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