[include a context continuation when simplifying
John Meacham <john@repetae.net>**20061129055011] hunk ./E/SSimplify.hs 19
+import Debug.Trace
hunk ./E/SSimplify.hs 349
-susp e sub =  Susp e sub undefined -- (substMap'' (fmap mkSubst sub) e)
+susp e sub =  Susp e sub Unknown -- (substMap'' (fmap mkSubst sub) e)
hunk ./E/SSimplify.hs 358
+insertRange 0 e env = env
+insertRange t e env = cacheSubst env { envSubst = minsert t e (envSubst env) }
+
hunk ./E/SSimplify.hs 387
+evalRange :: Range -> SM OutE
+evalRange (Done e) = return e
+evalRange (Susp e s _) = localEnv (envSubst_s s)  $ dosub e
hunk ./E/SSimplify.hs 393
+dosub :: InE -> SM OutE
hunk ./E/SSimplify.hs 417
+data Cont =
+    ApplyTo {
+        contArg  :: Range,
+        contNext :: Cont
+        }
+    | LazyContext TVr  -- the RHS of a let statement
+    | StartContext
+    | ArgContext
+    | Scrutinee {
+        contExamined :: Bool  -- ^ whether the result is actually examined, or just bound to a variable
+        }
+    deriving(Show)
hunk ./E/SSimplify.hs 430
+isApplyTo ApplyTo {} = True
+isApplyTo _ = False
hunk ./E/SSimplify.hs 454
-        localEnv (envSubst_s mempty) $ f e'
-    f :: InE -> SM OutE
-    f e | (ELam t b,(x:xs)) <- fromAp e = do
+        localEnv (envSubst_s mempty) $ f StartContext e'
+    --mtick a = Stats.mtick $ trace (show a) a
+    f :: Cont -> InE -> SM OutE
+    --f cont e | trace (take 20 (show cont) ++ " - " ++ take 40 (show e)) False = undefined
+    f ArgContext e = dosub e
+    f c (EAp a b) = do
+        sub <- asks envSubst
+        f ApplyTo { contArg = susp b sub, contNext = c } a
+    f (ApplyTo rng cont) (ELam t b) = do
hunk ./E/SSimplify.hs 464
-        xs' <- mapM dosub xs
-        b' <- localEnv (insertSuspSubst t x) $ f b
hunk ./E/SSimplify.hs 465
-        h b' xs'
-    f e| (EPi t b,(x:xs)) <- fromAp e = do
+        localEnv (insertRange (tvrIdent t) rng) $ f cont b
+    f (ApplyTo rng cont) (EPi t b) = do
hunk ./E/SSimplify.hs 468
-        xs' <- mapM dosub xs
-        b' <- localEnv (insertSuspSubst t x) $ f b
hunk ./E/SSimplify.hs 469
-        h b' xs'
-    f e | (EVar v,xs) <- fromAp e = do
-        xs' <- mapM dosub xs
+        localEnv (insertRange (tvrIdent t) rng) $ f cont b
+    f cont (EVar v) = do
hunk ./E/SSimplify.hs 473
-            Just (Done e) -> h e xs'   -- e is var or trivial
-            Just (Susp e s _) -> do
-                e' <- localEnv (envSubst_s s)  $ f e
-                h e' xs'
-            Nothing -> h (EVar v) xs'
-    f e | (x,xs) <- fromAp e = do
-        eed <- etaExpandDef (so_dataTable sopts) 0 tvr { tvrIdent = 0 } e
-        case eed of
-            Just (_,e) -> f e
-            Nothing -> do
-                xs' <- mapM dosub xs
-                x' <- g x
+            Just (Done e) -> done cont e
+            Just (Susp e s _) -> localEnv (envSubst_s s)  $ f cont e
+            Nothing -> done cont (EVar v)
+
+    f cont e | isApplyTo cont = els
+             | otherwise = tryEta
+            where
+            els = do
+                x' <- g e
hunk ./E/SSimplify.hs 484
-                h x xs'
+                done cont x
+            tryEta = do
+                eed <- etaExpandDef (so_dataTable sopts) 0 tvr { tvrIdent = 0 } e
+                case eed of
+                    Just (_,e) -> f cont e
+                    Nothing -> els
+
+    g :: InE -> SM OutE
+    --g e | trace ("g: " ++ take 20 (show e)) False = undefined
hunk ./E/SSimplify.hs 494
-    g (ELit lc@LitCons { litName = n, litArgs = es, litType = t }) = do
-        es' <- mapM dosub es
-        t' <- dosub t
-        return $ ELit lc { litArgs = es', litType = t' }
-    g (ELit (LitInt n t)) = do
-        t' <- dosub t
-        return $ ELit (LitInt n t')
-    g e@(EPi (TVr { tvrIdent = n }) b) = do
+    g e@ELit {} = dosub e
+    g e@(EPi (TVr { tvrIdent = n }) _) = do
hunk ./E/SSimplify.hs 502
-        e' <- f e
+        e' <- f (Scrutinee False) e
hunk ./E/SSimplify.hs 507
-        e' <- localEnv (insertDoneSubst v (EVar v') . insertInScope (tvrIdent v') NotKnown) $ f e
+        e' <- localEnv (insertDoneSubst v (EVar v') . insertInScope (tvrIdent v') NotKnown) $ f StartContext e
hunk ./E/SSimplify.hs 511
-        e' <- localEnv (const inb') $ f e
+        e' <- localEnv (const inb') $ f StartContext e
hunk ./E/SSimplify.hs 598
-        d' <- localEnv (insertDoneSubst b (EVar b') . (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e))) $ f d
+        d' <- localEnv (insertDoneSubst b (EVar b') . (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e))) $ f StartContext d
hunk ./E/SSimplify.hs 603
-        d' <- localEnv (insertDoneSubst b (EVar b') . (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e))) $ f d
+        d' <- localEnv (insertDoneSubst b (EVar b') . (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e))) $ f StartContext d
hunk ./E/SSimplify.hs 608
-        localEnv (insertDoneSubst b e) $ f d
+        localEnv (insertDoneSubst b e) $ f StartContext d
hunk ./E/SSimplify.hs 633
-        let dd e' = localEnv (const $ ids $ envInScope_u (newinb `union`) inb) $ f e' where
+        let dd e' = localEnv (const $ ids $ envInScope_u (newinb `union`) inb) $ f StartContext e' where
hunk ./E/SSimplify.hs 639
-                e' <- localEnv (ids . mins e (patToLitEE p')) $ f ae
+                e' <- localEnv (ids . mins e (patToLitEE p')) $ f StartContext ae
hunk ./E/SSimplify.hs 647
-                e' <- localEnv (const $ ids $ substAddList nsub (envInScope_u (ninb `union`) $ mins e (patToLitEE p') inb)) $ f ae
+                e' <- localEnv (const $ ids $ substAddList nsub (envInScope_u (ninb `union`) $ mins e (patToLitEE p') inb)) $ f StartContext ae
hunk ./E/SSimplify.hs 678
-                e' <- localEnv (const $ substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] $ envInScope_u (fromList [ (n,isBoundTo noUseInfo e) | (e,_,TVr { tvrIdent = n }) <- binds] `union`) inb) $ f e
+                e' <- localEnv (const $ substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] $ envInScope_u (fromList [ (n,isBoundTo noUseInfo e) | (e,_,TVr { tvrIdent = n }) <- binds] `union`) inb) $ f StartContext e
hunk ./E/SSimplify.hs 711
+    done cont e = z cont [] where
+        z (ApplyTo r cont') rs = evalRange r >>= \a -> z cont' (a:rs)
+        z _ rs = h e (reverse rs)
hunk ./E/SSimplify.hs 824
-                e' <- localEnv (const inb') $ f e
+                e' <- localEnv (const inb') $ f (LazyContext t') e