src/Gyehoek/CPS/Convert.hs

@@ -109,8 +109,10 @@ convertLambda bs m = do
   pure [cps|(λ (##{bs} #{ktail}) #{m'})|]
 
 convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program
-convertProgram p =
-  MkProgram <$> telescope (convert @es) (p ^.. each . _Left) (pure . Halt)
+convertProgram p = do
+  let nothalt = ExpContinue (ValVar "main-ktail")
+  e <- telescope (convert @es) (p ^.. each . _Left) (pure . nothalt)
+  _
 
 convertExp :: forall es. (GenSym :> es) => Scm.Exp -> Eff es Exp
 convertExp e = convert e (pure . Halt1)

src/Gyehoek/CPS/Stackify.hs

@@ -69,27 +69,15 @@ stackify g (ExpIf c t f) = do
   pure . Tail $ Stk.If c' t' f'
 
 stackify g (ExpApply f xs ktail) = pure $
-    Code [ Stk.PushCont k ] $
     Code [ Stk.Push (Stk.ValReg l) | l <- ls ] $
-    Tail (Stk.TailCall (stackifyVal g f) (stackifyVal g <$> xs))
+    Tail (Stk.PushCall k (stackifyVal g f) (stackifyVal g <$> xs))
   where
     k = var g ktail
     ls = fold $ (k ^? #ValImm . #ImmLabel)
       >>= \klbl -> g ^. #liveness . at klbl
 
 stackify g (ExpContinue k xs) =
-  -- return continuations require popping the stack. how do we know
-  -- when a continuation is a return continuation? is this a correct
-  -- test?
-  case elemIndex k g.contStack of
-    Nothing -> pure . Tail $ Stk.TailCall (Stk.ValLabel k) xs'
-    Just j -> do
-      ktail <- gensym' @Name $ k ^. _Wrapped'
-      pure $
-        Code (replicate j $ Stk.PopCont "_") $
-        Code [Stk.PopCont ktail] $
-        Tail (Stk.TailCall (Stk.ValReg ktail) xs')
-  where xs' = stackifyVal g <$> xs
+  pure . Tail $ Stk.TailCall (stackifyVal g k) (stackifyVal g <$> xs)
 
 stackify g (ExpPrim p (MkKappa [x] e)) = do
   e' <- stackify (g & #bound . at x ?~ Stk.ValReg x) e

src/Gyehoek/Stack/Lower.hs

@@ -16,9 +16,9 @@ lowerBlock = _
 
 lowerInstr :: Instr -> Wasm.Expr
 lowerInstr = \case
-  PopCont ktail -> [wat|
+  -- PopCont ktail -> [wat|
     
-  |]
+  -- |]
 
 lowerProgram :: Program -> Eff es Wasm.Module
 lowerProgram p = pure [watM|

src/Gyehoek/Stack/Syntax.hs

@@ -60,6 +60,7 @@ data Block = MkBlock
 
 data Tail
   = TailCall Val (List Val)
+  | PushCall Val Val (List Val)
   | If Val Block Block
   deriving stock (Show, Generic, Data)
   deriving anyclass (NFData)
@@ -67,8 +68,6 @@ data Tail
 data Instr
   = Pop Name
   | Push Val
-  | PopCont Name
-  | PushCont Val
   | Prim Name (Prim Val)
   deriving stock (Show, Generic, Data)
   deriving anyclass (NFData)
@@ -91,8 +90,6 @@ instance S.DatumIso Instr where
   datumIso = S.match
     $ S.With (S.headTagged1 "pop!" regName >>>)
     $ S.With (S.headTagged1 "push!" S.datumIso >>>)
-    $ S.With (S.headTagged1 "pop-cont!" regName >>>)
-    $ S.With (S.headTagged1 "push-cont!" S.datumIso >>>)
     $ S.With (S.headTagged2 "prim" regName S.datumIso >>>)
     $ S.End
     where
@@ -108,6 +105,7 @@ instance S.DataIso Block where
 instance S.DatumIso Tail where
   datumIso = S.match
     $ S.With (S.headTagged1' "tail-call" S.datumIso S.datumIso >>>)
+    $ S.With (S.headTagged2' "push-call" S.datumIso S.datumIso S.datumIso >>>)
     $ S.With (if_ >>>)
     $ S.End
     where

src/Gyehoek/Stack/VM.hs

@@ -17,7 +17,6 @@ import Gyehoek.Prelude
 
 data VM = MkVM
   { stack :: List Obj
-  , kstack :: List Name
   , code :: List Instr
   , tail :: Tail
   , registers :: HashMap Name Obj
@@ -40,8 +39,6 @@ stepI :: Env -> VM -> Instr -> VM
 
 stepI e vm (Push v) = vm & #stack %~ (evalVal e vm v :)
 
-stepI e vm (PushCont k) = vm & #kstack %~ (evalToLabel e vm k :)
-
 stepI e vm (Prim r p) = case evalVal e vm <$> p of
   PrimZeroP x -> case x of
     ObjImm (ImmInt n) -> ret . ObjImm . ImmBool $ n == 0
@@ -74,11 +71,6 @@ stepI e vm (Pop r) = case vm ^. #stack of
   (x:xs) -> vm & #registers . at r ?~ x
                & #stack .~ xs
 
-stepI e vm ins@(PopCont r) = case vm ^. #kstack of
-  [] -> error [i|empty cont stack: #{ins}|]
-  (x:xs) -> vm & #registers . at r ?~ ObjImm (ImmLabel x)
-               & #kstack .~ xs
-
 stepI e vm ins = error [i|unimplemented instruction: #{ins}|]
 
 stepT :: Env -> VM -> Tail -> VM
@@ -95,6 +87,9 @@ stepT g vm (TailCall f xs) =
           Nothing -> error [i|undefined label: #{l}|]
           Just x -> x
 
+stepT g vm (PushCall k f xs) =
+  _
+
 stepT g vm (If c t f) = vm & #code .~ branch.code & #tail .~ branch.tail
   where
     branch = case evalVal g vm c of
@@ -116,9 +111,8 @@ evalVal e vm = \case
 initialVM :: VM
 initialVM = MkVM
   { stack = []
-  , kstack = ["halt"]
   , code = []
-  , tail = TailCall (ValLabel "main") []
+  , tail = TailCall (ValLabel "main") [ValLabel "ktail"]
   , registers = mempty
   , stdout = ""
   , result = Nothing