Files
gyehoek-hs/test/Gyehoek/Test/Stack/VM.hs
T
2026-08-24 23:41:52 -06:00

76 lines
2.3 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 ($start %ktail)
(tail-call %ktail 3))
|]
, testCase "return constant" do
evalsTo [ObjImm (ImmInt 123)] [stkP|
(define ($start %ktail)
(tail-call $silly %ktail))
(define ($silly %ktail)
(tail-call %ktail 123))
|]
, testCase "identity continuation" do
evalsTo [ObjImm (ImmInt 45)] [stkP|
(define ($start %ktail)
(push! %ktail)
(tail-call $id 45))
(define ($id %x)
(pop! %ktail)
(tail-call %ktail %x))
|]
, testCase "identity function" do
evalsTo [ObjImm (ImmInt 45)] [stkP|
(define ($start %ktail)
(tail-call $id 45 %ktail))
(define ($id %x %ktail)
(tail-call %ktail %x))
|]
, testCase "square" do
evalsTo [ObjImm (ImmInt 16)] [stkP|
(define ($start %ktail)
(tail-call $square 4 %ktail))
(define ($square %x %ktail)
(prim %x2 (* %x %x))
(tail-call %ktail %x2))
|]
, testCase "factorial" do
let hsfac (n :: Int) = foldr (*) (1) [1..n]
let fac (n :: Int) = [stkP|
(define ($fac %n %ktail)
(prim %x0 (zero? %n))
(if %x0
(then (tail-call %ktail 1))
(else (push! %n)
(push! %ktail)
(prim %x1 (- %n 1))
(tail-call $fac %x1 $fac-k0))))
(define ($fac-k0 %x2)
(pop! %ktail)
(pop! %n)
(prim %x3 (* %x2 %n))
(tail-call %ktail %x3))
(define ($start %ktail)
(tail-call $fac #{n} %ktail))
|]
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
]