[fix up let floating inward and remove broken optimization subsumed by inlining
John Meacham <john@repetae.net>**20051002021933] hunk ./E/LetFloat.hs 28
+import qualified Info.Info as Info
hunk ./E/LetFloat.hs 111
---    f (ELetRec ds e) xs = g (G.scc $  G.newGraph [ (d, freeVars (tvrType $ fst d) `mappend` freeVars' (fst d) (snd d))  | d <- ds ] (tvrNum . fst . fst) (Set.toList . snd) ) xs where
-
hunk ./E/LetFloat.hs 117
-    --freeVars' v e = freeVars e `mappend` ruleFreeVars rules v
-    freeVars' v e = augment (freeVars (tvrType v) `mappend` freeVars e)
-    augment fvs = mconcat (fvs:[ ruleFreeVars' rules x | x <- Set.toList fvs ])
+    augment fvs = fvs
hunk ./E/LetFloat.hs 120
-    f (ELetRec ds e) xs = g (G.scc $  G.newGraph [ (d,freeVars' x y) | d@(x,y) <- ds ] (tvrNum . fst . fst) (Set.toList . snd) ) xs where
+    f (ELetRec ds e) xs = g (G.scc $  G.newGraph [ (d,bindingFreeVars x y) | d@(x,y) <- ds ] (tvrNum . fst . fst) (Set.toList . snd) ) xs where
hunk ./E/LetFloat.hs 122
-        g ((Left ((v,ev),fv)):xs) p = g xs (p0 ++ [Left ((v,ev'),freeVars' v ev')] ++ p') where
+        g ((Left ((v,ev),fv)):xs) p = g xs (p0 ++ [Left ((v,ev'),bindingFreeVars v ev')] ++ p') where
hunk ./E/LetFloat.hs 124
-            (p',[p0,pv,_]) = sepByDropPoint [augment (frest xs), freeVars' v ev, freeVars (tvrType v)] p
-        g (Right bs:xs) p =  g xs (p0 ++ [Right [ let ev' = f ev pv in ((v,ev'),freeVars' v ev') | ((v,ev),_) <- bs | pv <- ps ]] ++ p') where
+            (p',[p0,pv,_]) = sepByDropPoint [augment (frest xs), bindingFreeVars v ev, freeVars (tvrType v)] p
+        g (Right bs:xs) p =  g xs (p0 ++ [Right [ let ev' = f ev pv in ((v,ev'),bindingFreeVars v ev') | ((v,ev),_) <- bs | pv <- ps ]] ++ p') where
hunk ./E/LetFloat.hs 128
-    f e xs |  not (null ls) = letRec unsafe_binds (foldr ELam (f b safe_binds) ls) where
-        (unsafe_binds,safe_binds) =  sepDupableBinds (freeVars $ map tvrType ls) xs
-        (b,ls) = fromLam e
+    f e xs |  (b,ls@(_:_)) <- fromLam e = letRec xs (foldr ELam (f b []) ls)
hunk ./E/LetFloat.hs 130
-        | (EVar v,as) <- fromAp e, v == v', tvrNum v' `notElem` freeVars as  = f (runIdentity $ app (ev,as) {- foldl EAp ev as -} ) xs
-    --    | otherwise = f (EVar v) xs
-    --    | otherwise = error $ "floatInward: shouldn't happen:" <+>  tshow (EVar v) <+> tshow (v')
+        | (EVar v,as) <- fromAp e, v == v', not (tvrNum v' `Set.member` freeVars as)  = f (runIdentity $ app (ev,as) {- foldl EAp ev as -} ) xs
hunk ./E/LetFloat.hs 137
-    --letRec p e = eLetRec  (concatMap (map fst . fromScc) p) e
-    --letRec p e = foldr eLetRec e (reverse $ map (map fst . fromScc) p)
hunk ./E/LetFloat.hs 143
+{-
hunk ./E/LetFloat.hs 151
-
-sameLength [] [] = True
-sameLength (_:xs) (_:ys) = sameLength xs ys
-sameLength _ _ = False
+-}
hunk ./E/LetFloat.hs 160
-sepByDropPoint ds fs' | sameShape1 xs ds && sum (length r:map length xs) == length fs' = (r,xs) where
+--sepByDropPoint ds fs' | sameShape1 xs ds && sum (length r:map length xs) <= length fs' = (r,xs) where
+sepByDropPoint ds fs' = (r,xs) where
hunk ./E/LetFloat.hs 167
-            (gb,ds'') | sameShape1 ds' ds'' -> (gb, [ if v then b:d else d | d <- ds'' | (_,v) <- ds' ])
+            (gb,ds'')  -> (gb, [ if v then b:d else d | d <- ds'' | (_,v) <- ds' ])
+            -- (gb,ds'') | sameShape1 ds' ds'' -> (gb, [ if v then b:d else d | d <- ds'' | (_,v) <- ds' ])
hunk ./E/LetFloat.hs 170
-            (gb,ds'') | sameShape1 ds'' ds -> (b:gb,ds'')
+            (gb,ds'')  -> (b:gb,ds'')
+            --(gb,ds'') | sameShape1 ds'' ds -> (b:gb,ds'')