Wip: Introduce mutable cursors for updating cursor value in place

Author: vidsinghal

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

@@ -1001,6 +1001,7 @@ mapPacked fn t =
     PtrTy    -> PtrTy
     CursorTy -> CursorTy
     CursorArrayTy size -> CursorArrayTy size
+    MutCursorTy -> MutCursorTy
     ArenaTy  -> ArenaTy
     VectorTy elty -> VectorTy elty
     ListTy elty   -> ListTy elty
@@ -1023,6 +1024,7 @@ constPacked c t =
     PtrTy    -> PtrTy
     CursorTy -> CursorTy
     CursorArrayTy size -> CursorArrayTy size
+    MutCursorTy -> MutCursorTy
     ArenaTy  -> ArenaTy
     VectorTy el_ty -> VectorTy (constPacked c el_ty)
     ListTy el_ty -> ListTy (constPacked c el_ty)

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

@@ -69,6 +69,8 @@ data E3Ext loc dec =
   | MakeCursorArray Int [Var] -- ^ Make a Cursor Array from a list of Cursors. Returns a new variable for Cursor Array.
   | IndexCursorArray Var Int                       -- ^ Index into a Cursor Array 
   | AddCursor Var (PreExp E3Ext loc dec)           -- ^ Add a constant offset to a cursor variable
+  | AddrOfCursor (PreExp E3Ext loc dec)            -- ^ Take the address of a Cursor.
+  | DerefMutCursor Var                             -- ^ Explicitly de-reference a mutable cursor
   | CastPtr Var dec                                -- ^ Cast a pointer to the specified type
   | SubPtr Var Var                                 -- ^ Pointer subtraction
   | NewBuffer L2.Multiplicity         -- ^ Create a new buffer, and return a cursor
@@ -81,7 +83,7 @@ data E3Ext loc dec =
                                    --   we'll probably represent (sizeof x) as (end_x - start_x) / INT
   | SizeOfScalar Var               -- ^ sizeof(var)
   | BoundsCheck Int Var Var        -- ^ Bytes required, region, write cursor
-  | BoundsCheckVector [(Int, Var, Var)] -- ^ Bytes required, region, write cursor but for a vector of cursors and regions
+  | BoundsCheckVector [(Int, Var, Var, (Var, Var))] -- ^ Bytes required, region, write cursor but for a vector of cursors and regions
   | IndirectionBarrier TyCon (Var,Var,Var,Var)
     -- ^ Do one of the following:
     -- (1) If it's a old-to-young indirection, record it in the remembered set.
@@ -288,11 +290,13 @@ cursorizeTy ty =
     PDictTy k v   -> PDictTy (cursorizeTy k) (cursorizeTy v)
     PackedTy _ l    -> case l of 
                            Single _ -> ProdTy [CursorTy, CursorTy]
-			   SoA _ flds -> ProdTy [CursorArrayTy (1 + length flds), CursorArrayTy (1 + length flds)]
+                           SoA _ flds -> ProdTy [CursorArrayTy (1 + length flds), CursorArrayTy (1 + length flds)]
     VectorTy el_ty' -> VectorTy $ cursorizeTy el_ty'
     ListTy el_ty'   -> ListTy $ cursorizeTy el_ty'
     PtrTy    -> PtrTy
     CursorTy -> CursorTy
+    CursorArrayTy sz -> CursorArrayTy sz 
+    MutCursorTy -> MutCursorTy
     ArenaTy  -> ArenaTy
     SymSetTy -> SymSetTy
     SymHashTy-> SymHashTy

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

@@ -160,9 +160,11 @@ tcExp isSoA isPacked ddfs env exp = do
           cty <- lookupVar env cur exp
           ensureEqualTyModCursor isSoA exp cty CursorTy
           return IntTy
-        
+
+        {- VS: Ignoring the types of the arguments to gib grow region -}
+        {- Should we check these? -} 
         BoundsCheckVector bounds -> do
-                                    _ <- mapM (\(_, bound, cur) -> do
+                                    _ <- mapM (\(_, bound, cur, _) -> do
                                                                    rty <- lookupVar env bound exp
                                                                    ensureEqualTyModCursor isSoA exp rty CursorTy
                                                                    cty <- lookupVar env cur exp
@@ -249,6 +251,17 @@ tcExp isSoA isPacked ddfs env exp = do
           ensureEqualTyModCursor isSoA exp vty vty
           return CursorTy
 
+        AddrOfCursor expr -> do
+          ety <- go expr
+          ensureEqualTyModCursor isSoA expr ety CursorTy
+          return MutCursorTy
+
+        DerefMutCursor v -> do
+          vty <- lookupVar env v exp
+          ensureEqualTyModCursor isSoA exp vty MutCursorTy
+          return CursorTy
+
+
         MakeCursorArray _ vars -> do 
           tys <- mapM (\v -> lookupVar env v exp) vars
           unless (all (== CursorTy) tys) $ throwError $ GenericTC ("Expected all vars to be of type CursorTy. Got: " ++ sdoc tys) exp

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

@@ -31,6 +31,7 @@ import           Gibbon.Common
 import qualified Gibbon.Language  as L
 import qualified Gibbon.L2.Syntax as L2
 import qualified Gibbon.L3.Syntax as L3
+import Gibbon.L3.Syntax (E3Ext(DerefMutCursor))
 
 
 --------------------------------------------------------------------------------
@@ -61,6 +62,7 @@ data Triv
     | SymTriv Word16    -- ^ An index into the symbol table.
     | ProdTriv [Triv]   -- ^ Tuples
     | ProjTriv Int Triv -- ^ Projections
+    | IndexCursorArrayTriv Int Triv -- ^ Indexing operation
   deriving (Show, Ord, Eq, Generic, NFData, Out)
 
 typeOfTriv :: M.Map Var Ty -> Triv -> Ty
@@ -73,6 +75,7 @@ typeOfTriv env trv =
     BoolTriv{}  -> BoolTy
     TagTriv{}   -> TagTyPacked
     SymTriv{}   -> SymTy
+    IndexCursorArrayTriv{} -> CursorTy
     ProdTriv ts -> ProdTy (map (typeOfTriv env) ts)
     ProjTriv i trv1 -> case typeOfTriv env trv1 of
                          ProdTy tys -> tys !! i
@@ -201,6 +204,7 @@ data Ty
     | RegionTy -- ^ Region start and a refcount
     | ChunkTy  -- ^ Start and end pointers
     | CursorArrayTy Int
+    | MutCursorTy
 
 -- TODO: Make Ptrs more type safe like this:
 --    | StructPtrTy { fields :: [Ty] } -- ^ A pointer to a struct containing the given fields.
@@ -369,6 +373,8 @@ data Prim
     | IndexCursorArray 
     | MakeCursorArray
     | CastPtr
+    | AddrOfCursor 
+    | DerefMutCursor
 
   deriving (Show, Ord, Eq, Generic, NFData, Out)
 
@@ -449,6 +455,7 @@ fromL3Ty ty =
     L.PtrTy      -> PtrTy
     L.CursorTy   -> CursorTy
     L.CursorArrayTy size -> CursorArrayTy size
+    L.MutCursorTy -> MutCursorTy
     -- L.PackedTy{} -> error "fromL3Ty: Cannot convert PackedTy"
     L.VectorTy el_ty  -> VectorTy (fromL3Ty el_ty)
     _ -> IntTy -- [2019.06.10]: CSK, Why do we need this?

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

@@ -631,7 +631,9 @@ data UrTy loc
         | CursorArrayTy Int -- ^ An array of cursors for reading or writing multiple cursors. 
                             -- ^ The cursor may point to an unkwown type or to a fraction of a complete value.
                             -- ^ It is a machine pointer that can point to any byte.
-                            -- ^ The Int is the number of cursors in the array. 
+                            -- ^ The Int is the number of cursors in the array.
+        | MutCursorTy -- ^ A reference to a CursorTy. This can be mutated in place.
+                        
 
   deriving (Show, Read, Ord, Eq, Generic, NFData, Functor, Foldable, Traversable, Out)
 

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

@@ -49,6 +49,18 @@ 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@(Ext (AddrOfCursor (Ext (IndexCursorArray _ _)))) ) bod -> do
+      let new_env = extendVEnv v ty env
+      (let_expr, cenv', env') <- case ty of
+        MutCursorTy -> return $ ([LetE (v, locs, ty, rhs)], cenv, new_env) 
+        CursorTy -> error "Did not expect lhs of address of expression to be a cursor."
+        CursorArrayTy _ -> error "Cannot take address of a CursorArray!\n"
+        _ -> error "addCastsExp: Casting expressions others than cursors hot handled!\n"
+      bod' <- addCastsExp fundef cenv' env' bod
+      let ex' = foldr (\expr acc -> expr acc) bod' let_expr
+      pure $ ex'
+
     LetE (v, locs, ty, (Ext (MakeCursorArray len vars))) bod -> do
       let new_env = extendVEnv v ty env
       (new_insts, cenv', env', vars') <-
@@ -301,6 +313,11 @@ addCastsExp fundef cenv env ex =
             Nothing -> v
       e' <- go e
       pure (Ext $ AddCursor nv e')
+    Ext (DerefMutCursor v) -> do 
+      let nv = case (M.lookup v cenv) of
+            Just v' -> v' 
+            Nothing -> v
+      pure (Ext $ DerefMutCursor nv)
     Ext (SubPtr a b) -> do
       let na = case (M.lookup a cenv) of
             Just v' -> v'
@@ -343,14 +360,20 @@ addCastsExp fundef cenv env ex =
     Ext (BoundsCheckVector bounds) -> do
       bounds' <-
         mapM
-          ( \(i, a, b) -> do
+          ( \(i, a, b, (a', b')) -> do
               let na = case (M.lookup a cenv) of
                     Just v' -> v'
                     Nothing -> a
               let nb = case (M.lookup b cenv) of
                     Just v' -> v'
                     Nothing -> b
-              return $ (i, na, nb)
+              let na' = case (M.lookup a' cenv) of
+                        Just v' -> v'
+                        Nothing -> a'
+              let nb' = case (M.lookup b' cenv) of
+                        Just v' -> v'
+                        Nothing -> b'
+              return $ (i, na, nb, (na', nb'))
           )
           bounds
       pure $ Ext (BoundsCheckVector bounds')

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

@@ -31,6 +31,7 @@ import qualified Gibbon.Language as GL
 import           Gibbon.DynFlags
 import           Gibbon.L2.Syntax ( Multiplicity(..) )
 import           Gibbon.L4.Syntax
+import Language.Haskell.Exts (var)
 
 --------------------------------------------------------------------------------
 
@@ -480,6 +481,7 @@ codegenTriv venv (ProdTriv ls) =
 codegenTriv venv (ProjTriv i trv) =
   let field = "field" ++ show i
   in [cexp| $(codegenTriv venv trv).$id:field |]
+codegenTriv venv (IndexCursorArrayTriv idx v) = [cexp| $(codegenTriv venv v)[$int:idx] |]
 
 
 -- Type environment
@@ -1072,11 +1074,17 @@ codegenTail venv fenv sort_fns (LetPrimCallT bnds prm rnds body) ty sync_deps =
                    --_new_chunk   <- gensym "new_chunk"
                    --_chunk_start <- gensym "chunk_start"
                    --_chunk_end   <- gensym "chunk_end"
-                   ifConds <- mapM (\(ProdTriv [(IntTriv i),(VarTriv bound), (VarTriv cur)]) -> 
+                   ifConds <- mapM (\(ProdTriv [(IntTriv i),(VarTriv bound), (VarTriv cur), _]) -> 
                                            pure [cexp| ($id:cur + $int:i) > $id:bound |]
                                       ) rnds
-                   ifBody <- mapM (\(ProdTriv [(IntTriv i),(VarTriv bound), (VarTriv cur)]) -> 
-                                       pure [ C.BlockStm  [cstm|  gib_grow_region(& $id:cur, & $id:bound); |] ]
+                   ifBody <- mapM (\(ProdTriv [_, _, _, ProdTriv [(VarTriv b), (VarTriv c)]]) -> do
+                                       {- TODO: VS: Maybe we should check loc too, but i think we desinged this such that it is 
+                                        not needed! -}
+                                       let bty = M.lookup b venv
+                                       case bty of 
+                                            Just CursorTy -> pure [ C.BlockStm  [cstm|  gib_grow_region(& $id:c, & $id:b); |] ]
+                                            Just MutCursorTy -> pure [ C.BlockStm  [cstm|  gib_grow_region(& $id:c, $id:b); |] ]
+                                            _ -> error "Did not expect variable type in gib_grow_region!\n"
                                   ) rnds
                    let condExpr = foldr1 (\c1 c2 -> [cexp| $exp:c1 || $exp:c2 |]) ifConds
                    let ifBody' = concat ifBody
@@ -1572,6 +1580,18 @@ codegenTail venv fenv sort_fns (LetPrimCallT bnds prm rnds body) ty sync_deps =
                         [ptr] = rnds
                         ptr' = codegenTriv venv ptr
                     return [ C.BlockDecl [cdecl| $ty:(codegenTy outT) $id:outV = ($ty:(codegenTy outT)) $exp:ptr'; |] ] 
+                  
+                 AddrOfCursor -> do
+                    let [(outV, outT)] = bnds
+                        [expr] = rnds 
+                        expr' = codegenTriv venv expr
+                    return [ C.BlockDecl [cdecl| $ty:(codegenTy outT) $id:outV =  &($exp:expr'); |] ] 
+
+                 DerefMutCursor -> do 
+                    let [(outV, outT)] = bnds
+                        [var] = rnds
+                        var' = codegenTriv venv var
+                    return [ C.BlockDecl [cdecl| $ty:(codegenTy outT) $id:outV = *($exp:var'); |] ]
 
                  _ -> error $ "codegen: " ++ show prm ++ " unhandled."
 
@@ -1654,6 +1674,7 @@ codegenTy SymTy = [cty|typename GibSym|]
 codegenTy PtrTy = [cty|typename GibPtr|] -- char* - Hack, this could be void* if we have enough casts. [2016.11.06]
 codegenTy CursorTy = [cty|typename GibCursor|]
 codegenTy (CursorArrayTy size) = [cty|typename GibCursor* |]
+codegenTy MutCursorTy = [cty|typename GibCursor* |]
 codegenTy RegionTy = [cty|typename GibChunk|]
 codegenTy ChunkTy = [cty|typename GibChunk|]
 codegenTy (ProdTy []) = [cty|unsigned char|]
@@ -1679,6 +1700,7 @@ makeName' SymTy       = "GibSym"
 makeName' BoolTy      = "GibBool"
 makeName' CursorTy    = "GibCursor"
 makeName' (CursorArrayTy{}) = "GibCursorPtr"
+makeName' (MutCursorTy) = "GibMutCursor"
 makeName' TagTyPacked = "GibPackedTag"
 makeName' TagTyBoxed  = "GibBoxedTag"
 makeName' PtrTy       = "GibPtr"