wip: abstract stack/continuation machine

test/Gyehoek/Test/Stack/VM.hs

@@ -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"]
+          ]
+        ]
+  ]

test/Main.hs

@@ -5,6 +5,7 @@ import Test.Tasty.Silver.Interactive (defaultMain)
 import qualified Gyehoek.Test.Golden
 import qualified Gyehoek.Test.Sexp
 import qualified Gyehoek.Test.CPS.Syntax
+import qualified Gyehoek.Test.Stack.VM
 
 
 main :: IO ()
@@ -12,8 +13,9 @@ main = defaultMain =<< root
 
 root :: IO TestTree
 root = testGroup "test" <$> sequenceA
-  [ Gyehoek.Test.Golden.root
-  , Gyehoek.Test.Sexp.root
+  [ {- Gyehoek.Test.Golden.root
+  ,-} Gyehoek.Test.Sexp.root
   , Gyehoek.Test.CPS.Syntax.root
+  , Gyehoek.Test.Stack.VM.root
   ]