[make binding of case statements scope over all alternatives
John Meacham <john@repetae.net>**20060413012423] hunk ./E/Annotate.hs 89
-        alts <- (mapM da $ eCaseAlts ec)
+        alts <- local r (mapM da $ eCaseAlts ec)
hunk ./E/LetFloat.hs 335
-        ec' <- caseBodiesMapM g ec
hunk ./E/LetFloat.hs 338
-            nd = fmap mv (eCaseDefault ec')
+        ec' <- caseBodiesMapM (fmap mv . g) ec
hunk ./E/LetFloat.hs 340
-        return ec' { eCaseScrutinee = scrut', eCaseDefault = nd }
+        return ec' { eCaseScrutinee = scrut' }
hunk ./E/SSimplify.hs 569
-        let dd e' = f e' (insertDoneSubst b (EVar b') $ envInScope_u (newinb `union`) inb) where
+        let ids = insertDoneSubst b (EVar b')
+        let dd e' = f e' ( ids $ envInScope_u (newinb `union`) inb) where
hunk ./E/SSimplify.hs 576
-                e' <- f ae (mins e (patToLitEE p') inb)
+                e' <- f ae (ids $ mins e (patToLitEE p') inb)
hunk ./E/SSimplify.hs 584
-                e' <- f ae (substAddList nsub (envInScope_u (ninb `union`) $ mins e (patToLitEE p') inb))
+                e' <- f ae (ids $ substAddList nsub (envInScope_u (ninb `union`) $ mins e (patToLitEE p') inb))
hunk ./E/SSimplify.hs 594
+    doConstCase :: {- Out -} Lit E E -> InE -> InTVr -> [Alt E] -> Maybe InE -> Env -> SM OutE
hunk ./E/SSimplify.hs 607
-    match m@(LitCons c xs _) ((Alt (LitCons c' bs _) e):rs) d | c == c' = do
+    match m@(LitCons c xs _) ((Alt (LitCons c' bs _) e):rs) d@(b,_) | c == c' = do
hunk ./E/SSimplify.hs 609
-        return $ Just ((zip bs xs),e)
+        return $ Just ((b,ELit m):(zip bs xs),e)
hunk ./E/SSimplify.hs 611
-    match m@(LitInt a _) ((Alt (LitInt b _) e):rs) d | a == b = do
-        mtick (toAtom $ "E.Simplify.known-case." ++ show a)
-        return $ Just ([],e)
+    match m@(LitInt x _) ((Alt (LitInt y _) e):rs) d@(b,_) | x == y = do
+        mtick (toAtom $ "E.Simplify.known-case." ++ show x)
+        return $ Just ([(b,ELit m)],e)
hunk ./E/Subst.hs 111
-        alts <- (mapM da $ eCaseAlts ec)
+        alts <- local r (mapM da $ eCaseAlts ec)
hunk ./E/TypeAnalysis.hs 327
-        as'@(a:ras) = take (length $ ruleArgs rule1) as
+        as'@(a:ras)
+                | (a:ras) <- take (length $ ruleArgs rule1) as = (a:ras)
+                | otherwise = error $ pprint (tvr,(oe,show rule1))
hunk ./Grin/FromE.hs 393
-                e :>>= v :-> Case v (as' ++ def)
+                e :>>= v :-> Return v :>>= toVal b :-> Case v (as' ++ def)
hunk ./Grin/FromE.hs 400
-            ([],_,_) -> e :>>= v :-> Case v as
+            --([],_,_) -> e :>>= v :-> Case v as
hunk ./Ho/Build.hs 233
+    when (dump FD.EInfo || verbose2) $ putErrLn (show $ tvrInfo tvr)
hunk ./Main.hs 495
+    prog <- programPrune prog