wip: abstract stack/continuation machine

2026-08-17 22:31:45 -06:00
parent c3c4866fa8
commit 745277ed1a
16 changed files with 723 additions and 22 deletions
@@ -0,0 +1,50 @@
+module Gyehoek.Test.Stack.VM (root) where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit
+import Gyehoek.Stack.Syntax
+import Gyehoek.Stack.VM qualified as Sut
+import Data.List (List)
+import Control.Lens
+import Data.Generics.Labels
+
+
+root :: IO TestTree
+root = pure . testGroup "stack machine" $
+  [ lit_int
+  , arith
+  ]
+
+
+
+evalsTo :: List Obj -> List Block -> Assertion
+evalsTo rs bs = Sut.eval (MkProgram bs) @?= rs
+
+
+
+lit_int = testCase "lit int" do
+  evalsTo [ObjImm (ImmInt 3)]
+    [ MkBlock "main" []
+      [ PopCont "ktail"
+      , CallReg "ktail" [ValImm (ImmInt 3)]
+      ]
+    ]
+  
+arith = testGroup "arith"
+  [ testCase "multipy" do
+      evalsTo [ObjImm (ImmInt 12)]
+        [ MkBlock "main" []
+          [ PopCont "ktail"
+          , Prim "x1" (PrimMul (ValImm $ ImmInt 3) (ValImm $ ImmInt 4))
+          , CallReg "ktail" [ValReg "x1"]
+          ]
+        ]
+  , testCase "subtract" do
+      evalsTo [ObjImm (ImmInt 14)]
+        [ MkBlock "main" []
+          [ PopCont "ktail"
+          , Prim "x1" (PrimSub (ValImm $ ImmInt 20) (ValImm $ ImmInt 6))
+          , CallReg "ktail" [ValReg "x1"]
+          ]
+        ]
+  ]