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:
@@ -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
|
||||
|
||||
@@ -500,7 +500,9 @@ let () =
|
||||
| [Dict d; Keyword k] -> dict_get d k
|
||||
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
|
||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
||||
| _ -> raise (Eval_error "get: dict+key or list+index"));
|
||||
| [Nil; _] -> Nil (* nil.anything → nil *)
|
||||
| [_; _] -> Nil (* type mismatch → nil (matches JS/Python behavior) *)
|
||||
| _ -> Nil);
|
||||
register "has-key?" (fun args ->
|
||||
match args with
|
||||
| [Dict d; String k] -> Bool (dict_has d k)
|
||||
|
||||
@@ -403,7 +403,7 @@ and step_sf_provide args env kont =
|
||||
|
||||
(* step-sf-context *)
|
||||
and step_sf_context args env kont =
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "value")))) (env) (kont)) else (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (make_cek_value (default_val) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No provider for: "); name]))))))))
|
||||
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in (let stack_val = (if sx_truthy ((is_primitive ((String "scope-peek")))) then (cek_call ((get_primitive ((String "scope-peek")))) (List [name])) else Nil) in (if sx_truthy ((Bool (not (sx_truthy ((is_nil (stack_val))))))) then (make_cek_value (stack_val) (env) (kont)) else (let frame = (kont_find_provide (kont) (name)) in (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "value")))) (env) (kont)) else (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (make_cek_value (default_val) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No provider for: "); name])))))))))))
|
||||
|
||||
(* step-sf-emit *)
|
||||
and step_sf_emit args env kont =
|
||||
|
||||
@@ -313,11 +313,11 @@ and vm_call vm f args =
|
||||
(* Try JIT-compiled path first *)
|
||||
(match l.l_compiled with
|
||||
| Some cl when not (is_jit_failed cl) ->
|
||||
(* Execute cached bytecode; fall back to CEK on VM error *)
|
||||
(* Execute cached bytecode; fall back to CEK on VM error.
|
||||
Don't mark as failed — the bytecode is correct, the error
|
||||
is from runtime data (e.g. type mismatch in get). *)
|
||||
(try push vm (call_closure cl args vm.globals)
|
||||
with _ ->
|
||||
l.l_compiled <- Some jit_failed_sentinel;
|
||||
push vm (Sx_ref.cek_call f (List args)))
|
||||
with _ -> push vm (Sx_ref.cek_call f (List args)))
|
||||
| Some _ ->
|
||||
(* Previously failed or skipped — use CEK *)
|
||||
push vm (Sx_ref.cek_call f (List args))
|
||||
|
||||
Reference in New Issue
Block a user