Files
gyehoek-hs/test/Gyehoek/Test/CPS/Syntax.hs
T
msyds baa5d248fd
build / build (push) Successful in 1m27s
tasty-discover
2026-08-20 06:04:52 -06:00

51 lines
1.5 KiB
Haskell

{-# LANGUAGE OverloadedLists #-}
module Gyehoek.Test.CPS.Syntax where
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Language.SexpGrammar ()
import Gyehoek.CPS.Syntax (cps)
import Gyehoek.CPS.Syntax qualified as Sut
test_root = testGroup "cps syntax"
[ free
, qq
]
free :: TestTree
free = testGroup "free"
[ testCase "lambda" do
Sut.free' @Sut.Lambda [cps|
(lambda (x y z k1) (continue k1 x a b c y))
|] @=? ["a","b","c"]
, testCase "exp" do
Sut.free' @Sut.Exp [cps|
(letrec ((x (lambda (r k1) (continue k1 y)))
(y (lambda (r k2) (continue k2 x))))
(continue x y k3))|] @=? ["k3"]
]
qq :: TestTree
qq = testGroup "parser"
[ testCase "lambda" do
assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
(Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
[cps|(λ (x y ktail) (continue ktail x))|]
assertEqual "" (Sut.MkLambda [] "ktail"
(Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
[cps|(λ (ktail) (continue ktail x))|]
, testCase "kappa" do
assertEqual "" (Sut.MkKappa ["x","y"]
(Sut.ExpContinue "k123" [Sut.ValVar "x", Sut.ValVar "y"]))
[cps|(κ (x y) (continue k123 x y))|]
, testCase "application" do
assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
[Sut.ValVar "x",Sut.ValVar "y"]
"k")
[cps|(f x y k)|]
assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
[] "k")
[cps|(f k)|]
]