ughhh evaluate cps

2026-09-05 20:22:07 -06:00
parent ba5dc401d9
commit 9f37d10e4f
12 changed files with 340 additions and 145 deletions
@@ -10,86 +10,87 @@ import Gyehoek.GenSym (runGenSym)
 import Effectful
 import Gyehoek.Prelude
 import Gyehoek.Jalmot
+import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)


-test_stackify =
-  [ trivialReturn
-  , tailCall
-  , prim
-  , condition
-  , procedure
-  ]
+-- test_stackify =
+--   [ trivialReturn
+--   , tailCall
+--   , prim
+--   , condition
+--   , procedure
+--   ]

-evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
-evalsTo rs e = runJalmotUnsafe (Stk.eval e') @?= rs
-  where
-    e' = e & Sut.stackifyProgram & runGenSym & runPureEff
+-- evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
+-- evalsTo rs e = runJalmotUnsafe (Stk.eval e') @?= rs
+--   where
+--     e' = e & Sut.stackifyProgram & runGenSym & runPureEff

-trivialReturn = testGroup "trivial return"
-  [ testCase "return int" do
-      evalsTo [ObjImm (ImmInt 4)]
-        [cps|(λ (ktail) (continue ktail 4))|]
-  , testCase "return bool" do
-      evalsTo [ObjImm (ImmBool True)]
-        [cps|(λ (ktail) (continue ktail #t))|]
-      evalsTo [ObjImm (ImmBool False)]
-        [cps|(λ (ktail) (continue ktail #f))|]
-  ]
+-- trivialReturn = testGroup "trivial return"
+--   [ testCase "return int" do
+--       evalsTo [ObjImm (ImmInt 4)]
+--         [cps|(λ (ktail) (continue ktail 4))|]
+--   , testCase "return bool" do
+--       evalsTo [ObjImm (ImmBool True)]
+--         [cps|(λ (ktail) (continue ktail #t))|]
+--       evalsTo [ObjImm (ImmBool False)]
+--         [cps|(λ (ktail) (continue ktail #f))|]
+--   ]

-tailCall = testGroup "tail call"
-  [ testCase "square" do
-      evalsTo [ObjImm (ImmInt 16)] [cps|
-        (λ (ktail0)
-          (letrec ((square (λ (x ktail)
-                             (prim (* x x)
-                               (κ (x0) (continue ktail x0))))))
-            (square 4 halt)))
-      |]
-  ]
+-- tailCall = testGroup "tail call"
+--   [ testCase "square" do
+--       evalsTo [ObjImm (ImmInt 16)] [cps|
+--         (λ (ktail0)
+--           (letrec ((square (λ (x ktail)
+--                              (prim (* x x)
+--                                (κ (x0) (continue ktail x0))))))
+--             (square 4 halt)))
+--       |]
+--   ]

-prim = testGroup "prim"
-  [ testCase "multiply" do
-      evalsTo [ObjImm (ImmInt 20)]
-        [cps|(λ (ktail0)
-            (prim (* 4 5)
-               (κ (x) (continue ktail0 x))))|]
-  , testCase "add" do
-      evalsTo [ObjImm (ImmInt 9)]
-        [cps|(λ (ktail0)
-        (prim (+ 4 5)
-               (κ (x) (continue ktail0 x))))|]
-  -- , testGroup "call/cc"
-  --   [ testCase "trivial" do
-  --       evalsTo [ObjImm (ImmInt 123)]
-  --         [cps|(letrec ((f (λ (cc ktail) (continue cc 123))))
-  --                (prim (call/cc f)))|]
-  --   ]
-  ]
+-- prim = testGroup "prim"
+--   [ testCase "multiply" do
+--       evalsTo [ObjImm (ImmInt 20)]
+--         [cps|(λ (ktail0)
+--             (prim (* 4 5)
+--                (κ (x) (continue ktail0 x))))|]
+--   , testCase "add" do
+--       evalsTo [ObjImm (ImmInt 9)]
+--         [cps|(λ (ktail0)
+--         (prim (+ 4 5)
+--                (κ (x) (continue ktail0 x))))|]
+--   -- , testGroup "call/cc"
+--   --   [ testCase "trivial" do
+--   --       evalsTo [ObjImm (ImmInt 123)]
+--   --         [cps|(letrec ((f (λ (cc ktail) (continue cc 123))))
+--   --                (prim (call/cc f)))|]
+--   --   ]
+--   ]

-condition = testCase "if" do
-  evalsTo [ObjImm (ImmInt 123)]
-    [cps|(λ (ktail0)
-      (if #t (continue ktail0 123) (continue ktail0 456)))|]
-  evalsTo [ObjImm (ImmInt 456)]
-    [cps|(λ (ktail0)
-      (if #f (continue ktail0 123) (continue ktail0 456)))|]
+-- condition = testCase "if" do
+--   evalsTo [ObjImm (ImmInt 123)]
+--     [cps|(λ (ktail0)
+--       (if #t (continue ktail0 123) (continue ktail0 456)))|]
+--   evalsTo [ObjImm (ImmInt 456)]
+--     [cps|(λ (ktail0)
+--       (if #f (continue ktail0 123) (continue ktail0 456)))|]

-procedure = testGroup "procedure"
-  [ testCase "factorial" do
-      evalsTo [ObjImm (ImmInt 720)]
-        [cps|(λ (ktail0)
-          (letrec ((fac (λ (n ktail)
-                             (prim (zero? n)
-                               (κ (x0)
-                                 (if x0
-                                   (continue ktail 1)
-                                   (prim (- n 1)
-                                     (κ (x1)
-                                       (letrec ((fac-k0
-                                                  (κ (x2)
-                                                    (prim (* n x2)
-                                                      (κ (x3)
-                                                        (continue ktail x3))))))
-                                         (fac x1 fac-k0))))))))))
-               (fac 6 halt)))|]
-  ]
+-- procedure = testGroup "procedure"
+--   [ testCase "factorial" do
+--       evalsTo [ObjImm (ImmInt 720)]
+--         [cps|(λ (ktail0)
+--           (letrec ((fac (λ (n ktail)
+--                              (prim (zero? n)
+--                                (κ (x0)
+--                                  (if x0
+--                                    (continue ktail 1)
+--                                    (prim (- n 1)
+--                                      (κ (x1)
+--                                        (letrec ((fac-k0
+--                                                   (κ (x2)
+--                                                     (prim (* n x2)
+--                                                       (κ (x3)
+--                                                         (continue ktail x3))))))
+--                                          (fac x1 fac-k0))))))))))
+--                (fac 6 halt)))|]
+--   ]