55 lines
1.5 KiB
Haskell
55 lines
1.5 KiB
Haskell
module Gyehoek.Test.CPS.Eval where
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.HUnit
|
|
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
|
|
import Gyehoek.CPS.Eval qualified as Sut
|
|
import Data.List (List)
|
|
|
|
|
|
test_cpsInterpreter = testGroup "cps interpreter" $
|
|
[ primitives
|
|
, testCase "halt with constant" do
|
|
evalsTo [ObjImm (ImmInt 123)] [cps|
|
|
(continue halt 123)
|
|
|]
|
|
, testCase "identity cont" do
|
|
evalsTo [ObjImm (ImmInt 154)] [cps|
|
|
(letrec ((id (κ (x)
|
|
(continue halt x))))
|
|
(continue id 154))
|
|
|]
|
|
, testCase "identity function" do
|
|
evalsTo [ObjImm (ImmInt 456)] [cps|
|
|
(letrec ((id (λ (x ktail)
|
|
(continue ktail x))))
|
|
(id 456 halt))
|
|
|]
|
|
, testCase "square" do
|
|
evalsTo [ObjImm (ImmInt 81)] [cps|
|
|
(letrec ((square (λ (x ktail)
|
|
(prim (* x x)
|
|
(κ (r) (continue ktail r))))))
|
|
(square 9 halt))
|
|
|]
|
|
]
|
|
|
|
evalsTo :: HasCallStack => List Obj -> Sut.Exp -> Assertion
|
|
evalsTo rs e = Sut.evalExp e @?= rs
|
|
|
|
primitives = testGroup "primitives"
|
|
[ testGroup "arith"
|
|
[ testCase "basic 1" do
|
|
evalsTo [ObjImm (ImmInt 20)] [cps|
|
|
(prim (* 4 5)
|
|
(κ (x) (continue halt x)))
|
|
|]
|
|
, testCase "basic 2" do
|
|
evalsTo [ObjImm (ImmInt 35)] [cps|
|
|
(prim (* 2 16)
|
|
(κ (x) (prim (+ x 3)
|
|
(κ (r) (continue halt r)))))
|
|
|]
|
|
]
|
|
]
|