[add const-lazy-apply optimization
John Meacham <john@repetae.net>**20060421074855] hunk ./Grin/Simplify.hs 3
+import Char
hunk ./Grin/Simplify.hs 85
-        gs (doApply n v typ)
+        gs (doApply Return True n v typ)
+    gs (Store (NodeC t [Const x@NodeC {},y])) | Just 1 <- fromBap t = do --  App a [n@NodeC {},v] typ) | a == funcApply = do
+        lift $ tick stats "Optimize.simplify.const-lazy-apply"
+        gs (doApply Store False x y TyNode)
hunk ./Grin/Simplify.hs 175
-doApply (NodeC t xs) y typ | Just (n,v) <- tagUnfunction t = case n of
-    1 -> (App v (xs ++ [y]) typ)
-    _ -> Return (NodeC (partialTag v (n - 1)) (xs ++ [y]))
-doApply n y typ = error $ show ("doApply", n,y,typ)
+doApply ret strict (NodeC t xs) y typ | Just (n,v) <- tagUnfunction t = case n of
+    1 | strict -> (App v (xs ++ [y]) typ)
+    _ -> ret (NodeC (partialTag v (n - 1)) (xs ++ [y]))
+doApply _ _ n y typ = error $ show ("doApply", n,y,typ)
hunk ./Grin/Simplify.hs 186
+fromBap :: Monad m => Atom -> m Int
+fromBap t | 'B':'a':'p':'_':(n:ns) <- toString t, isDigit n = return $ read (n:takeWhile isDigit ns)
+fromBap t = fail "not Bap"
+
hunk ./Grin/Simplify.hs 304
-        f (Return t :>>= v :-> doApply t a typ :>>= lr)
+        f (Return t :>>= v :-> doApply Return True t a typ :>>= lr)
hunk ./Grin/Simplify.hs 307
-        f (Return t :>>= v :-> doApply t a typ)
+        f (Return t :>>= v :-> doApply Return True t a typ)