Fix VM correctness: get nil-safe, scope/context/collect! as primitives

- get primitive returns nil for type mismatches (list+string) instead
  of raising — matches JS/Python behavior, fixes find-nav-match errors
- scope-peek, collect!, collected, clear-collected! registered as real
  primitives in sx_primitives table (not just env bindings) so the CEK
  step-sf-context can find them via get-primitive
- step-sf-context checks scope-peek hashtable BEFORE walking CEK
  continuation — bridges aser's scope-push!/pop! with CEK's context
- context, emit!, emitted added to SPECIAL_FORM_NAMES and handled in
  aser-special (scope operations in aser rendering mode)
- sx-context NativeFn for VM-compiled code paths
- VM execution errors no longer mark functions as permanently failed —
  bytecode is correct, errors are from runtime data
- kbd, samp, var added to HTML_TAGS + sx-browser.js rebuilt

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-23 09:33:18 +00:00
parent a716e3f745
commit 4734d38f3b
7 changed files with 131 additions and 22 deletions

View File

@@ -125,6 +125,51 @@ let io_batch_mode = ref false
let io_queue : (int * string * value list) list ref = ref []
let io_counter = ref 0
(** Module-level scope stacks — shared between make_server_env (aser
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.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)
(** collect! — lazy scope accumulator. Creates root scope if missing,
emits value (deduplicates). Used by cssx and spread components. *)
let () = Sx_primitives.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)
| [] ->
(* Lazy root scope — create with the value *)
Hashtbl.replace _scope_stacks name [List [value]]
| _ :: _ -> ());
Nil
| _ -> Nil)
let () = Sx_primitives.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 [])
let () = Sx_primitives.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)
| [] -> ());
Nil
| _ -> Nil)
(** Helpers safe to defer — pure functions whose results are only used
as rendering output (inlined into SX wire format), not in control flow. *)
let batchable_helpers = [
@@ -309,8 +354,9 @@ let make_server_env () =
bind "render-active?" (fun _args -> Bool true);
(* Scope stack — platform primitives for render-time dynamic scope.
Used by aser for spread/provide/emit patterns. *)
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 in
Used by aser for spread/provide/emit patterns.
Module-level so step-sf-context can check it via get-primitive. *)
let scope_stacks = _scope_stacks in
bind "scope-push!" (fun args ->
match args with
| [String name; value] ->
@@ -346,6 +392,19 @@ let make_server_env () =
| [] -> ()); Nil
| _ -> Nil);
(* context — scope lookup. The CEK handles this as a special form
by walking continuation frames, but compiled VM code needs it as
a function that reads from the scope_stacks hashtable. *)
bind "sx-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);
(* Evaluator bridge — aser calls these spec functions.
Route to the OCaml CEK machine. *)
bind "eval-expr" (fun args ->
@@ -714,9 +773,10 @@ let register_jit_hook env =
| Lambda l ->
(match l.l_compiled with
| Some cl when not (Sx_vm.is_jit_failed cl) ->
(* Cached bytecode — execute on VM, fall back to CEK on error *)
(* Cached bytecode — execute on VM, fall back to CEK on error.
Don't invalidate cache — bytecode is correct, error is runtime. *)
(try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
with _ -> l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None)
with _ -> None)
| Some _ -> None (* failed sentinel *)
| None ->
(* Don't try to compile while already compiling (prevents