giles
4baed1853c
- R7RS parameter primitives (make-parameter, parameter?, parameterize support) - VM closure get_val introspection (vm-code, vm-upvalues, vm-name, vm-globals) - Lazy list caching on vm_code for transpiled VM performance - VM import suspension: check_io_suspension + resume_module for browser lazy loading - 23 new R7RS tests (parameter-basic, parameterize-basic, syntax-rules-basic) - Playwright bytecode-loading spec + WASM rebuild Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
372 lines
10 KiB
Plaintext
372 lines
10 KiB
Plaintext
(defsuite
|
|
"callcc-basic"
|
|
(deftest "simple escape" (assert= (call/cc (fn (k) (k 42))) 42))
|
|
(deftest "normal return (k unused)" (assert= (call/cc (fn (k) 99)) 99))
|
|
(deftest
|
|
"escape from nested expression"
|
|
(assert= (+ 1 (call/cc (fn (k) (+ 10 (k 42))))) 43))
|
|
(deftest
|
|
"call-with-current-continuation alias"
|
|
(assert= (call-with-current-continuation (fn (k) (k 77))) 77))
|
|
(deftest
|
|
"call/cc in let binding"
|
|
(assert= (let ((x (call/cc (fn (k) (k 5))))) (+ x 10)) 15))
|
|
(deftest
|
|
"call/cc in tail position"
|
|
(assert= (if true (call/cc (fn (k) (k 1))) 2) 1))
|
|
(deftest
|
|
"call/cc with no args to k"
|
|
(assert= (call/cc (fn (k) (k))) nil)))
|
|
|
|
(defsuite
|
|
"raise-basic"
|
|
(deftest
|
|
"raise with handler-bind"
|
|
(assert=
|
|
(handler-bind
|
|
(((fn (c) true) (fn (c) c)))
|
|
(+ 1 (raise-continuable 42)))
|
|
43))
|
|
(deftest
|
|
"raise-continuable returns to call site"
|
|
(assert=
|
|
(handler-bind
|
|
(((fn (c) true) (fn (c) (+ c 100))))
|
|
(+ 1 (raise-continuable 42)))
|
|
143))
|
|
(deftest
|
|
"raise non-continuable errors on handler return"
|
|
(assert=
|
|
(try-catch
|
|
(fn () (handler-bind (((fn (c) true) (fn (c) c))) (raise 42)))
|
|
(fn (e) "caught"))
|
|
"caught"))
|
|
(deftest
|
|
"unhandled raise gives host error"
|
|
(assert=
|
|
(try-catch (fn () (raise 99)) (fn (e) "unhandled"))
|
|
"unhandled")))
|
|
|
|
(defsuite
|
|
"guard-basic"
|
|
(deftest
|
|
"guard catches with matching clause"
|
|
(assert= (guard (exn ((number? exn) (+ exn 1))) (raise 41)) 42))
|
|
(deftest
|
|
"guard with else clause"
|
|
(assert= (guard (exn (else "caught")) (raise "boom")) "caught"))
|
|
(deftest
|
|
"guard passes through on no exception"
|
|
(assert= (guard (exn (else "caught")) (+ 1 2)) 3))
|
|
(deftest
|
|
"guard re-raises when no clause matches"
|
|
(assert=
|
|
(try-catch
|
|
(fn
|
|
()
|
|
(guard (exn ((number? exn) "number")) (raise "string-value")))
|
|
(fn (e) "re-raised"))
|
|
"re-raised"))
|
|
(deftest
|
|
"nested guard"
|
|
(assert=
|
|
(guard
|
|
(outer (else (str "outer: " (error-message outer))))
|
|
(guard (inner ((number? inner) (+ inner 1))) (raise 41)))
|
|
42)))
|
|
|
|
(defsuite
|
|
"with-exception-handler"
|
|
(deftest
|
|
"basic catch with continuable"
|
|
(assert=
|
|
(with-exception-handler
|
|
(fn (c) (+ c 100))
|
|
(fn () (+ 1 (raise-continuable 42))))
|
|
143)))
|
|
|
|
(defsuite
|
|
"error-objects"
|
|
(deftest
|
|
"make-error-object creates dict"
|
|
(assert (error-object? (make-error-object "test" (list)))))
|
|
(deftest
|
|
"error-message accessor"
|
|
(assert= (error-message (make-error-object "hello" (list))) "hello"))
|
|
(deftest
|
|
"error-object-irritants accessor"
|
|
(assert=
|
|
(error-object-irritants (make-error-object "msg" (list 1 2 3)))
|
|
(list 1 2 3)))
|
|
(deftest
|
|
"raise error object caught by guard"
|
|
(assert=
|
|
(guard
|
|
(exn ((error-object? exn) (error-message exn)))
|
|
(raise (make-error-object "test error" (list 1 2))))
|
|
"test error")))
|
|
|
|
(defsuite
|
|
"multi-map"
|
|
(deftest
|
|
"map over two lists"
|
|
(assert= (map + (list 1 2 3) (list 10 20 30)) (list 11 22 33)))
|
|
(deftest
|
|
"map over three lists"
|
|
(assert=
|
|
(map + (list 1 2) (list 10 20) (list 100 200))
|
|
(list 111 222)))
|
|
(deftest
|
|
"stops at shortest list"
|
|
(assert= (map + (list 1 2 3) (list 10 20)) (list 11 22)))
|
|
(deftest
|
|
"empty list returns empty"
|
|
(assert= (map + (list) (list 1 2)) (list)))
|
|
(deftest
|
|
"single list backwards compat"
|
|
(assert= (map (fn (x) (* x 2)) (list 1 2 3)) (list 2 4 6)))
|
|
(deftest
|
|
"map list constructor over two lists"
|
|
(assert=
|
|
(map (fn (a b) (list a b)) (list 1 2) (list 3 4))
|
|
(list (list 1 3) (list 2 4)))))
|
|
|
|
(defsuite
|
|
"cond-arrow"
|
|
(deftest
|
|
"basic arrow clause"
|
|
(assert= (cond (1 => (fn (x) (+ x 10)))) 11))
|
|
(deftest "arrow with identity" (assert= (cond (42 => (fn (x) x))) 42))
|
|
(deftest
|
|
"false clause skipped, else taken"
|
|
(assert= (cond (false => (fn (x) x)) (else 99)) 99))
|
|
(deftest
|
|
"arrow with complex expression"
|
|
(assert= (cond (42 => (fn (x) (* x 2)))) 84)))
|
|
|
|
(defsuite
|
|
"do-iteration"
|
|
(deftest "basic count" (assert= (do ((i 0 (+ i 1))) ((= i 5) i)) 5))
|
|
(deftest
|
|
"accumulator"
|
|
(assert= (do ((i 0 (+ i 1)) (sum 0 (+ sum i))) ((= i 4) sum)) 6))
|
|
(deftest
|
|
"collect into list"
|
|
(assert=
|
|
(do ((v (list) (append v (list i))) (i 0 (+ i 1))) ((= i 3) v))
|
|
(list 0 1 2)))
|
|
(deftest
|
|
"do as begin still works"
|
|
(assert= (let ((x 0)) (do (set! x 42)) x) 42)))
|
|
|
|
(defsuite
|
|
"r7rs-aliases"
|
|
(deftest
|
|
"car/cdr"
|
|
(assert= (car (list 1 2 3)) 1)
|
|
(assert= (cdr (list 1 2 3)) (list 2 3)))
|
|
(deftest "cadr" (assert= (cadr (list 1 2 3)) 2))
|
|
(deftest
|
|
"null?"
|
|
(assert (null? nil))
|
|
(assert (null? (list)))
|
|
(assert (not (null? (list 1)))))
|
|
(deftest
|
|
"pair?"
|
|
(assert (pair? (list 1)))
|
|
(assert (not (pair? (list))))
|
|
(assert (not (pair? 42))))
|
|
(deftest
|
|
"procedure?"
|
|
(assert (procedure? (fn () 1)))
|
|
(assert (procedure? +))
|
|
(assert (not (procedure? 42))))
|
|
(deftest
|
|
"integer?"
|
|
(assert (integer? 42))
|
|
(assert (integer? 0))
|
|
(assert (not (integer? 3.14)))
|
|
(assert (not (integer? "hello"))))
|
|
(deftest
|
|
"symbol->string"
|
|
(assert= (symbol->string (quote hello)) "hello"))
|
|
(deftest "number->string" (assert= (number->string 42) "42"))
|
|
(deftest
|
|
"boolean=?"
|
|
(assert (boolean=? true true))
|
|
(assert (boolean=? false false))
|
|
(assert (not (boolean=? true false)))))
|
|
|
|
(defsuite
|
|
"parameter-basic"
|
|
(deftest
|
|
"make-parameter creates parameter"
|
|
(let ((p (make-parameter 42))) (assert (parameter? p))))
|
|
(deftest
|
|
"parameter returns default value"
|
|
(let ((p (make-parameter 42))) (assert= 42 (p))))
|
|
(deftest
|
|
"parameter? false for non-parameters"
|
|
(do
|
|
(assert= false (parameter? 42))
|
|
(assert= false (parameter? "hello"))
|
|
(assert= false (parameter? (list 1 2)))))
|
|
(deftest
|
|
"two parameters are independent"
|
|
(let
|
|
((p1 (make-parameter 10)) (p2 (make-parameter 20)))
|
|
(do (assert= 10 (p1)) (assert= 20 (p2))))))
|
|
|
|
(defsuite
|
|
"parameterize-basic"
|
|
(deftest
|
|
"parameterize rebinds single parameter"
|
|
(let
|
|
((p (make-parameter 1)))
|
|
(assert= 99 (parameterize ((p 99)) (p)))))
|
|
(deftest
|
|
"parameterize restores after body"
|
|
(let
|
|
((p (make-parameter 1)))
|
|
(do (parameterize ((p 99)) (p)) (assert= 1 (p)))))
|
|
(deftest
|
|
"parameterize with multiple bindings"
|
|
(let
|
|
((p1 (make-parameter 10)) (p2 (make-parameter 20)))
|
|
(parameterize
|
|
((p1 100) (p2 200))
|
|
(do (assert= 100 (p1)) (assert= 200 (p2))))))
|
|
(deftest
|
|
"nested parameterize"
|
|
(let
|
|
((p (make-parameter 1)))
|
|
(parameterize
|
|
((p 10))
|
|
(do
|
|
(assert= 10 (p))
|
|
(parameterize ((p 100)) (assert= 100 (p)))
|
|
(assert= 10 (p))))))
|
|
(deftest
|
|
"parameterize with empty bindings"
|
|
(assert= 42 (parameterize () 42)))
|
|
(deftest
|
|
"parameterize body returns last expr"
|
|
(let
|
|
((p (make-parameter 0)))
|
|
(assert= 3 (parameterize ((p 3)) 1 2 (p))))))
|
|
|
|
(defsuite
|
|
"syntax-rules-basic"
|
|
(deftest
|
|
"simple constant pattern"
|
|
(do
|
|
(define-syntax my-const
|
|
(syntax-rules ()
|
|
((_) 42)))
|
|
(assert= 42 (my-const))))
|
|
(deftest
|
|
"pattern with variable"
|
|
(do
|
|
(define-syntax my-id
|
|
(syntax-rules ()
|
|
((_ x) x)))
|
|
(assert= 7 (my-id 7))))
|
|
(deftest
|
|
"variable in template expression"
|
|
(do
|
|
(define-syntax my-double
|
|
(syntax-rules ()
|
|
((_ x) (+ x x))))
|
|
(assert= 10 (my-double 5))))
|
|
(deftest
|
|
"multiple clauses by arity"
|
|
(do
|
|
(define-syntax my-if2
|
|
(syntax-rules ()
|
|
((_ test then) (if test then nil))
|
|
((_ test then else-expr) (if test then else-expr))))
|
|
(assert= 1 (my-if2 true 1))
|
|
(assert= 2 (my-if2 false 1 2))))
|
|
(deftest
|
|
"ellipsis collects zero-or-more"
|
|
(do
|
|
(define-syntax my-list
|
|
(syntax-rules ()
|
|
((_ x ...) (list x ...))))
|
|
(assert= (list 1 2 3) (my-list 1 2 3))
|
|
(assert= (list) (my-list))))
|
|
(deftest
|
|
"nested pattern"
|
|
(do
|
|
(define-syntax my-let1
|
|
(syntax-rules ()
|
|
((_ ((var val)) body) (let ((var val)) body))))
|
|
(assert= 10 (my-let1 ((x 10)) x))))
|
|
(deftest
|
|
"literal keyword matching"
|
|
(do
|
|
(define-syntax my-arrow
|
|
(syntax-rules (=>)
|
|
((_ x => y) (list x y))))
|
|
(assert= (list 1 2) (my-arrow 1 => 2))))
|
|
(deftest
|
|
"literal keyword no match falls through"
|
|
(do
|
|
(define-syntax my-cond
|
|
(syntax-rules (=>)
|
|
((_ x => fn-expr) (fn-expr x))
|
|
((_ x y) (list x y))))
|
|
(assert= (list 3 4) (my-cond 3 4))))
|
|
(deftest
|
|
"recursive macro with ellipsis"
|
|
(do
|
|
(define-syntax my-and
|
|
(syntax-rules ()
|
|
((_) true)
|
|
((_ e) e)
|
|
((_ e1 e2 ...) (if e1 (my-and e2 ...) false))))
|
|
(assert= true (my-and))
|
|
(assert= 5 (my-and 5))
|
|
(assert= true (my-and true true true))
|
|
(assert= false (my-and true false true))))
|
|
(deftest
|
|
"swap macro"
|
|
(do
|
|
(define-syntax my-swap!
|
|
(syntax-rules ()
|
|
((_ a b) (let ((tmp a)) (set! a b) (set! b tmp)))))
|
|
(let ((x 1) (y 2))
|
|
(my-swap! x y)
|
|
(assert= 2 x)
|
|
(assert= 1 y))))
|
|
(deftest
|
|
"when macro via syntax-rules"
|
|
(do
|
|
(define-syntax my-when
|
|
(syntax-rules ()
|
|
((_ test body ...) (if test (do body ...) nil))))
|
|
(assert= nil (my-when false 1 2 3))
|
|
(assert= 3 (my-when true 1 2 3))))
|
|
(deftest
|
|
"nested ellipsis in binding pairs"
|
|
(do
|
|
(define-syntax my-let
|
|
(syntax-rules ()
|
|
((_ ((var val) ...) body)
|
|
(let ((var val) ...) body))))
|
|
(assert= 6 (my-let ((a 1) (b 2) (c 3)) (+ a b c)))))
|
|
(deftest
|
|
"or macro with short-circuit"
|
|
(do
|
|
(define-syntax my-or
|
|
(syntax-rules ()
|
|
((_) false)
|
|
((_ e) e)
|
|
((_ e1 e2 ...)
|
|
(let ((t e1)) (if t t (my-or e2 ...))))))
|
|
(assert= false (my-or))
|
|
(assert= 42 (my-or 42))
|
|
(assert= 1 (my-or 1 2 3))
|
|
(assert= 3 (my-or false false 3))
|
|
(assert= false (my-or false false false)))))
|