msyds/gyehoek-hs
1
0
Fork 0
Code Issues Pull Requests 1 Actions Packages Projects Releases Wiki Activity

works albeit comically inefficiently

Browse Source
This commit is contained in:
msyds
2026-08-30 02:12:16 -06:00
parent e7c0ae9161
commit a09c00badd
8 changed files with 185 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/Gyehoek/Test/CPS/Stackify.hs
+25 -20
View File
@@ -20,42 +20,44 @@ test_stackify =
, procedure
]
evalsTo :: List Obj -> Sut.Exp -> Assertion
evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
evalsTo rs e = runJalmotUnsafe (Stk.eval e') @?= rs
where
e' = e & CPS.MkLambda [] "_ktail"
& CPS.MkProgram
& Sut.stackifyProgram & runGenSym & runPureEff
e' = e & Sut.stackifyProgram & runGenSym & runPureEff
trivialReturn = testGroup "trivial return"
[ testCase "return int" do
evalsTo [ObjImm (ImmInt 4)]
[cps|(continue halt 4)|]
[cps|(λ (ktail) (continue ktail 4))|]
, testCase "return bool" do
evalsTo [ObjImm (ImmBool True)]
[cps|(continue halt #t)|]
[cps|(λ (ktail) (continue ktail #t))|]
evalsTo [ObjImm (ImmBool False)]
[cps|(continue halt #f)|]
[cps|(λ (ktail) (continue ktail #f))|]
]
tailCall = testGroup "tail call"
[ testCase "square" do
evalsTo [ObjImm (ImmInt 16)]
[cps|(letrec ((square (λ (x ktail)
(prim (* x x)
(κ (x0) (continue ktail x0))))))
(square 4 halt))|]
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|(prim (* 4 5)
(κ (x) (continue halt x)))|]
[cps|(λ (ktail0)
(prim (* 4 5)
(κ (x) (continue ktail0 x))))|]
, testCase "add" do
evalsTo [ObjImm (ImmInt 9)]
[cps|(prim (+ 4 5)
(κ (x) (continue halt x)))|]
[cps|(λ (ktail0)
(prim (+ 4 5)
(κ (x) (continue ktail0 x))))|]
-- , testGroup "call/cc"
-- [ testCase "trivial" do
-- evalsTo [ObjImm (ImmInt 123)]
@@ -66,14 +68,17 @@ prim = testGroup "prim"
condition = testCase "if" do
evalsTo [ObjImm (ImmInt 123)]
[cps|(if #t (continue halt 123) (continue halt 456))|]
[cps|(λ (ktail0)
(if #t (continue ktail0 123) (continue ktail0 456)))|]
evalsTo [ObjImm (ImmInt 456)]
[cps|(if #f (continue halt 123) (continue halt 456))|]
[cps|(λ (ktail0)
(if #f (continue ktail0 123) (continue ktail0 456)))|]
procedure = testGroup "procedure"
[ testCase "factorial" do
evalsTo [ObjImm (ImmInt 720)]
[cps|(letrec ((fac (λ (n ktail)
[cps|(λ (ktail0)
(letrec ((fac (λ (n ktail)
(prim (zero? n)
(κ (x0)
(if x0
@@ -86,5 +91,5 @@ procedure = testGroup "procedure"
(κ (x3)
(continue ktail x3))))))
(fac x1 fac-k0))))))))))
(fac 6 halt))|]
(fac 6 halt)))|]
]