[bring function call collection to Grin.Noodle, clean up some code.
John Meacham <john@repetae.net>**20060817030845] hunk ./Grin/DeadCode.hs 12
-import Support.FreeVars
-import GenUtil
hunk ./Grin/DeadCode.hs 13
+import Grin.Noodle
hunk ./Grin/DeadCode.hs 17
+import Support.FreeVars
hunk ./Grin/DeadCode.hs 183
-    f lt@Let { expDefs = defs }  = if null defs' then return (expBody lt) else return lt { expDefs = defs' } where
+    f lt@Let { expDefs = defs }  = return $ updateLetProps lt { expDefs = defs' } where
hunk ./Grin/Devolve.hs 9
-import GenUtil
+import Util.Gen
hunk ./Grin/Devolve.hs 20
-            let nonTail = concatMap (execWriter . cfunc) (body : map (lamExp . funcDefBody) defs)
+            let nonTail = snd $ mconcatMap collectFuncs (body : map (lamExp . funcDefBody) defs)
hunk ./Grin/Devolve.hs 23
-                    | name `elem` nonTail = Left ((name,Tup (as ++ xs) :-> proc r),xs)
+                    | name `Set.member` nonTail = Left ((name,Tup (as ++ xs) :-> proc r),xs)
hunk ./Grin/Devolve.hs 34
-        clfunc (l :-> r) = cfunc r
-        cfunc (e :>>= y) = do
-            xs <- cfunc e
-            tell xs
-            clfunc y
-        cfunc (App a _ _) = return [a]
-        cfunc (Case _ as) = do
-            rs <- mapM clfunc as
-            return (concat rs)
-        cfunc Let { expDefs = defs, expBody = body } = do
-            b <- cfunc body
-            rs <- mapM (clfunc . funcDefBody) defs
-            return $ concat (b:rs)
-        cfunc Fetch {} = return []
-        cfunc Error {} = return []
-        cfunc Prim {} = return []
-        cfunc Return {} = return []
-        cfunc Store {} = return []
-        cfunc Update {} = return []
-        cfunc NewRegion { expLam = l } = clfunc l
-        cfunc Alloc {} = return []
-        cfunc MkCont { expCont = l1, expLam = l2 } = do
-            a <- clfunc l1
-            b <- clfunc l2
-            return (a ++ b)
-
hunk ./Grin/FromE.hs 570
-            return $ Let { expDefs = concat defs , expBody = v, expInfo = mempty }
+            return $ grinLet (concat defs) v
hunk ./Grin/Noodle.hs 5
+import Control.Monad.Writer
+import Data.Monoid
+import qualified Data.Set as Set
+
hunk ./Grin/Noodle.hs 98
+
+
+-- collect tail called, and normally called functions
+
+collectFuncs :: Exp -> (Set.Set Atom,Set.Set Atom)
+collectFuncs exp = runWriter (cfunc exp) where
+        clfunc (l :-> r) = cfunc r
+        cfunc (e :>>= y) = do
+            xs <- cfunc e
+            tell xs
+            clfunc y
+        cfunc (App a _ _) = return (Set.singleton a)
+        cfunc (Case _ as) = do
+            rs <- mapM clfunc as
+            return (mconcat rs)
+        cfunc Let { expDefs = defs, expBody = body } = do
+            b <- cfunc body
+            rs <- mapM (clfunc . funcDefBody) defs
+            return $ mconcat (b:rs)
+        cfunc Fetch {} = return mempty
+        cfunc Error {} = return mempty
+        cfunc Prim {} = return mempty
+        cfunc Return {} = return mempty
+        cfunc Store {} = return mempty
+        cfunc Update {} = return mempty
+        cfunc Alloc {} = return mempty
+        cfunc NewRegion { expLam = l } = clfunc l
+        cfunc MkCont { expCont = l1, expLam = l2 } = do
+            a <- clfunc l1
+            b <- clfunc l2
+            return (a `mappend` b)
+
+grinLet defs body = updateLetProps Let { expDefs = defs, expBody = body, expInfo = mempty }
+
+updateLetProps Let { expDefs = [], expBody = body } = body
+updateLetProps lt@Let {} = lt
+updateLetProps e = e
+
hunk ./Grin/Simplify.hs 352
-        f (lt { expDefs = defs, expBody = e } :>>= l :-> r)
+        f (updateLetProps lt { expBody = e } :>>= l :-> r)
hunk ./Grin/Simplify.hs 355
-        f ((lt { expDefs = defs, expBody = e } :>>= l :-> r) :>>= lr)
+        f ((updateLetProps lt { expBody = e } :>>= l :-> r) :>>= lr)
hunk ./Grin/Simplify.hs 358
-        f (e :>>= l :-> lt { expDefs = defs, expBody = r })
+        f (e :>>= l :-> updateLetProps lt { expBody = r })