{-# 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)
import Gyehoek.Jalmot
import Gyehoek.Prelude (i)
import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)


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

test_root = ignoreTestBecause "i'm super-killing myself" $ testGroup "stack machine"
  [ testCase "immediate halt" do
      evalsTo [] [stkP|
        (define $start
          (return 0))
      |]
  , testCase "lit int" do
      evalsTo [ObjImm (ImmInt 3)] [stkP|
        (define $start
          (push! 3)
          (return 1))
      |]
  , testCase "non-tail identity function" do
      evalsTo [ObjImm (ImmInt 123)] [stkP|
        (define $id
          (return 1))
        (define $c
          (return 1))
        (define $start
          (push! $c)
          (push! $id)
          (push! 123)
          (call 1))
      |]
  , testCase "tail identity function" do
      evalsTo [ObjImm (ImmInt 123)] [stkP|
        (define $id
          (return 1))
        (define $start
          (push! $id)
          (push! 123)
          (tail-call 1))
      |]
  , testCase "return constant" do
      evalsTo [ObjImm (ImmInt 123)] [stkP|
        (define $start
          (push! $silly)
          (tail-call 1))
        (define $silly
          (push! 123)
          (return 1))
      |]
  , testCase "return multiple" do
      evalsTo [ObjImm (ImmInt n) | n <- [1,2,3]] [stkP|
        (define $start
          (push! 3)
          (push! 2)
          (push! 1)
          (return 3))
      |]
  , testCase "return none" do
      evalsTo [] [stkP|
        (define $start
          (return 0))
      |]
  , testCase "square" do
      evalsTo [ObjImm (ImmInt 16)] [stkP|
        (define $start
          (push! $square)
          (push! 4)
          (tail-call 1))
        (define $square
          (pop! %x)
          (prim (* %x %x))
          (return 1))
      |]
  , testGroup "factorial"
      let
        hsfac (n :: Int) = foldr @List (*) 1 [1..n]
        fac (n :: Int) = [stkP|
          (define $start
            (push! $fac)
            (push! #{n})
            (tail-call 1))
          (define $fac
            (load %n 0)
            (prim (zero? %n))
            (pop! %x0)
            (if %x0
                (then (push! 1)
                      (return 1))
                (else (push! $fac-c0)
                      (push! $fac)
                      (prim (- %n 1))
                      (call 1))))
          (define $fac-c0
            (pop! %x2)
            (pop! %n)
            (prim (* %n %x2))
            (return 1))
      |]
        mkcase n = testCase [i|#{n}|] do
          evalsTo [ObjImm . ImmInt $ hsfac n] $ fac n
      -- 20 is the greatest `n` for which n! ≤ maxBount @Int
      in [ mkcase n | n <- [0,1,6,20] ]
  ]