[let floating inward float past oneshot lambdas and type applications. add programFloatInward to float a whole program
John Meacham <john@repetae.net>**20060428225428] hunk ./E/LetFloat.hs 5
+    programFloatInward,
hunk ./E/LetFloat.hs 30
+import Name.Names
hunk ./E/LetFloat.hs 40
+import Info.Types
+import qualified CharIO
hunk ./E/LetFloat.hs 148
+canFloatPast t | sortStarLike . getType $ t = True
+canFloatPast t | getType t == tWorldzh = True
+canFloatPast t | getType t == ELit (LitCons tc_IOErrorCont [] (ESort EStar)) = True
+canFloatPast _ = False
+
+programFloatInward :: Program -> IO Program
+programFloatInward prog = do
+    let binds = G.scc $  G.newGraph [ (d,bindingFreeVars x y) | d@(x,y) <- ds, x `notElem` progEntryPoints prog ] (tvrIdent . fst . fst) (idSetToList . snd)
+        binds :: Binds
+        epoints = [ d | d@(x,_) <- ds, x `elem` progEntryPoints prog ]
+        ds,epoints :: [(TVr,E)]
+        ds = programDs prog
+        (oall,pints) = sepByDropPoint (map (\ (x,y) -> bindingFreeVars x y) epoints) binds
+        nprog = programSetDs ([ (k,fi k v y)| ((k,v),y) <- zip epoints pints] ++ [ (x,floatInwardE y []) | (x,y) <- dsBinds oall]) prog
+        fi k = if getProperty prop_ONESHOT k then floatInwardE' else floatInwardE
+    --Prelude.putStrLn "programFloatInward:"
+    --mapM_ (putStrLn . pprint) (map fst $ dsBinds (concat pints))
+    --Prelude.putStrLn "programFloatedInward"
+    nprog <- programMapBodies (return . floatInward) prog
+    return nprog
+
+
hunk ./E/LetFloat.hs 176
-
-
hunk ./E/LetFloat.hs 177
-    f ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault =  d } xs = letRec p' $ ec { eCaseScrutinee = (f e pe), eCaseAlts = [ Alt l (f e pn) | Alt l e <- as | pn <- ps ], eCaseDefault = (fmap (flip f pd) d)}  where
+    f ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault =  d } xs = ans where
+        ans = letRec p' $ ec { eCaseScrutinee = (f e pe), eCaseAlts = [ Alt l (f e pn) | Alt l e <- as | pn <- ps ], eCaseDefault = (fmap (flip f pd) d)}
hunk ./E/LetFloat.hs 183
-            ev' = f ev pv
+            ev' = if getProperty prop_ONESHOT v then floatInwardE' ev pv else f ev pv
hunk ./E/LetFloat.hs 188
+    f e@ELam {} xs | all canFloatPast  ls = (foldr ELam (f b xs) ls) where
+        (b,ls) = fromLam e
hunk ./E/LetFloat.hs 202
+floatInwardE' e@ELam {} xs  = (foldr ELam (floatInwardE b xs) ls) where
+    (b,ls) = fromLam e
+floatInwardE' e xs = floatInwardE e xs
+
hunk ./E/LetFloat.hs 209
+dsBinds bs = foldr ($) [] (map f bs) where
+    f (Left (x,_)) = (x:)
+    f (Right ds) = (map fst ds ++)
+
hunk ./Main.hs 222
-            progClosed = False,
+            progClosed = True,
hunk ./Main.hs 310
-        mprog <- transformProgram "float inward" DontIterate (dump FD.CoreMini) (programMapBodies (return . floatInward)) mprog
+        mprog <- transformProgram "float inward" DontIterate (dump FD.CoreMini) programFloatInward mprog
hunk ./Main.hs 338
+    --prog <- transformProgram "Big Float Inward" DontIterate True programFloatInward prog
hunk ./Main.hs 578
+    --prog <- transformProgram "float inward" DontIterate True programFloatInward prog