coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix isomorphic SSR: revert inline opcodes, add named let compilation, fix cookie decode

Browse Source 
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:
giles
2026-03-24 22:32:51 +00:00
parent eb4233ff36
commit 57cffb8bcc
10 changed files with 360 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
hosts/ocaml/bin/integration_tests.ml
View File

@@ -217,12 +217,33 @@ let make_integration_env () =
bind "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil); 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 "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 "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 *) (* 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-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-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-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 "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 "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 *) (* Render-mode flags *)
ignore (env_bind env "*render-active*" (Bool false)); ignore (env_bind env "*render-active*" (Bool false));
@@ -236,7 +257,7 @@ let make_integration_env () =
"defstyle"; "defhandler"; "deftype"; "defeffect"; "defquery"; "defaction"; "defrelation"]) "defstyle"; "defhandler"; "deftype"; "defeffect"; "defquery"; "defaction"; "defrelation"])
| _ -> Bool false); | _ -> 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 "signal" (fun args -> match args with [v] -> v | _ -> Nil);
bind "computed" (fun args -> match args with [f] -> Sx_runtime.sx_call f [] | _ -> 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); bind "deref" (fun args -> match args with [v] -> v | _ -> Nil);
@@ -245,6 +266,85 @@ let make_integration_env () =
bind "effect" (fun _args -> Nil); bind "effect" (fun _args -> Nil);
bind "batch" (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 *) (* DOM stubs *)
bind "create-text-node" (fun args -> match args with [String s] -> String s | _ -> Nil); bind "create-text-node" (fun args -> match args with [String s] -> String s | _ -> Nil);
bind "create-fragment" (fun _args -> Nil); bind "create-fragment" (fun _args -> Nil);
@@ -360,13 +460,15 @@ let () =
(* ================================================================== *) (* ================================================================== *)
Printf.printf "\nSuite: SX adapter — components\n%!"; Printf.printf "\nSuite: SX adapter — components\n%!";
assert_no_error "defcomp + render" (fun () -> (try
ignore (Sx_ref.eval_expr assert_no_error "defcomp + render" (fun () ->
(List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))")) ignore (Sx_ref.eval_expr
(Env env)); (List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))"))
sx_render_html "(~test-card :title \"Hi\" (p \"body\"))"); (Env env));
assert_contains "component renders div" "<div" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))"); sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
assert_contains "component renders title" "Hi" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))"); assert_contains "component renders div" "<div" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
assert_contains "component renders title" "Hi" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))")
with Eval_error msg -> incr fail_count; Printf.printf " FAIL: components — %s\n%!" msg);
(* ================================================================== *) (* ================================================================== *)
Printf.printf "\nSuite: eval-expr with HTML tag functions\n%!"; Printf.printf "\nSuite: eval-expr with HTML tag functions\n%!";
@@ -375,6 +477,40 @@ let () =
assert_no_error "eval (span) returns list" (fun () -> assert_no_error "eval (span) returns list" (fun () ->
Sx_ref.eval_expr (List [Symbol "span"; String "text"]) (Env env)); 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";
Printf.printf "============================================================\n"; Printf.printf "============================================================\n";

20
hosts/ocaml/bin/sx_server.ml
View File

@@ -292,11 +292,15 @@ let setup_io_env env =
| _ -> raise (Eval_error "ctx: expected 1 arg")); | _ -> raise (Eval_error "ctx: expected 1 arg"));
bind "call-lambda" (fun args -> 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 match args with
| [fn_val; List call_args; Env e] -> | [fn_val; List call_args; Env _e] ->
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e) Sx_ref.cek_call fn_val (List call_args)
| [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?)")); | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
(* Register HO forms as callable NativeFn — the CEK machine handles them (* Register HO forms as callable NativeFn — the CEK machine handles them
@@ -377,11 +381,15 @@ let setup_evaluator_bridge env =
in resolve v in resolve v
| _ -> raise (Eval_error "trampoline: expected 1 arg")); | _ -> raise (Eval_error "trampoline: expected 1 arg"));
bind "call-lambda" (fun args -> 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 match args with
| [fn_val; List call_args; Env e] -> | [fn_val; List call_args; Env _e] ->
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e) Sx_ref.cek_call fn_val (List call_args)
| [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?)")); | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
bind "cek-call" (fun args -> bind "cek-call" (fun args ->
match args with match args with

7
hosts/ocaml/lib/sx_vm.ml
View File

@@ -418,7 +418,12 @@ and run vm =
push vm (match a, b with Number x, Number y -> Number (x /. y) | _ -> Nil) push vm (match a, b with Number x, Number y -> Number (x /. y) | _ -> Nil)
| 164 (* OP_EQ *) -> | 164 (* OP_EQ *) ->
let b = pop vm and a = pop vm in 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 *) -> | 165 (* OP_LT *) ->
let b = pop vm and a = pop vm in 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) push vm (match a, b with Number x, Number y -> Bool (x < y) | String x, String y -> Bool (x < y) | _ -> Bool false)

2
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// ========================================================================= // =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); 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 isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); } function isSxTruthy(x) { return x !== false && !isNil(x); }

5
shared/sx/ocaml_bridge.py
View File

@@ -228,9 +228,12 @@ class OcamlBridge:
if not cookies: if not cookies:
return return
# Build SX dict: {:name1 "val1" :name2 "val2"} # 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 = [] pairs = []
for k, v in cookies.items(): for k, v in cookies.items():
pairs.append(f':{k} "{_escape(str(v))}"') pairs.append(f':{k} "{_escape(unquote(str(v)))}"')
if pairs: if pairs:
cmd = f'(set-request-cookies {{{" ".join(pairs)}}})' cmd = f'(set-request-cookies {{{" ".join(pairs)}}})'
try: try:

97
spec/compiler.sx
View File

@@ -387,25 +387,46 @@
(define compile-let (define compile-let
(fn (em args scope tail?) (fn (em args scope tail?)
(let ((bindings (first args)) ;; Detect named let: (let loop ((x init) ...) body)
(body (rest args)) (if (= (type-of (first args)) "symbol")
(let-scope (make-scope scope))) ;; Named let → desugar to letrec:
;; Let scopes share the enclosing function's frame. ;; (letrec ((loop (fn (x ...) body))) (loop init ...))
;; Continue slot numbering from parent. (let ((loop-name (symbol-name (first args)))
(dict-set! let-scope "next-slot" (get scope "next-slot")) (bindings (nth args 1))
;; Compile each binding (body (slice args 2))
(for-each (fn (binding) (params (list))
(let ((name (if (= (type-of (first binding)) "symbol") (inits (list)))
(symbol-name (first binding)) (for-each (fn (binding)
(first binding))) (append! params (if (= (type-of (first binding)) "symbol")
(value (nth binding 1)) (first binding)
(slot (scope-define-local let-scope name))) (make-symbol (first binding))))
(compile-expr em value let-scope false) (append! inits (nth binding 1)))
(emit-op em 17) ;; OP_LOCAL_SET bindings)
(emit-byte em slot))) ;; Compile as: (letrec ((loop (fn (params...) body...))) (loop inits...))
bindings) (let ((lambda-expr (concat (list (make-symbol "fn") params) body))
;; Compile body in let scope (letrec-bindings (list (list (make-symbol loop-name) lambda-expr)))
(compile-begin em body let-scope tail?)))) (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 (define compile-letrec
@@ -756,40 +777,14 @@
(not (= (get (scope-resolve scope name) "type") "upvalue")) (not (= (get (scope-resolve scope name) "type") "upvalue"))
(primitive? name)))))) (primitive? name))))))
(if is-prim (if is-prim
;; Direct primitive call — try inline opcode first ;; Direct primitive call via CALL_PRIM
(let ((name (symbol-name head)) (let ((name (symbol-name head))
(argc (len args)) (argc (len args))
(inline-op (name-idx (pool-add (get em "pool") name)))
(cond (for-each (fn (a) (compile-expr em a scope false)) args)
;; Binary arithmetic/comparison (2 args) (emit-op em 52) ;; OP_CALL_PRIM
(and (= argc 2) (= name "+")) 160 (emit-u16 em name-idx)
(and (= argc 2) (= name "-")) 161 (emit-byte em argc))
(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))))
;; General call ;; General call
(do (do
(compile-expr em head scope false) (compile-expr em head scope false)

77
spec/tests/test-vm.sx
View File

@@ -416,3 +416,80 @@
(define double (fn (x) (* x 2))) (define double (fn (x) (* x 2)))
(let ((inc-then-double (compose double inc))) (let ((inc-then-double (compose double inc)))
(inc-then-double 20))))))) (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)))))))

32
spec/tests/vm-inline.sx
View File

@@ -83,3 +83,35 @@
(test "= with booleans" (= (= true true) true)) (test "= with booleans" (= (= true true) true))
(test "= with keywords" (= (= :foo :foo) true)) (test "= with keywords" (= (= :foo :foo) true))
(test "not with list" (= (not (list 1)) false)) (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))))

4
sx/sx/home-stepper.sx
View File

@@ -116,10 +116,10 @@
(dict-set! pos "i" (+ (get pos "i") 1)) (dict-set! pos "i" (+ (get pos "i") 1))
(let ((tag (get step "tag")) (let ((tag (get step "tag"))
(attrs (or (get step "attrs") (list))) (attrs (or (get step "attrs") (list)))
(spreads (or (get step "spreads") (list)))
(inner (build-children))) (inner (build-children)))
;; Skip spreads (~cssx/tw) — just structure + text
(append! children (append! children
(concat (list (make-symbol tag)) attrs inner))) (concat (list (make-symbol tag)) spreads attrs inner)))
(loop)) (loop))
(= stype "close") (= stype "close")
(do (dict-set! pos "i" (+ (get pos "i") 1)) (do (dict-set! pos "i" (+ (get pos "i") 1))

34
web/tests/test-aser.sx
View File

@@ -432,3 +432,37 @@
(render-sx (render-sx
"(do (defcomp ~page (&key x) (div x)) "(do (defcomp ~page (&key x) (div x))
(case \"miss\" \"hit\" (~page :x \"found\") :else \"index\"))")))) (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)))"))))