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

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

Browse Source 
- 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:
giles
2026-03-23 09:33:18 +00:00
parent a716e3f745
commit 4734d38f3b
7 changed files with 131 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
hosts/ocaml/bin/sx_server.ml
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

4
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -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)

2
hosts/ocaml/lib/sx_ref.ml
View File

@@ -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 =

8
hosts/ocaml/lib/sx_vm.ml
View File

@@ -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))

21
shared/static/scripts/sx-browser.js
View File

@@ -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;

26
spec/evaluator.sx
View File

@@ -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

24
web/adapter-sx.sx
View File

@@ -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))))))