fix redirections case

Author: vidsinghal

gibbon-compiler/examples/soa_examples/list.hs

@@ -33,19 +33,13 @@ sumList lst = case lst of
 		   Cons i rst -> let sumRst = sumList rst 
                                   in i + sumRst
 
+id :: List -> List 
+id lst = lst
+
 gibbon_main = let 
-<<<<<<< HEAD:gibbon-compiler/examples/soa_examples/list.hs
-		lst = mkList 100
-                lst' = add1 lst 
-	       in sumList lst'
-=======
-		lst = mkList 20000
-                --lst' = iterate (add1 lst)
-                _ = printPacked lst
-                _ = printsym (quote "NEWLINE")
-                --(val, lst'') = fieldDep lst' 
-	       in sumList lst --() --printPacked lst' --val --sumList lst'
->>>>>>> f352266b (Hoist BoundsChecking):gibbon-compiler/examples/simple_tests/list.hs
+				 lst = mkList 100
+              	 lst' = id (add1 lst) 
+	       	    in sumList lst'
 
 
 

gibbon-compiler/src/Gibbon/Passes/AddCastInstructions.hs

@@ -1,6 +1,6 @@
 module Gibbon.Passes.AddCastInstructions (addCasts) where
 
-import Data.Foldable (foldrM)
+import Data.Foldable (foldrM, foldlM)
 import qualified Data.List as L
 import qualified Data.Map as M
 import Gibbon.Common
@@ -49,6 +49,24 @@ addCastsExp fundef cenv env ex =
       bod' <- addCastsExp fundef cenv' env' bod
       let ex' = foldr (\expr acc -> expr acc) bod' let_expr
       pure $ ex'
+
+    LetE (v, locs, ty, rhs@(VarE v')) bod -> do
+      let new_env = extendVEnv v ty env
+      let tyv' = lookupVEnv v' env
+      (let_expr, cenv', env') <- case (ty == tyv') of
+        True -> return $ ([LetE (v, locs, ty, rhs)], cenv, new_env)
+        False -> do
+          casted_var <- gensym "cast"
+          let ncenv = M.insert v' v cenv
+          let cursory_ty3 :: Ty3 = CursorTy
+          let nenv = extendVEnv casted_var cursory_ty3 new_env
+          let cast_ins = Ext $ CastPtr casted_var ty
+          -- let new_inst = [LetE (v, locs, ty, rhs)] ++ [LetE (casted_var, [], CursorTy, cast_ins)]
+          let new_inst = [LetE (casted_var, locs, CursorTy, rhs)] ++ [LetE (v, [], ty, cast_ins)]
+          pure $ (new_inst, ncenv, nenv)
+      bod' <- addCastsExp fundef cenv' env' bod
+      let ex' = foldr (\expr acc -> expr acc) bod' let_expr
+      pure $ ex'
 
     LetE (v, locs, ty, rhs@(Ext (AddrOfCursor (Ext (IndexCursorArray _ _)))) ) bod -> do
       let new_env = extendVEnv v ty env
@@ -204,7 +222,25 @@ addCastsExp fundef cenv env ex =
     CharE {} -> pure ex
     FloatE {} -> pure ex
     LitSymE {} -> pure ex
-    AppE f locs args -> AppE f locs <$> mapM go args
+    AppE f locs args -> do
+      let funTy = lookupFEnv f env
+      let args_zip_ty = zip args (fst funTy ++ [snd funTy])
+      (lets, new_args) <- foldlM (\(l, args') zipped -> case zipped of 
+                                                        (VarE arg, ty) -> do
+                                                            let argTy = lookupVEnv arg env
+                                                            if argTy == ty
+                                                            then
+                                                              return $ (l, args' ++ [VarE arg])
+                                                            else do
+                                                              let new_arg = case (M.lookup arg cenv) of
+                                                                                  Just v' -> VarE v'
+                                                                                  Nothing -> error "TODO : Cast not found in env!!"
+                                                              return $ (l, args' ++ [new_arg])
+                                                        _ -> return $ (l, args' ++ [fst zipped]) 
+                                 ) ([], []) args_zip_ty
+      -- Expecting AppE to be flat, so only variables are present in AppE.
+      return $ AppE f locs new_args
+
     PrimAppE pr args -> PrimAppE pr <$> mapM go args
     IfE a b c -> do
       a' <- go a