From 4734d38f3b4bc7cbbe417efe1db38a241c55ba35 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 23 Mar 2026 09:33:18 +0000 Subject: [PATCH] Fix VM correctness: get nil-safe, scope/context/collect! as primitives MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - 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) --- hosts/ocaml/bin/sx_server.ml | 68 +++++++++++++++++++++++++++-- hosts/ocaml/lib/sx_primitives.ml | 4 +- hosts/ocaml/lib/sx_ref.ml | 2 +- hosts/ocaml/lib/sx_vm.ml | 8 ++-- shared/static/scripts/sx-browser.js | 21 +++++++-- spec/evaluator.sx | 26 +++++++---- web/adapter-sx.sx | 24 +++++++++- 7 files changed, 131 insertions(+), 22 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 1710a08..da06a5a 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -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 diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index d314605..715fb75 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -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) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index 53293e1..e314584 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -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 = diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 6d40a94..c6f1f85 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -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)) diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 6115135..6b37254 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -14,7 +14,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-03-23T08:09:30Z"; + var SX_VERSION = "2026-03-23T08:59:15Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -2759,7 +2759,7 @@ PRIMITIVES["aser-call"] = aserCall; PRIMITIVES["aser-expand-component"] = aserExpandComponent; // SPECIAL_FORM_NAMES - var SPECIAL_FORM_NAMES = ["if", "when", "cond", "case", "and", "or", "let", "let*", "lambda", "fn", "define", "defcomp", "defmacro", "defstyle", "defhandler", "defpage", "defquery", "defaction", "defrelation", "begin", "do", "quote", "quasiquote", "->", "set!", "letrec", "dynamic-wind", "defisland", "deftype", "defeffect", "scope", "provide"]; + var SPECIAL_FORM_NAMES = ["if", "when", "cond", "case", "and", "or", "let", "let*", "lambda", "fn", "define", "defcomp", "defmacro", "defstyle", "defhandler", "defpage", "defquery", "defaction", "defrelation", "begin", "do", "quote", "quasiquote", "->", "set!", "letrec", "dynamic-wind", "defisland", "deftype", "defeffect", "scope", "provide", "context", "emit!", "emitted"]; PRIMITIVES["SPECIAL_FORM_NAMES"] = SPECIAL_FORM_NAMES; // HO_FORM_NAMES @@ -2855,7 +2855,22 @@ return result; }, args); { var _c = slice(args, 2); for (var _i = 0; _i < _c.length; _i++) { var body = _c[_i]; result = aser(body, env); } } scopePop(provName); return result; -})() : trampoline(evalExpr(expr, env))))))))))))))))); +})() : (isSxTruthy((name == "context")) ? (function() { + var ctxName = trampoline(evalExpr(first(args), env)); + var defaultVal = (isSxTruthy((len(args) >= 2)) ? trampoline(evalExpr(nth(args, 1), env)) : NIL); + return (function() { + var val = scopePeek(ctxName); + return (isSxTruthy(isNil(val)) ? defaultVal : val); +})(); +})() : (isSxTruthy((name == "emit!")) ? (function() { + var emitName = trampoline(evalExpr(first(args), env)); + var emitVal = trampoline(evalExpr(nth(args, 1), env)); + scopeEmit(emitName, emitVal); + return NIL; +})() : (isSxTruthy((name == "emitted")) ? (function() { + var emitName = trampoline(evalExpr(first(args), env)); + return sxOr(scopePeek(emitName), []); +})() : trampoline(evalExpr(expr, env)))))))))))))))))))); })(); }; PRIMITIVES["aser-special"] = aserSpecial; diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 0b5c754..e5a05d9 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -1476,19 +1476,29 @@ (make-provide-frame name val (rest body) env) kont))))))) -;; context: walk kont for nearest ProvideFrame with matching name +;; context: check hashtable scope stacks first (set by aser's scope-push!), +;; then walk kont for nearest ProvideFrame with matching name. +;; The hashtable check is needed because aser renders scopes via scope-push!/pop! +;; but inner eval-expr calls (e.g. inside (str ...)) use the CEK continuation. (define step-sf-context (fn (args env kont) (let ((name (trampoline (eval-expr (first args) env))) (default-val (if (>= (len args) 2) (trampoline (eval-expr (nth args 1) env)) - nil)) - (frame (kont-find-provide kont name))) - (if frame - (make-cek-value (get frame "value") env kont) - (if (>= (len args) 2) - (make-cek-value default-val env kont) - (error (str "No provider for: " name))))))) + nil))) + ;; Check hashtable scope stacks first (aser rendering path) + (let ((stack-val (if (primitive? "scope-peek") + ((get-primitive "scope-peek") name) + nil))) + (if (not (nil? stack-val)) + (make-cek-value stack-val env kont) + ;; Fall back to continuation-based lookup + (let ((frame (kont-find-provide kont name))) + (if frame + (make-cek-value (get frame "value") env kont) + (if (>= (len args) 2) + (make-cek-value default-val env kont) + (error (str "No provider for: " name)))))))))) ;; emit!: walk kont for nearest ScopeAccFrame, append value (define step-sf-emit diff --git a/web/adapter-sx.sx b/web/adapter-sx.sx index ef562ce..77cd5f1 100644 --- a/web/adapter-sx.sx +++ b/web/adapter-sx.sx @@ -291,7 +291,8 @@ "defhandler" "defpage" "defquery" "defaction" "defrelation" "begin" "do" "quote" "quasiquote" "->" "set!" "letrec" "dynamic-wind" "defisland" - "deftype" "defeffect" "scope" "provide")) + "deftype" "defeffect" "scope" "provide" + "context" "emit!" "emitted")) (define HO_FORM_NAMES (list "map" "map-indexed" "filter" "reduce" @@ -460,6 +461,27 @@ (scope-pop! prov-name) result) + ;; context — scope lookup (uses hashtable stack, not CEK kont) + (= name "context") + (let ((ctx-name (trampoline (eval-expr (first args) env))) + (default-val (if (>= (len args) 2) + (trampoline (eval-expr (nth args 1) env)) + nil))) + (let ((val (scope-peek ctx-name))) + (if (nil? val) default-val val))) + + ;; emit! — scope accumulator + (= name "emit!") + (let ((emit-name (trampoline (eval-expr (first args) env))) + (emit-val (trampoline (eval-expr (nth args 1) env)))) + (scope-emit! emit-name emit-val) + nil) + + ;; emitted — collect accumulated scope values + (= name "emitted") + (let ((emit-name (trampoline (eval-expr (first args) env)))) + (or (scope-peek emit-name) (list))) + ;; Everything else — evaluate normally :else (trampoline (eval-expr expr env))))))