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

Fix create-text-node on server: return string instead of nil

Browse Source 
Server-side create-text-node was returning Nil, causing imperative
text nodes (stopwatch "Start"/"0.0s", imperative counter "0") to
render as empty in SSR HTML. Now returns the text as a String value,
which render-to-html handles via escape-html.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-25 14:29:06 +00:00
parent 998536f52d
commit 759309c5c4
1 changed files with 3 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -14,13 +14,7 @@
IO primitives (query, action, request-arg, request-method, ctx)
yield (io-request ...) and block on stdin for (io-response ...). *)
module Sx_types = Sx.Sx_types
module Sx_parser = Sx.Sx_parser
module Sx_primitives = Sx.Sx_primitives
module Sx_runtime = Sx.Sx_runtime
module Sx_ref = Sx.Sx_ref
module Sx_render = Sx.Sx_render
module Sx_vm = Sx.Sx_vm
(* Modules accessed directly — library is unwrapped *)
open Sx_types
@@ -137,7 +131,7 @@ 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. *)
module Sx_scope = Sx.Sx_scope
(* Sx_scope accessed directly — library is unwrapped *)
let _request_cookies = Sx_scope.request_cookies
let _scope_stacks = Sx_scope.scope_stacks
@@ -346,7 +340,7 @@ let setup_browser_stubs env =
bind "dom-body" (fun _args -> Nil);
bind "dom-create-element" (fun _args -> Nil);
bind "dom-append" (fun _args -> Nil);
bind "create-text-node" (fun _args -> Nil);
bind "create-text-node" (fun args -> match args with [String s] -> String s | [v] -> String (value_to_string v) | _ -> Nil);
bind "render-to-dom" (fun _args -> Nil);
bind "set-render-active!" (fun _args -> Nil);
bind "render-active?" (fun _args -> Bool true)
@@ -1084,61 +1078,6 @@ let rec dispatch env cmd =
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))
| List [Symbol "vm-compile"] ->
(* Compile all named lambdas in env to bytecode.
Called after all .sx files are loaded. *)
(try
if not (Hashtbl.mem env.bindings "compile") then
send_error "compiler not loaded"
else begin
let compile_fn = Hashtbl.find env.bindings "compile" in
let count = ref 0 in
let failed = ref 0 in
let names = Hashtbl.fold (fun k _ acc -> k :: acc) env.bindings [] in
List.iter (fun name ->
match Hashtbl.find_opt env.bindings name with
| Some (Lambda lam) when lam.l_name <> None
&& lam.l_closure.parent = None ->
(try
let quoted = List [Symbol "quote"; lam.l_body] in
let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env env) in
match result with
| Dict d when Hashtbl.mem d "bytecode" ->
let code = Sx_vm.code_from_value result in
(* Live env reference — NOT a snapshot. Functions see
current bindings, including later-defined functions. *)
let live_env = env.bindings in
(* Original lambda for CEK fallback *)
let orig_lambda = Lambda lam in
let fn = NativeFn ("vm:" ^ name, fun args ->
try
Sx_vm.call_closure
{ vm_code = code; vm_upvalues = [||]; vm_name = lam.l_name;
vm_env_ref = live_env; vm_closure_env = None }
args live_env
with
| _ ->
(* Any VM error — fall back to CEK *)
Sx_ref.eval_expr (List (orig_lambda :: args)) (Env env)) in
Hashtbl.replace env.bindings name fn;
incr count
| _ -> incr failed
with e ->
if !failed < 3 then
Printf.eprintf "[vm] FAIL %s: %s\n body: %s\n%!"
name (Printexc.to_string e)
(String.sub (inspect lam.l_body) 0
(min 200 (String.length (inspect lam.l_body))));
incr failed)
| _ -> ()
) names;
Printf.eprintf "[vm] Compiled %d functions (%d failed)\n%!" !count !failed;
send_ok_value (Number (float_of_int !count))
end
with
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))
| List [Symbol "reset"] ->
(* Clear all bindings and rebuild env.
We can't reassign env, so clear and re-populate. *)