Files
gyehoek-hs/test/Gyehoek/Test/CPS/Eval.hs
T
msyds bbb5d6e99f
build / build (push) Failing after 1m40s
stack vm throws jalmot
2026-08-27 01:45:10 -06:00

58 lines
1.6 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)
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
test_cpsInterpreter =
ignoreTestBecause "i forgorrrr" $
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)))))
|]
]
]