90 lines
2.7 KiB
Haskell
90 lines
2.7 KiB
Haskell
module Gyehoek.Test.CPS.Stackify where
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.HUnit
|
|
import qualified Gyehoek.CPS.Stackify as Sut
|
|
import Gyehoek.Stack.VM as Stk
|
|
import Gyehoek.CPS.Syntax (cps)
|
|
import Gyehoek.CPS.Syntax qualified as CPS
|
|
import Gyehoek.GenSym (runGenSym)
|
|
import Effectful
|
|
import Gyehoek.Prelude
|
|
|
|
|
|
test_stackify =
|
|
[ trivialReturn
|
|
, tailCall
|
|
, prim
|
|
, condition
|
|
, procedure
|
|
]
|
|
|
|
evalsTo :: List Obj -> Sut.Exp -> Assertion
|
|
evalsTo rs e = Stk.eval e' @?= rs
|
|
where
|
|
e' = e & CPS.MkLambda [] "_ktail"
|
|
& CPS.MkProgram
|
|
& Sut.stackifyProgram & runGenSym & runPureEff
|
|
|
|
trivialReturn = testGroup "trivial return"
|
|
[ testCase "return int" do
|
|
evalsTo [ObjImm (ImmInt 4)]
|
|
[cps|(continue halt 4)|]
|
|
, testCase "return bool" do
|
|
evalsTo [ObjImm (ImmBool True)]
|
|
[cps|(continue halt #t)|]
|
|
evalsTo [ObjImm (ImmBool False)]
|
|
[cps|(continue halt #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))|]
|
|
]
|
|
|
|
prim = testGroup "prim"
|
|
[ testCase "multiply" do
|
|
evalsTo [ObjImm (ImmInt 20)]
|
|
[cps|(prim (* 4 5)
|
|
(κ (x) (continue halt x)))|]
|
|
, testCase "add" do
|
|
evalsTo [ObjImm (ImmInt 9)]
|
|
[cps|(prim (+ 4 5)
|
|
(κ (x) (continue halt 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|(if #t (continue halt 123) (continue halt 456))|]
|
|
evalsTo [ObjImm (ImmInt 456)]
|
|
[cps|(if #f (continue halt 123) (continue halt 456))|]
|
|
|
|
procedure = testGroup "procedure"
|
|
[ testCase "factorial" do
|
|
evalsTo [ObjImm (ImmInt 720)]
|
|
[cps|(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))|]
|
|
]
|