module Gyehoek.Test.CPS.Stackify (root) where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import qualified Gyehoek.CPS.Stackify as Sut
import Gyehoek.Stack.VM as Stk
import Data.List (List)
import Gyehoek.CPS.Syntax (cps)
import Gyehoek.GenSym (runGenSym)
import Effectful
import Test.Tasty.ExpectedFailure (expectFail)


root :: IO TestTree
root = pure . testGroup "stackify" $
  [ trivialReturn
  , tailCall
  , prim
  , condition
  , procedure
  ]

evalsTo :: List Obj -> Sut.Exp -> Assertion
evalsTo rs e =
  Stk.eval e' @?= rs
  where e' = runPureEff . runGenSym $ Sut.stackifyExp "main" e

trivialReturn = testGroup "trivial return"
  [ testCase "return int" do
      evalsTo [ObjImm (ImmInt 4)]
        [cps|(continue halt 4)|]
  , testCase "return bool" do
      evalsTo [ObjImm (ImmBool True)]
        [cps|(continue halt #t)|]
      evalsTo [ObjImm (ImmBool False)]
        [cps|(continue halt #f)|]
  ]

tailCall = testGroup "tail call"
  [ testCase "square" do
      evalsTo [ObjImm (ImmInt 16)]
        [cps|(letrec ((square (λ (x ktail)
                                (prim (* x x)
                                  (κ (x0) (continue ktail x0))))))
               (square 4 halt))|]
  ]

prim = testGroup "prim"
  [ testCase "multiply" do
      evalsTo [ObjImm (ImmInt 20)]
        [cps|(prim (* 4 5)
               (κ (x) (continue halt x)))|]
  , testCase "add" do
      evalsTo [ObjImm (ImmInt 9)]
        [cps|(prim (+ 4 5)
               (κ (x) (continue halt x)))|]
  ]

condition = testCase "if" do
  evalsTo [ObjImm (ImmInt 123)]
    [cps|(if #t (continue halt 123) (continue halt 456))|]
  evalsTo [ObjImm (ImmInt 456)]
    [cps|(if #f (continue halt 123) (continue halt 456))|]

procedure = testGroup "procedure"
  [ testCase "factorial" do
      evalsTo [ObjImm (ImmInt 720)]
        [cps|(letrec ((fac (λ (n ktail)
                             (prim (zero? n)
                               (κ (x0)
                                 (if x0
                                   (continue ktail 1)
                                   (prim (- n 1)
                                     (κ (x1)
                                       (letrec ((fac-k0
                                                  (κ (x2)
                                                    (prim (* n x2)
                                                      (κ (x3)
                                                        (continue ktail x3))))))
                                         (fac x1 fac-k0))))))))))
               (fac 6 halt))|]
  ]