factorial

2026-08-17 23:44:26 -06:00
parent 745277ed1a
commit c4bcf38374
3 changed files with 161 additions and 19 deletions
@@ -12,7 +12,8 @@ import Data.Generics.Labels
 root :: IO TestTree
 root = pure . testGroup "stack machine" $
  [ lit_int
-  , arith
+  , procedure
+  , prims
  ]


@@ -29,22 +30,95 @@ lit_int = testCase "lit int" do
      , CallReg "ktail" [ValImm (ImmInt 3)]
      ]
    ]
-  
+
+procedure = testGroup "procedure"
+  [ testCase "return constant" do
+      evalsTo [ObjImm (ImmInt 123)]
+        [ MkBlock "main" []
+          [ CallLabel "silly" []
+          ]
+        , MkBlock "silly" []
+          [ PopCont "ktail"
+          , CallReg "ktail" [ValImm (ImmInt 123)]
+          ]
+        ]
+  , testCase "identity function" do
+      evalsTo [ObjImm (ImmInt 45)]
+        [ MkBlock "main" []
+          [ CallLabel "id" [ValImm (ImmInt 45)]
+          ]
+        , MkBlock "id" ["x"]
+          [ PopCont "ktail"
+          , CallReg "ktail" [ValReg "x"]
+          ]
+        ]
+  , testCase "square" do
+      evalsTo [ObjImm (ImmInt 16)]
+        [ MkBlock "main" []
+          [ CallLabel "square" [ValImm (ImmInt 4)]
+          ]
+        , MkBlock "square" ["x"]
+          [ PopCont "ktail"
+          , Prim "x2" $ PrimMul (ValReg "x") (ValReg "x")
+          , CallReg "ktail" [ValReg "x2"]
+          ]
+        ]
+  , testCase "factorial" do
+      let fac =
+            [ MkBlock "fac" ["n"]
+              [ Prim "x0" $ PrimZeroP (ValReg "n")
+              , If (ValReg "x0")
+                [ PopCont "ktail"
+                , CallReg "ktail" [ValImm (ImmInt 1)]
+                ]
+                [ Push (ValReg "n")
+                , Prim "x1" $ PrimSub (ValReg "n") (ValImm (ImmInt 1))
+                , PushCont "fac-k0"
+                , CallLabel "fac" [ValReg "x1"]
+                ]
+              ]
+            , MkBlock "fac-k0" ["x2"]
+              [ Pop "n"
+              , Prim "x3" $ PrimMul (ValReg "x2") (ValReg "n")
+              , PopCont "ktail"
+              , CallReg "ktail" [ValReg "x3"]
+              ]
+            ]
+      evalsTo [ObjImm (ImmInt 1)] $
+        [ MkBlock "main" []
+          [ CallLabel "fac" [ValImm (ImmInt 0)]
+          ]
+        ] ++ fac
+      evalsTo [ObjImm (ImmInt 720)] $
+        [ MkBlock "main" []
+          [ CallLabel "fac" [ValImm (ImmInt 6)]
+          ]
+        ] ++ fac
+  ]
+
+prims = testGroup "prims"
+  [ arith
+  , testCase "zero?" do
+      trivialPrimTest [ObjImm (ImmBool True)] $
+        PrimZeroP $ ValImm $ ImmInt 0
+      trivialPrimTest [ObjImm (ImmBool False)] $
+        PrimZeroP $ ValImm $ ImmInt 12
+  ]
+
+trivialPrimTest rs p =
+  evalsTo rs
+  [ MkBlock "main" []
+    [ PopCont "ktail"
+    , Prim "x1" p
+    , CallReg "ktail" [ValReg "x1"]
+    ]
+  ]
+
 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"]
-          ]
-        ]
+      trivialPrimTest [ObjImm (ImmInt 12)]
+        (PrimMul (ValImm $ ImmInt 3) (ValImm $ ImmInt 4))
  , testCase "subtract" do
-      evalsTo [ObjImm (ImmInt 14)]
-        [ MkBlock "main" []
-          [ PopCont "ktail"
-          , Prim "x1" (PrimSub (ValImm $ ImmInt 20) (ValImm $ ImmInt 6))
-          , CallReg "ktail" [ValReg "x1"]
-          ]
-        ]
+      trivialPrimTest [ObjImm (ImmInt 14)]
+        (PrimSub (ValImm $ ImmInt 20) (ValImm $ ImmInt 6))
  ]