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

Fix defhandler: native special form in make_server_env

Browse Source 
defhandler was only available via web-forms.sx which had load
dependencies that failed. Now registered as a native special form
in make_server_env, works in both coroutine and HTTP modes.

Key fix: custom special forms receive [List args; Env eval_env],
not flat args. The handler is now bound in the eval env, not the
make_server_env closure env.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-01 14:09:14 +00:00
parent 21c3e951ec
commit a0f4ff02a1
1 changed files with 73 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -692,6 +692,37 @@ let make_server_env () =
setup_io_bridges env;
setup_html_tags env;
setup_io_env env;
(* defhandler — native special form. Called by CEK as (handler [raw-args; Env eval-env]).
Registers handler as handler:name in the eval env. *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun sf_args ->
(* Custom special forms receive [List args; Env eval_env] *)
let raw_args, eval_env = match sf_args with
| [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
| _ -> ([], env) in
match raw_args with
| name_sym :: rest ->
let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
let rec parse_opts acc = function
| Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
| rest -> (acc, rest) in
let opts = Hashtbl.create 4 in
let (_, remaining) = parse_opts opts rest in
let params, body = match remaining with
| List p :: b :: _ -> (p, b) | List p :: [] -> (p, Nil) | _ -> ([], Nil) in
let hdef = Hashtbl.create 8 in
Hashtbl.replace hdef "__type" (String "handler");
Hashtbl.replace hdef "name" (String name);
Hashtbl.replace hdef "params" (List params);
Hashtbl.replace hdef "body" body;
Hashtbl.replace hdef "closure" (Env eval_env);
Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
| Some (Keyword m) -> String m | Some v -> v | None -> String "get");
Hashtbl.replace hdef "path" (match Hashtbl.find_opt opts "path" with Some v -> v | None -> Nil);
Hashtbl.replace hdef "csrf" (match Hashtbl.find_opt opts "csrf" with Some v -> v | None -> Bool true);
Hashtbl.replace hdef "returns" (match Hashtbl.find_opt opts "returns" with Some v -> v | None -> String "element");
ignore (env_bind eval_env ("handler:" ^ name) (Dict hdef));
Dict hdef
| _ -> Nil)));
(* Initialize trampoline ref so HO primitives (map, filter, etc.)
can call SX lambdas. Must be done here because Sx_ref is only
available at the binary level, not in the library. *)
@@ -1840,7 +1871,48 @@ let http_setup_declarative_stubs env =
noop "define-primitive";
noop "deftype";
noop "defeffect";
noop "define-page-helper"
noop "define-page-helper";
(* defhandler — register as native special form so it works without web-forms.sx.
Parses the handler args and stores as handler:name in the env. *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun args ->
match args with
| name_sym :: rest ->
let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
(* Parse keyword opts and find params/body *)
let rec parse_opts acc = function
| Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
| rest -> (acc, rest)
in
let opts = Hashtbl.create 4 in
let (_, remaining) = parse_opts opts rest in
let params, body = match remaining with
| List p :: b :: _ -> (p, b)
| List p :: [] -> (p, Nil)
| _ -> ([], Nil)
in
let hdef = Hashtbl.create 8 in
Hashtbl.replace hdef "__type" (String "handler");
Hashtbl.replace hdef "name" (String name);
Hashtbl.replace hdef "params" (List params);
Hashtbl.replace hdef "body" body;
Hashtbl.replace hdef "closure" (Env env);
Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
| Some (Keyword m) -> String m | Some v -> v | None -> String "get");
Hashtbl.replace hdef "path" (match Hashtbl.find_opt opts "path" with
| Some v -> v | None -> Nil);
Hashtbl.replace hdef "csrf" (match Hashtbl.find_opt opts "csrf" with
| Some v -> v | None -> Bool true);
Hashtbl.replace hdef "returns" (match Hashtbl.find_opt opts "returns" with
| Some v -> v | None -> String "element");
let handler_key = "handler:" ^ name in
ignore (env_bind env handler_key (Dict hdef));
Dict hdef
| _ -> Nil)));
(* Also stub defquery/defaction/defrelation/defstyle as no-ops *)
noop "defquery";
noop "defaction";
noop "defrelation";
noop "defstyle"
let http_setup_platform_constructors env =
(* Platform constructor functions expected by evaluator.sx.