Fix isomorphic SSR: revert inline opcodes, add named let compilation, fix cookie decode
Three bugs broke island SSR rendering of the home stepper widget: 1. Inline VM opcodes (OP_ADD..OP_DEC) broke JIT-compiled functions. The compiler emitted single-byte opcodes for first/rest/len/= etc. that produced wrong results in complex recursive code (sx-parse returned nil, split-tag produced 1 step instead of 16). Reverted compiler to use CALL_PRIM for all primitives. VM opcode handlers kept for future use. 2. Named let (let loop ((x init)) body) had no compiler support — silently produced broken bytecode. Added desugaring to letrec. 3. URL-encoded cookie values not decoded server-side. Client set-cookie uses encodeURIComponent but Werkzeug doesn't decode cookie values. Added unquote() in bridge cookie injection. Also: call-lambda used eval_expr which copies Dict values (signals), breaking mutations through aser lambda calls. Switched to cek_call. Also: stepper preview now includes ~cssx/tw spreads for SSR styling. Tests: 1317 JS, 1114 OCaml, 26 integration (2 pre-existing failures) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -387,25 +387,46 @@
|
||||
|
||||
(define compile-let
|
||||
(fn (em args scope tail?)
|
||||
(let ((bindings (first args))
|
||||
(body (rest args))
|
||||
(let-scope (make-scope scope)))
|
||||
;; Let scopes share the enclosing function's frame.
|
||||
;; Continue slot numbering from parent.
|
||||
(dict-set! let-scope "next-slot" (get scope "next-slot"))
|
||||
;; Compile each binding
|
||||
(for-each (fn (binding)
|
||||
(let ((name (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(first binding)))
|
||||
(value (nth binding 1))
|
||||
(slot (scope-define-local let-scope name)))
|
||||
(compile-expr em value let-scope false)
|
||||
(emit-op em 17) ;; OP_LOCAL_SET
|
||||
(emit-byte em slot)))
|
||||
bindings)
|
||||
;; Compile body in let scope
|
||||
(compile-begin em body let-scope tail?))))
|
||||
;; Detect named let: (let loop ((x init) ...) body)
|
||||
(if (= (type-of (first args)) "symbol")
|
||||
;; Named let → desugar to letrec:
|
||||
;; (letrec ((loop (fn (x ...) body))) (loop init ...))
|
||||
(let ((loop-name (symbol-name (first args)))
|
||||
(bindings (nth args 1))
|
||||
(body (slice args 2))
|
||||
(params (list))
|
||||
(inits (list)))
|
||||
(for-each (fn (binding)
|
||||
(append! params (if (= (type-of (first binding)) "symbol")
|
||||
(first binding)
|
||||
(make-symbol (first binding))))
|
||||
(append! inits (nth binding 1)))
|
||||
bindings)
|
||||
;; Compile as: (letrec ((loop (fn (params...) body...))) (loop inits...))
|
||||
(let ((lambda-expr (concat (list (make-symbol "fn") params) body))
|
||||
(letrec-bindings (list (list (make-symbol loop-name) lambda-expr)))
|
||||
(call-expr (cons (make-symbol loop-name) inits)))
|
||||
(compile-letrec em (list letrec-bindings call-expr) scope tail?)))
|
||||
;; Normal let
|
||||
(let ((bindings (first args))
|
||||
(body (rest args))
|
||||
(let-scope (make-scope scope)))
|
||||
;; Let scopes share the enclosing function's frame.
|
||||
;; Continue slot numbering from parent.
|
||||
(dict-set! let-scope "next-slot" (get scope "next-slot"))
|
||||
;; Compile each binding
|
||||
(for-each (fn (binding)
|
||||
(let ((name (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(first binding)))
|
||||
(value (nth binding 1))
|
||||
(slot (scope-define-local let-scope name)))
|
||||
(compile-expr em value let-scope false)
|
||||
(emit-op em 17) ;; OP_LOCAL_SET
|
||||
(emit-byte em slot)))
|
||||
bindings)
|
||||
;; Compile body in let scope
|
||||
(compile-begin em body let-scope tail?)))))
|
||||
|
||||
|
||||
(define compile-letrec
|
||||
@@ -756,40 +777,14 @@
|
||||
(not (= (get (scope-resolve scope name) "type") "upvalue"))
|
||||
(primitive? name))))))
|
||||
(if is-prim
|
||||
;; Direct primitive call — try inline opcode first
|
||||
;; Direct primitive call via CALL_PRIM
|
||||
(let ((name (symbol-name head))
|
||||
(argc (len args))
|
||||
(inline-op
|
||||
(cond
|
||||
;; Binary arithmetic/comparison (2 args)
|
||||
(and (= argc 2) (= name "+")) 160
|
||||
(and (= argc 2) (= name "-")) 161
|
||||
(and (= argc 2) (= name "*")) 162
|
||||
(and (= argc 2) (= name "/")) 163
|
||||
(and (= argc 2) (= name "=")) 164
|
||||
(and (= argc 2) (= name "<")) 165
|
||||
(and (= argc 2) (= name ">")) 166
|
||||
(and (= argc 2) (= name "nth")) 171
|
||||
(and (= argc 2) (= name "cons")) 172
|
||||
;; Unary (1 arg)
|
||||
(and (= argc 1) (= name "not")) 167
|
||||
(and (= argc 1) (= name "len")) 168
|
||||
(and (= argc 1) (= name "first")) 169
|
||||
(and (= argc 1) (= name "rest")) 170
|
||||
(and (= argc 1) (= name "inc")) 174
|
||||
(and (= argc 1) (= name "dec")) 175
|
||||
:else nil)))
|
||||
(if inline-op
|
||||
;; Emit inline opcode — no constant pool lookup, no argc byte
|
||||
(do
|
||||
(for-each (fn (a) (compile-expr em a scope false)) args)
|
||||
(emit-op em inline-op))
|
||||
;; Fallback: CALL_PRIM with name lookup
|
||||
(let ((name-idx (pool-add (get em "pool") name)))
|
||||
(for-each (fn (a) (compile-expr em a scope false)) args)
|
||||
(emit-op em 52) ;; OP_CALL_PRIM
|
||||
(emit-u16 em name-idx)
|
||||
(emit-byte em argc))))
|
||||
(name-idx (pool-add (get em "pool") name)))
|
||||
(for-each (fn (a) (compile-expr em a scope false)) args)
|
||||
(emit-op em 52) ;; OP_CALL_PRIM
|
||||
(emit-u16 em name-idx)
|
||||
(emit-byte em argc))
|
||||
;; General call
|
||||
(do
|
||||
(compile-expr em head scope false)
|
||||
|
||||
@@ -416,3 +416,80 @@
|
||||
(define double (fn (x) (* x 2)))
|
||||
(let ((inc-then-double (compose double inc)))
|
||||
(inc-then-double 20)))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; VM recursive mutation — closure capture must preserve mutable references
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Regression: recursive functions that append! to a shared mutable list
|
||||
;; lost mutations after the first call under JIT. The stepper island's
|
||||
;; split-tag function produced 1 step instead of 16, breaking SSR.
|
||||
|
||||
(defsuite "vm-recursive-mutation"
|
||||
(deftest "recursive append! to shared list"
|
||||
(assert-equal 3
|
||||
(vm-eval '(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 '(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 '(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 ;; skip component spreads
|
||||
(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)))))))
|
||||
|
||||
@@ -83,3 +83,35 @@
|
||||
(test "= with booleans" (= (= true true) true))
|
||||
(test "= with keywords" (= (= :foo :foo) true))
|
||||
(test "not with list" (= (not (list 1)) false))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Recursive mutation — VM closure capture must preserve mutable state
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Regression: recursive functions that append! to a shared mutable list
|
||||
;; lost mutations after the first call under JIT. The VM closure capture
|
||||
;; was copying the list value instead of sharing the mutable reference.
|
||||
|
||||
(test "recursive append! to shared list"
|
||||
(let ((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) 3))))
|
||||
|
||||
(test "recursive tree walk with append!"
|
||||
(let ((walk (fn (expr result)
|
||||
(cond
|
||||
(not (list? expr))
|
||||
(append! result "leaf")
|
||||
(empty? expr) nil
|
||||
:else
|
||||
(do (append! result "open")
|
||||
(for-each (fn (c) (walk c result)) (rest expr))
|
||||
(append! result "close"))))))
|
||||
(let ((tree (first (sx-parse "(div \"a\" (span \"b\") \"c\")")))
|
||||
(result (list)))
|
||||
(walk tree result)
|
||||
(= (len result) 7))))
|
||||
|
||||
Reference in New Issue
Block a user