53 lines
1.6 KiB
Haskell
53 lines
1.6 KiB
Haskell
{-# LANGUAGE OverloadedLists #-}
|
|
module Gyehoek.Test.CPS.Syntax (root) where
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.HUnit
|
|
import Language.Sexp.Located qualified as SL
|
|
import Language.SexpGrammar ()
|
|
import Gyehoek.CPS.Syntax (cps)
|
|
import Gyehoek.CPS.Syntax qualified as Sut
|
|
import Data.Function (on)
|
|
import Gyehoek.Test.Sexp (equivto)
|
|
|
|
|
|
root :: IO TestTree
|
|
root = pure . testGroup "cps syntax" $
|
|
[ qqTree
|
|
, freeTree
|
|
]
|
|
|
|
freeTree :: TestTree
|
|
freeTree = testCase "free" do
|
|
Sut.free [cps|
|
|
(letrec ((x (lambda (r k1) (continue k1 y)))
|
|
(y (lambda (r k2) (continue k2 x))))
|
|
(continue x y k3))|] @=? ["k3"]
|
|
Sut.free' [cps|
|
|
(letrec ((x (lambda (r k1) (continue k1 y)))
|
|
(y (lambda (r k2) (continue k2 x))))
|
|
(continue x y k3))|] @=? ["k3"]
|
|
|
|
qqTree :: TestTree
|
|
qqTree = 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)|]
|
|
]
|