cli, cps interpreter, stack vm, closure-conversion, fixes, tests, LOL

2026-08-20 01:05:16 -06:00
parent 94b1a5fb45
commit c5f9bf1850
23 changed files with 587 additions and 99 deletions
@@ -0,0 +1,56 @@
+module Gyehoek.Test.CPS.Eval (root) where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit
+import Language.SexpGrammar ()
+import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
+import Gyehoek.CPS.Eval qualified as Sut
+import Data.List (List)
+
+
+root :: IO TestTree
+root = pure . testGroup "cps interpreter" $
+  [ prim
+  , testCase "halt with constant" do
+      evalsTo [ObjImm (ImmInt 123)] [cps|
+        (continue halt 123)
+      |]
+  , testCase "identity cont" do
+      evalsTo [ObjImm (ImmInt 154)] [cps|
+        (letrec ((id (κ (x)
+                       (continue halt x))))
+          (continue id 154))
+      |]
+  , testCase "identity function" do
+      evalsTo [ObjImm (ImmInt 456)] [cps|
+        (letrec ((id (λ (x ktail)
+                       (continue ktail x))))
+          (id 456 halt))
+      |]
+  , testCase "square" do
+      evalsTo [ObjImm (ImmInt 81)] [cps|
+        (letrec ((square (λ (x ktail)
+                           (prim (* x x)
+                             (κ (r) (continue ktail r))))))
+          (square 9 halt))
+      |]
+  ]
+
+evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
+evalsTo rs p = Sut.evalProgram p @?= rs
+
+prim = testGroup "primitives"
+  [ testGroup "arith"
+    [ testCase "basic 1" do
+        evalsTo [ObjImm (ImmInt 20)] [cps|
+          (prim (* 4 5)
+            (κ (x) (continue halt x)))
+          |]
+    , testCase "basic 2" do
+        evalsTo [ObjImm (ImmInt 35)] [cps|
+          (prim (* 2 16)
+            (κ (x) (prim (+ x 3)
+                      (κ (r) (continue halt r)))))
+          |]
+    ]
+  ]