[add some annotation to C expressions to allow the code generator to clean things up some, do a pass replacing all unused vars with v0, modify C.FromGrin to handle v0 properly, not trying to assign to it.
John Meacham <john@repetae.net>**20080312224356] hunk ./C/FromGrin2.hs 42
-data Todo = TodoReturn | TodoExp [Expression] | TodoDecl Name Type
+data Todo = TodoReturn | TodoExp [Expression] | TodoDecl Name Type | TodoNothing
hunk ./C/FromGrin2.hs 141
+fetchVar (V 0) _ = return $ noAssign (err "fetchVar v0")
hunk ./C/FromGrin2.hs 148
-    return $ if not dclare then variable n else localVariable t n
+    return $ (if v == v0 then noAssign else id) $ if not dclare then variable n else localVariable t n
hunk ./C/FromGrin2.hs 267
-    ss <- localTodo (TodoExp []) (convertBody e)
+    ss <- localTodo TodoNothing (convertBody e)
hunk ./C/FromGrin2.hs 364
+        TodoNothing -> return jerr
hunk ./C/FromGrin2.hs 375
-convertBody (e :>>= [(Var vn' vt')] :-> e') | not $ isCompound e = do
+convertBody (e :>>= [(Var vn _)] :-> e') | vn == v0 = do
+    ss <- localTodo TodoNothing (convertBody e)
+    ss' <- convertBody e'
+    return (ss & ss')
+
+convertBody (e :>>= [(Var vn' vt')] :-> e') | not (isCompound e) = do
hunk ./C/FromGrin2.hs 454
+        TodoNothing -> return (toStatement er)
hunk ./C/Generate.hs 8
+    noAssign,
hunk ./C/Generate.hs 109
-data TypeHint = ThNone | ThConst | ThPtr
+data TypeHint = TypeHint {
+    thPtr :: Bool,
+    thConst :: Bool,
+    thNoAssign :: Bool,
+    thOmittable :: Bool
+    }
+
+hintConst = typeHint { thConst = True, thOmittable = True }
+hintPtr   = typeHint { thPtr = True }
+
+typeHint = TypeHint { thPtr = False, thConst = False, thNoAssign = False, thOmittable = False }
+
hunk ./C/Generate.hs 218
-    err s = (Exp ThNone (err s))
+    err s = (Exp typeHint (err s))
hunk ./C/Generate.hs 264
+noAssign :: Expression -> Expression
+noAssign (Exp th v) = Exp th { thNoAssign = True } v
+
hunk ./C/Generate.hs 271
-indexArray w i = expD (pdraw w <> char '[' <> pdraw i <> char ']')
+indexArray w i = expDO (pdraw w <> char '[' <> pdraw i <> char ']')
hunk ./C/Generate.hs 274
-project n e = expD (pdraw e <> char '.' <> draw n)
+project n e = expDO (pdraw e <> char '.' <> draw n)
hunk ./C/Generate.hs 277
-project' n e = expD (pdraw e <> text "->" <> draw n)
+project' n e = expDO (pdraw e <> text "->" <> draw n)
hunk ./C/Generate.hs 283
-variable n = expD (draw n)
+variable n = expDO (draw n)
hunk ./C/Generate.hs 318
-emptyExpression = Exp ThNone EE
+emptyExpression = Exp typeHint EE
hunk ./C/Generate.hs 338
-structAnon es = Exp ThNone $ ED $ do
+structAnon es = Exp typeHint $ ED $ do
hunk ./C/Generate.hs 356
-string s = Exp ThPtr (ED (return $ text (show s))) -- TODO, use C quoting conventions
+string s = Exp hintPtr (ED (return $ text (show s))) -- TODO, use C quoting conventions
hunk ./C/Generate.hs 358
-nullPtr = Exp ThPtr (ED $ text "NULL")
+nullPtr = Exp hintPtr (ED $ text "NULL")
hunk ./C/Generate.hs 362
-expD x = Exp ThNone (ED x)
-expDC x = Exp ThNone (EP $ ED x)
-expC x = Exp ThConst (ED x)
+expDO x = Exp typeHint { thOmittable = True } (ED x)
+expD x = Exp typeHint (ED x)
+expDC x = Exp hintConst (EP $ ED x)
+expC x = Exp hintConst (ED x)
hunk ./C/Generate.hs 393
+assign (Exp TypeHint { thNoAssign = True} _) (Exp TypeHint { thOmittable = True } _)  = mempty
+assign (Exp TypeHint { thNoAssign = True} _) b = expr b
hunk ./Grin/Devolve.hs 1
-module Grin.Devolve(devolveTransform,devolveGrin) where
+module Grin.Devolve(twiddleGrin,devolveTransform,devolveGrin) where
hunk ./Grin/Devolve.hs 4
-import Control.Monad.Writer
+import Control.Monad.RWS
hunk ./Grin/Devolve.hs 50
+
+data Env = Env {
+    envMap :: Map.Map Var Var,
+    envVar :: Var
+    }
+
+newtype R a = R (RWS Env (Set.Set Var) () a)
+    deriving(Monad,Functor,MonadReader Env,MonadWriter (Set.Set Var))
+
+runR (R x) = fst $ evalRWS x Env { envMap = mempty, envVar = v1 } ()
+
+
+class Twiddle a where
+    twiddle :: a -> R a
+    twiddle a = return a
+
+instance Twiddle Exp where
+    twiddle = twiddleExp
+
+instance Twiddle Val where
+    twiddle = twiddleVal
+
+instance Twiddle a => Twiddle [a] where
+    twiddle xs = mapM twiddle xs
+
+twiddleExp e = f e where
+    f (x :>>= lam) = return (:>>=) `ap` twiddle x `ap` twiddle lam
+    f l@Let {} = do
+        ds <- twiddle (expDefs l)
+        b <- twiddle (expBody l)
+        return . updateLetProps $ l { expDefs = ds, expBody = b }
+    f (Case v as) = return Case `ap` twiddle v `ap` twiddle as
+    f n = do e <- mapExpVal twiddleVal n ; mapExpExp twiddle e
+
+instance Twiddle Lam where
+    twiddle (vs :-> y) = do
+        let fvs = freeVars vs
+        (y,uv) <- censor (Set.filter (`notElem` fvs)) $ listen (twiddle y)
+        let fvp' = Map.fromList $ concatMap (\v -> if v `Set.member` uv then [] else [(v,v0)]) fvs
+        vs <- censor (const mempty) . local (\e -> e { envMap = fvp' }) $ twiddle vs
+        return (vs :-> y)
+--    twiddle (vs :-> y) = do
+--        cv <- asks envVar
+--        let fvp = Map.fromList $ zip fvs [cv ..]
+--            fvs = freeVars vs
+--        local (\e -> e { envVar = head $ drop (length fvs) [cv .. ], envMap = fvp `Map.union` envMap e }) $ do
+--        (y,uv) <- censor (Set.filter (`notElem` take (length fvs) [cv .. ])) $ listen (twiddle y)
+--        let fvp' = fmap (\v -> if v `Set.member` uv then v else v0) fvp
+--        vs <- censor (const mempty) . local (\e -> e { envMap = fvp' }) $ twiddle vs
+--        return (vs :-> y)
+
+
+twiddleGrin grin = grinFunctions_s fs' grin where
+    fs' = runR . twiddle  $ grinFunctions grin
+
+instance Twiddle FuncDef where
+    twiddle = funcDefBody_uM twiddle
+
+twiddleVal x = f x where
+    f var@(Var v ty) = do
+        em <- asks envMap
+        case Map.lookup v em of
+            Just n -> tell (Set.singleton n) >> return (Var n ty)
+            Nothing -> tell (Set.singleton v) >> return var
+    f x = mapValVal f x
+
+
+
+
+
+
hunk ./Grin/Noodle.hs 63
+mapValVal_ fn x = f x where
+    f (NodeC t vs) = mapM_ fn vs
+    f (Index a b) = fn a >> fn b >> return ()
+    f (Const v) = fn v >> return ()
+    f (ValPrim p vs ty) =  mapM_ fn vs >> return ()
+    f _ = return ()
+
hunk ./Grin/Noodle.hs 102
+funcDefBody_uM f fd@FuncDef { funcDefBody = b } = do
+    b' <- f b
+    return $  updateFuncDefProps fd { funcDefBody = b' }
+
+grinFunctions_s nf grin = grin { grinFunctions = nf }
+
hunk ./Grin/Noodle.hs 192
+        cfunc x = error "Grin.Noodle.collectFuncs: unknown"
hunk ./Main.hs 45
-import Grin.Devolve(devolveTransform)
+import Grin.Devolve(twiddleGrin,devolveTransform)
hunk ./Main.hs 98
-catom action = Control.Exception.catch action (\e -> dumpTable >> dumpStringTableStats >> throw e)
hunk ./Main.hs 747
+    x <- return $ twiddleGrin x