[don't rename values to be floated outward, unless they reach the very top level.
John Meacham <john@repetae.net>**20060322042850] hunk ./E/LetFloat.hs 228
+--notFloatOut e = isAtomic e || whnfOrBot e
+notFloatOut e = False
+
hunk ./E/LetFloat.hs 248
-                n' = maximum (top_level:[ n | t <- fvs, let Just n = Map.lookup t imap])
+                n' = maximum (top_level:[ lup t | t <- fvs ])
+                lup n = case Map.lookup n imap of
+                    Just x -> x
+                    Nothing -> error $ "LetFloat: could not find " ++ show tvr { tvrIdent = n }
hunk ./E/LetFloat.hs 268
-            return (ELetRec ds' e')
+            return (ELetRec (concat ds') e')
hunk ./E/LetFloat.hs 282
-                if whnfOrBot e || isAtomic e then do
-                    mtick $ "LetFloat.Full-Lazy.skip.{" ++ tvrShowName t
-                    return (t,e')
-                  else do
hunk ./E/LetFloat.hs 285
-                tell [(nl,(nv,e'))]
-                return (t,(EVar nv))
+                tell [(nl,(t,e'))]
+                return [] -- (t,(EVar nv))
hunk ./E/LetFloat.hs 291
-            return (t,e')
+            return [(t,e')]
+--        dtl (t,ELetRec ds e) = do
+--            (e',fs) <- runWriterT (dofloat e)
+--            return $ (t,e'):snds fs
hunk ./E/LetFloat.hs 297
-            return $ (t,letRec (snds fs) e')
-    let (nprog,stats) = runStatM (programMapDs dtl prog)
-    printStat "FullyLazy" stats
-    return nprog
+            let (e'',fs') = case e' of
+                    ELetRec ds e -> (e,ds++snds fs)
+                    _ -> (e',snds fs)
+            flip mapM_ (fsts $ fs') $ \t -> do
+                mtick $ "LetFloat.Full-Lazy.top_level.{" ++ tvrShowName t
+            let (fs'',sm') = unzip [ ((n,sm e),(t,EVar n)) | (t,e) <- fs', let n = nn t ]
+                sm = substLet sm'
+                nn tvr = tvr { tvrIdent = toId $ lfName (progModule prog) Val (tvrIdent tvr) }
+            return $ (t,sm e''):fs''
+    let (cds,stats) = runStatM (mapM dtl $ programDs prog)
+    let nprog = programSetDs (concat cds) prog
+    return nprog { progStats = progStats nprog `mappend` stats }
hunk ./E/LetFloat.hs 342
-    g e | isAtomic e || whnfOrBot e = return e
+    g e | notFloatOut e = return e
hunk ./E/TypeAnalysis.hs 79
-    return (prog,stats /= mempty)
+    return (prog { progStats = progStats prog `mappend` stats },stats /= mempty)