[before floating outward, let-bind all values
John Meacham <john@repetae.net>**20060322023435] hunk ./E/LetFloat.hs 20
+import E.Subst
hunk ./E/LetFloat.hs 254
-    prog <- programMapDs (\d -> return $ tl d imap) prog
+    prog <- flip programMapDs prog (\ (t,e) -> do
+        e' <- letBindAll (progDataTable prog) (progModule prog) e
+        return $ tl (t,e') imap)
hunk ./E/LetFloat.hs 303
+mapMSnd f xs = sequence [ (,) x `liftM` f y | (x,y) <- xs]
+
+
+letBindAll ::
+    DataTable  -- ^ the data table for expanding newtypes
+    -> Module     -- ^ current module name
+    -> E          -- ^ input term
+    -> IO E
+letBindAll  dataTable modName e = f e  where
+    f :: E -> IO E
+    f (ELetRec ds e) = do
+        ds' <- mapMSnd f ds
+        e' <- g e
+        return $ ELetRec ds' e'
+    f ec@ECase {} = do
+        let mv = case eCaseScrutinee ec of
+                EVar v -> subst (eCaseBind ec) (EVar v)
+                _ -> id
+        ec' <- caseBodiesMapM (g . mv) ec
+        scrut' <- g (eCaseScrutinee ec)
+        return ec' { eCaseScrutinee = scrut' }
+    f e@ELam {} = do
+        let (b,ts) = fromLam e
+        b' <- g b
+        return (foldr ELam b' ts)
+    f e = emapE' f e
+    g e | isAtomic e || whnfOrBot e = return e
+    g e = do
+        u <- newUniq
+        let n = toName Val (show modName,"af@" ++ show u)
+            tv = tvr { tvrIdent = toId n, tvrType = infertype dataTable e }
+        e' <- f e
+        return (ELetRec [(tv,e')] (EVar tv))
+