pass continuations as arguments, use normal stack

test/Gyehoek/Test/CPS/Eval.hs

@@ -34,8 +34,8 @@ test_cpsInterpreter = testGroup "cps interpreter" $
       |]
   ]
 
-evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
-evalsTo rs p = Sut.evalProgram p @?= rs
+evalsTo :: HasCallStack => List Obj -> Sut.Exp -> Assertion
+evalsTo rs e = Sut.evalExp e @?= rs
 
 primitives = testGroup "primitives"
   [ testGroup "arith"

test/Gyehoek/Test/CPS/Stackify.hs

@@ -4,10 +4,11 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit
 import qualified Gyehoek.CPS.Stackify as Sut
 import Gyehoek.Stack.VM as Stk
-import Data.List (List)
 import Gyehoek.CPS.Syntax (cps)
+import Gyehoek.CPS.Syntax qualified as CPS
 import Gyehoek.GenSym (runGenSym)
 import Effectful
+import Gyehoek.Prelude
 
 
 test_stackify =
@@ -19,9 +20,11 @@ test_stackify =
   ]
 
 evalsTo :: List Obj -> Sut.Exp -> Assertion
-evalsTo rs e =
-  Stk.eval e' @?= rs
-  where e' = runPureEff . runGenSym $ Sut.stackifyExp "main" e
+evalsTo rs e = Stk.eval e' @?= rs
+  where
+    e' = e & CPS.MkLambda [] "_ktail"
+      & CPS.MkProgram
+      & Sut.stackifyProgram & runGenSym & runPureEff
 
 trivialReturn = testGroup "trivial return"
   [ testCase "return int" do

test/Gyehoek/Test/CPS/Syntax.hs

@@ -28,15 +28,20 @@ free = testGroup "free"
 qq :: TestTree
 qq = testGroup "parser"
   [ testCase "lambda" do
-      assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
-               (Sut.ExpContinue (Sut.ValLabel "ktail") [Sut.ValVar "x"]))
+      assertEqual ""
+        (Sut.MkLambda ["x","y"] "ktail"
+         (Sut.ExpContinue (Sut.ValVar "ktail") [Sut.ValVar "x"]))
         [cps|(λ (x y ktail) (continue ktail x))|]
-      assertEqual "" (Sut.MkLambda [] "ktail"
-               (Sut.ExpContinue (Sut.ValLabel "ktail") [Sut.ValVar "x"]))
+      assertEqual ""
+        (Sut.MkLambda [] "ktail"
+         (Sut.ExpContinue (Sut.ValVar "ktail") [Sut.ValVar "x"]))
         [cps|(λ (ktail) (continue ktail x))|]
   , testCase "kappa" do
-      assertEqual "" (Sut.MkKappa ["x","y"]
-               (Sut.ExpContinue (Sut.ValLabel "k123") [Sut.ValVar "x", Sut.ValVar "y"]))
+      assertEqual ""
+        (Sut.MkKappa ["x","y"]
+         (Sut.ExpContinue
+          (Sut.ValVar "k123")
+          [Sut.ValVar "x", Sut.ValVar "y"]))
         [cps|(κ (x y) (continue k123 x y))|]
   , testCase "application" do
       assertEqual "" (Sut.ExpApply (Sut.ValVar "f")

test/Gyehoek/Test/Stack/VM.hs

@@ -14,58 +14,58 @@ evalsTo rs p = Sut.eval p @?= rs
 test_root = testGroup "stack machine"
   [ testCase "lit int" do
       evalsTo [ObjImm (ImmInt 3)] [stkP|
-        (define ($main)
-          (pop-cont! %ktail)
+        (define ($start %ktail)
           (tail-call %ktail 3))
       |]
   , testCase "return constant" do
       evalsTo [ObjImm (ImmInt 123)] [stkP|
-        (define ($main)
-          (tail-call $silly))
-        (define ($silly)
-          (pop-cont! %ktail)
+        (define ($start %ktail)
+          (tail-call $silly %ktail))
+        (define ($silly %ktail)
           (tail-call %ktail 123))
       |]
+  , testCase "identity continuation" do
+      evalsTo [ObjImm (ImmInt 45)] [stkP|
+        (define ($start %ktail)
+          (push! %ktail)
+          (tail-call $id 45))
+        (define ($id %x)
+          (pop! %ktail)
+          (tail-call %ktail %x))
+      |]
   , testCase "identity function" do
       evalsTo [ObjImm (ImmInt 45)] [stkP|
-        (define ($main)
-          (tail-call $id 45))
-        (define ($id %x)
-          (pop-cont! %ktail)
+        (define ($start %ktail)
+          (tail-call $id 45 %ktail))
+        (define ($id %x %ktail)
           (tail-call %ktail %x))
       |]
-  -- , testCase "square" do
-  --     evalsTo [ObjImm (ImmInt 16)] [stkP|
-  --       (define ($main))
-  --     |]
   , testCase "square" do
       evalsTo [ObjImm (ImmInt 16)] [stkP|
-        (define ($main)
-          (tail-call $square 4))
-        (define ($square %x)
+        (define ($start %ktail)
+          (tail-call $square 4 %ktail))
+        (define ($square %x %ktail)
           (prim %x2 (* %x %x))
-          (pop-cont! %ktail)
           (tail-call %ktail %x2))
       |]
   , testCase "factorial" do
       let hsfac (n :: Int) = foldr (*) (1) [1..n]
       let fac (n :: Int) = [stkP|
-            (define ($fac %n)
+            (define ($fac %n %ktail)
               (prim %x0 (zero? %n))
               (if %x0
-                (then (pop-cont! %ktail)
-                      (tail-call %ktail 1))
+                (then (tail-call %ktail 1))
                 (else (push! %n)
+                      (push! %ktail)
                       (prim %x1 (- %n 1))
-                      (push-cont! $fac-k0)
-                      (tail-call $fac %x1))))
+                      (tail-call $fac %x1 $fac-k0))))
             (define ($fac-k0 %x2)
+              (pop! %ktail)
               (pop! %n)
               (prim %x3 (* %x2 %n))
-              (pop-cont! %ktail)
               (tail-call %ktail %x3))
-            (define ($main)
-              (tail-call $fac #{n}))
+            (define ($start %ktail)
+              (tail-call $fac #{n} %ktail))
           |]
       evalsTo [ObjImm (ImmInt 1)] $ fac 0
       evalsTo [ObjImm (ImmInt 1)] $ fac 1