giles
f3f70cc00b
spec/ now contains only the language definition (5 files): evaluator.sx, parser.sx, primitives.sx, render.sx, special-forms.sx lib/ contains code written IN the language (8 files): stdlib.sx, types.sx, freeze.sx, content.sx, bytecode.sx, compiler.sx, vm.sx, callcc.sx Test files follow source: spec/tests/ for core language tests, lib/tests/ for library tests (continuations, freeze, types, vm). Updated all consumers: - JS/Python/OCaml bootstrappers: added lib/ to source search paths - OCaml bridge: spec_dir for parser/render, lib_dir for compiler/freeze - JS test runner: scans spec/tests/ (always) + lib/tests/ (--full) - OCaml test runner: scans spec/tests/, lib tests via explicit request - Docker dev mounts: added ./lib:/app/lib:ro Tests: 1041 JS standard, 1322 JS full, 1101 OCaml — all pass Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
245 lines
8.3 KiB
Plaintext
245 lines
8.3 KiB
Plaintext
;; ==========================================================================
|
|
;; test-vm-closures.sx — Tests for inner closure recursion patterns
|
|
;;
|
|
;; Requires: test-framework.sx loaded first.
|
|
;;
|
|
;; These tests exercise patterns where inner closures recurse deeply
|
|
;; while sharing mutable state via upvalues. This is the sx-parse
|
|
;; pattern: many inner functions close over a mutable cursor variable.
|
|
;; Without proper VM closure support, each recursive call would
|
|
;; allocate a fresh VM — blowing the stack or hanging.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Inner closure recursion with mutable upvalues
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "inner-closure-recursion"
|
|
(deftest "self-recursive inner closure with set! on captured variable"
|
|
;; Pattern: closure mutates captured var on each recursive call.
|
|
;; This is the core pattern in skip-ws, read-str-loop, etc.
|
|
(let ((counter 0))
|
|
(define count-up
|
|
(fn (n)
|
|
(when (> n 0)
|
|
(set! counter (+ counter 1))
|
|
(count-up (- n 1)))))
|
|
(count-up 100)
|
|
(assert-equal 100 counter)))
|
|
|
|
(deftest "deep inner closure recursion (500 iterations)"
|
|
;; Stress test: 500 recursive calls through an inner closure
|
|
;; mutating a shared upvalue. Would stack-overflow without TCO.
|
|
(let ((acc 0))
|
|
(define sum-up
|
|
(fn (n)
|
|
(if (<= n 0)
|
|
acc
|
|
(do (set! acc (+ acc n))
|
|
(sum-up (- n 1))))))
|
|
(assert-equal 125250 (sum-up 500))))
|
|
|
|
(deftest "inner closure reading captured variable updated by another"
|
|
;; Two closures: one writes, one reads, sharing the same binding.
|
|
(let ((pos 0))
|
|
(define advance! (fn () (set! pos (+ pos 1))))
|
|
(define current (fn () pos))
|
|
(advance!)
|
|
(advance!)
|
|
(advance!)
|
|
(assert-equal 3 (current))))
|
|
|
|
(deftest "recursive closure with multiple mutable upvalues"
|
|
;; Like sx-parse: multiple cursor variables mutated during recursion.
|
|
(let ((pos 0)
|
|
(count 0))
|
|
(define scan
|
|
(fn (source)
|
|
(when (< pos (len source))
|
|
(set! count (+ count 1))
|
|
(set! pos (+ pos 1))
|
|
(scan source))))
|
|
(scan "hello world")
|
|
(assert-equal 11 pos)
|
|
(assert-equal 11 count))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Mutual recursion between inner closures
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "mutual-inner-closures"
|
|
(deftest "two inner closures calling each other"
|
|
;; Pattern: read-expr calls read-list, read-list calls read-expr.
|
|
(let ((result (list)))
|
|
(define process-a
|
|
(fn (items)
|
|
(when (not (empty? items))
|
|
(append! result (str "a:" (first items)))
|
|
(process-b (rest items)))))
|
|
(define process-b
|
|
(fn (items)
|
|
(when (not (empty? items))
|
|
(append! result (str "b:" (first items)))
|
|
(process-a (rest items)))))
|
|
(process-a (list 1 2 3 4))
|
|
(assert-equal 4 (len result))
|
|
(assert-equal "a:1" (nth result 0))
|
|
(assert-equal "b:2" (nth result 1))
|
|
(assert-equal "a:3" (nth result 2))
|
|
(assert-equal "b:4" (nth result 3))))
|
|
|
|
(deftest "mutual recursion with shared mutable state"
|
|
;; Both closures read and write the same captured variable.
|
|
(let ((pos 0)
|
|
(source "aAbBcC"))
|
|
(define skip-lower
|
|
(fn ()
|
|
(when (and (< pos (len source))
|
|
(>= (nth source pos) "a")
|
|
(<= (nth source pos) "z"))
|
|
(set! pos (+ pos 1))
|
|
(skip-upper))))
|
|
(define skip-upper
|
|
(fn ()
|
|
(when (and (< pos (len source))
|
|
(>= (nth source pos) "A")
|
|
(<= (nth source pos) "Z"))
|
|
(set! pos (+ pos 1))
|
|
(skip-lower))))
|
|
(skip-lower)
|
|
(assert-equal 6 pos)))
|
|
|
|
(deftest "three-way mutual recursion"
|
|
(let ((n 30)
|
|
(result nil))
|
|
(define step-a
|
|
(fn (i)
|
|
(if (>= i n)
|
|
(set! result "done")
|
|
(step-b (+ i 1)))))
|
|
(define step-b
|
|
(fn (i)
|
|
(step-c (+ i 1))))
|
|
(define step-c
|
|
(fn (i)
|
|
(step-a (+ i 1))))
|
|
(step-a 0)
|
|
(assert-equal "done" result))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Parser-like patterns (the sx-parse structure)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "parser-pattern"
|
|
(deftest "mini-parser: tokenize digits from string"
|
|
;; Simplified sx-parse pattern: closure over pos + source,
|
|
;; multiple inner functions sharing the mutable cursor.
|
|
(let ((pos 0)
|
|
(source "12 34 56")
|
|
(len-src 8))
|
|
|
|
(define skip-ws
|
|
(fn ()
|
|
(when (and (< pos len-src) (= (nth source pos) " "))
|
|
(set! pos (+ pos 1))
|
|
(skip-ws))))
|
|
|
|
(define read-digits
|
|
(fn ()
|
|
(let ((start pos))
|
|
(define digit-loop
|
|
(fn ()
|
|
(when (and (< pos len-src)
|
|
(>= (nth source pos) "0")
|
|
(<= (nth source pos) "9"))
|
|
(set! pos (+ pos 1))
|
|
(digit-loop))))
|
|
(digit-loop)
|
|
(slice source start pos))))
|
|
|
|
(define read-all
|
|
(fn ()
|
|
(let ((tokens (list)))
|
|
(define parse-loop
|
|
(fn ()
|
|
(skip-ws)
|
|
(when (< pos len-src)
|
|
(append! tokens (read-digits))
|
|
(parse-loop))))
|
|
(parse-loop)
|
|
tokens)))
|
|
|
|
(let ((tokens (read-all)))
|
|
(assert-equal 3 (len tokens))
|
|
(assert-equal "12" (nth tokens 0))
|
|
(assert-equal "34" (nth tokens 1))
|
|
(assert-equal "56" (nth tokens 2)))))
|
|
|
|
(deftest "nested inner closures with upvalue chain"
|
|
;; Inner function defines its own inner function,
|
|
;; both closing over the outer mutable variable.
|
|
(let ((total 0))
|
|
(define outer-fn
|
|
(fn (items)
|
|
(for-each
|
|
(fn (item)
|
|
(let ((sub-total 0))
|
|
(define inner-loop
|
|
(fn (n)
|
|
(when (> n 0)
|
|
(set! sub-total (+ sub-total 1))
|
|
(set! total (+ total 1))
|
|
(inner-loop (- n 1)))))
|
|
(inner-loop item)))
|
|
items)))
|
|
(outer-fn (list 3 2 1))
|
|
(assert-equal 6 total)))
|
|
|
|
(deftest "closure returning accumulated list via append!"
|
|
;; Pattern from read-list: loop appends to mutable list, returns it.
|
|
(let ((items (list)))
|
|
(define collect
|
|
(fn (source pos)
|
|
(if (>= pos (len source))
|
|
items
|
|
(do (append! items (nth source pos))
|
|
(collect source (+ pos 1))))))
|
|
(let ((result (collect (list "a" "b" "c" "d") 0)))
|
|
(assert-equal 4 (len result))
|
|
(assert-equal "a" (first result))
|
|
(assert-equal "d" (last result))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Closures as callbacks to higher-order functions
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "closure-ho-callbacks"
|
|
(deftest "map with closure that mutates captured variable"
|
|
(let ((running-total 0))
|
|
(let ((results (map (fn (x)
|
|
(set! running-total (+ running-total x))
|
|
running-total)
|
|
(list 1 2 3 4))))
|
|
(assert-equal (list 1 3 6 10) results)
|
|
(assert-equal 10 running-total))))
|
|
|
|
(deftest "reduce with closure over external state"
|
|
(let ((call-count 0))
|
|
(let ((sum (reduce (fn (acc x)
|
|
(set! call-count (+ call-count 1))
|
|
(+ acc x))
|
|
0
|
|
(list 10 20 30))))
|
|
(assert-equal 60 sum)
|
|
(assert-equal 3 call-count))))
|
|
|
|
(deftest "filter with closure reading shared state"
|
|
(let ((threshold 3))
|
|
(let ((result (filter (fn (x) (> x threshold))
|
|
(list 1 2 3 4 5))))
|
|
(assert-equal (list 4 5) result)))))
|