module Gyehoek.Test.CPS.Eval where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
import Gyehoek.CPS.Eval qualified as Sut
import Data.List (List)


test_cpsInterpreter = testGroup "cps interpreter" $
  [ primitives
  , testCase "halt with constant" do
      evalsTo [ObjImm (ImmInt 123)] [cps|
        (continue halt 123)
      |]
  , testCase "identity cont" do
      evalsTo [ObjImm (ImmInt 154)] [cps|
        (letrec ((id (κ (x)
                       (continue halt x))))
          (continue id 154))
      |]
  , testCase "identity function" do
      evalsTo [ObjImm (ImmInt 456)] [cps|
        (letrec ((id (λ (x ktail)
                       (continue ktail x))))
          (id 456 halt))
      |]
  , testCase "square" do
      evalsTo [ObjImm (ImmInt 81)] [cps|
        (letrec ((square (λ (x ktail)
                           (prim (* x x)
                             (κ (r) (continue ktail r))))))
          (square 9 halt))
      |]
  ]

evalsTo :: HasCallStack => List Obj -> Sut.Exp -> Assertion
evalsTo rs e = Sut.evalExp e @?= rs

primitives = testGroup "primitives"
  [ testGroup "arith"
    [ testCase "basic 1" do
        evalsTo [ObjImm (ImmInt 20)] [cps|
          (prim (* 4 5)
            (κ (x) (continue halt x)))
          |]
    , testCase "basic 2" do
        evalsTo [ObjImm (ImmInt 35)] [cps|
          (prim (* 2 16)
            (κ (x) (prim (+ x 3)
                      (κ (r) (continue halt r)))))
          |]
    ]
  ]