giles
c923a34fa8
The sx-get links were doing full page refreshes because click handlers never attached. Root causes: VM frame management bug, missing primitives, CEK/VM type dispatch mismatch, and silent error swallowing. Fixes: - VM frame exhaustion: frames <- [] now properly pops to rest_frames - length primitive: add alias for len in OCaml primitives - call_sx_fn: use sx_call directly instead of eval_expr (CEK checks for type "lambda" but VmClosure reports "function") - Boot error surfacing: Sx.init() now has try/catch + failure summary - Callback error surfacing: catch-all handler for non-Eval_error exceptions - Silent JIT failures: log before CEK fallback instead of swallowing - vm→env sync: loadModule now calls sync_vm_to_env() - sx_build_bytecode MCP tool added for bytecode compilation Tests: 50 new tests across test-vm.sx and test-vm-primitives.sx covering nested VM calls, frame integrity, CEK bridge, primitive availability, cross-module symbol resolution, and callback dispatch. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
733 lines
20 KiB
Plaintext
733 lines
20 KiB
Plaintext
(define
|
|
vm-eval
|
|
(fn
|
|
(expr)
|
|
(let
|
|
((code (compile expr)))
|
|
(vm-execute-module (code-from-value code) {}))))
|
|
|
|
(define
|
|
vm-eval-with
|
|
(fn
|
|
(expr globals)
|
|
(let
|
|
((code (compile expr)))
|
|
(vm-execute-module (code-from-value code) globals))))
|
|
|
|
(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))))
|
|
|
|
(defsuite
|
|
"vm-arithmetic"
|
|
(deftest "addition" (assert-equal 5 (vm-eval (quote (+ 2 3)))))
|
|
(deftest "subtraction" (assert-equal 7 (vm-eval (quote (- 10 3)))))
|
|
(deftest "multiplication" (assert-equal 24 (vm-eval (quote (* 6 4)))))
|
|
(deftest "division" (assert-equal 5 (vm-eval (quote (/ 10 2)))))
|
|
(deftest
|
|
"nested arithmetic"
|
|
(assert-equal 14 (vm-eval (quote (+ (* 3 4) 2)))))
|
|
(deftest
|
|
"three-arg addition"
|
|
(assert-equal 15 (vm-eval (quote (+ 5 4 6))))))
|
|
|
|
(defsuite
|
|
"vm-comparison"
|
|
(deftest "equal numbers" (assert-equal true (vm-eval (quote (= 1 1)))))
|
|
(deftest
|
|
"unequal numbers"
|
|
(assert-equal false (vm-eval (quote (= 1 2)))))
|
|
(deftest "less than" (assert-equal true (vm-eval (quote (< 1 2)))))
|
|
(deftest "greater than" (assert-equal true (vm-eval (quote (> 5 3)))))
|
|
(deftest "not" (assert-equal true (vm-eval (quote (not false)))))
|
|
(deftest "not truthy" (assert-equal false (vm-eval (quote (not 42))))))
|
|
|
|
(defsuite
|
|
"vm-control-flow"
|
|
(deftest
|
|
"if true branch"
|
|
(assert-equal 1 (vm-eval (quote (if true 1 2)))))
|
|
(deftest
|
|
"if false branch"
|
|
(assert-equal 2 (vm-eval (quote (if false 1 2)))))
|
|
(deftest
|
|
"if without else returns nil"
|
|
(assert-nil (vm-eval (quote (if false 1)))))
|
|
(deftest
|
|
"when true evaluates body"
|
|
(assert-equal 42 (vm-eval (quote (when true 42)))))
|
|
(deftest
|
|
"when false returns nil"
|
|
(assert-nil (vm-eval (quote (when false 42)))))
|
|
(deftest
|
|
"and short-circuits on false"
|
|
(assert-equal false (vm-eval (quote (and true false 42)))))
|
|
(deftest
|
|
"and returns last truthy"
|
|
(assert-equal 3 (vm-eval (quote (and 1 2 3)))))
|
|
(deftest
|
|
"or short-circuits on true"
|
|
(assert-equal 1 (vm-eval (quote (or 1 false 2)))))
|
|
(deftest
|
|
"or returns false when all falsy"
|
|
(assert-equal false (vm-eval (quote (or false false false)))))
|
|
(deftest
|
|
"cond first match"
|
|
(assert-equal
|
|
"one"
|
|
(vm-eval (quote (cond (= 1 1) "one" (= 2 2) "two")))))
|
|
(deftest
|
|
"cond else clause"
|
|
(assert-equal
|
|
"none"
|
|
(vm-eval (quote (cond (= 1 2) "one" :else "none")))))
|
|
(deftest
|
|
"case match"
|
|
(assert-equal
|
|
"two"
|
|
(vm-eval (quote (case 2 1 "one" 2 "two" :else "other")))))
|
|
(deftest
|
|
"case else"
|
|
(assert-equal
|
|
"other"
|
|
(vm-eval (quote (case 99 1 "one" 2 "two" :else "other"))))))
|
|
|
|
(defsuite
|
|
"vm-let"
|
|
(deftest
|
|
"single binding"
|
|
(assert-equal 10 (vm-eval (quote (let ((x 10)) x)))))
|
|
(deftest
|
|
"multiple bindings"
|
|
(assert-equal 30 (vm-eval (quote (let ((x 10) (y 20)) (+ x y))))))
|
|
(deftest
|
|
"bindings are sequential"
|
|
(assert-equal 11 (vm-eval (quote (let ((x 10) (y (+ x 1))) y)))))
|
|
(deftest
|
|
"nested let"
|
|
(assert-equal
|
|
3
|
|
(vm-eval (quote (let ((x 1)) (let ((y 2)) (+ x y)))))))
|
|
(deftest
|
|
"inner let shadows outer"
|
|
(assert-equal 99 (vm-eval (quote (let ((x 1)) (let ((x 99)) x))))))
|
|
(deftest
|
|
"let body returns last expression"
|
|
(assert-equal 3 (vm-eval (quote (let ((x 1)) 1 2 3))))))
|
|
|
|
(defsuite
|
|
"vm-lambda"
|
|
(deftest
|
|
"lambda call"
|
|
(assert-equal
|
|
7
|
|
(vm-eval (quote (let ((f (fn (x) (+ x 2)))) (f 5))))))
|
|
(deftest
|
|
"lambda with multiple params"
|
|
(assert-equal
|
|
11
|
|
(vm-eval (quote (let ((add (fn (a b) (+ a b)))) (add 5 6))))))
|
|
(deftest
|
|
"higher-order: pass lambda to lambda"
|
|
(assert-equal
|
|
10
|
|
(vm-eval
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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 (quote ((fn (x) (* x 2)) 21))))))
|
|
|
|
(defsuite
|
|
"vm-closures"
|
|
(deftest
|
|
"closure captures local"
|
|
(assert-equal
|
|
10
|
|
(vm-eval (quote (let ((x 10)) (let ((f (fn () x))) (f)))))))
|
|
(deftest
|
|
"closure captures through two levels"
|
|
(assert-equal
|
|
30
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((x 10))
|
|
(let ((y 20)) (let ((f (fn () (+ x y)))) (f))))))))
|
|
(deftest
|
|
"two closures share upvalue"
|
|
(assert-equal
|
|
42
|
|
(vm-eval
|
|
(quote
|
|
(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
|
|
(quote
|
|
(let
|
|
((counter 0))
|
|
(let
|
|
((inc! (fn () (set! counter (+ counter 1)))))
|
|
(inc!)
|
|
(inc!)
|
|
(inc!)
|
|
counter)))))))
|
|
|
|
(defsuite
|
|
"vm-tco"
|
|
(deftest
|
|
"tail-recursive loop doesn't overflow"
|
|
(assert-equal
|
|
0
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((loop (fn (n) (if (<= n 0) 0 (loop (- n 1))))))
|
|
(loop 10000))))))
|
|
(deftest
|
|
"tail-recursive accumulator"
|
|
(assert-equal
|
|
5050
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((sum (fn (n acc) (if (<= n 0) acc (sum (- n 1) (+ acc n))))))
|
|
(sum 100 0)))))))
|
|
|
|
(defsuite
|
|
"vm-collections"
|
|
(deftest
|
|
"list construction"
|
|
(assert-equal (list 1 2 3) (vm-eval (quote (list 1 2 3)))))
|
|
(deftest "empty list" (assert-equal (list) (vm-eval (quote (list)))))
|
|
(deftest
|
|
"dict construction"
|
|
(let
|
|
((d (vm-eval (quote {:b 2 :a 1}))))
|
|
(assert-equal 1 (get d "a"))
|
|
(assert-equal 2 (get d "b"))))
|
|
(deftest
|
|
"list operations"
|
|
(assert-equal 1 (vm-eval (quote (first (list 1 2 3)))))
|
|
(assert-equal 3 (vm-eval (quote (len (list 1 2 3))))))
|
|
(deftest
|
|
"nested list"
|
|
(assert-equal
|
|
(list 1 (list 2 3))
|
|
(vm-eval (quote (list 1 (list 2 3)))))))
|
|
|
|
(defsuite
|
|
"vm-strings"
|
|
(deftest
|
|
"str concat"
|
|
(assert-equal "hello world" (vm-eval (quote (str "hello" " " "world")))))
|
|
(deftest
|
|
"string-length"
|
|
(assert-equal 5 (vm-eval (quote (string-length "hello")))))
|
|
(deftest
|
|
"str coerces numbers"
|
|
(assert-equal "42" (vm-eval (quote (str 42))))))
|
|
|
|
(defsuite
|
|
"vm-define"
|
|
(deftest
|
|
"top-level define"
|
|
(assert-equal 42 (vm-eval (quote (do (define x 42) x)))))
|
|
(deftest
|
|
"define function then call"
|
|
(assert-equal
|
|
10
|
|
(vm-eval (quote (do (define double (fn (n) (* n 2))) (double 5))))))
|
|
(deftest
|
|
"local define inside fn"
|
|
(assert-equal
|
|
30
|
|
(vm-eval
|
|
(quote (let ((f (fn (x) (define y (* x 2)) (+ x y)))) (f 10))))))
|
|
(deftest
|
|
"define with forward reference"
|
|
(assert-equal
|
|
120
|
|
(vm-eval
|
|
(quote
|
|
(do
|
|
(define fact (fn (n) (if (<= n 1) 1 (* n (fact (- n 1))))))
|
|
(fact 5)))))))
|
|
|
|
(defsuite
|
|
"vm-letrec"
|
|
(deftest
|
|
"letrec self-recursion"
|
|
(assert-equal
|
|
55
|
|
(vm-eval
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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)))))))
|
|
|
|
(defsuite
|
|
"vm-quasiquote"
|
|
(deftest
|
|
"simple quasiquote"
|
|
(assert-equal
|
|
(list 1 2 3)
|
|
(vm-eval (quote (let ((x 2)) (quasiquote (1 (unquote x) 3)))))))
|
|
(deftest
|
|
"quasiquote with splice"
|
|
(assert-equal
|
|
(list 1 2 3 4)
|
|
(vm-eval
|
|
(quote
|
|
(let ((xs (list 2 3))) (quasiquote (1 (splice-unquote xs) 4))))))))
|
|
|
|
(defsuite
|
|
"vm-threading"
|
|
(deftest "thread-first" (assert-equal 7 (vm-eval (quote (-> 5 (+ 2))))))
|
|
(deftest
|
|
"thread-first chain"
|
|
(assert-equal 12 (vm-eval (quote (-> 10 (+ 5) (- 3)))))))
|
|
|
|
(defsuite
|
|
"vm-integration"
|
|
(deftest
|
|
"fibonacci"
|
|
(assert-equal
|
|
55
|
|
(vm-eval
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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
|
|
(quote
|
|
(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))))))))
|
|
|
|
(defsuite
|
|
"vm-recursive-mutation"
|
|
(deftest
|
|
"recursive append! to shared list"
|
|
(assert-equal
|
|
3
|
|
(vm-eval
|
|
(quote
|
|
(do
|
|
(define
|
|
walk
|
|
(fn
|
|
(items result)
|
|
(when
|
|
(not (empty? items))
|
|
(append! result (first items))
|
|
(walk (rest items) result))))
|
|
(let
|
|
((result (list)))
|
|
(walk (list "a" "b" "c") result)
|
|
(len result)))))))
|
|
(deftest
|
|
"recursive tree walk with append!"
|
|
(assert-equal
|
|
7
|
|
(vm-eval
|
|
(quote
|
|
(do
|
|
(define
|
|
walk-children
|
|
(fn
|
|
(items result walk-fn)
|
|
(when
|
|
(not (empty? items))
|
|
(walk-fn (first items) result)
|
|
(walk-children (rest items) result walk-fn))))
|
|
(define
|
|
walk
|
|
(fn
|
|
(expr result)
|
|
(cond
|
|
(not (list? expr))
|
|
(append! result "leaf")
|
|
(empty? expr)
|
|
nil
|
|
:else (do
|
|
(append! result "open")
|
|
(walk-children (rest expr) result walk)
|
|
(append! result "close")))))
|
|
(let
|
|
((tree (first (sx-parse "(div \"a\" (span \"b\") \"c\")")))
|
|
(result (list)))
|
|
(walk tree result)
|
|
(len result)))))))
|
|
(deftest
|
|
"recursive walk matching stepper split-tag pattern"
|
|
(assert-equal
|
|
16
|
|
(vm-eval
|
|
(quote
|
|
(do
|
|
(define
|
|
walk-each
|
|
(fn
|
|
(items result walk-fn)
|
|
(when
|
|
(not (empty? items))
|
|
(walk-fn (first items) result)
|
|
(walk-each (rest items) result walk-fn))))
|
|
(define
|
|
collect-children
|
|
(fn
|
|
(items cch)
|
|
(when
|
|
(not (empty? items))
|
|
(let
|
|
((a (first items)))
|
|
(if
|
|
(and
|
|
(list? a)
|
|
(not (empty? a))
|
|
(= (type-of (first a)) "symbol")
|
|
(starts-with? (symbol-name (first a)) "~"))
|
|
nil
|
|
(append! cch a))
|
|
(collect-children (rest items) cch)))))
|
|
(define
|
|
split-tag
|
|
(fn
|
|
(expr result)
|
|
(cond
|
|
(not (list? expr))
|
|
(append! result "leaf")
|
|
(empty? expr)
|
|
nil
|
|
(not (= (type-of (first expr)) "symbol"))
|
|
(append! result "leaf")
|
|
(is-html-tag? (symbol-name (first expr)))
|
|
(let
|
|
((cch (list)))
|
|
(collect-children (rest expr) cch)
|
|
(append! result "open")
|
|
(walk-each cch result split-tag)
|
|
(append! result "close"))
|
|
:else (append! result "expr"))))
|
|
(let
|
|
((parsed (sx-parse "(div (~cssx/tw :tokens \"text-center\")\n (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))"))
|
|
(result (list)))
|
|
(split-tag (first parsed) result)
|
|
(len result))))))))
|
|
|
|
(defsuite
|
|
"vm-nested-calls"
|
|
(deftest
|
|
"function call then continue"
|
|
(assert-equal
|
|
30
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((double (fn (x) (* x 2))))
|
|
(let ((a (double 5))) (+ a (double 10))))))))
|
|
(deftest
|
|
"three sequential function calls"
|
|
(assert-equal
|
|
60
|
|
(vm-eval
|
|
(quote (let ((f (fn (x) (* x 10)))) (+ (f 1) (f 2) (f 3)))))))
|
|
(deftest
|
|
"nested call: fn calls fn"
|
|
(assert-equal
|
|
20
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((add1 (fn (x) (+ x 1))) (double (fn (x) (* x 2))))
|
|
(double (add1 9)))))))
|
|
(deftest
|
|
"three-deep nested call"
|
|
(assert-equal
|
|
22
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((add1 (fn (x) (+ x 1)))
|
|
(double (fn (x) (* x 2)))
|
|
(inc10 (fn (x) (+ x 10))))
|
|
(inc10 (double (add1 5))))))))
|
|
(deftest
|
|
"side effect after function call"
|
|
(assert-equal
|
|
42
|
|
(vm-eval
|
|
(quote (let ((x 0) (f (fn (n) (* n 2)))) (set! x (f 21)) x)))))
|
|
(deftest
|
|
"multiple side effects after nested calls"
|
|
(assert-equal
|
|
35
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((a 0) (b 0) (f (fn (x) (+ x 10))))
|
|
(set! a (f 5))
|
|
(set! b (f 10))
|
|
(+ a b))))))
|
|
(deftest
|
|
"when body continues after function call"
|
|
(assert-equal
|
|
100
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((x 0) (f (fn (n) (* n 10))))
|
|
(when true (f 1) (set! x (f 10)))
|
|
x)))))
|
|
(deftest
|
|
"function returning closure then call"
|
|
(assert-equal
|
|
15
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((make-adder (fn (n) (fn (x) (+ n x)))))
|
|
(let
|
|
((add5 (make-adder 5)) (add10 (make-adder 10)))
|
|
(add5 (add10 0))))))))
|
|
(deftest
|
|
"for-each with side effects"
|
|
(assert-equal
|
|
6
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((sum 0))
|
|
(for-each (fn (x) (set! sum (+ sum x))) (list 1 2 3))
|
|
sum)))))
|
|
(deftest
|
|
"map then use result"
|
|
(assert-equal
|
|
20
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((doubled (map (fn (x) (* x 2)) (list 1 2 3 4))))
|
|
(reduce + 0 doubled))))))
|
|
(deftest
|
|
"function call in let binding then body"
|
|
(assert-equal
|
|
25
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((square (fn (x) (* x x))))
|
|
(let ((a (square 3)) (b (square 4))) (+ a b)))))))
|
|
(deftest
|
|
"callback from higher-order function"
|
|
(assert-equal
|
|
3
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((apply-twice (fn (f x) (f (f x)))))
|
|
(apply-twice (fn (n) (+ n 1)) 1))))))
|
|
(deftest
|
|
"do block with interleaved calls"
|
|
(assert-equal
|
|
30
|
|
(vm-eval
|
|
(quote
|
|
(let
|
|
((x 0) (f (fn (n) (* n 5))))
|
|
(do
|
|
(set! x (+ x (f 1)))
|
|
(set! x (+ x (f 2)))
|
|
(set! x (+ x (f 3))))
|
|
x))))))
|
|
|
|
(defsuite
|
|
"vm-cek-bridge"
|
|
(deftest
|
|
"compiled fn calls another compiled fn"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define double (fn (x) (* x 2)))) g)
|
|
(vm-eval-with
|
|
(quote (define use-double (fn (n) (+ 1 (double n)))))
|
|
g)
|
|
(assert-equal 11 (vm-eval-with (quote (use-double 5)) g))))
|
|
(deftest
|
|
"compiled fn calls compiled fn then continues"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define helper (fn (x) (+ x 10)))) g)
|
|
(vm-eval-with
|
|
(quote (define main (fn () (let ((a (helper 5))) (+ a 100)))))
|
|
g)
|
|
(assert-equal 115 (vm-eval-with (quote (main)) g))))
|
|
(deftest
|
|
"compiled fn with side effect after nested call"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define f (fn (x) (* x 3)))) g)
|
|
(vm-eval-with
|
|
(quote
|
|
(define run (fn () (let ((x 0)) (set! x (f 7)) (+ x 1)))))
|
|
g)
|
|
(assert-equal 22 (vm-eval-with (quote (run)) g))))
|
|
(deftest
|
|
"three-deep compiled call chain"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define a (fn (x) (+ x 1)))) g)
|
|
(vm-eval-with (quote (define b (fn (x) (* (a x) 2)))) g)
|
|
(vm-eval-with (quote (define c (fn (x) (+ (b x) 100)))) g)
|
|
(assert-equal 112 (vm-eval-with (quote (c 5)) g))))
|
|
(deftest
|
|
"compiled fn with when block multiple body forms"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define f (fn (x) (* x 10)))) g)
|
|
(vm-eval-with
|
|
(quote
|
|
(define
|
|
run
|
|
(fn
|
|
()
|
|
(let
|
|
((result 0))
|
|
(when true (f 1) (set! result (f 5)))
|
|
result))))
|
|
g)
|
|
(assert-equal 50 (vm-eval-with (quote (run)) g))))
|
|
(deftest
|
|
"compiled fn for-each calling compiled fn"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define process (fn (x) (* x 2)))) g)
|
|
(vm-eval-with
|
|
(quote
|
|
(define
|
|
run
|
|
(fn
|
|
()
|
|
(let
|
|
((sum 0))
|
|
(for-each
|
|
(fn (x) (set! sum (+ sum (process x))))
|
|
(list 1 2 3))
|
|
sum))))
|
|
g)
|
|
(assert-equal 12 (vm-eval-with (quote (run)) g))))
|
|
(deftest
|
|
"compiled fn returns closure then caller continues"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define wrap (fn (x) (fn () x)))) g)
|
|
(vm-eval-with
|
|
(quote (define run (fn () (let ((f (wrap 42))) (+ (f) 8)))))
|
|
g)
|
|
(assert-equal 50 (vm-eval-with (quote (run)) g))))
|
|
(deftest
|
|
"multiple sequential calls from one compiled fn"
|
|
(let
|
|
((g (dict)))
|
|
(vm-eval-with (quote (define inc (fn (x) (+ x 1)))) g)
|
|
(vm-eval-with
|
|
(quote (define run (fn () (+ (inc 0) (inc 10) (inc 20)))))
|
|
g)
|
|
(assert-equal 33 (vm-eval-with (quote (run)) g)))))
|