113 lines
2.9 KiB
Haskell
113 lines
2.9 KiB
Haskell
{-# 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] ]
|
|
]
|