VM: VmClosure value type + iterative run loop + define hoisting + SSR fixes
Core VM changes: - Add VmClosure value variant — inner closures created by OP_CLOSURE are first-class VM values, not NativeFn wrappers around call_closure - Convert `run` from recursive to while-loop — zero OCaml stack growth, true TCO for VmClosure tail calls - vm_call handles VmClosure by pushing frame on current VM (no new VM allocation per call) - Forward ref _vm_call_closure_ref for cross-boundary calls (CEK/primitives) Compiler (spec/compiler.sx): - Define hoisting in compile-begin: pre-allocate local slots for all define forms before compiling any values. Fixes forward references between inner functions (e.g. read-expr referencing skip-ws in sx-parse) - scope-define-local made idempotent (skip if slot already exists) Server (sx_server.ml): - JIT fail-once sentinel: mark l_compiled as failed after first VM runtime error. Eliminates thousands of retry attempts per page render. - HTML tag bindings: register all HTML tags as pass-through NativeFns so eval-expr can handle (div ...) etc. in island component bodies. - Log VM FAIL errors with function name before disabling JIT. SSR fixes: - adapter-html.sx letrec handler: evaluate bindings in proper letrec scope (pre-bind nil, then evaluate), render body with render-to-html instead of eval-expr. Fixes island SSR for components using letrec. - Add `init` primitive to OCaml kernel (all-but-last of list). - VmClosure handling in sx_runtime.ml sx_call dispatch. Tests: 971/971 OCaml (+19 new), 0 failures. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -50,12 +50,17 @@
|
||||
|
||||
(define scope-define-local
|
||||
(fn (scope name)
|
||||
"Add a local variable, return its slot index."
|
||||
(let ((slot (get scope "next-slot")))
|
||||
(append! (get scope "locals")
|
||||
{:name name :slot slot :mutable false})
|
||||
(dict-set! scope "next-slot" (+ slot 1))
|
||||
slot)))
|
||||
"Add a local variable, return its slot index.
|
||||
Idempotent: if name already has a slot, return it."
|
||||
(let ((existing (first (filter (fn (l) (= (get l "name") name))
|
||||
(get scope "locals")))))
|
||||
(if existing
|
||||
(get existing "slot")
|
||||
(let ((slot (get scope "next-slot")))
|
||||
(append! (get scope "locals")
|
||||
{:name name :slot slot :mutable false})
|
||||
(dict-set! scope "next-slot" (+ slot 1))
|
||||
slot)))))
|
||||
|
||||
(define scope-resolve
|
||||
(fn (scope name)
|
||||
@@ -354,6 +359,22 @@
|
||||
|
||||
(define compile-begin
|
||||
(fn (em exprs scope tail?)
|
||||
;; Hoist: pre-allocate local slots for all define forms in this block.
|
||||
;; Enables forward references between inner functions (e.g. sx-parse).
|
||||
;; Only inside function bodies (scope has parent), not at top level.
|
||||
(when (and (not (empty? exprs)) (not (nil? (get scope "parent"))))
|
||||
(for-each (fn (expr)
|
||||
(when (and (= (type-of expr) "list")
|
||||
(>= (len expr) 2)
|
||||
(= (type-of (first expr)) "symbol")
|
||||
(= (symbol-name (first expr)) "define"))
|
||||
(let ((name-expr (nth expr 1))
|
||||
(name (if (= (type-of name-expr) "symbol")
|
||||
(symbol-name name-expr)
|
||||
name-expr)))
|
||||
(scope-define-local scope name))))
|
||||
exprs))
|
||||
;; Compile expressions
|
||||
(if (empty? exprs)
|
||||
(emit-op em 2) ;; OP_NIL
|
||||
(if (= (len exprs) 1)
|
||||
@@ -483,11 +504,22 @@
|
||||
(skip-annotations (rest (rest items)))
|
||||
(first items))))))
|
||||
(skip-annotations rest-args))
|
||||
(first rest-args))))
|
||||
(name-idx (pool-add (get em "pool") name)))
|
||||
(compile-expr em value scope false)
|
||||
(emit-op em 128) ;; OP_DEFINE
|
||||
(emit-u16 em name-idx))))
|
||||
(first rest-args)))))
|
||||
;; Inside a function body, define creates a LOCAL binding.
|
||||
;; At top level (no enclosing function scope), define creates a global.
|
||||
;; Local binding prevents recursive calls from overwriting
|
||||
;; each other's defines in the flat globals hashtable.
|
||||
(if (not (nil? (get scope "parent")))
|
||||
;; Local define — allocate slot, compile value, set local
|
||||
(let ((slot (scope-define-local scope name)))
|
||||
(compile-expr em value scope false)
|
||||
(emit-op em 17) ;; OP_LOCAL_SET
|
||||
(emit-byte em slot))
|
||||
;; Top-level define — global
|
||||
(let ((name-idx (pool-add (get em "pool") name)))
|
||||
(compile-expr em value scope false)
|
||||
(emit-op em 128) ;; OP_DEFINE
|
||||
(emit-u16 em name-idx))))))
|
||||
|
||||
|
||||
(define compile-set
|
||||
|
||||
244
spec/tests/test-vm-closures.sx
Normal file
244
spec/tests/test-vm-closures.sx
Normal file
@@ -0,0 +1,244 @@
|
||||
;; ==========================================================================
|
||||
;; 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)))))
|
||||
Reference in New Issue
Block a user