(** 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 (** 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 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 (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 (match stack with v :: _ -> v | [] -> Nil) | _ -> Nil); (* --- Context (scope lookup with optional default) --- *) register "context" (fun args -> match args with | [String name] | [String name; _] -> let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in (match stack, args with | v :: _, _ -> v | [], [_; default_val] -> default_val | [], _ -> Nil) | _ -> Nil); (* --- 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)