[make eval inlining and node analysis aware of single argument applys, disable some optimizations that need to be reworked in the presence of single arg applys
John Meacham <john@repetae.net>**20070509121324] hunk ./C/FromGrin2.hs 311
+    declareStruct t
hunk ./Grin/DeadCode.hs 112
-            g (App a [e] _) | a == funcEval =  addRule (doNode e)
+            g (App a [e] _)   | a == funcEval =  addRule (doNode e)
hunk ./Grin/DeadCode.hs 114
+            g (App a [x] _)   | a == funcApply =  addRule (doNode x)
hunk ./Grin/EvalInline.hs 113
-    tagGood t | Just (n,fn) <- tagUnfunction t, n > 0 = let
-        ptag = argType == ts !! (length ts - n)
-        rtag = retType == TyNode || (n == 1 && rt == retType)
-        (ts,rt) = runIdentity $ findArgsType te fn
-        in rtag && ptag
+    tagGood t | Just TyTy { tyThunk = TyPApp mt w } <- findTyTy te t =
+         (Just argType == mt || (argType == tyUnit && Nothing == mt)) && (fmap snd $ findArgsType te w) == Just retType
hunk ./Grin/EvalInline.hs 116
+--    tagGood t | Just (n,fn) <- tagUnfunction t, n > 0 = let
+--        ptag = argType == ts !! (length ts - n)
+--        rtag = retType == TyNode || (n == 1 && rt == retType)
+--        (ts,rt) = runIdentity $ findArgsType te fn
+--        in rtag && ptag
hunk ./Grin/EvalInline.hs 125
-        g | n == 1 =  App fn (vs ++ [a2]) ty
-          | n > 1 = Return $ NodeC (partialTag fn (n - 1)) (vs ++ [a2])
+        a2s = if argType == tyUnit then [] else [a2]
+        g | n == 1 =  App fn (vs ++ a2s) ty
+          | n > 1 = Return $ NodeC (partialTag fn (n - 1)) (vs ++ a2s)
hunk ./Grin/EvalInline.hs 156
-                return (toAtom $ "@apply_" ++ show u)
+                return (toAtom $ "bapply_" ++ show u)
hunk ./Grin/EvalInline.hs 161
-                return (toAtom $ "@apply_" ++ show u)
+                return (toAtom $ "bapply_" ++ show u)
hunk ./Grin/NodeAnalyze.hs 30
-data NodeType = WHNF | LazyWHNF | Lazy
+
+
+data NodeType =
+    WHNF         -- ^ guarenteed to be a WHNF
+    | LazyWHNF   -- ^ WHNF or an indirection to a WHNF
+    | Lazy       -- ^ a suspension, a WHNF, or an indirection to a WHNF
hunk ./Grin/NodeAnalyze.hs 199
+        f (App { expFunction = fn, expArgs = [x], expType = ty }) | fn == funcApply = do
+            convertVal x
+            dunno ty
hunk ./Grin/NodeAnalyze.hs 250
+    convertVal (Const (NodeC t _)) = return $ Right (N WHNF (Only $ Set.singleton t))
hunk ./Grin/NodeAnalyze.hs 290
---    f a@App { expFunction = fn, expArgs = [afunc,what] } | fn == funcApply, Just n <- lupVar afunc = case n of
---        N WHNF set | [x] <- Set.toList set, Just (1,fn) <- tagUnfunction x -> do
---            putStrLn "NA-APPLY-KNOWN"
---            return (a { expFunction = fn, expArgs =
---        _ -> return a
hunk ./Grin/Optimize.hs 102
-    prefer (App fn [v@Var {},_] _)  | fn == funcApply = return v
+    prefer (App fn [v@Var {},_] _)| fn == funcApply = return v
+    prefer (App fn [v@Var {}] _)  | fn == funcApply = return v
hunk ./Grin/Simplify.hs 90
-    gs (App a [n@NodeC {},v] typ) | a == funcApply = do
-        lift $ tick stats at_OptSimplifyConstApply
-        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)
+--    gs (App a [n@NodeC {},v] typ) | a == funcApply = do
+--        lift $ tick stats at_OptSimplifyConstApply
+--        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 328
-    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
-        mtick "Optimize.optimize.return-apply"
-        f (Return t :>>= v :-> doApply Return True t a typ :>>= lr)
-    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
-        mtick "Optimize.optimize.return-apply"
-        f (Return t :>>= v :-> doApply Return True t a typ)
+--    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
+--        mtick "Optimize.optimize.return-apply"
+--        f (Return t :>>= v :-> doApply Return True t a typ :>>= lr)
+--    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
+--        mtick "Optimize.optimize.return-apply"
+--        f (Return t :>>= v :-> doApply Return True t a typ)
hunk ./Main.hs 727
+    wdump FD.GrinPreeval $ do
+        putErrLn "v-- Preeval Grin"
+        dumpGrin (optOutName options) "preeval" x
+        printGrin x
+        putErrLn "^-- Preeval Grin"