From 19e7a6ee2d880887036f830edcd0620167073281 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 19:43:26 +0000 Subject: [PATCH] Step 5.5 phases 1-2: merge sx_scope into sx_primitives, 4-child define support Phase 1: Absorb sx_scope.ml (180 lines) into sx_primitives.ml. Scope stacks, cookies, and trace infrastructure now live alongside other primitives. All 20 scope primitive registrations moved. References updated in sx_server.ml and sx_browser.ml. sx_scope.ml deleted. Phase 2: Transpiler handles (define name :effects (...) (fn ...)) forms. ml-emit-define and ml-emit-define-body detect keyword at position 2 and use (last expr) instead. Unblocks transpilation of spec/render.sx and web/adapter-html.sx which use 4-child defines extensively. 2598/2598 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bin/sx_server.ml | 9 +- hosts/ocaml/browser/sx_browser.ml | 13 +-- hosts/ocaml/lib/sx_primitives.ml | 176 ++++++++++++++++++++++++++++- hosts/ocaml/lib/sx_scope.ml | 180 ------------------------------ hosts/ocaml/transpiler.sx | 6 +- 5 files changed, 189 insertions(+), 195 deletions(-) delete mode 100644 hosts/ocaml/lib/sx_scope.ml diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index a2bfc570..6d260e0b 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -140,11 +140,10 @@ let io_batch_mode = ref false let io_queue : (int * string * value list) list ref = ref [] let io_counter = ref 0 -(* Scope stacks and cookies — all primitives registered in sx_scope.ml. - We just reference the shared state for the IO bridge. *) -(* Sx_scope accessed directly — library is unwrapped *) -let _request_cookies = Sx_scope.request_cookies -let _scope_stacks = Sx_scope.scope_stacks +(* Scope stacks and cookies — primitives registered in sx_primitives.ml. + We reference the shared state for the IO bridge. *) +let _request_cookies = Sx_primitives._request_cookies +let _scope_stacks = Sx_primitives._scope_stacks (* ── App config ─────────────────────────────────────────────────────── *) (* Populated from __app-config dict after SX files load. *) diff --git a/hosts/ocaml/browser/sx_browser.ml b/hosts/ocaml/browser/sx_browser.ml index f6fc5f60..3874aa25 100644 --- a/hosts/ocaml/browser/sx_browser.ml +++ b/hosts/ocaml/browser/sx_browser.ml @@ -50,9 +50,8 @@ let host_get_js (id : int) : Js.Unsafe.any = (* Global environment *) (* ================================================================== *) -(* Force module initialization — these modules register primitives - in their let () = ... blocks but aren't referenced directly. *) -let () = Sx_scope.clear_all () +(* Clear scope stacks at startup *) +let () = Sx_primitives.scope_clear_all () let global_env = make_env () let _sx_render_mode = ref false @@ -641,7 +640,7 @@ let () = (* --- Scope stack --- *) (* Scope primitives (scope-push!, scope-pop!, context, collect!, collected, emit!, emitted, scope-emit!, scope-emitted, etc.) are registered by - Sx_scope module initialization in the primitives table. + Sx_primitives module initialization in the primitives table. The CEK evaluator falls through to the primitives table when a symbol isn't in the env, so these work automatically. Only provide-push!/provide-pop! need explicit env bindings as aliases. *) @@ -921,11 +920,11 @@ let () = (* Scope tracing API *) Js.Unsafe.set sx (Js.string "scopeTraceOn") (Js.wrap_callback (fun () -> - Sx_scope.scope_trace_enable (); Js.Unsafe.inject Js.null)); + Sx_primitives.scope_trace_enable (); Js.Unsafe.inject Js.null)); Js.Unsafe.set sx (Js.string "scopeTraceOff") (Js.wrap_callback (fun () -> - Sx_scope.scope_trace_disable (); Js.Unsafe.inject Js.null)); + Sx_primitives.scope_trace_disable (); Js.Unsafe.inject Js.null)); Js.Unsafe.set sx (Js.string "scopeTraceDrain") (Js.wrap_callback (fun () -> - let log = Sx_scope.scope_trace_drain () in + let log = Sx_primitives.scope_trace_drain () in Js.Unsafe.inject (Js.array (Array.of_list (List.map (fun s -> Js.Unsafe.inject (Js.string s)) log))))); Js.Unsafe.set Js.Unsafe.global (Js.string "SxKernel") sx diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 53eb2ea6..56ea1802 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -14,6 +14,29 @@ let _sx_trampoline_fn : (value -> value) ref = ref (fun v -> v) let _is_client : bool ref = ref false +(** Scope stacks — dynamic scope for render-time effects. + Each key maps to a stack of values. Used by aser for + spread/provide/emit patterns, CSSX collect/flush, etc. + Migrated from sx_scope.ml. *) +let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 + +(** Debug trace for scope operations *) +let _scope_trace = ref false +let _scope_log : string list ref = ref [] +let scope_trace_enable () = _scope_trace := true; _scope_log := [] +let scope_trace_disable () = _scope_trace := false +let scope_trace_drain () = + let log = List.rev !_scope_log in + _scope_log := []; + log + +(** Request cookies — set by the Python bridge before each render. + get-cookie reads from here; set-cookie is a no-op on the server. *) +let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8 + +(** Clear all scope stacks. Called between requests if needed. *) +let scope_clear_all () = Hashtbl.clear _scope_stacks + let register name fn = Hashtbl.replace primitives name fn let is_primitive name = Hashtbl.mem primitives name @@ -976,4 +999,155 @@ let () = | Some fn -> fn [] | None -> raise (Eval_error ("VM undefined: " ^ name))) | _ -> raise (Eval_error "call-primitive: expected (name args-list)")); - () + (); + + (* ================================================================ *) + (* Scope stacks — dynamic scope for render-time effects. *) + (* Migrated from sx_scope.ml — Phase 1 of step 5.5 *) + (* ================================================================ *) + + (* --- Cookies --- *) + + register "get-cookie" (fun args -> + match args with + | [String name] -> + (match Hashtbl.find_opt _request_cookies name with + | Some v -> String v + | None -> Nil) + | _ -> Nil); + + register "set-cookie" (fun _args -> Nil); + + (* --- Core scope stack operations --- *) + + register "scope-push!" (fun args -> + match args with + | [String name; value] -> + let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in + if !_scope_trace then + _scope_log := Printf.sprintf "PUSH %s depth=%d->%d" name (List.length stack) (List.length stack + 1) :: !_scope_log; + Hashtbl.replace _scope_stacks name (value :: 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 + if !_scope_trace then + _scope_log := Printf.sprintf "POP %s depth=%d->%d" name (List.length stack) (max 0 (List.length stack - 1)) :: !_scope_log; + (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil + | _ -> Nil); + + register "scope-peek" (fun args -> + match args with + | [String name] -> + let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in + if !_scope_trace then + _scope_log := Printf.sprintf "PEEK %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log; + (match stack with v :: _ -> v | [] -> Nil) + | _ -> Nil); + + (* --- Context (scope lookup with optional default) --- *) + + register "context" (fun args -> + match args with + | (String name) :: rest -> + let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in + if !_scope_trace then + _scope_log := Printf.sprintf "CTX %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log; + (match stack with + | v :: _ -> v + | [] -> (match rest with default_val :: _ -> default_val | [] -> Nil)) + | _ -> Nil); + + register "context-debug" (fun args -> + match args with + | [String name] -> + let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in + let all_keys = Hashtbl.fold (fun k _ acc -> k :: acc) _scope_stacks [] in + String (Printf.sprintf "name=%s stack_len=%d all_keys=[%s]" + name (List.length stack) (String.concat "," all_keys)) + | _ -> String "bad args"); + + (* --- Collect / collected / clear-collected! --- *) + + register "collect!" (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 -> + if not (List.mem value items) then + Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest) + | [] -> + Hashtbl.replace _scope_stacks name [List [value]] + | _ :: _ -> ()); + Nil + | _ -> Nil); + + register "collected" (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 []); + + register "clear-collected!" (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 (List [] :: rest) + | [] -> Hashtbl.replace _scope_stacks name [List []]); + Nil + | _ -> Nil); + + (* --- Emit / emitted --- *) + + 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) + | Nil :: rest -> + Hashtbl.replace _scope_stacks name (List [value] :: rest) + | [] -> + Hashtbl.replace _scope_stacks name [List [value]] + | _ :: _ -> ()); + Nil + | _ -> Nil); + + register "emit!" (fun args -> + match Hashtbl.find_opt primitives "scope-emit!" with + | Some fn -> fn args | None -> Nil); + + 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 []); + + register "scope-emitted" (fun args -> + match Hashtbl.find_opt primitives "emitted" with + | Some fn -> fn args | None -> List []); + + register "scope-collected" (fun args -> + match Hashtbl.find_opt primitives "collected" with + | Some fn -> fn args | None -> List []); + + register "scope-clear-collected!" (fun args -> + match Hashtbl.find_opt primitives "clear-collected!" with + | Some fn -> fn args | None -> Nil); + + (* --- Provide aliases --- *) + + register "provide-push!" (fun args -> + match Hashtbl.find_opt primitives "scope-push!" with + | Some fn -> fn args | None -> Nil); + + register "provide-pop!" (fun args -> + match Hashtbl.find_opt primitives "scope-pop!" with + | Some fn -> fn args | None -> Nil) diff --git a/hosts/ocaml/lib/sx_scope.ml b/hosts/ocaml/lib/sx_scope.ml deleted file mode 100644 index 71278c96..00000000 --- a/hosts/ocaml/lib/sx_scope.ml +++ /dev/null @@ -1,180 +0,0 @@ -(** Scope stacks — dynamic scope for render-time effects. - - Provides scope-push!/pop!/peek, collect!/collected/clear-collected!, - scope-emit!/emitted/scope-emitted, context, and cookie access. - - All functions are registered as primitives so both the CEK evaluator - and the JIT VM can find them in the same place. *) - -open Sx_types - -(** The shared scope stacks hashtable. Each key maps to a stack of values. - Used by aser for spread/provide/emit patterns, CSSX collect/flush, etc. *) -let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 - -(** Debug trace for scope operations — enabled from JS *) -let _scope_trace = ref false -let _scope_log : string list ref = ref [] -let scope_trace_enable () = _scope_trace := true; _scope_log := [] -let scope_trace_disable () = _scope_trace := false -let scope_trace_drain () = - let log = List.rev !_scope_log in - _scope_log := []; - log - -(** Request cookies — set by the Python bridge before each render. - get-cookie reads from here; set-cookie is a no-op on the server. *) -let request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8 - -(** Clear all scope stacks. Called between requests if needed. *) -let clear_all () = Hashtbl.clear scope_stacks - -let () = - let register = Sx_primitives.register in - - (* --- Cookies --- *) - - register "get-cookie" (fun args -> - match args with - | [String name] -> - (match Hashtbl.find_opt request_cookies name with - | Some v -> String v - | None -> Nil) - | _ -> Nil); - - register "set-cookie" (fun _args -> Nil); - - (* --- Core scope stack operations --- *) - - register "scope-push!" (fun args -> - match args with - | [String name; value] -> - let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in - if !_scope_trace then - _scope_log := Printf.sprintf "PUSH %s depth=%d->%d" name (List.length stack) (List.length stack + 1) :: !_scope_log; - Hashtbl.replace scope_stacks name (value :: 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 - if !_scope_trace then - _scope_log := Printf.sprintf "POP %s depth=%d->%d" name (List.length stack) (max 0 (List.length stack - 1)) :: !_scope_log; - (match stack with _ :: rest -> Hashtbl.replace scope_stacks name rest | [] -> ()); Nil - | _ -> Nil); - - register "scope-peek" (fun args -> - match args with - | [String name] -> - let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in - if !_scope_trace then - _scope_log := Printf.sprintf "PEEK %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log; - (match stack with v :: _ -> v | [] -> Nil) - | _ -> Nil); - - (* --- Context (scope lookup with optional default) --- *) - - register "context" (fun args -> - match args with - | (String name) :: rest -> - let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in - if !_scope_trace then - _scope_log := Printf.sprintf "CTX %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log; - (match stack with - | v :: _ -> v - | [] -> (match rest with default_val :: _ -> default_val | [] -> Nil)) - | _ -> Nil); - - register "context-debug" (fun args -> - match args with - | [String name] -> - let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in - let all_keys = Hashtbl.fold (fun k _ acc -> k :: acc) scope_stacks [] in - String (Printf.sprintf "name=%s stack_len=%d all_keys=[%s]" - name (List.length stack) (String.concat "," all_keys)) - | _ -> String "bad args"); - - (* --- Collect / collected / clear-collected! --- *) - - register "collect!" (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 -> - if not (List.mem value items) then - Hashtbl.replace scope_stacks name (List (items @ [value]) :: rest) - | [] -> - Hashtbl.replace scope_stacks name [List [value]] - | _ :: _ -> ()); - Nil - | _ -> Nil); - - register "collected" (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 []); - - register "clear-collected!" (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 (List [] :: rest) - | [] -> Hashtbl.replace scope_stacks name [List []]); - Nil - | _ -> Nil); - - (* --- Emit / emitted (for spread attrs in adapter-html.sx) --- *) - - 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) - | Nil :: rest -> - Hashtbl.replace scope_stacks name (List [value] :: rest) - | [] -> - Hashtbl.replace scope_stacks name [List [value]] - | _ :: _ -> ()); - Nil - | _ -> Nil); - - register "emit!" (fun args -> - (* Alias for scope-emit! *) - match Sx_primitives.get_primitive "scope-emit!" with - | NativeFn (_, fn) -> fn args | _ -> Nil); - - 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 []); - - register "scope-emitted" (fun args -> - match Sx_primitives.get_primitive "emitted" with - | NativeFn (_, fn) -> fn args | _ -> List []); - - register "scope-collected" (fun args -> - match Sx_primitives.get_primitive "collected" with - | NativeFn (_, fn) -> fn args | _ -> List []); - - register "scope-clear-collected!" (fun args -> - match Sx_primitives.get_primitive "clear-collected!" with - | NativeFn (_, fn) -> fn args | _ -> Nil); - - (* --- Provide aliases --- *) - - register "provide-push!" (fun args -> - match Sx_primitives.get_primitive "scope-push!" with - | NativeFn (_, fn) -> fn args | _ -> Nil); - - register "provide-pop!" (fun args -> - match Sx_primitives.get_primitive "scope-pop!" with - | NativeFn (_, fn) -> fn args | _ -> Nil) diff --git a/hosts/ocaml/transpiler.sx b/hosts/ocaml/transpiler.sx index 11a52388..c7bf8ece 100644 --- a/hosts/ocaml/transpiler.sx +++ b/hosts/ocaml/transpiler.sx @@ -1712,7 +1712,8 @@ (expr) (let ((name (if (= (type-of (nth expr 1)) "symbol") (symbol-name (nth expr 1)) (str (nth expr 1)))) - (val-expr (nth expr 2))) + (val-expr + (let ((raw (nth expr 2))) (if (keyword? raw) (last expr) raw)))) (let ((ml-name (ml-mangle name)) (is-fn @@ -1825,7 +1826,8 @@ (expr) (let ((name (if (= (type-of (nth expr 1)) "symbol") (symbol-name (nth expr 1)) (str (nth expr 1)))) - (val-expr (nth expr 2))) + (val-expr + (let ((raw (nth expr 2))) (if (keyword? raw) (last expr) raw)))) (let ((ml-name (ml-mangle name)) (is-fn