module Gyehoek.Test.CPS.Stackify 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


test_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)))|]
  -- , testGroup "call/cc"
  --   [ testCase "trivial" do
  --       evalsTo [ObjImm (ImmInt 123)]
  --         [cps|(letrec ((f (λ (cc ktail) (continue cc 123))))
  --                (prim (call/cc f)))|]
  --   ]
  ]

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