This commit is contained in:
@@ -34,8 +34,8 @@ test_cpsInterpreter = testGroup "cps interpreter" $
|
||||
|]
|
||||
]
|
||||
|
||||
evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
|
||||
evalsTo rs p = Sut.evalProgram p @?= rs
|
||||
evalsTo :: HasCallStack => List Obj -> Sut.Exp -> Assertion
|
||||
evalsTo rs e = Sut.evalExp e @?= rs
|
||||
|
||||
primitives = testGroup "primitives"
|
||||
[ testGroup "arith"
|
||||
|
||||
@@ -4,10 +4,11 @@ import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
import qualified Gyehoek.CPS.Stackify as Sut
|
||||
import Gyehoek.Stack.VM as Stk
|
||||
import Data.List (List)
|
||||
import Gyehoek.CPS.Syntax (cps)
|
||||
import Gyehoek.CPS.Syntax qualified as CPS
|
||||
import Gyehoek.GenSym (runGenSym)
|
||||
import Effectful
|
||||
import Gyehoek.Prelude
|
||||
|
||||
|
||||
test_stackify =
|
||||
@@ -19,9 +20,11 @@ test_stackify =
|
||||
]
|
||||
|
||||
evalsTo :: List Obj -> Sut.Exp -> Assertion
|
||||
evalsTo rs e =
|
||||
Stk.eval e' @?= rs
|
||||
where e' = runPureEff . runGenSym $ Sut.stackifyExp "main" e
|
||||
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
|
||||
|
||||
@@ -28,15 +28,20 @@ free = testGroup "free"
|
||||
qq :: TestTree
|
||||
qq = testGroup "parser"
|
||||
[ testCase "lambda" do
|
||||
assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
|
||||
(Sut.ExpContinue (Sut.ValLabel "ktail") [Sut.ValVar "x"]))
|
||||
assertEqual ""
|
||||
(Sut.MkLambda ["x","y"] "ktail"
|
||||
(Sut.ExpContinue (Sut.ValVar "ktail") [Sut.ValVar "x"]))
|
||||
[cps|(λ (x y ktail) (continue ktail x))|]
|
||||
assertEqual "" (Sut.MkLambda [] "ktail"
|
||||
(Sut.ExpContinue (Sut.ValLabel "ktail") [Sut.ValVar "x"]))
|
||||
assertEqual ""
|
||||
(Sut.MkLambda [] "ktail"
|
||||
(Sut.ExpContinue (Sut.ValVar "ktail") [Sut.ValVar "x"]))
|
||||
[cps|(λ (ktail) (continue ktail x))|]
|
||||
, testCase "kappa" do
|
||||
assertEqual "" (Sut.MkKappa ["x","y"]
|
||||
(Sut.ExpContinue (Sut.ValLabel "k123") [Sut.ValVar "x", Sut.ValVar "y"]))
|
||||
assertEqual ""
|
||||
(Sut.MkKappa ["x","y"]
|
||||
(Sut.ExpContinue
|
||||
(Sut.ValVar "k123")
|
||||
[Sut.ValVar "x", Sut.ValVar "y"]))
|
||||
[cps|(κ (x y) (continue k123 x y))|]
|
||||
, testCase "application" do
|
||||
assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
|
||||
|
||||
Reference in New Issue
Block a user