[add let-pullin optimization
John Meacham <john@repetae.net>**20060818035418] hunk ./Grin/Noodle.hs 9
+import Support.FreeVars
hunk ./Grin/Noodle.hs 11
+import Options(flint)
hunk ./Grin/Noodle.hs 20
-modifyTail lam@(_ :-> lb) te = trace "modifyTail: returning" (f mempty te) where
+modifyTail lam@(_ :-> lb) te = f mempty te where
+    lamFV = freeVars lam :: Set.Set Var
hunk ./Grin/Noodle.hs 33
+    g lf (p :-> e) | flint && not (Set.null $ Set.intersect (freeVars p) lamFV) = error "modifyTail: lam floated inside bad scope"
hunk ./Grin/Noodle.hs 162
-    myDefs = Set.fromList (map funcDefName defs)
+    myDefs = Set.fromList $ map funcDefName defs
+--    retInfo = filter (`notElem` [myDefs]) concatMap (getReturnInfo . lamExp . funcDefBody) (body:defs)
hunk ./Grin/Noodle.hs 166
+
+data ReturnInfo = ReturnNode (Maybe Atom,[Ty]) | ReturnConst Val | ReturnCalls Atom | ReturnOther | ReturnError
+    deriving(Eq,Ord)
+
+getReturnInfo :: Exp -> [ReturnInfo]
+getReturnInfo  e = ans where
+    ans = execWriter (f mempty e)
+    tells x = tell [x]
+    f lf (Return (NodeV t as)) = tells (ReturnNode (Nothing,map getType as))
+    f lf (Return (NodeC t as)) = tells (ReturnNode (Just t,map getType as))
+    f lf (Return z) | valIsConstant z = tell [ReturnConst z]
+    f lf Error {} = tells ReturnError
+    f lf (Case _ ls) = do Prelude.mapM_ (f lf) [ e | _ :-> e <- ls ]
+    f lf (_ :>>= _ :-> e) = f lf e
+    f lf Let { expBody = body, expIsNormal = False } = f lf body
+    f lf (App a _ _) | a `Set.member` lf = return ()
+    f lf Let { expBody = body, expDefs = defs, expIsNormal = True } = ans where
+        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
+        ans = do
+            mapM_ (f nlf . lamExp . funcDefBody) defs
+            f nlf body
+    f _ (App a _ _) = tells $ ReturnCalls a
+    f _ e = tells ReturnOther
+
hunk ./Grin/Simplify.hs 24
+import Util.HasSize
hunk ./Grin/Simplify.hs 230
--- returns nothing if can return a tag, or just atom if can return an atom
hunk ./Grin/Simplify.hs 394
+
+    -- case unboxing
hunk ./Grin/Simplify.hs 411
-    -- let combining
+
+    -- let pullin
+    f (cs@Let { expIsNormal = True } :>>= lr) |  sizeLTE 1 (filter (/= ReturnError) (getReturnInfo cs)) = do
+            mtick "Optimize.optimize.let-pullin"
+            return $ modifyTail lr cs
+    -- case pullin
+    f (cs@Case {} :>>= lr) |  sizeLTE 1 (filter (/= ReturnError) (getReturnInfo cs)) = do
+            mtick "Optimize.optimize.case-pullin"
+            return $ modifyTail lr cs
+
+
+    -- let unboxing