105 lines
3.0 KiB
Haskell
105 lines
3.0 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)
|
|
|
|
|
|
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))
|
|
-- ]
|