[clean up code some, fix bug where local function map was erased when you came across an non-normal let bindings
John Meacham <john@repetae.net>**20070608054422] hunk ./Grin/Simplify.hs 10
-import List hiding (insert)
+import List hiding (insert,union)
hunk ./Grin/Simplify.hs 225
-data UnboxingResult = UnboxTag | UnboxTup (Atom,[Ty]) | UnboxConst Val
+data UnboxingResult = UnboxTup (Atom,[Ty]) | UnboxConst Val
hunk ./Grin/Simplify.hs 236
---    f lf (Return (NodeC t [])) | postEval = return [UnboxTag]
hunk ./Grin/Simplify.hs 246
-        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
+        nlf = lf `union` Set.fromList (map funcDefName defs)
hunk ./Grin/Simplify.hs 255
-combineLam postEval nty (p :-> e) = p :-> combine postEval nty e where
+--combineLam postEval nty (p :-> e) = p :-> combine postEval nty e where
hunk ./Grin/Simplify.hs 257
---    f (Return (NodeC t [])) | postEval  = Return (Tag t)
-    f (Return v) | all valIsConstant v  = Return []
-    f (Return [NodeC t xs]) = Return xs
-    f lt@Let { expBody = body } = updateLetProps lt { expBody = combine postEval nty body }
-    f e = error $ "combine: " ++ show (postEval,nty,e)
+    f (Return v) | all valIsConstant v  = return $ Return []
+    f (Return [NodeC t xs]) = return $ Return xs
+    f e = fail $ "combine: " ++ show (postEval,nty,e)
hunk ./Grin/Simplify.hs 261
-editTail :: [Ty] -> (Exp -> Exp) -> Exp -> Exp
+editTail :: Monad m => [Ty] -> (Exp -> m Exp) -> Exp -> m Exp
hunk ./Grin/Simplify.hs 263
-    f _ (Error s ty) = Error s nty
-    f lf (Case x ls) = Case x (map (g lf) ls)
-    f _ lt@Let {expIsNormal = False } = mt lt
-    f lf lt@Let {expDefs = defs, expBody = body, expIsNormal = True } = updateLetProps lt { expBody = f nlf body, expDefs = defs' } where
-        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
-        defs' = [ updateFuncDefProps d { funcDefBody = g nlf (funcDefBody d) } | d <- defs ]
-    f lf lt@MkCont {expLam = lam, expCont = cont } = lt { expLam = g lf lam, expCont = g lf cont }
-    f lf (e1 :>>= p :-> e2) = e1 :>>= p :-> f lf e2
-    f lf e@(App a as t) | a `member` lf = App a as nty
+    f _ (Error s ty) = return $ Error s nty
+    f lf (Case x ls) = return (Case x) `ap` mapM (g lf) ls
+    f lf lt@Let {expIsNormal = False, expBody = body } = do
+        body <- f lf body
+        return $ updateLetProps lt { expBody = body }
+    f lf lt@Let {expDefs = defs, expIsNormal = True } = do
+        let nlf = lf `union` Set.fromList (map funcDefName defs)
+        mapExpExp (f nlf) lt
+    f lf lt@MkCont {expLam = lam, expCont = cont } = do
+        a <- g lf lam
+        b <- g lf cont
+        return $ lt { expLam = a, expCont = b }
+    f lf (e1 :>>= p :-> e2) = do
+        e2 <- f lf e2
+        return $ e1 :>>= p :-> e2
+    f lf e@(App a as t) | a `member` lf = return $ App a as nty
hunk ./Grin/Simplify.hs 280
-    g lf (p :-> e) = p :-> f lf e
+    g lf (p :-> e) = do e <- f lf e; return $ p :-> e
hunk ./Grin/Simplify.hs 400
-    f (cs@(Case x as) :>>= lr) | Just UnboxTag <- isCombinable postEval cs = do
-        mtick "Optimize.optimize.case-unbox-tag"
-        let fv = freeVars cs `Set.union` freeVars [ p | p :-> _ <- as ]
-            (va:_vr) = [ v | v <- [v1..], not $ v `Set.member` fv ]
-        lr <- g lr
-        return ((Case x (map (combineLam postEval TyTag) as) :>>= Var va TyTag :-> Return (NodeV va [])) :>>= lr)
hunk ./Grin/Simplify.hs 447
-                return ((combine postEval (ts) cs :>>= vars  :-> Return [NodeC t vars]) :>>= lr)
+                cpe <- combine postEval ts cs
+                return ((cpe :>>= vars  :-> Return [NodeC t vars]) :>>= lr)
hunk ./Grin/Simplify.hs 451
-                return ((combine postEval [] cs :>>= [] :-> Return [val]) :>>= lr)
+                cpe <- combine postEval [] cs
+                return ((cpe :>>= [] :-> Return [val]) :>>= lr)