[start getting Grin.FromE ready to switch to its own monad, allow raw fetches in FromGrin2. don't generate raw fetches fgrin can't handle in FromE
John Meacham <john@repetae.net>**20070227065737] hunk ./C/FromGrin2.hs 218
+    tell mempty { wTags = Set.singleton t }
hunk ./C/FromGrin2.hs 226
+            tell mempty { wTags = Set.singleton t }
hunk ./C/FromGrin2.hs 261
+            tell mempty { wTags = Set.singleton t }
hunk ./C/FromGrin2.hs 265
+            tell mempty { wTags = Set.singleton t }
hunk ./C/FromGrin2.hs 337
+convertExp (Fetch v) | getType v == TyPtr TyNode = do
+    v <- convertVal v
+    return (mempty,(functionCall (name "fetch") [v]))
hunk ./C/FromGrin2.hs 368
+convertExp (Update v@Var {} (NodeC t as)) | tagIsSuspFunction t, getType v == TyPtr TyNode = do
+    en <- declareEvalFunc t
+    v' <- convertVal v
+    as' <- mapM convertVal as
+    nt <- nodeTypePtr t
+    let tmp' = cast nt v'
+        s = getTag tmp' =* functionCall (name "EVALTAG") [reference (variable en)]
+        ass = [project' (arg i) tmp' =* a | a <- as' | i <- [(1 :: Int) ..] ]
+    return (mconcat $ profile_update_inc:s:ass,emptyExpression)
hunk ./C/FromGrin2.hs 381
+    declareStruct t
+    tell mempty { wTags = Set.singleton t }
hunk ./C/FromGrin2.hs 621
-convertExp (Fetch v) | getType v == TyPtr TyNode = do
-    v <- convertVal v
-    return (mempty,v)
hunk ./C/FromGrin2.hs 675
+
hunk ./Grin/FromE.hs 5
+import Control.Monad.Reader
+import Control.Monad.Trans
hunk ./Grin/FromE.hs 19
+import C.Arch
hunk ./Grin/FromE.hs 84
+newtype C a = C (ReaderT LEnv IO a)
+    deriving(Monad,MonadReader LEnv,UniqueProducer,Functor,MonadIO,Stats.MonadStats)
+
+runC :: LEnv -> C a -> IO a
+runC lenv (C x) = runReaderT x lenv
+
+newtype LEnv = LEnv {
+    evaledMap :: Map Id Val
+}
hunk ./Grin/FromE.hs 102
+    dataTable :: DataTable,
hunk ./Grin/FromE.hs 156
-    tyEnv <- newIORef initTyEnv
-    funcBaps <- newIORef []
-    counter <- newIORef 100000  -- TODO real number
+    tyEnv <- liftIO $ newIORef initTyEnv
+    funcBaps <- liftIO $ newIORef []
+    counter <- liftIO $ newIORef 100000  -- TODO real number
hunk ./Grin/FromE.hs 170
-    let doCompile = compile' dataTable CEnv {
+    let doCompile = compile' cenv
+        lenv = LEnv {
+            evaledMap = mempty
+        }
+        cenv = CEnv {
hunk ./Grin/FromE.hs 181
+            dataTable = dataTable,
hunk ./Grin/FromE.hs 185
-    ds <- mapM doCompile [ c | c@(v,_,_) <- progCombinators prog, v `notElem` [x | (x,_,_) <- cc]]
+    ds <- runC lenv $ mapM doCompile [ c | c@(v,_,_) <- progCombinators prog, v `notElem` [x | (x,_,_) <- cc]]
hunk ./Grin/FromE.hs 333
-evalVar _ tvr | Just CaseDefault <- Info.lookup (tvrInfo tvr)  = do
+evalVar _ tvr | not isFGrin, Just CaseDefault <- Info.lookup (tvrInfo tvr)  = do
hunk ./Grin/FromE.hs 342
-compile' ::  DataTable -> CEnv -> (TVr,[TVr],E) -> IO (Atom,Lam)
-compile' dataTable cenv (tvr,as,e) = ans where
+compile' ::  CEnv -> (TVr,[TVr],E) -> C (Atom,Lam)
+compile' cenv (tvr,as,e) = ans where
hunk ./Grin/FromE.hs 347
+        let (nn,_,_) = runIdentity $ Map.lookup (tvrIdent tvr) (scMap cenv)
hunk ./Grin/FromE.hs 350
-    cc, ce, cr :: E -> IO Exp
-    (nn,_,_) = runIdentity $ Map.lookup (tvrIdent tvr) (scMap cenv)
+    cc, ce, cr :: E -> C Exp
hunk ./Grin/FromE.hs 363
-        lfunc <- readIORef (localFuncMap cenv)
+        lfunc <- liftIO $ readIORef (localFuncMap cenv)
hunk ./Grin/FromE.hs 489
-    ce ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } | (ELit LitCons { litName = n, litArgs = [] }) <- followAliases dataTable (getType e), RawType <- nameType n = do
+    ce ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } | (ELit LitCons { litName = n, litArgs = [] }) <- followAliases (dataTable cenv) (getType e), RawType <- nameType n = do
hunk ./Grin/FromE.hs 491
-            v <- newPrimVar ty
+            v <- if tvrIdent b == 0 then newPrimVar ty else return $ toVal b
hunk ./Grin/FromE.hs 496
-                e :>>= v :-> Return v :>>= toVal b :-> Case v (as' ++ def)
+                e :>>= v :-> Case v (as' ++ def)
hunk ./Grin/FromE.hs 524
-    getName x = getName' dataTable x
+    getName x = getName' (dataTable cenv) x
hunk ./Grin/FromE.hs 526
+    app :: Ty -> Exp -> [Val] -> C Exp
hunk ./Grin/FromE.hs 559
-        addNewFunction (tl,Tup (args) :-> d)
+        liftIO $ addNewFunction cenv (tl,Tup (args) :-> d)
hunk ./Grin/FromE.hs 561
-    addNewFunction tl@(n,Tup args :-> body) = do
-        modifyIORef (funcBaps cenv) (tl:)
+    addNewFunction cenv tl@(n,Tup args :-> body) = do
+        liftIO $ modifyIORef (funcBaps cenv) (tl:)
hunk ./Grin/FromE.hs 564
-        modifyIORef (tyEnv cenv) addt
+        liftIO $ modifyIORef (tyEnv cenv) addt
hunk ./Grin/FromE.hs 574
-        a <- runOnceMap (errorOnce cenv) (ty,s) $ do
+        a <- liftIO $ runOnceMap (errorOnce cenv) (ty,s) $ do
hunk ./Grin/FromE.hs 578
-            addNewFunction (tl,Tup [] :-> Error s ty)
+            addNewFunction cenv (tl,Tup [] :-> Error s ty)
hunk ./Grin/FromE.hs 631
-                    modifyIORef (localFuncMap cenv) (minsert (tvrIdent t) (nn,length as,toType TyNode (getType a)))
+                    liftIO $ modifyIORef (localFuncMap cenv) (minsert (tvrIdent t) (nn,length as,toType TyNode (getType a)))
hunk ./Grin/FromE.hs 694
-        cons = runIdentity $ getConstructor n dataTable
+        cons = runIdentity $ getConstructor n (dataTable cenv)
hunk ./Grin/FromE.hs 706
-        i <- readIORef (counter cenv)
-        writeIORef (counter cenv) $! (i + 2)
+        i <- liftIO $ readIORef (counter cenv)
+        liftIO $ (writeIORef (counter cenv) $! (i + 2))