[rewrite application atomizer
John Meacham <john@repetae.net>**20060310114336] hunk ./E/FromHs.hs 35
-import E.LetFloat(atomizeApps)
+import E.LetFloat(atomizeAp)
hunk ./E/FromHs.hs 323
-        e2 <- atomizeApps mempty Stats.theStats e2'
+        e2 <- atomizeAp dataTable Stats.theStats e2'
hunk ./E/LetFloat.hs 2
-    atomizeApps,
+--    atomizeApps,
+    atomizeAp,
hunk ./E/LetFloat.hs 17
+import DataConstructors
+import Doc.PPrint
hunk ./E/LetFloat.hs 24
-import Support.FreeVars
-import Options
hunk ./E/LetFloat.hs 25
+import Name.Name
+import Options
+import qualified CharIO as C
hunk ./E/LetFloat.hs 30
+import Support.CanType
+import Support.FreeVars
+import Util.UniqueMonad
hunk ./E/LetFloat.hs 38
-doLetRec stats ds e = return $ substLet ds e
+doLetRec stats ds e = return $ ELetRec ds e
hunk ./E/LetFloat.hs 46
-    --f 0 (EPi (TVr Nothing t) b,[])  = do
-    --    (t',ds1) <- at t
-    --    (b',ds2) <- at b
-    --    doLetRec stats
+    f 0 (ep@(EPi tvr@TVr {tvrIdent = i, tvrType = t} b),[]) | i == 0 || i `notElem` freeVars b = do
+        (t',ds1) <- at t
+        (b',ds2) <- at b
+        liftIO $ C.putStrLn $ "atomizeApps: " ++ pprint ep
+        doLetRec stats (ds1 ++ ds2) (EPi tvr { tvrIdent = 0, tvrType = t'} b')
hunk ./E/LetFloat.hs 62
+    at (ELetRec ds e) = do
+        (x,xs) <- at e
+        return (x,ds ++ xs)
hunk ./E/LetFloat.hs 66
+        liftIO $ C.putStrLn $ "at: " ++ pprint e
hunk ./E/LetFloat.hs 69
-        nb@(tvr,_) <- newBinding e
-        return (EVar tvr,[nb])
+        case e of
+            ELetRec ds e -> do
+                nb@(tvr,_) <- newBinding e
+                return (EVar tvr,nb:ds)
+            e -> do
+                nb@(tvr,_) <- newBinding e
+                return (EVar tvr,[nb])
+
hunk ./E/LetFloat.hs 79
+atomizeAp :: DataTable -> Stats -> E -> IO E
+atomizeAp dataTable stats e = f e  where
+    f :: E -> IO E
+    f e = do
+        (x,ds) <- g e
+        ds' <- sequence [  f y >>= return . (,) x | (x,y) <- ds ]
+        doLetRec stats ds' x
+    g,h :: E -> IO (E,[(TVr,E)])
+    g (ELetRec ds e) = do
+        e' <- f e
+        return (e',ds)
+    g (ELam tvr e) = do
+        e' <- f e
+        return (ELam tvr e',[])
+    g (ELit (LitCons n xs t)) = do
+        (xs',dss) <- fmap unzip (mapM h xs)
+        return (ELit (LitCons n xs' t), concat dss)
+    g e@ELit {} = return (e,[])
+    g e@EError {} = return (e,[])
+    g ep@(EPi tvr@TVr {tvrIdent = i, tvrType = t} b) | i == 0 || i `notElem` freeVars b  = do
+        ([t',b'],dss) <- fmap unzip (mapM h [t,b])
+        return (EPi tvr { tvrIdent = 0, tvrType = t' } b', concat dss)
+    g (EPrim n xs t) = do
+        (xs',dss) <- fmap unzip (mapM h xs)
+        return (EPrim n xs' t, concat dss)
+    g ec@ECase { eCaseScrutinee = e } = do
+        ec' <- caseBodiesMapM f ec
+        e' <- f e
+        return (ec' { eCaseScrutinee = e' },[])
+    g e = case fromAp e of
+        (EVar x,xs) -> do
+            (xs',dss) <- fmap unzip (mapM h xs)
+            return (foldl EAp (EVar x) xs', concat dss)
+        (x,xs@(_:_)) -> do
+            (x',ds) <- g x
+            (xs',dss) <- fmap unzip (mapM h xs)
+            return (foldl EAp x' xs', concat (ds:dss))
+    h e | isAtomic e = return (e,[])
+    h (ELetRec ds e) = do
+        (e',ds') <- h e
+        return (e',ds' ++ ds)
+    h e = do
+        tick stats (toAtom "E.LetFloat.atomizeAp")
+        u <- newUniq
+        let n = toName Val ("A@",'v':show u)
+            tv = tvr { tvrIdent = toId n, tvrType = infertype dataTable e }
+        C.putStrLn $ show n ++ " = " ++ pprint e
+        return (EVar tv,[(tv,e)])
+
hunk ./E/SSimplify.hs 516
-someBenefit _ _ = True
+someBenefit _ _ = False
hunk ./E/SSimplify.hs 518
+multiInline x xs | not (someBenefit x xs) = False
hunk ./Main.hs 255
-        --wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName' fullDataTable v lc) cds
+        wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName'' fullDataTable v lc) cds
hunk ./Main.hs 268
+        wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName'' fullDataTable v lc) cds
hunk ./Main.hs 369
-    lc <- doopt mangle False stats "FixupLets..." (\stats x -> atomizeApps usedIds stats x >>= coalesceLets stats)  lc
+    lc <- doopt mangle False stats "FixupLets..." (\stats x -> atomizeAp dataTable stats x >>= coalesceLets stats)  lc
hunk ./Main.hs 496
-    lc <- mangle dataTable (return ()) True  "FixupLets..." (\x -> atomizeApps mempty finalStats x >>= coalesceLets finalStats)  (programE prog)
+    lc <- mangle dataTable (return ()) True  "FixupLets..." (\x -> atomizeAp dataTable finalStats x >>= coalesceLets finalStats)  (programE prog)