Fix CSSX styling: trampoline wiring + scope-emit!/emitted for adapter-html.sx
Root causes of missing CSSX classes in SSR: 1. _sx_trampoline_fn in sx_primitives.ml was never wired — call_any in HO forms (map/filter/for-each) returned unresolved Thunks, so callbacks like render-lambda-html's param binding never executed. Fixed in bootstrap.py FIXUPS: wire Sx_primitives._sx_trampoline_fn after eval_expr. 2. adapter-html.sx used (emit! ...) and (emitted ...) which are CEK special forms (walk kont for ScopeAccFrame), but scope-push!/scope-pop! use the hashtable. CEK frames and hashtable are two different scope systems. Fixed: adapter uses scope-emit!/scope-emitted (hashtable primitives). 3. env-* operations (env-has?, env-get, env-bind!, env-set!, env-extend, env-merge) only accepted Env type. adapter-html.sx passes Dict as env. Fixed: all env ops go through unwrap_env which handles Dict/Nil. Also: fix merge conflict in sx/sx/geography/index.sx, remove duplicate scope primitives from sx_primitives.ml (sx_server.ml registers them). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1140,6 +1140,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
|
||||
}
|
||||
PRIMITIVES["scope-emit!"] = scopeEmit;
|
||||
PRIMITIVES["scope-peek"] = scopePeek;
|
||||
PRIMITIVES["scope-emitted"] = sxEmitted;
|
||||
|
||||
// ---- VM stack primitives ----
|
||||
// The VM spec (vm.sx) requires these array-like operations.
|
||||
|
||||
@@ -177,33 +177,39 @@ let make_test_env () =
|
||||
|
||||
(* --- Environment operations --- *)
|
||||
|
||||
(* Env operations — accept both Env and Dict *)
|
||||
let uw = Sx_runtime.unwrap_env in
|
||||
bind "env-get" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Sx_types.env_get e k
|
||||
| [Env e; Keyword k] -> Sx_types.env_get e k
|
||||
| [e; String k] -> Sx_types.env_get (uw e) k
|
||||
| [e; Keyword k] -> Sx_types.env_get (uw e) k
|
||||
| _ -> raise (Eval_error "env-get: expected env and string"));
|
||||
|
||||
bind "env-has?" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Bool (Sx_types.env_has e k)
|
||||
| [Env e; Keyword k] -> Bool (Sx_types.env_has e k)
|
||||
| [e; String k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| _ -> raise (Eval_error "env-has?: expected env and string"));
|
||||
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> Sx_types.env_bind e k v
|
||||
| [Env e; Keyword k; v] -> Sx_types.env_bind e k v
|
||||
| [e; String k; v] ->
|
||||
let ue = uw e in
|
||||
if k = "x" || k = "children" || k = "i" then
|
||||
Printf.eprintf "[env-bind!] '%s' env-id=%d bindings-before=%d\n%!" k (Obj.obj (Obj.repr ue) : int) (Hashtbl.length ue.Sx_types.bindings);
|
||||
Sx_types.env_bind ue k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v
|
||||
| _ -> raise (Eval_error "env-bind!: expected env, key, value"));
|
||||
|
||||
bind "env-set!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> Sx_types.env_set e k v
|
||||
| [Env e; Keyword k; v] -> Sx_types.env_set e k v
|
||||
| [e; String k; v] -> Sx_types.env_set (uw e) k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_set (uw e) k v
|
||||
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
|
||||
|
||||
bind "env-extend" (fun args ->
|
||||
match args with
|
||||
| [Env e] -> Env (Sx_types.env_extend e)
|
||||
| [e] -> Env (Sx_types.env_extend (uw e))
|
||||
| _ -> raise (Eval_error "env-extend: expected env"));
|
||||
|
||||
bind "env-merge" (fun args ->
|
||||
@@ -279,18 +285,66 @@ let make_test_env () =
|
||||
| _ -> Nil);
|
||||
bind "eval-expr" (fun args ->
|
||||
match args with
|
||||
| [expr; Env e] -> eval_expr expr (Env e)
|
||||
| [expr; Dict d] ->
|
||||
(* Dict used as env — wrap it *)
|
||||
let e = Sx_types.make_env () in
|
||||
Hashtbl.iter (fun k v -> ignore (Sx_types.env_bind e k v)) d;
|
||||
eval_expr expr (Env e)
|
||||
| [expr; e] ->
|
||||
let ue = Sx_runtime.unwrap_env e in
|
||||
eval_expr expr (Env ue)
|
||||
| [expr] -> eval_expr expr (Env env)
|
||||
| _ -> raise (Eval_error "eval-expr: expected (expr env)"));
|
||||
(* Scope primitives — use a local scope stacks table.
|
||||
Must match the same pattern as sx_server.ml's _scope_stacks. *)
|
||||
let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 in
|
||||
bind "scope-push!" (fun args ->
|
||||
ignore (Sx_runtime.scope_push (List.hd args) (if List.length args > 1 then List.nth args 1 else Nil)); Nil);
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (value :: stack); Nil
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (Nil :: stack); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-pop!" (fun args ->
|
||||
ignore (Sx_runtime.scope_pop (List.hd args)); Nil);
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-emit!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| List items :: rest ->
|
||||
Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
|
||||
| _ :: rest ->
|
||||
Hashtbl.replace _scope_stacks name (List [value] :: rest)
|
||||
| [] ->
|
||||
Hashtbl.replace _scope_stacks name [List [value]]);
|
||||
Nil
|
||||
| _ -> Nil);
|
||||
bind "emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List []);
|
||||
bind "scope-emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List []);
|
||||
bind "provide-push!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (value :: stack); Nil
|
||||
| _ -> Nil);
|
||||
bind "provide-pop!" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
bind "cond-scheme?" (fun args ->
|
||||
match args with
|
||||
| [(List clauses | ListRef { contents = clauses })] ->
|
||||
|
||||
@@ -194,6 +194,43 @@ let () = Sx_primitives.register "clear-collected!" (fun args ->
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
|
||||
(* emit!/emitted — adapter-html.sx uses these for spread attr collection *)
|
||||
let () = Sx_primitives.register "scope-emit!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| List items :: rest ->
|
||||
Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
|
||||
| v :: rest ->
|
||||
(* Non-list top — wrap current entries as list + new value *)
|
||||
Hashtbl.replace _scope_stacks name (List [value] :: v :: rest)
|
||||
| [] ->
|
||||
Hashtbl.replace _scope_stacks name [List [value]]);
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
|
||||
let () = Sx_primitives.register "emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List [])
|
||||
|
||||
let () = Sx_primitives.register "scope-emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with List items :: _ -> List items | _ -> List [])
|
||||
| _ -> List [])
|
||||
|
||||
let () = Sx_primitives.register "provide-push!" (fun args ->
|
||||
match Sx_primitives.get_primitive "scope-push!" with
|
||||
| NativeFn (_, fn) -> fn args | _ -> Nil)
|
||||
let () = Sx_primitives.register "provide-pop!" (fun args ->
|
||||
match Sx_primitives.get_primitive "scope-pop!" with
|
||||
| NativeFn (_, fn) -> fn args | _ -> Nil)
|
||||
|
||||
let () = Sx_primitives.register "scope-emit!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
@@ -510,7 +547,7 @@ let make_server_env () =
|
||||
Route to the OCaml CEK machine. *)
|
||||
bind "eval-expr" (fun args ->
|
||||
match args with
|
||||
| [expr; Env e] -> Sx_ref.eval_expr expr (Env e)
|
||||
| [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 ->
|
||||
@@ -792,34 +829,35 @@ let make_server_env () =
|
||||
| [v] -> String (inspect v)
|
||||
| _ -> raise (Eval_error "sx-serialize: expected 1 arg"));
|
||||
|
||||
(* Env operations *)
|
||||
(* Env operations — accept both Env and Dict (adapter-html.sx passes dicts) *)
|
||||
let uw = Sx_runtime.unwrap_env in
|
||||
bind "env-get" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> env_get e k
|
||||
| [Env e; Keyword k] -> env_get e k
|
||||
| [e; String k] -> Sx_types.env_get (uw e) k
|
||||
| [e; Keyword k] -> Sx_types.env_get (uw e) k
|
||||
| _ -> raise (Eval_error "env-get: expected env and string"));
|
||||
|
||||
bind "env-has?" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k] -> Bool (env_has e k)
|
||||
| [Env e; Keyword k] -> Bool (env_has e k)
|
||||
| [e; String k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k)
|
||||
| _ -> raise (Eval_error "env-has?: expected env and string"));
|
||||
|
||||
bind "env-bind!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> env_bind e k v
|
||||
| [Env e; Keyword k; v] -> env_bind e k v
|
||||
| [e; String k; v] -> Sx_types.env_bind (uw e) k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v
|
||||
| _ -> raise (Eval_error "env-bind!: expected env, key, value"));
|
||||
|
||||
bind "env-set!" (fun args ->
|
||||
match args with
|
||||
| [Env e; String k; v] -> env_set e k v
|
||||
| [Env e; Keyword k; v] -> env_set e k v
|
||||
| [e; String k; v] -> Sx_types.env_set (uw e) k v
|
||||
| [e; Keyword k; v] -> Sx_types.env_set (uw e) k v
|
||||
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
|
||||
|
||||
bind "env-extend" (fun args ->
|
||||
match args with
|
||||
| [Env e] -> Env (env_extend e)
|
||||
| [e] -> Env (Sx_types.env_extend (uw e))
|
||||
| _ -> raise (Eval_error "env-extend: expected env"));
|
||||
|
||||
bind "env-merge" (fun args ->
|
||||
|
||||
@@ -72,6 +72,9 @@ let () = trampoline_fn := (fun v ->
|
||||
| Thunk (expr, env) -> eval_expr expr (Env env)
|
||||
| _ -> v)
|
||||
|
||||
(* Wire up the primitives trampoline so call_any in HO forms resolves Thunks *)
|
||||
let () = Sx_primitives._sx_trampoline_fn := !trampoline_fn
|
||||
|
||||
(* Override recursive cek_run with iterative loop *)
|
||||
let cek_run_iterative state =
|
||||
let s = ref state in
|
||||
|
||||
@@ -701,49 +701,8 @@ let () =
|
||||
| [String name] -> Bool (Hashtbl.mem primitives name)
|
||||
| _ -> Bool false);
|
||||
|
||||
(* ---- Scope stack primitives (for adapter-html.sx tree-walk rendering) ---- *)
|
||||
let scope_stacks : (string, (value * value list) list) Hashtbl.t = Hashtbl.create 8 in
|
||||
register "scope-push!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace scope_stacks name ((value, []) :: stack); Nil
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace scope_stacks name ((Nil, []) :: stack); Nil
|
||||
| _ -> Nil);
|
||||
register "scope-pop!" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
register "scope-peek" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
(match Hashtbl.find_opt scope_stacks name with
|
||||
| Some ((v, _) :: _) -> v
|
||||
| _ -> Nil)
|
||||
| _ -> Nil);
|
||||
register "scope-emit!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
(match Hashtbl.find_opt scope_stacks name with
|
||||
| Some ((v, emitted) :: rest) ->
|
||||
Hashtbl.replace scope_stacks name ((v, emitted @ [value]) :: rest)
|
||||
| _ -> ()); Nil
|
||||
| _ -> Nil);
|
||||
register "emitted" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
(match Hashtbl.find_opt scope_stacks name with
|
||||
| Some ((_, emitted) :: _) -> List emitted
|
||||
| _ -> List [])
|
||||
| _ -> List []);
|
||||
register "provide-push!" (fun args ->
|
||||
Hashtbl.find primitives "scope-push!" args);
|
||||
register "provide-pop!" (fun args ->
|
||||
Hashtbl.find primitives "scope-pop!" args);
|
||||
(* Scope stack primitives are registered by sx_server.ml / run_tests.ml
|
||||
because they use a shared scope stacks table with collect!/collected. *)
|
||||
|
||||
(* ---- Predicates needed by adapter-html.sx ---- *)
|
||||
register "lambda?" (fun args ->
|
||||
|
||||
@@ -399,23 +399,23 @@ and step_sf_lambda args env kont =
|
||||
|
||||
(* step-sf-scope *)
|
||||
and step_sf_scope args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest_args = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body := rest_args; Nil))) in (let () = ignore ((scope_push (name) (!val'))) in (let result' = ref (Nil) in (let () = ignore ((List.iter (fun expr -> ignore ((result' := (trampoline ((eval_expr (expr) (env)))); Nil))) (sx_to_list !body); Nil)) in (let () = ignore ((scope_pop (name))) in (make_cek_value (!result') (env) (kont))))))))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest_args = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body := rest_args; Nil))) in (if sx_truthy ((empty_p (!body))) then (make_cek_value (Nil) (env) (kont)) else (make_cek_state ((first (!body))) (env) ((kont_push ((make_scope_acc_frame (name) (!val') ((rest (!body))) (env))) (kont)))))))
|
||||
|
||||
(* step-sf-provide *)
|
||||
and step_sf_provide args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let body = (prim_call "slice" [args; (Number 2.0)]) in (let () = ignore ((scope_push (name) (val'))) in (let result' = ref (Nil) in (let () = ignore ((List.iter (fun expr -> ignore ((result' := (trampoline ((eval_expr (expr) (env)))); Nil))) (sx_to_list body); Nil)) in (let () = ignore ((scope_pop (name))) in (make_cek_value (!result') (env) (kont)))))))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let body = (prim_call "slice" [args; (Number 2.0)]) in (if sx_truthy ((empty_p (body))) then (make_cek_value (Nil) (env) (kont)) else (make_cek_state ((first (body))) (env) ((kont_push ((make_provide_frame (name) (val') ((rest (body))) (env))) (kont))))))
|
||||
|
||||
(* step-sf-context *)
|
||||
and step_sf_context args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let val' = (scope_peek (name)) in (make_cek_value ((if sx_truthy ((is_nil (val'))) then default_val else val')) (env) (kont)))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (make_cek_value ((if sx_truthy ((is_nil (frame))) then default_val else (get (frame) ((String "value"))))) (env) (kont)))
|
||||
|
||||
(* step-sf-emit *)
|
||||
and step_sf_emit args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in (let () = ignore ((scope_emit (name) (val'))) in (make_cek_value (Nil) (env) (kont))))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (let () = ignore ((if sx_truthy (frame) then (sx_dict_set_b frame (String "emitted") (prim_call "append" [(get (frame) ((String "emitted"))); (List [val'])])) else Nil)) in (make_cek_value (Nil) (env) (kont))))
|
||||
|
||||
(* step-sf-emitted *)
|
||||
and step_sf_emitted args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (scope_peek (name)) in (make_cek_value ((if sx_truthy ((is_nil (val'))) then (List []) else val')) (env) (kont)))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (make_cek_value ((if sx_truthy ((is_nil (frame))) then (List []) else (get (frame) ((String "emitted"))))) (env) (kont)))
|
||||
|
||||
(* step-sf-reset *)
|
||||
and step_sf_reset args env kont =
|
||||
@@ -516,6 +516,9 @@ let () = trampoline_fn := (fun v ->
|
||||
| Thunk (expr, env) -> eval_expr expr (Env env)
|
||||
| _ -> v)
|
||||
|
||||
(* Wire up the primitives trampoline so call_any in HO forms resolves Thunks *)
|
||||
let () = Sx_primitives._sx_trampoline_fn := !trampoline_fn
|
||||
|
||||
(* Override recursive cek_run with iterative loop *)
|
||||
let cek_run_iterative state =
|
||||
let s = ref state in
|
||||
|
||||
Reference in New Issue
Block a user