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

Fix vm_globals: prevent SX definitions from overwriting native primitives

Browse Source 
The env_bind hook was copying SX-defined functions (e.g. has-key? from
stdlib.sx) into vm_globals, shadowing the native primitives seeded there.
CALL_PRIM then called the SX version which broke with wrong arg types.

Fix: env_bind hook skips names that are registered primitives. Native
implementations are authoritative for CALL_PRIM dispatch.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-02 11:10:34 +00:00
parent 92a59eba9d
commit dea1879e27
1 changed files with 10 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -678,7 +678,10 @@ let () =
closure isolation for factory functions like make-page-fn. *)
Sx_types._env_bind_hook := Some (fun env name v ->
if env.parent = None then
Hashtbl.replace _shared_vm_globals name v)
(* Don't let SX definitions (from loaded .sx files) overwrite native
primitives in vm_globals — the native versions are authoritative. *)
if not (Sx_primitives.is_primitive name) then
Hashtbl.replace _shared_vm_globals name v)
let make_server_env () =
let env = make_env () in
@@ -735,11 +738,13 @@ let make_server_env () =
| other -> other);
(* client? returns false on server — overridden in browser via K.eval *)
ignore (env_bind env "client?" (NativeFn ("client?", fun _ -> Bool false)));
(* Seed vm_globals with any primitives not already there.
Must run AFTER all bind/ho_via_cek calls so wrappers take precedence. *)
(* Seed vm_globals with ALL primitives as NativeFn values.
Native primitives override SX definitions (e.g. has-key? from stdlib.sx)
because the native versions are correct and fast. HO forms (map, filter, etc.)
keep their ho_via_cek wrappers since those are set up after this seeding
via the env_bind_hook when SX files are loaded. *)
Hashtbl.iter (fun name fn ->
if not (Hashtbl.mem _shared_vm_globals name) then
Hashtbl.replace _shared_vm_globals name (NativeFn (name, fn))
Hashtbl.replace _shared_vm_globals name (NativeFn (name, fn))
) Sx_primitives.primitives;
env