[add switching update mode to eval inlining
John Meacham <john@repetae.net>**20051025051042] hunk ./FlagDump.flags 44
+grin-posteval show grin code just before eval/apply inlining
hunk ./Grin/EvalInline.hs 41
+    | SwitchingUpdate sts <- shared = let
+            lf = createEval NoUpdate te ts
+            cu t | tagIsTag t && tagIsWHNF t = return ans where
+                (ts,_) = runIdentity $ findArgsType te t
+                vs = [ Var v ty |  v <- [V 4 .. ] | ty <- ts]
+                ans = NodeC t vs :-> Update p1 (NodeC t vs)
+            cu t = error $ "not updatable:" ++ show t
+        in (p1 :-> (Return p1 :>>= lf) :>>= n3 :-> Case n3 (concatMap cu sts) :>>= unit :-> Return n3)
hunk ./Grin/PointsToAnalysis.hs 302
-        g (App a [vr@(Var v _)] _ :>>= node@(NodeC {}) :-> e) | a == funcEval = do
-                mtick "Grin.eval.hoisted2"
-                e' <- g e
-                return $ (Return vr :>>= createEval (HoistedUpdate node) typeEnv (tagsp v)) :>>= node :-> e'
-        --g (App a [vr@(Var v _)] _ :>>= Var r _ :-> _ )
-        --    | a == funcEval = Return vr :>>= createEval (SwitchingUpdate ) typeEnv (tagsp v)
+        --g (App a [vr@(Var v _)] _ :>>= vb :-> Case vb' rs :>>= rl ) | vb == vb', a == funcEval = trailingCase vr vb rs (Just rl)
+        --g (App a [vr@(Var v _)] _ :>>= vb :-> Case vb' rs ) | vb == vb', a == funcEval = trailingCase vr vb rs Nothing
+        g (App a [vr@(Var v _)] _ :>>= vb@(Var vbv _) :-> e) | a == funcEval = do
+                let Just stags = tags vbv
+                case stags of
+                    [] ->  return $ (Return vr :>>= createEval NoUpdate typeEnv (tagsp v)) :>>= vb :-> Error "Update: no alternatives" (getType e)
+                    [t] -> do
+                        e' <- g e
+                        mtick "Grin.eval.hoisted2"
+                        let node = NodeC t vs
+                            (ts,_) = runIdentity $ findArgsType typeEnv t
+                            vs = [ Var v ty |  v <- [V 4 .. ] | ty <- ts]
+                        return $ (Return vr :>>= createEval (HoistedUpdate node) typeEnv (tagsp v)) :>>= vb :-> e'
+                    _ -> do
+                        e' <- g e
+                        mtick "Grin.eval.switched"
+                        return $ (Return vr :>>= createEval (SwitchingUpdate stags) typeEnv (tagsp v)) :>>= vb :-> e'
hunk ./Grin/PointsToAnalysis.hs 334
+        {-
+        trailingCase vr@Var {expVar = v} vb rs rl = do
+                mtick "Grin.eval.case"
+                rl' <- fmapM f rl
+                let eval = createEval NoUpdate typeEnv (tagsp v)
+                    rs' = [  l :-> rs ]
+                g (Case vb rs)
+                return $ (Return vr :>>= eval) :>>= vb :-> Return vb' :>>= node :-> e'
+
+        g (App a [vr@(Var v _)] _ :>>= vb :-> Return vb' :>>= node@(NodeC {}) :-> e) | vb == vb', a == funcEval = do
+                mtick "Grin.eval.hoisted"
+                e' <- g e
+                return $ (Return vr :>>= createEval (HoistedUpdate node) typeEnv (tagsp v)) :>>= vb :-> Return vb' :>>= node :-> e'
+                -}
+
hunk ./Main.hs 426
-    wdump FD.GrinPreeval $ printGrin x
+    wdump FD.GrinPosteval $ printGrin x