[remove overloaded 'Update' in favor of 'Overwrite' 'Redirect' and 'PokeVal' as appropriate
John Meacham <john@repetae.net>**20090708140550
 Ignore-this: 255a24bf5eb39de40e22214ab293c4f4
] hunk ./C/FromGrin2.hs 443
-convertBody (Update (Index base off) z) | getType base == TyPtr tyINode = do
+convertBody (BaseOp PokeVal [Index base off,z])  = do
hunk ./C/FromGrin2.hs 448
+convertBody (BaseOp PokeVal [base,z])  = do
+    base <- convertVal base
+    z' <- convertVal z
+    return $ indexArray base (constant $ number 0) =* z'
+--convertBody (Update (Index base off) z) | getType base == TyPtr tyINode = do
+--    base <- convertVal base
+--    off <- convertVal off
+--    z' <- convertVal z
+--    return $ indexArray base off =* z'
hunk ./C/FromGrin2.hs 551
-convertExp (Update v@(Var vv _) tn@(NodeC t as)) | getType v == TyINode = do
+convertExp (BaseOp Overwrite [v@(Var vv _),tn@(NodeC t as)]) | getType v == TyINode = do
hunk ./C/FromGrin2.hs 563
+--convertExp (Update v@(Var vv _) tn@(NodeC t as)) | getType v == TyINode = do
+--    v' <- convertVal v
+--    as' <- mapM convertVal as
+--    nt <- nodeTypePtr t
+--    let tmp' = cast nt (f_DETAG v') -- (if vv < v0 then f_DETAG v' else v')
+--    if not (tagIsSuspFunction t) && vv < v0 then do
+--        (nns, nn) <- newNode fptr_t tn
+--        return (nns & getHead (f_NODEP(f_DETAG v')) =* nn,emptyExpression)
+--     else do
+--        s <- tagAssign tmp' t
+--        let ass = [project' (arg i) tmp' =* a | a <- as' | i <- [(1 :: Int) ..] ]
+--        return (mconcat $ profile_update_inc:s:ass,emptyExpression)
hunk ./Grin/DeadCode.hs 119
-            g (Update (Var v _) n) | v < v0 = do
+            g (BaseOp Overwrite [Var v _,n]) | v < v0 = do
hunk ./Grin/DeadCode.hs 122
-            g (Update vv@(Index (Var v _) r) n) | v < v0 = do
-                v' <- supplyValue usedCafs v
-                addRule (doNode r)
-                addRule $ conditionalRule id v' $ doNode n
-            g (Update vv n) = addRule $ (doNode vv) `mappend` (doNode n)
+           -- g (Update vv@(Index (Var v _) r) n) | v < v0 = do
+           --     v' <- supplyValue usedCafs v
+           --     addRule (doNode r)
+           --     addRule $ conditionalRule id v' $ doNode n
+            g (BaseOp Overwrite [vv,n]) = addRule $ (doNode vv) `mappend` (doNode n)
+            g (BaseOp PokeVal [vv,n]) = addRule $ (doNode vv) `mappend` (doNode n)
hunk ./Grin/DeadCode.hs 180
-    f (Update (Var v TyINode) _) | deadCaf v = do
+    f (BaseOp Overwrite [(Var v TyINode),_]) | deadCaf v = do
hunk ./Grin/DeadCode.hs 183
-    f (Update p (NodeC fn as)) |  Just fn' <- tagToFunction fn = do
+    f (BaseOp Overwrite [p,NodeC fn as]) |  Just fn' <- tagToFunction fn = do
hunk ./Grin/DeadCode.hs 186
-        return $ Update p (NodeC fn as)
+        return $ BaseOp Overwrite  [p,NodeC fn as]
+--    f (Update (Var v TyINode) _) | deadCaf v = do
+--        mtick $ toAtom "Optimize.dead-code.caf-update"
+--        return $ Return []
+--    f (Update p (NodeC fn as)) |  Just fn' <- tagToFunction fn = do
+--        as <- dff' fn' as
+--        as <- mapM clearCaf as
+--        return $ Update p (NodeC fn as)
hunk ./Grin/FromE.hs 221
-        initCafs = sequenceG_ [ Update (Var v TyINode) node | (v,node) <- cafs ]
+        initCafs = sequenceG_ [ BaseOp Overwrite [(Var v TyINode),node] | (v,node) <- cafs ]
hunk ./Grin/FromE.hs 437
-            return $ Update (Index r' (toUnVal (0::Int))) v'
+            return $ BaseOp PokeVal [r',v']
hunk ./Grin/FromE.hs 454
-            return $ Update (Index r' o') v'
+            return $ BaseOp PokeVal [(Index r' o'),v']
hunk ./Grin/FromE.hs 677
-    doUpdate vr (Store n@(NodeC t ts)) = (Update vr n,t,map getType ts)
+    doUpdate vr (Store n@(NodeC t ts)) = (BaseOp Overwrite [vr,n],t,map getType ts)
hunk ./Grin/Grin.hs 12
+    BaseOp(..),
hunk ./Grin/Grin.hs 152
-data PrimApp = Demote | Promote | Eval
hunk ./Grin/Grin.hs 157
-data BaseOp
-    = Demote                -- turn a node into an inode, always okay
-    | Promote               -- turn an inode into a node, the inode _must_ already be a valid node
-    | Eval                  -- evaluate an inode, returns a node representing the evaluated value. Bool is whether to update the inode
-    | StoreNode !Bool Val   -- create a new node, Bool is true if it should be an indirect node, the second val is the region
-    | Redirect              -- write an indirection over its first argument to point to its second one
-    | Overwrite             -- overwrite an existing node with new data (the tag must match what was used for the initial Store)
-    | Peek                  -- read a value from a pointed to location
-    | Poke                  -- write a value to a pointed to location
-    deriving(Eq,Ord,Show)
hunk ./Grin/Grin.hs 158
-    | BaseOp    { expBaseOp :: BaseOp,
-                  expArgs :: [Val],
-                  expType :: [Ty]
-                }
hunk ./Grin/Grin.hs 162
+-- The basic operations of our monad
+--
+-- PeekVal and PokeVal differ from the primitive peek and poke in that the Val
+-- varients operate on node references, while the primitive versions work on
+-- raw memory with unboxed pointers.
+--
hunk ./Grin/Grin.hs 169
+data BaseOp
+--    = Demote                -- turn a node into an inode, always okay
+    = Promote               -- turn an inode into a node, the inode _must_ already be a valid node
+    | Eval                  -- evaluate an inode, returns a node representing the evaluated value. Bool is whether to update the inode
+    | Apply                 -- apply a partial application to a value
+    | StoreNode !Bool       -- create a new node, Bool is true if it should be an indirect node, the second val is the region
+    | Redirect              -- write an indirection over its first argument to point to its second one
+    | Overwrite             -- overwrite an existing node with new data (the tag must match what was used for the initial Store)
+    | PeekVal               -- read a value from a pointed to location
+    | PokeVal               -- write a value to a pointed to location
+    | Consume               -- consume a value, depending on the back end this may be needed to free memory
+    deriving(Eq,Ord,Show)
hunk ./Grin/Grin.hs 187
+    | BaseOp    { expBaseOp :: BaseOp,
+                  expArgs :: [Val]
+                }
hunk ./Grin/Grin.hs 200
-    | Update    { expAddress :: Val, expValue :: Val }                    -- ^ Update given heap node
hunk ./Grin/Grin.hs 247
+    | TyAttr Ty Ty               -- ^ attach an attribute to a type
+    | TyAnd Ty Ty                -- ^ boolean conjunction of types
+    | TyOr  Ty Ty                -- ^ boolean disjunction of types
hunk ./Grin/Grin.hs 512
+    getType (BaseOp Overwrite _) = []
+    getType (BaseOp Redirect _) = []
hunk ./Grin/Grin.hs 520
-    getType (Update w v) = []
hunk ./Grin/Grin.hs 581
-    freeVars (Update x y) = freeVars (x,y)
+    freeVars (BaseOp _ vs) = freeVars vs
hunk ./Grin/Grin.hs 599
-    freeVars (Update x y) = freeVars (x,y)
+    freeVars (BaseOp _ vs) = freeVars vs
hunk ./Grin/Grin.hs 640
-    freeVars (Update x y) = freeVars (x,y)
+    freeVars (BaseOp _ vs) = freeVars vs
hunk ./Grin/Lint.hs 292
-    f e@(Update w v) = do
-        (TyPtr t) <- tcVal w
-        t' <- tcVal v
-        same (show e) t t'
+    f e@(BaseOp Overwrite [w,v]) = do
hunk ./Grin/Lint.hs 294
+    f e@(BaseOp PokeVal [w,v]) = do
+        return []
+    f e@(BaseOp PeekVal [w]) = do
+        TyPtr t <- tcVal w
+        return [t]
+--    f e@(Update w v) = do
+--        (TyPtr t) <- tcVal w
+--        t' <- tcVal v
+--        same (show e) t t'
+--        return []
hunk ./Grin/NodeAnalyze.hs 238
-        f (Update (Var vname ty) v) | ty == TyINode  = do
+        f (BaseOp Overwrite [Var vname ty,v]) | ty == TyINode = do
hunk ./Grin/NodeAnalyze.hs 241
+            dres []
+        f (BaseOp Overwrite vs) = do
+            mapM_ convertVal vs
+            dres []
+        f (BaseOp PokeVal vs) = do
+            mapM_ convertVal vs
hunk ./Grin/NodeAnalyze.hs 248
-        f (Update (Var vname ty) v) | ty == TyPtr TyINode  = do
-            v' <- convertVal v
-            dres []
-        f (Update v1 v)  = do
-            v' <- convertVal v
-            v' <- convertVal v1
+        f (BaseOp PeekVal vs) = do
+            mapM_ convertVal vs
hunk ./Grin/NodeAnalyze.hs 251
+--        f (Update (Var vname ty) v) | ty == TyINode  = do
+--            v' <- convertVal v
+--            tell $ Left (vr vname ty) `isgte` v'
+--            dres []
+--        f (Update (Var vname ty) v) | ty == TyPtr TyINode  = do
+--            v' <- convertVal v
+--            dres []
+--        f (Update v1 v)  = do
+--            v' <- convertVal v
+--            v' <- convertVal v1
+--            dres []
hunk ./Grin/Noodle.hs 42
+    f (BaseOp a vs) = return (BaseOp a) `ap` mapM g vs
hunk ./Grin/Noodle.hs 51
-    f (Update a b) = return Update `ap` g a `ap` g b
hunk ./Grin/Noodle.hs 156
-isErrOmittable Update {} = True
+isErrOmittable (BaseOp Overwrite _) = True
+isErrOmittable (BaseOp PokeVal _) = True
hunk ./Grin/Noodle.hs 186
+        cfunc BaseOp {} = return mempty
hunk ./Grin/Noodle.hs 188
-        cfunc Update {} = return mempty
hunk ./Grin/Show.hs 90
-prettyExp vl (Update x y) = vl <> keyword "update" <+> prettyVal x <+> prettyVal y
+--prettyExp vl (Update x y) = vl <> keyword "update" <+> prettyVal x <+> prettyVal y
+prettyExp vl (BaseOp Overwrite [x,y]) = vl <> keyword "overwrite" <+> prettyVal x <+> prettyVal y
+prettyExp vl (BaseOp Redirect [x,y]) = vl <> keyword "redirect" <+> prettyVal x <+> prettyVal y
+prettyExp vl (BaseOp PokeVal [x,y]) = vl <> keyword "pokeVal" <+> prettyVal x <+> prettyVal y
+prettyExp vl (BaseOp PeekVal [x]) = vl <> keyword "peekVal" <+> prettyVal x
+prettyExp vl (BaseOp Promote [x]) = vl <> keyword "promote" <+> prettyVal x
+--prettyExp vl (BaseOp Promote [x]) = vl <> keyword "promote" <+> prettyVal x
hunk ./Grin/Simplify.hs 81
-    gs (Update Const {} Var {}) = do
-        lift $ tick stats at_OptSimplifyConstUpdate
-        gs (Return [])
+--    gs (Update Const {} Var {}) = do
+--        lift $ tick stats at_OptSimplifyConstUpdate
+--        gs (Return [])
hunk ./Grin/Simplify.hs 315
-    f (Store t :>>= [v@(Var vr _)] :-> Update  v' w :>>= lr) | v == v', vr `notElem` freeVars w = do
-        mtick "Optimize.optimize.store-update"
-        f (Store w :>>= [v] :-> Return [] :>>= lr)
-    f (Update v t :>>= [] :-> Fetch v' :>>= lr) | v == v' = do
-        mtick "Optimize.optimize.update-fetch"
-        f (Update v t :>>= [] :-> Return [t] :>>= lr)
+--    f (Store t :>>= [v@(Var vr _)] :-> Update  v' w :>>= lr) | v == v', vr `notElem` freeVars w = do
+--        mtick "Optimize.optimize.store-update"
+--        f (Store w :>>= [v] :-> Return [] :>>= lr)
+--    f (Update v t :>>= [] :-> Fetch v' :>>= lr) | v == v' = do
+--        mtick "Optimize.optimize.update-fetch"
+--        f (Update v t :>>= [] :-> Return [t] :>>= lr)