edits

gibbon-compiler/src/Gibbon/Common.hs

@@ -8,7 +8,7 @@
 module Gibbon.Common
        (
          -- * Variables
-         Var(..), LocVar(..), Location, FieldIndex, DataConBuf, FieldBuf, FieldLocs
+         Var(..), LocVar(..), Location
        , RegVar, fromVar, toVar, varAppend, toEndV, toSeqV, cleanFunName
        , TyVar(..), isUserTv
        , Symbol, intern, unintern
@@ -30,7 +30,8 @@ module Gibbon.Common
 
          -- * Debugging/logging:
        , dbgLvl, dbgPrint, dbgPrintLn, dbgTrace, dbgTraceIt, minChatLvl
-       , internalError, dumpIfSet
+       , internalError, dumpIfSet, unwrapLocVar, singleLocVar
+
 
          -- * Establish conventions for the output of #lang gibbon:
        , truePrinted, falsePrinted
@@ -132,22 +133,9 @@ toSeqV v = varAppend v (toVar "_seq")
 
 -- | A location variable stores the abstract location. 
 type Location = Var
--- | Index position of the filed in the data constructor. 
-type FieldIndex = Int 
--- | Location of the buffer where all the data constructor tags are stored. 
-type DataConBuf = Location 
--- | Store the name of the data constructor as a String. 
-type DataConName = String 
--- | Store the location of the buffer with the factored out fields.
--- | Stores extra meta data like data constructor to which it comes from and the index position.
-type FieldBuf = ((DataConName, FieldIndex), Location) 
--- | List of field locations for a datatype
-type FieldLocs = [FieldBuf]
--- | A data type that stores either a single location, AoS 
--- | or a SoA representation: A data constructor buffer in addition to location for fields.
--- | LocVar can also be a pointer. 
-data LocVar = Single Location | SoA DataConBuf FieldLocs | Pointer Location 
-      deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
+
+data LocVar = Single Location 
+  deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
 
 -- | Abstract region variables.
 type RegVar = Var
@@ -508,3 +496,10 @@ truePrinted = "#t"
 
 falsePrinted :: String
 falsePrinted = "#f"
+
+unwrapLocVar :: LocVar -> Var
+unwrapLocVar locvar = case locvar of 
+                            Single loc -> loc
+
+singleLocVar :: Location -> LocVar 
+singleLocVar loc = Single loc 

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

@@ -56,7 +56,6 @@ module Gibbon.L2.Syntax
   , dummyTyLocs
   , allFreeVars
   , freeLocVars
-  , freeVarsInLocVar
   , singleLocVar
 
 -- * Other helpers
@@ -200,16 +199,6 @@ type LocExp = PreLocExp LocVar
 data LocRet = EndOf LRM
               deriving (Read, Show, Eq, Ord, Generic, NFData)
 
-
-freeVarsInLocVar :: LocVar -> [Var]
-freeVarsInLocVar locvar = case locvar of 
-                            Single loc -> [loc]
-                            SoA dconLoc fieldLocs -> let
-                                                       locs = L.map (\((dcon, index), loc) -> loc) fieldLocs
-                                                      in [dconLoc] ++ locs
-singleLocVar :: Location -> LocVar 
-singleLocVar loc = Single loc 
-
 instance FreeVars (E2Ext l d) where
   gFreeVars e =
     case e of
@@ -237,8 +226,8 @@ instance FreeVars (E2Ext l d) where
 instance FreeVars LocExp where
   gFreeVars e =
     case e of
-      AfterConstantLE _ loc   -> S.fromList $ freeVarsInLocVar loc
-      AfterVariableLE v loc _ -> S.fromList $ [v] ++ (freeVarsInLocVar loc)
+      AfterConstantLE _ loc   -> S.singleton $ unwrapLocVar loc
+      AfterVariableLE v loc _ -> S.fromList $ [v, unwrapLocVar loc]
       _ -> S.empty
 
 instance (Out l, Out d, Show l, Show d) => Expression (E2Ext l d) where
@@ -792,7 +781,7 @@ occurs w ex =
         BoundsCheck{} -> False
         AddFixed v _  -> v `S.member` w
         IndirectionE _ _ (_,v1) (_,v2) ib ->
-          (getPointerLocFromLocVar v1) `S.member` w  || (getPointerLocFromLocVar v2) `S.member` w || go ib
+          (unwrapLocVar v1) `S.member` w  || (unwrapLocVar v2) `S.member` w || go ib
         GetCilkWorkerNum -> False
         LetAvail _ bod -> go bod
         AllocateTagHere{} -> False
@@ -804,12 +793,6 @@ occurs w ex =
   where
     go = occurs w
 
-getPointerLocFromLocVar :: LocVar -> Location 
-getPointerLocFromLocVar locvar = case locvar of 
-                                        Single loc -> error "Did not expect Single loc." 
-                                        SoA dconLoc fields -> error "Did not expect a SoA representation."
-                                        Pointer loc -> loc
-
 mapPacked :: (Var -> l -> UrTy l) -> UrTy l -> UrTy l
 mapPacked fn t =
   case t of
@@ -881,7 +864,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 ++ (L.concatMap freeVarsInLocVar locs))
+                                           (vars ++ (map unwrapLocVar locs))
                        in go acc'' e)
                     acc
                     mp
@@ -931,32 +914,32 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
 allFreeVars :: Exp2 -> S.Set Var
 allFreeVars ex =
   case ex of
-    AppE _ locs args -> S.fromList (L.concatMap freeVarsInLocVar locs) `S.union` (S.unions (map allFreeVars args))
+    AppE _ locs args -> S.fromList (map unwrapLocVar locs) `S.union` (S.unions (map allFreeVars args))
     PrimAppE _ args -> (S.unions (map allFreeVars args))
-    LetE (v,locs,_,rhs) bod -> (S.fromList (L.concatMap freeVarsInLocVar locs) `S.union` (allFreeVars rhs) `S.union` (allFreeVars bod))
+    LetE (v,locs,_,rhs) bod -> (S.fromList (map unwrapLocVar 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 (concatMap (freeVarsInLocVar . snd) vlocs))
+                                                                                   S.fromList (map (unwrapLocVar . snd) vlocs))
                                                                   brs))
-    DataConE locvar _ args -> S.fromList (freeVarsInLocVar locvar) `S.union` (S.unions (map allFreeVars args))
+    DataConE locvar _ args -> S.singleton (unwrapLocVar locvar) `S.union` (S.unions (map allFreeVars args))
     TimeIt e _ _ -> allFreeVars e
     WithArenaE _ e -> allFreeVars e
-    SpawnE _ locs args -> S.fromList (L.concatMap freeVarsInLocVar locs) `S.union` (S.unions (map allFreeVars args))
+    SpawnE _ locs args -> S.fromList (map unwrapLocVar 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.difference (S.fromList $ freeVarsInLocVar loc) (allFreeVars bod `S.union` gFreeVars locexp)
+        LetLocE loc locexp bod -> S.difference (S.singleton $ unwrapLocVar 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 (L.concatMap freeVarsInLocVar locs))
-        FromEndE loc    -> S.fromList $ freeVarsInLocVar loc
+        RetE locs v     -> S.insert v (S.fromList (map unwrapLocVar locs))
+        FromEndE loc    -> S.singleton $ unwrapLocVar loc
         BoundsCheck _ (Single reg) (Single cur) -> S.fromList [reg,cur]
-        IndirectionE _ _ ((Pointer a),(Pointer b)) ((Pointer c),(Pointer d)) _ -> S.fromList $ [a,b,c,d]
+        IndirectionE _ _ (a, b) (c, d) _ -> S.fromList $ [(unwrapLocVar a),(unwrapLocVar b),(unwrapLocVar c), (unwrapLocVar d)]
         AddFixed v _    -> S.singleton v
         GetCilkWorkerNum-> S.empty
         LetAvail vs bod -> S.fromList vs `S.union` gFreeVars bod

gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs

@@ -84,7 +84,7 @@ fromOldL2Exp ddefs fundefs locenv env2 ex =
                                              case lookupVEnv w env2 of
                                                PackedTy _ loc -> (loc:acc)
                                                -- For indirection/redirection pointers.
-                                               CursorTy -> (w:acc)
+                                               CursorTy -> ((Single w):acc)
                                                _ -> acc
                                            _ -> acc)
                                       []
@@ -93,8 +93,8 @@ fromOldL2Exp ddefs fundefs locenv env2 ex =
                  (ewitnesses', locenv'') =
                         foldr
                           (\(witloc, tloc) (wits, env) ->
-                             let (New.Loc lrem) = (env # tloc)
-                                 wit' = New.EndWitness lrem witloc
+                             let (New.Loc lrem) = (env # (tloc))
+                                 wit' = New.EndWitness lrem (unwrapLocVar witloc)
                                  env' = M.insert witloc wit' env
                              in (wit' : wits, env'))
                           ([], locenv')
@@ -134,7 +134,7 @@ fromOldL2Exp ddefs fundefs locenv env2 ex =
                                    locenv locargs
                        env2' = extendPatternMatchEnv dcon ddefs vars locs env2
                        locenv'' = if isRedirectionTag dcon || isIndirectionTag dcon
-                                  then let ptr = head vars
+                                  then let ptr = Single $ head vars
                                        in M.insert ptr (mkLocArg ptr) locenv'
                                   else locenv'
                    rhs' <- go locenv'' env2' rhs
@@ -173,7 +173,7 @@ fromOldL2Exp ddefs fundefs locenv env2 ex =
         FromEndE loc -> Ext <$> FromEndE <$> pure (locenv # loc)
 
         BoundsCheck i reg loc -> do
-         let reg' = New.Reg reg Output
+         let reg' = New.Reg (unwrapLocVar reg) Output
              loc' = locenv # loc
          pure $ Ext $ BoundsCheck i reg' loc'
 
@@ -189,8 +189,8 @@ fromOldL2Exp ddefs fundefs locenv env2 ex =
             IndirectionE
               tycon
               dcon
-              (locenv # from, New.EndOfReg from_reg Output (toEndV from_reg))
-              (locenv # to, New.EndOfReg to_reg Input (toEndV to_reg))
+              (locenv # from, New.EndOfReg (unwrapLocVar from_reg) Output (toEndV (unwrapLocVar from_reg)))
+              (locenv # to, New.EndOfReg (unwrapLocVar to_reg) Input (toEndV (unwrapLocVar to_reg)))
               e'
               -- (locenv # from, New.Reg (VarR from_reg) Output)
               -- (locenv # to, New.Reg (VarR to_reg) Input)

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

@@ -107,15 +107,16 @@ toLocVar :: LocArg -> LocVar
 toLocVar arg =
   case arg of
     Loc lrm        -> lremLoc lrm
-    EndWitness _ v -> (v, [])
-    Reg v _        -> (v, [])
-    EndOfReg _ _ v -> (v, [])
-    EndOfReg_Tagged v -> (toEndFromTaggedV v, [])
+    EndWitness _ v -> Single v 
+    Reg v _        -> Single v
+    EndOfReg _ _ v -> Single v 
+    EndOfReg_Tagged v -> Single (toEndFromTaggedV v)
 
+-- Returns the data constructor 
 fromLocArgToVar :: LocArg -> Var 
 fromLocArgToVar arg =
   case arg of
-    Loc lrm        -> lremLoc lrm
+    Loc lrm        -> unwrapLocVar $ lremLoc lrm
     EndWitness _ v -> v
     Reg v _        -> v
     EndOfReg _ _ v -> v
@@ -134,8 +135,8 @@ toEndFromTaggedV v = (toVar "end_from_tagged_") `varAppend` v
 instance FreeVars LocExp where
   gFreeVars e =
     case e of
-      Old.AfterConstantLE _ loc  -> S.singleton (toLocVar loc)
-      Old.AfterVariableLE v loc _ -> S.fromList [v,toLocVar loc]
+      Old.AfterConstantLE _ loc  -> S.singleton $ unwrapLocVar (toLocVar loc)
+      Old.AfterVariableLE v loc _ -> S.fromList $ [v, unwrapLocVar (toLocVar loc)] 
       _ -> S.empty
 
 
@@ -383,7 +384,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 ++ (map toLocVar locs))
+                                           (vars ++ (map (unwrapLocVar . toLocVar) locs))
                        in go acc'' e)
                     acc
                     mp
@@ -402,7 +403,7 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
               Old.LetParRegionE r _ _ rhs ->
                 go (M.insertWith (++) (Old.regionToVar r) (S.toList $ allFreeVars rhs) acc) rhs
               Old.LetLocE loc phs rhs  ->
-                go (M.insertWith (++) loc (dep phs ++ (S.toList $ allFreeVars rhs)) acc) rhs
+                go (M.insertWith (++) (unwrapLocVar loc) (dep phs ++ (S.toList $ allFreeVars rhs)) acc) rhs
               Old.RetE{}         -> acc
               Old.FromEndE{}     -> acc
               Old.BoundsCheck{}  -> acc
@@ -421,49 +422,49 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty
       dep ex =
         case ex of
           Old.StartOfRegionLE r -> [Old.regionToVar r]
-          Old.AfterConstantLE _ loc   -> [toLocVar loc]
-          Old.AfterVariableLE v loc _ -> [v,toLocVar loc]
+          Old.AfterConstantLE _ loc   -> [unwrapLocVar $ toLocVar loc]
+          Old.AfterVariableLE v loc _ -> [v, unwrapLocVar $ toLocVar loc]
           Old.InRegionLE r  -> [Old.regionToVar r]
-          Old.FromEndLE loc -> [toLocVar loc]
+          Old.FromEndLE loc -> [unwrapLocVar $ toLocVar loc]
           Old.FreeLE -> []
 
 -- gFreeVars ++ locations ++ region variables
 allFreeVars :: Exp2 -> S.Set Var
 allFreeVars ex =
   case ex of
-    AppE _ locs args -> S.fromList (map toLocVar locs) `S.union` (S.unions (map allFreeVars args))
+    AppE _ locs args -> S.fromList (map (unwrapLocVar . toLocVar) locs) `S.union` (S.unions (map allFreeVars args))
     PrimAppE _ args -> (S.unions (map allFreeVars args))
-    LetE (v,locs,_,rhs) bod -> (S.fromList (map toLocVar locs) `S.union` (allFreeVars rhs) `S.union` (allFreeVars bod))
+    LetE (v,locs,_,rhs) bod -> (S.fromList (map (unwrapLocVar . toLocVar) 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 (toLocVar . snd) vlocs))
+                                                                                   S.fromList (map (unwrapLocVar . toLocVar . snd) vlocs))
                                                                   brs))
-    DataConE loc _ args -> S.singleton (toLocVar loc) `S.union` (S.unions (map allFreeVars args))
+    DataConE loc _ args -> S.singleton ((unwrapLocVar . toLocVar) loc) `S.union` (S.unions (map allFreeVars args))
     TimeIt e _ _ -> allFreeVars e
     WithArenaE _ e -> allFreeVars e
-    SpawnE _ locs args -> S.fromList (map toLocVar locs) `S.union` (S.unions (map allFreeVars args))
+    SpawnE _ locs args -> S.fromList (map (unwrapLocVar . toLocVar) locs) `S.union` (S.unions (map allFreeVars args))
     Ext ext ->
       case ext of
         Old.LetRegionE r _ _ bod -> S.delete (Old.regionToVar r) (allFreeVars bod)
         Old.LetParRegionE r _ _ bod -> S.delete (Old.regionToVar r) (allFreeVars bod)
-        Old.LetLocE loc locexp bod -> S.delete loc (allFreeVars bod `S.union` gFreeVars locexp)
+        Old.LetLocE loc locexp bod -> S.difference ((S.singleton . unwrapLocVar) loc) (allFreeVars bod `S.union` gFreeVars locexp)
         Old.StartOfPkdCursor v -> S.singleton v
         Old.TagCursor a b-> S.fromList [a,b]
-        Old.RetE locs v     -> S.insert v (S.fromList (map toLocVar locs))
-        Old.FromEndE loc    -> S.singleton (toLocVar loc)
-        Old.BoundsCheck _ reg cur -> S.fromList (map toLocVar [reg, cur])
-        Old.IndirectionE _ _ (a,b) (c,d) _ -> S.fromList $ [toLocVar a, toLocVar b, toLocVar c, toLocVar d]
+        Old.RetE locs v     -> S.insert v (S.fromList (map (unwrapLocVar . toLocVar) locs))
+        Old.FromEndE loc    -> S.singleton ((unwrapLocVar . toLocVar) loc)
+        Old.BoundsCheck _ reg cur -> S.fromList (map (unwrapLocVar . toLocVar) [reg, cur])
+        Old.IndirectionE _ _ (a,b) (c,d) _ -> S.fromList (map (unwrapLocVar . toLocVar) [a, b, c, d])
         Old.AddFixed v _    -> S.singleton v
         Old.GetCilkWorkerNum-> S.empty
         Old.LetAvail vs bod -> S.fromList vs `S.union` gFreeVars bod
-        Old.AllocateTagHere loc _ -> S.singleton loc
-        Old.AllocateScalarsHere loc -> S.singleton loc
-        Old.SSPush _ a b _ -> S.fromList [a,b]
-        Old.SSPop _ a b -> S.fromList [a,b]
+        Old.AllocateTagHere loc _ -> S.singleton $ unwrapLocVar loc
+        Old.AllocateScalarsHere loc -> S.singleton $ unwrapLocVar loc
+        Old.SSPush _ a b _ -> S.fromList (map unwrapLocVar [a,b])
+        Old.SSPop _ a b -> S.fromList (map unwrapLocVar [a,b])
     _ -> gFreeVars ex
 
 freeLocVars :: Exp2 -> [Var]