{-# LANGUAGE OverloadedLists #-}
module Gyehoek.Test.Stack.VM where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Gyehoek.Stack.Syntax
import Gyehoek.Stack.VM qualified as Sut
import Data.List (List)


evalsTo :: List Obj -> Program -> Assertion
evalsTo rs p = Sut.eval p @?= rs

test_root = testGroup "stack machine"
  [ testCase "lit int" do
      evalsTo [ObjImm (ImmInt 3)] [stkP|
        (define ($main)
          (pop-cont! %ktail)
          (tail-call! %ktail 3))
      |]
  , testCase "return constant" do
      evalsTo [ObjImm (ImmInt 123)] [stkP|
        (define ($main)
          (tail-call! $silly))
        (define ($silly)
          (pop-cont! %ktail)
          (tail-call! %ktail 123))
      |]
  , testCase "identity function" do
      evalsTo [ObjImm (ImmInt 45)] [stkP|
        (define ($main)
          (tail-call! $id 45))
        (define ($id %x)
          (pop-cont! %ktail)
          (tail-call! %ktail %x))
      |]
  -- , testCase "square" do
  --     evalsTo [ObjImm (ImmInt 16)] [stkP|
  --       (define ($main))
  --     |]
  , testCase "square" do
      evalsTo [ObjImm (ImmInt 16)] [stkP|
        (define ($main)
          (tail-call! $square 4))
        (define ($square %x)
          (prim %x2 (* %x %x))
          (pop-cont! %ktail)
          (tail-call! %ktail %x2))
      |]
  , testCase "factorial" do
      let hsfac (n :: Int) = foldr (*) (1) [1..n]
      let fac (n :: Int) = [stkP|
            (define ($fac %n)
              (prim %x0 (zero? %n))
              (if %x0
                (then (pop-cont! %ktail)
                      (tail-call! %ktail 1))
                (else (push! %n)
                      (prim %x1 (- %n 1))
                      (push-cont! $fac-k0)
                      (tail-call! $fac %x1))))
            (define ($fac-k0 %x2)
              (pop! %n)
              (prim %x3 (* %x2 %n))
              (pop-cont! %ktail)
              (tail-call! %ktail %x3))
            (define ($main)
              (tail-call! $fac #{n}))
          |]
      evalsTo [ObjImm (ImmInt 1)] $ fac 0
      evalsTo [ObjImm (ImmInt 1)] $ fac 1
      evalsTo [ObjImm (ImmInt 720)] $ fac 6
      -- 20 is the greatest `n` for which n! ≤ maxBount @Int
      evalsTo [ObjImm (ImmInt 2432902008176640000)] $ fac 20
  ]

--   ]

-- prims = testGroup "prims"
--   [ arith
--   , testCase "zero?" do
--       trivialPrimTest [ObjImm (ImmBool True)] $
--         PrimZeroP $ ValImm $ ImmInt 0
--       trivialPrimTest [ObjImm (ImmBool False)] $
--         PrimZeroP $ ValImm $ ImmInt 12
--   ]

-- trivialPrimTest rs p =
--   evalsTo rs
--   [ MkRoutine "main" []
--     [ PopCont "ktail"
--     , Prim "x1" p
--     , Call (ValReg "ktail") [ValReg "x1"]
--     ]
--   ]

-- arith = testGroup "arith"
--   [ testCase "multipy" do
--       trivialPrimTest [ObjImm (ImmInt 12)]
--         (PrimMul (ValImm $ ImmInt 3) (ValImm $ ImmInt 4))
--   , testCase "subtract" do
--       trivialPrimTest [ObjImm (ImmInt 14)]
--         (PrimSub (ValImm $ ImmInt 20) (ValImm $ ImmInt 6))
--   ]