97 lines
3.2 KiB
Haskell
97 lines
3.2 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
|
|
import Gyehoek.Jalmot
|
|
import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
|
|
|
|
|
|
-- 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
|
|
|
|
-- 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)))
|
|
-- |]
|
|
-- ]
|
|
|
|
-- 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)))|]
|
|
|
|
-- 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)))|]
|
|
-- ]
|