[keep track of mappings of variables to their evaluated forms when generating grin code and use them when possible
John Meacham <john@repetae.net>**20070227085716] hunk ./C/FromGrin2.hs 380
-{-
-convertExp (Update v@(Var vv _) (NodeC t as)) | getType v == TyPtr TyNode = do
-    v' <- convertVal v
-    as' <- mapM convertVal as
-    nt <- nodeTypePtr t
-    declareStruct t
-    tell mempty { wTags = Set.singleton t }
-    let tmp' = cast nt (if vv < v0 then f_DETAG v' else v')
-        s = getTag tmp' =* constant (enum (nodeTagName t))
-        ass = [project' (arg i) tmp' =* a | a <- as' | i <- [(1 :: Int) ..] ]
-    return (mconcat $ profile_update_inc:s:ass,emptyExpression)
--}
hunk ./Grin/FromE.hs 153
+{-# NOINLINE compile #-}
hunk ./Grin/FromE.hs 334
-evalVar _ tvr | not isFGrin, Just CaseDefault <- Info.lookup (tvrInfo tvr)  = do
-        mtick "Grin.FromE.strict-casedefault"
-        return (Fetch (toVal tvr))
-evalVar _ tvr | getProperty prop_WHNF tvr = do
-        mtick "Grin.FromE.strict-propevaled"
-        return (Fetch (toVal tvr))
---evalVar fty tvr = return $ gEval (toVal tvr)
-evalVar fty tvr = return $ App funcEval [toVal tvr] fty
+evalVar fty tvr  = do
+    em <- asks evaledMap
+    case Map.lookup (tvrIdent tvr) em of
+        Just v -> do
+            mtick "Grin.FromE.strict-evaled"
+            return (Return v)
+        Nothing | not isFGrin, Just CaseDefault <- Info.lookup (tvrInfo tvr) -> do
+            mtick "Grin.FromE.strict-casedefault"
+            return (Fetch (toVal tvr))
+        Nothing | getProperty prop_WHNF tvr -> do
+            mtick "Grin.FromE.strict-propevaled"
+            return (Fetch (toVal tvr))
+        Nothing -> return $ App funcEval [toVal tvr] fty
hunk ./Grin/FromE.hs 506
-        as <- mapM cp as
-        def <- createDef d newNodeVar
-        return $ case (def,b,scrut) of
-            --([],_,_) -> e :>>= v :-> Case v as
-            (_,TVr {tvrIdent = 0 },_) -> e :>>= v :-> Case v (as ++ def)
-            (_,_,EVar etvr) ->  e :>>= v :-> Return (toVal etvr) :>>= toVal b :-> Case v (as ++ def)
-            (_,_,_) -> e :>>= v :-> Store v :>>= toVal b :-> Case v (as ++ def)
+        case (b,scrut) of
+            (_,EVar etvr) -> localEvaled [etvr,b] v $ do
+                    as <- mapM cp as
+                    def <- createDef d newNodeVar
+                    return $ e :>>= v :-> Return (toVal etvr) :>>= toVal b :-> Case v (as ++ def)
+            (TVr { tvrIdent = 0 },_) -> do
+                as <- mapM cp as
+                def <- createDef d newNodeVar
+                return $ e :>>= v :-> Case v (as ++ def)
+            (_,_) -> localEvaled [b] v $ do
+                    as <- mapM cp as
+                    def <- createDef d newNodeVar
+                    return $ e :>>= v :-> Store v :>>= toVal b :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 521
+    localEvaled vs v action = local (\lenv -> lenv { evaledMap = nm `mappend` evaledMap lenv }) action where
+        nm = Map.fromList [ (tvrIdent x, v) | x <- vs, tvrIdent x /= 0 ]