{-# 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)|]
  ]