From 57cffb8bcc48e61e24b11c3a4f366739448e24df Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 24 Mar 2026 22:32:51 +0000 Subject: [PATCH] Fix isomorphic SSR: revert inline opcodes, add named let compilation, fix cookie decode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/integration_tests.ml | 152 +++++++++++++++++++++++++-- hosts/ocaml/bin/sx_server.ml | 20 ++-- hosts/ocaml/lib/sx_vm.ml | 7 +- shared/static/scripts/sx-browser.js | 2 +- shared/sx/ocaml_bridge.py | 5 +- spec/compiler.sx | 97 ++++++++--------- spec/tests/test-vm.sx | 77 ++++++++++++++ spec/tests/vm-inline.sx | 32 ++++++ sx/sx/home-stepper.sx | 4 +- web/tests/test-aser.sx | 34 ++++++ 10 files changed, 360 insertions(+), 70 deletions(-) diff --git a/hosts/ocaml/bin/integration_tests.ml b/hosts/ocaml/bin/integration_tests.ml index 21cc68f..63ca2bf 100644 --- a/hosts/ocaml/bin/integration_tests.ml +++ b/hosts/ocaml/bin/integration_tests.ml @@ -217,12 +217,33 @@ let make_integration_env () = bind "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil); bind "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil); bind "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []); + bind "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil); + bind "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []); + bind "collect!" (fun _args -> Nil); + bind "collected" (fun _args -> List []); + bind "clear-collected!" (fun _args -> Nil); + bind "scope-collected" (fun _args -> List []); + bind "scope-clear-collected!" (fun _args -> Nil); + bind "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil); + bind "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil); + bind "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil); + bind "sx-context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil); (* Also register as primitives for prim_call *) Sx_primitives.register "scope-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil); Sx_primitives.register "scope-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil); Sx_primitives.register "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil); Sx_primitives.register "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil); Sx_primitives.register "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []); + Sx_primitives.register "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil); + Sx_primitives.register "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []); + Sx_primitives.register "collect!" (fun _args -> Nil); + Sx_primitives.register "collected" (fun _args -> List []); + Sx_primitives.register "clear-collected!" (fun _args -> Nil); + Sx_primitives.register "scope-collected" (fun _args -> List []); + Sx_primitives.register "scope-clear-collected!" (fun _args -> Nil); + Sx_primitives.register "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil); + Sx_primitives.register "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil); + Sx_primitives.register "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil); (* Render-mode flags *) ignore (env_bind env "*render-active*" (Bool false)); @@ -236,7 +257,7 @@ let make_integration_env () = "defstyle"; "defhandler"; "deftype"; "defeffect"; "defquery"; "defaction"; "defrelation"]) | _ -> Bool false); - (* Signal stubs for SSR *) + (* Signal stubs for SSR — overridden when signals.sx is loaded *) bind "signal" (fun args -> match args with [v] -> v | _ -> Nil); bind "computed" (fun args -> match args with [f] -> Sx_runtime.sx_call f [] | _ -> Nil); bind "deref" (fun args -> match args with [v] -> v | _ -> Nil); @@ -245,6 +266,85 @@ let make_integration_env () = bind "effect" (fun _args -> Nil); bind "batch" (fun _args -> Nil); + (* Type predicates — needed by adapter-sx.sx *) + bind "callable?" (fun args -> + match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false); + bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false); + bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false); + bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false); + bind "component?" (fun args -> + match args with [Component _] | [Island _] -> Bool true | _ -> Bool false); + bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false); + bind "lambda-params" (fun args -> + match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []); + bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil); + bind "lambda-closure" (fun args -> + match args with [Lambda l] -> Env l.l_closure | _ -> Dict (Hashtbl.create 0)); + bind "component-name" (fun args -> + match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> String ""); + bind "component-closure" (fun args -> + match args with [Component c] -> Env c.c_closure | [Island i] -> Env i.i_closure | _ -> Dict (Hashtbl.create 0)); + bind "component-params" (fun args -> + match args with + | [Component c] -> List (List.map (fun s -> String s) c.c_params) + | [Island i] -> List (List.map (fun s -> String s) i.i_params) + | _ -> Nil); + bind "component-body" (fun args -> + match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil); + bind "component-affinity" (fun args -> + match args with [Component c] -> String c.c_affinity + | [Island _] -> Nil | _ -> Nil); + bind "component-has-children?" (fun args -> + match args with + | [Component c] -> Bool (List.mem "children" c.c_params) + | [Island i] -> Bool (List.mem "children" i.i_params) + | _ -> Bool false); + + (* Evaluator bridge — needed by adapter-sx.sx *) + bind "call-lambda" (fun args -> + match args with + | [fn_val; List call_args; Env _e] -> + Sx_ref.cek_call fn_val (List call_args) + | [fn_val; List call_args] -> + Sx_ref.cek_call fn_val (List call_args) + | _ -> raise (Eval_error "call-lambda: expected (fn args env?)")); + bind "cek-call" (fun args -> + match args with + | [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args) + | [fn_val; Nil] -> Sx_ref.cek_call fn_val (List []) + | [fn_val] -> Sx_ref.cek_call fn_val (List []) + | _ -> Nil); + bind "expand-macro" (fun args -> + match args with + | [Macro m; List macro_args; Env e] -> + let body_env = { bindings = Hashtbl.create 16; parent = Some e } in + List.iteri (fun i p -> + let v = if i < List.length macro_args then List.nth macro_args i else Nil in + Hashtbl.replace body_env.bindings p v + ) m.m_params; + Sx_ref.eval_expr m.m_body (Env body_env) + | _ -> raise (Eval_error "expand-macro: expected (macro args env)")); + bind "eval-expr" (fun args -> + match args with + | [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e)) + | [expr] -> Sx_ref.eval_expr expr (Env env) + | _ -> raise (Eval_error "eval-expr: expected (expr env?)")); + bind "trampoline" (fun args -> + match args with + | [v] -> + let rec resolve v = match v with + | Thunk (body, closure_env) -> resolve (Sx_ref.eval_expr body (Env closure_env)) + | _ -> v + in resolve v + | _ -> raise (Eval_error "trampoline: expected 1 arg")); + bind "expand-components?" (fun _args -> Bool false); + bind "register-special-form!" (fun args -> + match args with + | [String name; handler] -> + ignore (Sx_ref.register_special_form (String name) handler); Nil + | _ -> raise (Eval_error "register-special-form!: expected (name handler)")); + ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms); + (* DOM stubs *) bind "create-text-node" (fun args -> match args with [String s] -> String s | _ -> Nil); bind "create-fragment" (fun _args -> Nil); @@ -360,13 +460,15 @@ let () = (* ================================================================== *) Printf.printf "\nSuite: SX adapter — components\n%!"; - assert_no_error "defcomp + render" (fun () -> - ignore (Sx_ref.eval_expr - (List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))")) - (Env env)); - sx_render_html "(~test-card :title \"Hi\" (p \"body\"))"); - assert_contains "component renders div" " + ignore (Sx_ref.eval_expr + (List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))")) + (Env env)); + sx_render_html "(~test-card :title \"Hi\" (p \"body\"))"); + assert_contains "component renders div" " incr fail_count; Printf.printf " FAIL: components — %s\n%!" msg); (* ================================================================== *) Printf.printf "\nSuite: eval-expr with HTML tag functions\n%!"; @@ -375,6 +477,40 @@ let () = assert_no_error "eval (span) returns list" (fun () -> Sx_ref.eval_expr (List [Symbol "span"; String "text"]) (Env env)); + (* ================================================================== *) + (* Regression: call-lambda re-evaluated Dict args through eval_expr, + which copies dicts. Mutations inside the lambda (e.g. signal + reset!) operated on the copy, not the original. This broke + island SSR where aser processes multi-body let forms. *) + Printf.printf "\nSuite: call-lambda dict identity (aser mode)\n%!"; + let aser_eval src = + let exprs = Sx_parser.parse_all src in + let expr = match exprs with [e] -> e | _ -> Nil in + let call = List [Symbol "aser"; List [Symbol "quote"; expr]; Env env] in + match Sx_ref.eval_expr call (Env env) with + | String s | SxExpr s -> s + | v -> value_to_string v + in + assert_eq "lambda dict mutation in aser multi-body let" + "99" + (aser_eval + "(let ((mutate! (fn (d k v) (dict-set! d k v))) + (d (dict \"x\" 1))) + (mutate! d \"x\" 99) + (get d \"x\"))"); + assert_eq "signal reset! in aser multi-body let" + "99" + (aser_eval + "(let ((s (signal 42))) + (reset! s 99) + (deref s))"); + assert_eq "signal reset! then len of deref" + "3" + (aser_eval + "(let ((s (signal (list)))) + (reset! s (list 1 2 3)) + (len (deref s)))"); + (* ================================================================== *) Printf.printf "\n"; Printf.printf "============================================================\n"; diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index a53415a..d23e127 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -292,11 +292,15 @@ let setup_io_env env = | _ -> raise (Eval_error "ctx: expected 1 arg")); bind "call-lambda" (fun args -> + (* Use cek_call instead of eval_expr to avoid re-evaluating + already-evaluated args. eval_expr copies Dict values (signals) + during evaluation, so mutations in the lambda body would affect + the copy, not the original. *) match args with - | [fn_val; List call_args; Env e] -> - Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e) + | [fn_val; List call_args; Env _e] -> + Sx_ref.cek_call fn_val (List call_args) | [fn_val; List call_args] -> - Sx_ref.eval_expr (List (fn_val :: call_args)) (Env env) + Sx_ref.cek_call fn_val (List call_args) | _ -> raise (Eval_error "call-lambda: expected (fn args env?)")); (* Register HO forms as callable NativeFn — the CEK machine handles them @@ -377,11 +381,15 @@ let setup_evaluator_bridge env = in resolve v | _ -> raise (Eval_error "trampoline: expected 1 arg")); bind "call-lambda" (fun args -> + (* Use cek_call instead of eval_expr to avoid re-evaluating + already-evaluated args. eval_expr copies Dict values (signals) + during evaluation, so mutations in the lambda body would affect + the copy, not the original. *) match args with - | [fn_val; List call_args; Env e] -> - Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e) + | [fn_val; List call_args; Env _e] -> + Sx_ref.cek_call fn_val (List call_args) | [fn_val; List call_args] -> - Sx_ref.eval_expr (List (fn_val :: call_args)) (Env env) + Sx_ref.cek_call fn_val (List call_args) | _ -> raise (Eval_error "call-lambda: expected (fn args env?)")); bind "cek-call" (fun args -> match args with diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index c014b3c..3597a49 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -418,7 +418,12 @@ and run vm = push vm (match a, b with Number x, Number y -> Number (x /. y) | _ -> Nil) | 164 (* OP_EQ *) -> let b = pop vm and a = pop vm in - push vm (Bool (a = b)) + (* Must normalize ListRef→List before structural compare, + same as the "=" primitive in sx_primitives.ml *) + let rec norm = function + | ListRef { contents = l } -> List (List.map norm l) + | List l -> List (List.map norm l) | v -> v in + push vm (Bool (norm a = norm b)) | 165 (* OP_LT *) -> let b = pop vm and a = pop vm in push vm (match a, b with Number x, Number y -> Bool (x < y) | String x, String y -> Bool (x < y) | _ -> Bool false) diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index d70edc1..18357a2 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -14,7 +14,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-03-24T20:05:12Z"; + var SX_VERSION = "2026-03-24T22:31:01Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } diff --git a/shared/sx/ocaml_bridge.py b/shared/sx/ocaml_bridge.py index b15c228..dc1fa40 100644 --- a/shared/sx/ocaml_bridge.py +++ b/shared/sx/ocaml_bridge.py @@ -228,9 +228,12 @@ class OcamlBridge: if not cookies: return # Build SX dict: {:name1 "val1" :name2 "val2"} + # Cookie values may be URL-encoded (client set-cookie uses + # encodeURIComponent) — decode before sending to kernel. + from urllib.parse import unquote pairs = [] for k, v in cookies.items(): - pairs.append(f':{k} "{_escape(str(v))}"') + pairs.append(f':{k} "{_escape(unquote(str(v)))}"') if pairs: cmd = f'(set-request-cookies {{{" ".join(pairs)}}})' try: diff --git a/spec/compiler.sx b/spec/compiler.sx index 59c08d0..c1aa987 100644 --- a/spec/compiler.sx +++ b/spec/compiler.sx @@ -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) diff --git a/spec/tests/test-vm.sx b/spec/tests/test-vm.sx index 01ff02b..80d6bf4 100644 --- a/spec/tests/test-vm.sx +++ b/spec/tests/test-vm.sx @@ -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))))))) diff --git a/spec/tests/vm-inline.sx b/spec/tests/vm-inline.sx index 733f377..9396e9a 100644 --- a/spec/tests/vm-inline.sx +++ b/spec/tests/vm-inline.sx @@ -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)))) diff --git a/sx/sx/home-stepper.sx b/sx/sx/home-stepper.sx index 4a6f1e2..9a8c684 100644 --- a/sx/sx/home-stepper.sx +++ b/sx/sx/home-stepper.sx @@ -116,10 +116,10 @@ (dict-set! pos "i" (+ (get pos "i") 1)) (let ((tag (get step "tag")) (attrs (or (get step "attrs") (list))) + (spreads (or (get step "spreads") (list))) (inner (build-children))) - ;; Skip spreads (~cssx/tw) — just structure + text (append! children - (concat (list (make-symbol tag)) attrs inner))) + (concat (list (make-symbol tag)) spreads attrs inner))) (loop)) (= stype "close") (do (dict-set! pos "i" (+ (get pos "i") 1)) diff --git a/web/tests/test-aser.sx b/web/tests/test-aser.sx index 74cc29e..1c59757 100644 --- a/web/tests/test-aser.sx +++ b/web/tests/test-aser.sx @@ -432,3 +432,37 @@ (render-sx "(do (defcomp ~page (&key x) (div x)) (case \"miss\" \"hit\" (~page :x \"found\") :else \"index\"))")))) + + +;; -------------------------------------------------------------------------- +;; Dict mutation through lambda calls in aser body +;; -------------------------------------------------------------------------- +;; +;; Regression: aser's :else branch used call-lambda which re-evaluated +;; args through eval_expr. The CEK evaluator copies Dict values during +;; evaluation (treating them as dict literals), so mutations inside the +;; lambda operated on a copy, not the original. This broke signal +;; reset!/swap! in island SSR where aser processes multi-body let forms. + +(defsuite "aser-dict-mutation" + (deftest "lambda mutating dict arg in multi-body let" + (assert-equal "99" + (render-sx + "(let ((mutate! (fn (d k v) (dict-set! d k v))) + (d (dict \"x\" 1))) + (mutate! d \"x\" 99) + (get d \"x\"))"))) + + (deftest "signal reset! in multi-body let" + (assert-equal "99" + (render-sx + "(let ((s (signal 42))) + (reset! s 99) + (deref s))"))) + + (deftest "signal reset! then len of deref in multi-body let" + (assert-equal "3" + (render-sx + "(let ((s (signal (list)))) + (reset! s (list 1 2 3)) + (len (deref s)))"))))