return, pushcall

test/Gyehoek/Test/Stack/VM.hs

@@ -7,6 +7,7 @@ import Gyehoek.Stack.Syntax
 import Gyehoek.Stack.VM qualified as Sut
 import Data.List (List)
 import Gyehoek.Jalmot
+import Gyehoek.Prelude (i)
 
 
 evalsTo :: List Obj -> Program -> Assertion
@@ -14,7 +15,7 @@ evalsTo rs p = runJalmotUnsafe (Sut.eval p) @?= rs
 
 test_root = testGroup "stack machine"
   [ testCase "immediate halt" do
-      evalsTo [ObjImm (ImmInt 3)] [stkP|
+      evalsTo [] [stkP|
         (define $start
           (return 0))
       |]
@@ -24,59 +25,89 @@ test_root = testGroup "stack machine"
           (push! 3)
           (return 1))
       |]
-  -- , testCase "return constant" do
-  --     evalsTo [ObjImm (ImmInt 123)] [stkP|
-  --       (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 ($start %ktail)
-  --         (tail-call $id 45 %ktail))
-  --       (define ($id %x %ktail)
-  --         (tail-call %ktail %x))
-  --     |]
-  -- , testCase "square" do
-  --     evalsTo [ObjImm (ImmInt 16)] [stkP|
-  --       (define ($start %ktail)
-  --         (tail-call $square 4 %ktail))
-  --       (define ($square %x %ktail)
-  --         (prim %x2 (* %x %x))
-  --         (tail-call %ktail %x2))
-  --     |]
-  -- , testCase "factorial" do
-  --     let hsfac (n :: Int) = foldr (*) (1) [1..n]
-  --     let fac (n :: Int) = [stkP|
-  --           (define ($fac %n %ktail)
-  --             (prim %x0 (zero? %n))
-  --             (if %x0
-  --               (then (tail-call %ktail 1))
-  --               (else (push! %n)
-  --                     (push! %ktail)
-  --                     (prim %x1 (- %n 1))
-  --                     (tail-call $fac %x1 $fac-k0))))
-  --           (define ($fac-k0 %x2)
-  --             (pop! %ktail)
-  --             (pop! %n)
-  --             (prim %x3 (* %x2 %n))
-  --             (tail-call %ktail %x3))
-  --           (define ($start %ktail)
-  --             (tail-call $fac #{n} %ktail))
-  --         |]
-  --     evalsTo [ObjImm (ImmInt 1)] $ fac 0
-  --     evalsTo [ObjImm (ImmInt 1)] $ fac 1
-  --     evalsTo [ObjImm (ImmInt 720)] $ fac 6
-  --     -- 20 is the greatest `n` for which n! ≤ maxBount @Int
-  --     evalsTo [ObjImm (ImmInt 2432902008176640000)] $ fac 20
+  , testCase "non-tail identity function" do
+      evalsTo [ObjImm (ImmInt 123)] [stkP|
+        (define $id
+          (return 1))
+        (define $c
+          (return 1))
+        (define $start
+          (push! $c)
+          (push! $id)
+          (push! 123)
+          (call 1))
+      |]
+  , testCase "tail identity function" do
+      evalsTo [ObjImm (ImmInt 123)] [stkP|
+        (define $id
+          (return 1))
+        (define $start
+          (push! $id)
+          (push! 123)
+          (tail-call 1))
+      |]
+  , testCase "return constant" do
+      evalsTo [ObjImm (ImmInt 123)] [stkP|
+        (define $start
+          (push! $silly)
+          (tail-call 1))
+        (define $silly
+          (push! 123)
+          (return 1))
+      |]
+  , testCase "return multiple" do
+      evalsTo [ObjImm (ImmInt n) | n <- [1,2,3]] [stkP|
+        (define $start
+          (push! 3)
+          (push! 2)
+          (push! 1)
+          (return 3))
+      |]
+  , testCase "return none" do
+      evalsTo [] [stkP|
+        (define $start
+          (return 0))
+      |]
+  , testCase "square" do
+      evalsTo [ObjImm (ImmInt 16)] [stkP|
+        (define $start
+          (push! $square)
+          (push! 4)
+          (tail-call 1))
+        (define $square
+          (pop! %x)
+          (prim %x2 (* %x %x))
+          (push! %x2)
+          (return 1))
+      |]
+  , testGroup "factorial"
+      let
+        hsfac (n :: Int) = foldr @List (*) 1 [1..n]
+        fac (n :: Int) = [stkP|
+          (define $start
+            (push! $fac)
+            (push! #{n})
+            (tail-call 1))
+          (define $fac
+            (load %n 0)
+            (prim %x0 (zero? %n))
+            (if %x0
+                (then (push! 1)
+                      (return 1))
+                (else (prim %x1 (- %n 1))
+                      (push! $fac-c0)
+                      (push! $fac)
+                      (push! %x1)
+                      (call 1))))
+          (define $fac-c0
+            (pop! %x2)
+            (pop! %n)
+            (prim %x3 (* %n %x2))
+            (push! %x3)
+            (return 1))
+      |]
+        mkcase n = testCase [i|#{n}|] do
+          evalsTo [ObjImm . ImmInt $ hsfac n] $ fac n
+      -- 20 is the greatest `n` for which n! ≤ maxBount @Int
+      in [ mkcase n | n <- [0,1,6,20] ]
   ]