Change type of LocVar, starting refactor of files

gibbon-compiler/src/Gibbon/Common.hs

@@ -130,7 +130,12 @@ toSeqV :: Var -> Var
 toSeqV v = varAppend v (toVar "_seq")
 
 -- | Abstract location variables.
-type LocVar = Var
+-- type LocVar = Var
+
+-- | A location variable stores the abstract location. 
+-- | the second element stores locs for fields if factored out for an SoA optimization. 
+-- | If the list is empty it signifies a single location per type. 
+type LocVar = (Var, [((String, Int), Var)])
 
 -- | Abstract region variables.
 type RegVar = Var

gibbon-compiler/src/Gibbon/L2/Syntax.hs

@@ -103,6 +103,10 @@ type Exp2 = E2 LocVar Ty2
 -- | L1 Types extended with abstract Locations.
 type Ty2 = UrTy LocVar
 
+--type Ty2SoA = UrTy [LocVar]
+
+--instance Out Ty2SoA
+
 --------------------------------------------------------------------------------
 
 -- | Shorthand for recursions.
@@ -199,6 +203,12 @@ data LocRet = EndOf LRM
               deriving (Read, Show, Eq, Ord, Generic, NFData)
 
 
+freeVarsInLoc :: LocVar -> [Var]
+freeVarsInLoc (l, lst) = case lst of 
+                              [] -> [l]
+                              _ -> let locs = L.map (\((dcon, index), loc) -> loc) lst
+                                    in [l] ++ locs 
+
 instance FreeVars (E2Ext l d) where
   gFreeVars e =
     case e of
@@ -223,12 +233,11 @@ instance FreeVars (E2Ext l d) where
      SSPush{} -> S.empty
      SSPop{} -> S.empty
 
-
 instance FreeVars LocExp where
   gFreeVars e =
     case e of
-      AfterConstantLE _ loc   -> S.singleton loc
-      AfterVariableLE v loc _ -> S.fromList [v,loc]
+      AfterConstantLE _ loc   -> S.fromList $ freeVarsInLoc loc
+      AfterVariableLE v loc _ -> S.fromList $ [v] ++ (freeVarsInLoc loc)
       _ -> S.empty
 
 instance (Out l, Out d, Show l, Show d) => Expression (E2Ext l d) where
@@ -485,7 +494,7 @@ instance NFData LRM where
 
 -- | A designated doesn't-really-exist-anywhere location.
 dummyLRM :: LRM
-dummyLRM = LRM "l_dummy" (VarR "r_dummy") Input
+dummyLRM = LRM ("l_dummy", []) (VarR "r_dummy") Input
 
 regionToVar :: Region -> Var
 regionToVar r = case r of
@@ -556,6 +565,8 @@ instance Typeable (PreExp E2Ext LocVar (UrTy LocVar)) where
 
 instance Out (ArrowTy2 Ty2)
 
+--instance Out (ArrowTy2 Ty2SoA)
+
 instance Out Effect
 instance Out a => Out (S.Set a) where
   docPrec n x = docPrec n (S.toList x)
@@ -579,15 +590,15 @@ outLocVars ty = L.map (\(LRM l _ _) -> l) $
                 L.filter (\(LRM _ _ m) -> m == Output) (locVars ty)
 
 outRegVars :: ArrowTy2 ty2 -> [LocVar]
-outRegVars ty = L.map (\(LRM _ r _) -> regionToVar r) $
+outRegVars ty = L.map (\(LRM _ r _) -> (regionToVar r, [])) $
                 L.filter (\(LRM _ _ m) -> m == Output) (locVars ty)
 
 inRegVars :: ArrowTy2 ty2 -> [LocVar]
-inRegVars ty = L.nub $ L.map (\(LRM _ r _) -> regionToVar r) $
+inRegVars ty = L.nub $ L.map (\(LRM _ r _) -> (regionToVar r, [])) $
                L.filter (\(LRM _ _ m) -> m == Input) (locVars ty)
 
 allRegVars :: ArrowTy2 ty2 -> [LocVar]
-allRegVars ty = L.nub $ L.map (\(LRM _ r _) -> regionToVar r) (locVars ty)
+allRegVars ty = L.nub $ L.map (\(LRM _ r _) -> (regionToVar r, [])) (locVars ty)
 
 -- | Apply a location substitution to a type.
 substLoc :: M.Map LocVar LocVar -> Ty2 -> Ty2
@@ -640,7 +651,7 @@ substEffs mp effs =
     S.map (\ef -> substEff mp ef) effs
 
 dummyTyLocs :: Applicative f => UrTy () -> f (UrTy LocVar)
-dummyTyLocs ty = traverse (const (pure (toVar "dummy"))) ty
+dummyTyLocs ty = traverse (const (pure ((toVar "dummy", [])))) ty
 
 -- | Collect all the locations mentioned in a type.
 locsInTy :: Ty2 -> [LocVar]
@@ -779,7 +790,7 @@ occurs w ex =
         FromEndE{}    -> False
         BoundsCheck{} -> False
         AddFixed v _  -> v `S.member` w
-        IndirectionE _ _ (_,v1) (_,v2) ib ->
+        IndirectionE _ _ (_,(v1, _)) (_,(v2, _)) ib ->
           v1 `S.member` w  || v2 `S.member` w || go ib
         GetCilkWorkerNum -> False
         LetAvail _ bod -> go bod
@@ -864,7 +875,7 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
                        let (vars,locs) = unzip vlocs
                            acc'' = L.foldr (\w acc''' -> M.insertWith (++) v [w] acc''')
                                            acc'
-                                           (vars ++ locs)
+                                           (vars ++ (L.concatMap freeVarsInLoc locs))
                        in go acc'' e)
                     acc
                     mp
@@ -882,7 +893,9 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
                 go (M.insertWith (++) (regionToVar r) (S.toList $ allFreeVars rhs) acc) rhs
               LetParRegionE r _ _ rhs ->
                 go (M.insertWith (++) (regionToVar r) (S.toList $ allFreeVars rhs) acc) rhs
-              LetLocE loc phs rhs  ->
+              LetLocE (loc, _) phs rhs  ->
+                -- Assumption that the loc for the data constructor buffer is passed in case 
+                -- of SoA. If in SoA, ignoring the locs of the fields atm. 
                 go (M.insertWith (++) loc (dep phs ++ (S.toList $ allFreeVars rhs)) acc) rhs
               RetE{}         -> acc
               FromEndE{}     -> acc
@@ -902,49 +915,49 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
       dep ex =
         case ex of
           StartOfRegionLE r -> [regionToVar r]
-          AfterConstantLE _ loc   -> [loc]
-          AfterVariableLE v loc _ -> [v,loc]
+          AfterConstantLE _ (loc, _)   -> [loc]
+          AfterVariableLE v (loc, _) _ -> [v,loc]
           InRegionLE r  -> [regionToVar r]
-          FromEndLE loc -> [loc]
+          FromEndLE (loc, _) -> [loc]
           FreeLE -> []
 
 -- gFreeVars ++ locations ++ region variables
 allFreeVars :: Exp2 -> S.Set Var
 allFreeVars ex =
   case ex of
-    AppE _ locs args -> S.fromList locs `S.union` (S.unions (map allFreeVars args))
+    AppE _ locs args -> S.fromList (L.concatMap freeVarsInLoc locs) `S.union` (S.unions (map allFreeVars args))
     PrimAppE _ args -> (S.unions (map allFreeVars args))
-    LetE (v,locs,_,rhs) bod -> (S.fromList locs `S.union` (allFreeVars rhs) `S.union` (allFreeVars bod))
+    LetE (v,locs,_,rhs) bod -> (S.fromList (L.concatMap freeVarsInLoc locs) `S.union` (allFreeVars rhs) `S.union` (allFreeVars bod))
                                `S.difference` S.singleton v
     IfE a b c -> allFreeVars a `S.union` allFreeVars b `S.union` allFreeVars c
     MkProdE args -> (S.unions (map allFreeVars args))
     ProjE _ bod -> allFreeVars bod
     CaseE scrt brs -> (allFreeVars scrt) `S.union` (S.unions (map (\(_,vlocs,c) -> allFreeVars c `S.difference`
                                                                                    S.fromList (map fst vlocs) `S.difference`
-                                                                                   S.fromList (map snd vlocs))
+                                                                                   S.fromList (map (fst . snd) vlocs))
                                                                   brs))
-    DataConE loc _ args -> S.singleton loc `S.union` (S.unions (map allFreeVars args))
+    DataConE (loc, _) _ args -> S.singleton loc `S.union` (S.unions (map allFreeVars args))
     TimeIt e _ _ -> allFreeVars e
     WithArenaE _ e -> allFreeVars e
-    SpawnE _ locs args -> S.fromList locs `S.union` (S.unions (map allFreeVars args))
+    SpawnE _ locs args -> S.fromList (L.concatMap freeVarsInLoc locs) `S.union` (S.unions (map allFreeVars args))
     Ext ext ->
       case ext of
         LetRegionE r _ _ bod -> S.delete (regionToVar r) (allFreeVars bod)
         LetParRegionE r _ _ bod -> S.delete (regionToVar r) (allFreeVars bod)
-        LetLocE loc locexp bod -> S.delete loc (allFreeVars bod `S.union` gFreeVars locexp)
+        LetLocE (loc, _) locexp bod -> S.delete loc (allFreeVars bod `S.union` gFreeVars locexp)
         StartOfPkdCursor cur -> S.singleton cur
         TagCursor a b-> S.fromList [a,b]
-        RetE locs v     -> S.insert v (S.fromList locs)
-        FromEndE loc    -> S.singleton loc
-        BoundsCheck _ reg cur -> S.fromList [reg,cur]
-        IndirectionE _ _ (a,b) (c,d) _ -> S.fromList $ [a,b,c,d]
+        RetE locs v     -> S.insert v (S.fromList (L.concatMap freeVarsInLoc locs))
+        FromEndE (loc, _)    -> S.singleton loc
+        BoundsCheck _ (reg, _) (cur, _) -> S.fromList [reg,cur]
+        IndirectionE _ _ ((a, _),(b, _)) ((c, _),(d, _)) _ -> S.fromList $ [a,b,c,d]
         AddFixed v _    -> S.singleton v
         GetCilkWorkerNum-> S.empty
         LetAvail vs bod -> S.fromList vs `S.union` gFreeVars bod
-        AllocateTagHere loc _ -> S.singleton loc
-        AllocateScalarsHere loc -> S.singleton loc
-        SSPush _ a b _ -> S.fromList [a,b]
-        SSPop _ a b -> S.fromList [a,b]
+        AllocateTagHere (loc, _) _ -> S.singleton loc
+        AllocateScalarsHere (loc, _) -> S.singleton loc
+        SSPush _ (a, _) (b, _) _ -> S.fromList [a,b]
+        SSPop _ (a, _) (b, _) -> S.fromList [a,b]
     _ -> gFreeVars ex
 
 freeLocVars :: Exp2 -> [Var]

gibbon-compiler/src/Gibbon/L2/Typecheck.hs

@@ -767,42 +767,42 @@ tcExp ddfs env funs constrs regs tstatein exp =
                regs' <- regionInsert exp r regs
                (ty,tstate) <- tcExp ddfs env funs constrs regs' tstatein e
                return (ty,tstate)
-
-      Ext (LetLocE v c e) -> do
+      -- ATM, ignoring the locations for other buffers. 
+      Ext (LetLocE (v, rst) c e) -> do
               let env' = extendVEnv v CursorTy env
               case c of
                 StartOfRegionLE r ->
                     do ensureRegion exp r regs
                        absentStart exp constrs r
-                       let tstate1 = extendTS v (Output,False) tstatein
-                       let constrs1 = extendConstrs (StartOfC v r) $ extendConstrs (InRegionC v r) constrs
+                       let tstate1 = extendTS (v, rst) (Output,False) tstatein
+                       let constrs1 = extendConstrs (StartOfC (v, rst) r) $ extendConstrs (InRegionC (v, rst) r) constrs
                        (ty,tstate2) <- tcExp ddfs env' funs constrs1 regs tstate1 e
-                       tstate3 <- removeLoc exp tstate2 v
+                       tstate3 <- removeLoc exp tstate2 (v, rst)
                        return (ty,tstate3)
                 AfterConstantLE i l1 ->
                      do r <- getRegion exp constrs l1
-                        let tstate1 = extendTS v (Output,True) $ setAfter l1 tstatein
-                        let constrs1 = extendConstrs (InRegionC v r) $ extendConstrs (AfterConstantC i l1 v) constrs
+                        let tstate1 = extendTS (v, rst) (Output,True) $ setAfter l1 tstatein
+                        let constrs1 = extendConstrs (InRegionC (v, rst) r) $ extendConstrs (AfterConstantC i l1 (v, rst)) constrs
                         (ty,tstate2) <- tcExp ddfs env' funs constrs1 regs tstate1 e
-                        tstate3 <- removeLoc exp tstate2 v
+                        tstate3 <- removeLoc exp tstate2 (v, rst)
                         return (ty,tstate3)
                 AfterVariableLE x l1 _ ->
                     do r <- getRegion exp constrs l1
                        (_xty,tstate1) <- tcExp ddfs env funs constrs regs tstatein $ VarE x
                        -- NOTE: We now allow aliases (offsets) from scalar vars too. So we can leave out this check
                        -- ensurePackedLoc exp xty l1
-                       let tstate2 = extendTS v (Output,True) $ setAfter l1 tstate1
-                       let constrs1 = extendConstrs (InRegionC v r) $ extendConstrs (AfterVariableC x l1 v) constrs
+                       let tstate2 = extendTS (v, rst) (Output,True) $ setAfter l1 tstate1
+                       let constrs1 = extendConstrs (InRegionC (v, rst) r) $ extendConstrs (AfterVariableC x l1 (v, rst)) constrs
                        (ty,tstate3) <- tcExp ddfs env' funs constrs1 regs tstate2 e
-                       tstate4 <- removeLoc exp tstate3 v
+                       tstate4 <- removeLoc exp tstate3 (v, rst)
                        return (ty,tstate4)
                 FromEndLE _l1 ->
                     do -- TODO: This is the bare minimum which gets the examples typechecking again.
                        -- Need to figure out if we need to check more things here
                       (ty,tstate1) <- tcExp ddfs env' funs constrs regs tstatein e
                       return (ty,tstate1)
                 FreeLE ->
-                    do let constrs1 = extendConstrs (InRegionC v globalReg) $ constrs
+                    do let constrs1 = extendConstrs (InRegionC (v, rst) globalReg) $ constrs
                        (ty,tstate1) <- tcExp ddfs env' funs constrs1 regs tstatein e
                        return (ty,tstate1)
 

gibbon-compiler/src/Gibbon/Language/Syntax.hs

@@ -541,7 +541,7 @@ data UrTy loc
   | BoolTy
   | ProdTy [UrTy loc] -- ^ An N-ary tuple
   | SymDictTy (Maybe Var) (UrTy ()) -- ^ A map from SymTy to Ty
-          -- ^ We allow built-in dictionaries from symbols to a value type.
+      -- ^ We allow built-in dictionaries from symbols to a value type.
   | PackedTy TyCon loc -- ^ No type arguments to TyCons for now.  (No polymorphism.)
   | VectorTy (UrTy loc) -- ^ Vectors are decorated with the types of their elements;
                              -- which can only include scalars or flat products of scalars.

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

@@ -104,7 +104,7 @@ cursorize Prog{ddefs,fundefs,mainExp} = do
 -- |
 cursorizeFunDef :: DDefs Ty2 -> FunDefs2 -> FunDef2 -> PassM FunDef3
 cursorizeFunDef ddefs fundefs FunDef{funName,funTy,funArgs,funBody,funMeta} = do
-  let inLocs  = inLocVars funTy
+  let inLocs  = dbgTraceIt "Print function type: " dbgTraceIt (sdoc funTy) dbgTraceIt "\n" inLocVars funTy
       outLocs = outLocVars funTy
       outRegs = outRegVars funTy
       inRegs  = inRegVars funTy

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

@@ -140,7 +140,7 @@ convertFunTy (from,to,isPar) = do
     -- For this simple version, we assume every location is in a separate region:
     lrm1 <- concat <$> mapM (toLRM Input) from'
     lrm2 <- toLRM Output to'
-    return $ ArrowTy2 { locVars = lrm1 ++ lrm2
+    dbgTraceIt "Print in Inferloc: " dbgTraceIt (sdoc (lrm1, lrm2, from, to, from', to')) dbgTraceIt "\n" return $ ArrowTy2 { locVars = lrm1 ++ lrm2
                      , arrIns  = from'
                      , arrEffs = S.empty
                      , arrOut  = to'
@@ -152,9 +152,46 @@ convertFunTy (from,to,isPar) = do
                       return $ LRM v (VarR r) md)
             (F.toList ls)
 
+-- convertFunTySoa :: ([Ty1],Ty1,Bool) -> DDefs Ty1 -> PassM (ArrowTy2 Ty2)
+-- convertFunTySoa (from,to,isPar) ddefs = do
+--     from' <- mapM convertTy from
+--     from'' <- mapM (convertTySoA ddefs) from
+--     to'   <- convertTy to
+--     to'' <- convertTySoA ddefs to
+--     -- For this simple version, we assume every location is in a separate region:
+--     lrm1 <- concat <$> mapM (toLRM Input) from'
+--     lrm2 <- toLRM Output to'
+--     dbgTraceIt "Print in Inferloc: " dbgTraceIt (sdoc (lrm1, lrm2, from, to, from', to', from'', to'')) dbgTraceIt "\n" return $ ArrowTy2 { locVars = lrm1 ++ lrm2
+--                      , arrIns  = from'
+--                      , arrEffs = S.empty
+--                      , arrOut  = to'
+--                      , locRets = []
+--                      , hasParallelism = isPar }
+--  where
+--    toLRM md ls =
+--        mapM (\v -> do r <- freshLocVar "r"
+--                       return $ LRM v (VarR r) md)
+--             (F.toList ls)
+
+
 convertTy :: Ty1 -> PassM Ty2
 convertTy ty = traverse (const (freshLocVar "loc")) ty
 
+-- convertTySoA :: DDefs Ty1 -> Ty1 -> PassM Ty2SoA
+-- convertTySoA ddefs ty = case ty of 
+--                             PackedTy tc loc -> case (M.lookup (toVar tc) ddefs) of 
+--                                                             Nothing -> do 
+--                                                                         loc <- freshLocVar "loc"
+--                                                                         let locs = dbgTraceIt "Nothing case" [loc]
+--                                                                           in traverse (const $ pure locs) ty
+--                                                             Just ddef -> do 
+--                                                                           loc <- freshLocVar "loc"
+--                                                                           let locs = dbgTraceIt "just case" dbgTraceIt (sdoc ddef) dbgTraceIt "\n" [loc]
+--                                                                             in traverse (const $ pure locs) ty
+
+
+--traverse (const (freshLocVar "loc")) ty
+
 convertDDefs :: DDefs Ty1 -> PassM (DDefs Ty2)
 convertDDefs ddefs = traverse f ddefs
     where f (DDef tyargs n dcs) = do
@@ -224,7 +261,7 @@ inferLocs initPrg = do
           fenv <- forM fds $ \(FunDef _ _ (intys, outty) bod _meta) -> do
                   let has_par = hasSpawns bod
                   lift $ lift $ convertFunTy (intys,outty,has_par)
-          let fe = FullEnv dfs' M.empty fenv
+          let fe = dbgTraceIt "Print Data definitions" dbgTraceIt (sdoc dfs) dbgTraceIt "\n" FullEnv dfs' M.empty fenv
           me' <- case me of
             -- We ignore the type of the main expression inferred in L1..
             -- Probably should add a small check here

gibbon-rts/rts-c/gibbon_rts.h

@@ -768,7 +768,7 @@ INLINE_HEADER void gib_grow_region(char **writeloc_addr, char **footer_addr)
     if (old_chunk_in_nursery) {
         gib_grow_region_in_nursery_fast(
             false,
-            old_chunk_in_nursery,
+           old_chunk_in_nursery,
             newsize,
             old_footer,
             writeloc_addr,