[make jumppoint creation inline case statements when they will be applied to a known value. add let inlining.
John Meacham <john@repetae.net>**20060818064637] hunk ./Grin/Simplify.hs 5
+import Control.Monad.Writer
hunk ./Grin/Simplify.hs 435
-    f (Case x as :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
-        c <- caseHoist x as v as' (getType rc)
+    f (hexp@Case {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
+        c <- caseHoist hexp v as' (getType rc)
hunk ./Grin/Simplify.hs 439
-    f (Case x as :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
-        caseHoist x as v as' (getType rc)
+    f (hexp@Case {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
+        caseHoist hexp v as' (getType rc)
hunk ./Grin/Simplify.hs 460
+    f (hexp@Let {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
+        c <- caseHoist hexp v as' (getType rc)
+        lr <- g lr
+        return $ c :>>= lr
+    f (hexp@Let {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
+        caseHoist hexp v as' (getType rc)
hunk ./Grin/Simplify.hs 477
+    f Let { expDefs = [fd], expBody = body } | not (funcDefName fd `Set.member` funcTags (funcDefProps fd)), sizeLTE 1 nocc = ans where
+        (ne,nocc) = runWriter (c body)
+        ans = case nocc of
+            [] -> do
+                mtick $ "Optimize.let.omitted.{" ++ show (funcDefName fd)
+                return ne
+            [_] -> do
+                mtick $ "Optimize.let.inlined.{" ++ show (funcDefName fd)
+                return ne
+        c (App a xs _) | a == funcDefName fd = do
+            tell [a]
+            return $ Return (Tup xs) :>>= funcDefBody fd
+        c e@Let { expDefs = defs } | funcDefName fd `elem` map funcDefName defs = return e
+        c e = mapExpExp c e
hunk ./Grin/Simplify.hs 495
-    --caseHoist x as v as' ty | sizeLTE 1 (filter (\x -> x /= ReturnError && notReturnNode x ) (getReturnInfo (Case undefined as)))= do
-    caseHoist x as v as' ty | sizeLTE 1 (filter (== Nothing ) (Prelude.map (isManifestNode . lamExp) as))  = do
+    --caseHoist hexp v as' ty | sizeLTE 1 (filter (== Nothing ) (Prelude.map (isManifestNode . lamExp) as))  = do
+    caseHoist hexp v as' ty | sizeLTE 1 (filter (\x -> x /= ReturnError && notReturnNode x ) (getReturnInfo hexp))= do
hunk ./Grin/Simplify.hs 499
-        True <- return $ Set.null $ Set.intersection (freeVars nic) (freeVars (map lamBind as) :: Set.Set Var)
-        return $ modifyTail (v :-> nic) (Case x as) -- Case x [ b :-> e :>>= v :-> Case v as' | b :-> e <- as ]
-    caseHoist x as v as' ty | grinPhase grin >= PostDevolve  = do
+        --True <- return $ Set.null $ Set.intersection (freeVars nic) (freeVars (map lamBind as) :: Set.Set Var)
+        return $ modifyTail (v :-> nic) hexp -- Case x [ b :-> e :>>= v :-> Case v as' | b :-> e <- as ]
+    caseHoist hexp v as' ty | grinPhase grin >= PostDevolve  = do
hunk ./Grin/Simplify.hs 505
-            nbody = modifyTail (v :-> App fname [v] (getType $ Case v as')) (Case x as)
+            f e@(Return NodeC {}) = e :>>= v :-> Case v as'
+            f e@(Return Lit {}) = e :>>= v :-> Case v as'
+            f e = e :>>= v :-> App fname [v] ty
+            nbody = editTail ty f hexp -- (v :-> App fname [v] (getType $ Case v as')) (Case x as)
hunk ./Grin/Simplify.hs 511
-    caseHoist x as v as' ty = do
-       ras <- sequence [ f e >>= return . (b :->)| b :-> e <- as ]
-       mfc <- f (Case x as)
+    caseHoist hexp v as' ty = do
+       mfc <- f hexp
hunk ./Main.hs 787
+        x <- return $ normalizeGrin x
+        x <- devolveGrin x
+        x <- opt "After Devolve Optimization 2" x
+        x <- return $ normalizeGrin x
+        x <- devolveGrin x
hunk ./test/Primes.hs 10
-the_filter :: [Int] -> [Int]
-the_filter (n:ns) = filter (isdivs n) ns
+--the_filter :: [Int] -> [Int]
+--the_filter (n:ns) = filter (isdivs n) ns
hunk ./test/Primes.hs 13
-{-
hunk ./test/Primes.hs 18
--}