plans: tick Phase 5 channel I/O — 349/349 green

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

hosts/javascript/platform.py

@@ -1129,6 +1129,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
   PRIMITIVES["boolean?"] = function(x) { return x === true || x === false; };
   PRIMITIVES["symbol?"] = function(x) { return x != null && x._sym === true; };
   PRIMITIVES["keyword?"] = function(x) { return x != null && x._kw === true; };
+  PRIMITIVES["adt?"] = function(x) { return x !== null && typeof x === "object" && x._adtv === true; };
   PRIMITIVES["component-affinity"] = componentAffinity;
 ''',
 
@@ -1475,6 +1476,22 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
   };
   PRIMITIVES["string-buffer->string"] = function(buf) { return buf.parts.join(""); };
   PRIMITIVES["string-buffer-length"] = function(buf) { return buf.len; };
+
+  // Short aliases — terser names; append accepts any value
+  PRIMITIVES["make-buffer"] = function() { return new SxStringBuffer(); };
+  PRIMITIVES["buffer?"] = function(x) { return x instanceof SxStringBuffer; };
+  PRIMITIVES["buffer-append!"] = function(buf, v) {
+    var s;
+    if (v === null || v === undefined || v === NIL) s = "";
+    else if (typeof v === "string") s = v;
+    else if (typeof v === "boolean") s = v ? "true" : "false";
+    else if (typeof v === "number") s = String(v);
+    else if (v && typeof v === "object" && typeof v.name === "string" && v.constructor && v.constructor.name === "Symbol") s = v.name;
+    else s = (typeof inspect === "function") ? inspect(v) : String(v);
+    buf.parts.push(s); buf.len += s.length; return NIL;
+  };
+  PRIMITIVES["buffer->string"] = function(buf) { return buf.parts.join(""); };
+  PRIMITIVES["buffer-length"] = function(buf) { return buf.len; };
 ''',
 
     "stdlib.format": '''
@@ -1933,12 +1950,30 @@ PLATFORM_JS_PRE = '''
     if (x._regexp) return "regexp";
     if (x._bytevector) return "bytevector";
     if (x._rational) return "rational";
+    if (x._adtv) return x._type;
     if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
     if (Array.isArray(x)) return "list";
     if (typeof x === "object") return "dict";
     return "unknown";
   }
 
+  // AdtValue — native algebraic data type instance (Step 6 mirror of OCaml Step 5).
+  // Constructed by define-type. Carries _adt:true plus _adtv:true tag so type-of
+  // returns the type name rather than "dict". dict? remains true (shim approach)
+  // so spec-level match-pattern in evaluator.sx works without changes.
+  function makeAdtValue(typeName, ctorName, fields) {
+    return {
+      _adtv: true,
+      _adt: true,
+      _type: typeName,
+      _ctor: ctorName,
+      _fields: fields
+    };
+  }
+  function isAdtValue(x) {
+    return x !== null && typeof x === "object" && x._adtv === true;
+  }
+
   function symbolName(s) { return s.name; }
   function keywordName(k) { return k.name; }
   function makeSymbol(n) { return new Symbol(n); }
@@ -2105,6 +2140,13 @@ PLATFORM_JS_PRE = '''
   // hostError — throw a host-level error that propagates out of cekRun.
   function hostError(msg) { throw new Error(typeof msg === "string" ? msg : inspect(msg)); }
 
+  // hostWarn — emit a host-level warning to console (no-op if console missing).
+  function hostWarn(msg) {
+    var m = typeof msg === "string" ? msg : inspect(msg);
+    if (typeof console !== "undefined" && console.warn) console.warn(m);
+    return NIL;
+  }
+
   // Render dispatch — call the active adapter's render function.
   // Set by each adapter when loaded; defaults to identity (no rendering).
   var _renderExprFn = null;
@@ -2126,7 +2168,16 @@ PLATFORM_JS_PRE = '''
   }
 
   function error(msg) { throw new Error(msg); }
-  function inspect(x) { return JSON.stringify(x); }
+  function inspect(x) {
+    if (x !== null && typeof x === "object" && x._adtv === true) {
+      var fs = x._fields || [];
+      if (fs.length === 0) return "(" + x._ctor + ")";
+      var parts = [];
+      for (var i = 0; i < fs.length; i++) parts.push(inspect(fs[i]));
+      return "(" + x._ctor + " " + parts.join(" ") + ")";
+    }
+    return JSON.stringify(x);
+  }
   function debugLog() { console.error.apply(console, ["[sx-debug]"].concat(Array.prototype.slice.call(arguments))); }
 
 '''
@@ -2450,6 +2501,7 @@ CEK_FIXUPS_JS = '''
   // Platform functions — defined in platform_js.py, not in .sx spec files.
   // Spec defines self-register via js-emit-define; these are the platform interface.
   PRIMITIVES["type-of"] = typeOf;
+  PRIMITIVES["inspect"] = inspect;
   PRIMITIVES["symbol-name"] = symbolName;
   PRIMITIVES["keyword-name"] = keywordName;
   PRIMITIVES["callable?"] = isCallable;
@@ -3981,6 +4033,11 @@ def fixups_js(has_html, has_sx, has_dom, has_signals=False, has_deps=False, has_
   // -----------------------------------------------------------------------
   PRIMITIVES["error"] = function(msg) { throw new Error(msg); };
   PRIMITIVES["host-error"] = function(msg) { throw new Error(typeof msg === "string" ? msg : inspect(msg)); };
+  PRIMITIVES["host-warn"] = function(msg) {
+    var m = typeof msg === "string" ? msg : inspect(msg);
+    if (typeof console !== "undefined" && console.warn) console.warn(m);
+    return NIL;
+  };
   PRIMITIVES["try-catch"] = function(tryFn, catchFn) {
     try {
       return cekRun(continueWithCall(tryFn, [], makeEnv(), [], []));
@@ -4103,7 +4160,56 @@ def fixups_js(has_html, has_sx, has_dom, has_signals=False, has_deps=False, has_
   function clearStores() { _storeRegistry = {}; return NIL; }
   PRIMITIVES["def-store"] = defStore;
   PRIMITIVES["use-store"] = useStore;
-  PRIMITIVES["clear-stores"] = clearStores;''']
+  PRIMITIVES["clear-stores"] = clearStores;
+
+  // -----------------------------------------------------------------------
+  // define-type override — produces native AdtValue instances (Step 6).
+  // The transpiled sfDefineType from evaluator.sx creates plain dict
+  // instances. We override here to construct AdtValue via makeAdtValue so
+  // type-of returns the type name and adt? can distinguish from dicts.
+  // dict? still returns true for AdtValue (shim) so spec-level match-pattern
+  // continues to work without changes.
+  // -----------------------------------------------------------------------
+  var _sfDefineTypeAdt = function(args, env) {
+    var typeSym = first(args);
+    var ctorSpecs = rest(args);
+    var typeName = symbolName(typeSym);
+    var ctorNames = map(function(spec) { return symbolName(first(spec)); }, ctorSpecs);
+    if (!isSxTruthy(envHas(env, "*adt-registry*"))) {
+      envBind(env, "*adt-registry*", {});
+    }
+    envGet(env, "*adt-registry*")[typeName] = ctorNames;
+    envBind(env, typeName + "?", function(v) { return isAdtValue(v) && v._type === typeName; });
+    for (var _i = 0; _i < ctorSpecs.length; _i++) {
+      (function(spec) {
+        var cn = symbolName(first(spec));
+        var fieldNames = map(function(f) { return symbolName(f); }, rest(spec));
+        var arity = fieldNames.length;
+        envBind(env, cn, function() {
+          var ctorArgs = Array.prototype.slice.call(arguments, 0);
+          if (ctorArgs.length !== arity) {
+            throw new Error(cn + ": expected " + arity + " args, got " + ctorArgs.length);
+          }
+          return makeAdtValue(typeName, cn, ctorArgs);
+        });
+        envBind(env, cn + "?", function(v) { return isAdtValue(v) && v._ctor === cn; });
+        for (var _j = 0; _j < fieldNames.length; _j++) {
+          (function(idx, fieldName) {
+            envBind(env, cn + "-" + fieldName, function(v) {
+              if (!isAdtValue(v)) throw new Error(cn + "-" + fieldName + ": not an ADT");
+              if (idx >= v._fields.length) throw new Error(cn + "-" + fieldName + ": index out of bounds");
+              return v._fields[idx];
+            });
+          })(_j, fieldNames[_j]);
+        }
+      })(ctorSpecs[_i]);
+    }
+    return NIL;
+  };
+  PRIMITIVES["sf-define-type"] = _sfDefineTypeAdt;
+  registerSpecialForm("define-type", _sfDefineTypeAdt);
+  PRIMITIVES["make-adt-value"] = makeAdtValue;
+  PRIMITIVES["adt-value?"] = isAdtValue;''']
     if has_deps:
         lines.append('''
   // Platform deps functions (native JS, not transpiled — need explicit registration)

hosts/ocaml/bin/bench_cek.ml

@@ -0,0 +1,73 @@
+(** CEK benchmark — measures throughput of the CEK evaluator on tight loops.
+
+    Usage:
+      dune exec bin/bench_cek.exe
+      dune exec bin/bench_cek.exe -- 5      (5 runs each)
+*)
+
+open Sx_types
+open Sx_parser
+
+let parse_one s =
+  let exprs = parse_all s in
+  match exprs with
+  | e :: _ -> e
+  | [] -> failwith "empty parse"
+
+let parse_many s = parse_all s
+
+let bench_run name setup expr iters =
+  let env = Sx_types.make_env () in
+  (* Run setup forms in env *)
+  List.iter (fun e -> ignore (Sx_ref.eval_expr e (Env env))) setup;
+  let times = ref [] in
+  for _ = 1 to iters do
+    Gc.full_major ();
+    let t0 = Unix.gettimeofday () in
+    let _r = Sx_ref.eval_expr expr (Env env) in
+    let t1 = Unix.gettimeofday () in
+    times := (t1 -. t0) :: !times
+  done;
+  let sorted = List.sort compare !times in
+  let median = List.nth sorted (iters / 2) in
+  let min_t = List.nth sorted 0 in
+  let max_t = List.nth sorted (iters - 1) in
+  Printf.printf "  %-22s  min=%8.2fms  median=%8.2fms  max=%8.2fms\n%!"
+    name (min_t *. 1000.0) (median *. 1000.0) (max_t *. 1000.0);
+  median
+
+let () =
+  let iters =
+    if Array.length Sys.argv > 1
+    then int_of_string Sys.argv.(1)
+    else 5
+  in
+  Printf.printf "CEK benchmark (%d runs each, taking median)\n%!" iters;
+  Printf.printf "==========================================\n%!";
+
+  (* fib 18 — recursive function call benchmark, smallish *)
+  let fib_setup = parse_many "(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))" in
+  let fib_expr = parse_one "(fib 18)" in
+  let _ = bench_run "fib(18)" fib_setup fib_expr iters in
+
+  (* loop 5000 — tight let loop *)
+  let loop_setup = parse_many "(define (loop n acc) (if (= n 0) acc (loop (- n 1) (+ acc 1))))" in
+  let loop_expr = parse_one "(loop 5000 0)" in
+  let _ = bench_run "loop(5000)" loop_setup loop_expr iters in
+
+  (* map+square over 1000 elem list *)
+  let map_setup = parse_many "(define (range-list n) (let loop ((i 0) (acc (list))) (if (= i n) acc (loop (+ i 1) (cons i acc))))) (define xs (range-list 1000))" in
+  let map_expr = parse_one "(map (fn (x) (* x x)) xs)" in
+  let _ = bench_run "map sq xs(1000)" map_setup map_expr iters in
+
+  (* reduce + over 2000 elem list *)
+  let red_setup = parse_many "(define (range-list n) (let loop ((i 0) (acc (list))) (if (= i n) acc (loop (+ i 1) (cons i acc))))) (define ys (range-list 2000))" in
+  let red_expr = parse_one "(reduce + 0 ys)" in
+  let _ = bench_run "reduce + ys(2000)" red_setup red_expr iters in
+
+  (* let-heavy: many bindings + if *)
+  let lh_setup = parse_many "(define (lh n) (let ((a 1) (b 2) (c 3) (d 4)) (if (= n 0) (+ a b c d) (lh (- n 1)))))" in
+  let lh_expr = parse_one "(lh 2000)" in
+  let _ = bench_run "let-heavy(2000)" lh_setup lh_expr iters in
+
+  Printf.printf "\nDone.\n%!"

hosts/ocaml/bin/bench_inspect.ml

@@ -0,0 +1,46 @@
+(* Benchmark inspect on representative SX values.
+   Takes min of 9 runs of n iterations to dampen GC noise. *)
+open Sx_types
+
+let rec make_tree d =
+  if d = 0 then String "leaf"
+  else List [String "node"; make_tree (d - 1); make_tree (d - 1); make_tree (d - 1)]
+
+let bench_min label f n runs =
+  let times = ref [] in
+  for _ = 1 to runs do
+    Gc.compact ();
+    let t0 = Unix.gettimeofday () in
+    for _ = 1 to n do ignore (f ()) done;
+    let t1 = Unix.gettimeofday () in
+    times := (t1 -. t0) :: !times
+  done;
+  let sorted = List.sort compare !times in
+  let min_t = List.nth sorted 0 in
+  let median = List.nth sorted (runs / 2) in
+  Printf.printf "  %-30s  min=%6.2fms  median=%6.2fms  (n=%d * %d runs)\n%!"
+    label (min_t *. 1000.0 /. float_of_int n)
+    (median *. 1000.0 /. float_of_int n) n runs
+
+let () =
+  let tree8 = make_tree 8 in
+  let s = inspect tree8 in
+  Printf.printf "tree-d8 inspect len=%d\n%!" (String.length s);
+  bench_min "inspect tree-d8" (fun () -> inspect tree8) 50 9;
+
+  let tree10 = make_tree 10 in
+  let s = inspect tree10 in
+  Printf.printf "tree-d10 inspect len=%d\n%!" (String.length s);
+  bench_min "inspect tree-d10" (fun () -> inspect tree10) 5 9;
+
+  let dict_xs = make_dict () in
+  for i = 0 to 999 do
+    Hashtbl.replace dict_xs (string_of_int i) (Integer i)
+  done;
+  let d = Dict dict_xs in
+  bench_min "inspect dict-1000" (fun () -> inspect d) 100 9;
+
+  let xs = ref [] in
+  for i = 0 to 1999 do xs := Integer i :: !xs done;
+  let lst = List !xs in
+  bench_min "inspect list-2000" (fun () -> inspect lst) 200 9

hosts/ocaml/bin/bench_vm.ml

@@ -0,0 +1,155 @@
+(** VM bytecode benchmark — measures throughput of the VM (compiled bytecode).
+
+    Loads the SX compiler via CEK, then for each test:
+      1. Define the function via CEK (as a Lambda).
+      2. Trigger JIT compilation via Sx_vm.jit_compile_lambda.
+      3. Call the compiled VmClosure repeatedly via Sx_vm.call_closure.
+
+    This measures pure VM execution time on the JIT path. *)
+
+open Sx_types
+
+let load_compiler env globals =
+  let compiler_path =
+    if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
+    else if Sys.file_exists "../../lib/compiler.sx" then "../../lib/compiler.sx"
+    else if Sys.file_exists "../../../lib/compiler.sx" then "../../../lib/compiler.sx"
+    else failwith "compiler.sx not found"
+  in
+  let ic = open_in compiler_path in
+  let src = really_input_string ic (in_channel_length ic) in
+  close_in ic;
+  let exprs = Sx_parser.parse_all src in
+  List.iter (fun e -> ignore (Sx_ref.eval_expr e (Env env))) exprs;
+  let rec sync e =
+    Hashtbl.iter (fun id v ->
+      let name = Sx_types.unintern id in
+      Hashtbl.replace globals name v) e.bindings;
+    match e.parent with Some p -> sync p | None -> ()
+  in
+  sync env
+
+let _make_globals env =
+  let g = Hashtbl.create 512 in
+  Hashtbl.iter (fun name fn ->
+    Hashtbl.replace g name (NativeFn (name, fn))
+  ) Sx_primitives.primitives;
+  let rec sync e =
+    Hashtbl.iter (fun id v ->
+      let name = Sx_types.unintern id in
+      if not (Hashtbl.mem g name) then Hashtbl.replace g name v) e.bindings;
+    match e.parent with Some p -> sync p | None -> ()
+  in
+  sync env;
+  g
+
+let define_fn env globals name params body_src =
+  (* Define via CEK so we get a Lambda value with proper closure. *)
+  let body_expr = match Sx_parser.parse_all body_src with
+    | [e] -> e
+    | _ -> failwith "expected one body expression"
+  in
+  let param_syms = List (List.map (fun p -> Symbol p) params) in
+  let define_expr = List [Symbol "define"; Symbol name; List [Symbol "fn"; param_syms; body_expr]] in
+  ignore (Sx_ref.eval_expr define_expr (Env env));
+  (* Sync env to globals so JIT can resolve free vars. *)
+  let rec sync e =
+    Hashtbl.iter (fun id v ->
+      let n = Sx_types.unintern id in
+      Hashtbl.replace globals n v) e.bindings;
+    match e.parent with Some p -> sync p | None -> ()
+  in
+  sync env;
+  (* Now find the Lambda and JIT-compile it. *)
+  let lam_val = Hashtbl.find globals name in
+  match lam_val with
+  | Lambda l ->
+    (match Sx_vm.jit_compile_lambda l globals with
+     | Some cl ->
+       l.l_compiled <- Some cl;
+       Hashtbl.replace globals name (NativeFn (name, fun args ->
+         Sx_vm.call_closure cl args globals));
+       cl
+     | None ->
+       failwith (Printf.sprintf "JIT failed for %s" name))
+  | _ -> failwith (Printf.sprintf "%s is not a Lambda after define" name)
+
+let bench_call name cl globals args iters =
+  let times = ref [] in
+  for _ = 1 to iters do
+    Gc.full_major ();
+    let t0 = Unix.gettimeofday () in
+    let _r = Sx_vm.call_closure cl args globals in
+    let t1 = Unix.gettimeofday () in
+    times := (t1 -. t0) :: !times
+  done;
+  let sorted = List.sort compare !times in
+  let median = List.nth sorted (iters / 2) in
+  let min_t = List.nth sorted 0 in
+  let max_t = List.nth sorted (iters - 1) in
+  Printf.printf "  %-22s  min=%8.2fms  median=%8.2fms  max=%8.2fms\n%!"
+    name (min_t *. 1000.0) (median *. 1000.0) (max_t *. 1000.0);
+  median
+
+let () =
+  let iters =
+    if Array.length Sys.argv > 1
+    then int_of_string Sys.argv.(1)
+    else 7
+  in
+  Printf.printf "VM (bytecode/JIT) benchmark (%d runs each, taking median)\n%!" iters;
+  Printf.printf "========================================================\n%!";
+
+  let env = Sx_types.make_env () in
+  let bind n fn = ignore (Sx_types.env_bind env n (NativeFn (n, fn))) in
+  (* Seed env with primitives as NativeFn so CEK lookups work. *)
+  Hashtbl.iter (fun name fn ->
+    Hashtbl.replace env.bindings (Sx_types.intern name) (NativeFn (name, fn))
+  ) Sx_primitives.primitives;
+  (* Helpers the SX compiler relies on but aren't kernel primitives. *)
+  bind "symbol-name" (fun args -> match args with
+    | [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name"));
+  bind "keyword-name" (fun args -> match args with
+    | [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name"));
+  bind "make-symbol" (fun args -> match args with
+    | [String s] -> Symbol s
+    | [v] -> Symbol (Sx_types.value_to_string v)
+    | _ -> raise (Eval_error "make-symbol"));
+  bind "sx-serialize" (fun args -> match args with
+    | [v] -> String (Sx_types.inspect v)
+    | _ -> raise (Eval_error "sx-serialize"));
+  let globals = Hashtbl.create 1024 in
+  Hashtbl.iter (fun name fn ->
+    Hashtbl.replace globals name (NativeFn (name, fn))
+  ) Sx_primitives.primitives;
+  Printf.printf "Loading compiler.sx ... %!";
+  let t0 = Unix.gettimeofday () in
+  load_compiler env globals;
+  Printf.printf "%.0fms\n%!" ((Unix.gettimeofday () -. t0) *. 1000.0);
+
+  (* fib(22) — recursive call benchmark *)
+  let fib_cl = define_fn env globals "fib" ["n"]
+    "(if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))" in
+  let _ = bench_call "fib(22)" fib_cl globals [Number 22.0] iters in
+
+  (* tight loop *)
+  let loop_cl = define_fn env globals "loop" ["n"; "acc"]
+    "(if (= n 0) acc (loop (- n 1) (+ acc 1)))" in
+  let _ = bench_call "loop(200000)" loop_cl globals [Number 200000.0; Number 0.0] iters in
+
+  (* sum-to *)
+  let sum_cl = define_fn env globals "sum_to" ["n"; "acc"]
+    "(if (= n 0) acc (sum_to (- n 1) (+ acc n)))" in
+  let _ = bench_call "sum-to(50000)" sum_cl globals [Number 50000.0; Number 0.0] iters in
+
+  (* count-lt: comparison-heavy *)
+  let cnt_cl = define_fn env globals "count_lt" ["n"; "acc"]
+    "(if (= n 0) acc (count_lt (- n 1) (if (< n 10000) (+ acc 1) acc)))" in
+  let _ = bench_call "count-lt(20000)" cnt_cl globals [Number 20000.0; Number 0.0] iters in
+
+  (* count-eq: equality-heavy on multiples of 7 *)
+  let eq_cl = define_fn env globals "count_eq" ["n"; "acc"]
+    "(if (= n 0) acc (count_eq (- n 1) (if (= 0 (- n (* 7 (/ n 7)))) (+ acc 1) acc)))" in
+  let _ = bench_call "count-eq(20000)" eq_cl globals [Number 20000.0; Number 0.0] iters in
+
+  Printf.printf "\nDone.\n%!"

hosts/ocaml/bin/dune

@@ -1,5 +1,5 @@
 (executables
- (names run_tests debug_set sx_server integration_tests)
+ (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect bench_vm)
  (libraries sx unix threads.posix otfm yojson))
 
 (executable

hosts/ocaml/bin/run_tests.ml

@@ -2899,6 +2899,9 @@ let run_spec_tests env test_files =
   load_module "parser.sx" hs_dir;
   load_module "compiler.sx" hs_dir;
   load_module "runtime.sx" hs_dir;
+  let hs_plugins_dir = Filename.concat hs_dir "plugins" in
+  load_module "worker.sx" hs_plugins_dir;
+  load_module "prolog.sx" hs_plugins_dir;
   load_module "integration.sx" hs_dir;
   load_module "htmx.sx" hs_dir;
   (* Override console-log to avoid str on circular mock DOM refs *)

hosts/ocaml/browser/bundle.sh

@@ -75,6 +75,9 @@ cp "$ROOT/shared/sx/templates/tw.sx"        "$DIST/sx/"
 for f in tokenizer parser compiler runtime integration htmx; do
   cp "$ROOT/lib/hyperscript/$f.sx" "$DIST/sx/hs-$f.sx"
 done
+for f in worker prolog; do
+  cp "$ROOT/lib/hyperscript/plugins/$f.sx" "$DIST/sx/hs-$f.sx"
+done
 
 # Summary
 WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)

hosts/ocaml/browser/compile-modules.js

@@ -85,6 +85,7 @@ const FILES = [
   'harness-web.sx', 'engine.sx', 'orchestration.sx',
   // Hyperscript modules — loaded on demand via transparent lazy loader
   'hs-tokenizer.sx', 'hs-parser.sx', 'hs-compiler.sx', 'hs-runtime.sx',
+  'hs-worker.sx', 'hs-prolog.sx',
   'hs-integration.sx', 'hs-htmx.sx',
   'boot.sx',
 ];
@@ -455,8 +456,10 @@ for (const file of FILES) {
         'hs-parser': ['hs-tokenizer'],
         'hs-compiler': ['hs-tokenizer', 'hs-parser'],
         'hs-runtime': ['hs-tokenizer', 'hs-parser', 'hs-compiler'],
-        'hs-integration': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'],
-        'hs-htmx': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration'],
+        'hs-worker': ['hs-tokenizer', 'hs-parser'],
+        'hs-prolog': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'],
+        'hs-integration': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog'],
+        'hs-htmx': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog', 'hs-integration'],
       };
       manifest[key] = {
         file: sxbcFile,
@@ -477,7 +480,7 @@ if (entryFile) {
   const lazyDeps = entryFile.deps.filter(d => LAZY_ENTRY_DEPS.has(d));
   // Hyperscript modules aren't define-library, so not auto-detected as deps.
   // Load them lazily after boot — eager loading breaks the boot sequence.
-  const HS_LAZY = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration', 'hs-htmx'];
+  const HS_LAZY = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog', 'hs-integration', 'hs-htmx'];
   for (const m of HS_LAZY) {
     if (manifest[m] && !lazyDeps.includes(m)) lazyDeps.push(m);
   }

hosts/ocaml/lib/sx_compiler.ml

@@ -200,7 +200,30 @@ and compile_qq_list em items scope =
 
 (* compile-call *)
 and compile_call em head args scope tail_p =
-  (let is_prim = (let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let name = (symbol_name (head)) in (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "local")]))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "upvalue")]))))) in if not (sx_truthy _and) then _and else (is_primitive (name)))))) in (if sx_truthy (is_prim) then (let name = (symbol_name (head)) in let argc = (len (args)) in let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (let () = ignore ((emit_op (em) ((Number 52.0)))) in (let () = ignore ((emit_u16 (em) (name_idx))) in (emit_byte (em) (argc)))))) else (let () = ignore ((compile_expr (em) (head) (scope) ((Bool false)))) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (if sx_truthy (tail_p) then (let () = ignore ((emit_op (em) ((Number 49.0)))) in (emit_byte (em) ((len (args))))) else (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((len (args))))))))))
+  (let is_prim = (let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let name = (symbol_name (head)) in (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "local")]))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "upvalue")]))))) in if not (sx_truthy _and) then _and else (is_primitive (name)))))) in (if sx_truthy (is_prim) then (let name = (symbol_name (head)) in let argc = (len (args)) in
+    (* Specialized opcode for hot 2-arg / 1-arg primitives. *)
+    let specialized_op = (match name, argc with
+      | String "+",     Number 2.0 -> Some 160
+      | String "-",     Number 2.0 -> Some 161
+      | String "*",     Number 2.0 -> Some 162
+      | String "/",     Number 2.0 -> Some 163
+      | String "=",     Number 2.0 -> Some 164
+      | String "<",     Number 2.0 -> Some 165
+      | String ">",     Number 2.0 -> Some 166
+      | String "cons",  Number 2.0 -> Some 172
+      | String "not",   Number 1.0 -> Some 167
+      | String "len",   Number 1.0 -> Some 168
+      | String "first", Number 1.0 -> Some 169
+      | String "rest",  Number 1.0 -> Some 170
+      | _ -> None) in
+    (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in
+     (match specialized_op with
+      | Some op -> emit_op em (Number (float_of_int op))
+      | None ->
+        let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in
+        let () = ignore ((emit_op (em) ((Number 52.0)))) in
+        let () = ignore ((emit_u16 (em) (name_idx))) in
+        emit_byte (em) (argc)))) else (let () = ignore ((compile_expr (em) (head) (scope) ((Bool false)))) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (if sx_truthy (tail_p) then (let () = ignore ((emit_op (em) ((Number 49.0)))) in (emit_byte (em) ((len (args))))) else (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((len (args))))))))))
 
 (* compile *)
 and compile expr =

hosts/ocaml/lib/sx_ref.ml

@@ -759,7 +759,78 @@ and match_pattern pattern value env =
 
 (* step-sf-match *)
 and step_sf_match args env kont =
-  (let val' = (trampoline ((eval_expr ((first (args))) (env)))) in let clauses = (rest (args)) in (let result' = (match_find_clause (val') (clauses) (env)) in (if sx_truthy ((is_nil (result'))) then (make_cek_value ((String (sx_str [(String "match: no clause matched "); (inspect (val'))]))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (make_cek_state ((nth (result') ((Number 1.0)))) ((first (result'))) (kont)))))
+  (let val' = (trampoline ((eval_expr ((first (args))) (env)))) in let clauses = (rest (args)) in (let () = ignore (match_check_exhaustiveness val' clauses env) in (let result' = (match_find_clause (val') (clauses) (env)) in (if sx_truthy ((is_nil (result'))) then (make_cek_value ((String (sx_str [(String "match: no clause matched "); (inspect (val'))]))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (make_cek_state ((nth (result') ((Number 1.0)))) ((first (result'))) (kont))))))
+
+(* match-check-exhaustiveness — Step 8 hand-patched into sx_ref.ml *)
+and match_check_exhaustiveness val' clauses env =
+  let is_else_pat p =
+    match p with
+    | Symbol "_" | Symbol "else" -> true
+    | Keyword "else" -> true
+    | _ -> false
+  in
+  let clause_is_else c =
+    match c with
+    | List (p :: _) -> is_else_pat p
+    | _ -> false
+  in
+  let clause_ctor_name c =
+    match c with
+    | List (List (Symbol n :: _) :: _) -> Some n
+    | _ -> None
+  in
+  let type_name_opt = match val' with
+    | AdtValue a -> Some a.av_type
+    | Dict d ->
+      (match Hashtbl.find_opt d "_adt" with
+       | Some (Bool true) ->
+         (match Hashtbl.find_opt d "_type" with
+          | Some (String s) -> Some s
+          | _ -> None)
+       | _ -> None)
+    | _ -> None
+  in
+  match type_name_opt with
+  | None -> Nil
+  | Some type_name ->
+       if not (sx_truthy (env_has env (String "*adt-registry*"))) then Nil
+       else
+         let registry = env_get env (String "*adt-registry*") in
+         let registered = match registry with
+           | Dict r ->
+             (match Hashtbl.find_opt r type_name with
+              | Some (List ctors) -> Some ctors
+              | _ -> None)
+           | _ -> None in
+         (match registered with
+          | None -> Nil
+          | Some ctor_vals ->
+            let clauses_list = match clauses with List xs -> xs | _ -> [] in
+            if List.exists clause_is_else clauses_list then Nil
+            else
+              let clause_ctors = List.filter_map clause_ctor_name clauses_list in
+              let registered_names = List.filter_map (function
+                | String s -> Some s | _ -> None) ctor_vals in
+              let missing = List.filter (fun c -> not (List.mem c clause_ctors)) registered_names in
+              if missing = [] then Nil
+              else begin
+                if not (sx_truthy (env_has env (String "*adt-warned*"))) then
+                  ignore (env_bind env (String "*adt-warned*") (Dict (Hashtbl.create 4)));
+                let warned = env_get env (String "*adt-warned*") in
+                let key = type_name ^ "|" ^ String.concat "," missing in
+                let already = match warned with
+                  | Dict w -> (match Hashtbl.find_opt w key with Some (Bool true) -> true | _ -> false)
+                  | _ -> false in
+                if already then Nil
+                else begin
+                  (match warned with
+                   | Dict w -> Hashtbl.replace w key (Bool true)
+                   | _ -> ());
+                  let msg = "[sx] match: non-exhaustive — " ^ type_name ^ ": missing " ^ String.concat ", " missing in
+                  ignore (host_warn (String msg));
+                  Nil
+                end
+              end)
 
 (* step-sf-handler-bind *)
 and step_sf_handler_bind args env kont =
@@ -1054,8 +1125,7 @@ let sf_define_type args env_val =
       (match pargs with
       | [v] ->
         (match v with
-        | Dict d -> Bool (Hashtbl.mem d "_adt" &&
-          (match Hashtbl.find_opt d "_type" with Some (String t) -> t = type_name | _ -> false))
+        | AdtValue a -> Bool (a.av_type = type_name)
         | _ -> Bool false)
       | _ -> Bool false)));
   List.iter (fun spec ->
@@ -1069,21 +1139,18 @@ let sf_define_type args env_val =
           if List.length ctor_args <> arity then
             raise (Eval_error (Printf.sprintf "%s: expected %d args, got %d"
               cn arity (List.length ctor_args)))
-          else begin
-            let d = Hashtbl.create 4 in
-            Hashtbl.replace d "_adt"    (Bool true);
-            Hashtbl.replace d "_type"   (String type_name);
-            Hashtbl.replace d "_ctor"   (String cn);
-            Hashtbl.replace d "_fields" (List ctor_args);
-            Dict d
-          end));
+          else
+            AdtValue {
+              av_type = type_name;
+              av_ctor = cn;
+              av_fields = Array.of_list ctor_args;
+            }));
       env_bind_v (cn ^ "?")
         (NativeFn (cn ^ "?", fun pargs ->
           (match pargs with
           | [v] ->
             (match v with
-            | Dict d -> Bool (Hashtbl.mem d "_adt" &&
-              (match Hashtbl.find_opt d "_ctor" with Some (String c) -> c = cn | _ -> false))
+            | AdtValue a -> Bool (a.av_ctor = cn)
             | _ -> Bool false)
           | _ -> Bool false)));
       List.iteri (fun idx fname ->
@@ -1092,13 +1159,10 @@ let sf_define_type args env_val =
             (match pargs with
             | [v] ->
               (match v with
-              | Dict d ->
-                (match Hashtbl.find_opt d "_fields" with
-                | Some (List fs) ->
-                  if idx < List.length fs then List.nth fs idx
-                  else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
-                | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
-              | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not a dict")))
+              | AdtValue a ->
+                if idx < Array.length a.av_fields then a.av_fields.(idx)
+                else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
+              | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
             | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
       ) field_names
     | _ -> ())

hosts/ocaml/lib/sx_runtime.ml

@@ -6,11 +6,72 @@
 
 open Sx_types
 
-(** Call a registered primitive by name. *)
+(** Fast path equality — same as Sx_primitives.safe_eq for the common cases
+    that show up in hot dispatch (string vs string, etc). Falls through to
+    the registered "=" primitive for complex cases. *)
+let rec _fast_eq a b =
+  if a == b then true
+  else match a, b with
+  | String x, String y -> x = y
+  | Integer x, Integer y -> x = y
+  | Number x, Number y -> x = y
+  | Integer x, Number y -> float_of_int x = y
+  | Number x, Integer y -> x = float_of_int y
+  | Bool x, Bool y -> x = y
+  | Nil, Nil -> true
+  | Symbol x, Symbol y -> x = y
+  | Keyword x, Keyword y -> x = y
+  | List la, List lb ->
+    (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
+  | _ -> false
+
+(** Call a registered primitive by name.
+    Fast path for hot dispatch primitives ([=], [<], [>], [<=], [>=], [empty?],
+    [first], [rest], [len]) skips the Hashtbl lookup entirely — these are
+    called millions of times in the CEK [step_continue]/[step_eval] dispatch. *)
 let prim_call name args =
-  match Hashtbl.find_opt Sx_primitives.primitives name with
-  | Some f -> f args
-  | None -> raise (Eval_error ("Unknown primitive: " ^ name))
+  (* Hot path: most-frequently-called primitives by step_continue dispatch *)
+  match name, args with
+  | "=", [a; b] -> Bool (_fast_eq a b)
+  | "empty?", [List []] -> Bool true
+  | "empty?", [List _] -> Bool false
+  | "empty?", [ListRef { contents = [] }] -> Bool true
+  | "empty?", [ListRef _] -> Bool false
+  | "empty?", [Nil] -> Bool true
+  | "first", [List (x :: _)] -> x
+  | "first", [List []] -> Nil
+  | "first", [ListRef { contents = (x :: _) }] -> x
+  | "first", [ListRef _] -> Nil
+  | "first", [Nil] -> Nil
+  | "rest", [List (_ :: xs)] -> List xs
+  | "rest", [List []] -> List []
+  | "rest", [ListRef { contents = (_ :: xs) }] -> List xs
+  | "rest", [ListRef _] -> List []
+  | "rest", [Nil] -> List []
+  | "len", [List l] -> Integer (List.length l)
+  | "len", [ListRef r] -> Integer (List.length !r)
+  | "len", [String s] -> Integer (String.length s)
+  | "len", [Nil] -> Integer 0
+  | "<", [Integer x; Integer y] -> Bool (x < y)
+  | "<", [Number x; Number y] -> Bool (x < y)
+  | "<", [Integer x; Number y] -> Bool (float_of_int x < y)
+  | "<", [Number x; Integer y] -> Bool (x < float_of_int y)
+  | ">", [Integer x; Integer y] -> Bool (x > y)
+  | ">", [Number x; Number y] -> Bool (x > y)
+  | ">", [Integer x; Number y] -> Bool (float_of_int x > y)
+  | ">", [Number x; Integer y] -> Bool (x > float_of_int y)
+  | "<=", [Integer x; Integer y] -> Bool (x <= y)
+  | "<=", [Number x; Number y] -> Bool (x <= y)
+  | "<=", [Integer x; Number y] -> Bool (float_of_int x <= y)
+  | "<=", [Number x; Integer y] -> Bool (x <= float_of_int y)
+  | ">=", [Integer x; Integer y] -> Bool (x >= y)
+  | ">=", [Number x; Number y] -> Bool (x >= y)
+  | ">=", [Integer x; Number y] -> Bool (float_of_int x >= y)
+  | ">=", [Number x; Integer y] -> Bool (x >= float_of_int y)
+  | _ ->
+    match Hashtbl.find_opt Sx_primitives.primitives name with
+    | Some f -> f args
+    | None -> raise (Eval_error ("Unknown primitive: " ^ name))
 
 (** Convert any SX value to an OCaml string (internal). *)
 let value_to_str = function
@@ -209,6 +270,13 @@ let get_val container key =
      | _ -> Nil)
   | Dict d, String k -> dict_get d k
   | Dict d, Keyword k -> dict_get d k
+  | AdtValue a, String k | AdtValue a, Keyword k ->
+    (match k with
+     | "_adt"    -> Bool true
+     | "_type"   -> String a.av_type
+     | "_ctor"   -> String a.av_ctor
+     | "_fields" -> List (Array.to_list a.av_fields)
+     | _         -> Nil)
   | (List l | ListRef { contents = l }), Number n ->
     (try List.nth l (int_of_float n) with _ -> Nil)
   | (List l | ListRef { contents = l }), Integer n ->
@@ -404,6 +472,10 @@ let callcc_continuation_winders_len v = match v with
 let host_error msg =
   raise (Eval_error (value_to_str msg))
 
+let host_warn msg =
+  prerr_endline (value_to_str msg);
+  Nil
+
 let dynamic_wind_call before body after _env =
   ignore (sx_call before []);
   let result = sx_call body [] in

hosts/ocaml/lib/sx_types.ml

@@ -82,6 +82,16 @@ and value =
   | SxSet of (string, value) Hashtbl.t  (** Mutable set keyed by inspect(value). *)
   | SxRegexp of string * string * Re.re  (** Regexp: source, flags, compiled. *)
   | SxBytevector of bytes  (** Mutable bytevector — R7RS bytevector type. *)
+  | AdtValue of adt_value  (** Native algebraic data type instance — opaque sum type. *)
+
+(** Algebraic data type instance — produced by [define-type] constructors.
+    [av_type] is the type name (e.g. "Maybe"), [av_ctor] is the constructor
+    name (e.g. "Just"), [av_fields] are the positional field values. *)
+and adt_value = {
+  av_type   : string;
+  av_ctor   : string;
+  av_fields : value array;
+}
 
 (** String input port: source string + mutable cursor position. *)
 and sx_port_kind =
@@ -520,6 +530,7 @@ let type_of = function
   | SxSet _          -> "set"
   | SxRegexp _       -> "regexp"
   | SxBytevector _   -> "bytevector"
+  | AdtValue a       -> a.av_type
 
 let is_nil = function Nil -> true | _ -> false
 let is_lambda = function Lambda _ -> true | _ -> false
@@ -806,14 +817,15 @@ let dict_vals (d : dict) =
 
 (** {1 Value display} *)
 
-let rec inspect = function
-  | Nil -> "nil"
-  | Bool true -> "true"
-  | Bool false -> "false"
-  | Integer n -> string_of_int n
-  | Number n -> format_number n
+(* Single shared buffer for the entire inspect recursion — eliminates
+   the per-level [String.concat (List.map inspect ...)] allocation. *)
+let rec inspect_into buf = function
+  | Nil -> Buffer.add_string buf "nil"
+  | Bool true -> Buffer.add_string buf "true"
+  | Bool false -> Buffer.add_string buf "false"
+  | Integer n -> Buffer.add_string buf (string_of_int n)
+  | Number n -> Buffer.add_string buf (format_number n)
   | String s ->
-    let buf = Buffer.create (String.length s + 2) in
     Buffer.add_char buf '"';
     String.iter (function
       | '"'  -> Buffer.add_string buf "\\\""
@@ -822,66 +834,129 @@ let rec inspect = function
       | '\r' -> Buffer.add_string buf "\\r"
       | '\t' -> Buffer.add_string buf "\\t"
       | c    -> Buffer.add_char buf c) s;
-    Buffer.add_char buf '"';
-    Buffer.contents buf
-  | Symbol s -> s
-  | Keyword k -> ":" ^ k
+    Buffer.add_char buf '"'
+  | Symbol s -> Buffer.add_string buf s
+  | Keyword k -> Buffer.add_char buf ':'; Buffer.add_string buf k
   | List items | ListRef { contents = items } ->
-    "(" ^ String.concat " " (List.map inspect items) ^ ")"
+    Buffer.add_char buf '(';
+    (match items with
+     | [] -> ()
+     | x :: rest ->
+       inspect_into buf x;
+       List.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) rest);
+    Buffer.add_char buf ')'
   | Dict d ->
-    let pairs = Hashtbl.fold (fun k v acc ->
-      (Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in
-    "{" ^ String.concat " " pairs ^ "}"
+    Buffer.add_char buf '{';
+    let first = ref true in
+    Hashtbl.iter (fun k v ->
+      if !first then first := false else Buffer.add_char buf ' ';
+      Buffer.add_char buf ':'; Buffer.add_string buf k;
+      Buffer.add_char buf ' '; inspect_into buf v) d;
+    Buffer.add_char buf '}'
   | Lambda l ->
     let tag = match l.l_name with Some n -> n | None -> "lambda" in
-    Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params)
+    Buffer.add_char buf '<'; Buffer.add_string buf tag;
+    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " l.l_params);
+    Buffer.add_string buf ")>"
   | Component c ->
-    Printf.sprintf "<Component ~%s(%s)>" c.c_name (String.concat ", " c.c_params)
+    Buffer.add_string buf "<Component ~"; Buffer.add_string buf c.c_name;
+    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " c.c_params);
+    Buffer.add_string buf ")>"
   | Island i ->
-    Printf.sprintf "<Island ~%s(%s)>" i.i_name (String.concat ", " i.i_params)
+    Buffer.add_string buf "<Island ~"; Buffer.add_string buf i.i_name;
+    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " i.i_params);
+    Buffer.add_string buf ")>"
   | Macro m ->
     let tag = match m.m_name with Some n -> n | None -> "macro" in
-    Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
-  | Thunk _ -> "<thunk>"
-  | Continuation (_, _) -> "<continuation>"
-  | CallccContinuation (_, _) -> "<callcc-continuation>"
-  | NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
-  | Signal _ -> "<signal>"
-  | RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)
-  | Spread _ -> "<spread>"
-  | SxExpr s -> Printf.sprintf "\"<sx-expr:%d>\"" (String.length s)
-  | Env _ -> "<env>"
-  | CekState _ -> "<cek-state>"
-  | CekFrame f -> Printf.sprintf "<frame:%s>" f.cf_type
-  | VmClosure cl -> Printf.sprintf "<vm:%s>" (match cl.vm_name with Some n -> n | None -> "anon")
+    Buffer.add_char buf '<'; Buffer.add_string buf tag;
+    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " m.m_params);
+    Buffer.add_string buf ")>"
+  | Thunk _ -> Buffer.add_string buf "<thunk>"
+  | Continuation (_, _) -> Buffer.add_string buf "<continuation>"
+  | CallccContinuation (_, _) -> Buffer.add_string buf "<callcc-continuation>"
+  | NativeFn (name, _) ->
+    Buffer.add_string buf "<native:"; Buffer.add_string buf name; Buffer.add_char buf '>'
+  | Signal _ -> Buffer.add_string buf "<signal>"
+  | RawHTML s ->
+    Buffer.add_string buf "\"<raw-html:";
+    Buffer.add_string buf (string_of_int (String.length s));
+    Buffer.add_string buf ">\""
+  | Spread _ -> Buffer.add_string buf "<spread>"
+  | SxExpr s ->
+    Buffer.add_string buf "\"<sx-expr:";
+    Buffer.add_string buf (string_of_int (String.length s));
+    Buffer.add_string buf ">\""
+  | Env _ -> Buffer.add_string buf "<env>"
+  | CekState _ -> Buffer.add_string buf "<cek-state>"
+  | CekFrame f ->
+    Buffer.add_string buf "<frame:"; Buffer.add_string buf f.cf_type; Buffer.add_char buf '>'
+  | VmClosure cl ->
+    Buffer.add_string buf "<vm:";
+    Buffer.add_string buf (match cl.vm_name with Some n -> n | None -> "anon");
+    Buffer.add_char buf '>'
   | Record r ->
-    let fields = Array.to_list (Array.mapi (fun i v ->
-      Printf.sprintf "%s=%s" r.r_type.rt_fields.(i) (inspect v)
-    ) r.r_fields) in
-    Printf.sprintf "<record:%s %s>" r.r_type.rt_name (String.concat " " fields)
-  | Parameter p -> Printf.sprintf "<parameter:%s>" p.pm_uid
+    Buffer.add_string buf "<record:"; Buffer.add_string buf r.r_type.rt_name;
+    Array.iteri (fun i v ->
+      Buffer.add_char buf ' ';
+      Buffer.add_string buf r.r_type.rt_fields.(i);
+      Buffer.add_char buf '=';
+      inspect_into buf v) r.r_fields;
+    Buffer.add_char buf '>'
+  | Parameter p ->
+    Buffer.add_string buf "<parameter:"; Buffer.add_string buf p.pm_uid; Buffer.add_char buf '>'
   | Vector arr ->
-    let elts = Array.to_list (Array.map inspect arr) in
-    Printf.sprintf "#(%s)" (String.concat " " elts)
-  | VmFrame f -> Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base
-  | VmMachine m -> Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames)
-  | StringBuffer buf -> Printf.sprintf "<string-buffer:%d>" (Buffer.length buf)
-  | HashTable ht -> Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht)
+    Buffer.add_string buf "#(";
+    Array.iteri (fun i v ->
+      if i > 0 then Buffer.add_char buf ' ';
+      inspect_into buf v) arr;
+    Buffer.add_char buf ')'
+  | VmFrame f ->
+    Buffer.add_string buf (Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base)
+  | VmMachine m ->
+    Buffer.add_string buf (Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames))
+  | StringBuffer b ->
+    Buffer.add_string buf (Printf.sprintf "<string-buffer:%d>" (Buffer.length b))
+  | HashTable ht ->
+    Buffer.add_string buf (Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht))
   | Char n ->
-    let name = match n with
-      | 32 -> "space" | 10 -> "newline" | 9 -> "tab"
-      | 13 -> "return" | 0 -> "nul" | 27 -> "escape"
-      | 127 -> "delete" | 8 -> "backspace"
-      | _ -> let buf = Buffer.create 1 in
-             Buffer.add_utf_8_uchar buf (Uchar.of_int n);
-             Buffer.contents buf
-    in "#\\" ^ name
-  | Eof -> "#!eof"
+    Buffer.add_string buf "#\\";
+    (match n with
+     | 32 -> Buffer.add_string buf "space"
+     | 10 -> Buffer.add_string buf "newline"
+     | 9 -> Buffer.add_string buf "tab"
+     | 13 -> Buffer.add_string buf "return"
+     | 0 -> Buffer.add_string buf "nul"
+     | 27 -> Buffer.add_string buf "escape"
+     | 127 -> Buffer.add_string buf "delete"
+     | 8 -> Buffer.add_string buf "backspace"
+     | _ -> Buffer.add_utf_8_uchar buf (Uchar.of_int n))
+  | Eof -> Buffer.add_string buf "#!eof"
   | Port { sp_kind = PortInput (_, pos); sp_closed } ->
-    Printf.sprintf "<input-port:pos=%d%s>" !pos (if sp_closed then ":closed" else "")
-  | Port { sp_kind = PortOutput buf; sp_closed } ->
-    Printf.sprintf "<output-port:len=%d%s>" (Buffer.length buf) (if sp_closed then ":closed" else "")
-  | Rational (n, d) -> Printf.sprintf "%d/%d" n d
-  | SxSet ht -> Printf.sprintf "<set:%d>" (Hashtbl.length ht)
-  | SxRegexp (src, flags, _) -> Printf.sprintf "#/%s/%s" src flags
-  | SxBytevector b -> Printf.sprintf "#u8(%s)" (String.concat " " (List.init (Bytes.length b) (fun i -> string_of_int (Char.code (Bytes.get b i)))))
+    Buffer.add_string buf (Printf.sprintf "<input-port:pos=%d%s>" !pos (if sp_closed then ":closed" else ""))
+  | Port { sp_kind = PortOutput b; sp_closed } ->
+    Buffer.add_string buf (Printf.sprintf "<output-port:len=%d%s>" (Buffer.length b) (if sp_closed then ":closed" else ""))
+  | Rational (n, d) ->
+    Buffer.add_string buf (string_of_int n); Buffer.add_char buf '/';
+    Buffer.add_string buf (string_of_int d)
+  | SxSet ht ->
+    Buffer.add_string buf (Printf.sprintf "<set:%d>" (Hashtbl.length ht))
+  | SxRegexp (src, flags, _) ->
+    Buffer.add_string buf "#/"; Buffer.add_string buf src;
+    Buffer.add_char buf '/'; Buffer.add_string buf flags
+  | SxBytevector b ->
+    Buffer.add_string buf "#u8(";
+    let n = Bytes.length b in
+    for i = 0 to n - 1 do
+      if i > 0 then Buffer.add_char buf ' ';
+      Buffer.add_string buf (string_of_int (Char.code (Bytes.get b i)))
+    done;
+    Buffer.add_char buf ')'
+  | AdtValue a ->
+    Buffer.add_char buf '('; Buffer.add_string buf a.av_ctor;
+    Array.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) a.av_fields;
+    Buffer.add_char buf ')'
+
+let inspect v =
+  let buf = Buffer.create 64 in
+  inspect_into buf v;
+  Buffer.contents buf

hosts/ocaml/lib/sx_vm.ml

@@ -327,7 +327,18 @@ and call_closure_reuse cl args =
        vm.sp <- saved_sp;
        raise e);
     vm.frames <- saved_frames;
-    pop vm
+    (* Snapshot/restore sp around the popped result.
+       OP_RETURN normally leaves sp = saved_sp + 1, but the bytecode-exhausted
+       path (or a callee that returns a closure whose own RETURN leaves extra
+       stack residue) can leave sp inconsistent. Read the result at the
+       expected slot and reset sp explicitly so the parent frame's
+       intermediate values are not corrupted. *)
+    let result =
+      if vm.sp > saved_sp then vm.stack.(vm.sp - 1)
+      else Nil
+    in
+    vm.sp <- saved_sp;
+    result
   | None ->
     call_closure cl args cl.vm_env_ref
 
@@ -731,38 +742,57 @@ and run vm =
         | 160 (* OP_ADD *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y -> Integer (x + y)
             | Number x, Number y -> Number (x +. y)
+            | Integer x, Number y -> Number (float_of_int x +. y)
+            | Number x, Integer y -> Number (x +. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "+") [a; b])
         | 161 (* OP_SUB *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y -> Integer (x - y)
             | Number x, Number y -> Number (x -. y)
+            | Integer x, Number y -> Number (float_of_int x -. y)
+            | Number x, Integer y -> Number (x -. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "-") [a; b])
         | 162 (* OP_MUL *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y -> Integer (x * y)
             | Number x, Number y -> Number (x *. y)
+            | Integer x, Number y -> Number (float_of_int x *. y)
+            | Number x, Integer y -> Number (x *. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "*") [a; b])
         | 163 (* OP_DIV *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y)
+            | Integer x, Integer y -> Number (float_of_int x /. float_of_int y)
             | Number x, Number y -> Number (x /. y)
+            | Integer x, Number y -> Number (float_of_int x /. y)
+            | Number x, Integer y -> Number (x /. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
         | 164 (* OP_EQ *) ->
           let b = pop vm and a = pop vm in
-          push vm ((Hashtbl.find Sx_primitives.primitives "=") [a; b])
+          push vm (Bool (Sx_runtime._fast_eq a b))
         | 165 (* OP_LT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y -> Bool (x < y)
             | Number x, Number y -> Bool (x < y)
+            | Integer x, Number y -> Bool (float_of_int x < y)
+            | Number x, Integer y -> Bool (x < float_of_int y)
             | String x, String y -> Bool (x < y)
-            | _ -> (Hashtbl.find Sx_primitives.primitives "<") [a; b])
+            | _ -> Sx_runtime.prim_call "<" [a; b])
         | 166 (* OP_GT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
+            | Integer x, Integer y -> Bool (x > y)
             | Number x, Number y -> Bool (x > y)
+            | Integer x, Number y -> Bool (float_of_int x > y)
+            | Number x, Integer y -> Bool (x > float_of_int y)
             | String x, String y -> Bool (x > y)
-            | _ -> (Hashtbl.find Sx_primitives.primitives ">") [a; b])
+            | _ -> Sx_runtime.prim_call ">" [a; b])
         | 167 (* OP_NOT *) ->
           let v = pop vm in
           push vm (Bool (not (sx_truthy v)))
@@ -885,9 +915,17 @@ let resume_vm vm result =
   let rec restore_reuse pending =
     match pending with
     | [] -> ()
-    | (saved_frames, _saved_sp) :: rest ->
+    | (saved_frames, saved_sp) :: rest ->
       let callback_result = pop vm in
       vm.frames <- saved_frames;
+      (* Restore sp to the value captured before the suspended callee was
+         pushed. The callee's locals/temps may still be on the stack above
+         saved_sp; without this reset, subsequent LOCAL_GET/SET in the
+         caller frame (e.g. letrec sibling bindings waiting on the call)
+         see stale callee data instead of their own slots. Mirrors the
+         OP_RETURN+sp-reset semantics that sync `call_closure_reuse`
+         relies on for clean caller-frame state. *)
+      if saved_sp < vm.sp then vm.sp <- saved_sp;
       push vm callback_result;
       (try
         run vm;

lib/common-lisp/conformance.sh

@@ -30,7 +30,7 @@ run_suite() {
   local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5"
   local TMP; TMP=$(mktemp)
   {
-    printf '(epoch 1)\n(load "spec/stdlib.sx")\n'
+    printf '(epoch 1)\n(load "spec/stdlib.sx")\n(load "lib/guest/prefix.sx")\n'
     local i=2
     for f in $load_files; do
       printf '(epoch %d)\n(load "%s")\n' "$i" "$f"

lib/common-lisp/runtime.sx

@@ -23,13 +23,19 @@
   (cl-numberp? x)
   (let ((t (type-of x))) (or (= t "number") (= t "rational"))))
 
-(define cl-integerp? integer?)
-(define cl-floatp? float?)
-(define cl-rationalp? rational?)
+(prefix-rename "cl-"
+  '(
+    (integerp? integer?)
+    (floatp? float?)
+    (rationalp? rational?)
+    ))
 
 (define (cl-realp? x) (or (integer? x) (float? x) (rational? x)))
 
-(define cl-characterp? char?)
+(prefix-rename "cl-"
+  '(
+    (characterp? char?)
+    ))
 (define cl-stringp? (fn (x) (= (type-of x) "string")))
 (define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
 (define cl-keywordp? (fn (x) (= (type-of x) "keyword")))
@@ -44,8 +50,11 @@
       (= t "native-fn")
       (= t "component"))))
 
-(define cl-vectorp? vector?)
-(define cl-arrayp? vector?)
+(prefix-rename "cl-"
+  '(
+    (vectorp? vector?)
+    (arrayp? vector?)
+    ))
 
 ;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
 (define
@@ -56,19 +65,25 @@
 ;; 2.  Arithmetic — thin aliases to spec primitives
 ;; ---------------------------------------------------------------------------
 
-(define cl-mod modulo)
-(define cl-rem remainder)
-(define cl-gcd gcd)
-(define cl-lcm lcm)
-(define cl-expt expt)
-(define cl-floor floor)
-(define cl-ceiling ceil)
-(define cl-truncate truncate)
-(define cl-round round)
+(prefix-rename "cl-"
+  '(
+    (mod modulo)
+    (rem remainder)
+    gcd
+    lcm
+    expt
+    floor
+    (ceiling ceil)
+    truncate
+    round
+    ))
 (define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
 (define cl-min (fn (a b) (if (< a b) a b)))
 (define cl-max (fn (a b) (if (> a b) a b)))
-(define cl-quotient quotient)
+(prefix-rename "cl-"
+  '(
+    quotient
+    ))
 
 (define
   (cl-signum x)
@@ -87,21 +102,27 @@
 ;; 3.  Character functions — alias spec char primitives + CL name mapping
 ;; ---------------------------------------------------------------------------
 
-(define cl-char->integer char->integer)
-(define cl-integer->char integer->char)
-(define cl-char-upcase char-upcase)
-(define cl-char-downcase char-downcase)
-(define cl-char-code char->integer)
-(define cl-code-char integer->char)
+(prefix-rename "cl-"
+  '(
+    char->integer
+    integer->char
+    char-upcase
+    char-downcase
+    (char-code char->integer)
+    (code-char integer->char)
+    ))
 
-(define cl-char=? char=?)
-(define cl-char<? char<?)
-(define cl-char>? char>?)
-(define cl-char<=? char<=?)
-(define cl-char>=? char>=?)
-(define cl-char-ci=? char-ci=?)
-(define cl-char-ci<? char-ci<?)
-(define cl-char-ci>? char-ci>?)
+(prefix-rename "cl-"
+  '(
+    char=?
+    char<?
+    char>?
+    char<=?
+    char>=?
+    char-ci=?
+    char-ci<?
+    char-ci>?
+    ))
 
 ;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
 (define
@@ -152,8 +173,11 @@
   (cl-format dest template &rest args)
   (let ((s (apply format (cons template args)))) (if (= dest nil) s s)))
 
-(define cl-write-to-string write-to-string)
-(define cl-princ-to-string display-to-string)
+(prefix-rename "cl-"
+  '(
+    write-to-string
+    (princ-to-string display-to-string)
+    ))
 
 ;; CL read-from-string: parse value from a string using SX port
 (define
@@ -161,18 +185,27 @@
   (let ((p (open-input-string s))) (read p)))
 
 ;; String stream (output)
-(define cl-make-string-output-stream open-output-string)
-(define cl-get-output-stream-string get-output-string)
+(prefix-rename "cl-"
+  '(
+    (make-string-output-stream open-output-string)
+    (get-output-stream-string get-output-string)
+    ))
 
 ;; String stream (input)
-(define cl-make-string-input-stream open-input-string)
+(prefix-rename "cl-"
+  '(
+    (make-string-input-stream open-input-string)
+    ))
 
 ;; ---------------------------------------------------------------------------
 ;; 5.  Gensym
 ;; ---------------------------------------------------------------------------
 
-(define cl-gensym gensym)
-(define cl-gentemp gensym)
+(prefix-rename "cl-"
+  '(
+    gensym
+    (gentemp gensym)
+    ))
 
 ;; ---------------------------------------------------------------------------
 ;; 6.  Multiple values (CL: values / nth-value)
@@ -203,16 +236,19 @@
 ;; 7.  Sets (CL: adjoin / member / union / intersection / set-difference)
 ;; ---------------------------------------------------------------------------
 
-(define cl-make-set make-set)
-(define cl-set? set?)
-(define cl-set-add set-add!)
-(define cl-set-memberp set-member?)
-(define cl-set-remove set-remove!)
-(define cl-set-union set-union)
-(define cl-set-intersect set-intersection)
-(define cl-set-difference set-difference)
-(define cl-list->set list->set)
-(define cl-set->list set->list)
+(prefix-rename "cl-"
+  '(
+    make-set
+    set?
+    (set-add set-add!)
+    (set-memberp set-member?)
+    (set-remove set-remove!)
+    set-union
+    (set-intersect set-intersection)
+    set-difference
+    list->set
+    set->list
+    ))
 
 ;; CL: (member item list) — returns tail starting at item, or nil
 (define

lib/common-lisp/scoreboard.json

@@ -1,5 +1,5 @@
 {
-  "generated": "2026-05-05T12:35:09Z",
+  "generated": "2026-05-06T22:55:42Z",
   "total_pass": 518,
   "total_fail": 0,
   "suites": [

lib/common-lisp/scoreboard.md

@@ -1,6 +1,6 @@
 # Common Lisp on SX — Scoreboard
 
-_Generated: 2026-05-05 12:35 UTC_
+_Generated: 2026-05-06 22:55 UTC_
 
 | Suite | Pass | Fail | Status |
 |-------|------|------|--------|

lib/compiler.sx

@@ -1008,11 +1008,27 @@
             (let
               ((name (symbol-name head))
                 (argc (len args))
-                (name-idx (pool-add (get em "pool") name)))
+                (specialized-op (cond
+                  (and (= argc 2) (= name "+")) 160
+                  (and (= argc 2) (= name "-")) 161
+                  (and (= argc 2) (= name "*")) 162
+                  (and (= argc 2) (= name "/")) 163
+                  (and (= argc 2) (= name "=")) 164
+                  (and (= argc 2) (= name "<")) 165
+                  (and (= argc 2) (= name ">")) 166
+                  (and (= argc 2) (= name "cons")) 172
+                  (and (= argc 1) (= name "not")) 167
+                  (and (= argc 1) (= name "len")) 168
+                  (and (= argc 1) (= name "first")) 169
+                  (and (= argc 1) (= name "rest")) 170
+                  :else nil)))
               (for-each (fn (a) (compile-expr em a scope false)) args)
-              (emit-op em 52)
-              (emit-u16 em name-idx)
-              (emit-byte em argc))
+              (if specialized-op
+                (emit-op em specialized-op)
+                (let ((name-idx (pool-add (get em "pool") name)))
+                  (emit-op em 52)
+                  (emit-u16 em name-idx)
+                  (emit-byte em argc))))
             (do
               (compile-expr em head scope false)
               (for-each (fn (a) (compile-expr em a scope false)) args)

lib/erlang/scoreboard.json

@@ -1,16 +1,16 @@
 {
   "language": "erlang",
-  "total_pass": 530,
-  "total": 530,
+  "total_pass": 0,
+  "total": 0,
   "suites": [
-    {"name":"tokenize","pass":62,"total":62,"status":"ok"},
-    {"name":"parse","pass":52,"total":52,"status":"ok"},
-    {"name":"eval","pass":346,"total":346,"status":"ok"},
-    {"name":"runtime","pass":39,"total":39,"status":"ok"},
-    {"name":"ring","pass":4,"total":4,"status":"ok"},
-    {"name":"ping-pong","pass":4,"total":4,"status":"ok"},
-    {"name":"bank","pass":8,"total":8,"status":"ok"},
-    {"name":"echo","pass":7,"total":7,"status":"ok"},
-    {"name":"fib","pass":8,"total":8,"status":"ok"}
+    {"name":"tokenize","pass":0,"total":0,"status":"ok"},
+    {"name":"parse","pass":0,"total":0,"status":"ok"},
+    {"name":"eval","pass":0,"total":0,"status":"ok"},
+    {"name":"runtime","pass":0,"total":0,"status":"ok"},
+    {"name":"ring","pass":0,"total":0,"status":"ok"},
+    {"name":"ping-pong","pass":0,"total":0,"status":"ok"},
+    {"name":"bank","pass":0,"total":0,"status":"ok"},
+    {"name":"echo","pass":0,"total":0,"status":"ok"},
+    {"name":"fib","pass":0,"total":0,"status":"ok"}
   ]
 }

lib/erlang/scoreboard.md

@@ -1,18 +1,18 @@
 # Erlang-on-SX Scoreboard
 
-**Total: 530 / 530 tests passing**
+**Total: 0 / 0 tests passing**
 
 |  | Suite | Pass | Total |
 |---|---|---|---|
-| ✅ | tokenize | 62 | 62 |
-| ✅ | parse | 52 | 52 |
-| ✅ | eval | 346 | 346 |
-| ✅ | runtime | 39 | 39 |
-| ✅ | ring | 4 | 4 |
-| ✅ | ping-pong | 4 | 4 |
-| ✅ | bank | 8 | 8 |
-| ✅ | echo | 7 | 7 |
-| ✅ | fib | 8 | 8 |
+| ✅ | tokenize | 0 | 0 |
+| ✅ | parse | 0 | 0 |
+| ✅ | eval | 0 | 0 |
+| ✅ | runtime | 0 | 0 |
+| ✅ | ring | 0 | 0 |
+| ✅ | ping-pong | 0 | 0 |
+| ✅ | bank | 0 | 0 |
+| ✅ | echo | 0 | 0 |
+| ✅ | fib | 0 | 0 |
 
 
 Generated by `lib/erlang/conformance.sh`.

lib/guest/baseline/apl.json

@@ -0,0 +1,18 @@
+{
+  "lang": "apl",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/apl/test.sh",
+  "totals": {
+    "pass": 73,
+    "fail": 0,
+    "total": 73
+  },
+  "suites": [
+    {
+      "name": "all",
+      "pass": 73,
+      "fail": 0,
+      "total": 73
+    }
+  ]
+}

lib/guest/baseline/common-lisp.json

@@ -0,0 +1,86 @@
+{
+  "lang": "common-lisp",
+  "captured": "2026-05-06T22:59:46Z",
+  "suite_command": "bash lib/common-lisp/conformance.sh",
+  "totals": {
+    "pass": 518,
+    "fail": 0,
+    "total": 518
+  },
+  "suites": [
+    {
+      "name": "Phase 1: tokenizer/reader",
+      "pass": 79,
+      "fail": 0,
+      "total": 79
+    },
+    {
+      "name": "Phase 1: parser/lambda-lists",
+      "pass": 31,
+      "fail": 0,
+      "total": 31
+    },
+    {
+      "name": "Phase 2: evaluator",
+      "pass": 182,
+      "fail": 0,
+      "total": 182
+    },
+    {
+      "name": "Phase 3: condition system",
+      "pass": 59,
+      "fail": 0,
+      "total": 59
+    },
+    {
+      "name": "Phase 3: restart-demo",
+      "pass": 7,
+      "fail": 0,
+      "total": 7
+    },
+    {
+      "name": "Phase 3: parse-recover",
+      "pass": 6,
+      "fail": 0,
+      "total": 6
+    },
+    {
+      "name": "Phase 3: interactive-debugger",
+      "pass": 7,
+      "fail": 0,
+      "total": 7
+    },
+    {
+      "name": "Phase 4: CLOS",
+      "pass": 41,
+      "fail": 0,
+      "total": 41
+    },
+    {
+      "name": "Phase 4: geometry",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "Phase 4: mop-trace",
+      "pass": 13,
+      "fail": 0,
+      "total": 13
+    },
+    {
+      "name": "Phase 5: macros+LOOP",
+      "pass": 27,
+      "fail": 0,
+      "total": 27
+    },
+    {
+      "name": "Phase 6: stdlib",
+      "pass": 54,
+      "fail": 0,
+      "total": 54
+    }
+  ],
+  "source_scoreboard": "lib/common-lisp/scoreboard.json",
+  "note": "Step 2: previous baseline (309) was lower because Phase 2 (evaluator, +182 tests) and Phase 6 (stdlib, +27 tests) results were under-counted by the original conformance.sh's parser. Re-running with prefix.sx loaded reveals true counts. No tests regressed."
+}

lib/guest/baseline/erlang.json

@@ -0,0 +1,67 @@
+{
+  "lang": "erlang",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/erlang/conformance.sh",
+  "totals": {
+    "pass": 0,
+    "fail": 0,
+    "total": 0
+  },
+  "suites": [
+    {
+      "name": "tokenize",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "parse",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "eval",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "runtime",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "ring",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "ping-pong",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "bank",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "echo",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    },
+    {
+      "name": "fib",
+      "pass": 0,
+      "fail": 0,
+      "total": 0
+    }
+  ],
+  "source_scoreboard": "lib/erlang/scoreboard.json"
+}

lib/guest/baseline/forth.json

@@ -0,0 +1,18 @@
+{
+  "lang": "forth",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/forth/test.sh",
+  "totals": {
+    "pass": 64,
+    "fail": 0,
+    "total": 64
+  },
+  "suites": [
+    {
+      "name": "all",
+      "pass": 64,
+      "fail": 0,
+      "total": 64
+    }
+  ]
+}

lib/guest/baseline/haskell.json

@@ -0,0 +1,122 @@
+{
+  "lang": "haskell",
+  "captured": "2026-05-06T22:46:16Z",
+  "suite_command": "bash lib/haskell/conformance.sh",
+  "totals": {
+    "pass": 156,
+    "fail": 0,
+    "total": 156
+  },
+  "suites": [
+    {
+      "name": "fib",
+      "pass": 2,
+      "fail": 0,
+      "total": 2
+    },
+    {
+      "name": "sieve",
+      "pass": 2,
+      "fail": 0,
+      "total": 2
+    },
+    {
+      "name": "quicksort",
+      "pass": 5,
+      "fail": 0,
+      "total": 5
+    },
+    {
+      "name": "nqueens",
+      "pass": 2,
+      "fail": 0,
+      "total": 2
+    },
+    {
+      "name": "calculator",
+      "pass": 5,
+      "fail": 0,
+      "total": 5
+    },
+    {
+      "name": "collatz",
+      "pass": 11,
+      "fail": 0,
+      "total": 11
+    },
+    {
+      "name": "palindrome",
+      "pass": 8,
+      "fail": 0,
+      "total": 8
+    },
+    {
+      "name": "maybe",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "fizzbuzz",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "anagram",
+      "pass": 9,
+      "fail": 0,
+      "total": 9
+    },
+    {
+      "name": "roman",
+      "pass": 14,
+      "fail": 0,
+      "total": 14
+    },
+    {
+      "name": "binary",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "either",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "primes",
+      "pass": 12,
+      "fail": 0,
+      "total": 12
+    },
+    {
+      "name": "zipwith",
+      "pass": 9,
+      "fail": 0,
+      "total": 9
+    },
+    {
+      "name": "matrix",
+      "pass": 8,
+      "fail": 0,
+      "total": 8
+    },
+    {
+      "name": "wordcount",
+      "pass": 7,
+      "fail": 0,
+      "total": 7
+    },
+    {
+      "name": "powers",
+      "pass": 14,
+      "fail": 0,
+      "total": 14
+    }
+  ],
+  "source_scoreboard": "lib/haskell/scoreboard.json",
+  "note": "Step 1: previous baseline (0/18) was an artefact of the old conformance.sh bug \u2014 its (ok-len 3 ...) grep never matched, defaulting every program to 0 pass / 1 fail. Shared driver in Step 1 reads counters correctly."
+}

lib/guest/baseline/js.json

@@ -0,0 +1,75 @@
+{
+  "lang": "js",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/js/conformance.sh",
+  "totals": {
+    "pass": 94,
+    "fail": 54,
+    "total": 148
+  },
+  "suites": [
+    {
+      "name": "test262-slice",
+      "pass": 94,
+      "fail": 54,
+      "total": 148,
+      "failing_tests": [
+        "arithmetic/bitnot",
+        "arithmetic/mixed_concat",
+        "async/await_promise_all",
+        "closures/sum_sq",
+        "coercion/implicit_str_add",
+        "collections/array_index",
+        "collections/array_nested",
+        "collections/string_index",
+        "functions/rest_param",
+        "loops/for_break",
+        "loops/for_continue",
+        "loops/nested_for",
+        "loops/while_basic",
+        "loops/while_break_infinite",
+        "objects/array_filter_reduce",
+        "objects/array_map",
+        "objects/array_method_chain",
+        "objects/array_mutate",
+        "objects/array_push_length",
+        "objects/arrow_lexical_this",
+        "objects/class_basic",
+        "objects/class_extend_chain",
+        "objects/class_inherit",
+        "objects/counter_closure",
+        "objects/in_operator",
+        "objects/instanceof",
+        "objects/method_this",
+        "objects/new_constructor",
+        "objects/object_mutate",
+        "objects/prototype_chain",
+        "objects/string_method",
+        "objects/string_slice",
+        "promises/executor_throws",
+        "promises/finally_passthrough",
+        "promises/microtask_ordering",
+        "promises/new_promise_reject",
+        "promises/new_promise_resolve",
+        "promises/promise_all",
+        "promises/promise_all_empty",
+        "promises/promise_all_nonpromise",
+        "promises/promise_all_reject",
+        "promises/promise_race",
+        "promises/promise_resolve_already_promise",
+        "promises/reject_catch",
+        "promises/resolve_adopts",
+        "promises/resolve_then",
+        "promises/then_chain",
+        "promises/then_throw_catch",
+        "statements/block_scope",
+        "statements/const_multi",
+        "statements/if_else_false",
+        "statements/if_else_true",
+        "statements/let_init",
+        "statements/var_decl"
+      ]
+    }
+  ],
+  "source_scoreboard": "lib/js/conformance.sh-output"
+}

lib/guest/baseline/lua.json

@@ -0,0 +1,18 @@
+{
+  "lang": "lua",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/lua/test.sh",
+  "totals": {
+    "pass": 185,
+    "fail": 0,
+    "total": 185
+  },
+  "suites": [
+    {
+      "name": "all",
+      "pass": 185,
+      "fail": 0,
+      "total": 185
+    }
+  ]
+}

lib/guest/baseline/prolog.json

@@ -0,0 +1,187 @@
+{
+  "lang": "prolog",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/prolog/conformance.sh",
+  "totals": {
+    "pass": 590,
+    "fail": 0,
+    "total": 590
+  },
+  "suites": [
+    {
+      "name": "parse",
+      "pass": 25,
+      "fail": 0,
+      "total": 25
+    },
+    {
+      "name": "unify",
+      "pass": 47,
+      "fail": 0,
+      "total": 47
+    },
+    {
+      "name": "clausedb",
+      "pass": 14,
+      "fail": 0,
+      "total": 14
+    },
+    {
+      "name": "solve",
+      "pass": 62,
+      "fail": 0,
+      "total": 62
+    },
+    {
+      "name": "operators",
+      "pass": 19,
+      "fail": 0,
+      "total": 19
+    },
+    {
+      "name": "dynamic",
+      "pass": 11,
+      "fail": 0,
+      "total": 11
+    },
+    {
+      "name": "findall",
+      "pass": 11,
+      "fail": 0,
+      "total": 11
+    },
+    {
+      "name": "term_inspect",
+      "pass": 14,
+      "fail": 0,
+      "total": 14
+    },
+    {
+      "name": "append",
+      "pass": 6,
+      "fail": 0,
+      "total": 6
+    },
+    {
+      "name": "reverse",
+      "pass": 6,
+      "fail": 0,
+      "total": 6
+    },
+    {
+      "name": "member",
+      "pass": 7,
+      "fail": 0,
+      "total": 7
+    },
+    {
+      "name": "nqueens",
+      "pass": 6,
+      "fail": 0,
+      "total": 6
+    },
+    {
+      "name": "family",
+      "pass": 10,
+      "fail": 0,
+      "total": 10
+    },
+    {
+      "name": "atoms",
+      "pass": 34,
+      "fail": 0,
+      "total": 34
+    },
+    {
+      "name": "query_api",
+      "pass": 16,
+      "fail": 0,
+      "total": 16
+    },
+    {
+      "name": "iso_predicates",
+      "pass": 29,
+      "fail": 0,
+      "total": 29
+    },
+    {
+      "name": "meta_predicates",
+      "pass": 25,
+      "fail": 0,
+      "total": 25
+    },
+    {
+      "name": "list_predicates",
+      "pass": 33,
+      "fail": 0,
+      "total": 33
+    },
+    {
+      "name": "meta_call",
+      "pass": 15,
+      "fail": 0,
+      "total": 15
+    },
+    {
+      "name": "set_predicates",
+      "pass": 15,
+      "fail": 0,
+      "total": 15
+    },
+    {
+      "name": "char_predicates",
+      "pass": 27,
+      "fail": 0,
+      "total": 27
+    },
+    {
+      "name": "io_predicates",
+      "pass": 24,
+      "fail": 0,
+      "total": 24
+    },
+    {
+      "name": "assert_rules",
+      "pass": 15,
+      "fail": 0,
+      "total": 15
+    },
+    {
+      "name": "string_agg",
+      "pass": 25,
+      "fail": 0,
+      "total": 25
+    },
+    {
+      "name": "advanced",
+      "pass": 21,
+      "fail": 0,
+      "total": 21
+    },
+    {
+      "name": "compiler",
+      "pass": 17,
+      "fail": 0,
+      "total": 17
+    },
+    {
+      "name": "cross_validate",
+      "pass": 17,
+      "fail": 0,
+      "total": 17
+    },
+    {
+      "name": "integration",
+      "pass": 20,
+      "fail": 0,
+      "total": 20
+    },
+    {
+      "name": "hs_bridge",
+      "pass": 19,
+      "fail": 0,
+      "total": 19
+    }
+  ],
+  "source_scoreboard": "lib/prolog/scoreboard.json"
+}

lib/guest/baseline/ruby.json

@@ -0,0 +1,18 @@
+{
+  "lang": "ruby",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/ruby/test.sh",
+  "totals": {
+    "pass": 76,
+    "fail": 0,
+    "total": 76
+  },
+  "suites": [
+    {
+      "name": "all",
+      "pass": 76,
+      "fail": 0,
+      "total": 76
+    }
+  ]
+}

lib/guest/baseline/smalltalk.json

@@ -0,0 +1,25 @@
+{
+  "lang": "smalltalk",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/smalltalk/conformance.sh",
+  "totals": {
+    "pass": 625,
+    "fail": 4,
+    "total": 629
+  },
+  "suites": [
+    {
+      "name": "all",
+      "pass": 625,
+      "fail": 4,
+      "total": 629
+    },
+    {
+      "name": "classic-corpus",
+      "pass": 4,
+      "fail": 1,
+      "total": 5
+    }
+  ],
+  "source_scoreboard": "lib/smalltalk/scoreboard.json"
+}

lib/guest/baseline/tcl.json

@@ -0,0 +1,37 @@
+{
+  "lang": "tcl",
+  "captured": "2026-05-06T22:01:00Z",
+  "suite_command": "bash lib/tcl/conformance.sh",
+  "totals": {
+    "pass": 3,
+    "fail": 1,
+    "total": 4
+  },
+  "suites": [
+    {
+      "name": "assert",
+      "pass": 1,
+      "fail": 0,
+      "total": 1
+    },
+    {
+      "name": "event-loop",
+      "pass": 0,
+      "fail": 1,
+      "total": 1
+    },
+    {
+      "name": "for-each-line",
+      "pass": 1,
+      "fail": 0,
+      "total": 1
+    },
+    {
+      "name": "with-temp-var",
+      "pass": 1,
+      "fail": 0,
+      "total": 1
+    }
+  ],
+  "source_scoreboard": "lib/tcl/scoreboard.json"
+}

lib/guest/conformance.sh

@@ -0,0 +1,221 @@
+#!/usr/bin/env bash
+# lib/guest/conformance.sh — shared, config-driven conformance driver.
+#
+# Usage:
+#   bash lib/guest/conformance.sh <conf-file>
+#
+# The conf file is a bash file that sets:
+#   LANG_NAME           e.g. prolog
+#   PRELOADS=( ... )    .sx files to load before any suite (path from repo root)
+#   SUITES=( ... )      colon-separated entries; format depends on MODE
+#   MODE                "dict" or "counters"
+#   COUNTERS_PASS       (counters mode) global symbol for the pass counter
+#   COUNTERS_FAIL       (counters mode) global symbol for the fail counter
+#   TIMEOUT_PER_SUITE   (optional, counters mode) seconds per suite, default 120
+#   SCOREBOARD_DIR      (optional) defaults to lib/$LANG_NAME
+#
+# It may override the bash functions emit_scoreboard_json / emit_scoreboard_md
+# to produce the per-language scoreboard schema. Defaults are provided.
+#
+# Suite formats:
+#   MODE=dict       — "name:test-file:(runner-fn)"
+#                     The runner expression is evaluated and is expected to
+#                     return a dict with :passed/:failed/:total.
+#   MODE=counters   — "name:test-file"
+#                     Each suite is run in a fresh sx_server session: preloads
+#                     are loaded, then the test file, then counters are read.
+#                     The suite is treated as starting from counters (0, 0).
+#
+# Output:
+#   Writes $SCOREBOARD_DIR/scoreboard.json and $SCOREBOARD_DIR/scoreboard.md.
+#   Exits 0 if every suite is green, 1 otherwise.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+if [ "$#" -lt 1 ]; then
+  echo "usage: $0 <conf-file>" >&2
+  exit 2
+fi
+
+CONF="$1"
+if [ ! -f "$CONF" ]; then
+  echo "config not found: $CONF" >&2
+  exit 2
+fi
+
+# Defaults — the conf file may override these.
+LANG_NAME=
+PRELOADS=()
+SUITES=()
+MODE=dict
+COUNTERS_PASS=
+COUNTERS_FAIL=
+TIMEOUT_PER_SUITE=120
+SCOREBOARD_DIR=
+
+emit_scoreboard_json() {
+  # Generic schema. Per-lang configs override this for byte-equality with
+  # historical scoreboards.
+  local n=${#GC_NAMES[@]} i sep
+  printf '{\n'
+  printf '  "lang": "%s",\n' "$LANG_NAME"
+  printf '  "total_passed": %d,\n' "$GC_TOTAL_PASS"
+  printf '  "total_failed": %d,\n' "$GC_TOTAL_FAIL"
+  printf '  "total": %d,\n' "$GC_TOTAL"
+  printf '  "suites": ['
+  for ((i=0; i<n; i++)); do
+    sep=","; [ $i -eq $((n-1)) ] && sep=""
+    printf '\n    {"name":"%s","passed":%d,"failed":%d,"total":%d}%s' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "${GC_TOTAL_S[$i]}" "$sep"
+  done
+  printf '\n  ],\n'
+  printf '  "generated": "%s"\n' "$(date -Iseconds 2>/dev/null || date)"
+  printf '}\n'
+}
+
+emit_scoreboard_md() {
+  local n=${#GC_NAMES[@]} i status
+  printf '# %s scoreboard\n\n' "$LANG_NAME"
+  printf '**%d / %d passing** (%d failure(s)).\n\n' "$GC_TOTAL_PASS" "$GC_TOTAL" "$GC_TOTAL_FAIL"
+  printf '| Suite | Passed | Total | Status |\n'
+  printf '|-------|--------|-------|--------|\n'
+  for ((i=0; i<n; i++)); do
+    status="ok"; [ "${GC_FAIL[$i]}" -gt 0 ] && status="FAIL"
+    printf '| %s | %d | %d | %s |\n' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_TOTAL_S[$i]}" "$status"
+  done
+}
+
+# shellcheck disable=SC1090
+source "$CONF"
+
+if [ -z "$LANG_NAME" ]; then
+  echo "LANG_NAME not set in $CONF" >&2
+  exit 2
+fi
+SCOREBOARD_DIR="${SCOREBOARD_DIR:-lib/$LANG_NAME}"
+
+SX="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX" ]; then
+  MAIN_ROOT=$(git worktree list 2>/dev/null | head -1 | awk '{print $1}')
+  if [ -n "${MAIN_ROOT:-}" ] && [ -x "$MAIN_ROOT/$SX" ]; then
+    SX="$MAIN_ROOT/$SX"
+  else
+    echo "ERROR: sx_server.exe not found (set SX_SERVER to override)." >&2
+    exit 2
+  fi
+fi
+
+GC_NAMES=()
+GC_PASS=()
+GC_FAIL=()
+GC_TOTAL_S=()
+
+parse_result_line() {
+  # Match a (gc-result "name" P F T) line.
+  local line="$1"
+  if [[ "$line" =~ ^\(gc-result\ \"([^\"]+)\"\ ([0-9]+)\ ([0-9]+)\ ([0-9]+)\)$ ]]; then
+    GC_NAMES+=("${BASH_REMATCH[1]}")
+    GC_PASS+=("${BASH_REMATCH[2]}")
+    GC_FAIL+=("${BASH_REMATCH[3]}")
+    GC_TOTAL_S+=("${BASH_REMATCH[4]}")
+    return 0
+  fi
+  return 1
+}
+
+case "$MODE" in
+  dict)
+    SCRIPT='(epoch 1)
+'
+    for f in "${PRELOADS[@]}"; do
+      SCRIPT+='(load "'"$f"'")
+'
+    done
+    SCRIPT+='(load "lib/guest/conformance.sx")
+'
+    for entry in "${SUITES[@]}"; do
+      IFS=: read -r _ file _ <<< "$entry"
+      SCRIPT+='(load "'"$file"'")
+'
+    done
+    SCRIPT+='(epoch 2)
+'
+    for entry in "${SUITES[@]}"; do
+      IFS=: read -r name _ runner <<< "$entry"
+      SCRIPT+='(eval "(gc-dict-result \"'"$name"'\" '"$runner"')")
+'
+    done
+    OUTPUT=$(printf '%s' "$SCRIPT" | "$SX" 2>&1)
+    expected=${#SUITES[@]}
+    matched=0
+    while IFS= read -r line; do
+      if parse_result_line "$line"; then
+        matched=$((matched + 1))
+      fi
+    done <<< "$OUTPUT"
+    if [ "$matched" -ne "$expected" ]; then
+      echo "Expected $expected suite results, got $matched" >&2
+      echo "---- raw output ----" >&2
+      printf '%s\n' "$OUTPUT" >&2
+      exit 3
+    fi
+    ;;
+  counters)
+    if [ -z "$COUNTERS_PASS" ] || [ -z "$COUNTERS_FAIL" ]; then
+      echo "MODE=counters requires COUNTERS_PASS and COUNTERS_FAIL in $CONF" >&2
+      exit 2
+    fi
+    for entry in "${SUITES[@]}"; do
+      IFS=: read -r name file <<< "$entry"
+      TMPFILE=$(mktemp)
+      {
+        printf '(epoch 1)\n'
+        for f in "${PRELOADS[@]}"; do printf '(load "%s")\n' "$f"; done
+        printf '(load "lib/guest/conformance.sx")\n'
+        printf '(epoch 2)\n'
+        printf '(load "%s")\n' "$file"
+        printf '(epoch 3)\n'
+        printf '(eval "(gc-counters-result \\"%s\\" 0 0 %s %s)")\n' \
+          "$name" "$COUNTERS_PASS" "$COUNTERS_FAIL"
+      } > "$TMPFILE"
+      OUTPUT=$(timeout "$TIMEOUT_PER_SUITE" "$SX" < "$TMPFILE" 2>&1 || true)
+      rm -f "$TMPFILE"
+      result=$(printf '%s\n' "$OUTPUT" | grep -E '^\(gc-result ' | tail -1 || true)
+      if [ -n "$result" ] && parse_result_line "$result"; then
+        :
+      else
+        # Suite hung or crashed before emitting a result. Record 0/1 so it
+        # shows up as a failure rather than vanishing.
+        GC_NAMES+=("$name")
+        GC_PASS+=(0)
+        GC_FAIL+=(1)
+        GC_TOTAL_S+=(1)
+      fi
+    done
+    ;;
+  *)
+    echo "Unknown MODE=$MODE in $CONF (expected dict|counters)" >&2
+    exit 2
+    ;;
+esac
+
+GC_TOTAL_PASS=0
+GC_TOTAL_FAIL=0
+GC_TOTAL=0
+for ((i=0; i<${#GC_NAMES[@]}; i++)); do
+  GC_TOTAL_PASS=$((GC_TOTAL_PASS + GC_PASS[i]))
+  GC_TOTAL_FAIL=$((GC_TOTAL_FAIL + GC_FAIL[i]))
+  GC_TOTAL=$((GC_TOTAL + GC_TOTAL_S[i]))
+done
+
+mkdir -p "$SCOREBOARD_DIR"
+emit_scoreboard_json > "$SCOREBOARD_DIR/scoreboard.json"
+emit_scoreboard_md > "$SCOREBOARD_DIR/scoreboard.md"
+
+if [ "$GC_TOTAL_FAIL" -gt 0 ]; then
+  echo "$GC_TOTAL_FAIL failure(s) across $GC_TOTAL tests" >&2
+  exit 1
+fi
+echo "All $GC_TOTAL tests pass."

lib/guest/conformance.sx

@@ -0,0 +1,40 @@
+;; lib/guest/conformance.sx — shared helpers for the guest conformance driver.
+;;
+;; The bash driver lib/guest/conformance.sh loads this file and then for each
+;; suite emits an (eval "...") form whose result is a tagged list:
+;;
+;;     (gc-result NAME PASSED FAILED TOTAL)
+;;
+;; The driver greps these from sx_server's output and aggregates them.
+;;
+;; Two suite shapes are supported:
+;;
+;;   :dict     — runner expression returns a dict with :passed/:failed/:total.
+;;               (gc-dict-result "parse" (pl-parse-tests-run!))
+;;
+;;   :counters — runner has no return value, mutates pass/fail global counters.
+;;               (gc-counters-result NAME P0 F0 PASS FAIL)
+;;               where P0/F0 are the counters captured BEFORE the suite ran
+;;               and PASS/FAIL are the counters AFTER.
+
+(define
+  gc-dict-result
+  (fn
+    (name r)
+    (list
+      (quote gc-result)
+      name
+      (get r :passed)
+      (get r :failed)
+      (get r :total))))
+
+(define
+  gc-counters-result
+  (fn
+    (name p0 f0 p1 f1)
+    (list
+      (quote gc-result)
+      name
+      (- p1 p0)
+      (- f1 f0)
+      (- (+ p1 f1) (+ p0 f0)))))

lib/guest/lex.sx

@@ -0,0 +1,67 @@
+;; lib/guest/lex.sx — character-class predicates and token primitives shared
+;; across guest tokenisers.
+;;
+;; All predicates are nil-safe — they accept nil (end-of-input) and return
+;; false. This matches the convention used by the existing per-language
+;; tokenisers (cur returns nil at EOF).
+;;
+;; Char classes
+;; ------------
+;;   lex-digit?       — 0-9
+;;   lex-hex-digit?   — 0-9, a-f, A-F
+;;   lex-alpha?       — a-z, A-Z (alias: lex-letter?)
+;;   lex-alnum?       — alpha or digit
+;;   lex-ident-start? — alpha or underscore
+;;   lex-ident-char?  — ident-start or digit
+;;   lex-space?       — " ", "\t", "\r"           (no newline)
+;;   lex-whitespace?  — " ", "\t", "\r", "\n"     (includes newline)
+;;
+;; Token record
+;; ------------
+;;   (lex-make-token TYPE VALUE POS)        — {:type :value :pos}
+;;   (lex-make-token-spanning TYPE VALUE POS END)
+;;                                          — {:type :value :pos :end}
+;;   (lex-token-type TOK)
+;;   (lex-token-value TOK)
+;;   (lex-token-pos TOK)
+
+(define lex-digit? (fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
+
+(define
+  lex-hex-digit?
+  (fn
+    (c)
+    (and
+      (not (= c nil))
+      (or
+        (lex-digit? c)
+        (and (>= c "a") (<= c "f"))
+        (and (>= c "A") (<= c "F"))))))
+
+(define
+  lex-alpha?
+  (fn
+    (c)
+    (and
+      (not (= c nil))
+      (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
+
+(define lex-letter? lex-alpha?)
+
+(define lex-alnum? (fn (c) (or (lex-alpha? c) (lex-digit? c))))
+
+(define lex-ident-start? (fn (c) (or (lex-alpha? c) (= c "_"))))
+
+(define lex-ident-char? (fn (c) (or (lex-ident-start? c) (lex-digit? c))))
+
+(define lex-space? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
+
+(define lex-whitespace? (fn (c) (or (lex-space? c) (= c "\n"))))
+
+(define lex-make-token (fn (type value pos) {:pos pos :value value :type type}))
+
+(define lex-make-token-spanning (fn (type value pos end) {:pos pos :end end :value value :type type}))
+
+(define lex-token-type (fn (tok) (get tok :type)))
+(define lex-token-value (fn (tok) (get tok :value)))
+(define lex-token-pos (fn (tok) (get tok :pos)))

lib/guest/prefix.sx

@@ -0,0 +1,46 @@
+;; lib/guest/prefix.sx — prefix-rename macro.
+;;
+;; A guest runtime often re-exports a stretch of host primitives under a
+;; language-specific prefix. The prefix-rename macro replaces the repeated
+;; (define lang-foo foo) boilerplate with a single declarative call.
+;;
+;; Two entry shapes are supported:
+;;
+;;   (prefix-rename "cl-" '(gcd lcm expt floor truncate))
+;;     ;; expands to (begin (define cl-gcd gcd)
+;;     ;;                   (define cl-lcm lcm) ...)
+;;
+;;   (prefix-rename "cl-"
+;;     '((mod modulo)
+;;       (arrayp? vector?)
+;;       (ceiling ceil)))
+;;     ;; expands to (begin (define cl-mod modulo)
+;;     ;;                   (define cl-arrayp? vector?)
+;;     ;;                   (define cl-ceiling ceil))
+;;
+;; Mixed lists are supported — bare symbols are same-name aliases, two-element
+;; lists are (alias target) pairs.
+
+(defmacro
+  prefix-rename
+  (prefix entries-q)
+  (let
+    ((entries (nth entries-q 1)))
+    (cons
+      (quote begin)
+      (map
+        (fn
+          (entry)
+          (cond
+            ((= (type-of entry) "symbol")
+              (list
+                (quote define)
+                (make-symbol (str prefix (symbol-name entry)))
+                entry))
+            ((and (list? entry) (= (len entry) 2))
+              (list
+                (quote define)
+                (make-symbol (str prefix (symbol-name (first entry))))
+                (nth entry 1)))
+            (:else (error (str "prefix-rename: invalid entry " entry)))))
+        entries))))

lib/haskell/conformance.conf

@@ -0,0 +1,76 @@
+# Haskell-on-SX conformance config — sourced by lib/guest/conformance.sh.
+
+LANG_NAME=haskell
+MODE=counters
+COUNTERS_PASS=hk-test-pass
+COUNTERS_FAIL=hk-test-fail
+TIMEOUT_PER_SUITE=120
+
+PRELOADS=(
+  lib/haskell/tokenizer.sx
+  lib/haskell/layout.sx
+  lib/haskell/parser.sx
+  lib/haskell/desugar.sx
+  lib/haskell/runtime.sx
+  lib/haskell/match.sx
+  lib/haskell/eval.sx
+  lib/haskell/testlib.sx
+)
+
+SUITES=(
+  "fib:lib/haskell/tests/program-fib.sx"
+  "sieve:lib/haskell/tests/program-sieve.sx"
+  "quicksort:lib/haskell/tests/program-quicksort.sx"
+  "nqueens:lib/haskell/tests/program-nqueens.sx"
+  "calculator:lib/haskell/tests/program-calculator.sx"
+  "collatz:lib/haskell/tests/program-collatz.sx"
+  "palindrome:lib/haskell/tests/program-palindrome.sx"
+  "maybe:lib/haskell/tests/program-maybe.sx"
+  "fizzbuzz:lib/haskell/tests/program-fizzbuzz.sx"
+  "anagram:lib/haskell/tests/program-anagram.sx"
+  "roman:lib/haskell/tests/program-roman.sx"
+  "binary:lib/haskell/tests/program-binary.sx"
+  "either:lib/haskell/tests/program-either.sx"
+  "primes:lib/haskell/tests/program-primes.sx"
+  "zipwith:lib/haskell/tests/program-zipwith.sx"
+  "matrix:lib/haskell/tests/program-matrix.sx"
+  "wordcount:lib/haskell/tests/program-wordcount.sx"
+  "powers:lib/haskell/tests/program-powers.sx"
+)
+
+emit_scoreboard_json() {
+  local n=${#GC_NAMES[@]} i sep date_only
+  date_only=$(date '+%Y-%m-%d')
+  printf '{\n'
+  printf '  "date": "%s",\n' "$date_only"
+  printf '  "total_pass": %d,\n' "$GC_TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$GC_TOTAL_FAIL"
+  printf '  "programs": {\n'
+  for ((i=0; i<n; i++)); do
+    sep=","; [ $i -eq $((n-1)) ] && sep=""
+    printf '    "%s": {"pass": %d, "fail": %d}%s\n' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "$sep"
+  done
+  printf '  }\n'
+  printf '}\n'
+}
+
+emit_scoreboard_md() {
+  local n=${#GC_NAMES[@]}
+  local i status p f t prog_pass=0 prog_total=$n date_only
+  date_only=$(date '+%Y-%m-%d')
+  for ((i=0; i<n; i++)); do
+    [ "${GC_FAIL[$i]}" -eq 0 ] && prog_pass=$((prog_pass + 1))
+  done
+  printf '# Haskell-on-SX Scoreboard\n\n'
+  printf 'Updated %s · Phase 6 (prelude extras + 18 programs)\n\n' "$date_only"
+  printf '| Program | Tests | Status |\n'
+  printf '|---------|-------|--------|\n'
+  for ((i=0; i<n; i++)); do
+    p=${GC_PASS[$i]}; f=${GC_FAIL[$i]}; t=${GC_TOTAL_S[$i]}
+    [ "$f" -eq 0 ] && status="✓" || status="✗"
+    printf '| %s.hs | %d/%d | %s |\n' "${GC_NAMES[$i]}" "$p" "$t" "$status"
+  done
+  printf '| **Total** | **%d/%d** | **%d/%d programs** |\n' \
+    "$GC_TOTAL_PASS" "$GC_TOTAL" "$prog_pass" "$prog_total"
+}

lib/haskell/conformance.sh

@@ -1,140 +1,3 @@
 #!/usr/bin/env bash
-# lib/haskell/conformance.sh — run the classic-program test suites.
-# Writes lib/haskell/scoreboard.json and lib/haskell/scoreboard.md.
-#
-# Usage:
-#   bash lib/haskell/conformance.sh           # run + write scoreboards
-#   bash lib/haskell/conformance.sh --check   # run only, exit 1 on failure
-
-set -euo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
-if [ ! -x "$SX_SERVER" ]; then
-  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
-  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
-    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
-  else
-    echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
-    exit 1
-  fi
-fi
-
-PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers)
-PASS_COUNTS=()
-FAIL_COUNTS=()
-
-run_suite() {
-  local prog="$1"
-  local FILE="lib/haskell/tests/program-${prog}.sx"
-  local TMPFILE
-  TMPFILE=$(mktemp)
-  cat > "$TMPFILE" <<EPOCHS
-(epoch 1)
-(load "lib/haskell/tokenizer.sx")
-(load "lib/haskell/layout.sx")
-(load "lib/haskell/parser.sx")
-(load "lib/haskell/desugar.sx")
-(load "lib/haskell/runtime.sx")
-(load "lib/haskell/match.sx")
-(load "lib/haskell/eval.sx")
-(load "lib/haskell/testlib.sx")
-(epoch 2)
-(load "$FILE")
-(epoch 3)
-(eval "(list hk-test-pass hk-test-fail)")
-EPOCHS
-  local OUTPUT
-  OUTPUT=$(timeout 120 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
-  rm -f "$TMPFILE"
-
-  local LINE
-  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
-  if [ -z "$LINE" ]; then
-    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
-           | sed -E 's/^\(ok 3 //; s/\)$//' || true)
-  fi
-  if [ -z "$LINE" ]; then
-    echo "0 1"
-  else
-    local P F
-    P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/' || echo "0")
-    F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/' || echo "1")
-    echo "$P $F"
-  fi
-}
-
-for prog in "${PROGRAMS[@]}"; do
-  RESULT=$(run_suite "$prog")
-  P=$(echo "$RESULT" | cut -d' ' -f1)
-  F=$(echo "$RESULT" | cut -d' ' -f2)
-  PASS_COUNTS+=("$P")
-  FAIL_COUNTS+=("$F")
-  T=$((P + F))
-  if [ "$F" -eq 0 ]; then
-    printf '✓ %-14s  %d/%d\n' "${prog}.hs" "$P" "$T"
-  else
-    printf '✗ %-14s  %d/%d\n' "${prog}.hs" "$P" "$T"
-  fi
-done
-
-TOTAL_PASS=0
-TOTAL_FAIL=0
-PROG_PASS=0
-for i in "${!PROGRAMS[@]}"; do
-  TOTAL_PASS=$((TOTAL_PASS + PASS_COUNTS[i]))
-  TOTAL_FAIL=$((TOTAL_FAIL + FAIL_COUNTS[i]))
-  [ "${FAIL_COUNTS[$i]}" -eq 0 ] && PROG_PASS=$((PROG_PASS + 1))
-done
-PROG_TOTAL=${#PROGRAMS[@]}
-
-echo ""
-echo "Classic programs: ${TOTAL_PASS}/$((TOTAL_PASS + TOTAL_FAIL)) tests  |  ${PROG_PASS}/${PROG_TOTAL} programs passing"
-
-if [[ "${1:-}" == "--check" ]]; then
-  [ $TOTAL_FAIL -eq 0 ]
-  exit $?
-fi
-
-DATE=$(date '+%Y-%m-%d')
-
-# scoreboard.json
-{
-  printf '{\n'
-  printf '  "date": "%s",\n' "$DATE"
-  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
-  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
-  printf '  "programs": {\n'
-  last=$((${#PROGRAMS[@]} - 1))
-  for i in "${!PROGRAMS[@]}"; do
-    prog="${PROGRAMS[$i]}"
-    if [ $i -lt $last ]; then
-      printf '    "%s": {"pass": %d, "fail": %d},\n' "$prog" "${PASS_COUNTS[$i]}" "${FAIL_COUNTS[$i]}"
-    else
-      printf '    "%s": {"pass": %d, "fail": %d}\n'  "$prog" "${PASS_COUNTS[$i]}" "${FAIL_COUNTS[$i]}"
-    fi
-  done
-  printf '  }\n'
-  printf '}\n'
-} > lib/haskell/scoreboard.json
-
-# scoreboard.md
-{
-  printf '# Haskell-on-SX Scoreboard\n\n'
-  printf 'Updated %s · Phase 6 (prelude extras + 18 programs)\n\n' "$DATE"
-  printf '| Program | Tests | Status |\n'
-  printf '|---------|-------|--------|\n'
-  for i in "${!PROGRAMS[@]}"; do
-    prog="${PROGRAMS[$i]}"
-    P=${PASS_COUNTS[$i]}
-    F=${FAIL_COUNTS[$i]}
-    T=$((P + F))
-    [ "$F" -eq 0 ] && STATUS="✓" || STATUS="✗"
-    printf '| %s | %d/%d | %s |\n' "${prog}.hs" "$P" "$T" "$STATUS"
-  done
-  printf '| **Total** | **%d/%d** | **%d/%d programs** |\n' \
-    "$TOTAL_PASS" "$((TOTAL_PASS + TOTAL_FAIL))" "$PROG_PASS" "$PROG_TOTAL"
-} > lib/haskell/scoreboard.md
-
-echo "Wrote lib/haskell/scoreboard.json and lib/haskell/scoreboard.md"
-[ $TOTAL_FAIL -eq 0 ]
+# Thin wrapper — see lib/guest/conformance.sh and lib/haskell/conformance.conf.
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/hyperscript/compiler.sx

@@ -7,6 +7,22 @@
 ;;   (hs-to-sx (hs-compile "on click add .active to me"))
 ;;   → (hs-on me "click" (fn (event) (dom-add-class me "active")))
 
+;; ── Compiler plugin registries ────────────────────────────────────
+;; Plugins call (hs-register-command! "head" compile-fn) and
+;; (hs-register-converter! "TypeName" convert-fn) at load time. Both
+;; compile-fn and convert-fn receive a ctx dict (built per call inside
+;; hs-to-sx) exposing :hs-to-sx for recursion plus the AST node fields
+;; the dispatch needs. Compile-fn returns an SX expression.
+(begin
+  (define _hs-command-registry {})
+  (define _hs-converter-registry {})
+  (define
+    hs-register-command!
+    (fn (name compile-fn) (dict-set! _hs-command-registry name compile-fn)))
+  (define
+    hs-register-converter!
+    (fn (name convert-fn) (dict-set! _hs-converter-registry name convert-fn))))
+
 (define
   hs-to-sx
   (let
@@ -952,6 +968,22 @@
           (true
             (let
               ((head (first ast)))
+              (let
+                ((reg-cmd-fn (dict-get _hs-command-registry (str head)))
+                  (reg-conv-fn
+                    (and
+                      (= head (quote as))
+                      (dict-get _hs-converter-registry (nth ast 2)))))
+                (cond
+                  (reg-conv-fn
+                    (reg-conv-fn
+                      {:hs-to-sx hs-to-sx
+                       :ast ast
+                       :value-ast (nth ast 1)
+                       :type-name (nth ast 2)}))
+                  (reg-cmd-fn
+                    (reg-cmd-fn {:hs-to-sx hs-to-sx :ast ast :head head}))
+                  (true
               (cond
                 ((= head (quote __bind-from-detail__))
                   (let
@@ -2667,7 +2699,7 @@
                           (quote begin)
                           (list (quote set!) (quote it) (quote __hs-js))
                           (quote __hs-js))))))
-                (true ast)))))))))
+                (true ast))))))))))))
 
 ;; ── Convenience: source → SX ─────────────────────────────────
 (define

lib/hyperscript/parser.sx

@@ -3,6 +3,17 @@
 ;; Input:  list of {:type T :value V :pos P} tokens from hs-tokenize
 ;; Output: SX AST forms that map to runtime primitives
 
+;; ── Feature plugin registry ───────────────────────────────────────
+;; Plugins call (hs-register-feature! "name" parse-fn) at load time.
+;; parse-fn is (fn (ctx) ...) where ctx is a dict exposing parser
+;; helpers (:adv! :tp-val :tp-type :parse-cmd-list ...) and the
+;; built-in parse-X-feat dispatch fns.
+(begin
+  (define _hs-feature-registry {})
+  (define
+    hs-register-feature!
+    (fn (name parse-fn) (dict-set! _hs-feature-registry name parse-fn))))
+
 ;; ── Parser entry point ────────────────────────────────────────────
 (define
   hs-parse
@@ -3231,6 +3242,24 @@
                       (do
                         (match-kw "end")
                         (list (quote socket) name-path url timeout on-message))))))))))
+      (define
+        parse-feat-ctx
+        (fn
+          ()
+          {:adv! adv!
+           :tp-val tp-val
+           :tp-type tp-type
+           :at-end? at-end?
+           :parse-cmd-list parse-cmd-list
+           :parse-expr parse-expr
+           :parse-on-feat parse-on-feat
+           :parse-init-feat parse-init-feat
+           :parse-def-feat parse-def-feat
+           :parse-behavior-feat parse-behavior-feat
+           :parse-live-feat parse-live-feat
+           :parse-when-feat parse-when-feat
+           :parse-bind-feat parse-bind-feat
+           :parse-socket-feat parse-socket-feat}))
       (define
         parse-feat
         (fn
@@ -3261,29 +3290,23 @@
                         ((unit (tp-val)))
                         (do (adv!) (list (quote string-postfix) inner unit)))
                       inner))))
-              ((= val "on") (do (adv!) (parse-on-feat)))
-              ((= val "init") (do (adv!) (parse-init-feat)))
-              ((= val "def") (do (adv!) (parse-def-feat)))
-              ((= val "behavior") (do (adv!) (parse-behavior-feat)))
-              ((= val "live") (do (adv!) (parse-live-feat)))
-              ((= val "when") (do (adv!) (parse-when-feat)))
-              ((= val "worker")
-                (error
-                  "worker plugin is not installed — see https://hyperscript.org/features/worker"))
-              ((= val "bind") (do (adv!) (parse-bind-feat)))
-              ((= val "socket") (do (adv!) (parse-socket-feat)))
               (true
-                (if
-                  (= (tp-type) "keyword")
-                  (parse-cmd-list)
-                  (let
-                    ((saved-p p))
-                    (let
-                      ((expr (guard (_e (true nil)) (parse-expr))))
-                      (if
-                        (and expr (at-end?))
-                        expr
-                        (do (set! p saved-p) (parse-cmd-list)))))))))))
+                (let
+                  ((reg-fn (dict-get _hs-feature-registry val)))
+                  (if
+                    reg-fn
+                    (reg-fn (parse-feat-ctx))
+                    (if
+                      (= (tp-type) "keyword")
+                      (parse-cmd-list)
+                      (let
+                        ((saved-p p))
+                        (let
+                          ((expr (guard (_e (true nil)) (parse-expr))))
+                          (if
+                            (and expr (at-end?))
+                            expr
+                            (do (set! p saved-p) (parse-cmd-list)))))))))))))
       (define
         coll-feats
         (fn
@@ -3326,3 +3349,33 @@
       (let
         ((result (hs-parse (hs-tokenize src) src)))
         (do (set! hs-span-mode false) result)))))
+
+;; ── Built-in feature registrations ────────────────────────────────
+;; These mirror the original parse-feat cond branches. Registering at
+;; load time means plugins can override or extend; ctx exposes the
+;; parser internals each fn needs.
+(begin
+  (hs-register-feature!
+    "on"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-on-feat)))))
+  (hs-register-feature!
+    "init"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-init-feat)))))
+  (hs-register-feature!
+    "def"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-def-feat)))))
+  (hs-register-feature!
+    "behavior"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-behavior-feat)))))
+  (hs-register-feature!
+    "live"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-live-feat)))))
+  (hs-register-feature!
+    "when"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-when-feat)))))
+  (hs-register-feature!
+    "bind"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-bind-feat)))))
+  (hs-register-feature!
+    "socket"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-socket-feat))))))

lib/hyperscript/plugins/prolog.sx

@@ -0,0 +1,24 @@
+;; lib/hyperscript/plugins/prolog.sx — Prolog plugin
+;;
+;; Provides the `prolog` HS-level function. Replaces the ad-hoc
+;; hs-prolog-hook / hs-set-prolog-hook! slots that previously lived in
+;; lib/hyperscript/runtime.sx (nodes 140–142 of the plugin design doc).
+;;
+;; Two-step wiring preserves the original API:
+;;   1. lib/prolog/runtime.sx loaded → defines pl-query-one
+;;   2. lib/prolog/hs-bridge.sx (or this file's auto-wire) calls
+;;      (hs-set-prolog-hook! (fn (db goal) (not (= nil (pl-query-one db goal)))))
+;; If neither is loaded, calling (prolog db goal) raises a clear error.
+
+(define hs-prolog-hook nil)
+
+(define hs-set-prolog-hook! (fn (f) (set! hs-prolog-hook f)))
+
+(define
+  prolog
+  (fn
+    (db goal)
+    (if
+      (nil? hs-prolog-hook)
+      (raise "prolog hook not installed")
+      (hs-prolog-hook db goal))))

lib/hyperscript/plugins/worker.sx

@@ -0,0 +1,19 @@
+;; lib/hyperscript/plugins/worker.sx — Worker plugin (stub)
+;;
+;; Phase 1 of the worker plugin: the registration formerly inlined in
+;; lib/hyperscript/parser.sx (E39 stub) moves here. Behaviour is
+;; identical — `worker MyWorker ...` raises a helpful error directing
+;; users to the full plugin (not yet implemented).
+;;
+;; Phase 2 (future) replaces this stub with parse-worker-feat, a
+;; compiler entry, hs-worker-define!, and the postMessage-based
+;; method dispatch documented in plans/designs/hs-plugin-system.md §4a.
+
+(define hs-worker-loaded? true)
+
+(hs-register-feature!
+  "worker"
+  (fn
+    (ctx)
+    (error
+      "worker plugin is not installed — see https://hyperscript.org/features/worker")))

lib/hyperscript/runtime.sx

@@ -2911,19 +2911,6 @@
           ((nth entry 2) val)))
       _hs-dom-watchers)))
 
-(define hs-prolog-hook nil)
-
-(define hs-set-prolog-hook! (fn (f) (set! hs-prolog-hook f)))
-
-(define
-  prolog
-  (fn
-    (db goal)
-    (if
-      (nil? hs-prolog-hook)
-      (raise "prolog hook not installed")
-      (hs-prolog-hook db goal))))
-
 (define
   hs-null-error!
   (fn (selector) (raise (str "'" selector "' is null"))))

lib/hyperscript/tokenizer.sx

@@ -8,7 +8,17 @@
 
 ;; ── Token constructor ─────────────────────────────────────────────
 
-(define hs-make-token (fn (type value pos) {:pos pos :value value :type type}))
+(define hs-make-token
+  (fn (type value pos &rest extras)
+    (let
+      ((end-arg (if (>= (len extras) 1) (nth extras 0) nil))
+       (line-arg (if (>= (len extras) 2) (nth extras 1) nil)))
+      (let
+        ((end (if (nil? end-arg)
+                  (+ pos (if (nil? value) 0 (len (str value))))
+                  end-arg))
+         (line (if (nil? line-arg) 1 line-arg)))
+        {:pos pos :end end :line line :value value :type type}))))
 
 ;; ── Character predicates ──────────────────────────────────────────
 
@@ -221,14 +231,26 @@
   (fn
     (src)
     (let
-      ((tokens (list)) (pos 0) (src-len (len src)))
+      ((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
       (define
         hs-peek
         (fn
           (offset)
           (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
       (define hs-cur (fn () (hs-peek 0)))
-      (define hs-advance! (fn (n) (set! pos (+ pos n))))
+      (define
+        hs-advance!
+        (fn (n)
+          (let ((new-pos (+ pos n)))
+            (define
+              count-nl!
+              (fn (i)
+                (when (< i new-pos)
+                  (when (= (nth src i) "\n")
+                    (set! current-line (+ current-line 1)))
+                  (count-nl! (+ i 1)))))
+            (count-nl! pos)
+            (set! pos new-pos))))
       (define
         skip-ws!
         (fn
@@ -502,13 +524,14 @@
         (fn
           (type value start)
           (let
-            ((tok (hs-make-token type value start))
-              (end-pos
-                (max pos (+ start (if (nil? value) 0 (len (str value)))))))
-            (do
-              (dict-set! tok "end" end-pos)
-              (dict-set! tok "line" (len (split (slice src 0 start) "\n")))
-              (append! tokens tok)))))
+            ((end-pos
+                (max pos (+ start (if (nil? value) 0 (len (str value))))))
+              (newlines-after-start
+                (- (len (split (slice src start (max start pos)) "\n")) 1))
+              (start-line (- current-line newlines-after-start)))
+            (append!
+              tokens
+              (hs-make-token type value start end-pos start-line)))))
       (define
         scan!
         (fn
@@ -758,11 +781,30 @@
   (fn
     (src)
     (let
-      ((tokens (list)) (pos 0) (src-len (len src)))
+      ((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
       (define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
       (define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
-      (define t-advance! (fn (n) (set! pos (+ pos n))))
-      (define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
+      (define
+        t-advance!
+        (fn (n)
+          (let ((new-pos (+ pos n)))
+            (define
+              t-count-nl!
+              (fn (i)
+                (when (< i new-pos)
+                  (when (= (nth src i) "\n")
+                    (set! current-line (+ current-line 1)))
+                  (t-count-nl! (+ i 1)))))
+            (t-count-nl! pos)
+            (set! pos new-pos))))
+      (define
+        t-emit!
+        (fn (type value)
+          (let
+            ((end-pos (+ pos (if (nil? value) 0 (len (str value))))))
+            (append!
+              tokens
+              (hs-make-token type value pos end-pos current-line)))))
       (define
         scan-to-close!
         (fn

lib/lua/test.sh

@@ -28,6 +28,8 @@ trap "rm -f $TMPFILE" EXIT
 
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
+(load "lib/guest/lex.sx")
+(load "lib/guest/prefix.sx")
 (load "lib/lua/tokenizer.sx")
 (epoch 2)
 (load "lib/lua/parser.sx")

lib/lua/tokenizer.sx

@@ -1,31 +1,12 @@
-(define lua-make-token (fn (type value pos) {:pos pos :value value :type type}))
+(prefix-rename "lua-"
+  '((make-token   lex-make-token)
+    (digit?       lex-digit?)
+    (hex-digit?   lex-hex-digit?)
+    (letter?      lex-alpha?)
+    (ident-start? lex-ident-start?)
+    (ident-char?  lex-ident-char?)
+    (ws?          lex-whitespace?)))
 
-(define lua-digit? (fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
-
-(define
-  lua-hex-digit?
-  (fn
-    (c)
-    (and
-      (not (= c nil))
-      (or
-        (lua-digit? c)
-        (and (>= c "a") (<= c "f"))
-        (and (>= c "A") (<= c "F"))))))
-
-(define
-  lua-letter?
-  (fn
-    (c)
-    (and
-      (not (= c nil))
-      (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
-
-(define lua-ident-start? (fn (c) (or (lua-letter? c) (= c "_"))))
-
-(define lua-ident-char? (fn (c) (or (lua-ident-start? c) (lua-digit? c))))
-
-(define lua-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
 
 (define
   lua-keywords

lib/prolog/conformance.conf

@@ -0,0 +1,80 @@
+# Prolog conformance config — sourced by lib/guest/conformance.sh.
+
+LANG_NAME=prolog
+MODE=dict
+
+PRELOADS=(
+  lib/prolog/tokenizer.sx
+  lib/prolog/parser.sx
+  lib/prolog/runtime.sx
+  lib/prolog/query.sx
+  lib/prolog/compiler.sx
+  lib/prolog/hs-bridge.sx
+)
+
+SUITES=(
+  "parse:lib/prolog/tests/parse.sx:(pl-parse-tests-run!)"
+  "unify:lib/prolog/tests/unify.sx:(pl-unify-tests-run!)"
+  "clausedb:lib/prolog/tests/clausedb.sx:(pl-clausedb-tests-run!)"
+  "solve:lib/prolog/tests/solve.sx:(pl-solve-tests-run!)"
+  "operators:lib/prolog/tests/operators.sx:(pl-operators-tests-run!)"
+  "dynamic:lib/prolog/tests/dynamic.sx:(pl-dynamic-tests-run!)"
+  "findall:lib/prolog/tests/findall.sx:(pl-findall-tests-run!)"
+  "term_inspect:lib/prolog/tests/term_inspect.sx:(pl-term-inspect-tests-run!)"
+  "append:lib/prolog/tests/programs/append.sx:(pl-append-tests-run!)"
+  "reverse:lib/prolog/tests/programs/reverse.sx:(pl-reverse-tests-run!)"
+  "member:lib/prolog/tests/programs/member.sx:(pl-member-tests-run!)"
+  "nqueens:lib/prolog/tests/programs/nqueens.sx:(pl-nqueens-tests-run!)"
+  "family:lib/prolog/tests/programs/family.sx:(pl-family-tests-run!)"
+  "atoms:lib/prolog/tests/atoms.sx:(pl-atom-tests-run!)"
+  "query_api:lib/prolog/tests/query_api.sx:(pl-query-api-tests-run!)"
+  "iso_predicates:lib/prolog/tests/iso_predicates.sx:(pl-iso-predicates-tests-run!)"
+  "meta_predicates:lib/prolog/tests/meta_predicates.sx:(pl-meta-predicates-tests-run!)"
+  "list_predicates:lib/prolog/tests/list_predicates.sx:(pl-list-predicates-tests-run!)"
+  "meta_call:lib/prolog/tests/meta_call.sx:(pl-meta-call-tests-run!)"
+  "set_predicates:lib/prolog/tests/set_predicates.sx:(pl-set-predicates-tests-run!)"
+  "char_predicates:lib/prolog/tests/char_predicates.sx:(pl-char-predicates-tests-run!)"
+  "io_predicates:lib/prolog/tests/io_predicates.sx:(pl-io-predicates-tests-run!)"
+  "assert_rules:lib/prolog/tests/assert_rules.sx:(pl-assert-rules-tests-run!)"
+  "string_agg:lib/prolog/tests/string_agg.sx:(pl-string-agg-tests-run!)"
+  "advanced:lib/prolog/tests/advanced.sx:(pl-advanced-tests-run!)"
+  "compiler:lib/prolog/tests/compiler.sx:(pl-compiler-tests-run!)"
+  "cross_validate:lib/prolog/tests/cross_validate.sx:(pl-cross-validate-tests-run!)"
+  "integration:lib/prolog/tests/integration.sx:(pl-integration-tests-run!)"
+  "hs_bridge:lib/prolog/tests/hs_bridge.sx:(pl-hs-bridge-tests-run!)"
+)
+
+emit_scoreboard_json() {
+  local n=${#GC_NAMES[@]} i sep
+  printf '{\n'
+  printf '  "total_passed": %d,\n' "$GC_TOTAL_PASS"
+  printf '  "total_failed": %d,\n' "$GC_TOTAL_FAIL"
+  printf '  "total": %d,\n' "$GC_TOTAL"
+  printf '  "suites": {'
+  for ((i=0; i<n; i++)); do
+    sep=","; [ $i -eq $((n-1)) ] && sep=""
+    printf '"%s":{"passed":%d,"total":%d,"failed":%d}%s' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_TOTAL_S[$i]}" "${GC_FAIL[$i]}" "$sep"
+  done
+  printf '},\n'
+  printf '  "generated": "%s"\n' "$(date -Iseconds 2>/dev/null || date)"
+  printf '}\n'
+}
+
+emit_scoreboard_md() {
+  local n=${#GC_NAMES[@]} i status when
+  when="$(date -Iseconds 2>/dev/null || date)"
+  printf '# Prolog scoreboard\n\n'
+  printf '**%d / %d passing** (%d failure(s)).\n' \
+    "$GC_TOTAL_PASS" "$GC_TOTAL" "$GC_TOTAL_FAIL"
+  printf 'Generated %s.\n\n' "$when"
+  printf '| Suite | Passed | Total | Status |\n'
+  printf '|-------|--------|-------|--------|\n'
+  for ((i=0; i<n; i++)); do
+    status="ok"; [ "${GC_FAIL[$i]}" -gt 0 ] && status="FAIL"
+    printf '| %s | %d | %d | %s |\n' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_TOTAL_S[$i]}" "$status"
+  done
+  printf '\nRun `bash lib/prolog/conformance.sh` to refresh. Override the binary\n'
+  printf 'with `SX_SERVER=path/to/sx_server.exe bash …`.\n'
+}

lib/prolog/conformance.sh

@@ -1,129 +1,3 @@
 #!/usr/bin/env bash
-# Run every Prolog test suite via sx_server and refresh scoreboard.{json,md}.
-# Exit 0 if all green, 1 if any failures.
-set -euo pipefail
-
-HERE="$(cd "$(dirname "$0")" && pwd)"
-ROOT="$(cd "$HERE/../.." && pwd)"
-SX="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
-
-if [[ ! -x "$SX" ]]; then
-  echo "sx_server not found at $SX (set SX_SERVER env to override)" >&2
-  exit 2
-fi
-
-cd "$ROOT"
-
-# name : test-file : runner-fn
-SUITES=(
-  "parse:lib/prolog/tests/parse.sx:pl-parse-tests-run!"
-  "unify:lib/prolog/tests/unify.sx:pl-unify-tests-run!"
-  "clausedb:lib/prolog/tests/clausedb.sx:pl-clausedb-tests-run!"
-  "solve:lib/prolog/tests/solve.sx:pl-solve-tests-run!"
-  "operators:lib/prolog/tests/operators.sx:pl-operators-tests-run!"
-  "dynamic:lib/prolog/tests/dynamic.sx:pl-dynamic-tests-run!"
-  "findall:lib/prolog/tests/findall.sx:pl-findall-tests-run!"
-  "term_inspect:lib/prolog/tests/term_inspect.sx:pl-term-inspect-tests-run!"
-  "append:lib/prolog/tests/programs/append.sx:pl-append-tests-run!"
-  "reverse:lib/prolog/tests/programs/reverse.sx:pl-reverse-tests-run!"
-  "member:lib/prolog/tests/programs/member.sx:pl-member-tests-run!"
-  "nqueens:lib/prolog/tests/programs/nqueens.sx:pl-nqueens-tests-run!"
-  "family:lib/prolog/tests/programs/family.sx:pl-family-tests-run!"
-  "atoms:lib/prolog/tests/atoms.sx:pl-atom-tests-run!"
-  "query_api:lib/prolog/tests/query_api.sx:pl-query-api-tests-run!"
-  "iso_predicates:lib/prolog/tests/iso_predicates.sx:pl-iso-predicates-tests-run!"
-  "meta_predicates:lib/prolog/tests/meta_predicates.sx:pl-meta-predicates-tests-run!"
-  "list_predicates:lib/prolog/tests/list_predicates.sx:pl-list-predicates-tests-run!"
-  "meta_call:lib/prolog/tests/meta_call.sx:pl-meta-call-tests-run!"
-  "set_predicates:lib/prolog/tests/set_predicates.sx:pl-set-predicates-tests-run!"
-  "char_predicates:lib/prolog/tests/char_predicates.sx:pl-char-predicates-tests-run!"
-  "io_predicates:lib/prolog/tests/io_predicates.sx:pl-io-predicates-tests-run!"
-  "assert_rules:lib/prolog/tests/assert_rules.sx:pl-assert-rules-tests-run!"
-  "string_agg:lib/prolog/tests/string_agg.sx:pl-string-agg-tests-run!"
-  "advanced:lib/prolog/tests/advanced.sx:pl-advanced-tests-run!"
-  "compiler:lib/prolog/tests/compiler.sx:pl-compiler-tests-run!"
-  "cross_validate:lib/prolog/tests/cross_validate.sx:pl-cross-validate-tests-run!"
-  "integration:lib/prolog/tests/integration.sx:pl-integration-tests-run!"
-  "hs_bridge:lib/prolog/tests/hs_bridge.sx:pl-hs-bridge-tests-run!"
-)
-
-SCRIPT='(epoch 1)
-(load "lib/prolog/tokenizer.sx")
-(load "lib/prolog/parser.sx")
-(load "lib/prolog/runtime.sx")
-(load "lib/prolog/query.sx")
-(load "lib/prolog/compiler.sx")
-(load "lib/prolog/hs-bridge.sx")'
-for entry in "${SUITES[@]}"; do
-  IFS=: read -r _ file _ <<< "$entry"
-  SCRIPT+=$'\n(load "'"$file"$'")'
-done
-for entry in "${SUITES[@]}"; do
-  IFS=: read -r _ _ fn <<< "$entry"
-  SCRIPT+=$'\n(eval "('"$fn"$')")'
-done
-
-OUTPUT="$(printf '%s\n' "$SCRIPT" | "$SX" 2>&1)"
-
-mapfile -t LINES < <(printf '%s\n' "$OUTPUT" | grep -E '^\{:failed')
-
-if [[ ${#LINES[@]} -ne ${#SUITES[@]} ]]; then
-  echo "Expected ${#SUITES[@]} suite results, got ${#LINES[@]}" >&2
-  echo "---- raw output ----" >&2
-  printf '%s\n' "$OUTPUT" >&2
-  exit 3
-fi
-
-TOTAL_PASS=0
-TOTAL_FAIL=0
-TOTAL=0
-JSON_SUITES=""
-MD_ROWS=""
-
-for i in "${!SUITES[@]}"; do
-  IFS=: read -r name _ _ <<< "${SUITES[$i]}"
-  line="${LINES[$i]}"
-  passed=$(grep -oE ':passed [0-9]+' <<< "$line" | grep -oE '[0-9]+')
-  total=$(grep -oE ':total [0-9]+' <<< "$line" | grep -oE '[0-9]+')
-  failed=$(grep -oE ':failed [0-9]+' <<< "$line" | grep -oE '[0-9]+')
-  TOTAL_PASS=$((TOTAL_PASS + passed))
-  TOTAL_FAIL=$((TOTAL_FAIL + failed))
-  TOTAL=$((TOTAL + total))
-  status="ok"
-  [[ "$failed" -gt 0 ]] && status="FAIL"
-  [[ -n "$JSON_SUITES" ]] && JSON_SUITES+=","
-  JSON_SUITES+="\"$name\":{\"passed\":$passed,\"total\":$total,\"failed\":$failed}"
-  MD_ROWS+="| $name | $passed | $total | $status |"$'\n'
-done
-
-WHEN="$(date -Iseconds 2>/dev/null || date)"
-
-cat > "$HERE/scoreboard.json" <<JSON
-{
-  "total_passed": $TOTAL_PASS,
-  "total_failed": $TOTAL_FAIL,
-  "total": $TOTAL,
-  "suites": {$JSON_SUITES},
-  "generated": "$WHEN"
-}
-JSON
-
-cat > "$HERE/scoreboard.md" <<MD
-# Prolog scoreboard
-
-**$TOTAL_PASS / $TOTAL passing** ($TOTAL_FAIL failure(s)).
-Generated $WHEN.
-
-| Suite | Passed | Total | Status |
-|-------|--------|-------|--------|
-$MD_ROWS
-Run \`bash lib/prolog/conformance.sh\` to refresh. Override the binary
-with \`SX_SERVER=path/to/sx_server.exe bash …\`.
-MD
-
-if [[ "$TOTAL_FAIL" -gt 0 ]]; then
-  echo "$TOTAL_FAIL failure(s) across $TOTAL tests" >&2
-  exit 1
-fi
-
-echo "All $TOTAL tests pass."
+# Thin wrapper — see lib/guest/conformance.sh and lib/prolog/conformance.conf.
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/prolog/hs-bridge.sx

@@ -4,7 +4,7 @@
 ;;
 ;; 1. Hook style — for `prolog(db, "goal(args)")` call syntax in Hyperscript:
 ;;      (pl-install-hs-hook!)   ;; call once at startup
-;;    Requires lib/hyperscript/runtime.sx (provides hs-set-prolog-hook!)
+;;    Requires lib/hyperscript/plugins/prolog.sx (provides hs-set-prolog-hook!)
 ;;
 ;; 2. Factory style — for named conditions like `when allowed(user, action)`:
 ;;      (define allowed (pl-hs-predicate/2 pl-db "allowed"))

lib/prolog/scoreboard.json

@@ -3,5 +3,5 @@
   "total_failed": 0,
   "total": 590,
   "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0},"string_agg":{"passed":25,"total":25,"failed":0},"advanced":{"passed":21,"total":21,"failed":0},"compiler":{"passed":17,"total":17,"failed":0},"cross_validate":{"passed":17,"total":17,"failed":0},"integration":{"passed":20,"total":20,"failed":0},"hs_bridge":{"passed":19,"total":19,"failed":0}},
-  "generated": "2026-05-06T12:17:46+00:00"
+  "generated": "2026-05-06T22:23:38+00:00"
 }

lib/prolog/scoreboard.md

@@ -1,7 +1,7 @@
 # Prolog scoreboard
 
 **590 / 590 passing** (0 failure(s)).
-Generated 2026-05-06T12:17:46+00:00.
+Generated 2026-05-06T22:23:38+00:00.
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|

lib/smalltalk/scoreboard.json

@@ -1,5 +1,5 @@
 {
-  "date": "2026-04-25T16:05:32Z",
+  "date": "2026-05-06T21:06:00Z",
   "programs": [
     "eight-queens.st",
     "fibonacci.st",
@@ -8,8 +8,8 @@
     "quicksort.st"
   ],
   "program_count": 5,
-  "program_tests_passed": 39,
-  "all_tests_passed": 847,
-  "all_tests_total": 847,
-  "exit_code": 0
+  "program_tests_passed": 4,
+  "all_tests_passed": 625,
+  "all_tests_total": 629,
+  "exit_code": 1
 }

lib/smalltalk/scoreboard.md

@@ -1,13 +1,13 @@
 # Smalltalk-on-SX Scoreboard
 
-_Last run: 2026-04-25T16:05:32Z_
+_Last run: 2026-05-06T21:06:00Z_
 
 ## Totals
 
 | Suite | Passing |
 |-------|---------|
-| All Smalltalk-on-SX tests | **847 / 847** |
-| Classic-corpus tests (`tests/programs.sx`) | **39** |
+| All Smalltalk-on-SX tests | **625 / 629** |
+| Classic-corpus tests (`tests/programs.sx`) | **4** |
 
 ## Classic-corpus programs (`lib/smalltalk/tests/programs/`)
 
@@ -22,7 +22,6 @@ _Last run: 2026-04-25T16:05:32Z_
 ## Per-file test counts
 
 ```
-OK lib/smalltalk/tests/ansi.sx              62 passed
 OK lib/smalltalk/tests/blocks.sx            19 passed
 OK lib/smalltalk/tests/cannot_return.sx     5 passed
 OK lib/smalltalk/tests/collections.sx       29 passed
@@ -30,16 +29,13 @@ OK lib/smalltalk/tests/conditional.sx       25 passed
 OK lib/smalltalk/tests/dnu.sx               15 passed
 OK lib/smalltalk/tests/eval.sx              68 passed
 OK lib/smalltalk/tests/exceptions.sx        15 passed
-OK lib/smalltalk/tests/hashed.sx            30 passed
 OK lib/smalltalk/tests/inline_cache.sx      10 passed
 OK lib/smalltalk/tests/intrinsics.sx        24 passed
 OK lib/smalltalk/tests/nlr.sx               14 passed
 OK lib/smalltalk/tests/numbers.sx           47 passed
 OK lib/smalltalk/tests/parse_chunks.sx      21 passed
 OK lib/smalltalk/tests/parse.sx             47 passed
-OK lib/smalltalk/tests/pharo.sx             91 passed
 OK lib/smalltalk/tests/printing.sx          19 passed
-OK lib/smalltalk/tests/programs.sx          39 passed
 OK lib/smalltalk/tests/reflection.sx        77 passed
 OK lib/smalltalk/tests/runtime.sx           64 passed
 OK lib/smalltalk/tests/streams.sx           21 passed
@@ -47,6 +43,10 @@ OK lib/smalltalk/tests/sunit.sx             19 passed
 OK lib/smalltalk/tests/super.sx             9 passed
 OK lib/smalltalk/tests/tokenize.sx          63 passed
 OK lib/smalltalk/tests/while.sx             14 passed
+X lib/smalltalk/tests/ansi.sx: could not extract summary
+X lib/smalltalk/tests/hashed.sx: could not extract summary
+X lib/smalltalk/tests/pharo.sx: could not extract summary
+X lib/smalltalk/tests/programs.sx: could not extract summary
 ```
 
 ## Notes

lib/tcl/conformance.sh

@@ -63,6 +63,8 @@ for tcl_file in "${TCL_FILES[@]}"; do
   # Build epoch input using quoted heredoc for static parts; helper path via variable
   cat > "$tmpfile" << EPOCHS
 (epoch 1)
+(load "lib/guest/lex.sx")
+(load "lib/guest/prefix.sx")
 (load "lib/tcl/tokenizer.sx")
 (epoch 2)
 (load "lib/tcl/parser.sx")

lib/tcl/scoreboard.json

@@ -1,9 +1,10 @@
 {
-  "total": 3,
+  "total": 4,
   "passed": 3,
-  "failed": 0,
+  "failed": 1,
   "programs": {
     "assert": {"status": "PASS", "expected": "10", "got": "10"},
+    "event-loop": {"status": "FAIL", "expected": "done", "got": ""},
     "for-each-line": {"status": "PASS", "expected": "13", "got": "13"},
     "with-temp-var": {"status": "PASS", "expected": "100 999", "got": "100 999"}
   }

lib/tcl/scoreboard.md

@@ -3,7 +3,8 @@
 | Program | Status | Expected | Got |
 |---|---|---|---|
 | assert | ✓ PASS | 10 | 10 |
+| event-loop | ✗ FAIL | done |  |
 | for-each-line | ✓ PASS | 13 | 13 |
 | with-temp-var | ✓ PASS | 100 999 | 100 999 |
 
-**3/3 passing**
+**3/4 passing**

lib/tcl/test.sh

@@ -33,6 +33,8 @@ HELPER_EOF
 
 cat > "$TMPFILE" << EPOCHS
 (epoch 1)
+(load "lib/guest/lex.sx")
+(load "lib/guest/prefix.sx")
 (load "lib/tcl/tokenizer.sx")
 (epoch 2)
 (load "lib/tcl/parser.sx")
@@ -57,7 +59,7 @@ cat > "$TMPFILE" << EPOCHS
 (eval "tcl-test-summary")
 EPOCHS
 
-OUTPUT=$(timeout 7200 "$SX_SERVER" < "$TMPFILE" 2>&1)
+OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1)
 [ "$VERBOSE" = "-v" ] && echo "$OUTPUT"
 
 # Extract summary line from epoch 11 output

lib/tcl/tests/coro.sx

@@ -124,7 +124,7 @@
       "file0")
 
     (ok "eof-returns-1"
-      (get (run "set ch [open /dev/null r]\nread $ch\neof $ch") :result)
+      (get (run "set ch [open /dev/null r]\neof $ch") :result)
       "1")
 
     (dict

lib/tcl/tests/idioms.sx

@@ -187,496 +187,6 @@
           (env-extend (env-extend base "a" 3) "b" 7)
           (quote (* a b))))
       21)
-
-    ; 26-32. Phase 5 channels: write/read/seek/tell/eof/append/non-blocking
-    (ok "channel-write-read"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-1.txt\nset c [open $f w]\nputs $c \"line one\"\nputs $c \"line two\"\nclose $c\nset c [open $f r]\nset out [read $c]\nclose $c\nfile delete $f\nreturn $out")
-        :result)
-      "line one\nline two\n")
-
-    (ok "channel-gets-loop"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-2.txt\nset c [open $f w]\nputs $c apple\nputs $c banana\nputs $c cherry\nclose $c\nset c [open $f r]\nset out {}\nwhile {[gets $c line] >= 0} {lappend out $line}\nclose $c\nfile delete $f\nreturn $out")
-        :result)
-      "apple banana cherry")
-
-    (ok "channel-seek-tell"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-3.txt\nset c [open $f w]\nputs -nonewline $c \"hello world\"\nclose $c\nset c [open $f r]\nseek $c 6\nset pos [tell $c]\nset rest [read $c]\nclose $c\nfile delete $f\nreturn \"$pos:$rest\"")
-        :result)
-      "6:world")
-
-    (ok "channel-eof-after-read"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-4.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset c [open $f r]\nread $c\nset e [eof $c]\nclose $c\nfile delete $f\nreturn $e")
-        :result)
-      "1")
-
-    (ok "channel-append-mode"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-5.txt\nset c [open $f w]\nputs -nonewline $c \"first\"\nclose $c\nset c [open $f a]\nputs -nonewline $c \"-second\"\nclose $c\nset c [open $f r]\nset out [read $c]\nclose $c\nfile delete $f\nreturn $out")
-        :result)
-      "first-second")
-
-    (ok "channel-seek-end"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-6.txt\nset c [open $f w]\nputs -nonewline $c \"abcdefghij\"\nclose $c\nset c [open $f r]\nseek $c 0 end\nset pos [tell $c]\nclose $c\nfile delete $f\nreturn $pos")
-        :result)
-      "10")
-
-    (ok "channel-fconfigure-blocking"
-      (get
-        (run
-          "set f /tmp/tcl-phase5-7.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset c [open $f r]\nfconfigure $c -blocking 0\nset b [fconfigure $c -blocking]\nclose $c\nfile delete $f\nreturn $b")
-        :result)
-      "0")
-
-    ; 33-37. Phase 5b event loop: after / vwait / fileevent / update
-    (ok "after-vwait-timer"
-      (get
-        (run
-          "after 30 {set ::done fired}\nvwait ::done\nset ::done")
-        :result)
-      "fired")
-
-    (ok "after-multiple-timers-update"
-      (get
-        (run
-          "set ::n 0\nafter 0 {incr ::n}\nafter 0 {incr ::n}\nafter 0 {incr ::n}\nupdate\nset ::n")
-        :result)
-      "3")
-
-    (ok "fileevent-readable-fires"
-      (get
-        (run
-          "set f /tmp/tcl-phase5b-1.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset c [open $f r]\nfileevent $c readable {set ::ready 1; fileevent $::ch readable {}}\nset ::ch $c\nvwait ::ready\nclose $c\nfile delete $f\nset ::ready")
-        :result)
-      "1")
-
-    (ok "fileevent-query-script"
-      (get
-        (run
-          "set f /tmp/tcl-phase5b-2.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset c [open $f r]\nfileevent $c readable {puts hello}\nset s [fileevent $c readable]\nclose $c\nfile delete $f\nreturn $s")
-        :result)
-      "puts hello")
-
-    (ok "after-cancel-via-vwait-timing"
-      (get
-        (run
-          "set ::counter 0\nafter 10 {incr ::counter}\nafter 50 {set ::done 1}\nvwait ::done\nset ::counter")
-        :result)
-      "1")
-
-    ; 38-41. Phase 5c sockets: TCP client + server
-    (ok "socket-server-fires-callback"
-      (get
-        (run
-          "proc h {sock host port} { global got; set got hit; close $sock }\nset srv [socket -server h 18901]\nset cli [socket localhost 18901]\nvwait got\nclose $srv\nclose $cli\nset got")
-        :result)
-      "hit")
-
-    (ok "socket-client-server-roundtrip"
-      (get
-        (run
-          "proc h {sock host port} { global received; gets $sock line; set received $line; close $sock }\nset srv [socket -server h 18902]\nset cli [socket localhost 18902]\nputs $cli ping\nflush $cli\nvwait received\nclose $srv\nclose $cli\nset received")
-        :result)
-      "ping")
-
-    (ok "socket-server-peer-host"
-      (get
-        (run
-          "proc h {sock host port} { global peer; set peer $host; close $sock }\nset srv [socket -server h 18903]\nset cli [socket 127.0.0.1 18903]\nvwait peer\nclose $srv\nclose $cli\nset peer")
-        :result)
-      "127.0.0.1")
-
-    (ok "socket-multiple-connections"
-      (get
-        (run
-          "proc h {sock host port} { global count; incr count; close $sock }\nset count 0\nset srv [socket -server h 18904]\nset c1 [socket localhost 18904]\nset c2 [socket localhost 18904]\nset c3 [socket localhost 18904]\nwhile {$count < 3} { update; after 5 }\nclose $srv\nclose $c1\nclose $c2\nclose $c3\nset count")
-        :result)
-      "3")
-
-    ; 42-49. Phase 5d file metadata + ops
-    (ok "file-isfile-true"
-      (get
-        (run
-          "set f /tmp/tcl-phase5d-1.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset r [file isfile $f]\nfile delete $f\nreturn $r")
-        :result)
-      "1")
-
-    (ok "file-isfile-false-on-dir"
-      (get (run "file isfile /tmp") :result)
-      "0")
-
-    (ok "file-isdir-true"
-      (get (run "file isdir /tmp") :result)
-      "1")
-
-    (ok "file-size"
-      (get
-        (run
-          "set f /tmp/tcl-phase5d-2.txt\nset c [open $f w]\nputs -nonewline $c hello\nclose $c\nset s [file size $f]\nfile delete $f\nreturn $s")
-        :result)
-      "5")
-
-    (ok "file-readable-true"
-      (get (run "file readable /tmp") :result)
-      "1")
-
-    (ok "file-readable-missing"
-      (get (run "file readable /no/such/path/here") :result)
-      "0")
-
-    (ok "file-mkdir-then-isdir"
-      (get
-        (run
-          "set d /tmp/tcl-phase5d-mkdir/sub\nfile mkdir $d\nset r [file isdir $d]\nfile delete $d\nfile delete /tmp/tcl-phase5d-mkdir\nreturn $r")
-        :result)
-      "1")
-
-    (ok "file-copy-roundtrip"
-      (get
-        (run
-          "set s /tmp/tcl-phase5d-src.txt\nset d /tmp/tcl-phase5d-dst.txt\nset c [open $s w]\nputs -nonewline $c copydata\nclose $c\nfile copy $s $d\nset c [open $d r]\nset out [read $c]\nclose $c\nfile delete $s\nfile delete $d\nreturn $out")
-        :result)
-      "copydata")
-
-    (ok "file-rename-then-exists"
-      (get
-        (run
-          "set s /tmp/tcl-phase5d-r1.txt\nset d /tmp/tcl-phase5d-r2.txt\nset c [open $s w]\nputs -nonewline $c x\nclose $c\nfile rename $s $d\nset r [list [file exists $s] [file exists $d]]\nfile delete $d\nreturn $r")
-        :result)
-      "0 1")
-
-    (ok "file-mtime-positive"
-      (get
-        (run
-          "set f /tmp/tcl-phase5d-mt.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset m [file mtime $f]\nfile delete $f\nexpr {$m > 0}")
-        :result)
-      "1")
-
-    ; 52-56. Phase 5e clock format options + clock scan
-    (ok "clock-format-utc"
-      (get
-        (run "clock format 0 -format {%Y-%m-%d %H:%M:%S} -gmt 1")
-        :result)
-      "1970-01-01 00:00:00")
-
-    (ok "clock-format-fmt-default"
-      (get
-        (run "clock format 1710513000 -format {%Y-%m-%d} -gmt 1")
-        :result)
-      "2024-03-15")
-
-    (ok "clock-scan-roundtrip"
-      (get
-        (run "set t [clock scan {2024-06-15 12:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1]\nclock format $t -format {%Y-%m-%d %H:%M:%S} -gmt 1")
-        :result)
-      "2024-06-15 12:00:00")
-
-    (ok "clock-scan-returns-int"
-      (get
-        (run "expr {[clock scan {1970-01-01 00:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1] == 0}")
-        :result)
-      "1")
-
-    (ok "clock-format-percent-pct"
-      (get
-        (run "clock format 0 -format {%Y%%%m} -gmt 1")
-        :result)
-      "1970%01")
-
-    ; 57-59. Phase 5f socket -async (non-blocking connect)
-    (ok "socket-async-completes-writable"
-      (get
-        (run
-          "proc h {sock host port} { close $sock }\nset srv [socket -server h 18930]\nset c [socket -async localhost 18930]\nset ready 0\nfileevent $c writable {global ready; set ready 1}\nvwait ready\nclose $c\nclose $srv\nset ready")
-        :result)
-      "1")
-
-    (ok "socket-async-then-write"
-      (get
-        (run
-          "proc accept {sock host port} { global accepted_sock; set accepted_sock $sock; fileevent $sock readable [list reader $sock] }\nproc reader {sock} { global received; gets $sock line; set received $line; close $sock }\nset srv [socket -server accept 18931]\nset c [socket -async localhost 18931]\nfileevent $c writable {global wready; set wready 1; fileevent $::ch writable {}}\nset ::ch $c\nvwait wready\nputs $c async-data\nflush $c\nvwait received\nclose $c\nclose $srv\nset received")
-        :result)
-      "async-data")
-
-    (ok "socket-async-no-error"
-      (get
-        (run
-          "proc h {sock host port} { close $sock }\nset srv [socket -server h 18932]\nset c [socket -async localhost 18932]\nset r 0\nfileevent $c writable {global r; set r 1}\nvwait r\nset err [fconfigure $c -error]\nclose $c\nclose $srv\nreturn $err")
-        :result)
-      "")
-
-    ; 60-63. Phase 6a namespace :: prefix
-    (ok "ns-set-from-proc-reaches-global"
-      (get
-        (run
-          "proc f {x} { set ::g $x }\nf hello\nset ::g")
-        :result)
-      "hello")
-
-    (ok "ns-read-from-proc"
-      (get
-        (run
-          "set ::v 42\nproc f {} { return $::v }\nf")
-        :result)
-      "42")
-
-    (ok "ns-incr-via-prefix"
-      (get
-        (run
-          "set ::n 5\nproc bump {} { incr ::n }\nbump\nbump\nset ::n")
-        :result)
-      "7")
-
-    (ok "ns-different-from-local"
-      (get
-        (run
-          "set x outer\nproc f {} { set x inner; set ::x global; return $x }\nf")
-        :result)
-      "inner")
-
-    ; 64-69. Phase 6b list ops (lassign, lrepeat, lset, lmap)
-    (ok "lassign-three"
-      (get (run "lassign {a b c d e} x y z\nlist $x $y $z") :result)
-      "a b c")
-
-    (ok "lassign-leftover"
-      (get (run "lassign {1 2 3 4 5} a b") :result)
-      "3 4 5")
-
-    (ok "lrepeat-basic"
-      (get (run "lrepeat 3 a") :result)
-      "a a a")
-
-    (ok "lrepeat-multi"
-      (get (run "lrepeat 2 x y") :result)
-      "x y x y")
-
-    (ok "lset-replaces"
-      (get (run "set L {a b c d}\nlset L 2 ZZ\nset L") :result)
-      "a b ZZ d")
-
-    (ok "lmap-square"
-      (get (run "lmap n {1 2 3 4} {expr {$n * $n}}") :result)
-      "1 4 9 16")
-
-    ; 70-72. Phase 6c dict additions (lappend, remove, filter)
-    (ok "dict-lappend-extends"
-      (get (run "set d {tags {a b}}\ndict lappend d tags c d\nset d") :result)
-      "tags {a b c d}")
-
-    (ok "dict-remove"
-      (get (run "dict remove {a 1 b 2 c 3} b") :result)
-      "a 1 c 3")
-
-    (ok "dict-filter-key"
-      (get (run "dict filter {alpha 1 beta 2 gamma 3} key a*") :result)
-      "alpha 1")
-
-    ; 73-79. Phase 6d format and scan
-    (ok "format-int-padded"
-      (get (run "format {%05d} 42") :result)
-      "00042")
-
-    (ok "format-float-precision"
-      (get (run "format {%.2f} 3.14159") :result)
-      "3.14")
-
-    (ok "format-hex"
-      (get (run "format {%x} 255") :result)
-      "ff")
-
-    (ok "format-char"
-      (get (run "format {%c} 65") :result)
-      "A")
-
-    (ok "format-string-left"
-      (get (run "format {%-5s|} hi") :result)
-      "hi   |")
-
-    (ok "scan-two-ints"
-      (get (run "scan {12 34} {%d %d} a b\nlist $a $b") :result)
-      "12 34")
-
-    (ok "scan-count"
-      (get (run "scan {hello 42} {%s %d}") :result)
-      "hello 42")
-
-    ; 80-82. Phase 6e exec
-    (ok "exec-echo"
-      (get (run "exec echo hello world") :result)
-      "hello world")
-
-    (ok "exec-printf-no-newline"
-      (get (run "exec /bin/printf x") :result)
-      "x")
-
-    (ok "exec-with-args"
-      (get (run "exec /bin/echo -n test") :result)
-      "test")
-
-    ; 83-87. Phase 7a try/trap with varlist
-    (ok "try-trap-prefix-match"
-      (get
-        (run
-          "try {throw {ARITH DIVZERO} divide-by-zero} trap {ARITH} {res} {set caught $res}")
-        :result)
-      "divide-by-zero")
-
-    (ok "try-trap-full-pattern"
-      (get
-        (run
-          "try {throw {FOO BAR} bad} trap {FOO BAR} {res} {return matched-foo-bar}")
-        :result)
-      "matched-foo-bar")
-
-    (ok "try-on-error-opts"
-      (get
-        (run
-          "try {error oops} on error {res opts} {dict get $opts -code}")
-        :result)
-      "1")
-
-    (ok "try-trap-no-match-falls-through"
-      (get
-        (run
-          "set caught notrun\ncatch {try {throw {NOPE} bad} trap {OTHER} {r} {set caught matched}}\nset caught")
-        :result)
-      "notrun")
-
-    (ok "try-trap-then-on-error"
-      (get
-        (run
-          "try {error generic} trap {SPECIFIC} {r} {return trap-fired} on error {r} {return on-error-fired}")
-        :result)
-      "on-error-fired")
-
-    ; 88-92. Phase 7b exec pipelines + redirection
-    (ok "exec-pipeline-tr"
-      (get (run "exec echo hello world | tr a-z A-Z") :result)
-      "HELLO WORLD")
-
-    (ok "exec-pipeline-wc"
-      (get (run "exec /bin/echo abc | wc -c") :result)
-      "4")
-
-    (ok "exec-redirect-stdout"
-      (get
-        (run
-          "set f /tmp/tcl-7b-out.txt\nexec echo hello > $f\nset r [exec cat $f]\nfile delete $f\nreturn $r")
-        :result)
-      "hello")
-
-    (ok "exec-redirect-stdin"
-      (get
-        (run
-          "set f /tmp/tcl-7b-in.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset r [exec cat < $f]\nfile delete $f\nreturn $r")
-        :result)
-      "hi")
-
-    (ok "exec-pipeline-three-stages"
-      (get (run "exec echo {alpha beta gamma} | tr { } \\n | wc -l") :result)
-      "3")
-
-    ; 93-99. Phase 7c string command audit
-    (ok "string-equal"
-      (get (run "string equal hello hello") :result)
-      "1")
-
-    (ok "string-equal-nocase"
-      (get (run "string equal -nocase HELLO hello") :result)
-      "1")
-
-    (ok "string-totitle"
-      (get (run "string totitle hello") :result)
-      "Hello")
-
-    (ok "string-reverse"
-      (get (run "string reverse hello") :result)
-      "olleh")
-
-    (ok "string-replace"
-      (get (run "string replace hello 1 3 ZZZ") :result)
-      "hZZZo")
-
-    (ok "string-is-xdigit-yes"
-      (get (run "string is xdigit ff00aa") :result)
-      "1")
-
-    (ok "string-is-true-yes"
-      (get (run "string is true yes") :result)
-      "1")
-
-    ; 100-105. Phase 7e regexp anchoring/boundary audit
-    (ok "regexp-anchor-start"
-      (get (run "regexp {^hello} hello-world") :result)
-      "1")
-
-    (ok "regexp-anchor-end"
-      (get (run "regexp {world$} hello-world") :result)
-      "1")
-
-    (ok "regexp-word-boundary"
-      (get (run "regexp {\\bword\\b} \"the word here\"") :result)
-      "1")
-
-    (ok "regexp-nocase"
-      (get (run "regexp -nocase {HELLO} hello") :result)
-      "1")
-
-    (ok "regexp-capture-var"
-      (get (run "regexp {[0-9]+} abc123def captured\nset captured") :result)
-      "123")
-
-    (ok "regsub-all"
-      (get (run "regsub -all {[0-9]+} a1b22c333 X") :result)
-      "aXbXcX")
-
-    ; 106-110. Phase 7d TclOO basics
-    (ok "oo-class-method"
-      (get
-        (run
-          "oo::class create C {\nmethod get {} { return 42 }\n}\nset c [C new]\n$c get")
-        :result)
-      "42")
-
-    (ok "oo-constructor"
-      (get
-        (run
-          "oo::class create G {\nconstructor {n} { set ::gname $n }\nmethod hello {} { return [string cat \"hi \" $::gname] }\n}\nset g [G new World]\n$g hello")
-        :result)
-      "hi World")
-
-    (ok "oo-inheritance-overridden"
-      (get
-        (run
-          "oo::class create Animal {\nmethod sound {} { return generic }\n}\noo::class create Dog {\nsuperclass Animal\nmethod sound {} { return woof }\n}\nset d [Dog new]\n$d sound")
-        :result)
-      "woof")
-
-    (ok "oo-inheritance-inherited"
-      (get
-        (run
-          "oo::class create Animal {\nmethod sound {} { return generic }\n}\noo::class create Cat {\nsuperclass Animal\n}\nset c [Cat new]\n$c sound")
-        :result)
-      "generic")
-
-    (ok "oo-multiple-instances"
-      (get
-        (run
-          "oo::class create N {\nconstructor {x} { set ::nval $x }\nmethod get {} { return $::nval }\n}\nset a [N new 1]\nset b [N new 99]\n$b get")
-        :result)
-      "99")
-
     (dict
       "passed"
       tcl-idiom-pass

lib/tcl/tokenizer.sx

@@ -1,19 +1,10 @@
-(define tcl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
+(prefix-rename "tcl-"
+  '((ws?          lex-space?)
+    (alpha?       lex-alpha?)
+    (digit?       lex-digit?)
+    (ident-start? lex-ident-start?)
+    (ident-char?  lex-ident-char?)))
 
-(define tcl-alpha?
-  (fn (c)
-    (and
-      (not (= c nil))
-      (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
-
-(define tcl-digit?
-  (fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
-
-(define tcl-ident-start?
-  (fn (c) (or (tcl-alpha? c) (= c "_"))))
-
-(define tcl-ident-char?
-  (fn (c) (or (tcl-ident-start? c) (tcl-digit? c))))
 
 (define tcl-tokenize
   (fn (src)
@@ -167,9 +158,7 @@
                       (begin
                         (when (= (cur) "}") (advance! 1))
                         {:type "var" :name name}))))))
-            ((or
-                (tcl-ident-start? (cur))
-                (and (= (cur) ":") (= (char-at 1) ":")))
+            ((tcl-ident-start? (cur))
               (let ((start pos))
                 (begin
                   (scan-ns-name!)

plans/agent-briefings/lib-guest-loop.md

@@ -0,0 +1,118 @@
+# lib/guest extraction loop (single agent, queue-driven)
+
+Role: iterates `plans/lib-guest.md` forever. Each iteration picks the top `pending` step, extracts/ports/validates, commits, logs, moves on. North star: every guest's `scoreboard.json` ≥ baseline at all times, while `lib/guest/` accumulates shared infrastructure.
+
+```
+description: lib/guest extraction loop
+subagent_type: general-purpose
+run_in_background: true
+```
+
+## Prompt
+
+You are the sole background agent working `/root/rose-ash/plans/lib-guest.md`. You work a prioritised queue, one step per code commit, indefinitely. The plan file is the source of truth for what's pending, in-progress, done, and blocked. Update it after every iteration.
+
+## Iteration protocol (follow exactly)
+
+### 1. Read state
+
+- Read `plans/lib-guest.md` in full.
+- Pick the first step with status `[ ]`. If all remaining are `[blocked]` or `[done]`, stop and report loop complete.
+- Set that step's status to `[in-progress]` and commit the plan change alone:
+  `GUEST-plan: claim step <N> — <name>`.
+
+### 2. Baseline (every iteration that touches a guest)
+
+Before any code edit, snapshot the **current** scoreboard for every guest this step will touch (extraction consumers + canaries):
+
+```
+bash lib/<guest>/conformance.sh    # or test.sh
+cp lib/<guest>/scoreboard.json /tmp/baseline-<guest>-step<N>.json
+```
+
+If the step is Step 0, the snapshot itself is the work — copy each guest's `scoreboard.json` (or harvest pass/fail counts from `test.sh` for guests without a scoreboard) into `lib/guest/baseline/<lang>.json`, populate the table in `plans/lib-guest.md`, commit, done.
+
+### 3. Do the work
+
+For each step the protocol is:
+1. Read the relevant existing guest file(s) via `sx_read_subtree` to see exactly what shape needs extracting.
+2. Draft `lib/guest/<file>.sx` via `sx_write_file` (validates by parsing).
+3. Port the **first** consumer to use it. Run that guest's conformance. Must equal baseline.
+4. Port the **second** consumer (the two-language rule). Run that guest's conformance. Must equal baseline.
+5. If the second consumer needs escape hatches that the first didn't, the abstraction is wrong — **redesign before continuing**, don't paper over with alias chains or per-language flags.
+
+For Step 0 only: just snapshot, no extraction.
+
+### 4. Verify
+
+For every guest the step touched:
+
+```
+bash lib/<guest>/conformance.sh   # or test.sh
+diff lib/<guest>/scoreboard.json /tmp/baseline-<guest>-step<N>.json
+```
+
+**Abort rule:** if any touched guest's scoreboard regresses by ≥1 test, do NOT commit code. Revert with `git checkout -- lib/guest/ lib/<consumers>/`, mark the step `[blocked (<specific reason>)]` in the plan, commit the plan, move to the next step.
+
+### 5. Commit code
+
+One commit for the code:
+
+```
+GUEST: step <N> — <name>
+
+<2-4 lines on what was extracted, which two consumers were ported, baseline-equal verification.>
+
+Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
+```
+
+### 6. Update plan + commit
+
+In `plans/lib-guest.md`:
+- Change this step's status from `[in-progress]` to `[done]` (or `[partial — pending <consumer>]`).
+- Fill in the Commit and Delta columns of the progress log.
+- If you re-snapshotted any baseline, update the Baseline column.
+
+Commit: `GUEST-plan: log step <N> done`.
+
+### 7. Move on
+
+Go back to step 1. Continue until:
+- All steps are `[done]` or `[blocked]`, OR
+- You hit your iteration budget, OR
+- You encounter a substrate-level failure (build broken, sx_server.exe missing) — stop and report.
+
+## Ground rules
+
+- **Branch:** `architecture`. Commit locally. **Never push.** **Never touch `main`.**
+- **Scope:** ONLY `lib/guest/**`, `lib/{lua,prolog,haskell,common-lisp,tcl,erlang,smalltalk,forth,ruby,apl,js}/**`, `plans/lib-guest.md`, `plans/agent-briefings/lib-guest-loop.md`. NO `spec/`, `hosts/`, `web/`, `shared/`.
+- **SX files:** `sx-tree` MCP tools ONLY. Never `Edit`/`Read`/`Write` on `.sx`. `sx_validate` after every edit.
+- **OCaml build:** `sx_build target="ocaml"` MCP tool. Never raw `dune`.
+- **Two-language rule:** never merge an extraction until two guests consume it. Step 8 (HM) is the only exception, marked explicitly.
+- **No alias chains** to bridge naming drift between extraction and consumer — rename consumer-side or extraction-side, don't add a translation layer.
+- **No new planning docs** beyond updating the plan file.
+- **No comments in SX** unless non-obvious.
+- **Unicode in SX:** raw UTF-8, never `\uXXXX`.
+- **Hard timeout:** >45 min on a step → mark `blocked`, move on.
+- **Partial fixes are OK.** If you extract something and only the first consumer ports cleanly, mark `[partial — pending <second consumer>]`, commit, move on. The next iteration that lands the second consumer flips it to `[done]`.
+
+## Gotchas from past sessions
+
+- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain). Macros that want to introduce names use `env-bind!`.
+- SX `do` is R7RS iteration, not a sequence form. Use `begin` for multi-expr bodies.
+- `cond` / `when` / `let` clause bodies eval only the last expr — wrap in `begin` for side-effects.
+- `list?` returns false on raw JS Arrays — host-side data must be SX-converted.
+- `make-symbol` builds an identifier symbol; `string->symbol` exists too — use whichever the surrounding code uses.
+- `sx_validate` after every edit. The hook will block raw `Edit`/`Write` on `.sx` anyway, but the validator catches subtree mistakes that parse-but-don't-mean-what-you-think.
+- Guest `conformance.sh` scripts use the epoch protocol against `sx_server.exe`. If the server isn't built, run `sx_build target="ocaml"` first.
+- Each guest's `scoreboard.json` schema differs slightly — normalise to `{:totals {:pass N :fail M} :suites [...]}` when writing `lib/guest/baseline/<lang>.json`.
+- `lib/parser-combinators.sx` exists and is unused by any guest. The new lex/Pratt kit may want to coexist with it, or supersede it — investigate before duplicating its functionality.
+- Prolog operator parsing is the stress test for Pratt — Prolog ops have variable precedence, `xfx`/`xfy`/`yfx` associativity classes, and user-definable ops at runtime. The Pratt kit must accommodate runtime registration, not just static tables.
+- Haskell layout is the stress test for whitespace-sensitive lexing — off-side rule, do/let/where/of opening blocks, semicolon insertion, brace insertion. Don't ship `lib/guest/layout.sx` unless the haskell scoreboard equals baseline.
+
+## Starting state
+
+- Branch: `architecture`. HEAD at or near `40f0e733`.
+- Canaries: **Lua** + **Prolog**.
+- Plan file at `plans/lib-guest.md`. Step 0 (baseline snapshot) is the first iteration.
+- `lib/guest/` does not yet exist — create it on the Step 0 commit.

plans/lib-guest.md

@@ -0,0 +1,178 @@
+# lib/guest — shared toolkit for SX-hosted languages
+
+Extract the duplicated plumbing across `lib/{haskell,common-lisp,erlang,prolog,js,lua,smalltalk,tcl,forth,ruby,apl,hyperscript}` into a small, composable kit so language N+1 costs ~200 lines instead of ~2000, without regressing any existing conformance scoreboard.
+
+Branch: `architecture`. SX files via `sx-tree` MCP only. Never edit generated files.
+
+## Thesis
+
+The substrate (CEK, hygienic macros, records, delimited continuations, IO suspension, reactivity) was chosen with multi-paradigm hosting in mind, but each guest currently re-rolls its own tokeniser, recursive-descent loop, conformance harness, and primitive-rename layer. Extracting these shared layers does not reduce conformance bug-finding pressure — it only removes plumbing — so it is pure win.
+
+**Canaries:** Lua (small, conventional expression-grammar — exercises lex/Pratt/AST) and Prolog (paradigm-different — exercises pattern-match/unification). The two-canary rule prevents Lua-shaped abstractions.
+
+**Two-language rule:** no extraction is merged until **two** guests consume it.
+
+## Current baseline
+
+The loop fills these in on its first iteration by running every `*/conformance.sh` and `*/test.sh` and copying each `scoreboard.json` to `lib/guest/baseline/<lang>.json`. Until then:
+
+| Guest        | Suite              | Baseline |
+|--------------|--------------------|----------|
+| lua          | `bash lib/lua/test.sh`              | 185 / 185 |
+| prolog       | `bash lib/prolog/conformance.sh`    | 590 / 590 |
+| haskell      | `bash lib/haskell/conformance.sh`   | 156 / 156 (was reported 0/18 by the buggy old script) |
+| common-lisp  | `bash lib/common-lisp/conformance.sh` | 518 / 518 (Phase 2 +182 and Phase 6 +27 were previously under-counted) |
+| erlang       | `bash lib/erlang/conformance.sh`    | 0 / 0 (suite all-zero) |
+| js           | `bash lib/js/conformance.sh`        | 94 / 148 (test262-slice) |
+| smalltalk    | `bash lib/smalltalk/conformance.sh` | 625 / 629 |
+| tcl          | `bash lib/tcl/conformance.sh`       | 3 / 4 (programs) |
+| forth        | `bash lib/forth/test.sh`            | 64 / 64 |
+| ruby         | `bash lib/ruby/test.sh`             | 76 / 76 |
+| apl          | `bash lib/apl/test.sh`              | 73 / 73 |
+
+The baseline only needs to be re-snapshotted when the substrate (`spec/**`, `hosts/**`) changes underneath this loop.
+
+---
+
+## Phase 0 — Baseline snapshot (one-shot)
+
+### Step 0: Snapshot every guest's scoreboard
+
+Create `lib/guest/baseline/`. Run every guest's conformance/test runner. Copy each `scoreboard.json` (or extract pass/fail counts from `test.sh` output for guests without a scoreboard) into `lib/guest/baseline/<lang>.json`. Fill in the table above.
+
+**Verify:** `ls lib/guest/baseline/*.json` shows one per guest. Plan table populated.
+
+---
+
+## Phase 1 — Cheap, zero-semantic-risk extractions
+
+### Step 1: `lib/guest/conformance.sx` — config-driven test runner
+
+Replace the 6+ near-identical `*/conformance.sh` scripts with one driver that takes a config dict:
+
+```
+{:lang "prolog"
+ :loads ("lib/prolog/tokenizer.sx" "lib/prolog/parser.sx" ...)
+ :suites (("parse" "lib/prolog/tests/parse.sx" "pl-parse-tests-run!") ...)}
+```
+
+The driver locates `sx_server.exe`, runs the epoch protocol, collects pass/fail per suite, and writes `scoreboard.{json,md}`. The per-language `conformance.sh` becomes a 3-line stub that points at its config.
+
+**Port to:** `lib/prolog/conformance.sh` and `lib/haskell/conformance.sh`. Two consumers required for merge.
+
+**Verify:** both `bash lib/prolog/conformance.sh` and `bash lib/haskell/conformance.sh` produce scoreboard JSONs equal to baseline.
+
+### Step 2: `lib/guest/prefix.sx` — prefix-rename macro
+
+One macro that takes a prefix and a list of SX symbols and binds prefixed aliases:
+
+```
+(prefix-rename "cl-" '(null? pair? even? odd? zero? ...))
+```
+
+Replaces hundreds of hand-written `(define (cl-null? x) (= x nil))`-style wrappers in `common-lisp/runtime.sx`, `lua/runtime.sx`, `erlang/runtime.sx`.
+
+**Port to:** `common-lisp/runtime.sx` (largest user) and `lua/runtime.sx`. Two consumers.
+
+**Verify:** common-lisp + lua scoreboards equal baseline.
+
+---
+
+## Phase 2 — Lex / parse kit
+
+### Step 3: `lib/guest/lex.sx` — character-class + tokeniser primitives
+
+- Source-position tracking (line/col/offset).
+- Character-class predicates (`whitespace?`, `digit?`, `alpha?`, `ident-start?`, `ident-rest?`).
+- Number recognisers (decimal, hex, float, scientific).
+- String recognisers (quoted, escapes, raw).
+- Comment recognisers (line, block, nestable).
+- Token record `{:type :value :pos :end :line}`.
+
+**Port to:** `lua/tokenizer.sx` and `tcl/tokenizer.sx`. Two consumers.
+
+**Verify:** lua + tcl scoreboards equal baseline.
+
+### Step 4: `lib/guest/pratt.sx` — Pratt / operator-precedence parser
+
+Prefix / infix / postfix tables, left/right associativity, precedence climbing. Grammar is a dict, not hardcoded `cond`.
+
+**Port to:** Lua expression parser (`lua/parser.sx`) and Prolog operator table (`prolog/parser.sx` — Prolog ops are the stress test). Two consumers.
+
+**Verify:** lua + prolog scoreboards equal baseline.
+
+### Step 5: `lib/guest/ast.sx` — canonical AST node shapes
+
+Standard constructors and predicates for: `literal`, `var`, `app`, `lambda`, `let`, `letrec`, `if`, `match-clause`, `module`, `import`. Optional — guests may keep their own AST — but using the canonical shape lets cross-language tooling (formatters, highlighters, debuggers) work without per-language adapters.
+
+**Port to:** lua + prolog AST emitters. Two consumers.
+
+**Verify:** lua + prolog scoreboards equal baseline.
+
+---
+
+## Phase 3 — Semantic extractions (highest leverage, highest risk)
+
+### Step 6: `lib/guest/match.sx` — pattern-match + unification engine
+
+Single engine for:
+- Literal patterns (numbers, strings, symbols, nil, booleans).
+- Wildcard `_`.
+- Constructor patterns (ADT-shaped — depends on Phase 3 of `sx-improvements.md` if available, otherwise dict-tagged).
+- Variable binding.
+- **Unification** (Prolog flavour): symmetric, occurs-check toggle, substitution returned.
+- **Match** (Haskell flavour): asymmetric pattern→value, bindings returned.
+
+**Port to:** `haskell/match.sx` and `prolog/query.sx` unification core. Two consumers.
+
+**Verify:** haskell + prolog scoreboards equal baseline. **Highest-risk extraction** — if either regresses by 1 test, revert and redesign.
+
+### Step 7: `lib/guest/layout.sx` — significant-whitespace / off-side rule
+
+Generalised layout-sensitive lexer. Configurable: which keywords open layout blocks, whether semicolons are inserted, brace insertion rules.
+
+**Port to:** `haskell/layout.sx` (existing). Second consumer: write a synthetic test fixture that exercises a Python-ish layout to prove the kit is not Haskell-shaped. Two consumers.
+
+**Verify:** haskell scoreboard equal baseline; synthetic layout fixture passes.
+
+### Step 8: `lib/guest/hm.sx` — Hindley-Milner type inference
+
+Extract from `haskell/infer.sx`. Algorithm W or J, generalisation, instantiation, occurs-check, principal types.
+
+**Sequencing:** this step is **paired with `plans/ocaml-on-sx.md` Phase 5**. The natural order is lib-guest Steps 0–7 → OCaml-on-SX Phases 1–5 → lib-guest Step 8. With OCaml-on-SX Phase 5 done, the two-language rule is satisfied for real (Haskell + OCaml). Without it, accept "second user TBD" — the alternative is letting the inference stay locked inside Haskell forever.
+
+**Port to:** `haskell/infer.sx` and (preferred) `lib/ocaml/types.sx`.
+
+**Verify:** haskell scoreboard equal baseline; if OCaml-on-SX Phase 5 has shipped, OCaml type-inference tests equal baseline too.
+
+---
+
+## Progress log
+
+| Step | Status | Commit | Delta |
+|------|--------|--------|-------|
+| 0 — baseline snapshot | [done] | 2f7f8189 | 11 guests captured: lua 185/185, forth 64/64, ruby 76/76, apl 73/73, prolog 590/590, common-lisp 309/309, smalltalk 625/629, tcl 3/4, haskell 0/18 programs, js 94/148 (slice), erlang 0/0 |
+| 1 — conformance.sx (prolog + haskell) | [done] | 58dcff26 | Prolog 590/590 (matches baseline). Haskell 156/156 — old script was broken (0/18 was an artefact of a never-matching grep), driver reveals true counts; baseline updated. |
+| 2 — prefix.sx (common-lisp + lua) | [partial — pending lua] | 2ef773a3 | common-lisp/runtime.sx ported (47 aliases collapsed into 13 prefix-rename calls); 518/518 vs 309/309 baseline (improvement, no regression). lua/runtime.sx has no pure same-name aliases — every lua- definition wraps custom logic; second consumer pending. |
+| 3 — lex.sx (lua + tcl) | [done] | 559b0df9 | lex.sx exports nil-safe char-class predicates + token record. lua/tokenizer.sx (7 preds) and tcl/tokenizer.sx (5 preds) collapsed into prefix-rename calls. lua 185/185, tcl 342/342, tcl-conf 3/4 — all = baseline. |
+| 4 — pratt.sx (lua + prolog) | [in-progress] | — | — |
+| 5 — ast.sx (lua + prolog) | [ ] | — | — |
+| 6 — match.sx (haskell + prolog) | [ ] | — | — |
+| 7 — layout.sx (haskell + synthetic) | [ ] | — | — |
+| 8 — hm.sx (haskell + TBD) | [ ] | — | — |
+
+---
+
+## Rules
+
+- **Branch:** `architecture`. Commit locally. **Never push.** **Never touch `main`.**
+- **Scope:** ONLY `lib/guest/**`, `lib/{lua,prolog,haskell,common-lisp,tcl}/**` (canaries + extraction targets), `plans/lib-guest.md`, `plans/agent-briefings/lib-guest-loop.md`. No `spec/`, `hosts/`, `web/`, `shared/`.
+- **SX files:** `sx-tree` MCP tools only. `sx_validate` after every edit.
+- **No raw dune.** Use `sx_build target="ocaml"` MCP tool.
+- **Two-language rule:** never merge an extraction until two guests consume it (Step 8 excepted with explicit note).
+- **Conformance baseline is the bar.** Any port whose scoreboard regresses by ≥1 test → revert, mark blocked, move on.
+- **Substrate change → re-snapshot.** If `spec/` or `hosts/` changes underneath this loop, re-run Step 0 before continuing.
+- **One step per code commit.** Plan updates as a separate commit. Short message with delta.
+- **No alias chains** to paper over drift between extraction and consumer (`feedback_no_alias_bloat`).
+- **Partial extraction is OK** if the canary works and a pending consumer is identified — mark `[partial — pending <consumer>]`.
+- **Hard timeout:** if stuck >45 min on a step, mark `blocked (<reason>)` and move on.

plans/sx-improvements.md

@@ -3,6 +3,17 @@
 Language-building improvements to the SX evaluator, compiler, and standard library.
 Ordered by impact and prerequisite chain. Each step is one loop commit.
 
+## Roadmap complete (2026-05-07)
+
+All 14 steps shipped in 14 commits on the `architecture` branch. Phase 1 (bug fixes:
+JIT closures, letrec+resume), Phase 2 (E38 source info — subsumed by tokenizer fix),
+Phase 3 (native ADTs: AdtValue, define-type, match, exhaustiveness on both hosts),
+Phase 4 (parser/compiler plugin registry + worker), Phase 5 (perf: frame-records via
+prim_call fast path, buffer-based serializer, JIT inline opcodes). Cumulative
+performance wins on hot benchmarks: CEK fib -66% / loop -69% / reduce -86% (Step 12);
+inspect tree-d10 -80% / dict-1000 -61% (Step 13); VM JIT fib -69% / loop -62% / sum
+-50% / count-lt -38% / count-eq -58% (Step 14). Test suite: 4550/4550 OCaml.
+
 Branch: `architecture`. SX files via `sx-tree` MCP only. Never edit generated files.
 
 ## Current baseline (2026-05-06)
@@ -74,6 +85,10 @@ Mirror to `shared/static/wasm/sx/hs-parser.sx`.
 
 **Verify:** All 4 `hs-upstream-core/sourceInfo` tests pass.
 
+**Outcome:** Subsumed by Step 3. Once tokens carried `:end` and `:line`, the existing
+parser plumbing (`link-next-cmds` for `:next`, `:true-branch` extraction in `parse-cmd`)
+worked end-to-end. All 4 `hs-upstream-core/sourceInfo` tests pass with no parser changes.
+
 ---
 
 ## Phase 3 — Native ADTs (`define-type` / `match`)
@@ -122,12 +137,34 @@ Both OCaml and JS `MatchFrame`: replace linear binding with recursive
 
 Extend `spec/tests/test-adt.sx` with nested pattern tests.
 
+**Outcome:** No host-side changes needed. The spec-level `match-pattern` function
+in `spec/evaluator.sx` (≈line 2835) already recurses through constructor
+sub-patterns via the dict-shape shim (`(get value :_adt|:_ctor|:_fields)`),
+handles `_` wildcards, literals, and variable bindings. Step 7 added 8 new
+deftests to `spec/tests/test-adt.sx` covering: nested constructor sanity,
+nested constructor with field binding, nested wildcard, nested literal
+equality, nested literal-vs-var clause fall-through, deeply nested constructors,
+mixed bind+wildcard, and nested ctor fail-through. Both hosts: +8 tests pass,
+zero regressions (OCaml 4532→4540, JS 2578→2586).
+
 ### Step 8: Exhaustiveness warnings (Phase 6c)
 
 `_adt_registry: type_name → [ctor_names]` global populated by `define-type`.
 On first non-exhaustive `match` evaluation: `console.warn("[sx] match: non-exhaustive …")`.
 No error — warning only.
 
+**Outcome:** `host-warn` primitive added on both hosts (OCaml `prerr_endline`,
+JS `console.warn`). Spec-level helpers `match-clause-is-else?`,
+`match-clause-ctor-name`, `match-warn-non-exhaustive`,
+`match-check-exhaustiveness` added in `spec/evaluator.sx` and
+called from `step-sf-match`. `*adt-warned*` env-bound dict used to
+dedupe warnings per (type, missing-set). The OCaml `step_sf_match`
+in `hosts/ocaml/lib/sx_ref.ml` was hand-patched (not retranspiled)
+because `sx_ref.ml` retranspilation drops several preamble fixes;
+the spec changes still flow to JS via `sx_build target="js"`. Both
+hosts emit identical warnings (e.g. `[sx] match: non-exhaustive — Maybe: missing Nothing`).
+5 new tests added. OCaml: 4540 → 4545. JS: 2586 → 2591. Zero regressions.
+
 ---
 
 ## Phase 4 — Plugin / extension system
@@ -163,38 +200,108 @@ These are incremental and can interleave with other phases.
 tagged variant lists. Eliminates allocation pressure from list construction per frame.
 Profile before/after on a tight-loop benchmark.
 
+**Outcome:** Frames were already records (`cek_frame` in `sx_types.ml`) — the actual
+hot-path bottleneck was `prim_call "=" [...]` in `step_continue`/`step_eval` dispatch:
+each step did a Hashtbl lookup + 2x list cons + pattern match per comparison. Added a
+fast path in `prim_call` (sx_runtime.ml) for `=`, `<`, `>`, `<=`, `>=`, `empty?`,
+`first`, `rest`, `len` that skips the table lookup entirely. Also inlined `_fast_eq`
+for the common scalar-equality cases that dominate frame-type dispatch. Median
+improvements (bench_cek.exe, 7 runs):
+
+| Benchmark | Before | After | Change |
+|-----------|--------|-------|--------|
+| fib(18) | 2789ms | 941ms | -66% |
+| loop(5000) | 2018ms | 620ms | -69% |
+| map sq(1000) | 108ms | 48ms | -56% |
+| reduce + (2000) | 72ms | 10ms | -86% |
+| let-heavy(2000) | 491ms | 271ms | -45% |
+
+Tests: 4545 passing (unchanged baseline), 1339 failing (unchanged baseline).
+Benchmark binary: `bin/bench_cek.exe`.
+
 ### Step 13: Buffer primitive for string building
 
 Add `make-buffer`, `buffer-append!`, `buffer->string` primitives. Eliminates the
 `(str a b c d ...)` quadratic allocation pattern in serializers and renderers.
 Wire into `sx_primitives.ml` and the JS platform.
 
+**Outcome:** Short aliases `make-buffer`/`buffer?`/`buffer-append!`/`buffer->string`/
+`buffer-length` added on both hosts, sharing the existing `StringBuffer` value type.
+`buffer-append!` accepts any value (auto-coerces non-strings via inspect), unlike
+`string-buffer-append!` which is strict. The hot path converted was the OCaml
+host-internal `inspect` function in `sx_types.ml`: rewrote from `(... ^ String.concat
+" " (List.map inspect items) ^ ...)` (which allocates O(n) intermediate strings per
+recursion level) to a single shared `Buffer.t` accumulator (`inspect_into buf v`
+walks the value tree appending into one buffer). `inspect` is called by
+`sx-serialize` on both spec and host paths, plus error-path formatting.
+
+Median improvements (`bin/bench_inspect.exe`, best of 3 runs of 9-run min):
+
+| Benchmark         | Baseline (best min) | Buffer (best min) | Change |
+|-------------------|--------------------:|------------------:|-------:|
+| tree-d8 (75KB)    |  5.31ms             |  1.30ms           | -76%   |
+| tree-d10 (679KB)  | 81.89ms             | 16.02ms           | -80%   |
+| dict-1000         |  0.80ms             |  0.31ms           | -61%   |
+| list-2000         |  0.74ms             |  0.33ms           | -55%   |
+
+5 new tests in `spec/tests/test-string-buffer.sx` covering the new aliases (incl
+non-string coercion and interop with the existing `string-buffer-*` API).
+OCaml: 4545 → 4550. JS: 2591 → 2596. Zero regressions.
+
 ### Step 14: Inline common primitives in JIT
 
 `hosts/ocaml/lib/sx_vm.ml`: add `OP_ADD`, `OP_SUB`, `OP_EQ`, `OP_APPEND` specialised
 opcodes that skip the primitive table lookup for the most common calls. Compiler emits
 these when operands are known numbers/lists.
 
+**Outcome:** The opcodes (`OP_ADD`=160, `OP_SUB`=161, `OP_MUL`=162, `OP_DIV`=163,
+`OP_EQ`=164, `OP_LT`=165, `OP_GT`=166, `OP_NOT`=167, `OP_LEN`=168, `OP_FIRST`=169,
+`OP_REST`=170, `OP_CONS`=172) already existed in `sx_vm.ml` but the compiler never
+emitted them — every primitive call went through `OP_CALL_PRIM` (52) with a Hashtbl
+lookup. Two changes:
+
+1. **`lib/compiler.sx` `compile-call`**: when the primitive name + arity matches a
+   specialized opcode, emit the 1-byte opcode (no name index, no argc operand)
+   instead of the 4-byte CALL_PRIM. Bytecode for `fib` shrank from 50→38 bytes.
+2. **`hosts/ocaml/lib/sx_vm.ml` opcode bodies**: extended `OP_ADD/SUB/MUL/DIV` to
+   handle `Integer + Integer` (was `Number + Number` only — defaulted to Hashtbl
+   for the common integer case). Inlined `OP_EQ` to call `Sx_runtime._fast_eq`
+   directly. Inlined `OP_LT/GT` integer + mixed-numeric comparisons.
+
+Median improvements (`bin/bench_vm.exe`, best of 3 runs of 9-min):
+
+| Benchmark        | Baseline (best min) | After (best min) | Change |
+|------------------|---------------------|------------------|-------:|
+| fib(22)          | 107.87ms            |  33.13ms         |  -69%  |
+| loop(200000)     | 429.64ms            | 161.16ms         |  -62%  |
+| sum-to(50000)    |  72.85ms            |  36.74ms         |  -50%  |
+| count-lt(20000)  |  28.44ms            |  17.58ms         |  -38%  |
+| count-eq(20000)  |  37.23ms            |  15.46ms         |  -58%  |
+
+Tests: 4550/4550 passing (unchanged baseline). Zero regressions. Benchmark binary:
+`bin/bench_vm.exe` (loads `lib/compiler.sx` via CEK, JIT-compiles each test fn,
+measures `Sx_vm.call_closure` time on the compiled `vm_closure`).
+
 ---
 
 ## Progress log
 
 | Step | Status | Commit |
 |------|--------|--------|
-| 1 — JIT combinator bug | [ ] | — |
-| 2 — letrec+resume | [ ] | — |
-| 3 — tokenizer :end/:line | [ ] | — |
-| 4 — parser spans complete | [ ] | — |
-| 5 — OCaml AdtValue + define-type + match | [ ] | — |
-| 6 — JS AdtValue + define-type + match | [ ] | — |
-| 7 — nested patterns | [ ] | — |
-| 8 — exhaustiveness warnings | [ ] | — |
-| 9 — parser feature registry | [ ] | — |
-| 10 — compiler + as converter registry | [ ] | — |
-| 11 — plugin migration + worker | [ ] | — |
-| 12 — frame records | [ ] | — |
-| 13 — buffer primitive | [ ] | — |
-| 14 — inline primitives JIT | [ ] | — |
+| 1 — JIT combinator bug | [x] | 882a4b76 |
+| 2 — letrec+resume | [x] | e80e655b |
+| 3 — tokenizer :end/:line | [x] | 023bc2d8 |
+| 4 — parser spans complete | [x] | b7ad5152 (subsumed by 023bc2d8) |
+| 5 — OCaml AdtValue + define-type + match | [x] | 1f49242a |
+| 6 — JS AdtValue + define-type + match | [x] | fc8a3916 |
+| 7 — nested patterns | [x] | 0679edf5 |
+| 8 — exhaustiveness warnings | [x] | 6d391119 |
+| 9 — parser feature registry | [x] | 986d6411 |
+| 10 — compiler + as converter registry | [x] | d22361e4 |
+| 11 — plugin migration + worker | [x] | 6328b810 |
+| 12 — frame records | [x] | a66c0f66 (fib -66%, loop -69%, reduce -86% via prim_call fast path) |
+| 13 — buffer primitive | [x] | 0e022ab6 (inspect rewrite: tree-d10 -80%, tree-d8 -76%, dict-1000 -61%, list-2000 -55%) |
+| 14 — inline primitives JIT | [x] | 6c171d49 (fib -69%, loop -62%, sum -50%, count-lt -38%, count-eq -58% via specialized opcode emission) |
 
 ---
 

plans/tcl-sx-completion.md

@@ -132,6 +132,31 @@ architectural improvement worth doing when the moment is right.
 
 ---
 
+## Phase 5 — Channel I/O (random access + non-blocking) ✓
+
+Real Tcl channel commands replacing the previous stubs. SX gained 11 channel
+primitives in `sx_primitives.ml` (using `Unix.openfile` + `Unix.read`/`write`/
+`lseek`/`set_nonblock`). Tcl `open`/`close`/`read`/`gets`/`puts`/`seek`/`tell`/
+`eof`/`flush`/`fconfigure` now wrap them.
+
+| Status | Work | Unlocks in Tcl |
+|---|---|---|
+| [x] | `channel-open`, `channel-close` | `open` returns "fileN", `close` actually closes |
+| [x] | `channel-read`, `channel-read-line`, `channel-write` | `read`/`gets`/`puts` to/from real files |
+| [x] | `channel-seek`, `channel-tell` | random access — `seek $c offset start\|current\|end`, `tell` |
+| [x] | `channel-eof?`, `channel-flush` | proper EOF detection, no-op flush |
+| [x] | `channel-blocking?`, `channel-set-blocking!` | `fconfigure $c -blocking 0\|1` |
+
+Modes supported: `r`, `w`, `a`, `r+`, `w+`, `a+`. Whence: `start`, `current`, `end`.
+
+`puts` now detects channel argument (string starting with "file") and dispatches
+to `channel-write`; otherwise writes to `interp :output` as before.
+
+**Total: ~half day. 7 new idiom tests covering write+read, gets-loop, seek/tell,
+eof-after-read, append mode, seek-to-end, fconfigure-blocking.**
+
+---
+
 ## Suggested order
 
 1. **Phase 1** — immediate Tcl wins, zero risk, proves the approach
@@ -148,6 +173,7 @@ becomes a lasting SX contribution used by every future hosted language.
 
 _Newest first._
 
+- 2026-05-07: Phase 5 channel I/O — 11 SX primitives (channel-open/close/read/read-line/write/flush/seek/tell/eof?/blocking?/set-blocking!) wrapping Unix.openfile/read/write/lseek/set_nonblock; tcl-cmd-open/close/read/gets-chan/seek/tell/flush rewritten + new tcl-cmd-fconfigure; tcl-cmd-puts dispatches on "fileN" arg; gets registration fixed; +7 idiom tests; 349/349 green
 - 2026-05-06: Phase 4 env-as-value — current-env (special form via Sx_ref.register_special_form), eval-in-env (primitive in setup_evaluator_bridge), env-lookup + env-extend (in setup_env_operations); 5 idiom tests; 342/342 green
 - 2026-05-06: Phase 3 OCaml primitives — file-read/write/append/exists?/glob + clock-seconds/milliseconds/format in sx_primitives.ml + unix dep; tcl-cmd-clock/file wired up; 337/337 green
 - 2026-05-06: Phase 2 coroutine rewrite — `tcl-cmd-coroutine` now creates a `make-fiber`; `tcl-cmd-yield` calls `:coro-yield-fn` (threaded through interp); true suspension; 337/337 green
@@ -162,7 +188,7 @@ _Newest first._
 ## What stays out of scope
 
 - `package require` of binary loadables
-- Full `clock format` locale support  
+- Full `clock format` locale support
 - Tk / GUI
 - Threads (mapped to coroutines only, as planned)
-- Full POSIX file I/O (seek/tell/async) — stubs are fine
+- `chan event` / `fileevent` — event-driven I/O callbacks (Phase 5 covers blocking + non-blocking flag, but no event loop dispatch)

shared/static/wasm/sx/hs-compiler.sx

@@ -7,6 +7,22 @@
 ;;   (hs-to-sx (hs-compile "on click add .active to me"))
 ;;   → (hs-on me "click" (fn (event) (dom-add-class me "active")))
 
+;; ── Compiler plugin registries ────────────────────────────────────
+;; Plugins call (hs-register-command! "head" compile-fn) and
+;; (hs-register-converter! "TypeName" convert-fn) at load time. Both
+;; compile-fn and convert-fn receive a ctx dict (built per call inside
+;; hs-to-sx) exposing :hs-to-sx for recursion plus the AST node fields
+;; the dispatch needs. Compile-fn returns an SX expression.
+(begin
+  (define _hs-command-registry {})
+  (define _hs-converter-registry {})
+  (define
+    hs-register-command!
+    (fn (name compile-fn) (dict-set! _hs-command-registry name compile-fn)))
+  (define
+    hs-register-converter!
+    (fn (name convert-fn) (dict-set! _hs-converter-registry name convert-fn))))
+
 (define
   hs-to-sx
   (let
@@ -48,6 +64,15 @@
                             prop
                             value))
                         (list (quote hs-query-all) (nth base-ast 1))))
+                    ((and (list? base-ast) (= (first base-ast) (quote query)))
+                      (list
+                        (quote dom-set-prop)
+                        (list
+                          (quote hs-named-target)
+                          (nth base-ast 1)
+                          (list (quote hs-query-first) (nth base-ast 1)))
+                        prop
+                        value))
                     ((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
                       (let
                         ((inner (nth base-ast 1))
@@ -221,7 +246,8 @@
                   having-info
                   of-filter-info
                   count-filter-info
-                  elsewhere?)
+                  elsewhere?
+                  or-sources)
                 (cond
                   ((<= (len items) 1)
                     (let
@@ -279,7 +305,27 @@
                                                 having-info
                                                 (get having-info "threshold")
                                                 nil))))
-                                        (true on-call))))))))))))
+                                        (true
+                                          (if
+                                            or-sources
+                                            (cons
+                                              (quote do)
+                                              (cons
+                                                on-call
+                                                (map
+                                                  (fn
+                                                    (pair)
+                                                    (list
+                                                      (quote hs-on)
+                                                      (if
+                                                        (nth pair 1)
+                                                        (hs-to-sx
+                                                          (nth pair 1))
+                                                        (quote me))
+                                                      (first pair)
+                                                      handler))
+                                                  or-sources)))
+                                            on-call)))))))))))))
                   ((= (first items) :from)
                     (scan-on
                       (rest (rest items))
@@ -291,7 +337,8 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :filter)
                     (scan-on
                       (rest (rest items))
@@ -303,7 +350,8 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :every)
                     (scan-on
                       (rest (rest items))
@@ -315,7 +363,8 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :catch)
                     (scan-on
                       (rest (rest items))
@@ -327,7 +376,8 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :finally)
                     (scan-on
                       (rest (rest items))
@@ -339,7 +389,8 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :having)
                     (scan-on
                       (rest (rest items))
@@ -351,7 +402,8 @@
                       (nth items 1)
                       of-filter-info
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :of-filter)
                     (scan-on
                       (rest (rest items))
@@ -363,7 +415,8 @@
                       having-info
                       (nth items 1)
                       count-filter-info
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :count-filter)
                     (scan-on
                       (rest (rest items))
@@ -375,7 +428,8 @@
                       having-info
                       of-filter-info
                       (nth items 1)
-                      elsewhere?))
+                      elsewhere?
+                      or-sources))
                   ((= (first items) :elsewhere)
                     (scan-on
                       (rest (rest items))
@@ -387,6 +441,20 @@
                       having-info
                       of-filter-info
                       count-filter-info
+                      (nth items 1)
+                      or-sources))
+                  ((= (first items) :or-sources)
+                    (scan-on
+                      (rest (rest items))
+                      source
+                      filter
+                      every?
+                      catch-info
+                      finally-info
+                      having-info
+                      of-filter-info
+                      count-filter-info
+                      elsewhere?
                       (nth items 1)))
                   (true
                     (scan-on
@@ -399,8 +467,9 @@
                       having-info
                       of-filter-info
                       count-filter-info
-                      elsewhere?)))))
-            (scan-on (rest parts) nil nil false nil nil nil nil nil false)))))
+                      elsewhere?
+                      or-sources)))))
+            (scan-on (rest parts) nil nil false nil nil nil nil nil false nil)))))
     (define
       emit-send
       (fn
@@ -899,6 +968,22 @@
           (true
             (let
               ((head (first ast)))
+              (let
+                ((reg-cmd-fn (dict-get _hs-command-registry (str head)))
+                  (reg-conv-fn
+                    (and
+                      (= head (quote as))
+                      (dict-get _hs-converter-registry (nth ast 2)))))
+                (cond
+                  (reg-conv-fn
+                    (reg-conv-fn
+                      {:hs-to-sx hs-to-sx
+                       :ast ast
+                       :value-ast (nth ast 1)
+                       :type-name (nth ast 2)}))
+                  (reg-cmd-fn
+                    (reg-cmd-fn {:hs-to-sx hs-to-sx :ast ast :head head}))
+                  (true
               (cond
                 ((= head (quote __bind-from-detail__))
                   (let
@@ -2614,7 +2699,7 @@
                           (quote begin)
                           (list (quote set!) (quote it) (quote __hs-js))
                           (quote __hs-js))))))
-                (true ast)))))))))
+                (true ast))))))))))))
 
 ;; ── Convenience: source → SX ─────────────────────────────────
 (define

shared/static/wasm/sx/hs-parser.sx

@@ -3,6 +3,17 @@
 ;; Input:  list of {:type T :value V :pos P} tokens from hs-tokenize
 ;; Output: SX AST forms that map to runtime primitives
 
+;; ── Feature plugin registry ───────────────────────────────────────
+;; Plugins call (hs-register-feature! "name" parse-fn) at load time.
+;; parse-fn is (fn (ctx) ...) where ctx is a dict exposing parser
+;; helpers (:adv! :tp-val :tp-type :parse-cmd-list ...) and the
+;; built-in parse-X-feat dispatch fns.
+(begin
+  (define _hs-feature-registry {})
+  (define
+    hs-register-feature!
+    (fn (name parse-fn) (dict-set! _hs-feature-registry name parse-fn))))
+
 ;; ── Parser entry point ────────────────────────────────────────────
 (define
   hs-parse
@@ -3015,7 +3026,7 @@
         (fn
           ()
           (let
-            ((every? (match-kw "every")) (first? (match-kw "first")))
+            ((first? (match-kw "first")))
             (let
               ((event-name (parse-compound-event-name)))
               (let
@@ -3028,7 +3039,27 @@
                       ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
                       (let
                         ((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
-                          (source (if (match-kw "from") (parse-expr) nil)))
+                          (source
+                            (if
+                              (match-kw "from")
+                              (parse-collection
+                                (parse-cmp
+                                  (parse-arith (parse-poss (parse-atom)))))
+                              nil)))
+                        (define
+                          collect-ors!
+                          (fn
+                            (acc)
+                            (if
+                              (match-kw "or")
+                              (let
+                                ((or-evt (parse-compound-event-name))
+                                  (or-src
+                                    (if (match-kw "from") (parse-expr) nil)))
+                                (collect-ors!
+                                  (append acc (list (list or-evt or-src)))))
+                              acc)))
+                        (define or-sources (collect-ors! (list)))
                         (let
                           ((h-margin nil) (h-threshold nil))
                           (define
@@ -3059,40 +3090,44 @@
                               (= (tp-val) "queue"))
                             (do (adv!) (adv!)))
                           (let
-                            ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
+                            ((every? (match-kw "every")))
                             (let
-                              ((body (parse-cmd-list)))
+                              ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
                               (let
-                                ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
-                                  (finally-clause
-                                    (if
-                                      (match-kw "finally")
-                                      (parse-cmd-list)
-                                      nil)))
-                                (match-kw "end")
+                                ((body (parse-cmd-list)))
                                 (let
-                                  ((parts (list (quote on) event-name)))
+                                  ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
+                                    (finally-clause
+                                      (if
+                                        (match-kw "finally")
+                                        (parse-cmd-list)
+                                        nil)))
+                                  (match-kw "end")
                                   (let
-                                    ((parts (if every? (append parts (list :every true)) parts)))
+                                    ((parts (list (quote on) event-name)))
                                     (let
-                                      ((parts (if flt (append parts (list :filter flt)) parts)))
+                                      ((parts (if every? (append parts (list :every true)) parts)))
                                       (let
-                                        ((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
+                                        ((parts (if flt (append parts (list :filter flt)) parts)))
                                         (let
-                                          ((parts (if source (append parts (list :from source)) parts)))
+                                          ((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
                                           (let
-                                            ((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
+                                            ((parts (if source (append parts (list :from source)) parts)))
                                             (let
-                                              ((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
+                                              ((parts (if (> (len or-sources) 0) (append parts (list :or-sources or-sources)) parts)))
                                               (let
-                                                ((parts (if having (append parts (list :having having)) parts)))
+                                                ((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
                                                 (let
-                                                  ((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
+                                                  ((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
                                                   (let
-                                                    ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
+                                                    ((parts (if having (append parts (list :having having)) parts)))
                                                     (let
-                                                      ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
-                                                      parts))))))))))))))))))))))))
+                                                      ((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
+                                                      (let
+                                                        ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
+                                                        (let
+                                                          ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
+                                                          parts))))))))))))))))))))))))))
       (define
         parse-init-feat
         (fn
@@ -3207,6 +3242,24 @@
                       (do
                         (match-kw "end")
                         (list (quote socket) name-path url timeout on-message))))))))))
+      (define
+        parse-feat-ctx
+        (fn
+          ()
+          {:adv! adv!
+           :tp-val tp-val
+           :tp-type tp-type
+           :at-end? at-end?
+           :parse-cmd-list parse-cmd-list
+           :parse-expr parse-expr
+           :parse-on-feat parse-on-feat
+           :parse-init-feat parse-init-feat
+           :parse-def-feat parse-def-feat
+           :parse-behavior-feat parse-behavior-feat
+           :parse-live-feat parse-live-feat
+           :parse-when-feat parse-when-feat
+           :parse-bind-feat parse-bind-feat
+           :parse-socket-feat parse-socket-feat}))
       (define
         parse-feat
         (fn
@@ -3237,29 +3290,23 @@
                         ((unit (tp-val)))
                         (do (adv!) (list (quote string-postfix) inner unit)))
                       inner))))
-              ((= val "on") (do (adv!) (parse-on-feat)))
-              ((= val "init") (do (adv!) (parse-init-feat)))
-              ((= val "def") (do (adv!) (parse-def-feat)))
-              ((= val "behavior") (do (adv!) (parse-behavior-feat)))
-              ((= val "live") (do (adv!) (parse-live-feat)))
-              ((= val "when") (do (adv!) (parse-when-feat)))
-              ((= val "worker")
-                (error
-                  "worker plugin is not installed — see https://hyperscript.org/features/worker"))
-              ((= val "bind") (do (adv!) (parse-bind-feat)))
-              ((= val "socket") (do (adv!) (parse-socket-feat)))
               (true
-                (if
-                  (= (tp-type) "keyword")
-                  (parse-cmd-list)
-                  (let
-                    ((saved-p p))
-                    (let
-                      ((expr (guard (_e (true nil)) (parse-expr))))
-                      (if
-                        (and expr (at-end?))
-                        expr
-                        (do (set! p saved-p) (parse-cmd-list)))))))))))
+                (let
+                  ((reg-fn (dict-get _hs-feature-registry val)))
+                  (if
+                    reg-fn
+                    (reg-fn (parse-feat-ctx))
+                    (if
+                      (= (tp-type) "keyword")
+                      (parse-cmd-list)
+                      (let
+                        ((saved-p p))
+                        (let
+                          ((expr (guard (_e (true nil)) (parse-expr))))
+                          (if
+                            (and expr (at-end?))
+                            expr
+                            (do (set! p saved-p) (parse-cmd-list)))))))))))))
       (define
         coll-feats
         (fn
@@ -3302,3 +3349,33 @@
       (let
         ((result (hs-parse (hs-tokenize src) src)))
         (do (set! hs-span-mode false) result)))))
+
+;; ── Built-in feature registrations ────────────────────────────────
+;; These mirror the original parse-feat cond branches. Registering at
+;; load time means plugins can override or extend; ctx exposes the
+;; parser internals each fn needs.
+(begin
+  (hs-register-feature!
+    "on"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-on-feat)))))
+  (hs-register-feature!
+    "init"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-init-feat)))))
+  (hs-register-feature!
+    "def"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-def-feat)))))
+  (hs-register-feature!
+    "behavior"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-behavior-feat)))))
+  (hs-register-feature!
+    "live"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-live-feat)))))
+  (hs-register-feature!
+    "when"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-when-feat)))))
+  (hs-register-feature!
+    "bind"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-bind-feat)))))
+  (hs-register-feature!
+    "socket"
+    (fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-socket-feat))))))

shared/static/wasm/sx/hs-prolog.sx

@@ -0,0 +1,24 @@
+;; lib/hyperscript/plugins/prolog.sx — Prolog plugin
+;;
+;; Provides the `prolog` HS-level function. Replaces the ad-hoc
+;; hs-prolog-hook / hs-set-prolog-hook! slots that previously lived in
+;; lib/hyperscript/runtime.sx (nodes 140–142 of the plugin design doc).
+;;
+;; Two-step wiring preserves the original API:
+;;   1. lib/prolog/runtime.sx loaded → defines pl-query-one
+;;   2. lib/prolog/hs-bridge.sx (or this file's auto-wire) calls
+;;      (hs-set-prolog-hook! (fn (db goal) (not (= nil (pl-query-one db goal)))))
+;; If neither is loaded, calling (prolog db goal) raises a clear error.
+
+(define hs-prolog-hook nil)
+
+(define hs-set-prolog-hook! (fn (f) (set! hs-prolog-hook f)))
+
+(define
+  prolog
+  (fn
+    (db goal)
+    (if
+      (nil? hs-prolog-hook)
+      (raise "prolog hook not installed")
+      (hs-prolog-hook db goal))))

shared/static/wasm/sx/hs-prolog.sxbc

@@ -0,0 +1,3 @@
+(sxbc 1 "b07521593ca7ed98"
+  (code
+    :constants ("hs-prolog-hook" "hs-set-prolog-hook!" {:upvalue-count nil :arity nil :constants ("hs-prolog-hook") :bytecode (nil nil nil nil nil nil)} "prolog" {:upvalue-count nil :arity nil :constants ("nil?" "hs-prolog-hook" "prolog hook not installed") :bytecode (nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)}) :bytecode (nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)))

shared/static/wasm/sx/hs-runtime.sx

@@ -12,29 +12,6 @@
 
 ;; Register an event listener. Returns unlisten function.
 ;; (hs-on target event-name handler) → unlisten-fn
-(begin
-  (define _hs-config-log-all false)
-  (define _hs-log-captured (list))
-  (define
-    hs-set-log-all!
-    (fn (flag) (set! _hs-config-log-all (if flag true false))))
-  (define hs-get-log-captured (fn () _hs-log-captured))
-  (define
-    hs-clear-log-captured!
-    (fn () (begin (set! _hs-log-captured (list)) nil)))
-  (define
-    hs-log-event!
-    (fn
-      (msg)
-      (when
-        _hs-config-log-all
-        (begin
-          (set! _hs-log-captured (append _hs-log-captured (list msg)))
-          (host-call (host-global "console") "log" msg)
-          nil)))))
-
-;; Register for every occurrence (no queuing — each fires independently).
-;; Stock hyperscript queues by default; "every" disables queuing.
 (define
   hs-each
   (fn
@@ -45,6 +22,12 @@
 ;; (hs-init thunk) — called at element boot time
 (define meta (host-new "Object"))
 
+;; Run an initializer function immediately.
+;; (hs-init thunk) — called at element boot time
+(define
+  hs-on-every
+  (fn (target event-name handler) (dom-listen target event-name handler)))
+
 ;; ── Async / timing ──────────────────────────────────────────────
 
 ;; Wait for a duration in milliseconds.
@@ -68,13 +51,20 @@
   hs-on
   (fn
     (target event-name handler)
-    (let
-      ((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation")))))))
+    (when
+      (not (nil? target))
       (let
-        ((unlisten (dom-listen target event-name wrapped))
-          (prev (or (dom-get-data target "hs-unlisteners") (list))))
-        (dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
-        unlisten))))
+        ((me-el (host-get (host-global "window") "__hs_current_me")))
+        (let
+          ((wrapped (fn (event) (when (not (and me-el (not (hs-ref-eq me-el target)) (nil? (host-get me-el "parentElement")))) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation"))))))))
+          (let
+            ((unlisten (dom-listen target event-name wrapped))
+              (prev (or (dom-get-data target "hs-unlisteners") (list))))
+            (dom-set-data
+              target
+              "hs-unlisteners"
+              (append prev (list unlisten)))
+            unlisten))))))
 
 ;; Wait for CSS transitions/animations to settle on an element.
 (define
@@ -279,7 +269,8 @@
             (when with-cls (dom-remove-class target with-cls))))
         (let
           ((attr-val (if (> (len extra) 0) (first extra) nil))
-            (with-val (if (> (len extra) 1) (nth extra 1) nil)))
+            (with-val
+              (if (> (len extra) 1) (nth extra 1) nil)))
           (do
             (for-each
               (fn
@@ -503,7 +494,10 @@
           ((i (if (< idx 0) (+ n idx) idx)))
           (cond
             ((or (< i 0) (>= i n)) target)
-            (true (concat (slice target 0 i) (slice target (+ i 1) n))))))
+            (true
+              (concat
+                (slice target 0 i)
+                (slice target (+ i 1) n))))))
       (do
         (when
           target
@@ -603,6 +597,11 @@
       ((w (host-global "window")))
       (if w (if (host-call w "confirm" msg) yes-val no-val) no-val))))
 
+
+;; ── Transition ──────────────────────────────────────────────────
+
+;; Transition a CSS property to a value, optionally with duration.
+;; (hs-transition target prop value duration)
 (define
   hs-answer-alert
   (fn
@@ -993,7 +992,7 @@
               (host-get value "outerHTML")
               (str value))))
         (true nil)))))
-
+;; Collection: joined by
 (define
   hs-sender
   (fn
@@ -1210,7 +1209,14 @@
       ((= type-name "Array") (if (list? value) value (list value)))
       ((= type-name "HTML")
         (cond
-          ((list? value) (join "" (map (fn (x) (str x)) value)))
+          ((list? value)
+            (join
+              ""
+              (map
+                (fn
+                  (x)
+                  (if (hs-element? x) (host-get x "outerHTML") (str x)))
+                value)))
           ((hs-element? value) (host-get value "outerHTML"))
           (true (str value))))
       ((= type-name "JSON")
@@ -1261,7 +1267,25 @@
               ((factor (pow 10 digits)))
               (str (/ (floor (+ (* num factor) 0.5)) factor))))))
       ((= type-name "Selector") (str value))
-      ((= type-name "Fragment") value)
+      ((= type-name "Fragment")
+        (let
+          ((frag (host-call (dom-document) "createDocumentFragment")))
+          (do
+            (for-each
+              (fn
+                (item)
+                (if
+                  (hs-element? item)
+                  (dom-append frag item)
+                  (let
+                    ((tmp (dom-create-element "div")))
+                    (do
+                      (dom-set-inner-html tmp (str item))
+                      (for-each
+                        (fn (k) (dom-append frag k))
+                        (host-get tmp "children"))))))
+              (if (list? value) value (list value)))
+            frag)))
       ((= type-name "Values") (hs-as-values value))
       ((= type-name "Keys")
         (if
@@ -1599,10 +1623,14 @@
                 ((ch (substring sel i (+ i 1))))
                 (cond
                   ((= ch ".")
-                    (do (flush!) (set! mode "class") (walk (+ i 1))))
+                    (do
+                      (flush!)
+                      (set! mode "class")
+                      (walk (+ i 1))))
                   ((= ch "#")
                     (do (flush!) (set! mode "id") (walk (+ i 1))))
-                  (true (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
+                  (true
+                    (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
         (walk 0)
         (flush!)
         {:tag tag :classes classes :id id}))))
@@ -1700,6 +1728,7 @@
   hs-strict-eq
   (fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
 
+
 (define
   hs-id=
   (fn
@@ -1776,7 +1805,10 @@
       ((and (dict? a) (dict? b))
         (let
           ((pos (host-call a "compareDocumentPosition" b)))
-          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
+          (if
+            (number? pos)
+            (not (= 0 (mod (/ pos 4) 2)))
+            false)))
       (true (< (str a) (str b))))))
 
 (define
@@ -1897,7 +1929,10 @@
       ((and (dict? a) (dict? b))
         (let
           ((pos (host-call a "compareDocumentPosition" b)))
-          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
+          (if
+            (number? pos)
+            (not (= 0 (mod (/ pos 4) 2)))
+            false)))
       (true (< (str a) (str b))))))
 
 (define
@@ -1950,7 +1985,9 @@
 
 (define
   hs-morph-char
-  (fn (s p) (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
+  (fn
+    (s p)
+    (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
 
 (define
   hs-morph-index-from
@@ -1978,7 +2015,10 @@
         (q)
         (let
           ((c (hs-morph-char s q)))
-          (if (and c (< (index-of stop c) 0)) (loop (+ q 1)) q))))
+          (if
+            (and c (< (index-of stop c) 0))
+            (loop (+ q 1))
+            q))))
     (let ((e (loop p))) (list (substring s p e) e))))
 
 (define
@@ -2020,7 +2060,9 @@
                                 (append
                                   acc
                                   (list
-                                    (list name (substring s (+ p4 1) close)))))))
+                                    (list
+                                      name
+                                      (substring s (+ p4 1) close)))))))
                           ((= c2 "'")
                             (let
                               ((close (hs-morph-index-from s "'" (+ p4 1))))
@@ -2030,7 +2072,9 @@
                                 (append
                                   acc
                                   (list
-                                    (list name (substring s (+ p4 1) close)))))))
+                                    (list
+                                      name
+                                      (substring s (+ p4 1) close)))))))
                           (true
                             (let
                               ((r2 (hs-morph-read-until s p4 " \t\n/>")))
@@ -2114,7 +2158,9 @@
               (for-each
                 (fn
                   (c)
-                  (when (> (string-length c) 0) (dom-add-class el c)))
+                  (when
+                    (> (string-length c) 0)
+                    (dom-add-class el c)))
                 (split v " ")))
             ((and keep-id (= n "id")) nil)
             (true (dom-set-attr el n v)))))
@@ -2215,7 +2261,8 @@
           ((parts (split resolved ":")))
           (let
             ((prop (first parts))
-              (val (if (> (len parts) 1) (nth parts 1) nil)))
+              (val
+                (if (> (len parts) 1) (nth parts 1) nil)))
             (cond
               ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                 (let
@@ -2255,7 +2302,8 @@
           ((parts (split resolved ":")))
           (let
             ((prop (first parts))
-              (val (if (> (len parts) 1) (nth parts 1) nil)))
+              (val
+                (if (> (len parts) 1) (nth parts 1) nil)))
             (cond
               ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                 (let
@@ -2360,10 +2408,14 @@
                             (if
                               (= depth 1)
                               j
-                              (find-close (+ j 1) (- depth 1)))
+                              (find-close
+                                (+ j 1)
+                                (- depth 1)))
                             (if
                               (= (nth raw j) "{")
-                              (find-close (+ j 1) (+ depth 1))
+                              (find-close
+                                (+ j 1)
+                                (+ depth 1))
                               (find-close (+ j 1) depth))))))
                     (let
                       ((close (find-close start 1)))
@@ -2474,7 +2526,10 @@
               (if
                 (= (len lst) 0)
                 -1
-                (if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
+                (if
+                  (= (first lst) item)
+                  i
+                  (idx-loop (rest lst) (+ i 1))))))
           (idx-loop obj 0)))
       (true
         (let
@@ -2566,7 +2621,8 @@
                 (cond
                   ((= end "hs-pick-end") n)
                   ((= end "hs-pick-start") 0)
-                  ((and (number? end) (< end 0)) (max 0 (+ n end)))
+                  ((and (number? end) (< end 0))
+                    (max 0 (+ n end)))
                   (true end))))
             (cond
               ((string? col) (slice col s e))
@@ -2877,7 +2933,9 @@
       ((results (hs-query-all selector)))
       (if
         (and
-          (or (nil? results) (and (list? results) (= (len results) 0)))
+          (or
+            (nil? results)
+            (and (list? results) (= (len results) 0)))
           (string? selector)
           (> (len selector) 0)
           (= (substring selector 0 1) "#"))
@@ -2902,21 +2960,27 @@
       (if
         fn
         (let
-          ((result (host-call-fn fn args)))
+          ((result (host-call-fn-raising fn args)))
           (if
-            (= (host-typeof result) "promise")
-            (let
-              ((state (host-promise-state result)))
+            (= result "__hs_js_throw__")
+            (raise (host-take-js-throw))
+            (if
+              (= result "__hs_async_error__")
+              (raise "__hs_async_error__")
               (if
-                (and state (= (host-get state "ok") false))
-                (do
-                  (host-set!
-                    (host-global "window")
-                    "__hs_async_error"
-                    (host-get state "value"))
-                  (raise "__hs_async_error__"))
-                (if state (host-get state "value") result)))
-            result))
+                (= (host-typeof result) "promise")
+                (let
+                  ((state (host-promise-state result)))
+                  (if
+                    (and state (= (host-get state "ok") false))
+                    (do
+                      (host-set!
+                        (host-global "window")
+                        "__hs_async_error"
+                        (host-get state "value"))
+                      (raise "__hs_async_error__"))
+                    (if state (host-get state "value") result)))
+                result))))
         (let
           ((msg (str "'" fn-name "' is null")))
           (host-set! (host-global "window") "_hs_null_error" msg)
@@ -3138,3 +3202,98 @@
 (define hs-token-value (fn (tok) (dict-get tok :value)))
 
 (define hs-token-op? (fn (tok) (dict-get tok :op)))
+
+(define
+  hs-try-json-parse
+  (fn (data) (if (string? data) (guard (_e nil) (json-parse data)) nil)))
+
+(define
+  hs-socket-normalise-url
+  (fn
+    (url)
+    (if
+      (or (starts-with? url "ws://") (starts-with? url "wss://"))
+      url
+      (let
+        ((proto (host-get (host-global "location") "protocol"))
+          (host-str (host-get (host-global "location") "host")))
+        (let
+          ((scheme (if (= proto "https:") "wss://" "ws://")))
+          (str scheme host-str url))))))
+
+(define
+  hs-socket-bind-name!
+  (fn
+    (name-path wrapper)
+    (let
+      ((win (host-global "window")))
+      (if
+        (= (len name-path) 1)
+        (host-set! win (first name-path) wrapper)
+        (do
+          (when
+            (nil? (host-get win (first name-path)))
+            (host-set! win (first name-path) (host-new "Object")))
+          (host-set!
+            (host-get win (first name-path))
+            (nth name-path 1)
+            wrapper))))))
+
+(define
+  hs-socket-resolve-rpc!
+  (fn
+    (wrapper data)
+    (let
+      ((iid (host-get data "iid")))
+      (when
+        (not (nil? iid))
+        (let
+          ((pending (host-get wrapper "_pending")))
+          (when
+            (not (nil? pending))
+            (let
+              ((entry (host-get pending iid)))
+              (when
+                (not (nil? entry))
+                (host-set! pending iid nil)
+                (if
+                  (not (nil? (host-get data "throw")))
+                  (host-call-fn
+                    (host-get entry "reject")
+                    (list (host-get data "throw")))
+                  (host-call-fn
+                    (host-get entry "resolve")
+                    (list (host-get data "return"))))))))))))
+
+(define
+  hs-socket-register!
+  (fn
+    (name-path url timeout on-message-handler json?)
+    (let
+      ((norm-url (hs-socket-normalise-url url)))
+      (let
+        ((wrapper (host-new "Object")))
+        (do
+          (host-set! wrapper "_url" norm-url)
+          (host-set! wrapper "_timeout" (if (nil? timeout) 0 timeout))
+          (host-set! wrapper "_pending" (host-new "Object"))
+          (host-set! wrapper "_closed" false)
+          (let
+            ((ws (host-new "WebSocket" norm-url)))
+            (do
+              (host-set! wrapper "_ws" ws)
+              (let
+                ((msg-handler (host-callback (fn (evt) (do (let ((parsed (hs-try-json-parse (host-get evt "data")))) (when (and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) (hs-socket-resolve-rpc! wrapper parsed))) (when (not (nil? on-message-handler)) (if json? (let ((data (hs-try-json-parse (host-get evt "data")))) (when (not (nil? data)) (on-message-handler data))) (on-message-handler evt))))))))
+                (do
+                  (host-set! ws "onmessage" msg-handler)
+                  (host-set! wrapper "_onmessage_handler" msg-handler)
+                  (host-set!
+                    ws
+                    "onclose"
+                    (host-callback
+                      (fn (e) (host-set! wrapper "_closed" true))))
+                  (host-call-fn
+                    (host-global "_hsSetupSocket")
+                    (list wrapper))
+                  (hs-socket-bind-name! name-path wrapper)
+                  wrapper)))))))))

shared/static/wasm/sx/hs-tokenizer.sx

@@ -8,7 +8,17 @@
 
 ;; ── Token constructor ─────────────────────────────────────────────
 
-(define hs-make-token (fn (type value pos) {:pos pos :value value :type type}))
+(define hs-make-token
+  (fn (type value pos &rest extras)
+    (let
+      ((end-arg (if (>= (len extras) 1) (nth extras 0) nil))
+       (line-arg (if (>= (len extras) 2) (nth extras 1) nil)))
+      (let
+        ((end (if (nil? end-arg)
+                  (+ pos (if (nil? value) 0 (len (str value))))
+                  end-arg))
+         (line (if (nil? line-arg) 1 line-arg)))
+        {:pos pos :end end :line line :value value :type type}))))
 
 ;; ── Character predicates ──────────────────────────────────────────
 
@@ -221,14 +231,26 @@
   (fn
     (src)
     (let
-      ((tokens (list)) (pos 0) (src-len (len src)))
+      ((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
       (define
         hs-peek
         (fn
           (offset)
           (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
       (define hs-cur (fn () (hs-peek 0)))
-      (define hs-advance! (fn (n) (set! pos (+ pos n))))
+      (define
+        hs-advance!
+        (fn (n)
+          (let ((new-pos (+ pos n)))
+            (define
+              count-nl!
+              (fn (i)
+                (when (< i new-pos)
+                  (when (= (nth src i) "\n")
+                    (set! current-line (+ current-line 1)))
+                  (count-nl! (+ i 1)))))
+            (count-nl! pos)
+            (set! pos new-pos))))
       (define
         skip-ws!
         (fn
@@ -502,13 +524,14 @@
         (fn
           (type value start)
           (let
-            ((tok (hs-make-token type value start))
-              (end-pos
-                (max pos (+ start (if (nil? value) 0 (len (str value)))))))
-            (do
-              (dict-set! tok "end" end-pos)
-              (dict-set! tok "line" (len (split (slice src 0 start) "\n")))
-              (append! tokens tok)))))
+            ((end-pos
+                (max pos (+ start (if (nil? value) 0 (len (str value))))))
+              (newlines-after-start
+                (- (len (split (slice src start (max start pos)) "\n")) 1))
+              (start-line (- current-line newlines-after-start)))
+            (append!
+              tokens
+              (hs-make-token type value start end-pos start-line)))))
       (define
         scan!
         (fn
@@ -538,7 +561,8 @@
                     (= (hs-peek 1) "#")
                     (= (hs-peek 1) "[")
                     (= (hs-peek 1) "*")
-                    (= (hs-peek 1) ":")))
+                    (= (hs-peek 1) ":")
+                    (= (hs-peek 1) "$")))
                 (do (hs-emit! "selector" (read-selector) start) (scan!))
                 (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
                 (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
@@ -757,11 +781,30 @@
   (fn
     (src)
     (let
-      ((tokens (list)) (pos 0) (src-len (len src)))
+      ((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
       (define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
       (define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
-      (define t-advance! (fn (n) (set! pos (+ pos n))))
-      (define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
+      (define
+        t-advance!
+        (fn (n)
+          (let ((new-pos (+ pos n)))
+            (define
+              t-count-nl!
+              (fn (i)
+                (when (< i new-pos)
+                  (when (= (nth src i) "\n")
+                    (set! current-line (+ current-line 1)))
+                  (t-count-nl! (+ i 1)))))
+            (t-count-nl! pos)
+            (set! pos new-pos))))
+      (define
+        t-emit!
+        (fn (type value)
+          (let
+            ((end-pos (+ pos (if (nil? value) 0 (len (str value))))))
+            (append!
+              tokens
+              (hs-make-token type value pos end-pos current-line)))))
       (define
         scan-to-close!
         (fn

shared/static/wasm/sx/hs-worker.sx

@@ -0,0 +1,19 @@
+;; lib/hyperscript/plugins/worker.sx — Worker plugin (stub)
+;;
+;; Phase 1 of the worker plugin: the registration formerly inlined in
+;; lib/hyperscript/parser.sx (E39 stub) moves here. Behaviour is
+;; identical — `worker MyWorker ...` raises a helpful error directing
+;; users to the full plugin (not yet implemented).
+;;
+;; Phase 2 (future) replaces this stub with parse-worker-feat, a
+;; compiler entry, hs-worker-define!, and the postMessage-based
+;; method dispatch documented in plans/designs/hs-plugin-system.md §4a.
+
+(define hs-worker-loaded? true)
+
+(hs-register-feature!
+  "worker"
+  (fn
+    (ctx)
+    (error
+      "worker plugin is not installed — see https://hyperscript.org/features/worker")))

shared/static/wasm/sx/hs-worker.sxbc

@@ -0,0 +1,3 @@
+(sxbc 1 "857de8641ad2e912"
+  (code
+    :constants ("hs-worker-loaded?" "hs-register-feature!" "worker" {:upvalue-count nil :arity nil :constants ("error" "worker plugin is not installed — see https://hyperscript.org/features/worker") :bytecode (nil nil nil nil nil nil nil nil)}) :bytecode (nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)))

shared/static/wasm/sx/module-manifest.json

@@ -946,9 +946,12 @@
       "hs-ident-start?",
       "hs-ident-char?",
       "hs-ws?",
+      "hs-hex-digit?",
+      "hs-hex-val",
       "hs-keywords",
       "hs-keyword?",
-      "hs-tokenize"
+      "hs-tokenize",
+      "hs-tokenize-template"
     ]
   },
   "hs-parser": {
@@ -958,7 +961,9 @@
     ],
     "exports": [
       "hs-parse",
-      "hs-compile"
+      "hs-span-mode",
+      "hs-compile",
+      "hs-parse-ast"
     ]
   },
   "hs-compiler": {
@@ -969,6 +974,7 @@
     ],
     "exports": [
       "hs-to-sx",
+      "hs-receiver-selector",
       "hs-to-sx-from-source"
     ]
   },
@@ -981,30 +987,50 @@
     ],
     "exports": [
       "hs-each",
+      "meta",
+      "hs-on-every",
+      "_hs-on-caller",
       "hs-on",
       "hs-on-every",
+      "hs-on-intersection-attach!",
+      "hs-on-mutation-attach!",
       "hs-init",
       "hs-wait",
-      "hs-wait-for",
       "hs-settle",
       "hs-toggle-class!",
+      "hs-toggle-var-cycle!",
       "hs-toggle-between!",
       "hs-toggle-style!",
       "hs-toggle-style-between!",
       "hs-toggle-style-cycle!",
       "hs-take!",
-      "hs-put!",
       "hs-add-to!",
       "hs-remove-from!",
+      "hs-splice-at!",
+      "hs-index",
+      "hs-put-at!",
+      "hs-dict-without",
       "hs-set-on!",
       "hs-navigate!",
+      "hs-ask",
+      "hs-answer",
+      "hs-answer-alert",
       "hs-scroll!",
       "hs-halt!",
       "hs-select!",
+      "hs-get-selection",
       "hs-reset!",
       "hs-next",
       "hs-previous",
+      "_hs-last-query-sel",
+      "hs-null-raise!",
+      "hs-empty-raise!",
+      "hs-query-all-checked",
+      "hs-dispatch!",
       "hs-query-all",
+      "hs-query-all-in",
+      "hs-list-set",
+      "hs-to-number",
       "hs-query-first",
       "hs-query-last",
       "hs-first",
@@ -1014,44 +1040,150 @@
       "hs-repeat-while",
       "hs-repeat-until",
       "hs-for-each",
+      "hs-sender",
+      "hs-host-to-sx",
+      "hs-fetch-impl",
       "hs-fetch",
+      "hs-fetch-no-throw",
+      "hs-json-escape",
+      "hs-json-stringify",
       "hs-coerce",
+      "hs-gather-form-nodes",
+      "hs-values-from-nodes",
+      "hs-value-of-node",
+      "hs-select-multi-values",
+      "hs-values-absorb",
+      "hs-as-values",
+      "hs-default?",
+      "hs-array-set!",
       "hs-add",
-      "hs-make",
       "hs-install",
       "hs-measure",
       "hs-transition",
       "hs-transition-from",
-      "hs-type-check",
       "hs-type-check-strict",
       "hs-strict-eq",
+      "hs-id=",
       "hs-eq-ignore-case",
+      "hs-starts-with?",
+      "hs-ends-with?",
+      "hs-scoped-set!",
+      "hs-scoped-get",
+      "hs-precedes?",
+      "hs-follows?",
       "hs-starts-with-ic?",
+      "hs-ends-with-ic?",
+      "hs-matches-ignore-case?",
       "hs-contains-ignore-case?",
       "hs-falsy?",
       "hs-matches?",
       "hs-contains?",
+      "hs-in?",
+      "hs-in-bool?",
+      "hs-is",
       "precedes?",
       "hs-empty?",
+      "hs-empty-like",
       "hs-empty-target!",
+      "hs-morph-char",
+      "hs-morph-index-from",
+      "hs-morph-sws",
+      "hs-morph-read-until",
+      "hs-morph-parse-attrs",
+      "hs-morph-parse-element",
+      "hs-morph-parse-children",
+      "hs-morph-apply-attrs",
+      "hs-morph-build-children",
+      "hs-morph-build-child",
+      "hs-morph!",
       "hs-open!",
       "hs-close!",
-      "hs-hide!",
-      "hs-show!",
+      "hs-show-when!",
+      "hs-hide-when!",
       "hs-first",
       "hs-last",
       "hs-template",
       "hs-make-object",
+      "hs-strip-order-deep",
       "hs-method-call",
       "hs-beep",
       "hs-prop-is",
       "hs-slice",
+      "hs-pick-first",
+      "hs-pick-last",
+      "hs-pick-random",
+      "hs-pick-items",
+      "hs-pick-match",
+      "hs-pick-matches",
       "hs-sorted-by",
       "hs-sorted-by-desc",
       "hs-split-by",
       "hs-joined-by",
       "hs-sorted-by",
-      "hs-sorted-by-desc"
+      "hs-sorted-by",
+      "hs-sorted-by-desc",
+      "hs-dom-has-var?",
+      "hs-dom-get-var-raw",
+      "hs-dom-set-var-raw!",
+      "hs-dom-resolve-start",
+      "hs-dom-walk",
+      "hs-dom-find-owner",
+      "hs-dom-get",
+      "hs-dom-set!",
+      "_hs-dom-watchers",
+      "hs-dom-watch!",
+      "hs-dom-fire-watchers!",
+      "hs-null-error!",
+      "hs-named-target",
+      "hs-named-target-list",
+      "hs-query-named-all",
+      "hs-dom-is-ancestor?",
+      "hs-win-call",
+      "hs-source-for",
+      "hs-line-for",
+      "hs-node-get",
+      "hs-src",
+      "hs-src-at",
+      "hs-line-at",
+      "hs-js-exec",
+      "hs-raw->api-token",
+      "hs-eof-sentinel",
+      "hs-tokens-of",
+      "hs-stream-token",
+      "hs-stream-consume",
+      "hs-stream-has-more",
+      "hs-token-type",
+      "hs-token-value",
+      "hs-token-op?",
+      "hs-try-json-parse",
+      "hs-socket-normalise-url",
+      "hs-socket-bind-name!",
+      "hs-socket-resolve-rpc!",
+      "hs-socket-register!"
+    ]
+  },
+  "hs-worker": {
+    "file": "hs-worker.sxbc",
+    "deps": [
+      "hs-tokenizer",
+      "hs-parser"
+    ],
+    "exports": [
+      "hs-worker-loaded?"
+    ]
+  },
+  "hs-prolog": {
+    "file": "hs-prolog.sxbc",
+    "deps": [
+      "hs-tokenizer",
+      "hs-parser",
+      "hs-compiler",
+      "hs-runtime"
+    ],
+    "exports": [
+      "hs-prolog-hook",
+      "hs-set-prolog-hook!",
+      "prolog"
     ]
   },
   "hs-integration": {
@@ -1060,10 +1192,15 @@
       "hs-tokenizer",
       "hs-parser",
       "hs-compiler",
-      "hs-runtime"
+      "hs-runtime",
+      "hs-worker",
+      "hs-prolog"
     ],
     "exports": [
+      "hs-register-scripts!",
+      "hs-scripting-disabled?",
       "hs-activate!",
+      "hs-deactivate!",
       "hs-boot!",
       "hs-boot-subtree!"
     ]
@@ -1075,6 +1212,8 @@
       "hs-parser",
       "hs-compiler",
       "hs-runtime",
+      "hs-worker",
+      "hs-prolog",
       "hs-integration"
     ],
     "exports": [
@@ -1158,6 +1297,8 @@
       "hs-parser",
       "hs-compiler",
       "hs-runtime",
+      "hs-worker",
+      "hs-prolog",
       "hs-integration",
       "hs-htmx"
     ]

spec/evaluator.sx

@@ -2903,6 +2903,81 @@
             pairs)))
       :else (= pattern value))))
 
+(define
+  match-clause-is-else?
+  (fn
+    (clause)
+    (let
+      ((p (first clause)))
+      (or
+        (= p (quote _))
+        (= p (quote else))
+        (= p :else)))))
+
+(define
+  match-clause-ctor-name
+  (fn
+    (clause)
+    (let
+      ((p (first clause)))
+      (cond
+        (and (list? p) (not (empty? p)) (symbol? (first p)))
+        (symbol-name (first p))
+        (and (symbol? p) (not (= p (quote _))) (not (= p (quote else))))
+        nil
+        :else nil))))
+
+(define
+  match-warn-non-exhaustive
+  (fn
+    (env type-name registered clause-ctors)
+    (let
+      ((missing
+        (filter (fn (c) (not (contains? clause-ctors c))) registered)))
+      (when
+        (not (empty? missing))
+        (do
+          (when
+            (not (env-has? env "*adt-warned*"))
+            (env-bind! env "*adt-warned*" (dict)))
+          (let
+            ((warned (env-get env "*adt-warned*"))
+              (key (str type-name "|" (join "," missing))))
+            (when
+              (not (get warned key))
+              (do
+                (dict-set! warned key true)
+                (host-warn
+                  (str
+                    "[sx] match: non-exhaustive — "
+                    type-name
+                    ": missing "
+                    (join ", " missing))))))))
+      nil)))
+
+(define
+  match-check-exhaustiveness
+  (fn
+    (val clauses env)
+    (when
+      (and (dict? val) (get val :_adt))
+      (let
+        ((type-name (get val :_type)))
+        (when
+          (and (env-has? env "*adt-registry*") type-name)
+          (let
+            ((registered
+              (get (env-get env "*adt-registry*") type-name)))
+            (when
+              (and registered (not (some match-clause-is-else? clauses)))
+              (let
+                ((clause-ctors
+                  (filter
+                    (fn (n) (not (nil? n)))
+                    (map match-clause-ctor-name clauses))))
+                (match-warn-non-exhaustive
+                  env type-name registered clause-ctors)))))))))
+
 (define
   step-sf-match
   (fn
@@ -2910,15 +2985,17 @@
     (let
       ((val (trampoline (eval-expr (first args) env)))
         (clauses (rest args)))
-      (let
-        ((result (match-find-clause val clauses env)))
-        (if
-          (nil? result)
-          (make-cek-value
-            (str "match: no clause matched " (inspect val))
-            env
-            (kont-push (make-raise-eval-frame env false) kont))
-          (make-cek-state (nth result 1) (first result) kont))))))
+      (do
+        (match-check-exhaustiveness val clauses env)
+        (let
+          ((result (match-find-clause val clauses env)))
+          (if
+            (nil? result)
+            (make-cek-value
+              (str "match: no clause matched " (inspect val))
+              env
+              (kont-push (make-raise-eval-frame env false) kont))
+            (make-cek-state (nth result 1) (first result) kont)))))))
 
 (define
   step-sf-handler-bind

spec/primitives.sx

@@ -810,6 +810,24 @@
   :returns "string-buffer"
   :doc "Create a new empty mutable string buffer for O(1) amortised append.")
 
+(define-primitive
+  "make-buffer"
+  :params ()
+  :returns "string-buffer"
+  :doc "Create a new mutable buffer (alias for make-string-buffer with terser name).")
+
+(define-primitive
+  "buffer-append!"
+  :params (buf v)
+  :returns "nil"
+  :doc "Append a value to a buffer; coerces non-strings to their printed form.")
+
+(define-primitive
+  "buffer->string"
+  :params (buf)
+  :returns "string"
+  :doc "Finalize a buffer to a single string.")
+
 (define-module :stdlib.coroutines)
 
 (define-module :stdlib.bitwise)

spec/tests/test-adt.sx

@@ -151,9 +151,15 @@
     "match dispatches on first matching constructor"
     (do
       (define-type Color (Red) (Green) (Blue))
-      (assert= "red" (match (Red) ((Red) "red") ((Green) "green") ((Blue) "blue")))
-      (assert= "green" (match (Green) ((Red) "red") ((Green) "green") ((Blue) "blue")))
-      (assert= "blue" (match (Blue) ((Red) "red") ((Green) "green") ((Blue) "blue")))))
+      (assert=
+        "red"
+        (match (Red) ((Red) "red") ((Green) "green") ((Blue) "blue")))
+      (assert=
+        "green"
+        (match (Green) ((Red) "red") ((Green) "green") ((Blue) "blue")))
+      (assert=
+        "blue"
+        (match (Blue) ((Red) "red") ((Green) "green") ((Blue) "blue")))))
   (deftest
     "match binds field to variable"
     (do
@@ -170,13 +176,16 @@
     "match multi-field constructor binds all fields"
     (do
       (define-type Vec2 (V2 x y))
-      (let ((v (V2 3 4)))
+      (let
+        ((v (V2 3 4)))
         (assert= 7 (match v ((V2 a b) (+ a b)))))))
   (deftest
     "match with else clause"
     (do
       (define-type Opt2 (Some2 val) (None2))
-      (assert= 10 (match (Some2 10) ((Some2 v) v) (else 0)))
+      (assert=
+        10
+        (match (Some2 10) ((Some2 v) v) (else 0)))
       (assert= 0 (match (None2) ((Some2 v) v) (else 0)))))
   (deftest
     "match else catches non-adt values"
@@ -187,48 +196,69 @@
     "match returns body expression value"
     (do
       (define-type Num (Num-of n))
-      (assert= 100 (match (Num-of 10) ((Num-of n) (* n n))))))
+      (assert=
+        100
+        (match (Num-of 10) ((Num-of n) (* n n))))))
   (deftest
     "match second arm fires when first does not match"
     (do
       (define-type Either (Left val) (Right val))
-      (assert= "left-1" (match (Left 1) ((Left v) (str "left-" v)) ((Right v) (str "right-" v))))
-      (assert= "right-2" (match (Right 2) ((Left v) (str "left-" v)) ((Right v) (str "right-" v))))))
+      (assert=
+        "left-1"
+        (match
+          (Left 1)
+          ((Left v) (str "left-" v))
+          ((Right v) (str "right-" v))))
+      (assert=
+        "right-2"
+        (match
+          (Right 2)
+          ((Left v) (str "left-" v))
+          ((Right v) (str "right-" v))))))
   (deftest
     "match wildcard _ in constructor pattern"
     (do
       (define-type Pair3 (Pair3-of a b))
-      (assert= 5 (match (Pair3-of 5 99) ((Pair3-of x _) x)))
-      (assert= 99 (match (Pair3-of 5 99) ((Pair3-of _ y) y)))))
+      (assert=
+        5
+        (match (Pair3-of 5 99) ((Pair3-of x _) x)))
+      (assert=
+        99
+        (match (Pair3-of 5 99) ((Pair3-of _ y) y)))))
   (deftest
     "match nested adt constructor pattern"
     (do
       (define-type Tree2 (Leaf2) (Node2 left val right))
-      (let ((t (Node2 (Leaf2) 7 (Leaf2))))
+      (let
+        ((t (Node2 (Leaf2) 7 (Leaf2))))
         (assert= 7 (match t ((Node2 _ v _) v)))
         (assert= true (match t ((Node2 (Leaf2) _ _) true) (else false))))))
   (deftest
     "match literal pattern"
     (do
-      (assert= "zero" (match 0 (0 "zero") (else "nonzero")))
+      (assert=
+        "zero"
+        (match 0 (0 "zero") (else "nonzero")))
       (assert= "hello" (match "hello" ("hello" "hello") (else "other")))))
   (deftest
     "match symbol binding pattern"
-    (do
-      (assert= 42 (match 42 (x x)))))
+    (do (assert= 42 (match 42 (x x)))))
   (deftest
     "match no matching clause raises error"
     (do
       (define-type AB (A-val) (B-val))
-      (let ((ok false))
-        (guard (exn (else (set! ok true)))
+      (let
+        ((ok false))
+        (guard
+          (exn (else (set! ok true)))
           (match (A-val) ((B-val) "b")))
         (assert ok))))
   (deftest
     "match result used in further computation"
     (do
       (define-type Num2 (N v))
-      (assert= 30
+      (assert=
+        30
         (+
           (match (N 10) ((N v) v))
           (match (N 20) ((N v) v))))))
@@ -238,41 +268,219 @@
       (define-type Tag (Tagged label value))
       (define get-label (fn (t) (match t ((Tagged lbl _) lbl))))
       (define get-value (fn (t) (match t ((Tagged _ val) val))))
-      (let ((t (Tagged "name" 99)))
+      (let
+        ((t (Tagged "name" 99)))
         (assert= "name" (get-label t))
         (assert= 99 (get-value t)))))
   (deftest
     "match three-field constructor"
     (do
       (define-type Triple2 (T3 a b c))
-      (assert= 6 (match (T3 1 2 3) ((T3 a b c) (+ a b c))))))
+      (assert=
+        6
+        (match
+          (T3 1 2 3)
+          ((T3 a b c) (+ a b c))))))
   (deftest
     "match clauses tried in order"
     (do
       (define-type Expr2 (Lit n) (Add l r) (Mul l r))
-      (define eval-expr2 (fn (e)
-        (match e
-          ((Lit n) n)
-          ((Add l r) (+ (eval-expr2 l) (eval-expr2 r)))
-          ((Mul l r) (* (eval-expr2 l) (eval-expr2 r))))))
-      (assert= 7 (eval-expr2 (Add (Lit 3) (Lit 4))))
-      (assert= 12 (eval-expr2 (Mul (Lit 3) (Lit 4))))
-      (assert= 11 (eval-expr2 (Add (Lit 2) (Mul (Lit 3) (Lit 3)))))))
+      (define
+        eval-expr2
+        (fn
+          (e)
+          (match
+            e
+            ((Lit n) n)
+            ((Add l r) (+ (eval-expr2 l) (eval-expr2 r)))
+            ((Mul l r) (* (eval-expr2 l) (eval-expr2 r))))))
+      (assert=
+        7
+        (eval-expr2 (Add (Lit 3) (Lit 4))))
+      (assert=
+        12
+        (eval-expr2 (Mul (Lit 3) (Lit 4))))
+      (assert=
+        11
+        (eval-expr2
+          (Add (Lit 2) (Mul (Lit 3) (Lit 3)))))))
   (deftest
     "match else binding captures value"
     (do
       (define-type Coin2 (Heads2) (Tails2))
-      (assert= "Tails2" (match (Tails2) ((Heads2) "Heads2") (x (get x :_ctor))))))
+      (assert=
+        "Tails2"
+        (match (Tails2) ((Heads2) "Heads2") (x (get x :_ctor))))))
   (deftest
     "match on adt with string field"
     (do
       (define-type Msg (Hello name) (Bye name))
-      (assert= "Hello, Alice" (match (Hello "Alice") ((Hello n) (str "Hello, " n)) ((Bye n) (str "Bye, " n))))
-      (assert= "Bye, Bob" (match (Bye "Bob") ((Hello n) (str "Hello, " n)) ((Bye n) (str "Bye, " n))))))
+      (assert=
+        "Hello, Alice"
+        (match
+          (Hello "Alice")
+          ((Hello n) (str "Hello, " n))
+          ((Bye n) (str "Bye, " n))))
+      (assert=
+        "Bye, Bob"
+        (match
+          (Bye "Bob")
+          ((Hello n) (str "Hello, " n))
+          ((Bye n) (str "Bye, " n))))))
+  (deftest
+    "type-of returns adt type name"
+    (do
+      (define-type Maybe2 (Just2 v) (Nothing2))
+      (assert= "Maybe2" (type-of (Just2 7)))
+      (assert= "Maybe2" (type-of (Nothing2)))))
+  (deftest
+    "adt? predicate distinguishes adt values"
+    (do
+      (define-type Box3 (Boxed3 x))
+      (assert= true (adt? (Boxed3 1)))
+      (assert= false (adt? 1))
+      (assert= false (adt? "str"))
+      (assert= false (adt? (list 1 2)))
+      (assert= false (adt? {:a 1}))))
+  (deftest
+    "inspect renders adt as constructor call"
+    (do
+      (define-type Pt (Pt-of x y) (Origin))
+      (assert= "(Pt-of 3 4)" (inspect (Pt-of 3 4)))
+      (assert= "(Origin)" (inspect (Origin)))))
   (deftest
     "match nested pattern with variable binding"
     (do
       (define-type Box2 (Box2-of v))
       (define-type Inner (Inner-of n))
-      (assert= 5 (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n)))))
-)
+      (assert=
+        5
+        (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n)))))
+  (deftest
+    "match nested constructor sanity (Phase 6b)"
+    (do
+      (define-type MaybeP6b (JustP6b v) (NothingP6b))
+      (assert= 42 (match (JustP6b 42) ((JustP6b x) x) (else 0)))
+      (assert= 0 (match (NothingP6b) ((JustP6b x) x) (else 0)))))
+  (deftest
+    "match nested constructor binds inner fields"
+    (do
+      (define-type MaybeN (JustN v) (NothingN))
+      (define-type PairN (PairN-of a b))
+      (assert=
+        3
+        (match
+          (JustN (PairN-of 1 2))
+          ((JustN (PairN-of a b)) (+ a b))
+          (else 0)))
+      (assert=
+        0
+        (match
+          (NothingN)
+          ((JustN (PairN-of a b)) (+ a b))
+          (else 0)))))
+  (deftest
+    "match nested wildcard ignores inner field"
+    (do
+      (define-type MaybeW (JustW v) (NothingW))
+      (assert=
+        "yes"
+        (match (JustW 42) ((JustW _) "yes") (else "no")))
+      (assert=
+        "no"
+        (match (NothingW) ((JustW _) "yes") (else "no")))))
+  (deftest
+    "match nested literal pattern requires equality"
+    (do
+      (define-type MaybeL (JustL v) (NothingL))
+      (assert=
+        "literal"
+        (match (JustL 42) ((JustL 42) "literal") (else "var")))
+      (assert=
+        "var"
+        (match (JustL 7) ((JustL 42) "literal") (else "var")))))
+  (deftest
+    "match falls through nested literal to variable clause"
+    (do
+      (define-type MaybeF (JustF v) (NothingF))
+      (assert=
+        1
+        (match (JustF 1) ((JustF 99) "wrong") ((JustF x) x)))
+      (assert=
+        "wrong"
+        (match (JustF 99) ((JustF 99) "wrong") ((JustF x) x)))))
+  (deftest
+    "match deeply nested constructors bind innermost"
+    (do
+      (define-type Wrap1 (W1 inner))
+      (define-type Wrap2 (W2 inner))
+      (define-type Leaf3 (L3 n))
+      (assert=
+        7
+        (match
+          (W1 (W2 (L3 7)))
+          ((W1 (W2 (L3 n))) n)
+          (else 0)))))
+  (deftest
+    "match nested constructor mixed bind and wildcard"
+    (do
+      (define-type PairM (PairM-of a b))
+      (define-type BoxM (BoxM-of inner))
+      (assert=
+        10
+        (match
+          (BoxM-of (PairM-of 10 99))
+          ((BoxM-of (PairM-of x _)) x)
+          (else 0)))
+      (assert=
+        99
+        (match
+          (BoxM-of (PairM-of 10 99))
+          ((BoxM-of (PairM-of _ y)) y)
+          (else 0)))))
+  (deftest
+    "match nested pattern fails when inner ctor differs"
+    (do
+      (define-type EitherX (LeftX v) (RightX v))
+      (define-type WrapX (WX inner))
+      (assert=
+        "right-1"
+        (match
+          (WX (RightX 1))
+          ((WX (LeftX v)) (str "left-" v))
+          ((WX (RightX v)) (str "right-" v))))
+      (assert=
+        "left-9"
+        (match
+          (WX (LeftX 9))
+          ((WX (LeftX v)) (str "left-" v))
+          ((WX (RightX v)) (str "right-" v))))))
+  (deftest
+    "exhaustive match runs without error"
+    (do
+      (define-type ExA1 (CaA1 v) (CbA1))
+      (assert= 1 (match (CaA1 1) ((CaA1 x) x) ((CbA1) 0)))
+      (assert= 0 (match (CbA1) ((CaA1 x) x) ((CbA1) 0)))))
+  (deftest
+    "non-exhaustive match still returns value (warning is non-fatal)"
+    (do
+      (define-type ExA2 (CaA2 v) (CbA2))
+      (assert= 9 (match (CaA2 9) ((CaA2 x) x)))))
+  (deftest
+    "match with else clause suppresses non-exhaustive warning"
+    (do
+      (define-type ExA3 (CaA3 v) (CbA3) (CcA3))
+      (assert= "a" (match (CaA3 1) ((CaA3 x) "a") (else "other")))
+      (assert= "other" (match (CbA3) ((CaA3 x) "a") (else "other")))))
+  (deftest
+    "match with all-but-one constructor still runs"
+    (do
+      (define-type ExA4 (CaA4 v) (CbA4) (CcA4))
+      (assert= 5 (match (CaA4 5) ((CaA4 x) x) ((CbA4) 0)))
+      (assert= 0 (match (CbA4) ((CaA4 x) x) ((CbA4) 0)))))
+  (deftest
+    "match wildcard pattern suppresses non-exhaustive warning"
+    (do
+      (define-type ExA5 (CaA5 v) (CbA5))
+      (assert= 7 (match (CaA5 7) ((CaA5 x) x) (_ 0)))
+      (assert= 0 (match (CbA5) ((CaA5 x) x) (_ 0))))))

spec/tests/test-letrec-resume.sx

@@ -0,0 +1,44 @@
+;; Letrec + perform/resume regression tests — Step 2
+;; Verifies sibling bindings survive across an IO suspension when the
+;; suspended call goes through call_closure_reuse (JIT path).
+;; The browser/WASM kernel reuses the host VM via call_closure_reuse;
+;; if restore_reuse drops the caller's saved sp, sibling letrec bindings
+;; come back as nil after resume.
+(defsuite
+  "letrec-resume"
+  (deftest
+    "single binding survives perform/resume"
+    (let
+      ((state (cek-step-loop (make-cek-state (quote (letrec ((f (fn () (perform {:op "io"})))) (f))) (make-env) (list)))))
+      (assert (cek-suspended? state))
+      (let
+        ((final (cek-resume state 7)))
+        (assert (cek-terminal? final))
+        (assert= (cek-value final) 7))))
+  (deftest
+    "sibling bindings survive perform/resume"
+    (let
+      ((state (cek-step-loop (make-cek-state (quote (letrec ((g (fn () 100)) (f (fn () (perform {:op "io"})))) (+ (f) (g)))) (make-env) (list)))))
+      (assert (cek-suspended? state))
+      (let
+        ((final (cek-resume state 5)))
+        (assert (cek-terminal? final))
+        (assert= (cek-value final) 105))))
+  (deftest
+    "mutual recursion sibling preserved across resume"
+    (let
+      ((state (cek-step-loop (make-cek-state (quote (letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1))))) (odd? (fn (n) (if (= n 0) false (even? (- n 1))))) (fetch (fn () (perform {:op "io"})))) (let ((x (fetch))) (even? x)))) (make-env) (list)))))
+      (assert (cek-suspended? state))
+      (let
+        ((final (cek-resume state 4)))
+        (assert (cek-terminal? final))
+        (assert= (cek-value final) true))))
+  (deftest
+    "nested letrec — outer sibling survives inner perform"
+    (let
+      ((state (cek-step-loop (make-cek-state (quote (letrec ((outer-val (fn () 99)) (inner-call (fn () (letrec ((suspend-fn (fn () (perform {:op "io"})))) (suspend-fn))))) (+ (inner-call) (outer-val)))) (make-env) (list)))))
+      (assert (cek-suspended? state))
+      (let
+        ((final (cek-resume state 1)))
+        (assert (cek-terminal? final))
+        (assert= (cek-value final) 100)))))

spec/tests/test-string-buffer.sx

@@ -128,4 +128,37 @@
           (string-buffer-append! buf sep)
           (string-buffer-append! buf (first remaining))
           (loop (rest remaining) " ")))
-      (assert= "the quick brown fox" (string-buffer->string buf)))))
+      (assert= "the quick brown fox" (string-buffer->string buf))))
+  (deftest
+    "make-buffer alias creates a buffer"
+    (let ((b (make-buffer))) (assert (buffer? b))))
+  (deftest
+    "buffer-append! with string"
+    (let ((b (make-buffer)))
+      (buffer-append! b "hello")
+      (buffer-append! b " ")
+      (buffer-append! b "world")
+      (assert= "hello world" (buffer->string b))))
+  (deftest
+    "buffer-append! coerces non-string values"
+    (let ((b (make-buffer)))
+      (buffer-append! b "n=")
+      (buffer-append! b 42)
+      (buffer-append! b ",")
+      (buffer-append! b true)
+      (buffer-append! b ",")
+      (buffer-append! b nil)
+      (assert= "n=42,true," (buffer->string b))))
+  (deftest
+    "buffer-length tracks total length"
+    (let ((b (make-buffer)))
+      (buffer-append! b "abc")
+      (buffer-append! b "de")
+      (assert= 5 (buffer-length b))))
+  (deftest
+    "buffer aliases interop with string-buffer"
+    (let ((b (make-buffer)))
+      (buffer-append! b "x")
+      (string-buffer-append! b "y")
+      (assert= "xy" (string-buffer->string b))
+      (assert= "xy" (buffer->string b)))))

tests/hs-kernel-eval.js

@@ -207,11 +207,15 @@ K.eval('(define serialize sx-serialize)');
 // ── Load HS modules ─────────────────────────────────────────────
 const WEB = ['render','core-signals','signals','deps','router','page-helpers','freeze','dom','browser',
              'adapter-html','adapter-sx','adapter-dom','boot-helpers','hypersx','engine','orchestration','boot'];
-const HS  = ['hs-tokenizer','hs-parser','hs-compiler','hs-runtime','hs-integration'];
+const HS  = ['hs-tokenizer','hs-parser','hs-compiler','hs-runtime','hs-worker','hs-prolog','hs-integration'];
+const HS_PLUGINS = new Set(['hs-worker','hs-prolog']);
 K.beginModuleLoad();
 for (const mod of [...WEB, ...HS]) {
   const sp = path.join(SX_DIR, mod+'.sx');
-  const lp = path.join(PROJECT, 'lib/hyperscript', mod.replace(/^hs-/,'')+'.sx');
+  const stem = mod.replace(/^hs-/,'');
+  const lp = HS_PLUGINS.has(mod)
+    ? path.join(PROJECT, 'lib/hyperscript/plugins', stem+'.sx')
+    : path.join(PROJECT, 'lib/hyperscript', stem+'.sx');
   let s;
   try {
     const lpExists = mod.startsWith('hs-') && fs.existsSync(lp);