giles
23c8b97cb1
spec/vm.sx — bytecode VM written in SX (the spec):
- Stack-based interpreter for bytecode from compiler.sx
- 24 opcodes: constants, variables (local/upvalue/global), control flow,
function calls (with TCO), closures with upvalue capture, collections,
string concat, define
- Upvalue cells for shared mutable closure variables
- Call dispatch: vm-closure (fast path), native-fn, CEK fallback
- Platform interface: 7 primitives (vm-stack-*, call-primitive, cek-call,
get-primitive, env-parent)
spec/tests/test-vm.sx — 72 tests exercising compile→bytecode→VM pipeline:
constants, arithmetic, comparison, control flow (if/when/cond/case/and/or),
let bindings, lambda, closures, upvalue mutation, TCO (10K iterations),
collections, strings, define, letrec, quasiquote, threading, integration
(fibonacci, recursive map/filter/reduce, compose)
spec/compiler.sx — fix :else keyword detection in case/cond compilation
(was comparing Keyword object to evaluated string, now checks type)
Platform primitives added (JS + OCaml):
make-vm-stack, vm-stack-get, vm-stack-set!, vm-stack-length, vm-stack-copy!,
primitive?, get-primitive, call-primitive, set-nth! (JS)
Test runners updated to load bytecode.sx + compiler.sx + vm.sx for --full.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
419 lines
13 KiB
Plaintext
419 lines
13 KiB
Plaintext
;; ==========================================================================
|
|
;; test-vm.sx — Tests for the bytecode VM (spec/vm.sx)
|
|
;;
|
|
;; Requires: test-framework.sx, compiler.sx, vm.sx loaded.
|
|
;; Tests the compile → bytecode → VM execution pipeline.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; Helper: compile an SX expression and execute it on the VM.
|
|
;; Returns the result value.
|
|
(define vm-eval
|
|
(fn (expr)
|
|
(let ((code (compile expr)))
|
|
(vm-execute-module
|
|
(code-from-value code)
|
|
{}))))
|
|
|
|
;; Helper: compile and run with a pre-populated globals dict.
|
|
(define vm-eval-with
|
|
(fn (expr globals)
|
|
(let ((code (compile expr)))
|
|
(vm-execute-module (code-from-value code) globals))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Constants and literals
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-constants"
|
|
(deftest "number constant"
|
|
(assert-equal 42 (vm-eval 42)))
|
|
|
|
(deftest "string constant"
|
|
(assert-equal "hello" (vm-eval "hello")))
|
|
|
|
(deftest "boolean true"
|
|
(assert-equal true (vm-eval true)))
|
|
|
|
(deftest "boolean false"
|
|
(assert-equal false (vm-eval false)))
|
|
|
|
(deftest "nil constant"
|
|
(assert-nil (vm-eval nil)))
|
|
|
|
(deftest "negative number"
|
|
(assert-equal -7 (vm-eval -7)))
|
|
|
|
(deftest "float constant"
|
|
(assert-equal 3.14 (vm-eval 3.14))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Arithmetic via primitives
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-arithmetic"
|
|
(deftest "addition"
|
|
(assert-equal 5 (vm-eval '(+ 2 3))))
|
|
|
|
(deftest "subtraction"
|
|
(assert-equal 7 (vm-eval '(- 10 3))))
|
|
|
|
(deftest "multiplication"
|
|
(assert-equal 24 (vm-eval '(* 6 4))))
|
|
|
|
(deftest "division"
|
|
(assert-equal 5 (vm-eval '(/ 10 2))))
|
|
|
|
(deftest "nested arithmetic"
|
|
(assert-equal 14 (vm-eval '(+ (* 3 4) 2))))
|
|
|
|
(deftest "three-arg addition"
|
|
(assert-equal 15 (vm-eval '(+ 5 4 6)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Comparison and logic
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-comparison"
|
|
(deftest "equal numbers"
|
|
(assert-equal true (vm-eval '(= 1 1))))
|
|
|
|
(deftest "unequal numbers"
|
|
(assert-equal false (vm-eval '(= 1 2))))
|
|
|
|
(deftest "less than"
|
|
(assert-equal true (vm-eval '(< 1 2))))
|
|
|
|
(deftest "greater than"
|
|
(assert-equal true (vm-eval '(> 5 3))))
|
|
|
|
(deftest "not"
|
|
(assert-equal true (vm-eval '(not false))))
|
|
|
|
(deftest "not truthy"
|
|
(assert-equal false (vm-eval '(not 42)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Control flow — if, when, cond, and, or
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-control-flow"
|
|
(deftest "if true branch"
|
|
(assert-equal 1 (vm-eval '(if true 1 2))))
|
|
|
|
(deftest "if false branch"
|
|
(assert-equal 2 (vm-eval '(if false 1 2))))
|
|
|
|
(deftest "if without else returns nil"
|
|
(assert-nil (vm-eval '(if false 1))))
|
|
|
|
(deftest "when true evaluates body"
|
|
(assert-equal 42 (vm-eval '(when true 42))))
|
|
|
|
(deftest "when false returns nil"
|
|
(assert-nil (vm-eval '(when false 42))))
|
|
|
|
(deftest "and short-circuits on false"
|
|
(assert-equal false (vm-eval '(and true false 42))))
|
|
|
|
(deftest "and returns last truthy"
|
|
(assert-equal 3 (vm-eval '(and 1 2 3))))
|
|
|
|
(deftest "or short-circuits on true"
|
|
(assert-equal 1 (vm-eval '(or 1 false 2))))
|
|
|
|
(deftest "or returns false when all falsy"
|
|
(assert-equal false (vm-eval '(or false false false))))
|
|
|
|
(deftest "cond first match"
|
|
(assert-equal "one" (vm-eval '(cond (= 1 1) "one" (= 2 2) "two"))))
|
|
|
|
(deftest "cond else clause"
|
|
(assert-equal "none" (vm-eval '(cond (= 1 2) "one" :else "none"))))
|
|
|
|
(deftest "case match"
|
|
(assert-equal "two" (vm-eval '(case 2 1 "one" 2 "two" :else "other"))))
|
|
|
|
(deftest "case else"
|
|
(assert-equal "other" (vm-eval '(case 99 1 "one" 2 "two" :else "other")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Let bindings
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-let"
|
|
(deftest "single binding"
|
|
(assert-equal 10 (vm-eval '(let ((x 10)) x))))
|
|
|
|
(deftest "multiple bindings"
|
|
(assert-equal 30 (vm-eval '(let ((x 10) (y 20)) (+ x y)))))
|
|
|
|
(deftest "bindings are sequential"
|
|
(assert-equal 11 (vm-eval '(let ((x 10) (y (+ x 1))) y))))
|
|
|
|
(deftest "nested let"
|
|
(assert-equal 3 (vm-eval '(let ((x 1)) (let ((y 2)) (+ x y))))))
|
|
|
|
(deftest "inner let shadows outer"
|
|
(assert-equal 99 (vm-eval '(let ((x 1)) (let ((x 99)) x)))))
|
|
|
|
(deftest "let body returns last expression"
|
|
(assert-equal 3 (vm-eval '(let ((x 1)) 1 2 3)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Lambda and function calls
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-lambda"
|
|
(deftest "lambda call"
|
|
(assert-equal 7 (vm-eval '(let ((f (fn (x) (+ x 2)))) (f 5)))))
|
|
|
|
(deftest "lambda with multiple params"
|
|
(assert-equal 11 (vm-eval '(let ((add (fn (a b) (+ a b)))) (add 5 6)))))
|
|
|
|
(deftest "higher-order: pass lambda to lambda"
|
|
(assert-equal 10
|
|
(vm-eval '(let ((apply-fn (fn (f x) (f x)))
|
|
(double (fn (n) (* n 2))))
|
|
(apply-fn double 5)))))
|
|
|
|
(deftest "lambda returns lambda"
|
|
(assert-equal 15
|
|
(vm-eval '(let ((make-adder (fn (n) (fn (x) (+ n x)))))
|
|
(let ((add10 (make-adder 10)))
|
|
(add10 5))))))
|
|
|
|
(deftest "immediately invoked lambda"
|
|
(assert-equal 42 (vm-eval '((fn (x) (* x 2)) 21)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Closures and upvalues
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-closures"
|
|
(deftest "closure captures local"
|
|
(assert-equal 10
|
|
(vm-eval '(let ((x 10))
|
|
(let ((f (fn () x)))
|
|
(f))))))
|
|
|
|
(deftest "closure captures through two levels"
|
|
(assert-equal 30
|
|
(vm-eval '(let ((x 10))
|
|
(let ((y 20))
|
|
(let ((f (fn () (+ x y))))
|
|
(f)))))))
|
|
|
|
(deftest "two closures share upvalue"
|
|
(assert-equal 42
|
|
(vm-eval '(let ((x 0))
|
|
(let ((set-x (fn (v) (set! x v)))
|
|
(get-x (fn () x)))
|
|
(set-x 42)
|
|
(get-x))))))
|
|
|
|
(deftest "closure mutation visible to sibling"
|
|
(assert-equal 3
|
|
(vm-eval '(let ((counter 0))
|
|
(let ((inc! (fn () (set! counter (+ counter 1)))))
|
|
(inc!)
|
|
(inc!)
|
|
(inc!)
|
|
counter))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Tail call optimization
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-tco"
|
|
(deftest "tail-recursive loop doesn't overflow"
|
|
;; Count down from 10000 — would overflow without TCO
|
|
(assert-equal 0
|
|
(vm-eval '(let ((loop (fn (n)
|
|
(if (<= n 0) 0
|
|
(loop (- n 1))))))
|
|
(loop 10000)))))
|
|
|
|
(deftest "tail-recursive accumulator"
|
|
(assert-equal 5050
|
|
(vm-eval '(let ((sum (fn (n acc)
|
|
(if (<= n 0) acc
|
|
(sum (- n 1) (+ acc n))))))
|
|
(sum 100 0))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Collections
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-collections"
|
|
(deftest "list construction"
|
|
(assert-equal (list 1 2 3) (vm-eval '(list 1 2 3))))
|
|
|
|
(deftest "empty list"
|
|
(assert-equal (list) (vm-eval '(list))))
|
|
|
|
(deftest "dict construction"
|
|
(let ((d (vm-eval '{:a 1 :b 2})))
|
|
(assert-equal 1 (get d "a"))
|
|
(assert-equal 2 (get d "b"))))
|
|
|
|
(deftest "list operations"
|
|
(assert-equal 1 (vm-eval '(first (list 1 2 3))))
|
|
(assert-equal 3 (vm-eval '(len (list 1 2 3)))))
|
|
|
|
(deftest "nested list"
|
|
(assert-equal (list 1 (list 2 3))
|
|
(vm-eval '(list 1 (list 2 3))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; String operations
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-strings"
|
|
(deftest "str concat"
|
|
(assert-equal "hello world" (vm-eval '(str "hello" " " "world"))))
|
|
|
|
(deftest "string-length"
|
|
(assert-equal 5 (vm-eval '(string-length "hello"))))
|
|
|
|
(deftest "str coerces numbers"
|
|
(assert-equal "42" (vm-eval '(str 42)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Define — top-level and local
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-define"
|
|
(deftest "top-level define"
|
|
(assert-equal 42
|
|
(vm-eval '(do (define x 42) x))))
|
|
|
|
(deftest "define function then call"
|
|
(assert-equal 10
|
|
(vm-eval '(do
|
|
(define double (fn (n) (* n 2)))
|
|
(double 5)))))
|
|
|
|
(deftest "local define inside fn"
|
|
(assert-equal 30
|
|
(vm-eval '(let ((f (fn (x)
|
|
(define y (* x 2))
|
|
(+ x y))))
|
|
(f 10)))))
|
|
|
|
(deftest "define with forward reference"
|
|
(assert-equal 120
|
|
(vm-eval '(do
|
|
(define fact (fn (n)
|
|
(if (<= n 1) 1 (* n (fact (- n 1))))))
|
|
(fact 5))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Letrec — mutual recursion
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-letrec"
|
|
(deftest "letrec self-recursion"
|
|
(assert-equal 55
|
|
(vm-eval '(letrec ((sum-to (fn (n)
|
|
(if (<= n 0) 0
|
|
(+ n (sum-to (- n 1)))))))
|
|
(sum-to 10)))))
|
|
|
|
(deftest "letrec mutual recursion"
|
|
(assert-equal true
|
|
(vm-eval '(letrec ((my-even? (fn (n)
|
|
(if (= n 0) true (my-odd? (- n 1)))))
|
|
(my-odd? (fn (n)
|
|
(if (= n 0) false (my-even? (- n 1))))))
|
|
(my-even? 10))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Quasiquote
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-quasiquote"
|
|
(deftest "simple quasiquote"
|
|
(assert-equal (list 1 2 3)
|
|
(vm-eval '(let ((x 2)) `(1 ,x 3)))))
|
|
|
|
(deftest "quasiquote with splice"
|
|
(assert-equal (list 1 2 3 4)
|
|
(vm-eval '(let ((xs (list 2 3))) `(1 ,@xs 4))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Thread macro
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-threading"
|
|
(deftest "thread-first"
|
|
(assert-equal 7
|
|
(vm-eval '(-> 5 (+ 2)))))
|
|
|
|
(deftest "thread-first chain"
|
|
(assert-equal 12
|
|
(vm-eval '(-> 10 (+ 5) (- 3))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Integration: compile then execute
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "vm-integration"
|
|
(deftest "fibonacci"
|
|
(assert-equal 55
|
|
(vm-eval '(do
|
|
(define fib (fn (n)
|
|
(if (<= n 1) n
|
|
(+ (fib (- n 1)) (fib (- n 2))))))
|
|
(fib 10)))))
|
|
|
|
(deftest "map via recursive define"
|
|
(assert-equal (list 2 4 6)
|
|
(vm-eval '(do
|
|
(define my-map (fn (f lst)
|
|
(if (empty? lst) (list)
|
|
(cons (f (first lst)) (my-map f (rest lst))))))
|
|
(my-map (fn (x) (* x 2)) (list 1 2 3))))))
|
|
|
|
(deftest "filter via recursive define"
|
|
(assert-equal (list 2 4)
|
|
(vm-eval '(do
|
|
(define my-filter (fn (pred lst)
|
|
(if (empty? lst) (list)
|
|
(if (pred (first lst))
|
|
(cons (first lst) (my-filter pred (rest lst)))
|
|
(my-filter pred (rest lst))))))
|
|
(my-filter (fn (x) (even? x)) (list 1 2 3 4 5))))))
|
|
|
|
(deftest "reduce via recursive define"
|
|
(assert-equal 15
|
|
(vm-eval '(do
|
|
(define my-reduce (fn (f acc lst)
|
|
(if (empty? lst) acc
|
|
(my-reduce f (f acc (first lst)) (rest lst)))))
|
|
(my-reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4 5))))))
|
|
|
|
(deftest "nested function calls"
|
|
(assert-equal 42
|
|
(vm-eval '(do
|
|
(define compose (fn (f g) (fn (x) (f (g x)))))
|
|
(define inc (fn (x) (+ x 1)))
|
|
(define double (fn (x) (* x 2)))
|
|
(let ((inc-then-double (compose double inc)))
|
|
(inc-then-double 20)))))))
|