Merge origin/architecture (events 391/391) — no overlap with W14 gate merge

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

.claude/scheduled_tasks.lock

@@ -0,0 +1 @@
+{"sessionId":"d510140d-6197-40b7-9bd2-125ca304ad7a","pid":697492,"procStart":"125353752","acquiredAt":1783118024555}

.mcp.json

@@ -2,7 +2,7 @@
   "mcpServers": {
     "sx-tree": {
       "type": "stdio",
-      "command": "./hosts/ocaml/_build/default/bin/mcp_tree.exe"
+      "command": "/root/rose-ash/hosts/ocaml/_build/default/bin/mcp_tree.exe"
     },
     "rose-ash-services": {
       "type": "stdio",

CLAUDE.md

@@ -173,15 +173,16 @@ artdag/
 
 ## SX Language — Canonical Reference
 
-The SX language is defined by a self-hosting specification in `shared/sx/ref/`. **Read these files for authoritative SX semantics** — they supersede any implementation detail in `sx.js` or Python evaluators.
+The SX language is defined by a self-hosting specification in `spec/`. **Read these files for authoritative SX semantics.** (The former `shared/sx/ref/*.sx` copies were deleted — only `BOUNDARY.md` remains there.) The spec is transpiled into the OCaml kernel (`hosts/ocaml/lib/sx_ref.ml`, generated by `hosts/ocaml/bootstrap.py` — never edit the generated file; edit the spec and regenerate).
 
 ### Specification files
 
-- **`shared/sx/ref/eval.sx`** — Core evaluator: types, trampoline (TCO), `eval-expr` dispatch, special forms (`if`, `when`, `cond`, `case`, `let`, `and`, `or`, `lambda`, `define`, `defcomp`, `defmacro`, `quasiquote`), higher-order forms (`map`, `filter`, `reduce`, `some`, `every?`, `for-each`), macro expansion, function/lambda/component calling.
-- **`shared/sx/ref/parser.sx`** — Tokenizer and parser: grammar, string escapes, dict literals `{:key val}`, quote sugar (`` ` ``, `,`, `,@`), serializer.
-- **`shared/sx/ref/primitives.sx`** — All ~80 built-in pure functions: arithmetic, comparison, predicates, string ops, collection ops, dict ops, format helpers, CSSX style primitives.
-- **`shared/sx/ref/render.sx`** — Three rendering modes: `render-to-html` (server HTML), `render-to-sx`/`aser` (SX wire format for client), `render-to-dom` (browser). HTML tag registry, void elements, boolean attrs.
-- **`shared/sx/ref/bootstrap_js.py`** — Transpiler: reads the `.sx` spec files and emits `sx-ref.js`.
+- **`spec/evaluator.sx`** — The CEK-machine evaluator: frames, TCO trampoline, `step`/dispatch, special forms (`if`, `when`, `cond`, `case`, `let`, `and`, `or`, `lambda`, `define`, `defcomp`, `defmacro`, `quasiquote`, `guard`, `handler-bind`), higher-order forms (`map`, `filter`, `reduce`, `some`, `every?`, `for-each`), continuations (`call/cc`, `reset`/`shift`), macro expansion, strict-typing machinery, function/lambda/component calling.
+- **`spec/parser.sx`** — Tokenizer and parser: grammar, string escapes, dict literals `{:key val}`, quote sugar (`` ` ``, `,`, `,@`), serializer.
+- **`spec/primitives.sx`** — Declarative specs for the built-in pure functions: arithmetic, comparison, predicates, string ops, collection ops, dict ops, format helpers, CSSX style primitives.
+- **`spec/render.sx`** — Rendering registries + escaping (HTML tag registry, void elements, boolean attrs); the mode dispatch (`render-to-html`, `aser`, `render-to-dom`) lives in `web/adapter-*.sx`.
+- **`spec/special-forms.sx`, `spec/eval-rules.sx`** — Form specs and machine-readable evaluation rules.
+- **`spec/signals.sx`, `spec/coroutines.sx`, `spec/canonical.sx`, `spec/stdlib.sx`** — Reactive signals, coroutines, canonical serialization, stdlib.
 - **`spec/harness.sx`** — Test harness: mock IO platform for testing components. Sessions, IO interception, log queries, assertions (`assert-io-called`, `assert-io-count`, `assert-io-args`, `assert-no-io`, `assert-state`). Extensible — new platforms add entries to the platform dict. Loaded automatically by test runners.
 - **`spec/tests/test-harness.sx`** — Tests for the harness itself (15 tests).
 
@@ -310,7 +311,7 @@ cd artdag/l1 && mypy app/types.py app/routers/recipes.py tests/
 
 ### SX Rendering Pipeline
 
-The SX system renders component trees defined in s-expressions. Canonical semantics are in `shared/sx/ref/` (see "SX Language" section above). The same AST can be evaluated in different modes depending on where the server/client rendering boundary is drawn:
+The SX system renders component trees defined in s-expressions. Canonical semantics are in `spec/` (see "SX Language" section above). The same AST can be evaluated in different modes depending on where the server/client rendering boundary is drawn:
 
 - `render_to_html(name, **kw)` — server-side, produces HTML. Maps to `render-to-html` in the spec.
 - `render_to_sx(name, **kw)` — server-side, produces SX wire format. Maps to `aser` in the spec. Component calls stay **unexpanded**.
@@ -450,7 +451,7 @@ printf '(epoch 1)\n(prim-check "my-compiled-fn")\n' | sx_server.exe
 
 Key patterns discovered from the reactive runtime demos (see `sx/sx/reactive-runtime.sx`):
 
-1. **Multi-expression bodies need `(do ...)`** — `fn`, `let`, and `when` bodies evaluate only the last expression. Wrap multiples in `(do expr1 expr2 expr3)`.
-2. **`let` is parallel, not sequential** — bindings in the same `let` can't reference each other. Use nested `let` blocks when functions need to reference signals defined earlier.
+1. **Multi-expression bodies sequence (implicit begin)** — `fn`, `let`, and `when` bodies evaluate every expression and return the last (verified on both the CEK and the VM; the old "only the last expression runs" rule described a deleted evaluator). `(do ...)` still works and is fine for clarity.
+2. **`let` is SEQUENTIAL (`let*` semantics)** — later bindings see earlier ones (`(let ((a 1) (b a)) b)` → 1; tested intent, both engines). `cond`, however, has a mode-detection footgun with multi-expression clause bodies — use flat pairs with explicit `(do ...)` results.
 3. **Reactive text needs `(deref (computed ...))`** — bare `(len (deref items))` is NOT reactive. Wrap in `(deref (computed (fn () (len (deref items)))))`.
 4. **Effects go in inner `let`** — signals in outer `let`, functions and effects in inner `let`. The OCaml SSR evaluator can't resolve outer `let` bindings from same-`let` lambdas.

applications/sxtp/spec.sx

@@ -97,6 +97,42 @@
       (:body "Any SX value — event payload (optional)")
       (:time "Number — unix timestamp (optional)"))))
 
+;; ── patch (DOM fragment patch — borrowed from Datastar) ───────────
+;; A server-driven instruction to morph a region of the client DOM.
+;; Subsumes HTMX swap modes; the :body is an SX subtree that the client
+;; renders to DOM nodes before applying the mode at the target.
+(define
+  patch-fields
+  (quote
+    ((:target "String — CSS selector for the element to patch (required)")
+      (:mode "Symbol — patch mode (optional, default outer)")
+      (:body "SX tree — the new content (omitted for mode remove)")
+      (:transition "Boolean — use a view transition (optional, default false)"))))
+
+(define
+  patch-modes
+  (quote
+    ((outer "Replace the target's outerHTML (default; the morph target)")
+      (inner "Replace the target's innerHTML, preserving the wrapper")
+      (replace "Hard-replace without morphing (no diff, plain swap)")
+      (prepend "Insert the body as the target's first child")
+      (append "Insert the body as the target's last child")
+      (before "Insert the body before the target")
+      (after "Insert the body after the target")
+      (remove "Detach the target; :body MUST be absent"))))
+
+;; ── signals (reactive state patch — borrowed from Datastar) ──────
+;; A server-driven update to client-side reactive signals. :values is a
+;; dict of signal-name -> new-value; setting a value to nil REMOVES the
+;; signal. With :only-if-missing true, existing signals are not touched
+;; (use this to lazily initialise signal state without clobbering).
+(define
+  signals-fields
+  (quote
+    ((:values "Dict — signal-name -> new-value (required)")
+      (:only-if-missing
+        "Boolean — only set signals that don't yet exist (optional, default false)"))))
+
 (define
   example-navigate
   (quote
@@ -148,6 +184,23 @@
           :message "No such post"
           :retry false)))))
 
+;; A streaming response intermixing patch + signals: the server pushes
+;; DOM updates AND signal updates over the same channel. The client
+;; dispatches each message by its head symbol; ordering is preserved.
+(define
+  example-patch-stream
+  (quote
+    ((request :verb subscribe :path "/cart/live" :capabilities (fetch))
+      (response :status ok :stream true)
+      (signals :values {:cart/count 3 :cart/loading false})
+      (patch
+        :target "#cart-mini"
+        :mode outer
+        :body (~cart-mini :count 3 :total 47.50))
+      (patch :target "#flash" :mode inner :body (p "Item added."))
+      (signals :values {:cart/loading true})
+      (patch :target "#cart-loading-spinner" :mode remove))))
+
 (define
   example-inspect
   (quote

docker-compose.dev-sx-gitea.yml

@@ -0,0 +1,44 @@
+# sx-gitea live service — the federated git forge (lib/gitea) served by the
+# native http-listen server via lib/gitea/serve.sh. Joins externalnet so Caddy
+# can reverse_proxy sx.sx-web.org to it. Durable state on a host dir.
+#
+# Usage:
+#   sudo mkdir -p /root/sx-gitea-persist && sudo chown 10001:10001 /root/sx-gitea-persist
+#   docker compose -p sx-gitea -f docker-compose.dev-sx-gitea.yml up -d
+#   docker compose -p sx-gitea -f docker-compose.dev-sx-gitea.yml logs -f
+#   docker compose -p sx-gitea -f docker-compose.dev-sx-gitea.yml down
+
+services:
+  sx_gitea:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-gitea-1
+    entrypoint: ["bash", "/app/lib/gitea/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      # Bind all interfaces so Caddy (on externalnet) can reach it.
+      SX_HTTP_HOST: "0.0.0.0"
+      # Durable persist store root — repos/issues/PRs/tokens survive restarts.
+      SX_PERSIST_DIR: /data/persist
+      # Forge identity + admin. The token gates every mutation (repo create,
+      # push, issues, PRs) — rotate by editing here and recreating.
+      SX_INSTANCE: "sx.sx-web.org"
+      SX_GITEA_ADMIN: "giles"
+      SX_GITEA_TOKEN: "sxg-9f2e6c81a4d35b07"
+      OCAMLRUNPARAM: "b"
+      # Serving JIT stays OFF for the forge until validated under it.
+    volumes:
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      - /root/sx-gitea-persist:/data/persist
+    networks:
+      - externalnet
+      - default
+    restart: unless-stopped
+
+networks:
+  externalnet:
+    external: true

docker-compose.dev-sx-host.yml

@@ -0,0 +1,201 @@
+# host-on-sx live service — the SX web host (lib/host) served by the native
+# http-listen server via lib/host/serve.sh. Joins the sx-dev project + externalnet
+# so Caddy can reverse_proxy a subdomain to it (blog.rose-ash.com). Isolated from
+# the sx_docs server: separate container, separate port.
+#
+# Usage:
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml up -d sx_host
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml logs -f sx_host
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml down
+
+services:
+  sx_host:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_host-1
+    entrypoint: ["bash", "/app/lib/host/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      # Bind all interfaces so Caddy (on externalnet) can reach it.
+      SX_HTTP_HOST: "0.0.0.0"
+      # Durable persist store root — on a named volume so data survives restarts.
+      SX_PERSIST_DIR: /data/persist
+      # Blog write auth: admin login + session-cookie signing secret. The blog
+      # write routes (POST /new, POST/PUT/DELETE /posts) are guarded by a session
+      # login or Bearer token, so these gate publishing. Not a real site — these
+      # are demo creds; rotate by editing here and recreating the container.
+      SX_ADMIN_USER: admin
+      SX_ADMIN_PASSWORD: "sx-host-camper-van-2026"
+      SX_SESSION_SECRET: "ra-host-sess-7c1f9b3e2a8d4056"
+      # Serving-mode JIT: bytecode-compile hot SX (esp. the Datalog/relations path)
+      # on the epoch serving channel. Validated: host conformance 271/271 under JIT,
+      # 5.4x faster (1m43s -> 19s). Default-OFF gate, opt in here.
+      SX_SERVING_JIT: "1"
+      OCAMLRUNPARAM: "b"
+      # TA-live ACTOR MODEL: A's actor identity + base URL. A is FOLLOWED (B follows it), so A has no
+      # SX_FOLLOW; it delivers its activities to its followers. SX_FED_SECRET signs/verifies fed POSTs.
+      SX_DOMAIN: "blog"
+      SX_ACTOR: "blog.rose-ash.com"
+      SX_SELF_URL: "http://sx_host:8000"
+      SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
+      # Cross-domain: where to send "allocate a post to a calendar" activities (the events peer).
+      SX_EVENTS_BASE: "http://sx_events:8000"
+    volumes:
+      # SX source (hot-reload on container restart)
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./next:/app/next:ro
+      - ./web:/app/web:ro
+      # Client assets for the blog SPA: the WASM OCaml kernel + sx-platform + the
+      # web-stack modules, served by lib/host/static.sx at /static/**.
+      - ./shared/static:/app/shared/static:ro
+      # OCaml server binary — this worktree's build (has the SX_HTTP_HOST bind fix)
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      # Durable persist store (the SX op-log/kv on disk) — survives restarts.
+      # Host dir, chowned to the image's appuser (uid 10001) so the non-root
+      # server can write: sudo mkdir -p /root/sx-host-persist && sudo chown 10001:10001 /root/sx-host-persist
+      - /root/sx-host-persist:/data/persist
+    networks:
+      - externalnet
+      - default
+    restart: unless-stopped
+
+  # The durable-execution KERNEL (next/kernel/host_kernel.erl) — a persistent next/ service holding
+  # flow_store across requests (RA-live substrate). The host reaches it at http://sx_kernel:8930 over
+  # the shared `default` network. SX_HTTP_HOST=0.0.0.0 so the bind is reachable cross-container.
+  sx_kernel:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_kernel-1
+    entrypoint: ["bash", "/app/next/kernel/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      KERNEL_PORT: "8930"
+      SX_HTTP_HOST: "0.0.0.0"
+      OCAMLRUNPARAM: "b"
+    volumes:
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./next:/app/next:ro
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+    networks:
+      - default
+    restart: unless-stopped
+
+  # The EVENTS domain — a fed-sx peer running lib/host with SX_DOMAIN=events (a "calendar" type whose
+  # on-allocate behavior links posts federated from blog). Replaces the Python events service. Blog
+  # sends directed "allocate" activities to its /inbox. Own durable store; same shared fed secret.
+  sx_events:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_events-1
+    entrypoint: ["bash", "/app/lib/host/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      SX_HTTP_HOST: "0.0.0.0"
+      SX_PERSIST_DIR: /data/persist
+      SX_ADMIN_USER: admin
+      SX_ADMIN_PASSWORD: "sx-events-camper-2026"
+      SX_SESSION_SECRET: "events-sess-9d2e1f"
+      SX_SERVING_JIT: "1"
+      OCAMLRUNPARAM: "b"
+      SX_DOMAIN: "events"
+      SX_ACTOR: "events.rose-ash.com"
+      SX_SELF_URL: "http://sx_events:8000"
+      SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
+      # Cross-domain: where to place ticket orders (the shop peer).
+      SX_SHOP_BASE: "http://sx_shop:8000"
+    volumes:
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./next:/app/next:ro
+      - ./web:/app/web:ro
+      - ./shared/static:/app/shared/static:ro
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      - /root/sx-events-persist:/data/persist
+    networks:
+      # externalnet too, so Caddy can reverse_proxy events.rose-ash.com → here (external DNS/route).
+      - externalnet
+      - default
+    restart: unless-stopped
+
+  # The SHOP domain — a fed-sx peer running lib/host with SX_DOMAIN=shop (an "order" type). Events
+  # places ticket orders here (POST /order). Replaces the Python shop/market service.
+  sx_shop:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_shop-1
+    entrypoint: ["bash", "/app/lib/host/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      SX_HTTP_HOST: "0.0.0.0"
+      SX_PERSIST_DIR: /data/persist
+      SX_ADMIN_USER: admin
+      SX_ADMIN_PASSWORD: "sx-shop-camper-2026"
+      SX_SESSION_SECRET: "shop-sess-9d2e1f"
+      SX_SERVING_JIT: "1"
+      OCAMLRUNPARAM: "b"
+      SX_DOMAIN: "shop"
+      SX_ACTOR: "shop.rose-ash.com"
+      SX_SELF_URL: "http://sx_shop:8000"
+      SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
+      # Cross-domain: where to register the person who bought a ticket (the identity peer).
+      SX_IDENTITY_BASE: "http://sx_identity:8000"
+    volumes:
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./next:/app/next:ro
+      - ./web:/app/web:ro
+      - ./shared/static:/app/shared/static:ro
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      - /root/sx-shop-persist:/data/persist
+    networks:
+      - externalnet
+      - default
+    restart: unless-stopped
+
+  # The IDENTITY domain — a fed-sx peer running lib/host with SX_DOMAIN=identity (a "person" type).
+  # People are keyed by a contact-id (email), login-optional, created at checkout by the shop.
+  sx_identity:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_identity-1
+    entrypoint: ["bash", "/app/lib/host/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      SX_HTTP_HOST: "0.0.0.0"
+      SX_PERSIST_DIR: /data/persist
+      SX_ADMIN_USER: admin
+      SX_ADMIN_PASSWORD: "sx-identity-camper-2026"
+      SX_SESSION_SECRET: "identity-sess-9d2e1f"
+      SX_SERVING_JIT: "1"
+      OCAMLRUNPARAM: "b"
+      SX_DOMAIN: "identity"
+      SX_ACTOR: "id.rose-ash.com"
+      SX_SELF_URL: "http://sx_identity:8000"
+      SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
+    volumes:
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./next:/app/next:ro
+      - ./web:/app/web:ro
+      - ./shared/static:/app/shared/static:ro
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      - /root/sx-identity-persist:/data/persist
+    networks:
+      - externalnet
+      - default
+    restart: unless-stopped
+
+networks:
+  externalnet:
+    external: true

hosts/ocaml/bin/dune

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

hosts/ocaml/bin/integration_tests.ml

@@ -263,7 +263,7 @@ let make_integration_env () =
 
   (* Type predicates — needed by adapter-sx.sx *)
   bind "callable?" (fun args ->
-    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
   bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
   bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
   bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);

hosts/ocaml/bin/mcp_tree.ml

@@ -375,18 +375,34 @@ let setup_env () =
     | [String s] when String.length s = 1 ->
       let c = s.[0] in Bool ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
     | _ -> Bool false);
+  (* Parity with sx_primitives: Integer, not float — make-char requires an
+     Integer codepoint, so the float version broke #\a char literals here. *)
   bind "char-code" (fun args -> match args with
-    | [String s] when String.length s > 0 -> Number (float_of_int (Char.code s.[0]))
-    | _ -> Number 0.0);
+    | [String s] when String.length s > 0 -> Integer (Char.code s.[0])
+    | _ -> Integer 0);
   bind "code-char" (fun args -> match args with
     | [Number n] -> String (String.make 1 (Char.chr (int_of_float n)))
     | _ -> String "");
+  (* Parity with sx_primitives: Integer-aware — the float-only version
+     shadowed the kernel one and broke rationals through the guest parser. *)
   bind "parse-number" (fun args -> match args with
-    | [String s] -> (try Number (float_of_string s) with _ -> Nil)
+    | [String s] ->
+      let has_dec = String.contains s '.' in
+      let has_exp = String.contains s 'e' || String.contains s 'E' in
+      if has_dec || has_exp then
+        (try Number (float_of_string s) with Failure _ -> Nil)
+      else
+        (match int_of_string_opt s with
+         | Some n -> Integer n
+         | None -> (try Number (float_of_string s) with Failure _ -> Nil))
     | _ -> Nil);
   bind "identical?" (fun args -> match args with
     | [a; b] -> Bool (a == b)
     | _ -> Bool false);
+  (* Parity with sx_server: equal? exists in the real runtime env *)
+  bind "equal?" (fun args -> match args with
+    | [a; b] -> Bool (a = b)
+    | _ -> raise (Eval_error "equal?: expected 2 args"));
   (* Character classification for SX parser.sx *)
   bind "ident-start?" (fun args -> match args with
     | [String s] when String.length s = 1 ->
@@ -427,8 +443,10 @@ let setup_env () =
   (* Runtime functions needed by tree-tools *)
   bind "symbol-name" (fun args -> match args with
     | [Symbol s] -> String s | _ -> String "");
+  (* Parity with sx_server: error on non-keyword (was a silent "") *)
   bind "keyword-name" (fun args -> match args with
-    | [Keyword k] -> String k | _ -> String "");
+    | [Keyword k] -> String k
+    | _ -> raise (Eval_error "keyword-name: expected keyword"));
   bind "make-symbol" (fun args -> match args with
     | [String s] -> Symbol s | _ -> Nil);
   (* Environment operations needed by harness *)
@@ -443,12 +461,30 @@ let setup_env () =
     | _ -> Bool false);
   bind "make-env" (fun _args -> Env (make_env ()));
   bind "keys" (fun args -> match args with
-    | [Dict d] -> List (Hashtbl.fold (fun k _ acc -> String k :: acc) d [])
+    | [Dict d] -> List (dict_keys d)
     | _ -> List []);
-  bind "get" (fun args -> match args with
-    | [Dict d; String k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
-    | [Dict d; Keyword k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
-    | [List items; Number n] -> (let i = int_of_float n in if i >= 0 && i < List.length items then List.nth items i else Nil)
+  (* Parity with sx_primitives: Integer indices (literals parse as Integer,
+     so the Number-only arm returned nil for every (get lst 1)), Symbol keys,
+     and the 3-arg default form — default only when the key is ABSENT. *)
+  bind "get" (fun args ->
+    let dict_key = function
+      | String k | Keyword k | Symbol k -> Some k
+      | _ -> None in
+    let list_idx = function
+      | Integer i -> Some i
+      | Number n -> Some (int_of_float n)
+      | _ -> None in
+    match args with
+    | [Dict d; key] | [Dict d; key; _] when dict_key key <> None && Hashtbl.mem d (Option.get (dict_key key)) ->
+      Hashtbl.find d (Option.get (dict_key key))
+    | [Dict _; _] -> Nil
+    | [Dict _; _; default] -> default
+    | ([List items; idx] | [ListRef { contents = items }; idx]) when list_idx idx <> None ->
+      (let i = Option.get (list_idx idx) in
+       if i >= 0 && i < List.length items then List.nth items i else Nil)
+    | ([List items; idx; default] | [ListRef { contents = items }; idx; default]) when list_idx idx <> None ->
+      (let i = Option.get (list_idx idx) in
+       if i >= 0 && i < List.length items then List.nth items i else default)
     | _ -> Nil);
   bind "dict-set!" (fun args -> match args with
     | [Dict d; String k; v] -> Hashtbl.replace d k v; v
@@ -477,9 +513,13 @@ let setup_env () =
   bind "number?" (fun args -> match args with
     | [Number _] -> Bool true | _ -> Bool false);
   bind "callable?" (fun args -> match args with
-    | [NativeFn _ | Lambda _ | Component _ | Island _] -> Bool true | _ -> Bool false);
+    | [NativeFn _ | Lambda _ | Component _ | Island _ | VmClosure _] -> Bool true | _ -> Bool false);
+  (* Parity with sx_primitives: empty string and empty dict are empty
+     (test-primitives.sx:89 asserts this; the old arms said false). *)
   bind "empty?" (fun args -> match args with
     | [List []] | [ListRef { contents = [] }] -> Bool true
+    | [String s] -> Bool (String.length s = 0)
+    | [Dict d] -> Bool (Hashtbl.length d = 0)
     | [Nil] -> Bool true | _ -> Bool false);
   bind "contains?" (fun args -> match args with
     | [String s; String sub] ->
@@ -490,6 +530,11 @@ let setup_env () =
       in Bool (String.length sub = 0 || find 0)
     | [List l; v] | [ListRef { contents = l }; v] ->
       Bool (List.exists (fun x -> x = v) l)
+    | [Dict d; key] ->
+      (* Dicts: key check — matches the sx_primitives fix *)
+      (match key with
+       | String k | Keyword k | Symbol k -> Bool (Hashtbl.mem d k)
+       | _ -> Bool false)
     | _ -> Bool false);
   bind "starts-with?" (fun args -> match args with
     | [String s; String prefix] ->
@@ -560,9 +605,28 @@ let setup_env () =
     | _ -> Nil);
   bind "trim" (fun args -> match args with
     | [String s] -> String (String.trim s) | _ -> String "");
+  (* Parity with sx_primitives: literal SUBSTRING separator (the old
+     split_on_char d.[0] was char-class semantics — the historical
+     "split is char-class" gotcha lived HERE, not in the kernel), keeps
+     empties, empty separator → chars, and no crash on "". *)
   bind "split" (fun args -> match args with
-    | [String s; String d] ->
-      List (List.map (fun p -> String p) (String.split_on_char d.[0] s))
+    | [String s; String sep] ->
+      let sl = String.length s and pl = String.length sep in
+      if pl = 0 then
+        List (List.init sl (fun i -> String (String.make 1 s.[i])))
+      else if pl = 1 then
+        List (List.map (fun p -> String p) (String.split_on_char sep.[0] s))
+      else begin
+        let parts = ref [] and start = ref 0 and i = ref 0 in
+        while !i <= sl - pl do
+          if String.sub s !i pl = sep then begin
+            parts := String.sub s !start (!i - !start) :: !parts;
+            start := !i + pl; i := !i + pl
+          end else incr i
+        done;
+        parts := String.sub s !start (sl - !start) :: !parts;
+        List (List.map (fun p -> String p) (List.rev !parts))
+      end
     | _ -> List []);
   (* sx-parse — use the native OCaml parser for bootstrapping *)
   bind "sx-parse" (fun args -> match args with

hosts/ocaml/bin/repro_jit_resume.ml

@@ -0,0 +1,202 @@
+(* Surgical repro for the serving-JIT OP_PERFORM/resume stack misalignment.
+   Mirrors what register_jit_hook's resolve_loop does: call_closure, catch
+   VmSuspended, resolve IO (return Nil), resume_vm — looping on re-suspend.
+   No CEK evaluator needed for the direct/multi-frame/reuse paths. *)
+
+open Sx_types
+
+let req_dict () =
+  let h = Hashtbl.create 1 in
+  Hashtbl.replace h "op" (String "noop");
+  Dict h
+
+(* Mirror the serving hook's resolve loop exactly. *)
+let drive cl =
+  let globals = cl.vm_closure_env |> ignore; cl.vm_env_ref in
+  let rec resolve_loop req vm =
+    let _ = req in
+    (try Sx_vm.resume_vm vm Nil
+     with Sx_vm.VmSuspended (r2, v2) -> resolve_loop r2 v2)
+  in
+  try Sx_vm.call_closure cl [] globals
+  with Sx_vm.VmSuspended (req, vm) -> resolve_loop req vm
+
+let mk_code ~locals ~bc ~consts = {
+  vc_arity = 0; vc_rest_arity = -1; vc_locals = locals;
+  vc_bytecode = Array.of_list bc;
+  vc_constants = Array.of_list consts;
+  vc_bytecode_list = None; vc_constants_list = None;
+}
+
+let mk_cl ?(name="tf") ?(env=Hashtbl.create 64) code =
+  { vm_code = code; vm_upvalues = [||]; vm_name = Some name;
+    vm_env_ref = env; vm_closure_env = None }
+
+let report label v =
+  Printf.printf "%-28s => %s\n%!" label (Sx_runtime.value_to_str v)
+
+let run label f =
+  (try report label (f ())
+   with
+   | Eval_error m -> Printf.printf "%-28s => ERROR: %s\n%!" label m
+   | e -> Printf.printf "%-28s => EXN: %s\n%!" label (Printexc.to_string e))
+
+(* opcodes *)
+let _const i = [1; i land 0xff; (i lsr 8) land 0xff]
+let _perform = [112]
+let _pop = [5]
+let _call_prim idx argc = [52; idx land 0xff; (idx lsr 8) land 0xff; argc]
+let _call argc = [48; argc]
+let _return = [50]
+
+let () =
+  (* Serving mode: a synchronous IO resolver is installed (mirrors
+     sx_server's http setup). Our mock resolves every request to Nil. *)
+  Sx_types._cek_io_resolver := Some (fun _req _ -> Nil);
+
+  (* Case 1: direct OP_PERFORM then a list prim in the SAME frame.
+     (do (perform {..}) (rest (list 1 2 3)))  =>  (2 3) *)
+  run "1.direct perform→rest" (fun () ->
+    let consts = [ req_dict (); List [Number 1.; Number 2.; Number 3.]; String "rest" ] in
+    let bc = _const 0 @ _perform @ _pop @ _const 1 @ _call_prim 2 1 @ _return in
+    drive (mk_cl (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 2: direct perform then map (2-arg prim).
+     (do (perform {..}) (map inc (list 1 2 3)))  — needs a fn; use a NativeFn const *)
+  run "2.direct perform→map" (fun () ->
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ req_dict (); inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push fn, push list, CALL_PRIM map 2 *)
+    let bc = _const 0 @ _perform @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 3: multi-frame — outer calls a JIT'd helper that performs, THEN outer maps.
+     helper: (do (perform {..}) 99)
+     outer:  (do (helper) (map inc (list 1 2 3))) *)
+  run "3.multiframe perform→map" (fun () ->
+    let env = Hashtbl.create 64 in
+    let helper_code = mk_code ~locals:0
+      ~bc:(_const 0 @ _perform @ _pop @ _const 1 @ _return)
+      ~consts:[ req_dict (); Number 99. ] in
+    let helper_cl = mk_cl ~name:"helper" ~env helper_code in
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ VmClosure helper_cl; inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push helper-closure, CALL 0, POP its result, push inc, push list, CALL_PRIM map 2 *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl ~name:"outer" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 4: map whose CALLBACK performs (reuse_stack path), then a trailing prim.
+     callback: (do (perform {..}) (inc e))   — but callback gets arg e in slot 0
+     outer: (do (map cb (list 1 2 3)) (rest (list 7 8 9)))  *)
+  run "4.map-callback-perform" (fun () ->
+    let env = Hashtbl.create 64 in
+    (* callback arity 1: slot0 = e. body: (perform {..}); (inc e) ; return
+       LOCAL_GET 0 then CALL_PRIM inc... use NativeFn inc via CALL_PRIM *)
+    let cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop
+                                   @ [16;0] (* LOCAL_GET 0 *)
+                                   @ _call_prim 1 1 @ _return);
+      vc_constants = [| req_dict (); String "inc" |];
+      vc_bytecode_list = None; vc_constants_list = None } in
+    let cb_cl = mk_cl ~name:"cb" ~env cb_code in
+    let consts = [ VmClosure cb_cl; List [Number 1.; Number 2.; Number 3.]; String "map";
+                   List [Number 7.; Number 8.; Number 9.]; String "rest" ] in
+    (* push cb, push list, CALL_PRIM map 2, POP, push list2, CALL_PRIM rest 1, RETURN *)
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _pop @ _const 3 @ _call_prim 4 1 @ _return in
+    drive (mk_cl ~name:"outer4" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 5: THE HOST CASE — perform via an INTERPRETED helper (pending_cek path),
+     then a list prim. helper is a Lambda (l_compiled = jit_failed) whose body
+     performs; vm_call routes it through cek_call_or_suspend → pending_cek.
+       helper: (perform {..})  [interpreted via CEK]
+       outer:  (do (helper) (rest (list 1 2 3)))  => (2 3) *)
+  run "5.pending_cek perform→rest" (fun () ->
+    let env = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = env; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let consts = [ helper; List [Number 1.; Number 2.; Number 3.]; String "rest" ] in
+    (* push helper, CALL 0, POP, push list, CALL_PRIM rest 1, RETURN *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _call_prim 2 1 @ _return in
+    drive (mk_cl ~name:"outer5" ~env:(Hashtbl.create 64) (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 6: pending_cek perform → MAP (2-arg), the exact host shape. *)
+  run "6.pending_cek perform→map" (fun () ->
+    let env = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = env; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ helper; inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push helper, CALL 0, POP, push inc, push list, CALL_PRIM map 2, RETURN *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl ~name:"outer6" ~env:(Hashtbl.create 64) (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 7: THE HOST SHAPE — map whose callback calls an INTERPRETED helper
+     that performs (kv read via persist helper inside a map), THEN a trailing
+     prim. callback(e): (do (kvread) e)  — kvread suspends via pending_cek.
+     outer: (do (map cb (list 1 2 3)) (drop (list 5 6 7 8) 2)) => (7 8) *)
+  run "7.HOST: map[cb→helper perform]→drop" (fun () ->
+    let genv = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = genv; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let env = Hashtbl.create 64 in
+    (* cb(e): push helper, CALL 0, POP, LOCAL_GET 0, RETURN *)
+    let cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _call 0 @ _pop @ [16;0] @ _return);
+      vc_constants = [| helper |]; vc_bytecode_list=None; vc_constants_list=None } in
+    let cb_cl = mk_cl ~name:"cb7" ~env cb_code in
+    let consts = [ VmClosure cb_cl; List [Number 1.; Number 2.; Number 3.]; String "map";
+                   List [Number 5.; Number 6.; Number 7.; Number 8.]; Number 2.; String "drop" ] in
+    (* push cb, push list, CALL_PRIM map 2, POP, push list2, push 2, CALL_PRIM drop 2, RETURN *)
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _pop
+             @ _const 3 @ _const 4 @ _call_prim 5 2 @ _return in
+    drive (mk_cl ~name:"outer7" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 8: reduce whose callback performs. (reduce + 0 (list 1 2 3)) with a
+     perform in the reducer => 6 *)
+  run "8.reduce[acc→perform]" (fun () ->
+    let env = Hashtbl.create 64 in
+    (* reducer(acc e): (do (perform {..}) (+ acc e)). slots: 0=acc 1=e *)
+    let rd_code = {
+      vc_arity = 2; vc_rest_arity = -1; vc_locals = 2;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop
+                                   @ [16;0] @ [16;1] @ _call_prim 1 2 @ _return);
+      vc_constants = [| req_dict (); String "+" |];
+      vc_bytecode_list=None; vc_constants_list=None } in
+    let rd_cl = mk_cl ~name:"rd" ~env rd_code in
+    let consts = [ VmClosure rd_cl; Number 0.; List [Number 1.; Number 2.; Number 3.]; String "reduce" ] in
+    (* push reducer, push 0, push list, CALL_PRIM reduce 3, RETURN *)
+    let bc = _const 0 @ _const 1 @ _const 2 @ _call_prim 3 3 @ _return in
+    drive (mk_cl ~name:"outer8" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 9: nested map — outer map callback runs an inner map whose callback
+     performs. outer over (list 1 2), inner over (list 10 20) performing.
+     cb_outer(x): (map cb_inner (list 10 20)) ; cb_inner(y): (do (perform) y)
+     => ((10 20) (10 20)) *)
+  run "9.nested map[inner→perform]" (fun () ->
+    let env = Hashtbl.create 64 in
+    let inner_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop @ [16;0] @ _return);
+      vc_constants = [| req_dict () |]; vc_bytecode_list=None; vc_constants_list=None } in
+    let inner_cl = mk_cl ~name:"cbin" ~env inner_code in
+    (* outer cb(x): push inner_cl, push (10 20), CALL_PRIM map 2, RETURN *)
+    let outer_cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _const 1 @ _call_prim 2 2 @ _return);
+      vc_constants = [| VmClosure inner_cl; List [Number 10.; Number 20.]; String "map" |];
+      vc_bytecode_list=None; vc_constants_list=None } in
+    let outer_cb_cl = mk_cl ~name:"cbout" ~env outer_cb_code in
+    let consts = [ VmClosure outer_cb_cl; List [Number 1.; Number 2.]; String "map" ] in
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _return in
+    drive (mk_cl ~name:"outer9" ~env (mk_code ~locals:0 ~bc ~consts)))

hosts/ocaml/bin/run_tests.ml

@@ -67,6 +67,14 @@ let rec deep_equal a b =
   | NativeFn _, NativeFn _ -> a == b
   | _ -> false
 
+(* ====================================================================== *)
+(* Test extensions for the VM extension registry suite (Phase B)           *)
+(* ====================================================================== *)
+
+(* Extend the extensible variant from sx_vm_extension.ml so the test
+   extensions below can carry their own private state. *)
+type Sx_vm_extension.extension_state += TestRegState of int ref
+
 (* ====================================================================== *)
 (* Build evaluator environment with test platform functions                *)
 (* ====================================================================== *)
@@ -587,7 +595,7 @@ let make_test_env () =
   (* regex-find-all now provided by sx_primitives.ml *)
   bind "callable?" (fun args ->
     match args with
-    | [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
+    | [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true
     | _ -> Bool false);
   bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
   bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
@@ -1143,7 +1151,7 @@ let make_test_env () =
 
   bind "promise?" (fun args ->
     match args with
-    | [v] -> Bool (Sx_ref.is_promise v)
+    | [v] -> Sx_ref.promise_p v
     | _ -> Bool false);
 
   bind "make-promise" (fun args ->
@@ -1158,7 +1166,7 @@ let make_test_env () =
 
   bind "force" (fun args ->
     match args with
-    | [p] -> Sx_ref.force_promise p
+    | [p] -> Sx_ref.force p
     | _ -> Nil);
 
   env
@@ -1279,10 +1287,830 @@ let run_foundation_tests () =
   assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
   assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
   assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
-  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0 } in
+  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0; l_uid = Sx_types.next_lambda_uid () } in
   assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
   ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
-  assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l))
+  assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l));
+
+  Printf.printf "\nSuite: crypto-sha2\n";
+  (* NIST FIPS 180-4 published vectors. *)
+  assert_eq "sha256 empty"
+    (String "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")
+    (call "crypto-sha256" [String ""]);
+  assert_eq "sha256 abc"
+    (String "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad")
+    (call "crypto-sha256" [String "abc"]);
+  assert_eq "sha256 896-bit"
+    (String "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1")
+    (call "crypto-sha256"
+       [String "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"]);
+  assert_eq "sha256 1M 'a'"
+    (String "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0")
+    (call "crypto-sha256" [String (String.make 1000000 'a')]);
+  assert_eq "sha512 empty"
+    (String "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")
+    (call "crypto-sha512" [String ""]);
+  assert_eq "sha512 abc"
+    (String "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f")
+    (call "crypto-sha512" [String "abc"]);
+  assert_eq "sha512 896-bit"
+    (String "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909")
+    (call "crypto-sha512"
+       [String ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"
+                ^ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu")]);
+
+  Printf.printf "\nSuite: crypto-sha3\n";
+  (* NIST FIPS 202 published vectors. *)
+  assert_eq "sha3-256 empty"
+    (String "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a")
+    (call "crypto-sha3-256" [String ""]);
+  assert_eq "sha3-256 abc"
+    (String "3a985da74fe225b2045c172d6bd390bd855f086e3e9d525b46bfe24511431532")
+    (call "crypto-sha3-256" [String "abc"]);
+  assert_eq "sha3-256 896-bit"
+    (String "41c0dba2a9d6240849100376a8235e2c82e1b9998a999e21db32dd97496d3376")
+    (call "crypto-sha3-256"
+       [String "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"]);
+  (* 1600-bit message: 0xa3 * 200 — exercises multi-block absorb (>136B). *)
+  assert_eq "sha3-256 1600-bit 0xa3"
+    (String "79f38adec5c20307a98ef76e8324afbfd46cfd81b22e3973c65fa1bd9de31787")
+    (call "crypto-sha3-256" [String (String.make 200 '\xa3')]);
+
+  Printf.printf "\nSuite: dag-cbor\n";
+  let mkdict pairs =
+    let d = Sx_types.make_dict () in
+    List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs;
+    Dict d
+  in
+  let enc v = call "cbor-encode" [v] in
+  (* RFC 8949 Appendix A — minimal-length deterministic encoding. *)
+  assert_eq "cbor 0"        (String "\x00") (enc (Integer 0));
+  assert_eq "cbor 23"       (String "\x17") (enc (Integer 23));
+  assert_eq "cbor 24"       (String "\x18\x18") (enc (Integer 24));
+  assert_eq "cbor 100"      (String "\x18\x64") (enc (Integer 100));
+  assert_eq "cbor 1000"     (String "\x19\x03\xe8") (enc (Integer 1000));
+  assert_eq "cbor 1000000"
+    (String "\x1a\x00\x0f\x42\x40") (enc (Integer 1000000));
+  assert_eq "cbor -1"       (String "\x20") (enc (Integer (-1)));
+  assert_eq "cbor -100"     (String "\x38\x63") (enc (Integer (-100)));
+  assert_eq "cbor -1000"    (String "\x39\x03\xe7") (enc (Integer (-1000)));
+  assert_eq "cbor false"    (String "\xf4") (enc (Bool false));
+  assert_eq "cbor true"     (String "\xf5") (enc (Bool true));
+  assert_eq "cbor null"     (String "\xf6") (enc Nil);
+  assert_eq "cbor \"\""     (String "\x60") (enc (String ""));
+  assert_eq "cbor \"a\""    (String "\x61\x61") (enc (String "a"));
+  assert_eq "cbor \"IETF\"" (String "\x64IETF") (enc (String "IETF"));
+  assert_eq "cbor []"       (String "\x80") (enc (List []));
+  assert_eq "cbor [1,2,3]"
+    (String "\x83\x01\x02\x03")
+    (enc (List [Integer 1; Integer 2; Integer 3]));
+  assert_eq "cbor [1,[2,3],[4,5]]"
+    (String "\x83\x01\x82\x02\x03\x82\x04\x05")
+    (enc (List [Integer 1;
+                List [Integer 2; Integer 3];
+                List [Integer 4; Integer 5]]));
+  assert_eq "cbor {}" (String "\xa0") (enc (mkdict []));
+  assert_eq "cbor {a:1,b:[2,3]}"
+    (String "\xa2\x61\x61\x01\x61\x62\x82\x02\x03")
+    (enc (mkdict ["a", Integer 1; "b", List [Integer 2; Integer 3]]));
+  assert_eq "cbor {a..e:A..E}"
+    (String "\xa5\x61\x61\x61\x41\x61\x62\x61\x42\x61\x63\x61\x43\x61\x64\x61\x44\x61\x65\x61\x45")
+    (enc (mkdict ["a", String "A"; "b", String "B"; "c", String "C";
+                  "d", String "D"; "e", String "E"]));
+  (* Determinism: insertion order + key length must not change bytes.
+     Sort is length-then-bytewise → a, c, bb. *)
+  let d1 = mkdict ["bb", Integer 2; "a", Integer 1; "c", Integer 3] in
+  let d2 = mkdict ["c", Integer 3; "bb", Integer 2; "a", Integer 1] in
+  assert_eq "cbor det order-invariant" (enc d1) (enc d2);
+  assert_eq "cbor det length-then-bytewise"
+    (String "\xa3\x61\x61\x01\x61\x63\x03\x62\x62\x62\x02")
+    (enc d1);
+  (* Round-trip: decode . encode = identity (structural). *)
+  let roundtrip name v =
+    assert_eq ("cbor rt " ^ name) v (call "cbor-decode" [enc v])
+  in
+  roundtrip "int" (Integer 42);
+  roundtrip "neg" (Integer (-99999));
+  roundtrip "str" (String "hello world");
+  roundtrip "bool" (Bool true);
+  roundtrip "nil" Nil;
+  roundtrip "nested"
+    (List [Integer 1; String "x"; List [Bool false; Nil]]);
+  roundtrip "dict"
+    (mkdict ["k", List [Integer 7]; "name", String "z"]);
+
+  Printf.printf "\nSuite: cid\n";
+  let mh_sha256 s = Sx_cid.multihash 0x12 (Sx_cid.unhex (Sx_sha2.sha256_hex s)) in
+  (* Authoritative vectors (independently derived; match well-known
+     IPFS CIDs). raw "abc" and raw "" — codec 0x55. *)
+  assert_eq "cid raw abc"
+    (String "bafkreif2pall7dybz7vecqka3zo24irdwabwdi4wc55jznaq75q7eaavvu")
+    (call "cid-from-bytes" [Integer 0x55; String (mh_sha256 "abc")]);
+  assert_eq "cid raw empty"
+    (String "bafkreihdwdcefgh4dqkjv67uzcmw7ojee6xedzdetojuzjevtenxquvyku")
+    (call "cid-from-bytes" [Integer 0x55; String (mh_sha256 "")]);
+  (* dag-cbor {} — canonical empty-map CID (sha2-256, codec 0x71). *)
+  assert_eq "cid dag-cbor {}"
+    (String "bafyreigbtj4x7ip5legnfznufuopl4sg4knzc2cof6duas4b3q2fy6swua")
+    (call "cid-from-sx" [mkdict []]);
+  (* Determinism: dict key insertion order must not change the CID. *)
+  let cda = call "cid-from-sx" [mkdict ["b", Integer 2; "a", Integer 1]] in
+  let cdb = call "cid-from-sx" [mkdict ["a", Integer 1; "b", Integer 2]] in
+  assert_eq "cid det order-invariant" cda cdb;
+  assert_true "cid multibase 'b' prefix"
+    (Bool (match call "cid-from-sx" [mkdict []] with
+           | String s -> String.length s > 1 && s.[0] = 'b'
+           | _ -> false));
+
+  Printf.printf "\nSuite: ed25519\n";
+  let hx = Sx_ed25519.unhex in
+  let edv pk msg sg = call "ed25519-verify"
+      [String (hx pk); String (hx msg); String (hx sg)] in
+  (* RFC 8032 §7.1 TEST 1-3 (deterministic; re-derived independently). *)
+  assert_eq "ed25519 RFC T1"
+    (Bool true)
+    (edv "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a"
+         ""
+         "e5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e065224901555fb8821590a33bacc61e39701cf9b46bd25bf5f0595bbe24655141438e7a100b");
+  assert_eq "ed25519 RFC T2"
+    (Bool true)
+    (edv "3d4017c3e843895a92b70aa74d1b7ebc9c982ccf2ec4968cc0cd55f12af4660c"
+         "72"
+         "92a009a9f0d4cab8720e820b5f642540a2b27b5416503f8fb3762223ebdb69da085ac1e43e15996e458f3613d0f11d8c387b2eaeb4302aeeb00d291612bb0c00");
+  assert_eq "ed25519 RFC T3"
+    (Bool true)
+    (edv "fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025"
+         "af82"
+         "6291d657deec24024827e69c3abe01a30ce548a284743a445e3680d7db5ac3ac18ff9b538d16f290ae67f760984dc6594a7c15e9716ed28dc027beceea1ec40a");
+  (* Tampered message -> false. *)
+  assert_eq "ed25519 tampered msg"
+    (Bool false)
+    (edv "fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025"
+         "af83"
+         "6291d657deec24024827e69c3abe01a30ce548a284743a445e3680d7db5ac3ac18ff9b538d16f290ae67f760984dc6594a7c15e9716ed28dc027beceea1ec40a");
+  (* Tampered signature -> false. *)
+  assert_eq "ed25519 tampered sig"
+    (Bool false)
+    (edv "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a"
+         ""
+         "f5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e065224901555fb8821590a33bacc61e39701cf9b46bd25bf5f0595bbe24655141438e7a100b");
+  (* Total: wrong-length pubkey / sig -> false, no exception. *)
+  assert_eq "ed25519 short pubkey"
+    (Bool false)
+    (call "ed25519-verify" [String "abc"; String ""; String (String.make 64 '\000')]);
+  assert_eq "ed25519 short sig"
+    (Bool false)
+    (call "ed25519-verify"
+       [String (hx "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a");
+        String ""; String "short"]);
+  assert_eq "ed25519 non-string args"
+    (Bool false)
+    (call "ed25519-verify" [Integer 1; Integer 2; Integer 3]);
+
+  Printf.printf "\nSuite: rsa-sha256\n";
+  (* Fixed RSA-2048 vector: one-off python-cryptography keygen +
+     PKCS1v15/SHA-256 sign of "fed-sx phase F rsa test". *)
+  let rhx = Sx_rsa.unhex in
+  let spki = rhx "30820122300d06092a864886f70d01010105000382010f003082010a0282010100a117b573480bce5a08b54a98384001df26d062e9173caaee2e3a2d0045c6d16f99b2a1e7fb60763f65f95f8c39ff82c18b8590338042914331db3440a06d2dbe65a2f82c82f37d293f67a8b57a1f9014b55150a093cfee90257ef3b4a215d5ab002579bd92b6fcb3536777d51b639347d01e307ddafb209073dd9b8d6a507157c44c624a19b3b9275931472462870ae02132630159132a85c1c889adfb358b6bbd3760ce3fffe6285964833a10ee436d5bc33dfab7f9ed630a74e9a32e5688f5a7797f7cc839ad2494dd1c4c4a8fab844cd26208794bf2602c16b9d12bde434066d8c0dd2d20489f4070f883bae2b4508ead4a1b80b44c576e9e37bdb5df69f10203010001" in
+  let rmsg = rhx "6665642d73782070686173652046207273612074657374" in
+  let rsig = rhx "5e1593d674ed15c0172546d38efdf1aebd252f4b0c0dfbe1f7996fd569d0bfd9f3e8689ea2b14aa45b5fc3f0a05d4f23c6b02b8820d71f6998ea3b5b0d071bb33142236e388b1226ece3ec447d33b38999f189c37564cf052cf038de94c67b2ddf9a97d5a73554bb88818f615824517209a4083258965adace55658f344104eaa0d5f2f44ea00cfac8754674aade87b40d955cccd1ccd9b7649a08b66ce3bc5dba2de96b3e859488ded3ef9fb3744a1e3495fd14841d8319b3cc08054c729d1c02739ee314eba2b20fac46e463f47eb67183d8455583eca73ba37448164612dd9cd77877135d30d12084c2843f986a5b8ad59c6600f9855b91d7cbdf7c6c4b0e" in
+  let rsav s m g = call "rsa-sha256-verify" [String s; String m; String g] in
+  assert_eq "rsa valid" (Bool true) (rsav spki rmsg rsig);
+  assert_eq "rsa tampered msg" (Bool false)
+    (rsav spki (rmsg ^ "x") rsig);
+  assert_eq "rsa tampered sig" (Bool false)
+    (rsav spki rmsg
+       (rhx "5f1593d674ed15c0172546d38efdf1aebd252f4b0c0dfbe1f7996fd569d0bfd9f3e8689ea2b14aa45b5fc3f0a05d4f23c6b02b8820d71f6998ea3b5b0d071bb33142236e388b1226ece3ec447d33b38999f189c37564cf052cf038de94c67b2ddf9a97d5a73554bb88818f615824517209a4083258965adace55658f344104eaa0d5f2f44ea00cfac8754674aade87b40d955cccd1ccd9b7649a08b66ce3bc5dba2de96b3e859488ded3ef9fb3744a1e3495fd14841d8319b3cc08054c729d1c02739ee314eba2b20fac46e463f47eb67183d8455583eca73ba37448164612dd9cd77877135d30d12084c2843f986a5b8ad59c6600f9855b91d7cbdf7c6c4b0e"));
+  assert_eq "rsa garbage spki" (Bool false)
+    (rsav "not der" rmsg rsig);
+  assert_eq "rsa non-string args" (Bool false)
+    (call "rsa-sha256-verify" [Integer 1; Integer 2; Integer 3]);
+
+  Printf.printf "\nSuite: file-list-dir\n";
+  let expect_err nm f =
+    (try ignore (f ());
+       incr fail_count; Printf.printf "  FAIL: %s — no error\n" nm
+     with Eval_error _ ->
+       incr pass_count; Printf.printf "  PASS: %s\n" nm
+        | _ ->
+       incr fail_count; Printf.printf "  FAIL: %s — wrong exn\n" nm)
+  in
+  let tmp = Filename.temp_file "fld" "" in
+  Sys.remove tmp; Unix.mkdir tmp 0o755;
+  let touch n = let oc = open_out (Filename.concat tmp n) in close_out oc in
+  touch "b.txt"; touch "a.txt"; touch "c.txt";
+  assert_eq "file-list-dir sorted"
+    (List [String "a.txt"; String "b.txt"; String "c.txt"])
+    (call "file-list-dir" [String tmp]);
+  expect_err "file-list-dir missing"
+    (fun () -> call "file-list-dir" [String (Filename.concat tmp "nope")]);
+  expect_err "file-list-dir not-a-dir"
+    (fun () -> call "file-list-dir" [String (Filename.concat tmp "a.txt")]);
+  expect_err "file-list-dir arity"
+    (fun () -> call "file-list-dir" []);
+  (* best-effort cleanup *)
+  (try List.iter (fun n -> Sys.remove (Filename.concat tmp n))
+         ["a.txt"; "b.txt"; "c.txt"]; Unix.rmdir tmp
+   with _ -> ());
+
+  Printf.printf "\nSuite: vm-extension-dispatch\n";
+  let make_bc op = ({
+    vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
+    vc_bytecode = [| op |]; vc_constants = [||];
+    vc_bytecode_list = None; vc_constants_list = None;
+  } : Sx_types.vm_code) in
+  let expect_invalid_opcode label op =
+    let globals = Hashtbl.create 1 in
+    try
+      let _ = Sx_vm.execute_module (make_bc op) globals in
+      incr fail_count;
+      Printf.printf "  FAIL: %s — expected Invalid_opcode, got a result\n" label
+    with
+    | Sx_vm.Invalid_opcode n when n = op ->
+      incr pass_count;
+      Printf.printf "  PASS: %s\n" label
+    | exn ->
+      incr fail_count;
+      Printf.printf "  FAIL: %s — unexpected: %s\n" label (Printexc.to_string exn)
+  in
+  expect_invalid_opcode "opcode 200 raises Invalid_opcode 200" 200;
+  expect_invalid_opcode "opcode 224 raises Invalid_opcode 224" 224;
+  expect_invalid_opcode "opcode 247 raises Invalid_opcode 247" 247;
+  (* Opcode 199 sits just below the extension threshold — should fall to the
+     catch-all (Eval_error), proving the threshold is at 200, not 199. *)
+  let globals = Hashtbl.create 1 in
+  (try
+     let _ = Sx_vm.execute_module (make_bc 199) globals in
+     incr fail_count;
+     Printf.printf "  FAIL: opcode 199 — expected Eval_error, got a result\n"
+   with
+   | Sx_vm.Invalid_opcode _ ->
+     incr fail_count;
+     Printf.printf "  FAIL: opcode 199 routed to extension dispatch (threshold wrong)\n"
+   | Sx_types.Eval_error _ ->
+     incr pass_count;
+     Printf.printf "  PASS: opcode 199 stays in core (catch-all)\n"
+   | exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: opcode 199 — unexpected: %s\n" (Printexc.to_string exn));
+
+  Printf.printf "\nSuite: vm-extension-registry\n";
+  (* Sx_vm_extensions self-installs its dispatcher at module init.  Reset
+     the registry so prior loaded extensions don't interfere with this
+     test. *)
+  Sx_vm_extensions._reset_for_tests ();
+  let module TestExt : Sx_vm_extension.EXTENSION = struct
+    let name = "test_reg"
+    let init () = TestRegState (ref 0)
+    let opcodes _st = [
+      (210, "test_reg.OP_PUSH_42", (fun vm _frame ->
+        Sx_vm.push vm (Sx_types.Integer 42)));
+      (211, "test_reg.OP_DOUBLE_TOS", (fun vm _frame ->
+        let v = Sx_vm.pop vm in
+        match v with
+        | Sx_types.Integer n -> Sx_vm.push vm (Sx_types.Integer (n * 2))
+        | _ -> failwith "OP_DOUBLE_TOS: not an integer"));
+    ]
+  end in
+  Sx_vm_extensions.register (module TestExt);
+
+  (match Sx_vm_extensions.id_of_name "test_reg.OP_PUSH_42" with
+   | Some 210 ->
+     incr pass_count;
+     Printf.printf "  PASS: id_of_name resolves opcode\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: id_of_name: got %s\n"
+       (match other with Some n -> string_of_int n | None -> "None"));
+
+  (match Sx_vm_extensions.id_of_name "nonexistent.OP" with
+   | None ->
+     incr pass_count;
+     Printf.printf "  PASS: id_of_name returns None for unknown\n"
+   | Some _ ->
+     incr fail_count;
+     Printf.printf "  FAIL: id_of_name should return None for unknown\n");
+
+  (match Sx_vm_extensions.state_of_extension "test_reg" with
+   | Some (TestRegState _) ->
+     incr pass_count;
+     Printf.printf "  PASS: state_of_extension returns extension state\n"
+   | _ ->
+     incr fail_count;
+     Printf.printf "  FAIL: state_of_extension lookup\n");
+
+  (match Sx_vm_extensions.state_of_extension "nonexistent" with
+   | None ->
+     incr pass_count;
+     Printf.printf "  PASS: state_of_extension None for unknown\n"
+   | Some _ ->
+     incr fail_count;
+     Printf.printf "  FAIL: state_of_extension should be None\n");
+
+  (* End-to-end dispatch through the VM. Bytecode runs OP_PUSH_42 then
+     OP_RETURN (50); execute_module pops the result. *)
+  let make_bc_seq bytes = ({
+    vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
+    vc_bytecode = bytes; vc_constants = [||];
+    vc_bytecode_list = None; vc_constants_list = None;
+  } : Sx_types.vm_code) in
+  (let globals = Hashtbl.create 1 in
+   try
+     match Sx_vm.execute_module (make_bc_seq [| 210; 50 |]) globals with
+     | Integer 42 ->
+       incr pass_count;
+       Printf.printf "  PASS: dispatch routes opcode 210 -> push 42\n"
+     | other ->
+       incr fail_count;
+       Printf.printf "  FAIL: dispatch opcode 210: got %s\n"
+         (Sx_types.inspect other)
+   with exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: dispatch opcode 210 raised: %s\n"
+       (Printexc.to_string exn));
+
+  (* Compose two extension opcodes: PUSH_42 then DOUBLE_TOS then RETURN.
+     Verifies that successive extension dispatches share VM state. *)
+  (let globals = Hashtbl.create 1 in
+   try
+     match Sx_vm.execute_module (make_bc_seq [| 210; 211; 50 |]) globals with
+     | Integer 84 ->
+       incr pass_count;
+       Printf.printf "  PASS: extension opcodes compose (42 -> 84)\n"
+     | other ->
+       incr fail_count;
+       Printf.printf "  FAIL: composed opcodes: got %s\n"
+         (Sx_types.inspect other)
+   with exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: composed opcodes raised: %s\n"
+       (Printexc.to_string exn));
+
+  (* Duplicate opcode-id detection. *)
+  let module DupExt : Sx_vm_extension.EXTENSION = struct
+    let name = "dup_check"
+    let init () = TestRegState (ref 0)
+    let opcodes _st = [
+      (210, "dup_check.OP_X", (fun _vm _frame -> ()));
+    ]
+  end in
+  (try
+     Sx_vm_extensions.register (module DupExt);
+     incr fail_count;
+     Printf.printf "  FAIL: duplicate opcode id should have raised\n"
+   with Failure _ ->
+     incr pass_count;
+     Printf.printf "  PASS: duplicate opcode id rejected\n");
+
+  (* Out-of-range opcode-id detection. *)
+  let module OutExt : Sx_vm_extension.EXTENSION = struct
+    let name = "out_of_range"
+    let init () = TestRegState (ref 0)
+    let opcodes _st = [
+      (300, "out_of_range.OP_X", (fun _vm _frame -> ()));
+    ]
+  end in
+  (try
+     Sx_vm_extensions.register (module OutExt);
+     incr fail_count;
+     Printf.printf "  FAIL: out-of-range opcode should have raised\n"
+   with Failure _ ->
+     incr pass_count;
+     Printf.printf "  PASS: out-of-range opcode rejected\n");
+
+  (* Duplicate extension-name detection. *)
+  let module SameNameExt : Sx_vm_extension.EXTENSION = struct
+    let name = "test_reg"  (* same as TestExt above *)
+    let init () = TestRegState (ref 0)
+    let opcodes _st = []
+  end in
+  (try
+     Sx_vm_extensions.register (module SameNameExt);
+     incr fail_count;
+     Printf.printf "  FAIL: duplicate extension name should have raised\n"
+   with Failure _ ->
+     incr pass_count;
+     Printf.printf "  PASS: duplicate extension name rejected\n");
+
+  Printf.printf "\nSuite: extension-opcode-id primitive\n";
+  let prim = Hashtbl.find Sx_primitives.primitives "extension-opcode-id" in
+
+  (* Known opcode (registered by TestExt above). *)
+  (match prim [String "test_reg.OP_PUSH_42"] with
+   | Integer 210 ->
+     incr pass_count;
+     Printf.printf "  PASS: primitive returns Integer for registered opcode\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: registered opcode lookup: got %s\n"
+       (Sx_types.inspect other));
+
+  (* Unknown opcode → Nil. *)
+  (match prim [String "nonexistent.OP_X"] with
+   | Nil ->
+     incr pass_count;
+     Printf.printf "  PASS: primitive returns nil for unknown opcode\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: unknown opcode lookup: got %s\n"
+       (Sx_types.inspect other));
+
+  (* Symbol arg also accepted (compilers may pass quoted symbols). *)
+  (match prim [Symbol "test_reg.OP_DOUBLE_TOS"] with
+   | Integer 211 ->
+     incr pass_count;
+     Printf.printf "  PASS: primitive accepts Symbol args\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: symbol arg: got %s\n" (Sx_types.inspect other));
+
+  (* Wrong arity / type raises Eval_error. *)
+  (try
+     let _ = prim [] in
+     incr fail_count;
+     Printf.printf "  FAIL: zero args should have raised\n"
+   with Sx_types.Eval_error _ ->
+     incr pass_count;
+     Printf.printf "  PASS: zero args rejected\n");
+
+  (try
+     let _ = prim [Integer 42] in
+     incr fail_count;
+     Printf.printf "  FAIL: integer arg should have raised\n"
+   with Sx_types.Eval_error _ ->
+     incr pass_count;
+     Printf.printf "  PASS: integer arg rejected\n");
+
+  Printf.printf "\nSuite: extensions/test_ext (canonical extension)\n";
+  (* Phase D: the real test extension lives at lib/extensions/test_ext.ml.
+     Register it on top of the inline test_reg from earlier suites — the
+     two use disjoint opcode IDs (210/211 vs 220/221) so they coexist. *)
+  Test_ext.register ();
+
+  (* Lookup via the public primitive should now find OP_TEST_PUSH_42. *)
+  (match prim [String "test_ext.OP_TEST_PUSH_42"] with
+   | Integer 220 ->
+     incr pass_count;
+     Printf.printf "  PASS: extension-opcode-id finds test_ext.OP_TEST_PUSH_42\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: opcode lookup: got %s\n" (Sx_types.inspect other));
+
+  (* End-to-end: PUSH_42 + DOUBLE_TOS + RETURN. *)
+  (let globals = Hashtbl.create 1 in
+   try
+     match Sx_vm.execute_module (make_bc_seq [| 220; 221; 50 |]) globals with
+     | Integer 84 ->
+       incr pass_count;
+       Printf.printf "  PASS: extensions/test_ext bytecode executes (84)\n"
+     | other ->
+       incr fail_count;
+       Printf.printf "  FAIL: test_ext bytecode result: got %s\n"
+         (Sx_types.inspect other)
+   with exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: test_ext bytecode raised: %s\n"
+       (Printexc.to_string exn));
+
+  (* Disassembly: opcode_name should resolve 220/221 via the registry,
+     not fall back to UNKNOWN_220 / UNKNOWN_221.  disassemble returns a
+     Dict; the instruction list lives at key "bytecode". *)
+  (let code = make_bc_seq [| 220; 221; 50 |] in
+   let dis = Sx_vm.disassemble code in
+   let entries = match dis with
+     | Dict d -> (match Hashtbl.find_opt d "bytecode" with
+                  | Some (List es) -> es
+                  | _ -> [])
+     | _ -> []
+   in
+   let names = List.filter_map (fun entry -> match entry with
+     | Dict d ->
+       (match Hashtbl.find_opt d "opcode" with
+        | Some (String name) -> Some name
+        | _ -> None)
+     | _ -> None) entries
+   in
+   let has name = List.mem name names in
+   if has "test_ext.OP_TEST_PUSH_42" && has "test_ext.OP_TEST_DOUBLE_TOS" then begin
+     incr pass_count;
+     Printf.printf "  PASS: disassemble shows extension opcode names\n"
+   end else begin
+     incr fail_count;
+     Printf.printf "  FAIL: disassemble names: [%s]\n" (String.concat ", " names)
+   end);
+
+  (* Sanity: opcode_name on an unregistered extension opcode still
+     returns UNKNOWN_n.  Pick 230 — out of test_ext's range. *)
+  (match Sx_vm.opcode_name 230 with
+   | "UNKNOWN_230" ->
+     incr pass_count;
+     Printf.printf "  PASS: unregistered ext opcode falls back to UNKNOWN_n\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: opcode_name 230: got %s\n" other);
+
+  (* Per-extension state: invocation_count should reflect the two opcodes
+     that ran in the dispatch test above. *)
+  (match Test_ext.invocation_count () with
+   | Some n when n >= 2 ->
+     incr pass_count;
+     Printf.printf "  PASS: extension state recorded %d invocations\n" n
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: invocation_count: %s\n"
+       (match other with Some n -> string_of_int n | None -> "None"));
+
+  Printf.printf "\nSuite: extensions/erlang_ext (Phase 9h)\n";
+  (* Register the Erlang opcode namespace. Disjoint id range (200-217)
+     from test_ext (220/221) so they coexist. *)
+  Erlang_ext.register ();
+
+  (match prim [String "erlang.OP_PATTERN_TUPLE"] with
+   | Integer 222 ->
+     incr pass_count;
+     Printf.printf "  PASS: extension-opcode-id erlang.OP_PATTERN_TUPLE = 222\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: erlang.OP_PATTERN_TUPLE: got %s\n"
+       (Sx_types.inspect other));
+
+  (match prim [String "erlang.OP_BIF_IS_TUPLE"] with
+   | Integer 239 ->
+     incr pass_count;
+     Printf.printf "  PASS: extension-opcode-id erlang.OP_BIF_IS_TUPLE = 239\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: erlang.OP_BIF_IS_TUPLE: got %s\n"
+       (Sx_types.inspect other));
+
+  (match prim [String "erlang.OP_NONEXISTENT"] with
+   | Nil ->
+     incr pass_count;
+     Printf.printf "  PASS: unknown erlang opcode -> nil\n"
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: unknown erlang opcode: got %s\n"
+       (Sx_types.inspect other));
+
+  (* Phase 10b vertical slice: erlang.OP_BIF_LENGTH (230) is a REAL
+     handler. Build [CONST 0; OP_BIF_LENGTH; RETURN] with an Erlang
+     list [1,2,3] in the constant pool; expect Integer 3. Proves the
+     full path: bytecode -> Sx_vm extension fallthrough -> erlang_ext
+     handler -> correct stack result. *)
+  (let mk_dict kvs =
+     let h = Hashtbl.create 4 in
+     List.iter (fun (k, v) -> Hashtbl.replace h k v) kvs;
+     Sx_types.Dict h in
+   let er_nil = mk_dict [("tag", Sx_types.String "nil")] in
+   let er_cons hd tl =
+     mk_dict [("tag", Sx_types.String "cons");
+              ("head", hd); ("tail", tl)] in
+   let lst = er_cons (Sx_types.Integer 1)
+               (er_cons (Sx_types.Integer 2)
+                  (er_cons (Sx_types.Integer 3) er_nil)) in
+   let code = ({
+     vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
+     vc_bytecode = [| 1; 0; 0; 230; 50 |];
+     vc_constants = [| lst |];
+     vc_bytecode_list = None; vc_constants_list = None;
+   } : Sx_types.vm_code) in
+   let globals = Hashtbl.create 1 in
+   try
+     match Sx_vm.execute_module code globals with
+     | Integer 3 ->
+       incr pass_count;
+       Printf.printf "  PASS: erlang.OP_BIF_LENGTH [1,2,3] -> 3 (real handler, end-to-end)\n"
+     | other ->
+       incr fail_count;
+       Printf.printf "  FAIL: OP_BIF_LENGTH result: got %s\n"
+         (Sx_types.inspect other)
+   with exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: OP_BIF_LENGTH raised: %s\n"
+       (Printexc.to_string exn));
+
+  (* More real handlers (Phase 10b batch): build a list/tuple constant
+     and exercise HD/TL/TUPLE_SIZE/IS_* end-to-end through the VM. *)
+  (let mk_dict kvs =
+     let h = Hashtbl.create 4 in
+     List.iter (fun (k, v) -> Hashtbl.replace h k v) kvs;
+     Sx_types.Dict h in
+   let er_nil = mk_dict [("tag", Sx_types.String "nil")] in
+   let er_cons hd tl = mk_dict [("tag", Sx_types.String "cons");
+                                ("head", hd); ("tail", tl)] in
+   let er_tuple es = mk_dict [("tag", Sx_types.String "tuple");
+                              ("elements", Sx_types.List es)] in
+   let er_atom nm = mk_dict [("tag", Sx_types.String "atom");
+                             ("name", Sx_types.String nm)] in
+   let lst3 = er_cons (Sx_types.Integer 7)
+                (er_cons (Sx_types.Integer 8)
+                   (er_cons (Sx_types.Integer 9) er_nil)) in
+   let tup3 = er_tuple [Sx_types.Integer 1; Sx_types.Integer 2;
+                        Sx_types.Integer 3] in
+   let run consts bc =
+     let code = ({
+       vc_arity = 0; vc_rest_arity = -1; vc_locals = 0;
+       vc_bytecode = bc; vc_constants = consts;
+       vc_bytecode_list = None; vc_constants_list = None;
+     } : Sx_types.vm_code) in
+     Sx_vm.execute_module code (Hashtbl.create 1) in
+   let nm = function
+     | Sx_types.Dict d ->
+       (match Hashtbl.find_opt d "name" with
+        | Some (Sx_types.String s) -> s | _ -> "?")
+     | _ -> "?" in
+   let check label want got =
+     if got = want then begin
+       incr pass_count;
+       Printf.printf "  PASS: %s\n" label
+     end else begin
+       incr fail_count;
+       Printf.printf "  FAIL: %s: got %s\n" label (Sx_types.inspect got)
+     end in
+   (* HD [7,8,9] -> 7 *)
+   check "OP_BIF_HD [7,8,9] -> 7" (Sx_types.Integer 7)
+     (run [| lst3 |] [| 1;0;0; 231; 50 |]);
+   (* TL [7,8,9] -> [8,9], check its HD = 8 *)
+   check "OP_BIF_TL then HD -> 8" (Sx_types.Integer 8)
+     (run [| lst3 |] [| 1;0;0; 232; 231; 50 |]);
+   (* TUPLE_SIZE {1,2,3} -> 3 *)
+   check "OP_BIF_TUPLE_SIZE {1,2,3} -> 3" (Sx_types.Integer 3)
+     (run [| tup3 |] [| 1;0;0; 234; 50 |]);
+   (* IS_INTEGER 42 -> true ; IS_INTEGER [..] -> false *)
+   (match run [| Sx_types.Integer 42 |] [| 1;0;0; 236; 50 |] with
+    | v when nm v = "true" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_INTEGER 42 -> true\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_INTEGER 42: got %s\n" (Sx_types.inspect v));
+   (match run [| lst3 |] [| 1;0;0; 236; 50 |] with
+    | v when nm v = "false" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_INTEGER list -> false\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_INTEGER list: got %s\n" (Sx_types.inspect v));
+   (* IS_ATOM atom -> true ; IS_LIST nil -> true ; IS_TUPLE tuple -> true *)
+   (match run [| er_atom "ok" |] [| 1;0;0; 237; 50 |] with
+    | v when nm v = "true" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_ATOM ok -> true\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_ATOM: got %s\n" (Sx_types.inspect v));
+   (match run [| er_nil |] [| 1;0;0; 238; 50 |] with
+    | v when nm v = "true" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_LIST nil -> true\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_LIST nil: got %s\n" (Sx_types.inspect v));
+   (match run [| tup3 |] [| 1;0;0; 239; 50 |] with
+    | v when nm v = "true" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_TUPLE {..} -> true\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_TUPLE: got %s\n" (Sx_types.inspect v));
+   (match run [| tup3 |] [| 1;0;0; 238; 50 |] with
+    | v when nm v = "false" ->
+      incr pass_count; Printf.printf "  PASS: OP_BIF_IS_LIST tuple -> false\n"
+    | v -> incr fail_count;
+      Printf.printf "  FAIL: IS_LIST tuple: got %s\n" (Sx_types.inspect v));
+   (* ELEMENT: element(2, {1,2,3}) -> 2. Calling convention: push
+      Index then Tuple; opcode pops Tuple (TOS) then Index. *)
+   check "OP_BIF_ELEMENT element(2,{1,2,3}) -> 2" (Sx_types.Integer 2)
+     (run [| Sx_types.Integer 2; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
+   check "OP_BIF_ELEMENT element(1,{1,2,3}) -> 1" (Sx_types.Integer 1)
+     (run [| Sx_types.Integer 1; tup3 |] [| 1;0;0; 1;1;0; 233; 50 |]);
+   (* ELEMENT out of range raises *)
+   (let raised =
+      (try ignore (run [| Sx_types.Integer 9; tup3 |]
+                     [| 1;0;0; 1;1;0; 233; 50 |]); false
+       with Sx_types.Eval_error _ -> true) in
+    if raised then begin
+      incr pass_count;
+      Printf.printf "  PASS: OP_BIF_ELEMENT out-of-range raises\n"
+    end else begin
+      incr fail_count;
+      Printf.printf "  FAIL: OP_BIF_ELEMENT out-of-range should raise\n"
+    end);
+   (* LISTS_REVERSE [7,8,9] -> [9,8,7]; verify HD = 9 then HD of TL = 8 *)
+   check "OP_BIF_LISTS_REVERSE then HD -> 9" (Sx_types.Integer 9)
+     (run [| lst3 |] [| 1;0;0; 235; 231; 50 |]);
+   check "OP_BIF_LISTS_REVERSE then TL,HD -> 8" (Sx_types.Integer 8)
+     (run [| lst3 |] [| 1;0;0; 235; 232; 231; 50 |]);
+   (* reverse preserves length *)
+   check "OP_BIF_LISTS_REVERSE then LENGTH -> 3" (Sx_types.Integer 3)
+     (run [| lst3 |] [| 1;0;0; 235; 230; 50 |]));
+
+  (* A still-stubbed opcode (222 = erlang.OP_PATTERN_TUPLE) raises the
+     not-wired Eval_error — confirms the honest-failure path remains
+     for opcodes whose real handlers haven't landed. *)
+  (let globals = Hashtbl.create 1 in
+   try
+     ignore (Sx_vm.execute_module (make_bc_seq [| 222; 50 |]) globals);
+     incr fail_count;
+     Printf.printf "  FAIL: erlang.OP_PATTERN_TUPLE dispatch should have raised\n"
+   with
+   | Sx_types.Eval_error msg
+     when (let needle = "not yet wired" in
+           let nl = String.length needle and ml = String.length msg in
+           let rec scan i =
+             if i + nl > ml then false
+             else if String.sub msg i nl = needle then true
+             else scan (i + 1)
+           in scan 0) ->
+     incr pass_count;
+     Printf.printf "  PASS: erlang opcode dispatch raises not-wired error\n"
+   | exn ->
+     incr fail_count;
+     Printf.printf "  FAIL: unexpected exn: %s\n" (Printexc.to_string exn));
+
+  (match Erlang_ext.dispatch_count () with
+   | Some n when n >= 1 ->
+     incr pass_count;
+     Printf.printf "  PASS: erlang_ext state recorded %d dispatch(es)\n" n
+   | other ->
+     incr fail_count;
+     Printf.printf "  FAIL: dispatch_count: %s\n"
+       (match other with Some n -> string_of_int n | None -> "None"));
+
+  Printf.printf "\nSuite: jit extension-opcode awareness\n";
+  let scan = Sx_vm.bytecode_uses_extension_opcodes in
+  let no_consts = [||] in
+
+  (* Pure core ops: scan reports false. *)
+  (* OP_TRUE OP_RETURN *)
+  if not (scan [| 3; 50 |] no_consts) then begin
+    incr pass_count;
+    Printf.printf "  PASS: pure core bytecode is JIT-eligible\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: pure core bytecode flagged as extension\n"
+  end;
+
+  (* Extension opcode anywhere → true. *)
+  if scan [| 220; 50 |] no_consts then begin
+    incr pass_count;
+    Printf.printf "  PASS: extension opcode detected at head\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: extension opcode at head missed\n"
+  end;
+
+  (* Mixed: core + extension → true. *)
+  if scan [| 3; 220; 50 |] no_consts then begin
+    incr pass_count;
+    Printf.printf "  PASS: extension opcode detected after core ops\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: extension opcode after core ops missed\n"
+  end;
+
+  (* Operand bytes ≥200 must NOT trigger.  CONST u16 with index 220
+     into a synthetic constant pool — the operand is 220 (lo) 0 (hi),
+     not an opcode.  The pool entry at 220 is irrelevant for the scan. *)
+  let big_consts = Array.make 256 Nil in
+  if not (scan [| 1; 220; 0; 50 |] big_consts) then begin
+    incr pass_count;
+    Printf.printf "  PASS: CONST operand ≥200 not a false positive\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: CONST operand ≥200 false-positives as ext op\n"
+  end;
+
+  (* CALL_PRIM has 3 operand bytes (u16 + u8); all ≥200 should not
+     trigger. *)
+  if not (scan [| 52; 220; 200; 200; 50 |] big_consts) then begin
+    incr pass_count;
+    Printf.printf "  PASS: CALL_PRIM operands ≥200 not a false positive\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: CALL_PRIM operands ≥200 false-positive\n"
+  end;
+
+  (* CLOSURE with upvalue descriptors: scan must skip the 2 + 2*n
+     dynamic operand bytes.  Build a synthetic constant pool with a
+     Dict at index 0 declaring upvalue-count 1, descriptors that are
+     ≥200 — the scan should skip them and not trigger.
+
+     Bytecode layout: CLOSURE 0 0  desc_is_local desc_index  RETURN
+                       op    lo hi      210         220       50
+     With upvalue-count = 1, scan must advance past the 2-byte CLOSURE
+     operand AND the 2 descriptor bytes (210, 220), landing on RETURN. *)
+  let cl_consts = Array.make 1 Nil in
+  let dict = Hashtbl.create 1 in
+  Hashtbl.replace dict "upvalue-count" (Integer 1);
+  cl_consts.(0) <- Dict dict;
+  if not (scan [| 51; 0; 0; 210; 220; 50 |] cl_consts) then begin
+    incr pass_count;
+    Printf.printf "  PASS: CLOSURE upvalue descriptors ≥200 skipped\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: CLOSURE upvalue descriptors false-positive\n"
+  end;
+
+  (* Sanity: opcode after CLOSURE+descriptors that IS an extension
+     opcode triggers correctly. *)
+  if scan [| 51; 0; 0; 210; 220; 221; 50 |] cl_consts then begin
+    incr pass_count;
+    Printf.printf "  PASS: extension opcode after CLOSURE detected\n"
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: extension opcode after CLOSURE missed\n"
+  end
 
 
 (* ====================================================================== *)
@@ -1984,10 +2812,13 @@ let run_spec_tests env test_files =
               | "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
               | "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
               | "scrollTo" | "scroll" | "reset" -> Bool true
-              | "firstElementChild" ->
+              | "firstElementChild" | "firstChild" ->
+                (* the mock treats element children and child nodes alike, so
+                   firstChild == firstElementChild — children-to-fragment walks
+                   firstChild to drain a parsed fragment into a swap target. *)
                 let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                 (match kids with c :: _ -> c | [] -> Nil)
-              | "lastElementChild" ->
+              | "lastElementChild" | "lastChild" ->
                 let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                 (match List.rev kids with c :: _ -> c | [] -> Nil)
               | "nextElementSibling" | "nextSibling" ->
@@ -2133,6 +2964,15 @@ let run_spec_tests env test_files =
        | "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
        | "clearTimeout" -> Nil
        | _ -> Nil)
+    (* NodeList.item(i) — dom-query-all iterates the querySelectorAll result
+       (a bare List) via this method, exactly like a browser NodeList. *)
+    | (List _ | ListRef _) :: String "item" :: [idx] ->
+      let items = match args with
+        | List l :: _ -> l
+        | ListRef { contents = l } :: _ -> l
+        | _ -> [] in
+      let i = match idx with Number n -> int_of_float n | Integer n -> n | _ -> -1 in
+      if i >= 0 && i < List.length items then List.nth items i else Nil
     | Dict d :: String "hasOwnProperty" :: [String k] ->
       Bool (Hashtbl.mem d k)
     | Dict d :: String m :: rest ->
@@ -2242,6 +3082,26 @@ let run_spec_tests env test_files =
         (* console.log/debug/error — no-op in tests *)
         Nil
 
+      else if mt = "domparser" then
+        (* DOMParser.parseFromString(text, "text/html") — returns a mock
+           document whose <body> is parsed from `text`. An empty string yields
+           a valid empty document (truthy), matching the browser: that's what
+           the engine's handle-html-response relies on for an empty-body
+           sx-swap="delete" response. *)
+        (match m with
+         | "parseFromString" ->
+           let text = match rest with String t :: _ -> t | _ -> "" in
+           let bd = match make_mock_element "body" with Dict d -> d | _ -> Hashtbl.create 0 in
+           Hashtbl.replace bd "tagName" (String "BODY");
+           Hashtbl.replace bd "nodeName" (String "BODY");
+           parse_html_into bd text;
+           Hashtbl.replace bd "innerHTML" (String text);
+           let doc = Hashtbl.create 4 in
+           Hashtbl.replace doc "__mock_type" (String "document");
+           Hashtbl.replace doc "body" (Dict bd);
+           Dict doc
+         | _ -> Nil)
+
       else
         (* Element methods *)
         (match m with
@@ -2655,6 +3515,10 @@ let run_spec_tests env test_files =
       Dict ev
     | [String "Object"] ->
       Dict (Hashtbl.create 4)
+    | [String "DOMParser"] ->
+      let d = Hashtbl.create 4 in
+      Hashtbl.replace d "__mock_type" (String "domparser");
+      Dict d
     | _ -> Nil);
 
   reg "host-callback" (fun args ->
@@ -2688,6 +3552,32 @@ let run_spec_tests env test_files =
 
   reg "host-await" (fun _args -> Nil);
 
+  (* host-call-fn: hyperscript's call bridge — (host-call-fn fn arg-list). In a
+     real host it reaches into JS; in the headless mock it is simply apply. This
+     was the single biggest gap: ~900 behavioral tests failed on "Undefined
+     symbol: host-call-fn". host-call-fn-raising propagates errors (used by the
+     try/catch machinery); host-new-function can't run raw JS headless so stubs. *)
+  let list_elems = function
+    | List l | ListRef { contents = l } -> l
+    | Nil -> []
+    | v -> [v] in
+  reg "host-call-fn" (fun args ->
+    match args with
+    | fn :: rest ->
+      let call_args = match rest with a :: _ -> list_elems a | [] -> [] in
+      (try Sx_ref.cek_call fn (List call_args)
+       with e -> Printf.eprintf "[mock] host-call-fn error: %s\n%!" (Printexc.to_string e); Nil)
+    | _ -> Nil);
+  reg "host-call-fn-raising" (fun args ->
+    match args with
+    | fn :: rest ->
+      let call_args = match rest with a :: _ -> list_elems a | [] -> [] in
+      Sx_ref.cek_call fn (List call_args)
+    | _ -> Nil);
+  reg "host-new-function" (fun _ -> NativeFn ("host-new-function-stub", fun _ -> Nil));
+  reg "host-iter?" (fun _ -> Bool false);
+  reg "host-to-list" (fun args -> match args with [v] -> List (list_elems v) | _ -> List []);
+
   (* Minimal JSON parse/stringify used by hs-coerce (as JSON / as JSONString). *)
   let rec json_of_value = function
     | Nil -> `Null
@@ -2832,6 +3722,7 @@ let run_spec_tests env test_files =
   load_module "router.sx" web_dir;
   load_module "deps.sx" web_dir;
   load_module "orchestration.sx" web_dir;
+  load_module "console-render.sx" web_dir;
   (* Library modules for lib/tests/ *)
   load_module "bytecode.sx" lib_dir;
   load_module "compiler.sx" lib_dir;

hosts/ocaml/bin/sx_server.ml

@@ -18,6 +18,28 @@
 
 open Sx_types
 
+(* Force-link Sx_vm_extensions so its module-init runs: installs the
+   extension dispatch fallthrough and registers the `extension-opcode-id`
+   SX primitive. Without a reference here OCaml dead-code-eliminates the
+   module from sx_server.exe (it's only otherwise reached from run_tests),
+   leaving guest-language opcode extensions (Erlang Phase 9, etc.)
+   invisible to the runtime. The applied call is a harmless lookup. *)
+let () = ignore (Sx_vm_extensions.id_of_name "")
+
+(* Register the Erlang opcode extension (Phase 9h) so
+   `extension-opcode-id "erlang.OP_*"` resolves to the host ids the SX
+   stub dispatcher consults. Guarded: a double-register raises Failure,
+   which we swallow so a re-entered server process doesn't die. *)
+let () = try Erlang_ext.register () with Failure _ -> ()
+
+(* Ignore SIGPIPE: a client that closes its connection mid-response (a browser
+   aborting an in-flight fetch — the SX engine cancels superseded requests on a
+   debounced filter or a fast nav) must NOT kill the server. SIGPIPE's default
+   action terminates the process before any exception is raised; ignoring it
+   turns the failed write into a catchable Sys_error (EPIPE), which the
+   per-connection handler already swallows, dropping just that one connection. *)
+let () = try Sys.set_signal Sys.sigpipe Sys.Signal_ignore with _ -> ()
+
 (* ====================================================================== *)
 (* Font measurement via otfm — reads OpenType/TrueType font tables         *)
 (* ====================================================================== *)
@@ -508,9 +530,61 @@ let rec load_library_file path =
       Printf.eprintf "[load-library] %s: %s\n%!" (Filename.basename path) msg
   ) exprs
 
-(** IO-aware CEK run — handles suspension by dispatching IO requests.
-    Import requests are handled locally (load .sx file).
-    Other IO requests are sent to the Python bridge. *)
+(* IO-aware CEK run (cek_run_with_io, below) — handles suspension by dispatching
+   IO requests. Import requests are handled locally (load .sx file). *)
+(** Resolve a single IO request value to its response. Shared by
+    cek_run_with_io's suspension loop AND the _cek_io_resolver installed for the
+    http-listen serving path, so the synchronous inline-resolve path (sx_vm.ml's
+    HO-callback suspend fix) resolves durable reads byte-identically to the
+    CEK-driven path. Without an installed resolver, a `perform` inside an HO
+    primitive callback (map/filter/…) unwinds the native loop and corrupts the
+    stack — the host's map/rest/drop serving-JIT miscompile. *)
+and resolve_io_request request =
+  let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
+  (match op with
+   | "import" ->
+     (* Resolve library locally — load the .sx file *)
+     let lib_spec = Sx_runtime.get_val request (String "library") in
+     (* library_loaded_p takes the library SPEC and computes the key itself —
+        passing an already-computed key string double-applies library_name_key
+        and crashes (sx_to_list on a string). *)
+     if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
+       (* Already loaded — just resume *)
+       Nil
+     else begin
+       (match resolve_library_path lib_spec with
+        | Some path -> load_library_file path
+        | None ->
+          Printf.eprintf "[import] WARNING: no file for library %s\n%!"
+            (Sx_runtime.value_to_str lib_spec));
+       Nil
+     end
+   | "text-measure" ->
+     let args = let a = Sx_runtime.get_val request (String "args") in
+       (match a with List l -> l | _ -> [a]) in
+     let font = match args with String f :: _ -> f | _ -> "serif" in
+     let size = match args with
+       | [_font; Number sz; _text] -> sz
+       | [_font; Number sz] -> sz
+       | _ -> 16.0 in
+     let text = match args with
+       | [_font; _sz; String t] -> t
+       | _ -> "" in
+     let (w, h, asc, desc) = measure_text_otfm font size text in
+     let d = Hashtbl.create 4 in
+     Hashtbl.replace d "width" (Number w);
+     Hashtbl.replace d "height" (Number h);
+     Hashtbl.replace d "ascent" (Number asc);
+     Hashtbl.replace d "descent" (Number desc);
+     Dict d
+   | _ ->
+     let argsv = Sx_runtime.get_val request (String "args") in
+     (match Sx_persist_store.handle_op op argsv with
+      | Some resp -> resp
+      | None ->
+        let args = (match argsv with List l -> l | _ -> [argsv]) in
+        io_request op args))
+
 and cek_run_with_io state =
   let s = ref state in
   let is_terminal s = match Sx_ref.cek_terminal_p s with Bool true -> true | _ -> false in
@@ -521,46 +595,7 @@ and cek_run_with_io state =
     done;
     if is_suspended !s then begin
       let request = Sx_runtime.get_val !s (String "request") in
-      let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
-      let response = match op with
-        | "import" ->
-          (* Resolve library locally — load the .sx file *)
-          let lib_spec = Sx_runtime.get_val request (String "library") in
-          let key = Sx_ref.library_name_key lib_spec in
-          if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
-            (* Already loaded — just resume *)
-            Nil
-          else begin
-            (match resolve_library_path lib_spec with
-             | Some path -> load_library_file path
-             | None ->
-               Printf.eprintf "[import] WARNING: no file for library %s\n%!"
-                 (Sx_runtime.value_to_str lib_spec));
-            Nil
-          end
-        | "text-measure" ->
-          let args = let a = Sx_runtime.get_val request (String "args") in
-            (match a with List l -> l | _ -> [a]) in
-          let font = match args with String f :: _ -> f | _ -> "serif" in
-          let size = match args with
-            | [_font; Number sz; _text] -> sz
-            | [_font; Number sz] -> sz
-            | _ -> 16.0 in
-          let text = match args with
-            | [_font; _sz; String t] -> t
-            | _ -> "" in
-          let (w, h, asc, desc) = measure_text_otfm font size text in
-          let d = Hashtbl.create 4 in
-          Hashtbl.replace d "width" (Number w);
-          Hashtbl.replace d "height" (Number h);
-          Hashtbl.replace d "ascent" (Number asc);
-          Hashtbl.replace d "descent" (Number desc);
-          Dict d
-        | _ ->
-          let args = let a = Sx_runtime.get_val request (String "args") in
-            (match a with List l -> l | _ -> [a]) in
-          io_request op args
-      in
+      let response = resolve_io_request request in
       s := Sx_ref.cek_resume !s response;
       loop ()
     end else
@@ -708,6 +743,349 @@ let setup_evaluator_bridge env =
     match args with
     | [e; expr] -> Sx_ref.eval_expr expr e
     | _ -> raise (Eval_error "eval-in-env: (env expr)"));
+
+  (* fed-sx Milestone 1 Step 8 transport. NATIVE ONLY — sockets +
+     threads; deliberately absent from the WASM kernel (registered
+     here in bin/, never in lib/sx_primitives.ml). Minimal HTTP/1.1,
+     Connection: close. handler : req-dict -> resp-dict where
+     req = {:method :path :query :headers :body},
+     resp = {:status :headers :body}. Never returns. *)
+  Sx_primitives.register "http-listen" (fun args ->
+    let strip_cr s =
+      let n = String.length s in
+      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
+    in
+    match args with
+    | [port_v; handler] ->
+      let port = match port_v with
+        | Integer n -> n
+        | Number f -> int_of_float f
+        | _ -> raise (Eval_error "http-listen: (port handler)") in
+      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+      Unix.setsockopt sock Unix.SO_REUSEADDR true;
+      (* Bind host: loopback by default (safe for tests + local runs); set
+         SX_HTTP_HOST=0.0.0.0 to expose on the network (container/Caddy). *)
+      let bind_addr =
+        match Sys.getenv_opt "SX_HTTP_HOST" with
+        | Some h -> (try Unix.inet_addr_of_string h
+                     with _ -> Unix.inet_addr_loopback)
+        | None -> Unix.inet_addr_loopback in
+      Unix.bind sock
+        (Unix.ADDR_INET (bind_addr, port));
+      Unix.listen sock 64;
+      (* Install the synchronous IO resolver for the serving path. Without it, a
+         `perform` (durable kv read) that fires inside an HO-primitive callback
+         (map/filter/reduce/…) during request handling suspends through the
+         native OCaml loop, dropping its iteration state and leaving the stack
+         misaligned — the serving-JIT host miscompile (map/rest/drop wrong args,
+         blank pages, empty picker). With a resolver installed, sx_vm.ml resolves
+         that callback's IO inline (byte-identically to cek_run_with_io) and the
+         loop is never unwound. Only set if one isn't already installed. *)
+      (if !Sx_types._cek_io_resolver = None then
+         Sx_types._cek_io_resolver :=
+           Some (fun request _state -> resolve_io_request request));
+      (* SX runtime is shared across threads — serialize handler calls. *)
+      let mtx = Mutex.create () in
+      let reason = function
+        | 200 -> "OK" | 201 -> "Created" | 204 -> "No Content"
+        | 301 -> "Moved Permanently" | 302 -> "Found"
+        | 400 -> "Bad Request" | 401 -> "Unauthorized"
+        | 403 -> "Forbidden" | 404 -> "Not Found"
+        | 405 -> "Method Not Allowed" | 500 -> "Internal Server Error"
+        | _ -> "OK" in
+      let handle fd =
+        (try
+          let ic = Unix.in_channel_of_descr fd in
+          let oc = Unix.out_channel_of_descr fd in
+          let reqline = strip_cr (input_line ic) in
+          (match String.split_on_char ' ' reqline with
+           | meth :: target :: _ ->
+             let path, query =
+               match String.index_opt target '?' with
+               | Some i ->
+                 String.sub target 0 i,
+                 String.sub target (i + 1)
+                   (String.length target - i - 1)
+               | None -> target, "" in
+             let headers = Sx_types.make_dict () in
+             let clen = ref 0 in
+             let rec rdh () =
+               let h = strip_cr (input_line ic) in
+               if h = "" then ()
+               else begin
+                 (match String.index_opt h ':' with
+                  | Some i ->
+                    let name =
+                      String.lowercase_ascii
+                        (String.trim (String.sub h 0 i)) in
+                    let value =
+                      String.trim
+                        (String.sub h (i + 1)
+                           (String.length h - i - 1)) in
+                    Hashtbl.replace headers name (String value);
+                    if name = "content-length" then
+                      (try clen := int_of_string value with _ -> ())
+                  | None -> ());
+                 rdh ()
+               end in
+             rdh ();
+             let body =
+               if !clen > 0 then begin
+                 let b = Bytes.create !clen in
+                 really_input ic b 0 !clen;
+                 Bytes.unsafe_to_string b
+               end else "" in
+             let req = Sx_types.make_dict () in
+             Hashtbl.replace req "method" (String meth);
+             Hashtbl.replace req "path" (String path);
+             Hashtbl.replace req "query" (String query);
+             Hashtbl.replace req "headers" (Dict headers);
+             Hashtbl.replace req "body" (String body);
+             Mutex.lock mtx;
+             let resp =
+               (* Run the handler through the IO-aware CEK runner (not bare
+                  sx_call) so request handlers can perform per-request IO —
+                  durable store reads/writes resolve via cek_run_with_io's
+                  suspension loop instead of returning an unresolved suspension.
+                  On ANY handler exception, synthesise a 500 response rather than
+                  letting it escape: an escaped exception drops the connection
+                  with no bytes written, which a reverse proxy (Caddy/Cloudflare)
+                  surfaces as a 502 error page. A real 500 keeps the origin
+                  responsive and debuggable. Note: a native exception (e.g. the
+                  parser's Parse_error) cannot be caught by an SX (guard ...), so
+                  this boundary is the only place it can be trapped. *)
+               (try
+                  let st = Sx_ref.continue_with_call handler
+                             (List [Dict req]) (Env (Sx_types.make_env ()))
+                             (List [Dict req]) (List []) in
+                  let r = cek_run_with_io st in
+                  Mutex.unlock mtx; r
+                with e ->
+                  Mutex.unlock mtx;
+                  Printf.eprintf "[http-listen] handler error: %s\n%!"
+                    (Printexc.to_string e);
+                  let d = Sx_types.make_dict () in
+                  Hashtbl.replace d "status" (Integer 500);
+                  Hashtbl.replace d "body" (String "Internal Server Error");
+                  Dict d) in
+             let getk k = match resp with
+               | Dict h -> Hashtbl.find_opt h k | _ -> None in
+             let status = match getk "status" with
+               | Some (Integer n) -> n
+               | Some (Number f) -> int_of_float f
+               | _ -> 200 in
+             let rbody = match getk "body" with
+               | Some (String s) -> s
+               | Some v -> Sx_types.value_to_string v
+               | None -> "" in
+             let rhdrs = match getk "headers" with
+               | Some (Dict h) ->
+                 Hashtbl.fold (fun k v acc ->
+                   (k, (match v with
+                        | String s -> s
+                        | v -> Sx_types.value_to_string v)) :: acc)
+                   h []
+               | _ -> [] in
+             let buf = Buffer.create 256 in
+             Buffer.add_string buf
+               (Printf.sprintf "HTTP/1.1 %d %s\r\n" status
+                  (reason status));
+             List.iter (fun (k, v) ->
+               Buffer.add_string buf
+                 (Printf.sprintf "%s: %s\r\n" k v)) rhdrs;
+             (* Cookies: a response carries :set-cookies as a LIST of pre-formatted
+                cookie strings (Dream's dream-set-cookie), because a headers Dict
+                cannot hold more than one Set-Cookie. Emit one header per item. *)
+             (match getk "set-cookies" with
+              | Some (List items) ->
+                List.iter (fun v ->
+                  match v with
+                  | String s ->
+                    Buffer.add_string buf
+                      (Printf.sprintf "Set-Cookie: %s\r\n" s)
+                  | _ -> ()) items
+              | _ -> ());
+             if not (List.exists
+                       (fun (k, _) ->
+                          String.lowercase_ascii k = "content-type")
+                       rhdrs)
+             then Buffer.add_string buf
+                 "Content-Type: text/plain\r\n";
+             Buffer.add_string buf
+               (Printf.sprintf "Content-Length: %d\r\n"
+                  (String.length rbody));
+             Buffer.add_string buf "Connection: close\r\n\r\n";
+             Buffer.add_string buf rbody;
+             output_string oc (Buffer.contents buf);
+             flush oc
+           | _ -> ())
+         with _ -> ());
+        (try Unix.close fd with _ -> ())
+      in
+      while true do
+        let fd, _ = Unix.accept sock in
+        ignore (Thread.create handle fd)
+      done;
+      Nil
+    | _ -> raise (Eval_error "http-listen: (port handler)"));
+
+  (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
+     Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
+     request: TCP connect, write request line + headers + body,
+     read status + headers + body, return {:status :headers :body}.
+     URL must be http://...; HTTPS is a later phase (needs TLS).
+     Body read: Content-Length first, else read to EOF (we send
+     Connection: close). Transfer-Encoding: chunked is rejected —
+     fed-sx Phase 8 wires this for inter-server POSTs which will
+     all carry Content-Length. *)
+  Sx_primitives.register "http-request" (fun args ->
+    let strip_cr s =
+      let n = String.length s in
+      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
+    in
+    match args with
+    | [String meth; String url; headers_v; body_v] ->
+      let body = match body_v with
+        | String s -> s
+        | Nil -> ""
+        | v -> Sx_types.value_to_string v in
+      let prefix = "http://" in
+      let plen = String.length prefix in
+      let ulen = String.length url in
+      if ulen < plen || String.sub url 0 plen <> prefix
+      then raise (Eval_error "http-request: URL must start with http://");
+      let rest = String.sub url plen (ulen - plen) in
+      let host_port, path =
+        match String.index_opt rest '/' with
+        | Some i ->
+          String.sub rest 0 i,
+          String.sub rest i (String.length rest - i)
+        | None -> rest, "/" in
+      if host_port = "" then
+        raise (Eval_error "http-request: missing host");
+      let host, port =
+        match String.index_opt host_port ':' with
+        | Some i ->
+          let h = String.sub host_port 0 i in
+          let ps = String.sub host_port (i + 1)
+                     (String.length host_port - i - 1) in
+          (h,
+           (try int_of_string ps with _ ->
+              raise (Eval_error "http-request: bad port")))
+        | None -> host_port, 80 in
+      let addr =
+        (try (Unix.gethostbyname host).h_addr_list.(0)
+         with Not_found ->
+           raise (Eval_error ("http-request: dns: " ^ host))) in
+      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+      let cleanup () = try Unix.close sock with _ -> () in
+      let result =
+        (try
+          (try Unix.connect sock (Unix.ADDR_INET (addr, port))
+           with Unix.Unix_error (e, _, _) ->
+             raise (Eval_error
+                      ("http-request: connect: " ^ Unix.error_message e)));
+          let oc = Unix.out_channel_of_descr sock in
+          let ic = Unix.in_channel_of_descr sock in
+          let buf = Buffer.create 256 in
+          Buffer.add_string buf
+            (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
+          let host_hdr_sent = ref false in
+          let clen_sent = ref false in
+          let conn_sent = ref false in
+          (match headers_v with
+           | Dict h ->
+             Hashtbl.iter (fun k v ->
+               let kl = String.lowercase_ascii k in
+               if kl = "host" then host_hdr_sent := true;
+               if kl = "content-length" then clen_sent := true;
+               if kl = "connection" then conn_sent := true;
+               let vs = match v with
+                 | String s -> s
+                 | x -> Sx_types.value_to_string x in
+               Buffer.add_string buf
+                 (Printf.sprintf "%s: %s\r\n" k vs)) h
+           | Nil -> ()
+           | _ -> raise (Eval_error "http-request: headers must be dict"));
+          if not !host_hdr_sent then
+            Buffer.add_string buf
+              (Printf.sprintf "Host: %s\r\n" host_port);
+          if not !clen_sent then
+            Buffer.add_string buf
+              (Printf.sprintf "Content-Length: %d\r\n"
+                 (String.length body));
+          if not !conn_sent then
+            Buffer.add_string buf "Connection: close\r\n";
+          Buffer.add_string buf "\r\n";
+          Buffer.add_string buf body;
+          output_string oc (Buffer.contents buf);
+          flush oc;
+          let sl =
+            (try strip_cr (input_line ic)
+             with End_of_file ->
+               raise (Eval_error
+                        "http-request: connection closed before status")) in
+          let status =
+            match String.split_on_char ' ' sl with
+            | _ver :: code :: _ ->
+              (try int_of_string code with _ ->
+                 raise (Eval_error "http-request: bad status code"))
+            | _ -> raise (Eval_error "http-request: bad status line") in
+          let rhdrs = Sx_types.make_dict () in
+          let clen = ref (-1) in
+          let chunked = ref false in
+          let rec rdh () =
+            let h =
+              (try strip_cr (input_line ic)
+               with End_of_file -> "") in
+            if h = "" then ()
+            else begin
+              (match String.index_opt h ':' with
+               | Some i ->
+                 let name =
+                   String.lowercase_ascii
+                     (String.trim (String.sub h 0 i)) in
+                 let value =
+                   String.trim
+                     (String.sub h (i + 1)
+                        (String.length h - i - 1)) in
+                 Hashtbl.replace rhdrs name (String value);
+                 if name = "content-length" then
+                   (try clen := int_of_string value with _ -> ())
+                 else if name = "transfer-encoding" &&
+                         String.lowercase_ascii value = "chunked"
+                 then chunked := true
+               | None -> ());
+              rdh ()
+            end in
+          rdh ();
+          if !chunked then
+            raise (Eval_error
+                     "http-request: chunked transfer-encoding not supported");
+          let rbody =
+            if !clen >= 0 then begin
+              let b = Bytes.create !clen in
+              really_input ic b 0 !clen;
+              Bytes.unsafe_to_string b
+            end else begin
+              let b = Buffer.create 256 in
+              (try
+                 while true do
+                   Buffer.add_channel b ic 4096
+                 done; assert false
+               with End_of_file -> ());
+              Buffer.contents b
+            end in
+          let resp = Sx_types.make_dict () in
+          Hashtbl.replace resp "status" (Integer status);
+          Hashtbl.replace resp "headers" (Dict rhdrs);
+          Hashtbl.replace resp "body" (String rbody);
+          Dict resp
+        with e -> cleanup (); raise e) in
+      cleanup ();
+      result
+    | _ -> raise (Eval_error "http-request: (method url headers body)"));
+
   bind "trampoline" (fun args ->
     match args with
     | [v] ->
@@ -789,7 +1167,11 @@ let setup_introspection env =
   bind "component?" (fun args ->
     match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
   bind "callable?" (fun args ->
-    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
+    (* VmClosure must count as callable: a JIT-compiled higher-order function
+       returns its inner closure as a VmClosure, and downstream code (e.g.
+       scheme-apply's `(callable? proc)` guard) must recognize it — it is
+       invocable via the normal call path. *)
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
   bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
   bind "continuation?" (fun args ->
     match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
@@ -915,6 +1297,20 @@ let setup_type_constructors env =
       (* Already a value — return as-is *)
       v
     | _ -> raise (Eval_error "parse: expected string"));
+  (* Like parse, but returns nil instead of raising on malformed input. The
+     parser raises a native Parse_error that an SX-level (guard ...) cannot catch
+     (guard only traps SX conditions, not host exceptions), so code that handles
+     untrusted text — e.g. a stored post body — needs a value-returning parse to
+     degrade gracefully rather than crash the request. *)
+  bind "parse-safe" (fun args ->
+    match args with
+    | [String s] | [SxExpr s] ->
+      (try
+         let exprs = Sx_parser.parse_all s in
+         (match exprs with [e] -> e | _ -> List exprs)
+       with _ -> Nil)
+    | [v] -> v
+    | _ -> Nil);
   (* Native bytecode compiler — bootstrapped from lib/compiler.sx *)
   bind "compile" (fun args ->
     match args with [expr] -> Sx_compiler.compile expr | _ -> Nil);
@@ -1160,6 +1556,22 @@ let sx_render_to_html expr env =
 
 let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16
 
+(* Bisection aid: env-var-driven JIT filter. Lets us narrow which named
+   lambda the VM miscompiles without rebuilding.
+   SX_JIT_DENY=name1,name2  — never JIT these (substring match on exact name).
+   SX_JIT_ONLY=name1,name2  — JIT ONLY these (exact name); skip all others. *)
+let _jit_deny_set =
+  match Sys.getenv_opt "SX_JIT_DENY" with
+  | None | Some "" -> []
+  | Some s -> String.split_on_char ',' s |> List.map String.trim
+let _jit_only_set =
+  match Sys.getenv_opt "SX_JIT_ONLY" with
+  | None | Some "" -> []
+  | Some s -> String.split_on_char ',' s |> List.map String.trim
+let _jit_name_allowed name =
+  (not (List.mem name _jit_deny_set))
+  && (match _jit_only_set with [] -> true | only -> List.mem name only)
+
 let rec make_vm_suspend_marker request saved_vm =
   let d = Hashtbl.create 3 in
   Hashtbl.replace d "__vm_suspended" (Bool true);
@@ -1178,6 +1590,8 @@ let rec make_vm_suspend_marker request saved_vm =
 let register_jit_hook env =
   Sx_runtime._jit_try_call_fn := Some (fun f args ->
     match f with
+    | Lambda l when (match l.l_name with Some n -> not (_jit_name_allowed n) | None -> false) ->
+      None  (* bisection filter excluded this name *)
     | Lambda l ->
       (match l.l_compiled with
        | Some cl when not (Sx_vm.is_jit_failed cl) ->
@@ -1194,7 +1608,23 @@ let register_jit_hook env =
                let rec resolve_loop req vm =
                  let result = resolver req (Nil) in
                  (try Some (Sx_vm.resume_vm vm result)
-                  with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
+                  with
+                  | Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2
+                  | e ->
+                    (* (B) Resume raised mid-execution. resolve_loop runs inside
+                       the VmSuspended handler, so without catching here the
+                       error escapes to the http handler (→ 500). Recover THIS
+                       call on the CEK instead: mark jit_failed and return None
+                       so the interpreter re-runs it (idempotent for the host's
+                       durable reads). Self-heals on the first hit, not a retry. *)
+                    let fn_name = match l.l_name with Some n -> n | None -> "?" in
+                    if not (Hashtbl.mem _jit_warned fn_name) then begin
+                      Hashtbl.replace _jit_warned fn_name true;
+                      Printf.eprintf "[jit] %s resume fallback to CEK: %s\n%!"
+                        fn_name (Printexc.to_string e)
+                    end;
+                    l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
+                    None)
                in
                resolve_loop request saved_vm
              | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1227,7 +1657,16 @@ let register_jit_hook env =
                    let rec resolve_loop req vm =
                      let result = resolver req (Nil) in
                      (try Some (Sx_vm.resume_vm vm result)
-                      with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
+                      with
+                      | Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2
+                      | e ->
+                        (* (B) See note above — recover a failed resume on the
+                           CEK instead of escaping to the handler (→ 500). *)
+                        Printf.eprintf "[jit] %s resume fallback to CEK: %s\n%!"
+                          fn_name (Printexc.to_string e);
+                        Hashtbl.replace _jit_warned fn_name true;
+                        l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
+                        None)
                    in
                    resolve_loop request saved_vm
                  | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1359,6 +1798,10 @@ let rec dispatch env cmd =
         | Nil -> "nil"
         | Bool true -> "true" | Bool false -> "false"
         | Number n -> Sx_types.format_number n
+        (* Bytecode opcodes + arity/upvalue-count are Integers; without this case
+           they hit the `_ -> "nil"` fallthrough, so every .sxbc came out as
+           `:bytecode (nil nil ...)` -> "VM: unknown opcode 0" -> source fallback. *)
+        | Integer n -> string_of_int n
         | String s -> "\"" ^ escape_sx_string s ^ "\""
         | Symbol s -> s | Keyword k -> ":" ^ k
         | List items | ListRef { contents = items } -> "(" ^ String.concat " " (List.map raw_serialize items) ^ ")"
@@ -1386,14 +1829,20 @@ let rec dispatch env cmd =
             | _ -> "" in
           let response = if op = "import" then begin
             let lib_spec = Sx_runtime.get_val request (String "library") in
-            let key = Sx_ref.library_name_key lib_spec in
-            if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then Nil
+            (* pass the SPEC, not a pre-computed key — library_loaded_p applies
+               library_name_key itself (a key string would crash sx_to_list). *)
+            if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then Nil
             else begin
               (match resolve_library_path lib_spec with
                | Some path -> load_library_file path | None -> ());
               Nil
             end
-          end else Nil (* non-import IO: resume with nil *) in
+          end else
+            (* durable-storage ops: service against on-disk store *)
+            let args = Sx_runtime.get_val request (String "args") in
+            (match Sx_persist_store.handle_op op args with
+             | Some resp -> resp
+             | None -> Nil (* non-import IO: resume with nil *)) in
           s := Sx_ref.cek_resume !s response
         done;
         Sx_ref.cek_value !s
@@ -2182,8 +2631,12 @@ let http_render_page env path headers =
         Printf.eprintf "[http] route error for %s: %s\n%!" path (Printexc.to_string e);
         Nil
     in
-    (* Build an error page AST that keeps the layout intact *)
+    (* Build an error page AST that keeps the layout intact.
+       Sets is_error_page so callers can avoid caching soft error pages —
+       a transient routing failure must not be served from cache until restart. *)
+    let is_error_page = ref false in
     let error_page_ast msg =
+      is_error_page := true;
       List [Symbol "div"; Keyword "class"; String "p-8 max-w-2xl mx-auto";
         List [Symbol "h2"; Keyword "class"; String "text-xl font-semibold text-rose-600 mb-4";
           String "Page Error"];
@@ -2223,7 +2676,7 @@ let http_render_page env path headers =
             | String s | SxExpr s -> s | _ -> serialize_value body_result in
           let t1 = Unix.gettimeofday () in
           Printf.eprintf "[sx-http] %s (SX) aser=%.3fs body=%d\n%!" path (t1 -. t0) (String.length body_str);
-          Some body_str
+          Some (body_str, !is_error_page)
         end else begin
           (* Full page: aser → SSR → shell *)
           let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in
@@ -2278,7 +2731,7 @@ let http_render_page env path headers =
           let t4 = Unix.gettimeofday () in
           Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!"
             path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html);
-          Some html
+          Some (html, !is_error_page)
         end
       end
 
@@ -3710,8 +4163,18 @@ let http_mode port =
   http_inject_shell_statics env static_dir sx_sxc;
   (* Init shared VM globals AFTER all files loaded + shell statics injected.
      The env_bind hook keeps it in sync with any future bindings. *)
-  (* Enable lazy JIT — compile lambdas to bytecode on first call *)
-  register_jit_hook env;
+  (* Lazy JIT is OPT-IN via SX_SERVING_JIT=1, matching the epoch serving mode.
+     The serving JIT has confirmed miscompiles (`->` in argument position
+     evaluates steps once per remaining step and leaves stack residue; any
+     VM exception re-runs the whole call on the CEK, double-applying side
+     effects; user-macro call args are evaluated eagerly before fallback).
+     Until those are fixed, HTTP rendering runs on the CEK by default —
+     the response cache carries the hot paths. *)
+  (match Sys.getenv_opt "SX_SERVING_JIT" with
+   | Some ("1" | "true" | "yes" | "on") ->
+     register_jit_hook env
+   | _ ->
+     Printf.eprintf "[sx-http] serving JIT disabled (opt in with SX_SERVING_JIT=1)\n%!");
   (* Install global IO resolver so perform works inside aser/eval_expr.
      This lets components call measure-text during server-side rendering. *)
   Sx_types._cek_io_resolver := Some (fun request _state ->
@@ -3746,7 +4209,10 @@ let http_mode port =
       Dict d
     | "io-sleep" | "sleep" -> Nil
     | "import" -> Nil
-    | _ -> Nil);
+    | _ ->
+      (match Sx_persist_store.handle_op op args with
+       | Some resp -> resp
+       | None -> Nil));
   (* Response cache — path → full HTTP response string.
      Populated during pre-warm, serves cached responses in <0.1ms.
      Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for
@@ -3755,7 +4221,9 @@ let http_mode port =
 
   let cache_response path =
     match http_render_page env path [] with
-    | Some html ->
+    | Some (_, true) ->
+      Printf.eprintf "[cache] %s → error page, not cached\n%!" path
+    | Some (html, false) ->
       let resp = http_response html in
       Hashtbl.replace response_cache path resp;
       Printf.eprintf "[cache] %s → %d bytes\n%!" path (String.length html)
@@ -3845,7 +4313,7 @@ let http_mode port =
         let response =
           try
             match http_render_page env path headers with
-            | Some body ->
+            | Some (body, is_err) ->
               (* htmx requests get HTML; SX requests get SX wire format *)
               let final_body = if is_htmx then
                 (try
@@ -3857,7 +4325,7 @@ let http_mode port =
               let ct = if is_ajax && not is_htmx then "text/sx; charset=utf-8"
                        else "text/html; charset=utf-8" in
               let resp = http_response ~content_type:ct final_body in
-              Hashtbl.replace response_cache cache_key resp;
+              if not is_err then Hashtbl.replace response_cache cache_key resp;
               resp
             | None -> http_response ~status:404 "<h1>Not Found</h1>"
           with e ->
@@ -4211,7 +4679,7 @@ let http_mode port =
                 String.lowercase_ascii k = "hx-request") headers in
               let response =
                 try match http_render_page env path headers with
-                  | Some body ->
+                  | Some (body, is_err) ->
                     let final_body = if is_htmx then
                       (try
                         let exprs = Sx_parser.parse_all body in
@@ -4222,7 +4690,7 @@ let http_mode port =
                     let ct = if is_htmx then "text/html; charset=utf-8"
                              else "text/sx; charset=utf-8" in
                     let resp = http_response ~content_type:ct final_body in
-                    if not is_htmx then Hashtbl.replace response_cache cache_key resp;
+                    if not is_htmx && not is_err then Hashtbl.replace response_cache cache_key resp;
                     resp
                   | None -> http_response ~status:404
                     "(div :class \"p-8\" (h2 :class \"text-rose-600 font-semibold\" \"Page not found\") (p :class \"text-stone-500\" \"No route matched this path\"))"
@@ -4238,7 +4706,7 @@ let http_mode port =
                  Don't cache: response varies by cookie value. *)
               let response =
                 try match http_render_page env path [] with
-                  | Some body -> http_response body
+                  | Some (body, _) -> http_response body
                   | None -> http_response ~status:404 "<h1>Not Found</h1>"
                 with e ->
                   Printf.eprintf "[render] Cookie render error for %s: %s\n%!" path (Printexc.to_string e);
@@ -4495,7 +4963,11 @@ let site_mode () =
         let line = String.trim line in
         if line = "" then ()
         else begin
-          let exprs = Sx_parser.parse_all line in
+          (* A malformed line must never kill the shared command channel:
+             report it as an error response and keep serving. *)
+          match (try Ok (Sx_parser.parse_all line) with e -> Error e) with
+          | Error e -> send_error ("Malformed command line: " ^ Printexc.to_string e)
+          | Ok exprs ->
           match exprs with
           | [List [Symbol "epoch"; Number n]] ->
             current_epoch := int_of_float n
@@ -4504,7 +4976,7 @@ let site_mode () =
           (* render-page: full SSR pipeline — URL → complete HTML *)
           | [List [Symbol "render-page"; String path]] ->
             (try match http_render_page env path [] with
-              | Some html -> send_ok_blob html
+              | Some (html, _) -> send_ok_blob html
               | None -> send_error ("render-page: no route for " ^ path)
             with e -> send_error ("render-page: " ^ Printexc.to_string e))
           (* nav-urls: flat list of (href label) from nav tree *)
@@ -4538,6 +5010,46 @@ let () =
   else begin
     (* Normal persistent server mode *)
     let env = make_server_env () in
+    (* render-page: render an (unevaluated) SX page/component expression to HTML
+       using the server env, so http-listen handlers can serve interactive SX
+       pages. render-to-html expands components + collects keyword attrs itself;
+       SX handlers can't reach the server env, so this primitive supplies it. *)
+    ignore (env_bind env "render-page" (NativeFn ("render-page", fun args ->
+      match args with
+      | expr :: _ -> String (sx_render_to_html expr env)
+      | _ -> raise (Eval_error "render-page: (expr)"))));
+    (* JIT in the epoch serving mode is OPT-IN via SX_SERVING_JIT=1.
+       Default OFF: this mode is the shared command channel used by every
+       loop's conformance runner, and enabling JIT globally regresses
+       continuation-based guest interpreters (Scheme/Erlang/Prolog/CL: their
+       eval/dispatch cores capture call/cc continuations the stack VM can't
+       escape, and deep AST recursion can miscompile into a non-terminating
+       loop). Guests that are safe declare their interpret-only namespace with
+       `(jit-exclude! "<ns>-*")`; until every guest is validated, the safe
+       default is no JIT here. Opt in (SX_SERVING_JIT=1) for validated
+       workloads — e.g. the content/Smalltalk page server. *)
+    (match Sys.getenv_opt "SX_SERVING_JIT" with
+     | Some ("1" | "true" | "yes" | "on") ->
+       (* Load the SX bytecode compiler (lib/compiler.sx) as `compile` — the
+          native Sx_compiler.compile is an incomplete stub (arity-0 bytecode,
+          params as GLOBAL_GET). http/cli/site modes already load it. *)
+       (_import_env := Some env;
+        let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
+          try Sys.getenv "SX_ROOT" with Not_found ->
+          if Sys.file_exists "/app/spec" then "/app" else Sys.getcwd () in
+        let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found ->
+          project_dir ^ "/lib" in
+        let compiler_path = lib_base ^ "/compiler.sx" in
+        let compiler_path =
+          if Sys.file_exists compiler_path then compiler_path
+          else if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
+          else compiler_path in
+        try load_library_file compiler_path; rebind_host_extensions env
+        with exn ->
+          Printf.eprintf "[sx-server] WARNING: failed to load compiler.sx for JIT (%s) — JIT disabled\n%!"
+            (Printexc.to_string exn));
+       register_jit_hook env
+     | _ -> ());
     send "(ready)";
     (* Main command loop *)
     try
@@ -4553,7 +5065,11 @@ let () =
             Printf.eprintf "[sx-server] discarding stale io-response (%d chars)\n%!"
               (String.length line)
           else begin
-            let exprs = Sx_parser.parse_all line in
+            (* A malformed line must never kill the shared command channel:
+               report it as an error response and keep serving. *)
+            match (try Ok (Sx_parser.parse_all line) with e -> Error e) with
+            | Error e -> send_error ("Malformed command line: " ^ Printexc.to_string e)
+            | Ok exprs ->
             match exprs with
             (* Epoch marker: (epoch N) — set current epoch, read next command *)
             | [List [Symbol "epoch"; Number n]] ->

hosts/ocaml/bin/test_http.sh

@@ -0,0 +1,49 @@
+#!/usr/bin/env bash
+# Phase H test — native-only http-listen primitive.
+# Starts sx_server with a tiny SX echo handler, drives it with curl
+# (GET / POST / 404 / custom header), asserts, then kills it.
+set -u
+cd "$(dirname "$0")/.."
+
+SRV=_build/default/bin/sx_server.exe
+PORT=${HTTP_TEST_PORT:-8911}
+PASS=0
+FAIL=0
+ok()  { echo "  PASS: $1"; PASS=$((PASS+1)); }
+bad() { echo "  FAIL: $1 — $2"; FAIL=$((FAIL+1)); }
+
+if [ ! -x "$SRV" ]; then
+  echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1
+fi
+
+H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} {:status 404 :body "nope"})) (http-listen '"$PORT"' h))'
+ESC=${H//\"/\\\"}
+
+{ printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 30; } | "$SRV" >/tmp/test_http_srv.out 2>&1 &
+SVPID=$!
+trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT
+
+up=0
+for _ in $(seq 1 50); do
+  curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; }
+  sleep 0.2
+done
+[ "$up" = 1 ] || { echo "  FAIL: server did not start"; cat /tmp/test_http_srv.out; exit 1; }
+
+# GET with query + custom response header.
+g=$(curl -s -i "http://127.0.0.1:$PORT/echo?x=1" | tr -d '\r')
+echo "$g" | grep -q '^HTTP/1.1 200 OK'        && ok "GET status 200"          || bad "GET status" "$g"
+echo "$g" | grep -q '^X-Echo: GET'            && ok "GET custom header"       || bad "GET header" "$g"
+echo "$g" | grep -q '^M=GET P=/echo Q=x=1 B=$' && ok "GET echo body"          || bad "GET body" "$g"
+
+# POST with body.
+p=$(curl -s -X POST --data 'hello' "http://127.0.0.1:$PORT/echo")
+[ "$p" = 'M=POST P=/echo Q= B=hello' ] && ok "POST body echoed" || bad "POST body" "$p"
+
+# 404 path.
+n=$(curl -s -i "http://127.0.0.1:$PORT/missing" | tr -d '\r')
+echo "$n" | grep -q '^HTTP/1.1 404 Not Found' && ok "404 status" || bad "404 status" "$n"
+echo "$n" | grep -q '^nope$'                  && ok "404 body"   || bad "404 body" "$n"
+
+echo "Results: $PASS passed, $FAIL failed"
+[ "$FAIL" = 0 ]

hosts/ocaml/bin/test_http_client.sh

@@ -0,0 +1,80 @@
+#!/usr/bin/env bash
+# Phase J test — native-only http-request client primitive.
+# Reuses Phase H's http-listen to spin up an echo server, then drives
+# a separate sx_server via the epoch protocol to issue http-request
+# calls and assert response shape + headers + body.
+set -u
+cd "$(dirname "$0")/.."
+
+SRV=_build/default/bin/sx_server.exe
+PORT=${HTTP_CLIENT_TEST_PORT:-8921}
+PASS=0
+FAIL=0
+ok()  { echo "  PASS: $1"; PASS=$((PASS+1)); }
+bad() { echo "  FAIL: $1 — $2"; FAIL=$((FAIL+1)); }
+
+if [ ! -x "$SRV" ]; then
+  echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1
+fi
+
+# /echo echoes method/path/query/body and reflects request X-Custom
+# back as response X-Got; /missing-test → 404.
+H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method") "X-Got" (get (get req "headers") "x-custom")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} (if (= (get req "path") "/missing-test") {:status 404 :body "nope"} {:status 500 :body "err"}))) (http-listen '"$PORT"' h))'
+ESC=${H//\"/\\\"}
+
+{ printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 60; } | "$SRV" >/tmp/test_http_client_srv.out 2>&1 &
+SVPID=$!
+trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT
+
+up=0
+for _ in $(seq 1 50); do
+  curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; }
+  sleep 0.2
+done
+[ "$up" = 1 ] || { echo "  FAIL: server did not start"; cat /tmp/test_http_client_srv.out; exit 1; }
+
+emit() {
+  # $1 = epoch num, $2 = raw SX form. Wraps in (eval "...") with quotes escaped.
+  local esc=${2//\"/\\\"}
+  printf '(epoch %s)\n(eval "%s")\n' "$1" "$esc"
+}
+
+DRV_OUT=/tmp/test_http_client_drv.out
+{
+  emit 1 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo?x=1" {} ""))) (str "S=" (get r "status") " E=" (get (get r "headers") "x-echo") " B=" (get r "body")))'
+  emit 2 '(let ((r (http-request "POST" "http://127.0.0.1:'"$PORT"'/echo" {} "hello"))) (str "S=" (get r "status") " B=" (get r "body")))'
+  emit 3 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/missing-test" {} ""))) (str "S=" (get r "status") " B=" (get r "body")))'
+  emit 4 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {"X-Custom" "myval"} ""))) (get (get r "headers") "x-got"))'
+  emit 5 '(http-request "GET" "ftp://nope" {} "")'
+  emit 6 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {} ""))) (get r "status"))'
+} | "$SRV" >"$DRV_OUT" 2>&1
+
+# eval results come back as (ok-len N L)\n<body>\n — grep the body content.
+grep -q '^"S=200 E=GET B=M=GET P=/echo Q=x=1 B="$' "$DRV_OUT" \
+  && ok "GET status + echo header + body" \
+  || bad "GET" "$(grep -A1 '^(ok-len 1 ' "$DRV_OUT" | tail -1)"
+
+grep -q '^"S=200 B=M=POST P=/echo Q= B=hello"$' "$DRV_OUT" \
+  && ok "POST body roundtrip" \
+  || bad "POST" "$(grep -A1 '^(ok-len 2 ' "$DRV_OUT" | tail -1)"
+
+grep -q '^"S=404 B=nope"$' "$DRV_OUT" \
+  && ok "404 status + body" \
+  || bad "404" "$(grep -A1 '^(ok-len 3 ' "$DRV_OUT" | tail -1)"
+
+grep -q '^"myval"$' "$DRV_OUT" \
+  && ok "custom request header reaches server" \
+  || bad "custom-header" "$(grep -A1 '^(ok-len 4 ' "$DRV_OUT" | tail -1)"
+
+R5=$(grep '^(error 5 ' "$DRV_OUT" | head -1)
+echo "$R5" | grep -q 'URL must start with http' \
+  && ok "non-http scheme rejected" \
+  || bad "bad-url" "$R5"
+
+# Status is an Integer (200), serialized bare without quotes.
+grep -q '^200$' "$DRV_OUT" \
+  && ok "response status is integer 200" \
+  || bad "status-integer" "$(grep -A1 '^(ok-len 6 ' "$DRV_OUT" | tail -1)"
+
+echo "Results: $PASS passed, $FAIL failed"
+[ "$FAIL" = 0 ]

hosts/ocaml/bootstrap.py

@@ -156,8 +156,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 ->
@@ -171,21 +170,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 ->
@@ -194,28 +190,53 @@ 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
     | _ -> ())
   ) ctor_specs;
   Nil
 
-(* Register define-type via custom_special_forms so the CEK dispatch finds it.
-   The top-level (register-special-form! ...) in spec/evaluator.sx is not a
-   define and therefore is not transpiled; we wire it up here instead. *)
+(* Register special forms via custom_special_forms so the CEK dispatch finds
+   them. The top-level (register-special-form! ...) calls in spec/evaluator.sx
+   are not defines and therefore are not transpiled; we wire them up here.
+   let-values/define-values/delay/delay-force point at the TRANSPILED spec
+   functions (sf_let_values etc.) — these registrations were previously
+   hand-appended to the generated sx_ref.ml and were silently lost on every
+   regeneration (2026-07 review). *)
 let () = ignore (register_special_form (String "define-type")
   (NativeFn ("define-type", fun call_args ->
     match call_args with
     | [args; env] -> sf_define_type args env
     | _ -> Nil)))
 
+let () = ignore (register_special_form (String "let-values")
+  (NativeFn ("let-values", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_let_values args env
+    | _ -> Nil)))
+
+let () = ignore (register_special_form (String "define-values")
+  (NativeFn ("define-values", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_define_values args env
+    | _ -> Nil)))
+
+let () = ignore (register_special_form (String "delay")
+  (NativeFn ("delay", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_delay args env
+    | _ -> Nil)))
+
+let () = ignore (register_special_form (String "delay-force")
+  (NativeFn ("delay-force", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_delay_force args env
+    | _ -> Nil)))
+
 
 """
 
@@ -263,7 +284,21 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
                 "pad-left", "pad-right", "char-at", "substring",
                 # sf-define-type uses &rest + empty-dict literals that the transpiler
                 # can't emit as valid OCaml; hand-written implementation in FIXUPS.
-                "sf-define-type"}
+                "sf-define-type",
+                # Arrow-named portability shims for non-OCaml hosts. All three
+                # are registered natively in sx_primitives.ml, and the
+                # transpiler has no mangling rule for '>' in identifiers
+                # (emits invalid OCaml like `string_>symbol`).
+                "string->symbol", "symbol->string", "integer->char",
+                # values/in-range use &rest, which the transpiler can't emit
+                # (see sf-define-type above). in-range is registered natively;
+                # values has never been in the compiled kernel — bound only in
+                # run_tests.ml (2026-07 review F-7); making it a real kernel
+                # primitive is a tracked follow-up.
+                "values", "in-range", "build-range",
+                # zero-arg guest shim; the native gensym (with optional
+                # prefix) is registered in sx_primitives.ml
+                "gensym"}
         defines = [(n, e) for n, e in defines if n not in skip]
 
         # Deduplicate — keep last definition for each name (CEK overrides tree-walk)

hosts/ocaml/browser/bundle.sh

@@ -71,6 +71,11 @@ cp "$ROOT/shared/sx/templates/tw-layout.sx" "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw-type.sx"   "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw.sx"        "$DIST/sx/"
 
+# 9b. Host app components (content-addressed, client-expanded on boosted nav).
+# Listed in the host's data-sx-manifest "boot" array so the client eager-loads
+# them after the web stack — see lib/host/static.sx + sx-platform.js loadWebStack.
+cp "$ROOT/lib/host/sx/relate-picker.sx" "$DIST/sx/"
+
 # 10. Hyperscript
 for f in tokenizer parser compiler runtime integration htmx; do
   cp "$ROOT/lib/hyperscript/$f.sx" "$DIST/sx/hs-$f.sx"

hosts/ocaml/browser/compile-modules.js

@@ -48,6 +48,8 @@ const SOURCE_MAP = {
   'boot.sx': 'web/boot.sx',
   'tw-layout.sx': 'web/tw-layout.sx', 'tw-type.sx': 'web/tw-type.sx', 'tw.sx': 'web/tw.sx',
   'text-layout.sx': 'lib/text-layout.sx',
+  // Host app components (content-addressed, client-expanded on boosted nav).
+  'relate-picker.sx': 'lib/host/sx/relate-picker.sx',
 };
 let synced = 0;
 for (const [dist, src] of Object.entries(SOURCE_MAP)) {
@@ -87,6 +89,8 @@ const FILES = [
   'hs-tokenizer.sx', 'hs-parser.sx', 'hs-compiler.sx', 'hs-runtime.sx',
   'hs-worker.sx', 'hs-prolog.sx',
   'hs-integration.sx', 'hs-htmx.sx',
+  // Host app components — standalone defcomps, no inter-module deps.
+  'relate-picker.sx',
   'boot.sx',
 ];
 

hosts/ocaml/browser/eval_wasm_probes.js

@@ -0,0 +1,68 @@
+#!/usr/bin/env node
+// eval_wasm_probes.js — W14/F8: evaluate a file of probe expressions (one
+// per line, '#'-comments allowed) on the SHIPPED browser kernel and print
+//   PROBE <n> <result-or-ERROR>
+// per line, for diffing against the native server (scripts/test-differential.sh).
+// Boot stubs mirror test_wasm_native.js / run_wasm_corpus.js.
+
+const fs = require('fs');
+const path = require('path');
+
+const PROJECT_ROOT = path.resolve(__dirname, '../../..');
+const WASM_DIR = path.join(PROJECT_ROOT, 'shared/static/wasm');
+
+const probeFile = process.argv[2];
+if (!probeFile) { console.error('usage: eval_wasm_probes.js <probes.txt>'); process.exit(2); }
+
+global.window = global;
+global.document = {
+  createElement: () => ({ style: {}, setAttribute() {}, appendChild() {}, children: [] }),
+  createDocumentFragment: () => ({ appendChild() {}, children: [], childNodes: [] }),
+  head: { appendChild() {} }, body: { appendChild() {} },
+  querySelector: () => null, querySelectorAll: () => [],
+  createTextNode: s => ({ textContent: s }), addEventListener() {},
+  createComment: s => ({ textContent: s || '' }),
+  getElementsByTagName: () => [],
+};
+global.localStorage = { getItem: () => null, setItem() {}, removeItem() {} };
+global.CustomEvent = class { constructor(n, o) { this.type = n; this.detail = (o || {}).detail || {}; } };
+global.MutationObserver = class { observe() {} disconnect() {} };
+global.requestIdleCallback = fn => setTimeout(fn, 0);
+global.matchMedia = () => ({ matches: false });
+global.navigator = { serviceWorker: { register: () => Promise.resolve() } };
+global.location = { href: '', pathname: '/', hostname: 'localhost' };
+global.history = { pushState() {}, replaceState() {} };
+global.fetch = () => Promise.resolve({ ok: true, text: () => Promise.resolve('') });
+
+async function main() {
+  require(path.join(WASM_DIR, 'sx_browser.bc.wasm.js'));
+  const K = await new Promise((resolve, reject) => {
+    let tries = 0;
+    const poll = setInterval(() => {
+      if (globalThis.SxKernel) { clearInterval(poll); resolve(globalThis.SxKernel); }
+      else if (++tries > 200) { clearInterval(poll); reject(new Error('SxKernel not found')); }
+    }, 50);
+  });
+
+  const lines = fs.readFileSync(probeFile, 'utf8').split('\n');
+  let n = 0;
+  for (const raw of lines) {
+    const line = raw.trim();
+    if (!line || line.startsWith('#')) continue;
+    n++;
+    let out;
+    try {
+      // Serialize through the kernel's own printer so both hosts emit SX
+      // text (K.eval returns raw JS values otherwise — [object Object]).
+      const r = K.eval(`(sx-serialize ${line})`);
+      out = (typeof r === 'string') ? r : String(r);
+    } catch (e) {
+      out = 'ERROR';
+    }
+    // errors normalized: kernel returns "Error: ..." strings for eval errors
+    if (typeof out === 'string' && out.startsWith('Error')) out = 'ERROR';
+    console.log(`PROBE ${n} ${out.replace(/\n/g, '\\n')}`);
+  }
+}
+
+main().catch(e => { console.error('FATAL:', e.message); process.exit(1); });

hosts/ocaml/browser/run_wasm_corpus.js

@@ -0,0 +1,170 @@
+#!/usr/bin/env node
+// run_wasm_corpus.js — W14/F2: run spec-test files through the SHIPPED
+// browser kernel (sx_browser.bc.wasm.js), headless in Node.
+//
+// The review (conformance.md F-2) found no runner feeds spec/tests through
+// the shipped browser artifact — F-1/F-3 host divergences existed
+// undetected precisely because of that. This runs ONE test file per
+// invocation (process isolation: a hanging file is killed by the driver's
+// timeout without taking down the sweep) and prints a parseable summary:
+//   CORPUS-RESULT <file> pass=<n> fail=<n> status=ok|load-error
+//
+// Usage: node hosts/ocaml/browser/run_wasm_corpus.js spec/tests/test-eval.sx
+// Driver: scripts/test-wasm-corpus.sh (sweeps the corpus, applies skips).
+//
+// Boot stubs and module preload mirror test_wasm_native.js (the blessed
+// boot path for the shipped kernel).
+
+const fs = require('fs');
+const path = require('path');
+
+const PROJECT_ROOT = path.resolve(__dirname, '../../..');
+const WASM_DIR = path.join(PROJECT_ROOT, 'shared/static/wasm');
+
+const target = process.argv[2];
+if (!target) { console.error('usage: run_wasm_corpus.js <test-file.sx>'); process.exit(2); }
+
+// --- DOM stubs (as test_wasm_native.js) ---
+function makeElement(tag) {
+  const el = {
+    tagName: tag, _attrs: {}, _children: [], style: {},
+    childNodes: [], children: [], textContent: '',
+    nodeType: 1,
+    setAttribute(k, v) { el._attrs[k] = String(v); },
+    getAttribute(k) { return el._attrs[k] || null; },
+    removeAttribute(k) { delete el._attrs[k]; },
+    appendChild(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    insertBefore(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    removeChild(c) { return c; },
+    replaceChild(n) { return n; },
+    cloneNode() { return makeElement(tag); },
+    addEventListener() {}, removeEventListener() {}, dispatchEvent() {},
+    get innerHTML() {
+      return el._children.map(c => {
+        if (c._isText) return c.textContent || '';
+        if (c._isComment) return '<!--' + (c.textContent || '') + '-->';
+        return c.outerHTML || '';
+      }).join('');
+    },
+    set innerHTML(v) { el._children = []; el.childNodes = []; el.children = []; },
+    get outerHTML() {
+      let s = '<' + tag;
+      for (const k of Object.keys(el._attrs).sort()) s += ` ${k}="${el._attrs[k]}"`;
+      s += '>';
+      if (['br', 'hr', 'img', 'input', 'meta', 'link'].includes(tag)) return s;
+      return s + el.innerHTML + '</' + tag + '>';
+    },
+    dataset: new Proxy({}, {
+      get(_, k) { return el._attrs['data-' + k.replace(/[A-Z]/g, c => '-' + c.toLowerCase())]; },
+      set(_, k, v) { el._attrs['data-' + k.replace(/[A-Z]/g, c => '-' + c.toLowerCase())] = v; return true; }
+    }),
+    querySelectorAll() { return []; },
+    querySelector() { return null; },
+  };
+  return el;
+}
+
+global.window = global;
+global.document = {
+  createElement: makeElement,
+  createDocumentFragment() { return makeElement('fragment'); },
+  head: makeElement('head'), body: makeElement('body'),
+  querySelector() { return null; }, querySelectorAll() { return []; },
+  createTextNode(s) { return { _isText: true, textContent: String(s), nodeType: 3 }; },
+  addEventListener() {},
+  createComment(s) { return { _isComment: true, textContent: s || '', nodeType: 8 }; },
+  getElementsByTagName() { return []; },
+};
+global.localStorage = { getItem() { return null; }, setItem() {}, removeItem() {} };
+global.CustomEvent = class { constructor(n, o) { this.type = n; this.detail = (o || {}).detail || {}; } };
+global.MutationObserver = class { observe() {} disconnect() {} };
+global.requestIdleCallback = fn => setTimeout(fn, 0);
+global.matchMedia = () => ({ matches: false });
+global.navigator = { serviceWorker: { register() { return Promise.resolve(); } } };
+global.location = { href: '', pathname: '/', hostname: 'localhost' };
+global.history = { pushState() {}, replaceState() {} };
+global.fetch = () => Promise.resolve({ ok: true, text() { return Promise.resolve(''); } });
+global.XMLHttpRequest = class { open() {} send() {} };
+
+async function main() {
+  require(path.join(WASM_DIR, 'sx_browser.bc.wasm.js'));
+  const K = await new Promise((resolve, reject) => {
+    let tries = 0;
+    const poll = setInterval(() => {
+      if (globalThis.SxKernel) { clearInterval(poll); resolve(globalThis.SxKernel); }
+      else if (++tries > 200) { clearInterval(poll); reject(new Error('SxKernel not found after 10s')); }
+    }, 50);
+  });
+
+  // --- 8 FFI host primitives (as test_wasm_native.js) ---
+  K.registerNative('host-global', args => (args[0] in globalThis) ? globalThis[args[0]] : null);
+  K.registerNative('host-get', args => {
+    const [obj, prop] = args;
+    if (obj == null) return null;
+    const v = obj[prop];
+    return v === undefined ? null : v;
+  });
+  K.registerNative('host-set!', args => { if (args[0] != null) args[0][args[1]] = args[2]; return args[2]; });
+  K.registerNative('host-call', args => {
+    const [obj, method, ...rest] = args;
+    if (obj == null || typeof obj[method] !== 'function') return null;
+    const r = obj[method].apply(obj, rest);
+    return r === undefined ? null : r;
+  });
+  K.registerNative('host-new', args => new (Function.prototype.bind.apply(args[0], [null, ...args.slice(1)])));
+  K.registerNative('host-callback', args => function () { return K.callFn(args[0], Array.from(arguments)); });
+  K.registerNative('host-typeof', args => typeof args[0]);
+  K.registerNative('host-await', args => args[0]);
+
+  K.eval('(define SX_VERSION "wasm-corpus-1.0")');
+  K.eval('(define SX_ENGINE "ocaml-vm-wasm-corpus")');
+  K.eval('(define parse sx-parse)');
+  K.eval('(define serialize sx-serialize)');
+
+  // --- Web stack modules (source form; bytecode covered elsewhere) ---
+  const sxDir = path.join(WASM_DIR, 'sx');
+  const modules = [
+    'render', 'core-signals', 'signals', 'deps', 'router', 'page-helpers', 'freeze',
+    'bytecode', 'compiler', 'vm', 'dom', 'browser',
+    'adapter-html', 'adapter-sx', 'adapter-dom',
+    'boot-helpers', 'hypersx',
+    'harness', 'harness-reactive', 'harness-web',
+    'engine', 'orchestration', 'boot',
+  ];
+  if (K.beginModuleLoad) K.beginModuleLoad();
+  for (const mod of modules) {
+    K.load(fs.readFileSync(path.join(sxDir, mod + '.sx'), 'utf8'));
+  }
+  if (K.endModuleLoad) K.endModuleLoad();
+
+  // --- Test framework hooks ---
+  let pass = 0, fail = 0;
+  const suiteStack = [];
+  K.registerNative('report-pass', () => { pass++; return null; });
+  K.registerNative('report-fail', args => {
+    fail++;
+    const suitePath = suiteStack.join(' > ');
+    console.error(`FAIL: ${suitePath ? suitePath + ' > ' : ''}${args[0]}\n  ${args[1]}`);
+    return null;
+  });
+  K.registerNative('push-suite', args => { suiteStack.push(args[0]); return null; });
+  K.registerNative('pop-suite', () => { suiteStack.pop(); return null; });
+  K.eval('(define test-allowed? (fn (name) true))');
+  K.eval('(define try-call (fn (thunk) (let ((result (cek-try thunk (fn (err) err)))) (if (and (= (type-of result) "string") (starts-with? result "Error")) {"ok" false "error" result} {"ok" true "error" nil}))))');
+
+  K.load(fs.readFileSync(path.join(PROJECT_ROOT, 'spec/tests/test-framework.sx'), 'utf8'));
+
+  // --- Run the target file ---
+  const rel = path.relative(PROJECT_ROOT, path.resolve(target));
+  let status = 'ok';
+  try {
+    K.load(fs.readFileSync(path.resolve(target), 'utf8'));
+  } catch (e) {
+    status = 'load-error';
+    console.error(`LOAD-ERROR: ${rel}: ${e.message}`);
+  }
+  console.log(`CORPUS-RESULT ${rel} pass=${pass} fail=${fail} status=${status}`);
+  process.exit(status !== 'ok' || fail > 0 ? 1 : 0);
+}
+
+main().catch(e => { console.error('FATAL:', e.message); process.exit(1); });

hosts/ocaml/browser/sx-platform.js

@@ -646,6 +646,18 @@
     // Load entry point itself (boot.sx — not a library, just defines + init)
     loadBytecodeFile("sx/" + entry.file) || loadSxFile("sx/" + entry.file.replace(/\.sxbc$/, '.sx'));
 
+    // App components: the page's data-sx-manifest "boot" array lists app-specific
+    // modules (e.g. ~relate-picker) to eager-load after the web stack, so their
+    // defcomps are registered before a boosted fragment references them. Loaded
+    // content-addressed, the same as any module.
+    var pageM = loadPageManifest();
+    if (pageM && pageM.boot && pageM.boot.length) {
+      for (var b = 0; b < pageM.boot.length; b++) {
+        var bf = pageM.boot[b];
+        loadBytecodeFile("sx/" + bf) || loadSxFile("sx/" + bf.replace(/\.sxbc$/, '.sx'));
+      }
+    }
+
     if (K.endModuleLoad) K.endModuleLoad();
     var count = Object.keys(_loadedLibs).length + 1; // +1 for entry
     var dt = Math.round(performance.now() - t0);

hosts/ocaml/browser/sx_browser.ml

@@ -73,6 +73,7 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
   | Nil -> Js.Unsafe.inject Js.null
   | Bool b -> Js.Unsafe.inject (Js.bool b)
   | Number n -> Js.Unsafe.inject (Js.number_of_float n)
+  | Integer n -> Js.Unsafe.inject (Js.number_of_float (float_of_int n))
   | String s -> Js.Unsafe.inject (Js.string s)
   | RawHTML s -> Js.Unsafe.inject (Js.string s)
   | Symbol s ->
@@ -329,8 +330,9 @@ let handle_import_suspension request =
   let lib_spec = match request with
     | Dict d -> (match Hashtbl.find_opt d "library" with Some v -> v | _ -> Nil)
     | _ -> Nil in
-  let key = Sx_ref.library_name_key lib_spec in
-  if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
+  (* library_loaded_p takes the SPEC and applies library_name_key itself —
+     passing a pre-computed key string double-applies it and crashes. *)
+  if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
     Some Nil  (* Already loaded — resume immediately *)
   else
     None  (* Not loaded — JS platform must fetch it *)
@@ -676,7 +678,11 @@ let () =
   let rec deep_equal a b =
     match a, b with
     | Nil, Nil -> true | Bool a, Bool b -> a = b
-    | Number a, Number b -> a = b | String a, String b -> a = b
+    | Integer a, Integer b -> a = b
+    | Number a, Number b -> a = b
+    | Integer a, Number b -> float_of_int a = b
+    | Number a, Integer b -> a = float_of_int b
+    | String a, String b -> a = b
     | Symbol a, Symbol b -> a = b | Keyword a, Keyword b -> a = b
     | (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
       List.length a = List.length b && List.for_all2 deep_equal a b

hosts/ocaml/lib/dune

@@ -2,3 +2,7 @@
  (name sx)
  (wrapped false)
  (libraries re re.pcre unix))
+
+; Pull in extension modules from lib/extensions/ (test_ext.ml, etc).
+; See plans/sx-vm-opcode-extension.md.
+(include_subdirs unqualified)

hosts/ocaml/lib/extensions/README.md

@@ -0,0 +1,71 @@
+# SX VM extensions
+
+Each `*.ml` file here is a VM extension — a first-class OCaml module that
+registers specialized bytecode opcodes with `Sx_vm_extensions`. See
+[`plans/sx-vm-opcode-extension.md`](../../../../plans/sx-vm-opcode-extension.md)
+for the design.
+
+## Pattern
+
+```ocaml
+(* lib/extensions/myport.ml *)
+open Sx_types
+
+type Sx_vm_extension.extension_state += MyportState of { ... }
+
+module M : Sx_vm_extension.EXTENSION = struct
+  let name = "myport"
+  let init () = MyportState { ... }
+  let opcodes _st = [
+    (id, "myport.OP_NAME", handler);
+    ...
+  ]
+end
+
+let register () = Sx_vm_extensions.register (module M)
+```
+
+Then call `Myport.register ()` once at startup from any binary that
+should have the extension loaded.
+
+## Opcode-ID allocation
+
+Range 200-247 (per `Sx_vm_extensions.extension_min` /
+`extension_max`).  Conventions:
+
+| Range   | Use                                                                     |
+|---------|-------------------------------------------------------------------------|
+| 200-209 | reserved for `lib/guest/vm/` shared opcodes (chiselled out on 2nd use)  |
+| 210-219 | inline test extensions defined in `bin/run_tests.ml`                    |
+| 220-229 | this directory's `test_ext` (the canonical template)                    |
+| 230-247 | first-come-first-served by language ports (Erlang first)                |
+
+When a port claims a contiguous block, document it in the table above.
+The registry rejects collisions at startup with a loud error — there is
+no silent shadowing.
+
+## Naming
+
+Always prefix opcode names with the extension name plus a dot:
+`myport.OP_<NAME>`.  The prefix is a hard convention so that multiple
+extensions can share the global opcode-name namespace cleanly.
+
+## State
+
+`extension_state` is an extensible variant.  Add your case (e.g.
+`MyportState of { ... }`) at the top of your file, return it from
+`init`, and pattern-match it inside your handlers.  Other extensions
+cannot see your state — the variant case is private to your module.
+
+## Testing
+
+`test_ext.ml` is the canonical worked example.  `bin/run_tests.ml`
+calls `Test_ext.register ()`, then drives bytecode that exercises the
+opcodes end-to-end (push, double, dispatch, disassemble, invocation
+counter).  Mirror this shape when adding a real port's extension.
+
+## Build wiring
+
+`lib/dune` has `(include_subdirs unqualified)`, so any `.ml` you drop
+in here is automatically part of the `sx` library.  Module name follows
+the filename verbatim (`test_ext.ml` → `Test_ext`).

hosts/ocaml/lib/extensions/erlang_ext.ml

@@ -0,0 +1,278 @@
+(** {1 [erlang_ext] — Erlang-on-SX VM opcode extension (Phase 9h)}
+
+    Registers the Erlang opcode namespace in [Sx_vm_extensions] so that
+    [extension-opcode-id "erlang.OP_*"] resolves to a stable id. The SX
+    stub dispatcher in [lib/erlang/vm/dispatcher.sx] consults these ids
+    (Phase 9i) and falls back to its own local ids when the host
+    extension is absent.
+
+    Opcode ids occupy 222-239 in the extension partition (200-247).
+    222+ is chosen to clear the test extensions' reserved ids
+    (test_reg 210/211, test_ext 220/221) so all three coexist in
+    run_tests; production sx_server only registers this one. Names
+    mirror the SX stub dispatcher exactly:
+
+    - 222 erlang.OP_PATTERN_TUPLE      - 231 erlang.OP_BIF_HD
+    - 223 erlang.OP_PATTERN_LIST       - 232 erlang.OP_BIF_TL
+    - 224 erlang.OP_PATTERN_BINARY     - 233 erlang.OP_BIF_ELEMENT
+    - 225 erlang.OP_PERFORM            - 234 erlang.OP_BIF_TUPLE_SIZE
+    - 226 erlang.OP_HANDLE             - 235 erlang.OP_BIF_LISTS_REVERSE
+    - 227 erlang.OP_RECEIVE_SCAN       - 236 erlang.OP_BIF_IS_INTEGER
+    - 228 erlang.OP_SPAWN              - 237 erlang.OP_BIF_IS_ATOM
+    - 229 erlang.OP_SEND               - 238 erlang.OP_BIF_IS_LIST
+    - 230 erlang.OP_BIF_LENGTH         - 239 erlang.OP_BIF_IS_TUPLE
+
+    {2 Handler status}
+
+    The bytecode compiler does not yet emit these opcodes — Erlang
+    programs run through the general CEK path and the working
+    specialization path is the SX stub dispatcher. So every handler
+    here raises a descriptive [Eval_error] rather than silently
+    corrupting the VM stack. This keeps the extension honest: the
+    namespace is registered and disassembles by name, [extension-opcode-id]
+    works, but actually dispatching an opcode (which only happens once a
+    future phase teaches the compiler to emit them) fails loudly with a
+    pointer to the phase that will wire it. Real stack-machine handlers
+    land alongside compiler emission in a later phase. *)
+
+open Sx_types
+
+(** Per-instance state: invocation counter, purely to exercise the
+    [extension_state] machinery (mirrors [test_ext]). *)
+type Sx_vm_extension.extension_state += ErlangExtState of {
+  mutable dispatched : int;
+}
+
+let not_wired name =
+  raise (Eval_error
+    (Printf.sprintf
+       "%s: bytecode emission not yet wired (Phase 9j) — \
+        Erlang runs via CEK; specialization path is the SX stub \
+        dispatcher in lib/erlang/vm/dispatcher.sx"
+       name))
+
+module M : Sx_vm_extension.EXTENSION = struct
+  let name = "erlang"
+  let init () = ErlangExtState { dispatched = 0 }
+
+  let opcodes st =
+    let bump () = match st with
+      | ErlangExtState s -> s.dispatched <- s.dispatched + 1
+      | _ -> ()
+    in
+    let op id nm =
+      (id, nm, (fun (_vm : Sx_vm.vm) (_frame : Sx_vm.frame) ->
+        bump (); not_wired nm))
+    in
+    (* Phase 10b vertical slice: one REAL register-machine handler.
+       erlang.OP_BIF_LENGTH (230) — pops an Erlang list off the VM
+       stack and pushes its length. Proves the full path works:
+       extension-opcode-id -> bytecode -> Sx_vm dispatch fallthrough
+       -> this handler -> correct stack result. The remaining 17
+       opcodes still raise not_wired until their handlers + compiler
+       emission land. Erlang lists are tagged dicts:
+         nil  = {"tag" -> String "nil"}
+         cons = {"tag" -> String "cons"; "head" -> v; "tail" -> v} *)
+    let er_tag d =
+      match Hashtbl.find_opt d "tag" with
+      | Some (String s) -> s | _ -> ""
+    in
+    let op_bif_length =
+      (230, "erlang.OP_BIF_LENGTH",
+       (fun (vm : Sx_vm.vm) (_frame : Sx_vm.frame) ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         let rec walk acc node =
+           match node with
+           | Dict d ->
+             (match er_tag d with
+              | "nil" -> acc
+              | "cons" ->
+                (match Hashtbl.find_opt d "tail" with
+                 | Some t -> walk (acc + 1) t
+                 | None -> raise (Eval_error
+                     "erlang.OP_BIF_LENGTH: cons cell without :tail"))
+              | _ -> raise (Eval_error
+                  "erlang.OP_BIF_LENGTH: not a proper list"))
+           | _ -> raise (Eval_error
+               "erlang.OP_BIF_LENGTH: not a proper list")
+         in
+         Sx_vm.push vm (Integer (walk 0 v))))
+    in
+    (* Phase 10b — simple hot-BIF handlers. Erlang bool is the atom
+       {"tag"->"atom"; "name"->"true"|"false"}; mk_atom builds it. *)
+    let mk_atom nm =
+      let h = Hashtbl.create 2 in
+      Hashtbl.replace h "tag" (String "atom");
+      Hashtbl.replace h "name" (String nm);
+      Dict h
+    in
+    let er_bool b = mk_atom (if b then "true" else "false") in
+    let is_tag v t = match v with
+      | Dict d -> er_tag d = t
+      | _ -> false
+    in
+    let op_bif_hd =
+      (231, "erlang.OP_BIF_HD",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         match Sx_vm.pop vm with
+         | Dict d when er_tag d = "cons" ->
+           (match Hashtbl.find_opt d "head" with
+            | Some h -> Sx_vm.push vm h
+            | None -> raise (Eval_error "erlang.OP_BIF_HD: cons without :head"))
+         | _ -> raise (Eval_error "erlang.OP_BIF_HD: not a cons")))
+    in
+    let op_bif_tl =
+      (232, "erlang.OP_BIF_TL",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         match Sx_vm.pop vm with
+         | Dict d when er_tag d = "cons" ->
+           (match Hashtbl.find_opt d "tail" with
+            | Some t -> Sx_vm.push vm t
+            | None -> raise (Eval_error "erlang.OP_BIF_TL: cons without :tail"))
+         | _ -> raise (Eval_error "erlang.OP_BIF_TL: not a cons")))
+    in
+    let op_bif_tuple_size =
+      (234, "erlang.OP_BIF_TUPLE_SIZE",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         match Sx_vm.pop vm with
+         | Dict d when er_tag d = "tuple" ->
+           let n = match Hashtbl.find_opt d "elements" with
+             | Some (List es) -> List.length es
+             | Some (ListRef r) -> List.length !r
+             | _ -> raise (Eval_error
+                 "erlang.OP_BIF_TUPLE_SIZE: tuple without :elements")
+           in
+           Sx_vm.push vm (Integer n)
+         | _ -> raise (Eval_error "erlang.OP_BIF_TUPLE_SIZE: not a tuple")))
+    in
+    let op_bif_is_integer =
+      (236, "erlang.OP_BIF_IS_INTEGER",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         Sx_vm.push vm (er_bool (match v with Integer _ -> true | _ -> false))))
+    in
+    let op_bif_is_atom =
+      (237, "erlang.OP_BIF_IS_ATOM",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         Sx_vm.push vm (er_bool (is_tag v "atom"))))
+    in
+    let op_bif_is_list =
+      (238, "erlang.OP_BIF_IS_LIST",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         Sx_vm.push vm (er_bool (is_tag v "cons" || is_tag v "nil"))))
+    in
+    let op_bif_is_tuple =
+      (239, "erlang.OP_BIF_IS_TUPLE",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         Sx_vm.push vm (er_bool (is_tag v "tuple"))))
+    in
+    (* element/2 and lists:reverse/1 — pure stack transforms (no
+       bytecode operands). Calling convention: args pushed left→right,
+       so element/2 stack is [.. Index Tuple] (Tuple on top). Erlang
+       element/2 is 1-indexed. *)
+    let op_bif_element =
+      (233, "erlang.OP_BIF_ELEMENT",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let tup = Sx_vm.pop vm in
+         let idx = Sx_vm.pop vm in
+         match tup, idx with
+         | Dict d, Integer i when er_tag d = "tuple" ->
+           let es = match Hashtbl.find_opt d "elements" with
+             | Some (List es) -> es
+             | Some (ListRef r) -> !r
+             | _ -> raise (Eval_error
+                 "erlang.OP_BIF_ELEMENT: tuple without :elements")
+           in
+           let n = List.length es in
+           if i < 1 || i > n then
+             raise (Eval_error
+               (Printf.sprintf
+                  "erlang.OP_BIF_ELEMENT: index %d out of range 1..%d" i n))
+           else
+             Sx_vm.push vm (List.nth es (i - 1))
+         | _, Integer _ ->
+           raise (Eval_error "erlang.OP_BIF_ELEMENT: 2nd arg not a tuple")
+         | _ ->
+           raise (Eval_error "erlang.OP_BIF_ELEMENT: 1st arg not an integer")))
+    in
+    let op_bif_lists_reverse =
+      (235, "erlang.OP_BIF_LISTS_REVERSE",
+       (fun (vm : Sx_vm.vm) _f ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         let mk_nil () =
+           let h = Hashtbl.create 1 in
+           Hashtbl.replace h "tag" (String "nil"); Dict h in
+         let mk_cons hd tl =
+           let h = Hashtbl.create 3 in
+           Hashtbl.replace h "tag" (String "cons");
+           Hashtbl.replace h "head" hd;
+           Hashtbl.replace h "tail" tl;
+           Dict h in
+         let rec rev acc node =
+           match node with
+           | Dict d ->
+             (match er_tag d with
+              | "nil" -> acc
+              | "cons" ->
+                let hd = match Hashtbl.find_opt d "head" with
+                  | Some x -> x
+                  | None -> raise (Eval_error
+                      "erlang.OP_BIF_LISTS_REVERSE: cons without :head") in
+                let tl = match Hashtbl.find_opt d "tail" with
+                  | Some x -> x
+                  | None -> raise (Eval_error
+                      "erlang.OP_BIF_LISTS_REVERSE: cons without :tail") in
+                rev (mk_cons hd acc) tl
+              | _ -> raise (Eval_error
+                  "erlang.OP_BIF_LISTS_REVERSE: not a proper list"))
+           | _ -> raise (Eval_error
+               "erlang.OP_BIF_LISTS_REVERSE: not a proper list")
+         in
+         Sx_vm.push vm (rev (mk_nil ()) v)))
+    in
+    [
+      op 222 "erlang.OP_PATTERN_TUPLE";
+      op 223 "erlang.OP_PATTERN_LIST";
+      op 224 "erlang.OP_PATTERN_BINARY";
+      op 225 "erlang.OP_PERFORM";
+      op 226 "erlang.OP_HANDLE";
+      op 227 "erlang.OP_RECEIVE_SCAN";
+      op 228 "erlang.OP_SPAWN";
+      op 229 "erlang.OP_SEND";
+      op_bif_length;
+      op_bif_hd;
+      op_bif_tl;
+      op_bif_element;
+      op_bif_tuple_size;
+      op_bif_lists_reverse;
+      op_bif_is_integer;
+      op_bif_is_atom;
+      op_bif_is_list;
+      op_bif_is_tuple;
+    ]
+end
+
+(** Register [erlang] in [Sx_vm_extensions]. Idempotent only by failing
+    loudly — calling twice raises [Failure]. sx_server calls this once
+    at startup. *)
+let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION)
+
+(** Read the dispatch counter from the live registry state. [None] if
+    [register] hasn't run. *)
+let dispatch_count () =
+  match Sx_vm_extensions.state_of_extension "erlang" with
+  | Some (ErlangExtState s) -> Some s.dispatched
+  | _ -> None

hosts/ocaml/lib/extensions/test_ext.ml

@@ -0,0 +1,67 @@
+(** {1 [test_ext] — canonical example VM extension}
+
+    A minimal extension demonstrating the registration pattern from
+    [plans/sx-vm-opcode-extension.md].  The opcode IDs (220, 221) sit at
+    the top of the extension range, well clear of anything a real
+    language port would claim.
+
+    Two operand-less opcodes:
+
+    - [test_ext.OP_TEST_PUSH_42] (220) — pushes the integer 42.
+    - [test_ext.OP_TEST_DOUBLE_TOS] (221) — pops the integer on TOS,
+      pushes 2× it.
+
+    These are the smallest stack manipulations that prove the extension
+    mechanism wires through end-to-end (registry → dispatch → human-
+    readable disassembly).  Real ports (Erlang Phase 9, future Haskell
+    perf phases) replace this template with their own opcode set.
+
+    Loading: [Test_ext.register ()] adds the extension to
+    [Sx_vm_extensions].  Run-time binaries that want the test opcodes
+    available call this once at startup.  Unit tests in
+    [bin/run_tests.ml] do exactly that. *)
+
+open Sx_types
+
+(** Per-instance state for [test_ext].  Counts how many times the
+    handlers ran — purely so the extension has *some* state, exercising
+    the [extension_state] machinery. *)
+type Sx_vm_extension.extension_state += TestExtState of {
+  mutable invocations : int;
+}
+
+module M : Sx_vm_extension.EXTENSION = struct
+  let name = "test_ext"
+  let init () = TestExtState { invocations = 0 }
+
+  let opcodes st =
+    let bump () = match st with
+      | TestExtState s -> s.invocations <- s.invocations + 1
+      | _ -> ()
+    in
+    [
+      (220, "test_ext.OP_TEST_PUSH_42",
+       (fun vm _frame -> bump (); Sx_vm.push vm (Integer 42)));
+
+      (221, "test_ext.OP_TEST_DOUBLE_TOS",
+       (fun vm _frame ->
+         bump ();
+         let v = Sx_vm.pop vm in
+         match v with
+         | Integer n -> Sx_vm.push vm (Integer (n * 2))
+         | _ -> raise (Eval_error
+             "test_ext.OP_TEST_DOUBLE_TOS: TOS is not an integer")));
+    ]
+end
+
+(** Register [test_ext] in [Sx_vm_extensions].  Idempotent only by
+    failing loudly — calling twice raises [Failure].  Binaries call this
+    once at startup; tests may [_reset_for_tests] then re-register. *)
+let register () = Sx_vm_extensions.register (module M : Sx_vm_extension.EXTENSION)
+
+(** Read the invocation counter from the live registry state.  Returns
+    [None] if [register] hasn't been called yet. *)
+let invocation_count () =
+  match Sx_vm_extensions.state_of_extension "test_ext" with
+  | Some (TestExtState s) -> Some s.invocations
+  | _ -> None

hosts/ocaml/lib/sx_cbor.ml

@@ -0,0 +1,146 @@
+(** dag-cbor encode / decode — pure OCaml, WASM-safe.
+
+    RFC 8949 deterministic subset as constrained by IPLD dag-cbor
+    (RFC 8742): unsigned/negative ints, text strings, arrays, maps
+    with keys sorted by **length-then-bytewise**, bool, null, and
+    tag 42 (CID link, decode-side passthrough). Floats are not
+    supported (no fed-sx shape needs them yet) — encoding a [Number]
+    or decoding a float head raises. Reference: RFC 8949 §3, §4.2. *)
+
+open Sx_types
+
+exception Cbor_error of string
+
+(* ---- Encoder ---- *)
+
+let write_head buf major v =
+  let m = major lsl 5 in
+  (* Width selection + big-endian byte emission via Int64, so the web targets
+     compute identically to native: on js_of_ocaml [int] is 32-bit, so the
+     literal 0x100000000 (2^32) truncates to 0 (sending small values to the
+     8-byte branch) and [v lsr (8*i)] with i>=4 is shift-mod-32. Int64 has the
+     full 64-bit width and well-defined shifts on every target. *)
+  let v64 = Int64.of_int v in
+  let put_be nbytes =
+    for i = nbytes - 1 downto 0 do
+      Buffer.add_char buf
+        (Char.chr (Int64.to_int
+           (Int64.logand (Int64.shift_right_logical v64 (8 * i)) 0xFFL)))
+    done
+  in
+  if v < 24 then
+    Buffer.add_char buf (Char.chr (m lor v))
+  else if v < 0x100 then begin
+    Buffer.add_char buf (Char.chr (m lor 24)); put_be 1
+  end else if v < 0x10000 then begin
+    Buffer.add_char buf (Char.chr (m lor 25)); put_be 2
+  end else if Int64.compare v64 0x100000000L < 0 then begin
+    Buffer.add_char buf (Char.chr (m lor 26)); put_be 4
+  end else begin
+    Buffer.add_char buf (Char.chr (m lor 27)); put_be 8
+  end
+
+(* dag-cbor map key order: shorter key first, then bytewise. *)
+let key_order a b =
+  let la = String.length a and lb = String.length b in
+  if la <> lb then compare la lb else compare a b
+
+let rec encode_into buf (v : value) : unit =
+  match v with
+  | Integer n ->
+    if n >= 0 then write_head buf 0 n
+    else write_head buf 1 (-1 - n)
+  | String s ->
+    write_head buf 3 (String.length s);
+    Buffer.add_string buf s
+  | Symbol s | Keyword s ->
+    write_head buf 3 (String.length s);
+    Buffer.add_string buf s
+  | Bool false -> Buffer.add_char buf '\xf4'
+  | Bool true  -> Buffer.add_char buf '\xf5'
+  | Nil        -> Buffer.add_char buf '\xf6'
+  | List items ->
+    write_head buf 4 (List.length items);
+    List.iter (encode_into buf) items
+  | Dict d ->
+    let keys = Hashtbl.fold (fun k _ acc -> k :: acc) d [] in
+    let keys = List.sort_uniq key_order keys in
+    write_head buf 5 (List.length keys);
+    List.iter (fun k ->
+      write_head buf 3 (String.length k);
+      Buffer.add_string buf k;
+      encode_into buf (Hashtbl.find d k)) keys
+  | Number _ ->
+    raise (Cbor_error "cbor-encode: floats unsupported (dag-cbor subset)")
+  | _ ->
+    raise (Cbor_error
+             ("cbor-encode: unencodable value " ^ type_of v))
+
+let encode (v : value) : string =
+  let buf = Buffer.create 64 in
+  encode_into buf v;
+  Buffer.contents buf
+
+(* ---- Decoder ---- *)
+
+let decode (s : string) : value =
+  let pos = ref 0 in
+  let len = String.length s in
+  let byte () =
+    if !pos >= len then raise (Cbor_error "cbor-decode: truncated");
+    let c = Char.code s.[!pos] in incr pos; c
+  in
+  let read_uint ai =
+    if ai < 24 then ai
+    else if ai = 24 then byte ()
+    else if ai = 25 then let a = byte () in let b = byte () in (a lsl 8) lor b
+    else if ai = 26 then begin
+      let v = ref 0 in
+      for _ = 0 to 3 do v := (!v lsl 8) lor byte () done; !v
+    end else if ai = 27 then begin
+      let v = ref 0 in
+      for _ = 0 to 7 do v := (!v lsl 8) lor byte () done; !v
+    end else raise (Cbor_error "cbor-decode: bad additional info")
+  in
+  let read_bytes n =
+    if !pos + n > len then raise (Cbor_error "cbor-decode: truncated");
+    let r = String.sub s !pos n in pos := !pos + n; r
+  in
+  let rec item () =
+    let b = byte () in
+    let major = b lsr 5 and ai = b land 0x1f in
+    match major with
+    | 0 -> Integer (read_uint ai)
+    | 1 -> Integer (-1 - read_uint ai)
+    | 2 -> String (read_bytes (read_uint ai))
+    | 3 -> String (read_bytes (read_uint ai))
+    | 4 ->
+      let n = read_uint ai in
+      List (List.init n (fun _ -> item ()))
+    | 5 ->
+      let n = read_uint ai in
+      let d = make_dict () in
+      for _ = 1 to n do
+        let k = match item () with
+          | String k -> k
+          | _ -> raise (Cbor_error "cbor-decode: non-string map key")
+        in
+        Hashtbl.replace d k (item ())
+      done;
+      Dict d
+    | 6 ->
+      (* Tag: tag-42 CID link → pass the inner item through. *)
+      ignore (read_uint ai); item ()
+    | 7 ->
+      (match ai with
+       | 20 -> Bool false
+       | 21 -> Bool true
+       | 22 -> Nil
+       | 23 -> Nil
+       | _ ->
+         raise (Cbor_error
+                  "cbor-decode: floats/simple unsupported (dag-cbor subset)"))
+    | _ -> raise (Cbor_error "cbor-decode: bad major type")
+  in
+  let v = item () in
+  v

hosts/ocaml/lib/sx_cid.ml

@@ -0,0 +1,70 @@
+(** CIDv1 computation — pure OCaml, WASM-safe.
+
+    Multihash + CIDv1 + multibase base32-lower (RFC 4648, no pad,
+    multibase prefix 'b'). Codecs: dag-cbor 0x71, raw 0x55. Hash
+    codes: sha2-256 0x12, sha3-256 0x16. Reference: the multiformats
+    specs (unsigned-varint, multihash, cid, multibase). No deps. *)
+
+open Sx_types
+
+(* Unsigned LEB128 (multiformats unsigned-varint). *)
+let varint (n : int) : string =
+  let buf = Buffer.create 4 in
+  let n = ref n in
+  let cont = ref true in
+  while !cont do
+    let b = !n land 0x7f in
+    n := !n lsr 7;
+    if !n = 0 then (Buffer.add_char buf (Char.chr b); cont := false)
+    else Buffer.add_char buf (Char.chr (b lor 0x80))
+  done;
+  Buffer.contents buf
+
+(* RFC 4648 base32 lowercase, no padding. *)
+let b32_alpha = "abcdefghijklmnopqrstuvwxyz234567"
+
+let base32_lower (s : string) : string =
+  let buf = Buffer.create ((String.length s * 8 + 4) / 5) in
+  let acc = ref 0 and bits = ref 0 in
+  String.iter (fun c ->
+    acc := (!acc lsl 8) lor (Char.code c);
+    bits := !bits + 8;
+    while !bits >= 5 do
+      bits := !bits - 5;
+      Buffer.add_char buf b32_alpha.[(!acc lsr !bits) land 0x1f]
+    done;
+    (* Keep only the unconsumed low [bits] bits, so [acc] stays tiny (< 2^13).
+       Without this it grows by 8 bits per byte and overflows native [int] on
+       the 32-bit web targets, corrupting the emitted symbols. *)
+    acc := !acc land ((1 lsl !bits) - 1)) s;
+  if !bits > 0 then
+    Buffer.add_char buf b32_alpha.[(!acc lsl (5 - !bits)) land 0x1f];
+  Buffer.contents buf
+
+(* "abef" -> the 2 raw bytes. *)
+let unhex (h : string) : string =
+  let n = String.length h / 2 in
+  let b = Bytes.create n in
+  for i = 0 to n - 1 do
+    Bytes.set b i
+      (Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
+  done;
+  Bytes.unsafe_to_string b
+
+(* multihash = varint(code) || varint(len) || digest *)
+let multihash (code : int) (digest : string) : string =
+  varint code ^ varint (String.length digest) ^ digest
+
+(* CIDv1 = 0x01 || varint(codec) || multihash ; multibase 'b' base32. *)
+let cidv1 (codec : int) (mh : string) : string =
+  "b" ^ base32_lower ("\x01" ^ varint codec ^ mh)
+
+let codec_dag_cbor = 0x71
+let mh_sha2_256 = 0x12
+
+(* Canonicalize an SX value: dag-cbor encode -> sha2-256 ->
+   multihash -> CIDv1 (dag-cbor codec). *)
+let cid_from_sx (v : value) : string =
+  let cbor = Sx_cbor.encode v in
+  let digest = unhex (Sx_sha2.sha256_hex cbor) in
+  cidv1 codec_dag_cbor (multihash mh_sha2_256 digest)

hosts/ocaml/lib/sx_ed25519.ml

@@ -0,0 +1,300 @@
+(** Ed25519 signature verification — pure OCaml, WASM-safe.
+
+    RFC 8032 §5.1.7 cofactorless verify over edwards25519. Includes a
+    minimal arbitrary-precision unsigned bignum (no Zarith / no deps)
+    and twisted-Edwards extended-coordinate point arithmetic. Verify
+    is total: malformed inputs return [false], never raise. SHA-512
+    is reused from {!Sx_sha2}. Reference: RFC 8032, RFC 7748. *)
+
+(* ---- Minimal bignum: int array, little-endian, base 2^26. ---- *)
+
+let bits = 26
+let base = 1 lsl bits
+let mask = base - 1
+
+type bn = int array  (* normalized: no high zero limbs, length >= 1 *)
+
+let norm (a : bn) : bn =
+  let n = ref (Array.length a) in
+  while !n > 1 && a.(!n - 1) = 0 do decr n done;
+  if !n = Array.length a then a else Array.sub a 0 !n
+
+let bzero : bn = [| 0 |]
+let of_int n : bn =
+  if n = 0 then bzero
+  else begin
+    let r = ref [] and n = ref n in
+    while !n > 0 do r := (!n land mask) :: !r; n := !n lsr bits done;
+    norm (Array.of_list (List.rev !r))
+  end
+
+let is_zero (a : bn) = Array.length a = 1 && a.(0) = 0
+
+let cmp (a : bn) (b : bn) : int =
+  let a = norm a and b = norm b in
+  let la = Array.length a and lb = Array.length b in
+  if la <> lb then compare la lb
+  else begin
+    let r = ref 0 and i = ref (la - 1) in
+    while !r = 0 && !i >= 0 do
+      if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
+      decr i
+    done; !r
+  end
+
+let add (a : bn) (b : bn) : bn =
+  let la = Array.length a and lb = Array.length b in
+  let n = (max la lb) + 1 in
+  let r = Array.make n 0 in
+  let carry = ref 0 in
+  for i = 0 to n - 1 do
+    let s = !carry
+            + (if i < la then a.(i) else 0)
+            + (if i < lb then b.(i) else 0) in
+    r.(i) <- s land mask; carry := s lsr bits
+  done;
+  norm r
+
+(* a - b, requires a >= b *)
+let sub (a : bn) (b : bn) : bn =
+  let la = Array.length a and lb = Array.length b in
+  let r = Array.make la 0 in
+  let borrow = ref 0 in
+  for i = 0 to la - 1 do
+    let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
+    if s < 0 then (r.(i) <- s + base; borrow := 1)
+    else (r.(i) <- s; borrow := 0)
+  done;
+  norm r
+
+let mul (a : bn) (b : bn) : bn =
+  (* Accumulate in Int64: a limb product is 26+26 = 52 bits, which overflows the
+     web targets' int (32-bit js_of_ocaml / 31-bit wasm_of_ocaml). Int64 is a
+     real 64-bit type on every target, so the carries are exact. *)
+  let la = Array.length a and lb = Array.length b in
+  let r = Array.make (la + lb) 0 in
+  let maskL = Int64.of_int mask in
+  for i = 0 to la - 1 do
+    let carry = ref 0L in
+    let ai = Int64.of_int a.(i) in
+    for j = 0 to lb - 1 do
+      let s = Int64.add (Int64.add (Int64.of_int r.(i + j))
+                           (Int64.mul ai (Int64.of_int b.(j)))) !carry in
+      r.(i + j) <- Int64.to_int (Int64.logand s maskL);
+      carry := Int64.shift_right_logical s bits
+    done;
+    r.(i + lb) <- r.(i + lb) + Int64.to_int !carry
+  done;
+  norm r
+
+let numbits (a : bn) : int =
+  let a = norm a in
+  let hi = Array.length a - 1 in
+  if hi = 0 && a.(0) = 0 then 0
+  else begin
+    let b = ref 0 and v = ref a.(hi) in
+    while !v > 0 do incr b; v := !v lsr 1 done;
+    hi * bits + !b
+  end
+
+let bit (a : bn) (i : int) : int =
+  let limb = i / bits and off = i mod bits in
+  if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
+
+(* r = a mod m  (m > 0), binary long division. *)
+let bn_mod (a : bn) (m : bn) : bn =
+  if cmp a m < 0 then norm a
+  else begin
+    let r = ref bzero in
+    for i = numbits a - 1 downto 0 do
+      (* r = r*2 + bit *)
+      r := add !r !r;
+      if bit a i = 1 then r := add !r [| 1 |];
+      if cmp !r m >= 0 then r := sub !r m
+    done;
+    !r
+  end
+
+let div_small (a : bn) (d : int) : bn =
+  (* [rem lsl bits] reaches ~2^34 (rem < d <= 256, bits = 26), past the web
+     targets' int width — accumulate the running remainder in Int64. *)
+  let la = Array.length a in
+  let q = Array.make la 0 in
+  let rem = ref 0L in
+  let dL = Int64.of_int d in
+  for i = la - 1 downto 0 do
+    let cur = Int64.logor (Int64.shift_left !rem bits) (Int64.of_int a.(i)) in
+    q.(i) <- Int64.to_int (Int64.div cur dL);
+    rem := Int64.rem cur dL
+  done;
+  norm q
+
+let powmod (b0 : bn) (e : bn) (m : bn) : bn =
+  let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
+  let nb = numbits e in
+  for i = 0 to nb - 1 do
+    if bit e i = 1 then result := bn_mod (mul !result !b) m;
+    b := bn_mod (mul !b !b) m
+  done;
+  !result
+
+let of_bytes_le (s : string) : bn =
+  let acc = ref bzero in
+  for i = String.length s - 1 downto 0 do
+    acc := add (mul !acc (of_int 256)) (of_int (Char.code s.[i]))
+  done;
+  !acc
+
+let to_bytes_le (a : bn) (n : int) : string =
+  let b = Bytes.make n '\000' in
+  let cur = ref (norm a) in
+  for i = 0 to n - 1 do
+    let q = div_small !cur 256 in
+    let r =
+      let qm = mul q (of_int 256) in
+      let d = sub !cur qm in
+      if is_zero d then 0 else d.(0)
+    in
+    Bytes.set b i (Char.chr r);
+    cur := q
+  done;
+  Bytes.unsafe_to_string b
+
+(* ---- Field GF(p), p = 2^255 - 19 ---- *)
+
+let p =
+  let twop255 = Array.make 11 0 in   (* 11*26 = 286 > 255 *)
+  let limb = 255 / bits and off = 255 mod bits in
+  twop255.(limb) <- 1 lsl off;
+  sub (norm twop255) (of_int 19)
+
+let fmod a = bn_mod a p
+let fadd a b = fmod (add a b)
+let fsub a b = fmod (add a (sub p (fmod b)))
+let fmul a b = fmod (mul a b)
+let fpow a e = powmod a e p
+let finv a = fpow a (sub p (of_int 2))   (* Fermat: a^(p-2) *)
+
+(* group order L = 2^252 + 27742317777372353535851937790883648493 *)
+let ell =
+  of_bytes_le
+    "\xed\xd3\xf5\x5c\x1a\x63\x12\x58\xd6\x9c\xf7\xa2\xde\xf9\xde\x14\
+     \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10"
+
+(* d = -121665 / 121666 mod p *)
+let dconst =
+  let inv666 = finv (of_int 121666) in
+  fmod (mul (fsub (of_int 0) (of_int 121665)) inv666)
+
+(* sqrt(-1) = 2^((p-1)/4) mod p *)
+let sqrtm1 = fpow (of_int 2) (div_small (sub p (of_int 1)) 4)
+
+(* ---- edwards25519 points in extended coords (X,Y,Z,T) ---- *)
+
+type pt = { x : bn; y : bn; z : bn; t : bn }
+
+let identity = { x = bzero; y = of_int 1; z = of_int 1; t = bzero }
+
+(* add-2008-hwcd-3, complete for a = -1 on ed25519 *)
+let padd (p1 : pt) (p2 : pt) : pt =
+  let a = fmul (fsub p1.y p1.x) (fsub p2.y p2.x) in
+  let b = fmul (fadd p1.y p1.x) (fadd p2.y p2.x) in
+  let c = fmul (fmul p1.t (fmul (of_int 2) dconst)) p2.t in
+  let dd = fmul (fmul p1.z (of_int 2)) p2.z in
+  let e = fsub b a in
+  let f = fsub dd c in
+  let g = fadd dd c in
+  let h = fadd b a in
+  { x = fmul e f; y = fmul g h; t = fmul e h; z = fmul f g }
+
+let scalar_mul (n : bn) (q : pt) : pt =
+  let r = ref identity in
+  for i = numbits n - 1 downto 0 do
+    r := padd !r !r;
+    if bit n i = 1 then r := padd !r q
+  done;
+  !r
+
+let pnegate (q : pt) : pt =
+  { q with x = fsub (of_int 0) q.x; t = fsub (of_int 0) q.t }
+
+(* Decompress a 32-byte little-endian point encoding. *)
+let decompress (s : string) : pt option =
+  if String.length s <> 32 then None
+  else begin
+    let sign = (Char.code s.[31] lsr 7) land 1 in
+    let s' = Bytes.of_string s in
+    Bytes.set s' 31 (Char.chr (Char.code s.[31] land 0x7f));
+    let y = of_bytes_le (Bytes.unsafe_to_string s') in
+    if cmp y p >= 0 then None
+    else begin
+      let y2 = fmul y y in
+      let u = fsub y2 (of_int 1) in
+      let v = fadd (fmul dconst y2) (of_int 1) in
+      (* x = u v^3 (u v^7)^((p-5)/8) *)
+      let v3 = fmul (fmul v v) v in
+      let v7 = fmul (fmul v3 v3) v in
+      let exp = div_small (sub p (of_int 5)) 8 in
+      let x0 = fmul (fmul u v3) (fpow (fmul u v7) exp) in
+      let vx2 = fmul v (fmul x0 x0) in
+      let x =
+        if cmp vx2 u = 0 then Some x0
+        else if cmp vx2 (fsub (of_int 0) u) = 0 then Some (fmul x0 sqrtm1)
+        else None
+      in
+      match x with
+      | None -> None
+      | Some x ->
+        if is_zero x && sign = 1 then None
+        else begin
+          let x = if (bit x 0) <> sign then fsub (of_int 0) x else x in
+          Some { x; y; z = of_int 1; t = fmul x y }
+        end
+    end
+  end
+
+(* Encode a point to 32-byte little-endian (y with x-parity bit). *)
+let encode (q : pt) : string =
+  let zi = finv q.z in
+  let x = fmul q.x zi and y = fmul q.y zi in
+  let b = Bytes.of_string (to_bytes_le y 32) in
+  let last = Char.code (Bytes.get b 31) lor ((bit x 0) lsl 7) in
+  Bytes.set b 31 (Char.chr last);
+  Bytes.unsafe_to_string b
+
+(* base point: y = 4/5 mod p, x even (sign 0). *)
+let base_point =
+  let by = fmul (of_int 4) (finv (of_int 5)) in
+  match decompress (to_bytes_le by 32) with
+  | Some pt -> pt
+  | None -> failwith "ed25519: base point decompress failed"
+
+let unhex (h : string) : string =
+  let n = String.length h / 2 in
+  let b = Bytes.create n in
+  for i = 0 to n - 1 do
+    Bytes.set b i
+      (Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
+  done;
+  Bytes.unsafe_to_string b
+
+let sha512_bytes s = unhex (Sx_sha2.sha512_hex s)
+
+(* RFC 8032 §5.1.7 cofactorless: encode([S]B - [k]A) == R. *)
+let verify ~pubkey ~msg ~sig_ : bool =
+  if String.length pubkey <> 32 || String.length sig_ <> 64 then false
+  else
+    let rb = String.sub sig_ 0 32 in
+    let sb = String.sub sig_ 32 32 in
+    let s = of_bytes_le sb in
+    if cmp s ell >= 0 then false
+    else
+      match decompress pubkey with
+      | None -> false
+      | Some a ->
+        let h = sha512_bytes (rb ^ pubkey ^ msg) in
+        let k = bn_mod (of_bytes_le h) ell in
+        let sb_pt = scalar_mul s base_point in
+        let ka = scalar_mul k a in
+        let chk = padd sb_pt (pnegate ka) in
+        (try encode chk = rb with _ -> false)

hosts/ocaml/lib/sx_persist_store.ml

@@ -0,0 +1,293 @@
+(* sx_persist_store — host durable-storage adapter for lib/persist.
+   Production twin of `persist/serve` (lib/persist/durable.sx): it answers the
+   same `persist/...` IO ops, but backs them with real on-disk storage so writes
+   survive a process restart. Stateless-on-disk: every op reads/writes the
+   filesystem directly, so a fresh process recovers state with no warm-up — the
+   log on disk IS the state.
+
+   On-disk layout under the root dir (default ./persist-data, or $SX_PERSIST_DIR):
+     streams/<hex(stream)>.log   append-only, one SX-serialized event per line
+     streams/<hex(stream)>.seq   per-stream monotonic high-water counter (int)
+     kv/<hex(key)>               one SX-serialized value per key
+
+   Invariants honoured (see plans/persist-on-sx.md Blocker spec):
+   1. last-seq is a per-stream monotonic counter stored in .seq, SEPARATE from
+      the rows — it keeps climbing across truncate, so a compacted stream never
+      reassigns a seq.
+   2. append never renumbers — the event already carries its :seq (log.sx does
+      last-seq+1); the host only bumps the high-water mark to max(hw, seq).
+   3. read returns surviving events in append order with :seq intact.
+   4. streams is the set of streams that ever had an append — keyed off the .seq
+      file, which truncate never deletes, so it survives full compaction.
+   5. values round-trip structurally via the SX serializer/parser. *)
+
+open Sx_types
+
+(* ---- root dir ---------------------------------------------------------- *)
+
+let _root : string option ref = ref None
+
+let set_root dir = _root := Some dir
+
+let root_dir () =
+  match !_root with
+  | Some d -> d
+  | None -> (try Sys.getenv "SX_PERSIST_DIR" with Not_found -> "persist-data")
+
+(* ---- filesystem helpers ------------------------------------------------ *)
+
+let rec ensure_dir dir =
+  if dir = "" || dir = "." || dir = "/" || Sys.file_exists dir then ()
+  else begin
+    ensure_dir (Filename.dirname dir);
+    (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
+  end
+
+let streams_dir () = Filename.concat (root_dir ()) "streams"
+let kv_dir () = Filename.concat (root_dir ()) "kv"
+let blobs_dir () = Filename.concat (root_dir ()) "blobs"
+
+let read_file path =
+  let ic = open_in_bin path in
+  let n = in_channel_length ic in
+  let s = really_input_string ic n in
+  close_in ic;
+  s
+
+(* Atomic write: temp file in the same dir then rename over the target. *)
+let write_file_atomic path contents =
+  ensure_dir (Filename.dirname path);
+  let tmp = path ^ ".tmp" in
+  let oc = open_out_bin tmp in
+  output_string oc contents;
+  flush oc;
+  close_out oc;
+  Sys.rename tmp path
+
+let append_line path line =
+  ensure_dir (Filename.dirname path);
+  let oc = open_out_gen [Open_append; Open_creat; Open_wronly] 0o644 path in
+  output_string oc line;
+  output_char oc '\n';
+  close_out oc
+
+(* ---- name <-> filename (hex, reversible, fs-safe) ---------------------- *)
+
+let hex_encode s =
+  let b = Buffer.create (String.length s * 2) in
+  String.iter (fun c -> Buffer.add_string b (Printf.sprintf "%02x" (Char.code c))) s;
+  Buffer.contents b
+
+let hex_decode s =
+  let n = String.length s / 2 in
+  String.init n (fun i -> Char.chr (int_of_string ("0x" ^ String.sub s (i * 2) 2)))
+
+let stream_log stream = Filename.concat (streams_dir ()) (hex_encode stream ^ ".log")
+let stream_seq stream = Filename.concat (streams_dir ()) (hex_encode stream ^ ".seq")
+let kv_path key = Filename.concat (kv_dir ()) (hex_encode key)
+
+(* ---- value <-> SX text (round-trips through Sx_parser) ----------------- *)
+
+let escape_str s =
+  let len = String.length s in
+  let buf = Buffer.create (len + 16) in
+  for i = 0 to len - 1 do
+    match s.[i] with
+    | '"'  -> Buffer.add_string buf "\\\""
+    | '\\' -> Buffer.add_string buf "\\\\"
+    | '\n' -> Buffer.add_string buf "\\n"
+    | '\r' -> Buffer.add_string buf "\\r"
+    | '\t' -> Buffer.add_string buf "\\t"
+    | c    -> Buffer.add_char buf c
+  done;
+  Buffer.contents buf
+
+let rec serialize = function
+  | Nil -> "nil"
+  | Bool true -> "true"
+  | Bool false -> "false"
+  | Integer n -> string_of_int n
+  | Number n -> format_number n
+  | String s -> "\"" ^ escape_str s ^ "\""
+  | Symbol s -> "(quote " ^ s ^ ")"
+  | Keyword k -> ":" ^ k
+  | List items | ListRef { contents = items } ->
+    "(list" ^ (List.fold_left (fun acc v -> acc ^ " " ^ serialize v) "" items) ^ ")"
+  | Dict d ->
+    let pairs = Hashtbl.fold (fun k v acc ->
+      (Printf.sprintf ":%s %s" k (serialize v)) :: acc) d [] in
+    "{" ^ String.concat " " (List.sort String.compare pairs) ^ "}"
+  | _ -> "nil"
+
+(* Parse one serialized value back. Empty / blank -> Nil. *)
+let rec deserialize line =
+  let line = String.trim line in
+  if line = "" then Nil
+  else match Sx_parser.parse_all line with
+    | v :: _ -> eval_quote_lists v
+    | [] -> Nil
+
+(* serialize emits lists as `(list ...)` and symbols as `(quote s)` so the
+   parser yields data, not a call — but the parser leaves those as AST. Walk
+   the parsed AST and collapse `(list ...)`/`(quote s)` back to values. *)
+and eval_quote_lists v =
+  match v with
+  | List (Symbol "quote" :: x :: []) -> x
+  | List (Symbol "list" :: rest) -> List (List.map eval_quote_lists rest)
+  | List items -> List (List.map eval_quote_lists items)
+  | ListRef { contents = items } -> List (List.map eval_quote_lists items)
+  | Dict d ->
+    let d' = Hashtbl.create (Hashtbl.length d) in
+    Hashtbl.iter (fun k v -> Hashtbl.replace d' k (eval_quote_lists v)) d;
+    Dict d'
+  | other -> other
+
+(* ---- seq counter ------------------------------------------------------- *)
+
+let read_seq stream =
+  let p = stream_seq stream in
+  if Sys.file_exists p then (try int_of_string (String.trim (read_file p)) with _ -> 0)
+  else 0
+
+let write_seq stream n = write_file_atomic (stream_seq stream) (string_of_int n)
+
+let value_to_int = function
+  | Integer n -> n
+  | Number n -> int_of_float n
+  | _ -> 0
+
+let event_seq ev =
+  match ev with
+  | Dict d -> (match Hashtbl.find_opt d "seq" with Some v -> value_to_int v | None -> 0)
+  | _ -> 0
+
+(* ---- ops --------------------------------------------------------------- *)
+
+let do_append stream ev =
+  ensure_dir (streams_dir ());
+  (* bump the monotonic high-water mark; create .seq on first append so the
+     stream shows up in `streams` and survives later truncation. *)
+  let hw = read_seq stream in
+  let s = event_seq ev in
+  write_seq stream (max hw s);
+  append_line (stream_log stream) (serialize ev)
+
+let do_read stream =
+  let p = stream_log stream in
+  if not (Sys.file_exists p) then List []
+  else begin
+    let content = read_file p in
+    let lines = String.split_on_char '\n' content in
+    let evs = List.filter_map (fun l ->
+      if String.trim l = "" then None else Some (deserialize l)) lines in
+    List evs
+  end
+
+let do_last_seq stream = Number (float_of_int (read_seq stream))
+
+let list_dir_suffix dir suffix =
+  if not (Sys.file_exists dir) then []
+  else
+    Array.to_list (Sys.readdir dir)
+    |> List.filter (fun f -> Filename.check_suffix f suffix)
+    |> List.map (fun f -> hex_decode (Filename.chop_suffix f suffix))
+    |> List.sort String.compare
+
+let do_streams () = List (List.map (fun s -> String s) (list_dir_suffix (streams_dir ()) ".seq"))
+
+(* drop events with seq <= n; the .seq high-water counter is untouched. *)
+let do_truncate stream n =
+  let p = stream_log stream in
+  if Sys.file_exists p then begin
+    let evs = match do_read stream with List l -> l | _ -> [] in
+    let kept = List.filter (fun ev -> event_seq ev > n) evs in
+    let body = String.concat "" (List.map (fun ev -> serialize ev ^ "\n") kept) in
+    write_file_atomic p body
+  end
+
+let do_kv_get key =
+  let p = kv_path key in
+  if Sys.file_exists p then deserialize (read_file p) else Nil
+
+let do_kv_put key v =
+  ensure_dir (kv_dir ());
+  write_file_atomic (kv_path key) (serialize v)
+
+let do_kv_delete key =
+  let p = kv_path key in
+  if Sys.file_exists p then (try Sys.remove p with _ -> ())
+
+let do_kv_has key = Bool (Sys.file_exists (kv_path key))
+
+let do_kv_keys () =
+  if not (Sys.file_exists (kv_dir ())) then List []
+  else
+    List (
+      Array.to_list (Sys.readdir (kv_dir ()))
+      |> List.map hex_decode
+      |> List.sort String.compare
+      |> List.map (fun s -> String s))
+
+(* ---- blob store (content-addressed) ------------------------------------ *)
+(* Same pattern as the persist ops, but a SEPARATE adapter: large objects live
+   in a content-addressed directory keyed by a CIDv1 (raw codec, sha2-256).
+   persist only ever stores the returned ref ({:cid :size :mime}), never bytes.
+   blob/put is idempotent — identical bytes hash to the same cid + same file. *)
+
+let codec_raw = 0x55
+
+let blob_cid bytes =
+  let digest = Sx_cid.unhex (Sx_sha2.sha256_hex bytes) in
+  Sx_cid.cidv1 codec_raw (Sx_cid.multihash Sx_cid.mh_sha2_256 digest)
+
+let blob_path cid = Filename.concat (blobs_dir ()) cid
+
+let do_blob_put bytes =
+  let cid = blob_cid bytes in
+  let p = blob_path cid in
+  if not (Sys.file_exists p) then write_file_atomic p bytes;
+  String cid
+
+let do_blob_get cid =
+  let p = blob_path cid in
+  if Sys.file_exists p then String (read_file p) else Nil
+
+let do_blob_has cid = Bool (Sys.file_exists (blob_path cid))
+
+(* ---- dispatch ---------------------------------------------------------- *)
+
+let arglist = function
+  | List l | ListRef { contents = l } -> l
+  | Nil -> []
+  | v -> [v]
+
+(* Returns Some response if op is a persist op this store owns, None otherwise. *)
+let handle_op op args =
+  let a = arglist args in
+  let str = function String s -> s | v -> value_to_string v in
+  match op with
+  | "persist/append" ->
+    (match a with stream :: ev :: _ -> do_append (str stream) ev | _ -> ()); Some Nil
+  | "persist/read" ->
+    (match a with stream :: _ -> Some (do_read (str stream)) | _ -> Some (List []))
+  | "persist/last-seq" ->
+    (match a with stream :: _ -> Some (do_last_seq (str stream)) | _ -> Some (Number 0.0))
+  | "persist/streams" -> Some (do_streams ())
+  | "persist/truncate" ->
+    (match a with stream :: n :: _ -> do_truncate (str stream) (value_to_int n) | _ -> ()); Some Nil
+  | "persist/kv-get" ->
+    (match a with key :: _ -> Some (do_kv_get (str key)) | _ -> Some Nil)
+  | "persist/kv-put" ->
+    (match a with key :: v :: _ -> do_kv_put (str key) v | _ -> ()); Some Nil
+  | "persist/kv-delete" ->
+    (match a with key :: _ -> do_kv_delete (str key) | _ -> ()); Some Nil
+  | "persist/kv-has?" ->
+    (match a with key :: _ -> Some (do_kv_has (str key)) | _ -> Some (Bool false))
+  | "persist/kv-keys" -> Some (do_kv_keys ())
+  | "blob/put" ->
+    (match a with bytes :: _ -> Some (do_blob_put (str bytes)) | _ -> Some Nil)
+  | "blob/get" ->
+    (match a with cid :: _ -> Some (do_blob_get (str cid)) | _ -> Some Nil)
+  | "blob/has?" ->
+    (match a with cid :: _ -> Some (do_blob_has (str cid)) | _ -> Some (Bool false))
+  | _ -> None

hosts/ocaml/lib/sx_primitives.ml

@@ -218,7 +218,14 @@ let () =
       Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
   register "/" (fun args ->
     match args with
-    | [Integer a; Integer b] -> make_rat a b
+    (* (/ int int): exact when divisible → integer, else inexact float.
+       Matches spec ("inexact float") + JS host (backward-compatible) +
+       test-numeric-tower ((/ 6 2)=3, (/ 1 4)=0.25, (/ 5 2)=2.5). Exact
+       rationals come ONLY from literals / make-rational, so a rational
+       OPERAND keeps the result exact (cases below) — but two integers do
+       NOT silently produce a rational (that diverged from the JS host). *)
+    | [Integer a; Integer b] when b <> 0 && a mod b = 0 -> Integer (a / b)
+    | [Integer a; Integer b] -> Number (float_of_int a /. float_of_int b)
     | [Rational(an,ad); Integer b] -> make_rat an (ad * b)
     | [Integer a; Rational(bn,bd)] -> make_rat (a * bd) bn
     | [Rational(an,ad); Rational(bn,bd)] -> rat_div (an, ad) (bn, bd)
@@ -397,6 +404,7 @@ let () =
   register "exact?" (fun args ->
     match args with
     | [Integer _] -> Bool true
+    | [Rational _] -> Bool true   (* rationals are exact *)
     | [Number _] -> Bool false
     | [_] -> Bool false
     | _ -> raise (Eval_error "exact?: 1 arg"));
@@ -422,8 +430,20 @@ let () =
   register "expt" (fun args ->
     match args with
     | [Integer a; Integer b] when b >= 0 ->
-      let rec ipow base e acc = if e = 0 then acc else ipow base (e - 1) (acc * base) in
-      Integer (ipow a b 1)
+      (* Overflow-checked integer power: promote to float instead of
+         silently wrapping int63 ((expt 2 100) used to return 0). *)
+      let mul_ovf x y =
+        if x = 0 || y = 0 then Some 0
+        else let p = x * y in
+          if p / y <> x then None else Some p in
+      let rec ipow base e acc =
+        if e = 0 then Some acc
+        else match mul_ovf acc base with
+          | None -> None
+          | Some acc' -> ipow base (e - 1) acc' in
+      (match ipow a b 1 with
+       | Some n -> Integer n
+       | None -> Number (Float.pow (float_of_int a) (float_of_int b)))
     | [a; b] -> Number (Float.pow (as_number a) (as_number b))
     | _ -> raise (Eval_error "expt: 2 args"));
   register "quotient" (fun args ->
@@ -759,11 +779,22 @@ let () =
       (List lb | ListRef { contents = lb }) ->
       List.length la = List.length lb &&
       List.for_all2 safe_eq la lb
-    (* Dict: check __host_handle for DOM node identity *)
+    (* Dict: __host_handle identity for DOM-wrapped dicts; otherwise
+       structural equality over keys + values. *)
     | Dict a, Dict b ->
       (match Hashtbl.find_opt a "__host_handle", Hashtbl.find_opt b "__host_handle" with
        | Some (Number ha), Some (Number hb) -> ha = hb
-       | _ -> false)
+       | Some _, _ | _, Some _ -> false
+       | None, None ->
+         Hashtbl.length a = Hashtbl.length b &&
+         (let eq = ref true in
+          Hashtbl.iter (fun k v ->
+            if !eq then
+              match Hashtbl.find_opt b k with
+              | Some v' -> if not (safe_eq v v') then eq := false
+              | None -> eq := false
+          ) a;
+          !eq))
     (* Records: same type + structurally equal fields *)
     | Record a, Record b ->
       a.r_type.rt_uid = b.r_type.rt_uid &&
@@ -822,7 +853,7 @@ let () =
     match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
   register "number?" (fun args ->
     match args with
-    | [Integer _] | [Number _] -> Bool true
+    | [Integer _] | [Number _] | [Rational _] -> Bool true
     | [_] -> Bool false
     | _ -> raise (Eval_error "number?: 1 arg"));
   register "integer?" (fun args ->
@@ -1208,6 +1239,12 @@ let () =
         else if String.sub s i (String.length sub) = sub then true
         else find (i + 1)
       in Bool (find 0)
+    | [Dict d; key] ->
+      (* Dicts: key check (per the spec doc). Keywords evaluate to their
+         string name, so (contains? {:a 1} :a) arrives as String "a". *)
+      (match key with
+       | String k | Keyword k | Symbol k -> Bool (Hashtbl.mem d k)
+       | _ -> Bool false)
     | _ -> raise (Eval_error "contains?: 2 args"));
   register "range" (fun args ->
     match args with
@@ -2287,7 +2324,13 @@ let () =
           | Some r -> r
           | None -> raise (Eval_error "regex: handle not found"))
        | _ -> raise (Eval_error "regex: missing id"))
-    | _ -> raise (Eval_error "regex: expected regex dict")
+    | String s ->
+      (* Accept a raw pattern string: auto-compile it. Lets regex-split /
+         regex-match-all / regex-test / etc. take a pattern directly, not only
+         a pre-compiled regex dict from regex-compile. *)
+      (try (Re.compile (Re.Pcre.re s), s, "")
+       with _ -> raise (Eval_error ("regex: invalid pattern " ^ s)))
+    | _ -> raise (Eval_error "regex: expected regex dict or pattern string")
   in
   let group_to_dict g input =
     let d = Hashtbl.create 4 in
@@ -2349,6 +2392,14 @@ let () =
     | _ -> raise (Eval_error "regex-match-all: (regex string)"));
   register "regex-replace" (fun args ->
     match args with
+    | [String pattern; String replacement; String input] ->
+      (* string API: (regex-replace pattern replacement input) — replace ALL
+         matches of a raw pattern. Disambiguated from the compiled-regex API
+         below by the first arg being a String rather than a regex Dict. *)
+      (try
+        let re = Re.Pcre.re pattern |> Re.compile in
+        String (Re.replace_string re ~by:replacement input)
+       with _ -> String input)
     | [rx; String s; String replacement] ->
       let (re, _, flags) = regex_of_value rx in
       let expand g =
@@ -3226,6 +3277,21 @@ let () =
       with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg)))
     | _ -> raise (Eval_error "file-read: (path)"));
 
+  (* fed-sx Step 3 segment replay. Sorted names, no "."/".." ;
+     errors prefixed like file-read (msg carries enoent/enotdir). *)
+  register "file-list-dir" (fun args ->
+    match args with
+    | [String path] ->
+      (try
+        let names = Sys.readdir path in
+        let names =
+          Array.to_list names
+          |> List.filter (fun n -> n <> "." && n <> "..") in
+        let names = List.sort compare names in
+        List (List.map (fun n -> String n) names)
+      with Sys_error msg -> raise (Eval_error ("file-list-dir: " ^ msg)))
+    | _ -> raise (Eval_error "file-list-dir: (path)"));
+
   register "file-write" (fun args ->
     match args with
     | [String path; String content] ->
@@ -4117,17 +4183,123 @@ let () =
   register "jit-stats" (fun _args ->
     let d = Hashtbl.create 8 in
     Hashtbl.replace d "threshold"        (Number (float_of_int !Sx_types.jit_threshold));
+    Hashtbl.replace d "budget"           (Number (float_of_int !Sx_types.jit_budget));
+    Hashtbl.replace d "cache-size"       (Number (float_of_int (Sx_types.jit_cache_size ())));
     Hashtbl.replace d "compiled"         (Number (float_of_int !Sx_types.jit_compiled_count));
     Hashtbl.replace d "compile-failed"   (Number (float_of_int !Sx_types.jit_skipped_count));
     Hashtbl.replace d "below-threshold"  (Number (float_of_int !Sx_types.jit_threshold_skipped_count));
+    Hashtbl.replace d "evicted"          (Number (float_of_int !Sx_types.jit_evicted_count));
     Dict d);
   register "jit-set-threshold!" (fun args ->
     match args with
     | [Number n] -> Sx_types.jit_threshold := int_of_float n; Nil
     | [Integer n] -> Sx_types.jit_threshold := n; Nil
     | _ -> raise (Eval_error "jit-set-threshold!: (n) where n is integer"));
+  register "jit-set-budget!" (fun args ->
+    match args with
+    | [Number n] -> Sx_types.jit_budget := int_of_float n; Nil
+    | [Integer n] -> Sx_types.jit_budget := n; Nil
+    | _ -> raise (Eval_error "jit-set-budget!: (n) where n is integer"));
+  register "jit-reset-cache!" (fun _args ->
+    (* Phase 3 manual cache reset — clear all compiled VmClosures.
+       Hot paths will re-JIT on next call (after re-hitting threshold). *)
+    Queue.iter (fun (_, v) ->
+      match v with Lambda l -> l.l_compiled <- None | _ -> ()
+    ) Sx_types.jit_cache_queue;
+    Queue.clear Sx_types.jit_cache_queue;
+    Nil);
+  register "jit-exclude!" (fun args ->
+    (* Mark function names as interpret-only (never JIT-compiled). A guest
+       interpreter calls this for its continuation-using dispatch core.
+       Accepts string/symbol names; a trailing "*" makes it a namespace prefix
+       (e.g. "er-*" excludes every function whose name starts with "er-") —
+       the robust way to declare a whole guest interpreter core. *)
+    List.iter (fun a ->
+      match a with
+      | String n | Symbol n ->
+        let len = String.length n in
+        if len > 0 && n.[len - 1] = '*' then begin
+          let prefix = String.sub n 0 (len - 1) in
+          if not (List.mem prefix !Sx_types.jit_excluded_prefixes) then
+            Sx_types.jit_excluded_prefixes := prefix :: !Sx_types.jit_excluded_prefixes
+        end else
+          Hashtbl.replace Sx_types.jit_excluded n ()
+      | _ -> ()) args;
+    Nil);
+  register "jit-excluded?" (fun args ->
+    match args with
+    | [String n] | [Symbol n] -> Bool (Sx_types.jit_name_excluded n)
+    | _ -> Bool false);
+  register "jit-exclude-callers-of!" (fun args ->
+    (* Register call/cc-establishing forms (e.g. cl-restart-case). Any function
+       whose bytecode references one of these is itself interpret-only — JIT
+       would force the form into a nested cek-run where its continuation can't
+       escape. A guest declares its condition-system / escaping forms here. *)
+    List.iter (fun a ->
+      match a with
+      | String n | Symbol n -> Hashtbl.replace Sx_types.jit_excluded_caller_names n ()
+      | _ -> ()) args;
+    Nil);
   register "jit-reset-counters!" (fun _args ->
     Sx_types.jit_compiled_count := 0;
     Sx_types.jit_skipped_count := 0;
     Sx_types.jit_threshold_skipped_count := 0;
-    Nil)
+    Sx_types.jit_evicted_count := 0;
+    Nil);
+
+  (* fed-sx host primitives — pure-OCaml crypto (WASM-safe). *)
+  register "crypto-sha256" (fun args ->
+    match args with
+    | [String s] -> String (Sx_sha2.sha256_hex s)
+    | _ -> raise (Eval_error "crypto-sha256: (bytes)"));
+
+  register "crypto-sha512" (fun args ->
+    match args with
+    | [String s] -> String (Sx_sha2.sha512_hex s)
+    | _ -> raise (Eval_error "crypto-sha512: (bytes)"));
+
+  register "crypto-sha3-256" (fun args ->
+    match args with
+    | [String s] -> String (Sx_sha3.sha3_256_hex s)
+    | _ -> raise (Eval_error "crypto-sha3-256: (bytes)"));
+
+  register "cbor-encode" (fun args ->
+    match args with
+    | [v] ->
+      (try String (Sx_cbor.encode v)
+       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
+    | _ -> raise (Eval_error "cbor-encode: (value)"));
+
+  register "cbor-decode" (fun args ->
+    match args with
+    | [String s] ->
+      (try Sx_cbor.decode s
+       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
+    | _ -> raise (Eval_error "cbor-decode: (bytes)"));
+
+  register "cid-from-bytes" (fun args ->
+    match args with
+    | [Integer codec; String mh] ->
+      String (Sx_cid.cidv1 codec mh)
+    | _ -> raise (Eval_error "cid-from-bytes: (codec multihash-bytes)"));
+
+  register "cid-from-sx" (fun args ->
+    match args with
+    | [v] ->
+      (try String (Sx_cid.cid_from_sx v)
+       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
+    | _ -> raise (Eval_error "cid-from-sx: (value)"));
+
+  (* Verify is total: any malformed input -> false, never raises. *)
+  register "ed25519-verify" (fun args ->
+    match args with
+    | [String pk; String msg; String sg] ->
+      Bool (try Sx_ed25519.verify ~pubkey:pk ~msg ~sig_:sg
+            with _ -> false)
+    | _ -> Bool false);
+
+  register "rsa-sha256-verify" (fun args ->
+    match args with
+    | [String spki; String msg; String sg] ->
+      Bool (try Sx_rsa.verify ~spki ~msg ~sig_:sg with _ -> false)
+    | _ -> Bool false)

hosts/ocaml/lib/sx_rsa.ml

@@ -0,0 +1,220 @@
+(** RSASSA-PKCS1-v1_5 verification with SHA-256 — pure OCaml,
+    WASM-safe. Self-contained minimal bignum (modexp only), a tiny
+    DER reader for SubjectPublicKeyInfo, and the fixed SHA-256
+    DigestInfo prefix. Verify only on public data — constant time
+    not required. Reference: RFC 8017 §8.2.2, §9.2. No deps. *)
+
+(* ---- Minimal unsigned bignum: int array, little-endian, base 2^26 ---- *)
+
+let bits = 26
+let base = 1 lsl bits
+let mask = base - 1
+
+type bn = int array
+
+let norm a =
+  let n = ref (Array.length a) in
+  while !n > 1 && a.(!n - 1) = 0 do decr n done;
+  if !n = Array.length a then a else Array.sub a 0 !n
+
+let bzero : bn = [| 0 |]
+let is_zero a = Array.length a = 1 && a.(0) = 0
+
+let cmp a b =
+  let a = norm a and b = norm b in
+  let la = Array.length a and lb = Array.length b in
+  if la <> lb then compare la lb
+  else begin
+    let r = ref 0 and i = ref (la - 1) in
+    while !r = 0 && !i >= 0 do
+      if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
+      decr i
+    done; !r
+  end
+
+let add a b =
+  let la = Array.length a and lb = Array.length b in
+  let n = (max la lb) + 1 in
+  let r = Array.make n 0 and carry = ref 0 in
+  for i = 0 to n - 1 do
+    let s = !carry + (if i < la then a.(i) else 0)
+            + (if i < lb then b.(i) else 0) in
+    r.(i) <- s land mask; carry := s lsr bits
+  done;
+  norm r
+
+let sub a b =                       (* requires a >= b *)
+  let la = Array.length a and lb = Array.length b in
+  let r = Array.make la 0 and borrow = ref 0 in
+  for i = 0 to la - 1 do
+    let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
+    if s < 0 then (r.(i) <- s + base; borrow := 1)
+    else (r.(i) <- s; borrow := 0)
+  done;
+  norm r
+
+let mul a b =
+  let la = Array.length a and lb = Array.length b in
+  let r = Array.make (la + lb) 0 in
+  for i = 0 to la - 1 do
+    let carry = ref 0 in
+    for j = 0 to lb - 1 do
+      let s = r.(i + j) + a.(i) * b.(j) + !carry in
+      r.(i + j) <- s land mask; carry := s lsr bits
+    done;
+    r.(i + lb) <- r.(i + lb) + !carry
+  done;
+  norm r
+
+let numbits a =
+  let a = norm a in
+  let hi = Array.length a - 1 in
+  if hi = 0 && a.(0) = 0 then 0
+  else begin
+    let b = ref 0 and v = ref a.(hi) in
+    while !v > 0 do incr b; v := !v lsr 1 done;
+    hi * bits + !b
+  end
+
+let bit a i =
+  let limb = i / bits and off = i mod bits in
+  if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
+
+let bn_mod a m =                    (* binary long division, m > 0 *)
+  if cmp a m < 0 then norm a
+  else begin
+    let r = ref bzero in
+    for i = numbits a - 1 downto 0 do
+      r := add !r !r;
+      if bit a i = 1 then r := add !r [| 1 |];
+      if cmp !r m >= 0 then r := sub !r m
+    done;
+    !r
+  end
+
+let powmod b0 e m =
+  let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
+  for i = 0 to numbits e - 1 do
+    if bit e i = 1 then result := bn_mod (mul !result !b) m;
+    b := bn_mod (mul !b !b) m
+  done;
+  !result
+
+let of_bytes_be (s : string) : bn =
+  let acc = ref bzero in
+  for i = 0 to String.length s - 1 do
+    acc := add (mul !acc [| 256 |]) [| Char.code s.[i] |]
+  done;
+  !acc
+
+let div_small a d =
+  let la = Array.length a in
+  let q = Array.make la 0 and rem = ref 0 in
+  for i = la - 1 downto 0 do
+    let cur = (!rem lsl bits) lor a.(i) in
+    q.(i) <- cur / d; rem := cur mod d
+  done;
+  norm q
+
+let to_bytes_be (a : bn) (n : int) : string =
+  let b = Bytes.make n '\000' in
+  let cur = ref (norm a) in
+  for i = n - 1 downto 0 do
+    let q = div_small !cur 256 in
+    let r =
+      let d = sub !cur (mul q [| 256 |]) in
+      if is_zero d then 0 else d.(0)
+    in
+    Bytes.set b i (Char.chr r);
+    cur := q
+  done;
+  Bytes.unsafe_to_string b
+
+(* ---- Minimal DER reader (for SubjectPublicKeyInfo) ---- *)
+
+exception Der of string
+
+(* Returns (tag, content_start, content_len, next). *)
+let der_tlv s pos =
+  if pos + 2 > String.length s then raise (Der "short");
+  let tag = Char.code s.[pos] in
+  let l0 = Char.code s.[pos + 1] in
+  let len, hdr =
+    if l0 < 0x80 then l0, 2
+    else begin
+      let nb = l0 land 0x7f in
+      if pos + 2 + nb > String.length s then raise (Der "short len");
+      let v = ref 0 in
+      for i = 0 to nb - 1 do
+        v := (!v lsl 8) lor Char.code s.[pos + 2 + i]
+      done;
+      !v, 2 + nb
+    end
+  in
+  (tag, pos + hdr, len, pos + hdr + len)
+
+(* SPKI DER -> (n, e) as bignums. *)
+let parse_spki (der : string) : bn * bn =
+  let tag, c, _l, _ = der_tlv der 0 in
+  if tag <> 0x30 then raise (Der "spki: outer not SEQUENCE");
+  (* AlgorithmIdentifier SEQUENCE — skip. *)
+  let _, _, _, after_alg = der_tlv der c in
+  (* BIT STRING. *)
+  let bt, bc, bl, _ = der_tlv der after_alg in
+  if bt <> 0x03 then raise (Der "spki: expected BIT STRING");
+  (* First content byte = unused bits (must be 0). *)
+  let rpk_start = bc + 1 in
+  ignore bl;
+  let st, sc, _, _ = der_tlv der rpk_start in
+  if st <> 0x30 then raise (Der "spki: RSAPublicKey not SEQUENCE");
+  let nt, nc, nl, after_n = der_tlv der sc in
+  if nt <> 0x02 then raise (Der "spki: modulus not INTEGER");
+  let et, ec, el, _ = der_tlv der after_n in
+  if et <> 0x02 then raise (Der "spki: exponent not INTEGER");
+  let n = of_bytes_be (String.sub der nc nl) in
+  let e = of_bytes_be (String.sub der ec el) in
+  (n, e)
+
+(* SHA-256 DigestInfo DER prefix (RFC 8017 §9.2 note 1). *)
+let sha256_digestinfo_prefix =
+  "\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20"
+
+let unhex h =
+  let n = String.length h / 2 in
+  let b = Bytes.create n in
+  for i = 0 to n - 1 do
+    Bytes.set b i (Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
+  done;
+  Bytes.unsafe_to_string b
+
+(* RSASSA-PKCS1-v1_5 verify with SHA-256. Total: any malformed
+   input yields false (caller wraps, but be defensive here too). *)
+let verify ~spki ~msg ~sig_ : bool =
+  try
+    let n, e = parse_spki spki in
+    let k = (numbits n + 7) / 8 in
+    if String.length sig_ <> k then false
+    else begin
+      let s = of_bytes_be sig_ in
+      if cmp s n >= 0 then false
+      else begin
+        let m = powmod s e n in
+        let em = to_bytes_be m k in
+        (* EM = 0x00 01 FF..FF 00 || DigestInfo || H *)
+        let h = unhex (Sx_sha2.sha256_hex msg) in
+        let t = sha256_digestinfo_prefix ^ h in
+        let tlen = String.length t in
+        if k < tlen + 11 then false
+        else begin
+          let ok = ref (em.[0] = '\x00' && em.[1] = '\x01') in
+          let ps_end = k - tlen - 1 in
+          for i = 2 to ps_end - 1 do
+            if em.[i] <> '\xff' then ok := false
+          done;
+          if em.[ps_end] <> '\x00' then ok := false;
+          if String.sub em (ps_end + 1) tlen <> t then ok := false;
+          !ok
+        end
+      end
+    end
+  with _ -> false

hosts/ocaml/lib/sx_runtime.ml

@@ -17,11 +17,19 @@ let rec _fast_eq a b =
   | Number x, Number y -> x = y
   | Integer x, Number y -> float_of_int x = y
   | Number x, Integer y -> x = float_of_int y
+  (* Exact rationals — must match the "=" primitive (safe_eq). Cross-multiply
+     for rational/rational; coerce for rational/int and rational/float. *)
+  | Rational (an, ad), Rational (bn, bd) -> an * bd = bn * ad
+  | Rational (n, d), Integer y -> n = y * d
+  | Integer x, Rational (n, d) -> x * d = n
+  | Rational (n, d), Number y -> float_of_int n /. float_of_int d = y
+  | Number x, Rational (n, d) -> x = float_of_int n /. float_of_int d
   | 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 ->
+  | (List la | ListRef { contents = la }),
+    (List lb | ListRef { contents = lb }) ->
     (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
   | _ -> false
 

hosts/ocaml/lib/sx_sha2.ml

@@ -0,0 +1,237 @@
+(** SHA-2 (SHA-256, SHA-512) — pure OCaml, WASM-safe.
+
+    No C stubs, no external deps. Used by the fed-sx host primitives
+    [crypto-sha256] / [crypto-sha512]. Reference: FIPS 180-4. *)
+
+(* ---- SHA-256 (FIPS 180-4 §6.2). 32-bit words via Int32, NOT native int.
+   On the web targets the kernel is compiled by js_of_ocaml (32-bit int) and
+   wasm_of_ocaml (31-bit int), where native [int] silently truncates the 32-bit
+   round words — producing WRONG digests (and, downstream, bad CIDs and a
+   Char.chr crash at kernel init). Int32 has well-defined wrap-around mod 2^32 on
+   every target, so this matches the 63-bit native build exactly. ---- *)
+
+let k256 = [|
+  0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l;
+  0x3956c25bl; 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l;
+  0xd807aa98l; 0x12835b01l; 0x243185bel; 0x550c7dc3l;
+  0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; 0xc19bf174l;
+  0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl;
+  0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal;
+  0x983e5152l; 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l;
+  0xc6e00bf3l; 0xd5a79147l; 0x06ca6351l; 0x14292967l;
+  0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; 0x53380d13l;
+  0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l;
+  0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l;
+  0xd192e819l; 0xd6990624l; 0xf40e3585l; 0x106aa070l;
+  0x19a4c116l; 0x1e376c08l; 0x2748774cl; 0x34b0bcb5l;
+  0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; 0x682e6ff3l;
+  0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l;
+  0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l |]
+
+let rotr32 (x : int32) (n : int) : int32 =
+  Int32.logor (Int32.shift_right_logical x n) (Int32.shift_left x (32 - n))
+
+let sha256_hex (msg : string) : string =
+  let h = [| 0x6a09e667l; 0xbb67ae85l; 0x3c6ef372l; 0xa54ff53al;
+             0x510e527fl; 0x9b05688cl; 0x1f83d9abl; 0x5be0cd19l |] in
+  let len = String.length msg in
+  (* Padded length: multiple of 64 bytes. *)
+  let bitlen = Int64.mul (Int64.of_int len) 8L in
+  let padlen =
+    let r = (len + 1) mod 64 in
+    if r <= 56 then 56 - r else 120 - r
+  in
+  let total = len + 1 + padlen + 8 in
+  let buf = Bytes.make total '\000' in
+  Bytes.blit_string msg 0 buf 0 len;
+  Bytes.set buf len '\x80';
+  (* 64-bit big-endian bit length. Int64 shifts so the high bytes (shift >= 32)
+     are correct on the 32-bit web targets — native int `lsr 32` is shift-mod-32
+     on js_of_ocaml and would leak the low length byte into a higher word. *)
+  for i = 0 to 7 do
+    Bytes.set buf (total - 1 - i)
+      (Char.chr (Int64.to_int
+         (Int64.logand (Int64.shift_right_logical bitlen (8 * i)) 0xFFL)))
+  done;
+  let byte i = Int32.of_int (Char.code (Bytes.get buf i)) in
+  let w = Array.make 64 0l in
+  let nblocks = total / 64 in
+  for b = 0 to nblocks - 1 do
+    let base = b * 64 in
+    for t = 0 to 15 do
+      let o = base + t * 4 in
+      w.(t) <-
+        Int32.logor
+          (Int32.logor
+             (Int32.shift_left (byte o) 24)
+             (Int32.shift_left (byte (o + 1)) 16))
+          (Int32.logor
+             (Int32.shift_left (byte (o + 2)) 8)
+             (byte (o + 3)))
+    done;
+    for t = 16 to 63 do
+      let s0 =
+        Int32.logxor
+          (Int32.logxor (rotr32 w.(t - 15) 7) (rotr32 w.(t - 15) 18))
+          (Int32.shift_right_logical w.(t - 15) 3) in
+      let s1 =
+        Int32.logxor
+          (Int32.logxor (rotr32 w.(t - 2) 17) (rotr32 w.(t - 2) 19))
+          (Int32.shift_right_logical w.(t - 2) 10) in
+      w.(t) <-
+        Int32.add (Int32.add w.(t - 16) s0) (Int32.add w.(t - 7) s1)
+    done;
+    let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
+    and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
+    and g = ref h.(6) and hh = ref h.(7) in
+    for t = 0 to 63 do
+      let s1 =
+        Int32.logxor
+          (Int32.logxor (rotr32 !e 6) (rotr32 !e 11)) (rotr32 !e 25) in
+      let ch =
+        Int32.logxor (Int32.logand !e !f)
+          (Int32.logand (Int32.lognot !e) !g) in
+      let t1 =
+        Int32.add
+          (Int32.add (Int32.add !hh s1) (Int32.add ch k256.(t))) w.(t) in
+      let s0 =
+        Int32.logxor
+          (Int32.logxor (rotr32 !a 2) (rotr32 !a 13)) (rotr32 !a 22) in
+      let maj =
+        Int32.logxor
+          (Int32.logxor (Int32.logand !a !bb) (Int32.logand !a !c))
+          (Int32.logand !bb !c) in
+      let t2 = Int32.add s0 maj in
+      hh := !g; g := !f; f := !e;
+      e := Int32.add !d t1;
+      d := !c; c := !bb; bb := !a;
+      a := Int32.add t1 t2
+    done;
+    h.(0) <- Int32.add h.(0) !a;
+    h.(1) <- Int32.add h.(1) !bb;
+    h.(2) <- Int32.add h.(2) !c;
+    h.(3) <- Int32.add h.(3) !d;
+    h.(4) <- Int32.add h.(4) !e;
+    h.(5) <- Int32.add h.(5) !f;
+    h.(6) <- Int32.add h.(6) !g;
+    h.(7) <- Int32.add h.(7) !hh
+  done;
+  let out = Buffer.create 64 in
+  Array.iter (fun x -> Buffer.add_string out (Printf.sprintf "%08lx" x)) h;
+  Buffer.contents out
+
+(* ---- SHA-512 (FIPS 180-4 §6.4). 64-bit words via Int64.
+   128-bit length append; we only support messages whose bit length
+   fits in 64 bits (high word is always zero). ---- *)
+
+let k512 = [|
+  0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL;
+  0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L;
+  0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L;
+  0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L;
+  0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L;
+  0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L;
+  0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L;
+  0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L;
+  0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL;
+  0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L;
+  0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL;
+  0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL;
+  0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L;
+  0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L;
+  0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L;
+  0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L;
+  0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L;
+  0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL;
+  0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL;
+  0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL;
+  0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L;
+  0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L;
+  0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL;
+  0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL;
+  0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL;
+  0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL;
+  0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L |]
+
+let ( &: ) = Int64.logand
+let ( |: ) = Int64.logor
+let ( ^: ) = Int64.logxor
+let ( +: ) = Int64.add
+let lnot64 = Int64.lognot
+
+let rotr64 x n =
+  (Int64.shift_right_logical x n) |: (Int64.shift_left x (64 - n))
+
+let sha512_hex (msg : string) : string =
+  let h = [| 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL;
+             0x3c6ef372fe94f82bL; 0xa54ff53a5f1d36f1L;
+             0x510e527fade682d1L; 0x9b05688c2b3e6c1fL;
+             0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L |] in
+  let len = String.length msg in
+  let bitlen = Int64.mul (Int64.of_int len) 8L in
+  (* Pad to a multiple of 128 bytes; 16-byte big-endian length. *)
+  let padlen =
+    let r = (len + 1) mod 128 in
+    if r <= 112 then 112 - r else 240 - r
+  in
+  let total = len + 1 + padlen + 16 in
+  let buf = Bytes.make total '\000' in
+  Bytes.blit_string msg 0 buf 0 len;
+  Bytes.set buf len '\x80';
+  (* Low 64 bits of the bit length (high 64 stay 0). Int64 shifts so the bytes
+     at shift >= 32 are correct on the 32-bit web targets (js shift-mod-32). *)
+  for i = 0 to 7 do
+    Bytes.set buf (total - 1 - i)
+      (Char.chr (Int64.to_int
+         (Int64.logand (Int64.shift_right_logical bitlen (8 * i)) 0xFFL)))
+  done;
+  let w = Array.make 80 0L in
+  let nblocks = total / 128 in
+  for b = 0 to nblocks - 1 do
+    let base = b * 128 in
+    for t = 0 to 15 do
+      let o = base + t * 8 in
+      let v = ref 0L in
+      for j = 0 to 7 do
+        v := Int64.logor (Int64.shift_left !v 8)
+               (Int64.of_int (Char.code (Bytes.get buf (o + j))))
+      done;
+      w.(t) <- !v
+    done;
+    for t = 16 to 79 do
+      let s0 =
+        (rotr64 w.(t - 15) 1) ^: (rotr64 w.(t - 15) 8)
+        ^: (Int64.shift_right_logical w.(t - 15) 7) in
+      let s1 =
+        (rotr64 w.(t - 2) 19) ^: (rotr64 w.(t - 2) 61)
+        ^: (Int64.shift_right_logical w.(t - 2) 6) in
+      w.(t) <- w.(t - 16) +: s0 +: w.(t - 7) +: s1
+    done;
+    let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
+    and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
+    and g = ref h.(6) and hh = ref h.(7) in
+    for t = 0 to 79 do
+      let s1 = (rotr64 !e 14) ^: (rotr64 !e 18) ^: (rotr64 !e 41) in
+      let ch = (!e &: !f) ^: ((lnot64 !e) &: !g) in
+      let t1 = !hh +: s1 +: ch +: k512.(t) +: w.(t) in
+      let s0 = (rotr64 !a 28) ^: (rotr64 !a 34) ^: (rotr64 !a 39) in
+      let maj = (!a &: !bb) ^: (!a &: !c) ^: (!bb &: !c) in
+      let t2 = s0 +: maj in
+      hh := !g; g := !f; f := !e;
+      e := !d +: t1;
+      d := !c; c := !bb; bb := !a;
+      a := t1 +: t2
+    done;
+    h.(0) <- h.(0) +: !a;
+    h.(1) <- h.(1) +: !bb;
+    h.(2) <- h.(2) +: !c;
+    h.(3) <- h.(3) +: !d;
+    h.(4) <- h.(4) +: !e;
+    h.(5) <- h.(5) +: !f;
+    h.(6) <- h.(6) +: !g;
+    h.(7) <- h.(7) +: !hh
+  done;
+  let out = Buffer.create 128 in
+  Array.iter
+    (fun x -> Buffer.add_string out (Printf.sprintf "%016Lx" x)) h;
+  Buffer.contents out

hosts/ocaml/lib/sx_sha3.ml

@@ -0,0 +1,107 @@
+(** SHA-3 (SHA3-256) — pure OCaml, WASM-safe.
+
+    Keccak-f[1600] permutation + SHA-3 multi-rate padding (domain byte
+    0x06, NOT the legacy Keccak 0x01). Reference: FIPS 202. No deps. *)
+
+let ( ^: ) = Int64.logxor
+let ( &: ) = Int64.logand
+let lnot64 = Int64.lognot
+
+let rotl64 x n =
+  if n = 0 then x
+  else
+    Int64.logor (Int64.shift_left x n) (Int64.shift_right_logical x (64 - n))
+
+(* FIPS 202 Table 2 — ρ rotation offsets, indexed lane = x + 5*y. *)
+let rho = [|
+   0;  1; 62; 28; 27;
+  36; 44;  6; 55; 20;
+   3; 10; 43; 25; 39;
+  41; 45; 15; 21;  8;
+  18;  2; 61; 56; 14 |]
+
+(* FIPS 202 §3.2.5 — round constants RC[0..23] for ι. *)
+let rc = [|
+  0x0000000000000001L; 0x0000000000008082L; 0x800000000000808aL;
+  0x8000000080008000L; 0x000000000000808bL; 0x0000000080000001L;
+  0x8000000080008081L; 0x8000000000008009L; 0x000000000000008aL;
+  0x0000000000000088L; 0x0000000080008009L; 0x000000008000000aL;
+  0x000000008000808bL; 0x800000000000008bL; 0x8000000000008089L;
+  0x8000000000008003L; 0x8000000000008002L; 0x8000000000000080L;
+  0x000000000000800aL; 0x800000008000000aL; 0x8000000080008081L;
+  0x8000000000008080L; 0x0000000080000001L; 0x8000000080008008L |]
+
+let keccak_f (a : int64 array) : unit =
+  let c = Array.make 5 0L and d = Array.make 5 0L in
+  let b = Array.make 25 0L in
+  for round = 0 to 23 do
+    (* θ *)
+    for x = 0 to 4 do
+      c.(x) <- a.(x) ^: a.(x + 5) ^: a.(x + 10)
+               ^: a.(x + 15) ^: a.(x + 20)
+    done;
+    for x = 0 to 4 do
+      d.(x) <- c.((x + 4) mod 5) ^: (rotl64 c.((x + 1) mod 5) 1)
+    done;
+    for x = 0 to 4 do
+      for y = 0 to 4 do
+        a.(x + 5 * y) <- a.(x + 5 * y) ^: d.(x)
+      done
+    done;
+    (* ρ and π: B[y, 2x+3y] = rotl(A[x,y], rho[x,y]) *)
+    for x = 0 to 4 do
+      for y = 0 to 4 do
+        let nx = y and ny = (2 * x + 3 * y) mod 5 in
+        b.(nx + 5 * ny) <- rotl64 a.(x + 5 * y) rho.(x + 5 * y)
+      done
+    done;
+    (* χ *)
+    for y = 0 to 4 do
+      for x = 0 to 4 do
+        a.(x + 5 * y) <-
+          b.(x + 5 * y)
+          ^: ((lnot64 b.((x + 1) mod 5 + 5 * y))
+              &: b.((x + 2) mod 5 + 5 * y))
+      done
+    done;
+    (* ι *)
+    a.(0) <- a.(0) ^: rc.(round)
+  done
+
+let sha3_256_hex (msg : string) : string =
+  let rate = 136 (* bytes: (1600 - 2*256) / 8 *) in
+  let len = String.length msg in
+  (* pad10*1 with SHA-3 domain byte 0x06; last byte ORed with 0x80. *)
+  let q = rate - (len mod rate) in
+  let padded = Bytes.make (len + q) '\000' in
+  Bytes.blit_string msg 0 padded 0 len;
+  if q = 1 then
+    Bytes.set padded len '\x86'
+  else begin
+    Bytes.set padded len '\x06';
+    Bytes.set padded (len + q - 1) '\x80'
+  end;
+  let total = Bytes.length padded in
+  let a = Array.make 25 0L in
+  let nblocks = total / rate in
+  for blk = 0 to nblocks - 1 do
+    let base = blk * rate in
+    (* Absorb: XOR rate bytes into the state, little-endian lanes. *)
+    for j = 0 to rate - 1 do
+      let lane = j / 8 and sh = (j mod 8) * 8 in
+      let byte = Int64.of_int (Char.code (Bytes.get padded (base + j))) in
+      a.(lane) <- a.(lane) ^: (Int64.shift_left byte sh)
+    done;
+    keccak_f a
+  done;
+  (* Squeeze 32 bytes (fits in the first 4 lanes; rate > 32). *)
+  let out = Buffer.create 64 in
+  for j = 0 to 31 do
+    let lane = j / 8 and sh = (j mod 8) * 8 in
+    let byte =
+      Int64.to_int
+        (Int64.logand (Int64.shift_right_logical a.(lane) sh) 0xFFL)
+    in
+    Buffer.add_string out (Printf.sprintf "%02x" byte)
+  done;
+  Buffer.contents out

hosts/ocaml/lib/sx_types.ml

@@ -139,6 +139,7 @@ and lambda = {
   mutable l_name : string option;
   mutable l_compiled : vm_closure option;  (** Lazy JIT cache *)
   mutable l_call_count : int;              (** Tiered-compilation counter — JIT after threshold calls *)
+  l_uid : int;                             (** Unique identity for LRU cache tracking *)
 }
 
 and component = {
@@ -445,12 +446,16 @@ let unwrap_env_val = function
   | Env e -> e
   | _ -> raise (Eval_error "make_lambda: expected env for closure")
 
+(* Lambda UID — minted on construction, used as LRU cache key (Phase 2). *)
+let lambda_uid_counter = ref 0
+let next_lambda_uid () = incr lambda_uid_counter; !lambda_uid_counter
+
 let make_lambda params body closure =
   let ps = match params with
     | List items -> List.map value_to_string items
     | _ -> value_to_string_list params
   in
-  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0 }
+  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0; l_uid = next_lambda_uid () }
 
 (** {1 JIT cache control}
 
@@ -465,6 +470,83 @@ let jit_compiled_count = ref 0
 let jit_skipped_count = ref 0
 let jit_threshold_skipped_count = ref 0
 
+(** Runtime, data-driven JIT exclusion set. Names added here are never
+    JIT-compiled — they run on the CEK interpreter instead.
+
+    This is how a guest interpreter declares its *interpret-only* functions:
+    those that capture or invoke first-class continuations (e.g. Smalltalk's
+    [call/cc]-based non-local return [^expr], or block escape). The stack VM
+    cannot transfer control through a CEK continuation, so a JIT-compiled
+    frame on the OCaml/VM stack between a [call/cc] and its [(k v)] invocation
+    would either fail at runtime or (worse) re-run with duplicated side
+    effects. Marking the dispatch core interpret-only keeps those functions on
+    the CEK while pure helpers still JIT.
+
+    Populated from SX via the [jit-exclude!] primitive (see sx_primitives).
+    Consulted in [Sx_vm.jit_compile_lambda], so it covers BOTH JIT entry
+    points: the CEK call hook and the in-VM tiered-compilation path. *)
+let jit_excluded : (string, unit) Hashtbl.t = Hashtbl.create 64
+
+(** Namespace-prefix exclusions. A guest interpreter declares its whole
+    function namespace interpret-only with one entry (e.g. ["er-"], ["scm-"]),
+    which is far more robust than enumerating every function — a name-list
+    misses functions in extra files (the erlang VM dispatcher, etc.) and
+    silently regresses. Set via [jit-exclude!] with a trailing ["*"]
+    (e.g. [(jit-exclude! "er-*")]). Checked via [jit_name_excluded]. *)
+let jit_excluded_prefixes : string list ref = ref []
+
+(** True if [name] is excluded from JIT — by exact name or by namespace prefix. *)
+let jit_name_excluded name =
+  Hashtbl.mem jit_excluded name
+  || List.exists (fun p ->
+       String.length name >= String.length p
+       && String.sub name 0 (String.length p) = p) !jit_excluded_prefixes
+
+(** Names of functions that ESTABLISH an escaping continuation via call/cc
+    (e.g. Common-Lisp's [cl-restart-case] / [cl-handler-case] — the condition
+    system). Any SX function that *calls* one of these is itself unsafe to JIT:
+    JIT-compiling the caller forces the call/cc-wrapping form to run in a nested
+    cek-run, where invoking the captured continuation runs-to-completion-and-
+    returns instead of escaping — so a restart/non-local exit silently fails
+    and the body falls through (observed as result accumulation / no-abort).
+
+    These callers are NOT a fixed namespace (they are arbitrary user/test code),
+    so they cannot be prefix-excluded. Instead a guest declares its escaping
+    forms here (via [jit-exclude-callers-of!]) and [jit_compile_lambda] skips
+    any function whose constant pool references one of them. *)
+let jit_excluded_caller_names : (string, unit) Hashtbl.t = Hashtbl.create 16
+
+(** {2 JIT cache LRU eviction — Phase 2}
+
+    Once a lambda crosses the threshold, its [l_compiled] slot is filled.
+    To bound memory under unbounded compilation pressure, track all live
+    compiled lambdas in FIFO order, and evict from the head when the count
+    exceeds [jit_budget].
+
+    [lambda_uid_counter] mints unique identities on lambda creation; the
+    LRU queue holds these IDs paired with a back-reference to the lambda
+    so we can clear its [l_compiled] slot on eviction.
+
+    Budget of 0 = no cache (disable JIT entirely).
+    Budget of [max_int] = unbounded (legacy behaviour). Default 5000 is
+    a generous ceiling for any realistic page; the test harness compiles
+    ~3000 distinct one-shot lambdas in a full run but tiered compilation
+    (Phase 1) means most never enter the cache, so steady-state count
+    stays small.
+
+    [lambda_uid_counter] and [next_lambda_uid] are defined above
+    [make_lambda] (which uses them on construction). *)
+let jit_budget = ref 5000
+let jit_evicted_count = ref 0
+
+(** Live compiled lambdas in FIFO order — front is oldest, back is newest.
+    Each entry is (uid, lambda); on eviction we clear lambda.l_compiled and
+    drop from the queue. Using a mutable Queue rather than a hand-rolled
+    linked list because eviction is amortised O(1) at the head and inserts
+    are O(1) at the tail. *)
+let jit_cache_queue : (int * value) Queue.t = Queue.create ()
+let jit_cache_size () = Queue.length jit_cache_queue
+
 let make_component name params has_children body closure affinity =
   let n = value_to_string name in
   let ps = value_to_string_list params in
@@ -822,6 +904,12 @@ let dict_set (d : dict) key v = Hashtbl.replace d key v
 
 let dict_delete (d : dict) key = Hashtbl.remove d key
 
+(* keys/vals order: OCaml Hashtbl fold order is unspecified (in practice
+   reverse insertion for fresh tables). NOTE (2026-07 review): this is a
+   determinism footgun for serialization/content-addressing, but render
+   attr emission depends on the current order (tests pin source-order
+   attributes), so changing it is gated on the insertion-order dict ruling
+   (RULINGS R29) — do not "fix" locally. *)
 let dict_keys (d : dict) =
   Hashtbl.fold (fun k _ acc -> String k :: acc) d []
 

hosts/ocaml/lib/sx_vm.ml

@@ -44,6 +44,11 @@ type vm = {
     ip past OP_PERFORM, stack ready for a result push). *)
 exception VmSuspended of value * vm
 
+(** Raised by the extension dispatch fallthrough when an opcode in the
+    extension range (≥ 200) is encountered with no handler registered.
+    Carries the offending opcode id. See plans/sx-vm-opcode-extension.md. *)
+exception Invalid_opcode of int
+
 (* Register the VM suspension converter so sx_runtime.sx_apply_cek can
    catch VmSuspended and convert it to CekPerformRequest without a
    direct dependency on this module. *)
@@ -57,6 +62,21 @@ let () = Sx_types._convert_vm_suspension := (fun exn ->
 let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
   ref (fun _ _ -> None)
 
+(** Forward reference for extension opcode dispatch — Phase B installs the
+    real registry's dispatch function here at module init. Until then, any
+    opcode in the extension range raises [Invalid_opcode]. Same forward-ref
+    pattern as [jit_compile_ref] above; keeps [Sx_vm_extensions] free to
+    depend on [Sx_vm]'s [vm] / [frame] types without a cycle. *)
+let extension_dispatch_ref : (int -> vm -> frame -> unit) ref =
+  ref (fun op _vm _frame -> raise (Invalid_opcode op))
+
+(** Forward reference for extension opcode → name lookup, used by
+    [opcode_name] / [disassemble] for human-readable disassembly.  The
+    registry installs a real lookup at module init; default returns
+    [None] (then [opcode_name] falls back to "UNKNOWN_n"). *)
+let extension_opcode_name_ref : (int -> string option) ref =
+  ref (fun _ -> None)
+
 (* JIT threshold and counters live in Sx_types so primitives can read them
    without creating a sx_primitives → sx_vm dependency cycle. *)
 
@@ -316,30 +336,51 @@ and call_closure_reuse cl args =
     push_closure_frame vm cl args;
     let saved_frames = List.tl vm.frames in
     vm.frames <- [List.hd vm.frames];
-    (try run vm
-     with
-     | VmSuspended _ as e ->
-       (* IO suspension: save the caller's continuation on the reuse stack.
-          DON'T merge frames — that corrupts the frame chain with nested
-          closures. On resume, restore_reuse in resume_vm processes these
-          in innermost-first order after the callback finishes. *)
-       vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
-       raise e
-     | e ->
-       vm.frames <- saved_frames;
-       vm.sp <- saved_sp;
-       raise e);
-    vm.frames <- saved_frames;
-    (* 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
+      (try run vm;
+        (* Normal completion: result sits at the top of the stack.
+           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. *)
+        if vm.sp > saved_sp then vm.stack.(vm.sp - 1) else Nil
+       with
+       | VmSuspended (req, _) as e ->
+         (match !Sx_types._cek_io_resolver with
+          | Some resolver ->
+            (* Serving path: a `perform` fired inside this HO-primitive
+               callback (map/filter/reduce/for-each/…). The primitive's native
+               OCaml loop sits between us and the resume point, so we CANNOT
+               unwind it and resume later (the loop state would be lost and the
+               remaining elements dropped — corrupting the stack so the next
+               CALL_PRIM sees wrong args). Instead resolve the callback's IO
+               inline and run it to completion right here, returning its value
+               to the native loop exactly as a non-suspending callback would.
+               reuse_stack is isolated so an outer suspension's saved
+               continuations aren't consumed by this nested resume. *)
+            let saved_reuse = vm.reuse_stack in
+            vm.reuse_stack <- [];
+            let rec settle req =
+              let r = resolver req Nil in
+              (try resume_vm vm r
+               with VmSuspended (req2, _) -> settle req2)
+            in
+            let cb = settle req in
+            vm.reuse_stack <- saved_reuse;
+            cb
+          | None ->
+            (* CEK-driven path (no synchronous resolver): preserve the existing
+               behaviour — save the caller's continuation on the reuse stack and
+               re-raise so resume_vm restores it after the callback finishes.
+               DON'T merge frames — that corrupts the frame chain. *)
+            vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
+            raise e)
+       | e ->
+         vm.frames <- saved_frames;
+         vm.sp <- saved_sp;
+         raise e)
     in
+    vm.frames <- saved_frames;
     vm.sp <- saved_sp;
     result
   | None ->
@@ -368,12 +409,20 @@ and vm_call vm f args =
        if l.l_name <> None
        then begin
          l.l_call_count <- l.l_call_count + 1;
-         if l.l_call_count >= !Sx_types.jit_threshold then begin
+         if l.l_call_count >= !Sx_types.jit_threshold && !Sx_types.jit_budget > 0 then begin
            l.l_compiled <- Some jit_failed_sentinel;
            match !jit_compile_ref l vm.globals with
            | Some cl ->
              incr Sx_types.jit_compiled_count;
              l.l_compiled <- Some cl;
+             (* Phase 2 LRU: track this compiled lambda; if cache exceeds budget,
+                evict the oldest by clearing its l_compiled slot. *)
+             Queue.add (l.l_uid, Lambda l) Sx_types.jit_cache_queue;
+             while Queue.length Sx_types.jit_cache_queue > !Sx_types.jit_budget do
+               (match Queue.pop Sx_types.jit_cache_queue with
+                | (_, Lambda ev_l) -> ev_l.l_compiled <- None; incr Sx_types.jit_evicted_count
+                | _ -> ())
+             done;
              push_closure_frame vm cl args
            | None ->
              incr Sx_types.jit_skipped_count;
@@ -780,14 +829,31 @@ and run vm =
           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)
+            (* Non-divisible Integer/Integer + any Rational operand delegate to
+               the "/" primitive (single source of truth): (/ 5 2)=2.5 float,
+               (/ 1/2 2)=1/4 rational. Keeping the VM in lockstep with the
+               primitive avoids diverging from the CEK interpreter. *)
             | 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 (Bool (Sx_runtime._fast_eq a b))
+          (* Trivial scalar cases inline; everything else (Rational, Dict,
+             Record, Vector, ListRef, nested lists) delegates to the "="
+             primitive so VM equality matches CEK exactly. _fast_eq is a
+             stripped-down subset and must not be the source of truth here. *)
+          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)
+            | Bool x, Bool y -> Bool (x = y)
+            | Symbol x, Symbol y -> Bool (x = y)
+            | Keyword x, Keyword y -> Bool (x = y)
+            | Nil, Nil -> Bool true
+            | _ -> (Hashtbl.find Sx_primitives.primitives "=") [a; b])
         | 165 (* OP_LT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
@@ -867,6 +933,15 @@ and run vm =
           let request = pop vm in
           raise (VmSuspended (request, vm))
 
+        (* ---- Extension dispatch fallthrough ----
+           Opcode partition (see plans/sx-vm-opcode-extension.md):
+             0       reserved / NOP
+             1-199   core opcodes (current ceiling 175 = OP_DEC)
+             200-247 extension opcodes (registered via Sx_vm_extensions)
+             248-255 reserved for future expansion / multi-byte
+           Any opcode ≥ 200 routes through the extension registry. *)
+        | op when op >= 200 -> !extension_dispatch_ref op vm frame
+
         | opcode ->
           raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
                                opcode (frame.ip - 1)))
@@ -884,7 +959,17 @@ and run vm =
 
     After the callback finishes, restores any call_closure_reuse
     continuations saved on vm.reuse_stack (innermost first). *)
-let resume_vm vm result =
+and resume_vm vm result =
+  (* The resumed execution runs on [vm]; HO primitives (map/filter/…) called
+     during the resume reach for [!_active_vm] to run their callbacks on the
+     same stack. call_closure restored [_active_vm] to the *caller* when the
+     original VmSuspended unwound through it, so without re-asserting it here
+     the resumed run's callbacks land on the wrong VM (or allocate a fresh
+     one), corrupting the stack. Mirror call_closure's save/set/restore. *)
+  let prev_active = !_active_vm in
+  _active_vm := Some vm;
+  let restore () = _active_vm := prev_active in
+  (try
   (match vm.pending_cek with
    | Some cek_state ->
      vm.pending_cek <- None;
@@ -956,7 +1041,9 @@ let resume_vm vm result =
   let pending = List.rev vm.reuse_stack in
   vm.reuse_stack <- [];
   restore_reuse pending;
-  pop vm
+  let r = pop vm in
+  restore (); r
+  with e -> restore (); raise e)
 
 (** Execute a compiled module (top-level bytecode). *)
 let execute_module code globals =
@@ -1019,6 +1106,105 @@ let _jit_is_broken_name n =
   || n = "hs-repeat-while" || n = "hs-repeat-until"
   || n = "hs-for-each" || n = "hs-put!"
 
+(** Scan bytecode for any extension opcode (≥ 200, the registry's
+    [Sx_vm_extensions.extension_min]). Walks operand bytes correctly
+    so values that happen to be ≥200 (e.g. a CONST u16 index pointing
+    into a large pool) do not trigger false positives. CLOSURE's
+    dynamic upvalue descriptors are read from the constant pool entry
+    at the same index it pushes.
+
+    Used by [jit_compile_lambda] (Phase E of the opcode-extension
+    plan): a lambda whose compiled body contains any extension opcode
+    is routed through interpretation rather than JIT.  Extensions
+    interpret their opcodes via the registry; the JIT does not
+    currently know how to compile them.
+
+    Operand-size logic mirrors [opcode_operand_size] (which is defined
+    later, in the disassembly section); inlined here so this helper can
+    sit before [jit_compile_lambda] in the file. *)
+let bytecode_find_opcode (pred : int -> bool) (bc : int array) (consts : value array) =
+  let core_operand_size = function
+    | 1 | 20 | 21 | 64 | 65 | 128 -> 2  (* u16 *)
+    | 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1  (* u8 *)
+    | 32 | 33 | 34 | 35 -> 2  (* i16 *)
+    | 52 -> 3  (* CALL_PRIM: u16 + u8 *)
+    | _ -> 0
+  in
+  let len = Array.length bc in
+  let ip = ref 0 in
+  let found = ref false in
+  while not !found && !ip < len do
+    let op = bc.(!ip) in
+    if pred op then found := true
+    else begin
+      ip := !ip + 1;
+      let extra = match op with
+        | 51 (* CLOSURE *) when !ip + 1 < len ->
+          let lo = bc.(!ip) in
+          let hi = bc.(!ip + 1) in
+          let idx = lo lor (hi lsl 8) in
+          let uv_count =
+            if idx < Array.length consts then
+              (match consts.(idx) with
+               | Dict d ->
+                 (match Hashtbl.find_opt d "upvalue-count" with
+                  | Some (Integer n) -> n
+                  | Some (Number n) -> int_of_float n
+                  | _ -> 0)
+               | _ -> 0)
+            else 0
+          in
+          2 + uv_count * 2
+        | _ -> core_operand_size op
+      in
+      ip := !ip + extra
+    end
+  done;
+  !found
+
+let bytecode_uses_extension_opcodes bc consts =
+  bytecode_find_opcode (fun op -> op >= 200) bc consts
+
+(** True if [code] — or any closure nested in its constant pool — installs an
+    exception handler (OP_PUSH_HANDLER = 35), i.e. contains a `guard` /
+    `handler-bind` / dream-catch form. The VM's PUSH_HANDLER only intercepts a
+    VM-level RAISE (opcode 37); it does NOT catch the OCaml [Eval_error] that
+    the `error` primitive throws from inside a CALL/CALL_PRIM in a callee
+    frame. So a JIT-compiled guard silently fails to catch thrown errors (they
+    escape across the JIT frame).
+
+    The scan is RECURSIVE: a curried higher-order function (e.g. Dream's
+    `dream-catch-with = (fn (on-error) (fn (next) (fn (req) (guard ...))))`)
+    has no PUSH_HANDLER in its own body — the guard lives in a nested
+    `OP_CLOSURE` whose code sits in the constant pool. JIT-compiling the outer
+    function would mint that inner guard as a VmClosure with the broken VM
+    handler. Descending into nested closure codes catches this, so the whole
+    closure family runs on the CEK (whose guard catches correctly). Covers
+    dream-catch-with, host wrap-errors, and every guard user centrally. *)
+let rec code_uses_handler code =
+  bytecode_find_opcode (fun op -> op = 35) code.vc_bytecode code.vc_constants
+  || Array.exists (fun c ->
+       match c with
+       | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
+         (try code_uses_handler (code_from_value c) with _ -> false)
+       | _ -> false) code.vc_constants
+
+(** True if [code] — or any nested closure code — references (in its constant
+    pool, as a GLOBAL_GET/CALL name) a function registered in
+    [Sx_types.jit_excluded_caller_names] (a call/cc-establishing form like
+    Common-Lisp's cl-restart-case/cl-handler-case). Such a caller must run on
+    the CEK so the continuation captured inside the called form can escape.
+    The constant-pool string IS the referenced symbol name, so membership is a
+    direct lookup; recurse into nested closure codes. Skipped entirely (no
+    Hashtbl walk) when no escaping forms are registered. *)
+let rec code_refs_escaping_caller code =
+  Array.exists (fun c ->
+    match c with
+    | String s -> Hashtbl.mem Sx_types.jit_excluded_caller_names s
+    | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
+      (try code_refs_escaping_caller (code_from_value c) with _ -> false)
+    | _ -> false) code.vc_constants
+
 let jit_compile_lambda (l : lambda) globals =
   let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
   if !_jit_compiling then (
@@ -1034,6 +1220,13 @@ let jit_compile_lambda (l : lambda) globals =
     None
   ) else if _jit_is_broken_name fn_name then (
     None
+  ) else if Sx_types.jit_name_excluded fn_name then (
+    (* Guest-declared interpret-only function (continuation-using dispatch
+       core, or a whole namespace via prefix). Run on the CEK; the stack VM
+       can't escape through a CEK continuation and may miscompile deep AST
+       recursion into a non-terminating loop. See Sx_types.jit_excluded /
+       jit_excluded_prefixes. *)
+    None
   ) else
   try
     _jit_compiling := true;
@@ -1081,8 +1274,32 @@ let jit_compile_lambda (l : lambda) globals =
         if idx < Array.length outer_code.vc_constants then
           let inner_val = outer_code.vc_constants.(idx) in
           let code = code_from_value inner_val in
-          Some { vm_code = code; vm_upvalues = [||];
-                 vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }
+          (* Phase E: if the inner lambda's bytecode contains any
+             extension opcode (≥200), skip JIT and let the lambda run
+             interpreted via CEK. Extension opcodes dispatch correctly
+             through the VM's registry fallthrough, but the JIT has no
+             knowledge of them and shouldn't claim ownership. *)
+          if bytecode_uses_extension_opcodes code.vc_bytecode code.vc_constants then begin
+            Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!"
+              fn_name;
+            None
+          end else if code_uses_handler code then begin
+            (* guard / handler-bind (possibly in a nested closure): VM
+               PUSH_HANDLER doesn't catch the `error` primitive's OCaml
+               exception across frames — run on the CEK. *)
+            Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
+              fn_name;
+            None
+          end else if Hashtbl.length Sx_types.jit_excluded_caller_names > 0
+                      && code_refs_escaping_caller code then begin
+            (* Calls a call/cc-establishing form (e.g. cl-restart-case): must
+               run on the CEK so the captured continuation can escape. *)
+            Printf.eprintf "[jit] SKIP %s: calls a call/cc-establishing form — interpret-only\n%!"
+              fn_name;
+            None
+          end else
+            Some { vm_code = code; vm_upvalues = [||];
+                   vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }
         else begin
           Printf.eprintf "[jit] FAIL %s: closure index %d out of bounds (pool=%d)\n%!"
             fn_name idx (Array.length outer_code.vc_constants);
@@ -1192,7 +1409,12 @@ let opcode_name = function
   | 164 -> "EQ" | 165 -> "LT" | 166 -> "GT" | 167 -> "NOT"
   | 168 -> "LEN" | 169 -> "FIRST" | 170 -> "REST" | 171 -> "NTH"
   | 172 -> "CONS" | 173 -> "NEG" | 174 -> "INC" | 175 -> "DEC"
-  | n -> Printf.sprintf "UNKNOWN_%d" n
+  | n ->
+    (* Extension opcodes (≥200) get their human-readable name from the
+       registry; defaults to UNKNOWN_n if the extension isn't loaded. *)
+    (match !extension_opcode_name_ref n with
+     | Some name -> name
+     | None -> Printf.sprintf "UNKNOWN_%d" n)
 
 (** Number of extra operand bytes consumed by each opcode.
     Returns (format, total_bytes) where format describes the operand types. *)

hosts/ocaml/lib/sx_vm_extension.ml

@@ -0,0 +1,48 @@
+(** {1 VM extension interface}
+
+    Type definitions for VM bytecode extensions. See
+    [plans/sx-vm-opcode-extension.md].
+
+    An extension is a first-class module of type [EXTENSION]: it has a
+    stable [name], an [init] that returns its private state, and an
+    [opcodes] function that lists the opcodes it provides.
+
+    Opcode handlers receive the live [vm] and the active [frame]. They
+    read operands via [Sx_vm.read_u8] / [read_u16], manipulate the stack
+    via [push] / [pop] / [peek], and update the frame's [ip] as needed. *)
+
+(** A handler for an extension opcode. Reads operands from bytecode,
+    manipulates the VM stack, updates the frame's instruction pointer.
+    May raise exceptions (which propagate via the existing VM error path). *)
+type handler = Sx_vm.vm -> Sx_vm.frame -> unit
+
+(** State an extension carries alongside the VM. Opaque to the VM core;
+    extensions extend this with their own constructor and cast as needed.
+
+    Extensible variant — extensions add cases:
+    {[
+      type Sx_vm_extension.extension_state +=
+        | ErlangState of erlang_scheduler
+    ]} *)
+type extension_state = ..
+
+(** An extension is a first-class module of this signature. *)
+module type EXTENSION = sig
+  (** Stable name for this extension (e.g. ["erlang"], ["guest_vm"]).
+      Used as the lookup key in the registry and as the prefix for opcode
+      names ([erlang.OP_PATTERN_TUPLE_2] etc). *)
+  val name : string
+
+  (** Initialize per-instance state. Called once when [register] is
+      invoked on this extension. *)
+  val init : unit -> extension_state
+
+  (** Opcodes this extension provides. Each is
+      [(opcode_id, opcode_name, handler)].
+
+      [opcode_id] must be in the range 200-247 (the extension partition;
+      see the partition comment at the top of [Sx_vm]'s dispatch loop).
+      Conflicts with already-registered opcodes cause [register] to
+      fail. *)
+  val opcodes : extension_state -> (int * string * handler) list
+end

hosts/ocaml/lib/sx_vm_extensions.ml

@@ -0,0 +1,120 @@
+(** {1 VM extension registry}
+
+    Holds the live registry of extension opcodes and installs the
+    [dispatch] function into [Sx_vm.extension_dispatch_ref] at module
+    init time, replacing Phase A's stub.
+
+    See [plans/sx-vm-opcode-extension.md] and [Sx_vm_extension] for the
+    extension interface. *)
+
+open Sx_vm_extension
+
+(** The opcode range an extension is allowed to claim.
+    Mirrors the partition comment in [Sx_vm]. *)
+let extension_min = 200
+let extension_max = 247
+
+(** opcode_id → handler *)
+let by_id : (int, handler) Hashtbl.t = Hashtbl.create 64
+
+(** opcode_name → opcode_id *)
+let by_name : (string, int) Hashtbl.t = Hashtbl.create 64
+
+(** opcode_id → opcode_name (reverse of [by_name]; used by
+    [Sx_vm.opcode_name] for disassembly). *)
+let name_of_id_table : (int, string) Hashtbl.t = Hashtbl.create 64
+
+(** extension_name → state *)
+let states : (string, extension_state) Hashtbl.t = Hashtbl.create 8
+
+(** Registered extension names, newest first. *)
+let extensions : string list ref = ref []
+
+(** Dispatch an extension opcode to its registered handler. Raises
+    [Sx_vm.Invalid_opcode] if no handler is registered for [op]. *)
+let dispatch op vm frame =
+  match Hashtbl.find_opt by_id op with
+  | Some handler -> handler vm frame
+  | None -> raise (Sx_vm.Invalid_opcode op)
+
+(** Register an extension. Fails if the extension name is already
+    registered, or if any opcode_id is outside the extension range or
+    collides with an already-registered opcode. *)
+let register (m : (module EXTENSION)) =
+  let module M = (val m) in
+  if Hashtbl.mem states M.name then
+    failwith (Printf.sprintf
+      "Sx_vm_extensions: extension %S already registered" M.name);
+  let st = M.init () in
+  let ops = M.opcodes st in
+  List.iter (fun (id, opname, _h) ->
+    if id < extension_min || id > extension_max then
+      failwith (Printf.sprintf
+        "Sx_vm_extensions: opcode %d (%s) outside extension range %d-%d"
+        id opname extension_min extension_max);
+    if Hashtbl.mem by_id id then
+      failwith (Printf.sprintf
+        "Sx_vm_extensions: opcode %d (%s) already registered" id opname);
+    if Hashtbl.mem by_name opname then
+      failwith (Printf.sprintf
+        "Sx_vm_extensions: opcode name %S already registered" opname)
+  ) ops;
+  Hashtbl.add states M.name st;
+  List.iter (fun (id, opname, h) ->
+    Hashtbl.add by_id id h;
+    Hashtbl.add by_name opname id;
+    Hashtbl.add name_of_id_table id opname
+  ) ops;
+  extensions := M.name :: !extensions
+
+(** Look up the opcode_id for an opcode_name. Returns [None] if no
+    extension provides that opcode. *)
+let id_of_name name = Hashtbl.find_opt by_name name
+
+(** Look up the opcode_name for an opcode_id. Returns [None] if no
+    extension provides that opcode. Used by disassembly. *)
+let name_of_id id = Hashtbl.find_opt name_of_id_table id
+
+(** Look up the state of an extension by name. Returns [None] if the
+    extension is not registered. *)
+let state_of_extension name = Hashtbl.find_opt states name
+
+(** Names of all registered extensions, newest first. *)
+let registered_extensions () = !extensions
+
+(** Test-only: clear the registry. Used by unit tests to isolate
+    extensions between test cases. The dispatch_ref is left in place. *)
+let _reset_for_tests () =
+  Hashtbl.clear by_id;
+  Hashtbl.clear by_name;
+  Hashtbl.clear name_of_id_table;
+  Hashtbl.clear states;
+  extensions := []
+
+(** Install our [dispatch] into [Sx_vm.extension_dispatch_ref] and our
+    [name_of_id] into [Sx_vm.extension_opcode_name_ref], replacing
+    the Phase A stubs. Idempotent. Called automatically at module init. *)
+let install_dispatch () =
+  Sx_vm.extension_dispatch_ref := dispatch;
+  Sx_vm.extension_opcode_name_ref := name_of_id
+
+let () = install_dispatch ()
+
+(** Compiler-side opcode lookup: register the [extension-opcode-id]
+    primitive. Compilers ([lib/compiler.sx]) call this to emit
+    extension opcodes by name. Returns [Integer id] when registered,
+    [Nil] otherwise — so missing extensions degrade to a fallback
+    rather than failure. *)
+let () =
+  Sx_primitives.register "extension-opcode-id" (fun args ->
+    match args with
+    | [Sx_types.String name] ->
+      (match id_of_name name with
+       | Some id -> Sx_types.Integer id
+       | None -> Sx_types.Nil)
+    | [Sx_types.Symbol name] ->
+      (match id_of_name name with
+       | Some id -> Sx_types.Integer id
+       | None -> Sx_types.Nil)
+    | _ -> raise (Sx_types.Eval_error
+        "extension-opcode-id: expected one string or symbol"))

hosts/ocaml/test/persist_durable_test.sh

@@ -0,0 +1,144 @@
+#!/usr/bin/env bash
+# hosts/ocaml/test/persist_durable_test.sh
+# Acceptance test for the host durable-storage adapter (Sx_persist_store).
+#
+# Exercises `persist/durable-backend` (REAL `perform`, not the mock) under the
+# WORKTREE-built sx_server.exe, and asserts:
+#   1. durable: writes land on disk and read back (the silent-data-loss repro
+#      from plans/persist-on-sx.md now returns correct values).
+#   2. last-seq is monotonic across truncate (compaction never reassigns a seq).
+#   3. kv ops round-trip and delete.
+#   4. recovery: a REAL process restart (write, exit, fresh process, replay)
+#      recovers state from disk.
+#
+# Run from repo root or anywhere; locates the worktree binary relative to itself.
+set -uo pipefail
+
+HERE="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
+ROOT="$(cd "$HERE/../../.." && pwd)"        # repo/worktree root
+cd "$ROOT"
+
+SX="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX" ]; then
+  echo "ERROR: worktree binary not found at $SX — build it first:" >&2
+  echo "  (cd hosts/ocaml && dune build bin/sx_server.exe)" >&2
+  exit 1
+fi
+
+DATADIR="$(mktemp -d)"
+trap 'rm -rf "$DATADIR"' EXIT
+
+PASS=0
+FAIL=0
+check() { # check <label> <got> <expected>
+  if [ "$2" = "$3" ]; then
+    PASS=$((PASS + 1)); printf '  ok   %-40s => %s\n' "$1" "$2"
+  else
+    FAIL=$((FAIL + 1)); printf '  FAIL %-40s got [%s] want [%s]\n' "$1" "$2" "$3"
+  fi
+}
+
+PRELUDE='(epoch 1)
+(load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/persist/durable.sx")
+(load "lib/persist/blob.sx")
+(epoch 2)'
+
+# run_eval <sx-expr-string>: prints the final (ok-len 2 ...) payload line.
+run_eval() {
+  local expr="$1"
+  printf '%s\n(eval %s)\n' "$PRELUDE" "$expr" \
+    | SX_PERSIST_DIR="$DATADIR" timeout 60 "$SX" 2>/dev/null \
+    | awk '/^\(ok-len 2 / {getline; print; exit}'
+}
+
+# escape an SX program into a single-line double-quoted SX string literal for
+# (eval "..."). The REPL reads one command per physical line, so newlines in the
+# program are collapsed to spaces.
+q() { printf '"%s"' "$(printf '%s' "$1" | tr '\n' ' ' | sed 's/\\/\\\\/g; s/"/\\"/g')"; }
+
+echo "== durable: append/read/last-seq round-trip on disk =="
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
+  (begin
+    (persist/append b "s" "x" 0 {:v 1})
+    (persist/append b "s" "x" 0 {:v 2})
+    (list (persist/event-seq (persist/append b "s" "x" 0 {:v 3}))
+          (persist/count b "s")
+          (len (persist/read b "s")))))')")
+check "append/count/read" "$GOT" "(3 3 3)"
+
+echo "== last-seq monotonic across truncate =="
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
+  (begin
+    (persist/append b "t" "x" 0 {})
+    (persist/append b "t" "x" 0 {})
+    (persist/append b "t" "x" 0 {})
+    (persist/truncate b "t" 2)
+    (list (persist/last-seq b "t") (persist/count b "t"))))')")
+check "last-seq survives truncate" "$GOT" "(3 1)"
+
+echo "== streams set survives compaction =="
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
+  (sort ((get b "streams"))))')")
+check "streams" "$GOT" '("s" "t")'
+
+echo "== kv round-trip + delete =="
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
+  (begin
+    (persist/kv-put b "k" {:a 1 :b "two"})
+    (persist/kv-put b "gone" 9)
+    (persist/kv-delete b "gone")
+    (list (get (persist/kv-get b "k") :b)
+          (persist/kv-has? b "k")
+          (persist/kv-has? b "gone"))))')")
+check "kv get/has/delete" "$GOT" '("two" true false)'
+
+echo "== recovery: state survives a REAL process restart =="
+# write in process A then let it exit; the next run is a brand-new process.
+run_eval "$(q '(let ((b (persist/durable-backend)))
+  (begin
+    (persist/append b "r" "ev" 0 {:n 1})
+    (persist/append b "r" "ev" 0 {:n 2})
+    (persist/kv-put b "survive" "yes")
+    (persist/count b "r")))')" >/dev/null
+# fresh process, same SX_PERSIST_DIR — must replay from disk.
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)))
+  (list (persist/count b "r")
+        (persist/last-seq b "r")
+        (get (get (nth (persist/read b "r") 1) :data) :n)
+        (persist/kv-get b "survive")))')")
+check "recovered after restart" "$GOT" '(2 2 2 "yes")'
+
+echo "== blob: content-addressed put/get/has? round-trip =="
+GOT=$(run_eval "$(q '(let ((bs (persist/blob-store-backend)))
+  (let ((r (persist/blob-store bs "hello world" "text/plain")))
+    (list (persist/blob-size r)
+          (persist/blob-mime r)
+          (persist/blob-fetch bs r)
+          (persist/blob-exists? bs r))))')")
+check "blob size/mime/fetch/exists" "$GOT" '(11 "text/plain" "hello world" true)'
+
+echo "== blob: put is content-addressed (idempotent cid) =="
+GOT=$(run_eval "$(q '(let ((bs (persist/blob-store-backend)))
+  (equal? (persist/blob-cid (persist/blob-store bs "same bytes" "x"))
+          (persist/blob-cid (persist/blob-store bs "same bytes" "x"))))')")
+check "same bytes -> same cid" "$GOT" "true"
+
+echo "== blob: bytes + ref-in-kv survive a REAL restart =="
+# process A: store a blob, keep only its ref in the durable kv.
+run_eval "$(q '(let ((b (persist/durable-backend)) (bs (persist/blob-store-backend)))
+  (begin (persist/kv-put b "logo" (persist/blob-store bs "PNGDATA" "image/png")) nil))')" >/dev/null
+# fresh process: read the ref from kv, fetch the bytes from the blob store.
+GOT=$(run_eval "$(q '(let ((b (persist/durable-backend)) (bs (persist/blob-store-backend)))
+  (let ((r (persist/kv-get b "logo")))
+    (list (persist/blob-fetch bs r) (persist/blob-exists? bs r) (persist/blob-mime r))))')")
+check "blob recovered via ref after restart" "$GOT" '("PNGDATA" true "image/png")'
+
+echo
+echo "durable adapter: $PASS passed, $FAIL failed"
+[ "$FAIL" -eq 0 ]

hosts/ocaml/transpiler.sx

@@ -956,7 +956,13 @@
               (= op "starts-with?")
               (= op "ends-with?")
               (= op "string-contains?")
-              (= op "string-length"))
+              (= op "string-length")
+              (= op "vector?")
+              (= op "vector->list")
+              (= op "list->vector")
+              (= op "vector-length")
+              (= op "vector-ref")
+              (= op "gensym"))
             (str
               "(prim_call "
               (ml-quote-string op)

lib/acl/api.sx

@@ -0,0 +1,45 @@
+;; lib/acl/api.sx — public ACL surface over an implicit current db.
+;;
+;; Callers load a fact set once, then issue decisions without threading the db
+;; through every call. The current db is module state; (acl/load! facts) rebuilds
+;; it. This is the boundary the rest of rose-ash imports.
+
+(define acl-current-db nil)
+
+;; Replace the current fact base. Rebuilds the Datalog db under the active
+;; ruleset (see lib/acl/engine.sx).
+(define
+  acl/load!
+  (fn
+    (facts)
+    (do (set! acl-current-db (acl-build-db facts)) acl-current-db)))
+
+;; Ensure a db exists, building an empty one on first use.
+(define
+  acl-ensure-db!
+  (fn
+    ()
+    (do
+      (when
+        (= acl-current-db nil)
+        (set! acl-current-db (acl-build-db (list))))
+      acl-current-db)))
+
+;; Public decision against the current db (pure, no logging).
+(define
+  acl/permit?
+  (fn (subj act res) (acl-permit? (acl-ensure-db!) subj act res)))
+
+;; Decision-with-proof against the current db. See lib/acl/explain.sx.
+(define
+  acl/explain
+  (fn (subj act res) (acl-explain (acl-ensure-db!) subj act res)))
+
+;; Audited decision: logs the outcome to the append-only audit log and returns
+;; the boolean. See lib/acl/audit.sx.
+(define
+  acl/audit
+  (fn (subj act res) (acl-audit-decide! (acl-ensure-db!) subj act res)))
+
+;; Recent audited decisions (chronological).
+(define acl/audit-tail (fn (n) (acl-audit-tail n)))

lib/acl/audit.sx

@@ -0,0 +1,110 @@
+;; lib/acl/audit.sx — append-only decision log.
+;;
+;; Every decision routed through acl-audit-decide! is appended to an in-memory
+;; log with a monotonic sequence number (no wall-clock — deterministic and
+;; testable; a host can stamp time at the serializer boundary). The log is
+;; append-only: there is no mutate or delete, only append, tail, clear,
+;; snapshot/restore, and serialize-for-disk.
+
+(define acl-audit-log (list))
+(define acl-audit-seq 0)
+
+;; Copy a list into a fresh, append!-able list. `map`/`rest`-derived lists are
+;; NOT extensible by append! in this runtime (it silently no-ops), so the live
+;; log must always be a list built with `list` + `append!`.
+(define
+  acl-audit-copy
+  (fn
+    (xs)
+    (let
+      ((fresh (list)))
+      (do (for-each (fn (e) (append! fresh e)) xs) fresh))))
+
+(define
+  acl-audit-clear!
+  (fn
+    ()
+    (do (set! acl-audit-log (list)) (set! acl-audit-seq 0) nil)))
+
+;; Append a decision record. Returns the record.
+(define
+  acl-audit-record!
+  (fn
+    (subj act res allowed?)
+    (let
+      ((entry {:allowed? allowed? :act act :subj subj :res res :seq acl-audit-seq}))
+      (do
+        (set! acl-audit-seq (+ acl-audit-seq 1))
+        (append! acl-audit-log entry)
+        entry))))
+
+;; Decide against db, log the outcome, and return the boolean. This is the
+;; audited path; acl-permit? remains the pure, side-effect-free decision.
+(define
+  acl-audit-decide!
+  (fn
+    (db subj act res)
+    (let
+      ((allowed? (acl-permit? db subj act res)))
+      (do (acl-audit-record! subj act res allowed?) allowed?))))
+
+(define acl-audit-count (fn () (len acl-audit-log)))
+
+;; Most recent n entries (in chronological order). n >= log size returns all.
+(define
+  acl-audit-tail
+  (fn
+    (n)
+    (let
+      ((total (len acl-audit-log)))
+      (if
+        (<= total n)
+        acl-audit-log
+        (acl-audit-drop acl-audit-log (- total n))))))
+
+(define
+  acl-audit-drop
+  (fn
+    (xs k)
+    (if (<= k 0) xs (acl-audit-drop (rest xs) (- k 1)))))
+
+;; Structured snapshot for save/restore — a {:seq :entries} value carrying a
+;; copy of the log (so later appends don't mutate a held snapshot).
+(define acl-audit-snapshot (fn () {:seq acl-audit-seq :entries (acl-audit-copy acl-audit-log)}))
+
+;; Replace the live log from a snapshot. Restores both entries and the seq
+;; counter so subsequent records continue numbering correctly. The log is
+;; rebuilt as a fresh append!-able list (see acl-audit-copy).
+(define
+  acl-audit-restore!
+  (fn
+    (snap)
+    (do
+      (set! acl-audit-log (acl-audit-copy (get snap :entries)))
+      (set! acl-audit-seq (get snap :seq))
+      nil)))
+
+;; Serialize the whole log to a disk-ready string: one record per line,
+;; "seq\tsubj\tact\tres\tallowed?". A host writes this; structured reload is via
+;; snapshot/restore.
+(define
+  acl-audit-serialize
+  (fn
+    ()
+    (reduce
+      (fn
+        (acc e)
+        (str
+          acc
+          (get e :seq)
+          "\t"
+          (get e :subj)
+          "\t"
+          (get e :act)
+          "\t"
+          (get e :res)
+          "\t"
+          (get e :allowed?)
+          "\n"))
+      ""
+      acl-audit-log)))

lib/acl/conformance.conf

@@ -0,0 +1,32 @@
+# ACL conformance config — sourced by lib/guest/conformance.sh.
+
+LANG_NAME=acl
+MODE=dict
+
+PRELOADS=(
+  lib/datalog/tokenizer.sx
+  lib/datalog/parser.sx
+  lib/datalog/unify.sx
+  lib/datalog/db.sx
+  lib/datalog/builtins.sx
+  lib/datalog/aggregates.sx
+  lib/datalog/strata.sx
+  lib/datalog/eval.sx
+  lib/datalog/api.sx
+  lib/datalog/magic.sx
+  lib/acl/schema.sx
+  lib/acl/facts.sx
+  lib/acl/engine.sx
+  lib/acl/explain.sx
+  lib/acl/audit.sx
+  lib/acl/federation.sx
+  lib/acl/api.sx
+)
+
+SUITES=(
+  "direct:lib/acl/tests/direct.sx:(acl-direct-tests-run!)"
+  "inherit:lib/acl/tests/inherit.sx:(acl-inherit-tests-run!)"
+  "explain:lib/acl/tests/explain.sx:(acl-explain-tests-run!)"
+  "fed:lib/acl/tests/fed.sx:(acl-fed-tests-run!)"
+  "harden:lib/acl/tests/harden.sx:(acl-harden-tests-run!)"
+)

lib/acl/conformance.sh

@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+# Thin wrapper — see lib/guest/conformance.sh and lib/acl/conformance.conf.
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/acl/engine.sx

@@ -0,0 +1,72 @@
+;; lib/acl/engine.sx — ACL ruleset + decision reducer over lib/datalog/.
+;;
+;; The engine is a thin layer: it owns the permit ruleset (SX data rules) and
+;; reduces a (subject, action, resource) decision to a Datalog query against a
+;; db built from EDB facts. The rule engine itself is Datalog's.
+;;
+;; Policy — inheritance + federation with deny-overrides:
+;;
+;;   eff_grant(S,A,R) :- grant(S,A,R).                         ; direct
+;;   eff_grant(S,A,R) :- member_of(S,G), eff_grant(G,A,R).     ; group/role chain
+;;   eff_grant(S,A,R) :- child_of(R,P), eff_grant(S,A,P).      ; resource tree
+;;   eff_grant(S,A,R) :- member_of(S,Role), role_grant(Role,A,R). ; role expansion
+;;   eff_grant(S,A,R) :- delegate(Peer,S,A,R),                 ; federated grant
+;;                       trust(Peer,L), level_covers(L,A).
+;;
+;;   eff_deny(S,A,R)  :- deny(S,A,R).                          ; direct
+;;   eff_deny(S,A,R)  :- member_of(S,G), eff_deny(G,A,R).      ; group chain
+;;   eff_deny(S,A,R)  :- child_of(R,P), eff_deny(S,A,P).       ; resource tree
+;;
+;;   permit(S,A,R)    :- eff_grant(S,A,R), not eff_deny(S,A,R).
+;;
+;; DENY-OVERRIDES: an effective deny anywhere in the inheritance closure of
+;; (S,A,R) defeats any effective grant — including federated grants. Deny
+;; inherits through the *same* group and resource chains as grant, so a
+;; group-level or ancestor-resource deny is authoritative for members/
+;; descendants. This is the principled, fail-safe reading of "deny wins".
+;;
+;; FEDERATION — non-transitive trust: a peer's `delegate` fact only grants if a
+;; *local* `trust(Peer, L)` exists AND that level `level_covers` the action.
+;; Trust is re-checked on every query (it is a body literal), never baked in at
+;; fact-ingestion time, so revoking trust or narrowing a level takes effect
+;; immediately on the next decision.
+;;
+;; Termination & stratification:
+;;   - eff_grant/eff_deny recurse only over member_of and child_of, which are
+;;     EDB relations with no function symbols, so the closure is finite (cyclic
+;;     membership/containment just reaches a fixpoint, never loops). The
+;;     federation rule is non-recursive.
+;;   - permit negates eff_deny; neither eff_grant nor eff_deny depends on
+;;     permit, so the program is stratifiable (permit sits in a higher stratum).
+
+(define
+  acl-rules
+  (quote
+    ((eff_grant S A R <- (grant S A R))
+      (eff_grant S A R <- (member_of S G) (eff_grant G A R))
+      (eff_grant S A R <- (child_of R P) (eff_grant S A P))
+      (eff_grant S A R <- (member_of S Role) (role_grant Role A R))
+      (eff_grant
+        S
+        A
+        R
+        <-
+        (delegate Peer S A R)
+        (trust Peer L)
+        (level_covers L A))
+      (eff_deny S A R <- (deny S A R))
+      (eff_deny S A R <- (member_of S G) (eff_deny G A R))
+      (eff_deny S A R <- (child_of R P) (eff_deny S A P))
+      (permit S A R <- (eff_grant S A R) {:neg (eff_deny S A R)}))))
+
+;; Build a Datalog db from a list of EDB facts under the ACL ruleset.
+(define acl-build-db (fn (facts) (dl-program-data facts acl-rules)))
+
+;; Core decision: does the db permit subject S to perform action A on
+;; resource R? Reduces to a ground Datalog query on the derived `permit`
+;; relation — non-empty result means permitted.
+(define
+  acl-permit?
+  (fn
+    (db subj act res)
+    (> (len (dl-query db (list (quote permit) subj act res))) 0)))

lib/acl/explain.sx

@@ -0,0 +1,125 @@
+;; lib/acl/explain.sx — proof-tree reconstruction over the saturated db.
+;;
+;; lib/datalog/ records derived facts but not their provenance, so the proof is
+;; reconstructed here by goal-directed search over the *saturated* db: for a
+;; ground goal we find the first ACL rule (in rule order) whose body holds, take
+;; the first solution binding its remaining variables, and recurse on each body
+;; literal. Negated literals are recorded as verified `:neg-ok` leaves.
+;;
+;; CANONICAL DERIVATION: the Datalog derivation graph is a DAG (a fact may hold
+;; many ways). We pick ONE canonical proof — first matching rule, first solution
+;; — matching the rule order in lib/acl/engine.sx (direct/EDB rules first). A
+;; depth cap guards against pathological cyclic data producing unbounded search.
+;;
+;; A proof node is one of:
+;;   {:fact <lit> :via "edb"}                       — base EDB fact
+;;   {:fact <lit> :rule <head> :body (<node|negleaf> ...)}  — derived
+;;   {:neg-ok <lit>}                                — negation verified to fail
+;;   {:fact <lit> :truncated true}                  — depth cap hit
+
+(define acl-proof-max-depth 64)
+
+;; Substitute a body literal, descending into {:neg ...} dicts (dl-apply-subst
+;; does not recurse into dicts, which would leak the neg's free vars).
+(define
+  acl-subst-lit
+  (fn
+    (lit s)
+    (if
+      (and (dict? lit) (has-key? lit :neg))
+      {:neg (dl-apply-subst (get lit :neg) s)}
+      (dl-apply-subst lit s))))
+
+(define
+  acl-lit-edb?
+  (fn
+    (lit)
+    (and
+      (list? lit)
+      (> (len lit) 0)
+      (symbol? (first lit))
+      (has-key? acl-edb-arity (symbol->string (first lit))))))
+
+(define
+  acl-subst-zip!
+  (fn
+    (d ks vs)
+    (when
+      (> (len ks) 0)
+      (do
+        (dict-set! d (symbol->string (first ks)) (first vs))
+        (acl-subst-zip! d (rest ks) (rest vs))))))
+
+;; Bind a rule head's variables to a ground goal's arguments (positional).
+(define
+  acl-bind-head
+  (fn
+    (head goal)
+    (let
+      ((d {}))
+      (do (acl-subst-zip! d (rest head) (rest goal)) d))))
+
+(define
+  acl-subst-union
+  (fn
+    (a b)
+    (let
+      ((d {}))
+      (do
+        (for-each (fn (k) (dict-set! d k (get a k))) (keys a))
+        (for-each (fn (k) (dict-set! d k (get b k))) (keys b))
+        d))))
+
+(define acl-prove (fn (db goal) (acl-prove-d db goal 0)))
+
+(define
+  acl-prove-d
+  (fn
+    (db goal depth)
+    (cond
+      ((> depth acl-proof-max-depth) {:truncated true :fact goal})
+      ((acl-lit-edb? goal)
+        (if (> (len (dl-query db goal)) 0) {:via "edb" :fact goal} nil))
+      (else (acl-prove-rules db goal acl-rules depth)))))
+
+(define
+  acl-prove-rules
+  (fn
+    (db goal rules depth)
+    (if
+      (= (len rules) 0)
+      nil
+      (let
+        ((p (dl-rule-from-list (first rules))))
+        (if
+          (= (first (get p :head)) (first goal))
+          (let
+            ((hs (acl-bind-head (get p :head) goal)))
+            (let
+              ((qbody (map (fn (l) (acl-subst-lit l hs)) (get p :body))))
+              (let
+                ((sols (dl-query db qbody)))
+                (if
+                  (> (len sols) 0)
+                  (acl-prove-build db goal p hs (first sols) depth)
+                  (acl-prove-rules db goal (rest rules) depth)))))
+          (acl-prove-rules db goal (rest rules) depth))))))
+
+(define
+  acl-prove-build
+  (fn
+    (db goal p hs sol depth)
+    (let ((full (acl-subst-union hs sol))) {:body (map (fn (l) (let ((g (acl-subst-lit l full))) (if (and (dict? g) (has-key? g :neg)) {:neg-ok (get g :neg)} (acl-prove-d db g (+ depth 1))))) (get p :body)) :rule (get p :head) :fact goal})))
+
+;; Public decision-with-proof. Returns:
+;;   {:allowed? <bool> :proof <node|nil> :reason <eff_deny proof|nil>}
+;; When permitted, :proof is the permit derivation. When denied, :proof is nil
+;; and :reason carries the blocking eff_deny proof if one exists (an explicit or
+;; inherited deny), else nil (simply no grant).
+(define
+  acl-explain
+  (fn
+    (db subj act res)
+    (let
+      ((proof (acl-prove db (list (quote permit) subj act res))))
+      (if (= proof nil) {:allowed? false :proof nil :reason (acl-prove db (list (quote eff_deny) subj act res))} {:allowed? true :proof proof :reason nil}))))

lib/acl/facts.sx

@@ -0,0 +1,47 @@
+;; lib/acl/facts.sx — EDB fact constructors.
+;;
+;; Each constructor returns a Datalog fact tuple (a list whose head is the
+;; predicate symbol). These are the only shapes lib/acl/engine.sx feeds to
+;; lib/datalog/.
+;;   Phase 1: actor/resource/grant/deny.
+;;   Phase 2: member_of (subject -> group/role), child_of (resource -> parent),
+;;            role_grant (role -> action,resource capability).
+;;   Phase 4: peer/trust/delegate/level_covers (federation).
+
+(define acl-actor (fn (id kind) (list (quote actor) id kind)))
+
+(define acl-resource-fact (fn (id kind) (list (quote resource) id kind)))
+
+(define acl-grant (fn (subj act res) (list (quote grant) subj act res)))
+
+(define acl-deny (fn (subj act res) (list (quote deny) subj act res)))
+
+;; subject S is a member of group/role G (one hop; transitivity is derived).
+(define acl-member-of (fn (subj grp) (list (quote member_of) subj grp)))
+
+;; resource R is a child of parent P (one hop; transitivity is derived).
+(define acl-child-of (fn (res parent) (list (quote child_of) res parent)))
+
+;; role confers capability (act on res) to every member of the role.
+(define
+  acl-role-grant
+  (fn (role act res) (list (quote role_grant) role act res)))
+
+;; --- federation ---
+
+;; a known peer instance at addr, of some kind (e.g. peer).
+(define acl-peer (fn (addr kind) (list (quote peer) addr kind)))
+
+;; local trust in a peer at a named level. Gates delegated grants at query time.
+(define acl-trust (fn (peer level) (list (quote trust) peer level)))
+
+;; a peer asserts that subject S may A on R. Only takes effect if local trust in
+;; that peer covers action A (see level_covers).
+(define
+  acl-delegate
+  (fn (peer subj act res) (list (quote delegate) peer subj act res)))
+
+;; local policy: trust `level` authorises delegated grants for action `act`.
+(define
+  acl-level-covers
+  (fn (level act) (list (quote level_covers) level act)))

lib/acl/federation.sx

@@ -0,0 +1,61 @@
+;; lib/acl/federation.sx — cross-instance ACL facts + revocation.
+;;
+;; fed-sx replicates ACL facts between instances; this module models the local
+;; side. A peer's authority arrives as `delegate(Peer, S, A, R)` facts, which
+;; only take effect when a local `trust(Peer, L)` and `level_covers(L, A)`
+;; authorise them (enforced by the engine rule, re-checked every query). The
+;; actual network transport is fed-sx's job and is mocked in tests as a dict.
+;;
+;; Trust is NOT transitive: trusting peer α does not extend to peers α trusts.
+;; Only delegate facts that α itself asserts, and that local trust covers, flow.
+
+;; Mock fed-sx pull: `transport` is a dict mapping a peer address (its string
+;; name) to the list of delegate facts that peer asserts. Returns the facts for
+;; `addr`, or an empty list if the peer is unknown / unreachable.
+(define
+  acl-fed-fetch
+  (fn
+    (transport addr)
+    (let
+      ((k (if (symbol? addr) (symbol->string addr) addr)))
+      (if (has-key? transport k) (get transport k) (list)))))
+
+;; Gather delegate facts from every peer in `addrs` via the transport.
+(define
+  acl-fed-collect
+  (fn
+    (transport addrs)
+    (let
+      ((acc (list)))
+      (do
+        (for-each
+          (fn
+            (addr)
+            (for-each
+              (fn (f) (append! acc f))
+              (acl-fed-fetch transport addr)))
+          addrs)
+        acc))))
+
+;; Build a db from local facts plus delegate facts pulled from `peers`. Local
+;; facts must include the `trust`/`level_covers` policy; replicated delegate
+;; facts are gated against it by the engine rule at query time.
+(define
+  acl-fed-build-db
+  (fn
+    (local-facts transport peers)
+    (let
+      ((all (list)))
+      (do
+        (for-each (fn (f) (append! all f)) local-facts)
+        (for-each
+          (fn (f) (append! all f))
+          (acl-fed-collect transport peers))
+        (acl-build-db all)))))
+
+;; Propagated revocation: retract a replicated fact (e.g. a peer's delegate, or
+;; local trust) from a live db. The next decision re-saturates and reflects it.
+(define acl-revoke! (fn (db fact) (do (dl-retract! db fact) db)))
+
+;; Propagated assertion: ingest a newly replicated fact into a live db.
+(define acl-fed-assert! (fn (db fact) (do (dl-assert! db fact) db)))

lib/acl/schema.sx

@@ -0,0 +1,71 @@
+;; lib/acl/schema.sx — ACL sorts and EDB predicate vocabulary.
+;;
+;; Datalog is untyped; this module is the schema-as-data layer. It declares
+;; the subject/resource/action sorts and the arity of every EDB predicate the
+;; ACL engine recognises, plus light validators. Facts that pass these checks
+;; are well-formed inputs to lib/acl/engine.sx.
+
+(define acl-subject-kinds (quote (user group role service)))
+(define acl-resource-kinds (quote (page post thread peer)))
+
+;; Actions are open-ended (a grant may name any action symbol), but these are
+;; the platform's well-known verbs.
+(define acl-actions (quote (read edit comment moderate federate)))
+
+;; EDB predicate name -> arity.
+;;   Phase 1: actor/resource/grant/deny.
+;;   Phase 2: member_of (subject->group/role), child_of (resource->parent),
+;;            role_grant (role->action,resource).
+;;   Phase 4: peer (addr->kind), trust (peer->level),
+;;            delegate (peer->subj,action,resource), level_covers (level->action).
+(define acl-edb-arity {:role_grant 3 :child_of 2 :trust 2 :peer 2 :actor 2 :level_covers 2 :delegate 4 :member_of 2 :deny 3 :grant 3 :resource 2})
+
+(define
+  acl-member?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (acl-member? x (rest xs))))))
+
+(define acl-subject-kind? (fn (k) (acl-member? k acl-subject-kinds)))
+
+(define acl-resource-kind? (fn (k) (acl-member? k acl-resource-kinds)))
+
+(define acl-known-action? (fn (a) (acl-member? a acl-actions)))
+
+;; A fact is a list whose head is a predicate symbol. Valid when the predicate
+;; is known and the argument count matches the declared arity.
+(define
+  acl-fact-valid?
+  (fn
+    (f)
+    (and
+      (list? f)
+      (> (len f) 0)
+      (symbol? (first f))
+      (let
+        ((pred (symbol->string (first f))))
+        (and
+          (has-key? acl-edb-arity pred)
+          (= (- (len f) 1) (get acl-edb-arity pred)))))))
+
+;; Return the sublist of facts that fail acl-fact-valid?. Empty list means the
+;; whole set is well-formed. acl-build-db stays lenient (Datalog accepts any
+;; tuple, and custom action symbols are allowed); callers opt in to checking.
+(define
+  acl-validate-facts
+  (fn
+    (facts)
+    (let
+      ((bad (list)))
+      (do
+        (for-each
+          (fn (f) (when (not (acl-fact-valid? f)) (append! bad f)))
+          facts)
+        bad))))
+
+(define
+  acl-facts-valid?
+  (fn (facts) (= (len (acl-validate-facts facts)) 0)))

lib/acl/scoreboard.json

@@ -0,0 +1,14 @@
+{
+  "lang": "acl",
+  "total_passed": 145,
+  "total_failed": 0,
+  "total": 145,
+  "suites": [
+    {"name":"direct","passed":24,"failed":0,"total":24},
+    {"name":"inherit","passed":30,"failed":0,"total":30},
+    {"name":"explain","passed":35,"failed":0,"total":35},
+    {"name":"fed","passed":31,"failed":0,"total":31},
+    {"name":"harden","passed":25,"failed":0,"total":25}
+  ],
+  "generated": "2026-06-06T22:43:27+00:00"
+}

lib/acl/scoreboard.md

@@ -0,0 +1,11 @@
+# acl scoreboard
+
+**145 / 145 passing** (0 failure(s)).
+
+| Suite | Passed | Total | Status |
+|-------|--------|-------|--------|
+| direct | 24 | 24 | ok |
+| inherit | 30 | 30 | ok |
+| explain | 35 | 35 | ok |
+| fed | 31 | 31 | ok |
+| harden | 25 | 25 | ok |

lib/acl/tests/direct.sx

@@ -0,0 +1,170 @@
+;; lib/acl/tests/direct.sx — Phase 1: direct grants + deny-overrides.
+
+(define acl-dt-pass 0)
+(define acl-dt-fail 0)
+(define acl-dt-failures (list))
+
+(define
+  acl-dt-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! acl-dt-pass (+ acl-dt-pass 1))
+      (do
+        (set! acl-dt-fail (+ acl-dt-fail 1))
+        (append!
+          acl-dt-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+;; A small fixture used by most cases: alice can read page1, is denied edit on
+;; page1, and a service may federate peer1.
+(define
+  acl-dt-fixture
+  (fn
+    ()
+    (acl-build-db
+      (list
+        (acl-actor (quote alice) (quote user))
+        (acl-actor (quote svc1) (quote service))
+        (acl-resource-fact (quote page1) (quote page))
+        (acl-resource-fact (quote peer1) (quote peer))
+        (acl-grant (quote alice) (quote read) (quote page1))
+        (acl-grant (quote alice) (quote edit) (quote page1))
+        (acl-deny (quote alice) (quote edit) (quote page1))
+        (acl-grant (quote svc1) (quote federate) (quote peer1))))))
+
+(define
+  acl-dt-run-all!
+  (fn
+    ()
+    (let
+      ((db (acl-dt-fixture)))
+      (do
+        (acl-dt-check!
+          "direct grant permits"
+          (acl-permit? db (quote alice) (quote read) (quote page1))
+          true)
+        (acl-dt-check!
+          "service grant permits federate"
+          (acl-permit? db (quote svc1) (quote federate) (quote peer1))
+          true)
+        (acl-dt-check!
+          "missing action denied"
+          (acl-permit? db (quote alice) (quote comment) (quote page1))
+          false)
+        (acl-dt-check!
+          "missing resource denied"
+          (acl-permit? db (quote alice) (quote read) (quote page2))
+          false)
+        (acl-dt-check!
+          "missing subject denied"
+          (acl-permit? db (quote bob) (quote read) (quote page1))
+          false)
+        (acl-dt-check!
+          "wrong subject for service grant denied"
+          (acl-permit? db (quote alice) (quote federate) (quote peer1))
+          false)
+        (acl-dt-check!
+          "grant plus deny -> deny wins"
+          (acl-permit? db (quote alice) (quote edit) (quote page1))
+          false)
+        (acl-dt-check!
+          "deny alone still denies"
+          (acl-permit?
+            (acl-build-db
+              (list (acl-deny (quote alice) (quote read) (quote page1))))
+            (quote alice)
+            (quote read)
+            (quote page1))
+          false)
+        (acl-dt-check!
+          "deny on edit does not block read"
+          (acl-permit? db (quote alice) (quote read) (quote page1))
+          true)
+        (acl-dt-check!
+          "empty db denies"
+          (acl-permit?
+            (acl-build-db (list))
+            (quote alice)
+            (quote read)
+            (quote page1))
+          false)
+        (let
+          ((db2 (acl-build-db (list (acl-grant (quote a) (quote read) (quote r)) (acl-grant (quote b) (quote read) (quote r)) (acl-deny (quote b) (quote read) (quote r))))))
+          (do
+            (acl-dt-check!
+              "subject a allowed"
+              (acl-permit? db2 (quote a) (quote read) (quote r))
+              true)
+            (acl-dt-check!
+              "subject b denied by override"
+              (acl-permit? db2 (quote b) (quote read) (quote r))
+              false)))
+        (let
+          ((db3 (acl-build-db (list (acl-actor (quote editors) (quote role)) (acl-grant (quote editors) (quote edit) (quote post1))))))
+          (acl-dt-check!
+            "role subject direct grant"
+            (acl-permit? db3 (quote editors) (quote edit) (quote post1))
+            true))
+        (do
+          (acl/load!
+            (list
+              (acl-grant (quote carol) (quote moderate) (quote thread1))))
+          (acl-dt-check!
+            "api permit via current db"
+            (acl/permit? (quote carol) (quote moderate) (quote thread1))
+            true)
+          (acl-dt-check!
+            "api deny via current db"
+            (acl/permit? (quote carol) (quote read) (quote thread1))
+            false))
+        (do
+          (acl/load! (list))
+          (acl-dt-check!
+            "api reload clears prior grants"
+            (acl/permit? (quote carol) (quote moderate) (quote thread1))
+            false))
+        (acl-dt-check!
+          "schema grant arity valid"
+          (acl-fact-valid? (acl-grant (quote x) (quote read) (quote y)))
+          true)
+        (acl-dt-check!
+          "schema bad arity invalid"
+          (acl-fact-valid? (list (quote grant) (quote x)))
+          false)
+        (acl-dt-check!
+          "schema unknown predicate invalid"
+          (acl-fact-valid? (list (quote frobnicate) (quote x)))
+          false)
+        (acl-dt-check!
+          "schema subject kind known"
+          (acl-subject-kind? (quote service))
+          true)
+        (acl-dt-check!
+          "schema resource kind unknown"
+          (acl-resource-kind? (quote galaxy))
+          false)
+        (acl-dt-check!
+          "schema known action"
+          (acl-known-action? (quote moderate))
+          true)
+        (acl-dt-check!
+          "grant constructor shape"
+          (acl-grant (quote u) (quote read) (quote p))
+          (list (quote grant) (quote u) (quote read) (quote p)))
+        (acl-dt-check!
+          "actor constructor shape"
+          (acl-actor (quote u) (quote user))
+          (list (quote actor) (quote u) (quote user)))))))
+
+(define
+  acl-direct-tests-run!
+  (fn
+    ()
+    (do
+      (set! acl-dt-pass 0)
+      (set! acl-dt-fail 0)
+      (set! acl-dt-failures (list))
+      (acl-dt-run-all!)
+      {:failures acl-dt-failures :total (+ acl-dt-pass acl-dt-fail) :passed acl-dt-pass :failed acl-dt-fail})))

lib/acl/tests/explain.sx

@@ -0,0 +1,316 @@
+;; lib/acl/tests/explain.sx — Phase 3: proof correctness + audit completeness.
+
+(define acl-et-pass 0)
+(define acl-et-fail 0)
+(define acl-et-failures (list))
+
+;; Name-based deep equality. The host `=` compares symbols by interned
+;; identity, which is unstable across substitution/saturation; comparing by
+;; name (as the datalog suite does) makes structural assertions deterministic.
+(define
+  acl-et-eq?
+  (fn
+    (a b)
+    (cond
+      ((and (list? a) (list? b))
+        (and (= (len a) (len b)) (acl-et-eq-l? a b 0)))
+      ((and (dict? a) (dict? b))
+        (let
+          ((ka (keys a)) (kb (keys b)))
+          (and (= (len ka) (len kb)) (acl-et-eq-d? a b ka 0))))
+      ((and (symbol? a) (symbol? b))
+        (= (symbol->string a) (symbol->string b)))
+      (else (= a b)))))
+
+(define
+  acl-et-eq-l?
+  (fn
+    (a b i)
+    (cond
+      ((>= i (len a)) true)
+      ((not (acl-et-eq? (nth a i) (nth b i))) false)
+      (else (acl-et-eq-l? a b (+ i 1))))))
+
+(define
+  acl-et-eq-d?
+  (fn
+    (a b ka i)
+    (cond
+      ((>= i (len ka)) true)
+      ((let ((k (nth ka i))) (not (acl-et-eq? (get a k) (get b k))))
+        false)
+      (else (acl-et-eq-d? a b ka (+ i 1))))))
+
+(define
+  acl-et-check!
+  (fn
+    (name got expected)
+    (if
+      (acl-et-eq? got expected)
+      (set! acl-et-pass (+ acl-et-pass 1))
+      (do
+        (set! acl-et-fail (+ acl-et-fail 1))
+        (append!
+          acl-et-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+;; --- proof-tree walkers ---
+
+;; True if EDB fact `target` appears as a base leaf anywhere in the proof.
+(define
+  acl-et-has-leaf?
+  (fn
+    (node target)
+    (cond
+      ((= node nil) false)
+      ((and (dict? node) (has-key? node :via))
+        (acl-et-eq? (get node :fact) target))
+      ((and (dict? node) (has-key? node :body))
+        (acl-et-any-leaf? (get node :body) target))
+      (else false))))
+
+(define
+  acl-et-any-leaf?
+  (fn
+    (nodes target)
+    (cond
+      ((= (len nodes) 0) false)
+      ((acl-et-has-leaf? (first nodes) target) true)
+      (else (acl-et-any-leaf? (rest nodes) target)))))
+
+;; True if the proof records a verified negation (deny did not fire).
+(define
+  acl-et-has-negok?
+  (fn
+    (node)
+    (cond
+      ((= node nil) false)
+      ((and (dict? node) (has-key? node :neg-ok)) true)
+      ((and (dict? node) (has-key? node :body))
+        (acl-et-any-negok? (get node :body)))
+      (else false))))
+
+(define
+  acl-et-any-negok?
+  (fn
+    (nodes)
+    (cond
+      ((= (len nodes) 0) false)
+      ((acl-et-has-negok? (first nodes)) true)
+      (else (acl-et-any-negok? (rest nodes))))))
+
+(define
+  acl-et-run-all!
+  (fn
+    ()
+    (do
+      (let
+        ((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p))))))
+        (let
+          ((e (acl-explain db (quote u) (quote read) (quote p))))
+          (do
+            (acl-et-check! "direct: allowed?" (get e :allowed?) true)
+            (acl-et-check!
+              "direct: proof root fact"
+              (get (get e :proof) :fact)
+              (list (quote permit) (quote u) (quote read) (quote p)))
+            (acl-et-check!
+              "direct: grant leaf present"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote grant) (quote u) (quote read) (quote p)))
+              true)
+            (acl-et-check!
+              "direct: negation verified"
+              (acl-et-has-negok? (get e :proof))
+              true)
+            (acl-et-check!
+              "direct: reason nil when allowed"
+              (get e :reason)
+              nil))))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-member-of (quote team) (quote org)) (acl-grant (quote org) (quote read) (quote doc))))))
+        (let
+          ((e (acl-explain db (quote alice) (quote read) (quote doc))))
+          (do
+            (acl-et-check! "group: allowed?" (get e :allowed?) true)
+            (acl-et-check!
+              "group: member_of alice leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote member_of) (quote alice) (quote team)))
+              true)
+            (acl-et-check!
+              "group: member_of team leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote member_of) (quote team) (quote org)))
+              true)
+            (acl-et-check!
+              "group: grant org leaf at base"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote grant) (quote org) (quote read) (quote doc)))
+              true))))
+      (let
+        ((db (acl-build-db (list (acl-child-of (quote sec) (quote book)) (acl-grant (quote u) (quote read) (quote book))))))
+        (let
+          ((e (acl-explain db (quote u) (quote read) (quote sec))))
+          (do
+            (acl-et-check! "resource: allowed?" (get e :allowed?) true)
+            (acl-et-check!
+              "resource: child_of leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote child_of) (quote sec) (quote book)))
+              true)
+            (acl-et-check!
+              "resource: grant on parent leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote grant) (quote u) (quote read) (quote book)))
+              true))))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-role-grant (quote editor) (quote edit) (quote page1))))))
+        (let
+          ((e (acl-explain db (quote bob) (quote edit) (quote page1))))
+          (do
+            (acl-et-check! "role: allowed?" (get e :allowed?) true)
+            (acl-et-check!
+              "role: member_of leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list (quote member_of) (quote bob) (quote editor)))
+              true)
+            (acl-et-check!
+              "role: role_grant leaf"
+              (acl-et-has-leaf?
+                (get e :proof)
+                (list
+                  (quote role_grant)
+                  (quote editor)
+                  (quote edit)
+                  (quote page1)))
+              true))))
+      (let
+        ((db (acl-build-db (list (acl-grant (quote u) (quote edit) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
+        (let
+          ((e (acl-explain db (quote u) (quote edit) (quote p))))
+          (do
+            (acl-et-check! "deny: not allowed" (get e :allowed?) false)
+            (acl-et-check! "deny: no proof" (get e :proof) nil)
+            (acl-et-check!
+              "deny: reason root is eff_deny"
+              (get (get e :reason) :fact)
+              (list (quote eff_deny) (quote u) (quote edit) (quote p)))
+            (acl-et-check!
+              "deny: reason has deny leaf"
+              (acl-et-has-leaf?
+                (get e :reason)
+                (list (quote deny) (quote u) (quote edit) (quote p)))
+              true))))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote alice) (quote read) (quote doc)) (acl-deny (quote team) (quote read) (quote doc))))))
+        (let
+          ((e (acl-explain db (quote alice) (quote read) (quote doc))))
+          (do
+            (acl-et-check!
+              "inherited deny: not allowed"
+              (get e :allowed?)
+              false)
+            (acl-et-check!
+              "inherited deny: reason has member_of leaf"
+              (acl-et-has-leaf?
+                (get e :reason)
+                (list (quote member_of) (quote alice) (quote team)))
+              true)
+            (acl-et-check!
+              "inherited deny: reason has group deny leaf"
+              (acl-et-has-leaf?
+                (get e :reason)
+                (list (quote deny) (quote team) (quote read) (quote doc)))
+              true))))
+      (let
+        ((db (acl-build-db (list))))
+        (let
+          ((e (acl-explain db (quote u) (quote read) (quote p))))
+          (do
+            (acl-et-check! "no grant: not allowed" (get e :allowed?) false)
+            (acl-et-check! "no grant: proof nil" (get e :proof) nil)
+            (acl-et-check! "no grant: reason nil" (get e :reason) nil))))
+      (let
+        ((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
+        (do
+          (acl-audit-clear!)
+          (acl-et-check! "audit: starts empty" (acl-audit-count) 0)
+          (acl-et-check!
+            "audit decide allowed returns true"
+            (acl-audit-decide! db (quote u) (quote read) (quote p))
+            true)
+          (acl-et-check!
+            "audit decide denied returns false"
+            (acl-audit-decide! db (quote u) (quote edit) (quote p))
+            false)
+          (acl-audit-decide! db (quote u) (quote comment) (quote p))
+          (acl-et-check!
+            "audit: count after three decisions"
+            (acl-audit-count)
+            3)
+          (acl-et-check!
+            "audit: tail size respects n"
+            (len (acl-audit-tail 2))
+            2)
+          (acl-et-check!
+            "audit: tail returns most recent"
+            (get (first (acl-audit-tail 1)) :act)
+            (quote comment))
+          (acl-et-check!
+            "audit: first record seq is 0"
+            (get (first (acl-audit-tail 3)) :seq)
+            0)
+          (acl-et-check!
+            "audit: allowed flag recorded"
+            (get (first (acl-audit-tail 3)) :allowed?)
+            true)
+          (acl-et-check!
+            "audit: serialize line count"
+            (len (acl-et-lines (acl-audit-serialize)))
+            3)
+          (acl-audit-clear!)
+          (acl-et-check!
+            "audit: clear resets count"
+            (acl-audit-count)
+            0))))))
+
+;; count newline-terminated lines in a serialized log
+(define acl-et-lines (fn (s) (acl-et-count-nl s 0 0)))
+(define
+  acl-et-count-nl
+  (fn
+    (s i n)
+    (if
+      (>= i (len s))
+      (if (= n 0) (list) (acl-et-rangelist n))
+      (acl-et-count-nl
+        s
+        (+ i 1)
+        (if (= (slice s i (+ i 1)) "\n") (+ n 1) n)))))
+(define
+  acl-et-rangelist
+  (fn
+    (n)
+    (if
+      (<= n 0)
+      (list)
+      (cons n (acl-et-rangelist (- n 1))))))
+
+(define
+  acl-explain-tests-run!
+  (fn
+    ()
+    (do
+      (set! acl-et-pass 0)
+      (set! acl-et-fail 0)
+      (set! acl-et-failures (list))
+      (acl-et-run-all!)
+      {:failures acl-et-failures :total (+ acl-et-pass acl-et-fail) :passed acl-et-pass :failed acl-et-fail})))

lib/acl/tests/fed.sx

@@ -0,0 +1,273 @@
+;; lib/acl/tests/fed.sx — Phase 4: federation (peer trust, delegation,
+;; cross-instance chains, revocation). fed-sx transport is mocked as a dict.
+
+(define acl-ft-pass 0)
+(define acl-ft-fail 0)
+(define acl-ft-failures (list))
+
+;; Name-based deep equality (host `=` compares symbols by unstable interned
+;; identity; see lib/acl/tests/explain.sx).
+(define
+  acl-ft-eq?
+  (fn
+    (a b)
+    (cond
+      ((and (list? a) (list? b))
+        (and (= (len a) (len b)) (acl-ft-eq-l? a b 0)))
+      ((and (symbol? a) (symbol? b))
+        (= (symbol->string a) (symbol->string b)))
+      (else (= a b)))))
+(define
+  acl-ft-eq-l?
+  (fn
+    (a b i)
+    (cond
+      ((>= i (len a)) true)
+      ((not (acl-ft-eq? (nth a i) (nth b i))) false)
+      (else (acl-ft-eq-l? a b (+ i 1))))))
+
+(define
+  acl-ft-check!
+  (fn
+    (name got expected)
+    (if
+      (acl-ft-eq? got expected)
+      (set! acl-ft-pass (+ acl-ft-pass 1))
+      (do
+        (set! acl-ft-fail (+ acl-ft-fail 1))
+        (append!
+          acl-ft-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+;; proof leaf walker (federated proofs reconstruct through the engine rule).
+(define
+  acl-ft-has-leaf?
+  (fn
+    (node target)
+    (cond
+      ((= node nil) false)
+      ((and (dict? node) (has-key? node :via))
+        (acl-ft-eq? (get node :fact) target))
+      ((and (dict? node) (has-key? node :body))
+        (acl-ft-any-leaf? (get node :body) target))
+      (else false))))
+(define
+  acl-ft-any-leaf?
+  (fn
+    (nodes target)
+    (cond
+      ((= (len nodes) 0) false)
+      ((acl-ft-has-leaf? (first nodes) target) true)
+      (else (acl-ft-any-leaf? (rest nodes) target)))))
+
+(define acl-ft-p? (fn (db s a r) (acl-permit? db s a r)))
+
+;; A standard federation fixture: local trusts peer alpha at "readonly", which
+;; covers read+comment. alpha delegates several capabilities to alice.
+(define
+  acl-ft-fixture
+  (fn
+    ()
+    (acl-build-db
+      (list
+        (acl-trust (quote alpha) (quote readonly))
+        (acl-level-covers (quote readonly) (quote read))
+        (acl-level-covers (quote readonly) (quote comment))
+        (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))
+        (acl-delegate (quote alpha) (quote alice) (quote edit) (quote doc))))))
+
+(define
+  acl-ft-run-all!
+  (fn
+    ()
+    (do
+      (let
+        ((db (acl-ft-fixture)))
+        (do
+          (acl-ft-check!
+            "trusted delegate, level covers action -> permit"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-ft-check!
+            "trusted delegate, level does NOT cover action -> deny"
+            (acl-ft-p? db (quote alice) (quote edit) (quote doc))
+            false)
+          (acl-ft-check!
+            "delegated but action class uncovered (comment has no delegate)"
+            (acl-ft-p? db (quote alice) (quote comment) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-level-covers (quote readonly) (quote read)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
+        (acl-ft-check!
+          "untrusted peer delegate -> deny"
+          (acl-ft-p? db (quote bob) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote readonly)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
+        (acl-ft-check!
+          "trust but no level_covers -> deny"
+          (acl-ft-p? db (quote alice) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
+        (do
+          (acl-ft-check!
+            "trust is per-peer: alpha's delegate applies"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-ft-check!
+            "trust not transitive: beta's delegate does not apply"
+            (acl-ft-p? db (quote bob) (quote read) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
+        (acl-ft-check!
+          "local deny overrides federated grant"
+          (acl-ft-p? db (quote alice) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-member-of (quote alice) (quote team)) (acl-delegate (quote alpha) (quote team) (quote read) (quote doc))))))
+        (acl-ft-check!
+          "federated grant to group reaches member"
+          (acl-ft-p? db (quote alice) (quote read) (quote doc))
+          true))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-child-of (quote sec) (quote book)) (acl-delegate (quote alpha) (quote u) (quote read) (quote book))))))
+        (acl-ft-check!
+          "federated grant on parent resource reaches child"
+          (acl-ft-p? db (quote u) (quote read) (quote sec))
+          true))
+      (let
+        ((transport {:gamma (list (acl-delegate (quote gamma) (quote carol) (quote read) (quote post))) :alpha (list (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)))}))
+        (do
+          (acl-ft-check!
+            "fetch known peer returns its delegates"
+            (len (acl-fed-fetch transport (quote alpha)))
+            1)
+          (acl-ft-check!
+            "fetch unknown peer returns empty"
+            (len (acl-fed-fetch transport (quote delta)))
+            0)
+          (acl-ft-check!
+            "collect across peers"
+            (len
+              (acl-fed-collect transport (list (quote alpha) (quote gamma))))
+            2)
+          (let
+            ((db (acl-fed-build-db (list (acl-trust (quote alpha) (quote readonly)) (acl-trust (quote gamma) (quote readonly)) (acl-level-covers (quote readonly) (quote read))) transport (list (quote alpha) (quote gamma)))))
+            (do
+              (acl-ft-check!
+                "fed-build-db: alpha delegate permits"
+                (acl-ft-p? db (quote alice) (quote read) (quote doc))
+                true)
+              (acl-ft-check!
+                "fed-build-db: gamma delegate permits"
+                (acl-ft-p? db (quote carol) (quote read) (quote post))
+                true)
+              (acl-ft-check!
+                "fed-build-db: untrusted action still denied"
+                (acl-ft-p? db (quote alice) (quote edit) (quote doc))
+                false)))))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
+        (do
+          (acl-ft-check!
+            "before revoke: permitted"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-revoke!
+            db
+            (acl-delegate
+              (quote alpha)
+              (quote alice)
+              (quote read)
+              (quote doc)))
+          (acl-ft-check!
+            "after delegate revoked: denied"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
+        (do
+          (acl-ft-check!
+            "before trust revoke: permitted"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-revoke! db (acl-trust (quote alpha) (quote full)))
+          (acl-ft-check!
+            "after trust revoked: denied"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
+        (do
+          (acl-ft-check!
+            "delegate without trust: denied"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            false)
+          (acl-fed-assert! db (acl-trust (quote alpha) (quote full)))
+          (acl-ft-check!
+            "trust ingested then re-checked: permitted"
+            (acl-ft-p? db (quote alice) (quote read) (quote doc))
+            true)))
+      (let
+        ((db (acl-ft-fixture)))
+        (let
+          ((e (acl-explain db (quote alice) (quote read) (quote doc))))
+          (do
+            (acl-ft-check! "federated proof allowed?" (get e :allowed?) true)
+            (acl-ft-check!
+              "federated proof has delegate leaf"
+              (acl-ft-has-leaf?
+                (get e :proof)
+                (list
+                  (quote delegate)
+                  (quote alpha)
+                  (quote alice)
+                  (quote read)
+                  (quote doc)))
+              true)
+            (acl-ft-check!
+              "federated proof has trust leaf"
+              (acl-ft-has-leaf?
+                (get e :proof)
+                (list (quote trust) (quote alpha) (quote readonly)))
+              true)
+            (acl-ft-check!
+              "federated proof has level_covers leaf"
+              (acl-ft-has-leaf?
+                (get e :proof)
+                (list (quote level_covers) (quote readonly) (quote read)))
+              true))))
+      (acl-ft-check!
+        "schema delegate arity valid"
+        (acl-fact-valid?
+          (acl-delegate (quote p) (quote s) (quote a) (quote r)))
+        true)
+      (acl-ft-check!
+        "schema trust arity valid"
+        (acl-fact-valid? (acl-trust (quote p) (quote l)))
+        true)
+      (acl-ft-check!
+        "schema peer arity valid"
+        (acl-fact-valid? (acl-peer (quote p) (quote peer)))
+        true)
+      (acl-ft-check!
+        "schema level_covers arity valid"
+        (acl-fact-valid? (acl-level-covers (quote l) (quote read)))
+        true)
+      (acl-ft-check!
+        "schema delegate bad arity invalid"
+        (acl-fact-valid? (list (quote delegate) (quote p) (quote s)))
+        false))))
+
+(define
+  acl-fed-tests-run!
+  (fn
+    ()
+    (do
+      (set! acl-ft-pass 0)
+      (set! acl-ft-fail 0)
+      (set! acl-ft-failures (list))
+      (acl-ft-run-all!)
+      {:failures acl-ft-failures :total (+ acl-ft-pass acl-ft-fail) :passed acl-ft-pass :failed acl-ft-fail})))

lib/acl/tests/harden.sx

@@ -0,0 +1,228 @@
+;; lib/acl/tests/harden.sx — adversarial / cross-phase hardening.
+;;
+;; Diamond hierarchies, conflict resolution where deny must win through every
+;; path, chain inheritance, cycle termination, multi-peer delegation, fact
+;; validation, and audit save/restore.
+;;
+;; PROVER-FREE BY DESIGN: this suite calls only acl-permit? (which runs in
+;; compiled Datalog, safe at any depth) plus pure data ops — never acl-explain /
+;; acl-prove-d. The SX-side proof reconstructor recurses, and once the kernel
+;; JIT-compiles it (after the explain/fed suites warm the process) it loops on
+;; chains deeper than ~3 (substrate JIT bug — see plan Blockers). Proof
+;; reconstruction is covered by tests/explain.sx (and federated proofs by
+;; tests/fed.sx), both of which stay under the warm-process depth threshold.
+
+(define acl-hd-pass 0)
+(define acl-hd-fail 0)
+(define acl-hd-failures (list))
+
+(define
+  acl-hd-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! acl-hd-pass (+ acl-hd-pass 1))
+      (do
+        (set! acl-hd-fail (+ acl-hd-fail 1))
+        (append!
+          acl-hd-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define acl-hd-p? (fn (db s a r) (acl-permit? db s a r)))
+
+(define
+  acl-hd-run-all!
+  (fn
+    ()
+    (do
+      (let
+        ((grant-deny (acl-build-db (list (acl-child-of (quote r) (quote p1)) (acl-child-of (quote r) (quote p2)) (acl-grant (quote u) (quote read) (quote p1)) (acl-deny (quote u) (quote read) (quote p2)))))
+          (both-grant
+            (acl-build-db
+              (list
+                (acl-child-of (quote r) (quote p1))
+                (acl-child-of (quote r) (quote p2))
+                (acl-grant (quote u) (quote read) (quote p1))
+                (acl-grant (quote u) (quote read) (quote p2))))))
+        (do
+          (acl-hd-check!
+            "diamond resource: grant+deny parents -> deny wins"
+            (acl-hd-p? grant-deny (quote u) (quote read) (quote r))
+            false)
+          (acl-hd-check!
+            "diamond resource: both grant -> permit"
+            (acl-hd-p? both-grant (quote u) (quote read) (quote r))
+            true)
+          (acl-hd-check!
+            "diamond resource: deny does not leak to other parent"
+            (acl-hd-p? grant-deny (quote u) (quote read) (quote p1))
+            true)))
+      (let
+        ((grant-deny (acl-build-db (list (acl-member-of (quote alice) (quote g1)) (acl-member-of (quote alice) (quote g2)) (acl-grant (quote g1) (quote read) (quote doc)) (acl-deny (quote g2) (quote read) (quote doc)))))
+          (both-grant
+            (acl-build-db
+              (list
+                (acl-member-of (quote alice) (quote g1))
+                (acl-member-of (quote alice) (quote g2))
+                (acl-grant (quote g1) (quote read) (quote doc))
+                (acl-grant (quote g2) (quote read) (quote doc))))))
+        (do
+          (acl-hd-check!
+            "diamond group: grant+deny groups -> deny wins"
+            (acl-hd-p? grant-deny (quote alice) (quote read) (quote doc))
+            false)
+          (acl-hd-check!
+            "diamond group: both grant -> permit"
+            (acl-hd-p? both-grant (quote alice) (quote read) (quote doc))
+            true)))
+      (let
+        ((chain (acl-build-db (list (acl-member-of (quote a0) (quote a1)) (acl-member-of (quote a1) (quote a2)) (acl-member-of (quote a2) (quote a3)) (acl-member-of (quote a3) (quote a4)) (acl-grant (quote a4) (quote read) (quote res)))))
+          (chain-deny
+            (acl-build-db
+              (list
+                (acl-member-of (quote a0) (quote a1))
+                (acl-member-of (quote a1) (quote a2))
+                (acl-member-of (quote a2) (quote a3))
+                (acl-member-of (quote a3) (quote a4))
+                (acl-grant (quote a4) (quote read) (quote res))
+                (acl-deny (quote a0) (quote read) (quote res))))))
+        (do
+          (acl-hd-check!
+            "chain: top-group grant reaches leaf member"
+            (acl-hd-p? chain (quote a0) (quote read) (quote res))
+            true)
+          (acl-hd-check!
+            "chain: intermediate also covered"
+            (acl-hd-p? chain (quote a2) (quote read) (quote res))
+            true)
+          (acl-hd-check!
+            "chain: leaf-member deny overrides top grant"
+            (acl-hd-p? chain-deny (quote a0) (quote read) (quote res))
+            false)
+          (acl-hd-check!
+            "chain: deny on leaf does not block sibling level"
+            (acl-hd-p? chain-deny (quote a1) (quote read) (quote res))
+            true)))
+      (let
+        ((self-member (acl-build-db (list (acl-member-of (quote a) (quote a)) (acl-grant (quote a) (quote read) (quote r)))))
+          (self-child
+            (acl-build-db
+              (list
+                (acl-child-of (quote r) (quote r))
+                (acl-grant (quote u) (quote read) (quote r)))))
+          (two-cycle
+            (acl-build-db
+              (list
+                (acl-member-of (quote x) (quote y))
+                (acl-member-of (quote y) (quote x))
+                (acl-grant (quote y) (quote read) (quote r))))))
+        (do
+          (acl-hd-check!
+            "self-membership cycle terminates and grants"
+            (acl-hd-p? self-member (quote a) (quote read) (quote r))
+            true)
+          (acl-hd-check!
+            "self-child cycle terminates and grants"
+            (acl-hd-p? self-child (quote u) (quote read) (quote r))
+            true)
+          (acl-hd-check!
+            "two-node membership cycle terminates"
+            (acl-hd-p? two-cycle (quote x) (quote read) (quote r))
+            true)))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-member-of (quote alice) (quote team)) (acl-delegate (quote alpha) (quote team) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
+        (acl-hd-check!
+          "federated group grant, local member deny -> deny wins"
+          (acl-hd-p? db (quote alice) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
+        (acl-hd-check!
+          "two peers delegate, one trusted -> permit"
+          (acl-hd-p? db (quote bob) (quote read) (quote doc))
+          true))
+      (let
+        ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-trust (quote beta) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
+        (acl-hd-check!
+          "two peers both trusted -> permit"
+          (acl-hd-p? db (quote bob) (quote read) (quote doc))
+          true))
+      (let
+        ((empty (acl-build-db (list))))
+        (acl-hd-check!
+          "empty db: nothing permitted"
+          (acl-hd-p? empty (quote u) (quote read) (quote r))
+          false))
+      (do
+        (acl-hd-check!
+          "validate: clean set has no bad facts"
+          (len
+            (acl-validate-facts
+              (list
+                (acl-grant (quote u) (quote read) (quote p))
+                (acl-member-of (quote u) (quote g))
+                (acl-delegate (quote pe) (quote u) (quote read) (quote p)))))
+          0)
+        (acl-hd-check!
+          "validate: facts-valid? true on clean set"
+          (acl-facts-valid?
+            (list (acl-grant (quote u) (quote read) (quote p))))
+          true)
+        (acl-hd-check!
+          "validate: surfaces wrong-arity and unknown predicate"
+          (len
+            (acl-validate-facts
+              (list
+                (acl-grant (quote u) (quote read) (quote p))
+                (list (quote grant) (quote u))
+                (list (quote bogus) (quote x) (quote y)))))
+          2)
+        (acl-hd-check!
+          "validate: empty set is valid"
+          (acl-facts-valid? (list))
+          true))
+      (let
+        ((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
+        (do
+          (acl-audit-clear!)
+          (acl-audit-decide! db (quote u) (quote read) (quote p))
+          (acl-audit-decide! db (quote u) (quote edit) (quote p))
+          (let
+            ((snap (acl-audit-snapshot)))
+            (do
+              (acl-audit-clear!)
+              (acl-hd-check!
+                "audit: cleared count is 0"
+                (acl-audit-count)
+                0)
+              (acl-audit-restore! snap)
+              (acl-hd-check!
+                "audit: restored count"
+                (acl-audit-count)
+                2)
+              (acl-hd-check!
+                "audit: restored last act"
+                (get (first (acl-audit-tail 1)) :act)
+                (quote edit))
+              (acl-audit-decide! db (quote u) (quote comment) (quote p))
+              (acl-hd-check!
+                "audit: seq continues after restore"
+                (get (first (acl-audit-tail 1)) :seq)
+                2)
+              (acl-hd-check!
+                "audit: snapshot is an immutable copy"
+                (len (get snap :entries))
+                2)
+              (acl-audit-clear!))))))))
+
+(define
+  acl-harden-tests-run!
+  (fn
+    ()
+    (do
+      (set! acl-hd-pass 0)
+      (set! acl-hd-fail 0)
+      (set! acl-hd-failures (list))
+      (acl-hd-run-all!)
+      {:failures acl-hd-failures :total (+ acl-hd-pass acl-hd-fail) :passed acl-hd-pass :failed acl-hd-fail})))

lib/acl/tests/inherit.sx

@@ -0,0 +1,202 @@
+;; lib/acl/tests/inherit.sx — Phase 2: inheritance (groups, resource trees,
+;; role expansion) with deny-overrides.
+
+(define acl-it-pass 0)
+(define acl-it-fail 0)
+(define acl-it-failures (list))
+
+(define
+  acl-it-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! acl-it-pass (+ acl-it-pass 1))
+      (do
+        (set! acl-it-fail (+ acl-it-fail 1))
+        (append!
+          acl-it-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define acl-it-p? (fn (db s a r) (acl-permit? db s a r)))
+
+(define
+  acl-it-run-all!
+  (fn
+    ()
+    (do
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc))))))
+        (do
+          (acl-it-check!
+            "group grant reaches member"
+            (acl-it-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-it-check!
+            "group grant: non-member excluded"
+            (acl-it-p? db (quote bob) (quote read) (quote doc))
+            false)
+          (acl-it-check!
+            "group grant: wrong action"
+            (acl-it-p? db (quote alice) (quote edit) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-member-of (quote team) (quote org)) (acl-member-of (quote org) (quote company)) (acl-grant (quote company) (quote read) (quote doc))))))
+        (do
+          (acl-it-check!
+            "deep nested group grant reaches leaf member"
+            (acl-it-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-it-check!
+            "intermediate group also covered"
+            (acl-it-p? db (quote team) (quote read) (quote doc))
+            true)
+          (acl-it-check!
+            "mid group org covered"
+            (acl-it-p? db (quote org) (quote read) (quote doc))
+            true)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote a) (quote b)) (acl-member-of (quote b) (quote a)) (acl-grant (quote b) (quote read) (quote r))))))
+        (do
+          (acl-it-check!
+            "cyclic membership terminates and grants"
+            (acl-it-p? db (quote a) (quote read) (quote r))
+            true)
+          (acl-it-check!
+            "cyclic membership covers both"
+            (acl-it-p? db (quote b) (quote read) (quote r))
+            true)))
+      (let
+        ((db (acl-build-db (list (acl-child-of (quote sec) (quote chap)) (acl-child-of (quote chap) (quote book)) (acl-grant (quote u) (quote read) (quote book))))))
+        (do
+          (acl-it-check!
+            "parent grant reaches direct child"
+            (acl-it-p? db (quote u) (quote read) (quote chap))
+            true)
+          (acl-it-check!
+            "parent grant reaches deep descendant"
+            (acl-it-p? db (quote u) (quote read) (quote sec))
+            true)
+          (acl-it-check!
+            "parent grant covers parent itself"
+            (acl-it-p? db (quote u) (quote read) (quote book))
+            true)
+          (acl-it-check!
+            "child grant does not climb to parent"
+            (acl-it-p?
+              (acl-build-db
+                (list
+                  (acl-child-of (quote sec) (quote book))
+                  (acl-grant (quote u) (quote read) (quote sec))))
+              (quote u)
+              (quote read)
+              (quote book))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-child-of (quote post1) (quote board)) (acl-grant (quote team) (quote comment) (quote board))))))
+        (do
+          (acl-it-check!
+            "group + resource: member on child resource"
+            (acl-it-p? db (quote alice) (quote comment) (quote post1))
+            true)
+          (acl-it-check!
+            "group + resource: member on parent resource"
+            (acl-it-p? db (quote alice) (quote comment) (quote board))
+            true)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-role-grant (quote editor) (quote edit) (quote page1)) (acl-role-grant (quote editor) (quote read) (quote page1))))))
+        (do
+          (acl-it-check!
+            "role confers edit to member"
+            (acl-it-p? db (quote bob) (quote edit) (quote page1))
+            true)
+          (acl-it-check!
+            "role confers read to member"
+            (acl-it-p? db (quote bob) (quote read) (quote page1))
+            true)
+          (acl-it-check!
+            "role: capability not in tuple denied"
+            (acl-it-p? db (quote bob) (quote moderate) (quote page1))
+            false)
+          (acl-it-check!
+            "role: non-member excluded"
+            (acl-it-p? db (quote eve) (quote edit) (quote page1))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-child-of (quote draft) (quote page1)) (acl-role-grant (quote editor) (quote edit) (quote page1))))))
+        (acl-it-check!
+          "role grant flows to child resource"
+          (acl-it-p? db (quote bob) (quote edit) (quote draft))
+          true))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
+        (acl-it-check!
+          "explicit deny beats inherited group allow"
+          (acl-it-p? db (quote alice) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote alice) (quote read) (quote doc)) (acl-deny (quote team) (quote read) (quote doc))))))
+        (do
+          (acl-it-check!
+            "group deny inherits and overrides direct grant"
+            (acl-it-p? db (quote alice) (quote read) (quote doc))
+            false)
+          (acl-it-check!
+            "group deny: another member also blocked"
+            (acl-it-p? db (quote team) (quote read) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-child-of (quote sec) (quote book)) (acl-grant (quote u) (quote read) (quote sec)) (acl-deny (quote u) (quote read) (quote book))))))
+        (acl-it-check!
+          "ancestor deny overrides descendant grant"
+          (acl-it-p? db (quote u) (quote read) (quote sec))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc)) (acl-grant (quote team) (quote edit) (quote doc)) (acl-deny (quote alice) (quote edit) (quote doc))))))
+        (do
+          (acl-it-check!
+            "deny on edit leaves inherited read intact"
+            (acl-it-p? db (quote alice) (quote read) (quote doc))
+            true)
+          (acl-it-check!
+            "deny on edit blocks edit"
+            (acl-it-p? db (quote alice) (quote edit) (quote doc))
+            false)))
+      (let
+        ((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-deny (quote team) (quote read) (quote doc))))))
+        (acl-it-check!
+          "inherited deny, no grant: denied"
+          (acl-it-p? db (quote alice) (quote read) (quote doc))
+          false))
+      (let
+        ((db (acl-build-db (list (acl-child-of (quote a) (quote root)) (acl-child-of (quote b) (quote root)) (acl-grant (quote u) (quote read) (quote root)) (acl-deny (quote u) (quote read) (quote a))))))
+        (do
+          (acl-it-check!
+            "deny on sibling a blocks a"
+            (acl-it-p? db (quote u) (quote read) (quote a))
+            false)
+          (acl-it-check!
+            "deny on sibling a leaves b permitted"
+            (acl-it-p? db (quote u) (quote read) (quote b))
+            true)
+          (acl-it-check!
+            "root itself still permitted"
+            (acl-it-p? db (quote u) (quote read) (quote root))
+            true)))
+      (let
+        ((db (acl-build-db (list (acl-grant (quote x) (quote read) (quote y))))))
+        (acl-it-check!
+          "direct grant under inheritance ruleset"
+          (acl-it-p? db (quote x) (quote read) (quote y))
+          true)))))
+
+(define
+  acl-inherit-tests-run!
+  (fn
+    ()
+    (do
+      (set! acl-it-pass 0)
+      (set! acl-it-fail 0)
+      (set! acl-it-failures (list))
+      (acl-it-run-all!)
+      {:failures acl-it-failures :total (+ acl-it-pass acl-it-fail) :passed acl-it-pass :failed acl-it-fail})))

lib/agentic/branch.sx

@@ -0,0 +1,317 @@
+; lib/agentic/branch.sx — agentic-sx Phase 2: one branch = one agent.
+; spawn = branch-from-briefing: write the briefing, then a genesis "spawn"
+; agent-commit whose parent is the fork point; the branch ref IS the agent.
+; The commit verb snapshots a full worktree VALUE (path -> data) into a typed
+; agent-commit and advances the branch by CAS — no shared index, multi-agent
+; safe by construction. Branch topology = agent topology: fork points via
+; git/merge-base, plus relations typed edges (sub-agent-of / reviews /
+; merges) in a Datalog db carried on the space handle.
+; Edge direction: (rel src dst kind) reads src=parent/actor, dst=child/object
+;   (root child sub-agent-of), (reviewer reviewee reviews), (into from merges).
+; Session merges are always recorded as a two-parent "session-merge" commit
+; (no fast-forward) so the merge itself is an agent action with metadata.
+; Requires: lib/agentic/schema.sx, lib/git/*, lib/relations/* (+ datalog).
+
+; ---- space: repo + relations db ----
+(define agentic/space (fn (db name) {:repo (git/repo-named db name) :rels (relations-build-db (list))}))
+
+(define agentic/space-repo (fn (sp) (get sp :repo)))
+(define agentic/space-rels (fn (sp) (get sp :rels)))
+
+(define agentic/branch-name (fn (agent) (str "agents/" agent)))
+
+; ---- typed edges over relations ----
+(define
+  agentic/relate!
+  (fn
+    (sp src dst kind)
+    (begin
+      (dl-assert! (agentic/space-rels sp) (relations-rel src dst kind))
+      true)))
+
+(define
+  agentic/sub-agents
+  (fn
+    (sp agent)
+    (sort
+      (relations-children-of
+        (agentic/space-rels sp)
+        agent
+        (quote sub-agent-of)))))
+
+(define
+  agentic/parent-agent
+  (fn
+    (sp agent)
+    (let
+      ((ps (relations-parents-of (agentic/space-rels sp) agent (quote sub-agent-of))))
+      (if (= (len ps) 0) nil (nth ps 0)))))
+
+(define
+  agentic/agent-tree
+  (fn
+    (sp agent)
+    (sort
+      (relations-descendants
+        (agentic/space-rels sp)
+        agent
+        (quote sub-agent-of)))))
+
+(define
+  agentic/reviews!
+  (fn
+    (sp reviewer reviewee)
+    (agentic/relate! sp reviewer reviewee (quote reviews))))
+
+(define
+  agentic/reviewers
+  (fn
+    (sp agent)
+    (sort
+      (relations-parents-of (agentic/space-rels sp) agent (quote reviews)))))
+
+(define
+  agentic/reviewing
+  (fn
+    (sp agent)
+    (sort
+      (relations-children-of (agentic/space-rels sp) agent (quote reviews)))))
+
+(define
+  agentic/merged-sessions
+  (fn
+    (sp agent)
+    (sort
+      (relations-children-of (agentic/space-rels sp) agent (quote merges)))))
+
+(define
+  agentic/merged-into
+  (fn
+    (sp agent)
+    (sort
+      (relations-parents-of (agentic/space-rels sp) agent (quote merges)))))
+
+; ---- spawn = branch-from-briefing ----
+; base-cid nil => root agent over an empty tree; parent-agent nil => no edge.
+; => {:agent :branch :briefing :genesis} | {:conflict true :actual cid}
+(define
+  agentic/spawn-at!
+  (fn
+    (sp agent briefing base-cid parent-agent)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((bcid (git/write repo briefing))
+          (tree
+            (if
+              (nil? base-cid)
+              (git/tree-from-files repo {})
+              (git/commit-tree (git/read repo base-cid))))
+          (parents (if (nil? base-cid) (list) (list base-cid))))
+        (let
+          ((g (agentic/agent-commit tree parents "spawn" {:message (str "spawn: " (agentic/briefing-title briefing)) :agent agent :briefing bcid})))
+          (let
+            ((gcid (git/write repo g)))
+            (let
+              ((res (git/branch-create! repo (agentic/branch-name agent) gcid)))
+              (if
+                (and (dict? res) (has-key? res :conflict))
+                res
+                (begin
+                  (if
+                    (nil? parent-agent)
+                    nil
+                    (agentic/relate!
+                      sp
+                      parent-agent
+                      agent
+                      (quote sub-agent-of)))
+                  {:agent agent :briefing bcid :branch (agentic/branch-name agent) :genesis gcid})))))))))
+
+(define
+  agentic/spawn!
+  (fn (sp agent briefing) (agentic/spawn-at! sp agent briefing nil nil)))
+
+(define
+  agentic/spawn-from!
+  (fn
+    (sp agent briefing parent-agent)
+    (let
+      ((h (agentic/head sp parent-agent)))
+      (if
+        (nil? h)
+        {:agent parent-agent :error "no-such-agent"}
+        (agentic/spawn-at! sp agent briefing h parent-agent)))))
+
+; ---- heads / listing ----
+(define
+  agentic/head
+  (fn
+    (sp agent)
+    (git/branch-get (agentic/space-repo sp) (agentic/branch-name agent))))
+
+(define
+  agentic/agents
+  (fn (sp) (git/refs-under (agentic/space-repo sp) "heads/agents/")))
+
+; ---- the commit verb: snapshot + typed agent-commit + CAS advance ----
+; files = the agent's FULL worktree value (path -> data). Briefing and agent
+; identity propagate from the branch head. => cid | {:error ...} | {:conflict ...}
+(define
+  agentic/commit!
+  (fn
+    (sp agent kind files meta)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((head (agentic/head sp agent)))
+        (cond
+          ((nil? head) {:agent agent :error "no-such-agent"})
+          ((not (agentic/commit-kind? kind)) {:error "unknown-kind" :kind kind})
+          (else
+            (let
+              ((tree (git/tree-from-files repo files))
+                (b (agentic/commit-briefing (git/read repo head))))
+              (let
+                ((pm (if (nil? b) {:agent agent} {:agent agent :briefing b})))
+                (let
+                  ((cid (git/write repo (agentic/agent-commit tree (list head) kind (merge meta pm)))))
+                  (let
+                    ((res (git/branch-cas! repo (agentic/branch-name agent) head cid)))
+                    (if (and (dict? res) (has-key? res :conflict)) res cid)))))))))))
+
+; commits authored by this agent, newest first, from its branch head
+(define
+  agentic/session-log
+  (fn
+    (sp agent)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((head (agentic/head sp agent)))
+        (if
+          (nil? head)
+          (list)
+          (filter
+            (fn (cid) (= (agentic/commit-agent (git/read repo cid)) agent))
+            (git/log repo head)))))))
+
+; the branch's genesis spawn commit (oldest spawn authored by this agent)
+(define
+  agentic/genesis
+  (fn
+    (sp agent)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((head (agentic/head sp agent)))
+        (if
+          (nil? head)
+          nil
+          (let
+            ((hits (filter (fn (cid) (let ((c (git/read repo cid))) (and (= (agentic/commit-kind c) "spawn") (= (agentic/commit-agent c) agent)))) (git/log repo head))))
+            (if (= (len hits) 0) nil (last hits))))))))
+
+(define
+  agentic/briefing-of
+  (fn
+    (sp agent)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((g (agentic/genesis sp agent)))
+        (if
+          (nil? g)
+          nil
+          (let
+            ((bcid (agentic/commit-briefing (git/read repo g))))
+            (if (nil? bcid) nil (git/read repo bcid))))))))
+
+; ---- topology: fork points via the DAG ----
+(define
+  agentic/fork-point
+  (fn
+    (sp agent-a agent-b)
+    (let
+      ((ha (agentic/head sp agent-a)) (hb (agentic/head sp agent-b)))
+      (if
+        (or (nil? ha) (nil? hb))
+        nil
+        (git/merge-base (agentic/space-repo sp) ha hb)))))
+
+; ---- session merge: always an explicit two-parent session-merge commit ----
+(define
+  agentic/merge-commit-at!
+  (fn
+    (sp into-agent from-agent ours theirs tree meta)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((b (agentic/commit-briefing (git/read repo ours))))
+        (let
+          ((pm (if (nil? b) {:agent into-agent :merged-agent from-agent} {:agent into-agent :briefing b :merged-agent from-agent})))
+          (let
+            ((cid (git/write repo (agentic/agent-commit tree (list ours theirs) "session-merge" (merge meta pm)))))
+            (let
+              ((res (git/branch-cas! repo (agentic/branch-name into-agent) ours cid)))
+              (if
+                (and (dict? res) (has-key? res :conflict))
+                res
+                (begin
+                  (agentic/relate! sp into-agent from-agent (quote merges))
+                  {:cid cid :result "merged"})))))))))
+
+; => {:result "up-to-date"} | {:result "merged" :cid} |
+;    {:result "conflicts" :tree :conflicts (paths)} | {:error ...}
+; Conflicts commit nothing — resolve with agentic/merge-resolve!.
+(define
+  agentic/merge-session!
+  (fn
+    (sp into-agent from-agent meta)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((ours (agentic/head sp into-agent))
+          (theirs (agentic/head sp from-agent)))
+        (cond
+          ((nil? ours) {:agent into-agent :error "no-such-agent"})
+          ((nil? theirs) {:agent from-agent :error "no-such-agent"})
+          (else
+            (let
+              ((m (git/merge-commits repo ours theirs)))
+              (cond
+                ((= (get m :result) "up-to-date") m)
+                ((= (get m :result) "conflicts") m)
+                (else
+                  (let
+                    ((tree (if (= (get m :result) "fast-forward") (git/commit-tree (git/read repo theirs)) (get m :tree))))
+                    (agentic/merge-commit-at!
+                      sp
+                      into-agent
+                      from-agent
+                      ours
+                      theirs
+                      tree
+                      meta)))))))))))
+
+; conclude a conflicted session merge with resolved worktree files
+(define
+  agentic/merge-resolve!
+  (fn
+    (sp into-agent from-agent files meta)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (let
+        ((ours (agentic/head sp into-agent))
+          (theirs (agentic/head sp from-agent)))
+        (if
+          (or (nil? ours) (nil? theirs))
+          {:error "no-such-agent"}
+          (agentic/merge-commit-at!
+            sp
+            into-agent
+            from-agent
+            ours
+            theirs
+            (git/tree-from-files repo files)
+            meta))))))

lib/agentic/conformance.sh

@@ -0,0 +1,191 @@
+#!/usr/bin/env bash
+# lib/agentic/conformance.sh — run agentic-sx test suites, emit scoreboard.json + scoreboard.md.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found." >&2
+  exit 1
+fi
+
+SUITES=(schema branch trace durable)
+
+OUT_JSON="lib/agentic/scoreboard.json"
+OUT_MD="lib/agentic/scoreboard.md"
+
+# shared prefix: persist + artdag + datalog + sx-git + agentic schema
+base_loads() {
+  cat << 'BASE'
+(load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/artdag/dag.sx")
+(load "lib/datalog/tokenizer.sx")
+(load "lib/datalog/parser.sx")
+(load "lib/datalog/unify.sx")
+(load "lib/datalog/db.sx")
+(load "lib/datalog/builtins.sx")
+(load "lib/datalog/aggregates.sx")
+(load "lib/datalog/strata.sx")
+(load "lib/datalog/eval.sx")
+(load "lib/datalog/api.sx")
+(load "lib/datalog/magic.sx")
+(load "lib/git/object.sx")
+(load "lib/git/ref.sx")
+(load "lib/git/dag.sx")
+(load "lib/git/worktree.sx")
+(load "lib/git/diff.sx")
+(load "lib/git/merge.sx")
+(load "lib/git/porcelain.sx")
+(load "lib/agentic/schema.sx")
+BASE
+}
+
+# relations stack (branch/trace suites)
+relations_loads() {
+  cat << 'RELS'
+(load "lib/relations/schema.sx")
+(load "lib/relations/engine.sx")
+(load "lib/relations/api.sx")
+(load "lib/relations/explain.sx")
+(load "lib/relations/federation.sx")
+(load "lib/relations/tree.sx")
+RELS
+}
+
+# scheme + flow stack (durable suite)
+flow_loads() {
+  cat << 'FLOW'
+(load "lib/guest/lex.sx")
+(load "lib/guest/reflective/env.sx")
+(load "lib/guest/reflective/quoting.sx")
+(load "lib/scheme/parser.sx")
+(load "lib/scheme/eval.sx")
+(load "lib/scheme/runtime.sx")
+(load "lib/flow/spec.sx")
+(load "lib/flow/store.sx")
+(load "lib/flow/remote.sx")
+(load "lib/flow/host.sx")
+(load "lib/flow/api.sx")
+FLOW
+}
+
+suite_loads() {
+  local suite=$1
+  base_loads
+  case "$suite" in
+    branch)
+      relations_loads
+      echo '(load "lib/agentic/branch.sx")'
+      ;;
+    trace)
+      relations_loads
+      echo '(load "lib/agentic/branch.sx")'
+      echo '(load "lib/agentic/trace.sx")'
+      ;;
+    durable)
+      relations_loads
+      flow_loads
+      echo '(load "lib/agentic/branch.sx")'
+      echo '(load "lib/agentic/trace.sx")'
+      echo '(load "lib/agentic/durable.sx")'
+      ;;
+  esac
+}
+
+run_suite() {
+  local suite=$1
+  local file="lib/agentic/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  {
+    echo "(epoch 1)"
+    suite_loads "$suite"
+    echo "(epoch 2)"
+    echo '(eval "(define agentic-test-pass 0)")'
+    echo '(eval "(define agentic-test-fail 0)")'
+    echo '(eval "(define agentic-test-failures (list))")'
+    echo '(eval "(define agentic-test (fn (name got expected) (if (equal? got expected) (set! agentic-test-pass (+ agentic-test-pass 1)) (begin (set! agentic-test-fail (+ agentic-test-fail 1)) (set! agentic-test-failures (append agentic-test-failures (list (list name (inspect got) (inspect expected)))))))))")'
+    echo "(epoch 3)"
+    echo "(load \"${file}\")"
+    echo "(epoch 4)"
+    echo '(eval "(list agentic-test-pass agentic-test-fail)")'
+  } > "$TMP"
+
+  local OUTPUT
+  OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
+  rm -f "$TMP"
+
+  local LINE
+  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
+  if [ -z "$LINE" ]; then
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
+            | sed -E 's/^\(ok 4 //; s/\)$//')
+  fi
+
+  local P F
+  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
+  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
+  P=${P:-0}
+  F=${F:-0}
+  echo "${P} ${F}"
+}
+
+declare -A SUITE_PASS
+declare -A SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running agentic-sx conformance suite..." >&2
+for s in "${SUITES[@]}"; do
+  read -r p f < <(run_suite "$s")
+  SUITE_PASS[$s]=$p
+  SUITE_FAIL[$s]=$f
+  TOTAL_PASS=$((TOTAL_PASS + p))
+  TOTAL_FAIL=$((TOTAL_FAIL + f))
+  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
+done
+
+# scoreboard.json
+{
+  printf '{\n'
+  printf '  "suites": {\n'
+  first=1
+  for s in "${SUITES[@]}"; do
+    if [ $first -eq 0 ]; then printf ',\n'; fi
+    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
+    first=0
+  done
+  printf '\n  },\n'
+  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
+  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_JSON"
+printf '}\n' >> "$OUT_JSON"
+
+# scoreboard.md
+{
+  printf '# agentic-sx Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/agentic/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    p=${SUITE_PASS[$s]}
+    f=${SUITE_FAIL[$s]}
+    printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_MD"
+
+echo "Wrote $OUT_JSON and $OUT_MD" >&2
+echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
+
+[ "$TOTAL_FAIL" -eq 0 ]

lib/agentic/durable.sx

@@ -0,0 +1,235 @@
+; lib/agentic/durable.sx — agentic-sx Phase 4: long agent sessions as
+; DURABLE flow workflows. Deterministic replay IS the durability mechanism:
+; every transition re-runs a self-contained flow program (the session's
+; defflow source + flow/start + a replay of every recorded resume value),
+; so the only durable state is a plain record {:flow :input :resumes ...}
+; in the persist kv store — restart-safe by construction, and forking an
+; agent run is literally copying the record (both replays then diverge).
+; Effects are data: a suspended session exposes its suspend tag / typed
+; (request kind payload) envelope to the host as plain SX values.
+; Transitions also land in the agent's Phase-3 trace buffer, so the session
+; history travels with the agent's next commit.
+; Convention for session flows: suspend tags are quoted symbols, decision
+; values are numbers/strings/lists of those (see agentic/scm-lit).
+; Requires: lib/agentic/trace.sx (and its deps), lib/flow/* (+ scheme stack).
+
+; ---- SX -> Scheme literal (numbers, strings, booleans, lists; nil = ()) ----
+(define
+  agentic/scm-lit
+  (fn
+    (v)
+    (cond
+      ((nil? v) "(list)")
+      ((= v true) "#t")
+      ((= v false) "#f")
+      ((number? v) (str v))
+      ((string? v) (str "\"" v "\""))
+      ((list? v) (str "(list " (join " " (map agentic/scm-lit v)) ")"))
+      (else "(list)"))))
+
+; ---- Scheme -> SX: unbox {:scm-string ...} recursively ----
+(define
+  agentic/scm-out
+  (fn
+    (v)
+    (cond
+      ((and (dict? v) (has-key? v :scm-string)) (get v :scm-string))
+      ((list? v) (map agentic/scm-out v))
+      (else v))))
+
+; ---- kv keys (namespaced under the repo prefix) ----
+(define
+  agentic/session-def-key
+  (fn
+    (sp name)
+    (str (get (agentic/space-repo sp) :prefix) "/session-def/" name)))
+
+(define
+  agentic/session-key
+  (fn
+    (sp agent)
+    (str (get (agentic/space-repo sp) :prefix) "/session/" agent)))
+
+; ---- durable session flow definitions ----
+(define
+  agentic/defsession!
+  (fn
+    (sp name scheme-src)
+    (begin
+      (persist/kv-put
+        (git/repo-db (agentic/space-repo sp))
+        (agentic/session-def-key sp name)
+        scheme-src)
+      name)))
+
+(define
+  agentic/session-def
+  (fn
+    (sp name)
+    (persist/kv-get
+      (git/repo-db (agentic/space-repo sp))
+      (agentic/session-def-key sp name))))
+
+(define
+  agentic/session-record
+  (fn
+    (sp agent)
+    (persist/kv-get
+      (git/repo-db (agentic/space-repo sp))
+      (agentic/session-key sp agent))))
+
+; ---- one self-contained replay program per transition ----
+; a fresh flow-run resets the flow store, so the started flow is always id 1
+(define
+  agentic/session-program
+  (fn
+    (defs name input resumes)
+    (str
+      defs
+      "\n"
+      "(define s0 (flow/start "
+      name
+      " "
+      (agentic/scm-lit input)
+      "))\n"
+      (join
+        "\n"
+        (map
+          (fn (v) (str "(flow/resume 1 " (agentic/scm-lit v) ")"))
+          resumes))
+      "\n(list (flow/status 1) (flow/pending) (flow/result 1))")))
+
+; replay the record, derive {:status :tag/:result}, persist record+state
+(define
+  agentic/session-transition!
+  (fn
+    (sp agent record)
+    (let
+      ((defs (agentic/session-def sp (get record :flow))))
+      (if
+        (nil? defs)
+        {:flow (get record :flow) :error "no-such-session-flow"}
+        (let
+          ((out (flow-run (agentic/session-program defs (get record :flow) (get record :input) (get record :resumes)))))
+          (let
+            ((status (agentic/scm-out (nth out 0)))
+              (pending (agentic/scm-out (nth out 1))))
+            (let
+              ((state (cond ((= status "done") {:status "done" :result (agentic/scm-out (nth out 2))}) ((= status "suspended") {:tag (nth (nth pending 0) 1) :status "suspended"}) (else {:status status}))))
+              (begin
+                (persist/kv-put
+                  (git/repo-db (agentic/space-repo sp))
+                  (agentic/session-key sp agent)
+                  (merge {:flow (get record :flow) :resumes (get record :resumes) :input (get record :input)} state))
+                state))))))))
+
+; ---- lifecycle ----
+(define
+  agentic/session-start!
+  (fn
+    (sp agent flow-name input)
+    (if
+      (nil? (agentic/head sp agent))
+      {:agent agent :error "no-such-agent"}
+      (let
+        ((state (agentic/session-transition! sp agent {:flow flow-name :resumes (list) :input input})))
+        (begin
+          (if
+            (has-key? state :error)
+            nil
+            (agentic/trace! sp agent "session" (str "start " flow-name)))
+          state)))))
+
+(define
+  agentic/session-resume!
+  (fn
+    (sp agent value)
+    (let
+      ((rec (agentic/session-record sp agent)))
+      (cond
+        ((nil? rec) {:agent agent :error "no-session"})
+        ((not (= (get rec :status) "suspended")) {:agent agent :error "not-suspended"})
+        (else
+          (let
+            ((state (agentic/session-transition! sp agent {:flow (get rec :flow) :resumes (append (get rec :resumes) (list value)) :input (get rec :input)})))
+            (begin
+              (if
+                (has-key? state :error)
+                nil
+                (agentic/trace!
+                  sp
+                  agent
+                  "session"
+                  (str "resume " (agentic/scm-lit value))))
+              state)))))))
+
+(define
+  agentic/session-status
+  (fn
+    (sp agent)
+    (let
+      ((r (agentic/session-record sp agent)))
+      (if (nil? r) "none" (get r :status)))))
+
+(define
+  agentic/session-pending
+  (fn
+    (sp agent)
+    (let
+      ((r (agentic/session-record sp agent)))
+      (if
+        (and (dict? r) (= (get r :status) "suspended"))
+        (get r :tag)
+        nil))))
+
+(define
+  agentic/session-result
+  (fn
+    (sp agent)
+    (let
+      ((r (agentic/session-record sp agent)))
+      (if (and (dict? r) (= (get r :status) "done")) (get r :result) nil))))
+
+; ---- fork-an-agent-run: copy the record, replay rebuilds the run ----
+; to-agent must already be spawned (branch fork) and session-free
+(define
+  agentic/session-fork!
+  (fn
+    (sp from-agent to-agent)
+    (let
+      ((rec (agentic/session-record sp from-agent)))
+      (cond
+        ((nil? rec) {:agent from-agent :error "no-session"})
+        ((nil? (agentic/head sp to-agent)) {:agent to-agent :error "no-such-agent"})
+        ((not (nil? (agentic/session-record sp to-agent))) {:agent to-agent :error "session-exists"})
+        (else
+          (let
+            ((state (agentic/session-transition! sp to-agent {:flow (get rec :flow) :resumes (get rec :resumes) :input (get rec :input)})))
+            (begin
+              (if
+                (has-key? state :error)
+                nil
+                (agentic/trace!
+                  sp
+                  to-agent
+                  "session"
+                  (str "fork " from-agent)))
+              state)))))))
+
+; ---- effect-as-data helpers over (request kind payload) envelopes ----
+(define
+  agentic/effect-request?
+  (fn
+    (tag)
+    (and
+      (list? tag)
+      (= (len tag) 3)
+      (= (nth tag 0) "flow-request"))))
+
+(define
+  agentic/effect-kind
+  (fn (tag) (if (agentic/effect-request? tag) (nth tag 1) nil)))
+
+(define
+  agentic/effect-payload
+  (fn (tag) (if (agentic/effect-request? tag) (nth tag 2) nil)))

lib/agentic/schema.sx

@@ -0,0 +1,160 @@
+; lib/agentic/schema.sx — agentic-sx Phase 1: the object types.
+; An agentic structure IS the open-branch set of a repo: one branch = one
+; agent, seeded by a briefing. All objects are plain SX dicts, typed by
+; :type, content-addressed via sx-git's native CID (git/cid, git/write) —
+; same store, same identity rules as blob/tree/commit/tag.
+;
+; Two families:
+;   object types  — standalone: briefing, console-trace, behaviour (TAG only,
+;                   library HELD Phase 8). :type carries the type name.
+;   commit kinds  — agent-commit (extensible base) + subtypes spawn/finding/
+;                   refactor/test/session-merge/decision. These ARE git
+;                   commits (:type "commit") so the whole DAG/branch/merge
+;                   machinery applies; the kind rides in :agent-type and
+;                   participates in the CID like any extra commit field.
+;
+; Full fed-sx DefineType/SubtypeOf + federation is HELD (Phase 7) — this
+; registry declares the tags and the subtype relation locally.
+; Requires: lib/git/object.sx (and its persist/artdag deps).
+
+; ---- type registry ----
+(define agentic/types {:refactor {:parent "agent-commit" :kind "commit" :doc "behaviour-preserving restructure"} :console-trace {:parent nil :kind "object" :doc "console/tool output attached to a commit by cid"} :test {:parent "agent-commit" :kind "commit" :doc "adds or repairs tests"} :spawn {:parent "agent-commit" :kind "commit" :doc "genesis commit seeding an agent branch from a briefing"} :finding {:parent "agent-commit" :kind "commit" :doc "a discovered fact worth recording"} :briefing {:parent nil :kind "object" :doc "branch genesis — why an agent exists"} :decision {:parent "agent-commit" :kind "commit" :doc "records a choice and its rationale"} :session-merge {:parent "agent-commit" :kind "commit" :doc "merges another agent session's branch"} :agent-commit {:parent nil :kind "commit" :doc "extensible base for typed agent commits"} :behaviour {:parent nil :kind "object" :doc "behaviour TAG only — library HELD (Phase 8)"}})
+
+(define
+  agentic/type?
+  (fn (name) (and (string? name) (has-key? agentic/types name))))
+
+(define
+  agentic/type-info
+  (fn (name) (if (agentic/type? name) (get agentic/types name) nil)))
+
+(define
+  agentic/type-parent
+  (fn
+    (name)
+    (let
+      ((info (agentic/type-info name)))
+      (if (dict? info) (get info :parent) nil))))
+
+(define
+  agentic/type-kind
+  (fn
+    (name)
+    (let
+      ((info (agentic/type-info name)))
+      (if (dict? info) (get info :kind) nil))))
+
+; reflexive + transitive subtype walk, bounded against registry cycles
+(define
+  agentic/is-a-n?
+  (fn
+    (name ancestor depth)
+    (cond
+      ((<= depth 0) false)
+      ((not (agentic/type? name)) false)
+      ((= name ancestor) true)
+      (else
+        (let
+          ((p (agentic/type-parent name)))
+          (if
+            (nil? p)
+            false
+            (agentic/is-a-n? p ancestor (- depth 1))))))))
+
+(define
+  agentic/is-a?
+  (fn (name ancestor) (agentic/is-a-n? name ancestor 10)))
+
+; extend the registry (downstream: sx-gitea review kinds, behaviour library).
+; create-only; parent must exist when given. => name | nil
+(define
+  agentic/register-type!
+  (fn
+    (name parent kind doc)
+    (if
+      (and
+        (string? name)
+        (not (agentic/type? name))
+        (or (nil? parent) (agentic/type? parent)))
+      (begin (set! agentic/types (assoc agentic/types name {:parent parent :kind kind :doc doc})) name)
+      nil)))
+
+(define
+  agentic/commit-kind?
+  (fn
+    (kind)
+    (and
+      (agentic/type? kind)
+      (= (agentic/type-kind kind) "commit")
+      (agentic/is-a? kind "agent-commit"))))
+
+; all registered commit kinds (incl. the base), sorted
+(define
+  agentic/commit-kinds
+  (fn
+    ()
+    (sort (filter (fn (n) (agentic/commit-kind? n)) (keys agentic/types)))))
+
+; ---- briefing — branch genesis / "why" ----
+(define agentic/briefing (fn (title goal meta) (merge meta {:type "briefing" :title title :goal goal})))
+
+(define
+  agentic/briefing?
+  (fn (obj) (and (dict? obj) (= (get obj :type) "briefing"))))
+
+(define agentic/briefing-title (fn (obj) (get obj :title)))
+(define agentic/briefing-goal (fn (obj) (get obj :goal)))
+
+; ---- agent-commit — a git commit carrying an agentic kind ----
+; kind must be a registered commit kind; :agent-type is protected, all other
+; meta is open (:briefing :agent :message :behaviour-cid ... round-trip and
+; participate in the CID). => commit dict | nil on unknown kind
+(define
+  agentic/agent-commit
+  (fn
+    (tree-cid parents kind meta)
+    (if
+      (agentic/commit-kind? kind)
+      (git/commit tree-cid parents (merge meta {:agent-type kind}))
+      nil)))
+
+(define
+  agentic/commit-kind
+  (fn (obj) (if (dict? obj) (get obj :agent-type) nil)))
+
+(define
+  agentic/agent-commit?
+  (fn
+    (obj)
+    (and (git/commit? obj) (agentic/commit-kind? (agentic/commit-kind obj)))))
+
+; is obj an agent-commit of (a subtype of) kind?
+(define
+  agentic/kind-of?
+  (fn
+    (obj kind)
+    (and
+      (agentic/agent-commit? obj)
+      (agentic/is-a? (agentic/commit-kind obj) kind))))
+
+(define agentic/commit-briefing (fn (obj) (get obj :briefing)))
+(define agentic/commit-agent (fn (obj) (get obj :agent)))
+(define agentic/commit-behaviour (fn (obj) (get obj :behaviour-cid)))
+
+; ---- console-trace — attached to a commit by cid (binding is Phase 3) ----
+(define agentic/trace-entry (fn (kind text) {:text text :kind kind}))
+
+(define agentic/console-trace (fn (entries meta) (merge meta {:type "console-trace" :entries entries})))
+
+(define
+  agentic/console-trace?
+  (fn (obj) (and (dict? obj) (= (get obj :type) "console-trace"))))
+
+(define agentic/trace-entries (fn (obj) (get obj :entries)))
+
+; ---- behaviour — TAG declared, library HELD (Phase 8) ----
+(define agentic/behaviour (fn (name body meta) (merge meta {:name name :type "behaviour" :body body})))
+
+(define
+  agentic/behaviour?
+  (fn (obj) (and (dict? obj) (= (get obj :type) "behaviour"))))

lib/agentic/scoreboard.json

@@ -0,0 +1,11 @@
+{
+  "suites": {
+    "schema": {"pass": 65, "fail": 0},
+    "branch": {"pass": 53, "fail": 0},
+    "trace": {"pass": 35, "fail": 0},
+    "durable": {"pass": 43, "fail": 0}
+  },
+  "total_pass": 196,
+  "total_fail": 0,
+  "total": 196
+}

lib/agentic/scoreboard.md

@@ -0,0 +1,11 @@
+# agentic-sx Conformance Scoreboard
+
+_Generated by `lib/agentic/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| schema | 65 | 0 | 65 |
+| branch | 53 | 0 | 53 |
+| trace | 35 | 0 | 35 |
+| durable | 43 | 0 | 43 |
+| **Total** | **196** | **0** | **196** |

lib/agentic/tests/branch.sx

@@ -0,0 +1,333 @@
+; Phase 2 — branch: one branch = one agent. Fixture story: root-1 coordinates
+; a refactor; lexer-1 + parser-1 spawn from its plan commit (lexer-1a nested
+; under lexer-1); their sessions merge back (ff-shaped and true 3-way), then
+; risky-1 collides with root-1 on plan.md and the conflict is resolved via
+; merge-resolve!. Edges: sub-agent-of / reviews / merges.
+
+(define agb-db (persist/mem-backend))
+(define agb-sp (agentic/space agb-db "agentic-branch-test"))
+(define agb-repo (agentic/space-repo agb-sp))
+
+(define
+  agb-root-briefing
+  (agentic/briefing "coordinate refactor" "split parser module" {}))
+(define agb-root (agentic/spawn! agb-sp "root-1" agb-root-briefing))
+
+(agentic-test "spawn returns the agent" (get agb-root :agent) "root-1")
+(agentic-test
+  "spawn creates the agent branch"
+  (contains? (git/branches agb-repo) "agents/root-1")
+  true)
+(agentic-test
+  "head is the genesis"
+  (= (agentic/head agb-sp "root-1") (get agb-root :genesis))
+  true)
+(agentic-test
+  "genesis is a spawn commit"
+  (agentic/commit-kind (git/read agb-repo (get agb-root :genesis)))
+  "spawn")
+(agentic-test
+  "genesis records the briefing"
+  (agentic/commit-briefing (git/read agb-repo (get agb-root :genesis)))
+  (get agb-root :briefing))
+(agentic-test
+  "briefing-of reads back the briefing"
+  (agentic/briefing-title (agentic/briefing-of agb-sp "root-1"))
+  "coordinate refactor")
+(agentic-test
+  "root genesis has no parents"
+  (= (git/parents agb-repo (get agb-root :genesis)) (list))
+  true)
+(agentic-test
+  "spawn is create-only"
+  (has-key? (agentic/spawn! agb-sp "root-1" agb-root-briefing) :conflict)
+  true)
+(agentic-test
+  "agents lists the branch set"
+  (= (agentic/agents agb-sp) (list "root-1"))
+  true)
+
+; ---- the commit verb ----
+(define
+  agb-c1
+  (agentic/commit!
+    agb-sp
+    "root-1"
+    "decision"
+    (assoc {} "plan.md" "split into lexer+parser\n")
+    {:message "plan recorded"}))
+
+(agentic-test "commit! returns a cid" (starts-with? agb-c1 "sx1:") true)
+(agentic-test
+  "commit! advances the head"
+  (= (agentic/head agb-sp "root-1") agb-c1)
+  true)
+(agentic-test
+  "commit! records the kind"
+  (agentic/commit-kind (git/read agb-repo agb-c1))
+  "decision")
+(agentic-test
+  "briefing propagates to every commit"
+  (agentic/commit-briefing (git/read agb-repo agb-c1))
+  (get agb-root :briefing))
+(agentic-test
+  "commit! snapshots the worktree"
+  (get (git/commit-files agb-repo agb-c1) "plan.md")
+  "split into lexer+parser\n")
+(agentic-test
+  "unknown kind is rejected"
+  (get
+    (agentic/commit! agb-sp "root-1" "frobnicate" {} {})
+    :error)
+  "unknown-kind")
+(agentic-test
+  "commit to unknown agent fails"
+  (get
+    (agentic/commit! agb-sp "ghost" "finding" {} {})
+    :error)
+  "no-such-agent")
+(agentic-test
+  "session-log newest first"
+  (=
+    (agentic/session-log agb-sp "root-1")
+    (list agb-c1 (get agb-root :genesis)))
+  true)
+(agentic-test
+  "genesis found from head"
+  (= (agentic/genesis agb-sp "root-1") (get agb-root :genesis))
+  true)
+
+; ---- sub-agents fork at the parent head ----
+(define
+  agb-lex-briefing
+  (agentic/briefing "extract lexer" "pull tokenizer into lexer.sx" {}))
+(define
+  agb-lex
+  (agentic/spawn-from! agb-sp "lexer-1" agb-lex-briefing "root-1"))
+(define
+  agb-par-briefing
+  (agentic/briefing "extract parser" "pull grammar into parser.sx" {}))
+(define
+  agb-par
+  (agentic/spawn-from! agb-sp "parser-1" agb-par-briefing "root-1"))
+
+(agentic-test
+  "spawn-from creates the sub branch"
+  (get agb-lex :agent)
+  "lexer-1")
+(agentic-test
+  "sub genesis forks at the parent head"
+  (= (git/parents agb-repo (get agb-lex :genesis)) (list agb-c1))
+  true)
+(agentic-test
+  "sub genesis inherits the base tree"
+  (get (git/commit-files agb-repo (get agb-lex :genesis)) "plan.md")
+  "split into lexer+parser\n")
+(agentic-test
+  "sub-agent edges recorded"
+  (= (agentic/sub-agents agb-sp "root-1") (list "lexer-1" "parser-1"))
+  true)
+(agentic-test
+  "parent-agent edge"
+  (agentic/parent-agent agb-sp "lexer-1")
+  "root-1")
+(agentic-test
+  "root has no parent agent"
+  (agentic/parent-agent agb-sp "root-1")
+  nil)
+(agentic-test
+  "spawn-from unknown parent fails"
+  (get (agentic/spawn-from! agb-sp "x-1" agb-lex-briefing "ghost") :error)
+  "no-such-agent")
+(agentic-test
+  "agents lists all branches sorted"
+  (= (agentic/agents agb-sp) (list "lexer-1" "parser-1" "root-1"))
+  true)
+
+(define
+  agb-lex2
+  (agentic/spawn-from!
+    agb-sp
+    "lexer-1a"
+    (agentic/briefing "lexer unicode" "handle utf8 in the lexer" {})
+    "lexer-1"))
+
+(agentic-test
+  "agent-tree is transitive"
+  (=
+    (agentic/agent-tree agb-sp "root-1")
+    (list "lexer-1" "lexer-1a" "parser-1"))
+  true)
+
+; ---- parallel session work ----
+(define
+  agb-lc1
+  (agentic/commit!
+    agb-sp
+    "lexer-1"
+    "refactor"
+    (merge
+      (git/commit-files agb-repo (get agb-lex :genesis))
+      (assoc {} "lexer.sx" "(define lexer 1)\n"))
+    {:message "lexer extracted"}))
+(define
+  agb-pc1
+  (agentic/commit!
+    agb-sp
+    "parser-1"
+    "refactor"
+    (merge
+      (git/commit-files agb-repo (get agb-par :genesis))
+      (assoc {} "parser.sx" "(define parser 1)\n"))
+    {:message "parser extracted"}))
+
+(agentic-test
+  "fork-point of sibling agents"
+  (= (agentic/fork-point agb-sp "lexer-1" "parser-1") agb-c1)
+  true)
+(agentic-test
+  "fork-point with itself is its head"
+  (= (agentic/fork-point agb-sp "lexer-1" "lexer-1") agb-lc1)
+  true)
+(agentic-test
+  "fork-point with unknown agent"
+  (agentic/fork-point agb-sp "lexer-1" "ghost")
+  nil)
+
+; ---- session merge: ff-shaped history still gets a merge commit ----
+(define agb-m1 (agentic/merge-session! agb-sp "root-1" "lexer-1" {:message "absorb lexer session"}))
+
+(agentic-test "session merge merges" (get agb-m1 :result) "merged")
+(agentic-test
+  "merge commit has both session parents"
+  (= (git/parents agb-repo (get agb-m1 :cid)) (list agb-c1 agb-lc1))
+  true)
+(agentic-test
+  "merge advances the into head"
+  (= (agentic/head agb-sp "root-1") (get agb-m1 :cid))
+  true)
+(agentic-test
+  "merge commit is a session-merge"
+  (agentic/commit-kind (git/read agb-repo (get agb-m1 :cid)))
+  "session-merge")
+(agentic-test
+  "merge names the merged agent"
+  (get (git/read agb-repo (get agb-m1 :cid)) :merged-agent)
+  "lexer-1")
+(agentic-test
+  "merged tree carries the merged session"
+  (get (git/commit-files agb-repo (get agb-m1 :cid)) "lexer.sx")
+  "(define lexer 1)\n")
+(agentic-test
+  "merge keeps the into briefing"
+  (agentic/commit-briefing (git/read agb-repo (get agb-m1 :cid)))
+  (get agb-root :briefing))
+(agentic-test
+  "merges edge recorded"
+  (= (agentic/merged-sessions agb-sp "root-1") (list "lexer-1"))
+  true)
+(agentic-test
+  "merged-into inverse"
+  (= (agentic/merged-into agb-sp "lexer-1") (list "root-1"))
+  true)
+(agentic-test
+  "re-merge is up-to-date"
+  (get (agentic/merge-session! agb-sp "root-1" "lexer-1" {}) :result)
+  "up-to-date")
+
+; ---- true three-way merge ----
+(define agb-m2 (agentic/merge-session! agb-sp "root-1" "parser-1" {:message "absorb parser session"}))
+
+(agentic-test "three-way session merge" (get agb-m2 :result) "merged")
+(agentic-test
+  "three-way tree unions the sessions"
+  (get (git/commit-files agb-repo (get agb-m2 :cid)) "parser.sx")
+  "(define parser 1)\n")
+(agentic-test
+  "three-way tree keeps ours side"
+  (get (git/commit-files agb-repo (get agb-m2 :cid)) "lexer.sx")
+  "(define lexer 1)\n")
+
+; ---- conflicting sessions ----
+(define
+  agb-risk
+  (agentic/spawn-from!
+    agb-sp
+    "risky-1"
+    (agentic/briefing "rewrite plan" "contentious plan edit" {})
+    "root-1"))
+(define agb-risk-files (git/commit-files agb-repo (get agb-risk :genesis)))
+(define
+  agb-rc1
+  (agentic/commit!
+    agb-sp
+    "risky-1"
+    "decision"
+    (merge agb-risk-files (assoc {} "plan.md" "risky rewrite\n"))
+    {:message "risky plan"}))
+(define
+  agb-rootc2
+  (agentic/commit!
+    agb-sp
+    "root-1"
+    "decision"
+    (merge agb-risk-files (assoc {} "plan.md" "steady as she goes\n"))
+    {:message "root plan"}))
+(define agb-mc (agentic/merge-session! agb-sp "root-1" "risky-1" {:message "risky merge"}))
+
+(agentic-test
+  "conflicting sessions surface conflicts"
+  (get agb-mc :result)
+  "conflicts")
+(agentic-test
+  "conflict paths name the file"
+  (= (get agb-mc :conflicts) (list "plan.md"))
+  true)
+(agentic-test
+  "conflicted merge commits nothing"
+  (= (agentic/head agb-sp "root-1") agb-rootc2)
+  true)
+
+(define
+  agb-res
+  (agentic/merge-resolve!
+    agb-sp
+    "root-1"
+    "risky-1"
+    (merge
+      agb-risk-files
+      (assoc {} "plan.md" "steady, with one risky idea\n"))
+    {:message "negotiated"}))
+
+(agentic-test
+  "merge-resolve! concludes the merge"
+  (get agb-res :result)
+  "merged")
+(agentic-test
+  "resolution advances the head"
+  (= (agentic/head agb-sp "root-1") (get agb-res :cid))
+  true)
+(agentic-test
+  "resolution has both parents"
+  (= (git/parents agb-repo (get agb-res :cid)) (list agb-rootc2 agb-rc1))
+  true)
+(agentic-test
+  "resolved content wins"
+  (get (git/commit-files agb-repo (get agb-res :cid)) "plan.md")
+  "steady, with one risky idea\n")
+
+; ---- reviews + edge isolation ----
+(agentic/reviews! agb-sp "parser-1" "lexer-1")
+
+(agentic-test
+  "reviewers edge"
+  (= (agentic/reviewers agb-sp "lexer-1") (list "parser-1"))
+  true)
+(agentic-test
+  "reviewing inverse"
+  (= (agentic/reviewing agb-sp "parser-1") (list "lexer-1"))
+  true)
+(agentic-test
+  "edge kinds are isolated"
+  (= (agentic/sub-agents agb-sp "parser-1") (list))
+  true)

lib/agentic/tests/durable.sx

@@ -0,0 +1,281 @@
+; Phase 4 — durable: agent sessions as durable flow workflows. Fixture story:
+; worker-1 runs the two-suspend "triage" flow to completion; worker-1b proves
+; restart-safety (fresh space handles over the same backend, resume across
+; the restart); worker-2's mid-flight run is FORKED to worker-2b and the two
+; replays diverge; worker-3 exercises typed (request kind payload) effects
+; and the trace-buffer composition with Phase 3.
+; NOTE: numbers computed inside the guest are compared with = (numeric
+; equality), not equal? — guest numerics box differently at the boundary.
+
+(define agd-db (persist/mem-backend))
+(define agd-sp (agentic/space agd-db "agentic-durable-test"))
+(define
+  agd-a
+  (agentic/spawn!
+    agd-sp
+    "worker-1"
+    (agentic/briefing "long task" "run a durable session" {})))
+(define
+  agd-b
+  (agentic/spawn-from!
+    agd-sp
+    "worker-1b"
+    (agentic/briefing "second worker" "restart survivor" {})
+    "worker-1"))
+
+(agentic/defsession!
+  agd-sp
+  "triage"
+  "(defflow triage (sequence (lambda (x) (+ x (suspend (quote ask-priority)))) (lambda (y) (* y (suspend (quote ask-factor))))))")
+
+; ---- literals across the guest boundary ----
+(agentic-test "scm-lit numbers" (agentic/scm-lit 42) "42")
+(agentic-test "scm-lit strings" (agentic/scm-lit "hi") "\"hi\"")
+(agentic-test
+  "scm-lit lists nest"
+  (agentic/scm-lit (list 1 "a"))
+  "(list 1 \"a\")")
+(agentic-test
+  "scm-out unboxes scheme strings"
+  (agentic/scm-out {:scm-string "x"})
+  "x")
+
+; ---- lifecycle: start / suspend / resume / done ----
+(agentic-test
+  "session flow source is durable"
+  (starts-with? (agentic/session-def agd-sp "triage") "(defflow")
+  true)
+(agentic-test
+  "no session before start"
+  (agentic/session-status agd-sp "worker-1")
+  "none")
+
+(define agd-s1 (agentic/session-start! agd-sp "worker-1" "triage" 10))
+
+(agentic-test
+  "start suspends at the first effect"
+  (get agd-s1 :status)
+  "suspended")
+(agentic-test "the suspend tag is data" (get agd-s1 :tag) "ask-priority")
+(agentic-test
+  "session-status tracks the suspension"
+  (agentic/session-status agd-sp "worker-1")
+  "suspended")
+(agentic-test
+  "session-pending exposes the tag"
+  (agentic/session-pending agd-sp "worker-1")
+  "ask-priority")
+(agentic-test
+  "start on unknown agent fails"
+  (get (agentic/session-start! agd-sp "ghost" "triage" 1) :error)
+  "no-such-agent")
+(agentic-test
+  "start with unknown flow fails"
+  (get
+    (agentic/session-start! agd-sp "worker-1b" "frobnicate" 1)
+    :error)
+  "no-such-session-flow")
+(agentic-test
+  "a failed start leaves no session"
+  (agentic/session-status agd-sp "worker-1b")
+  "none")
+
+(define agd-s2 (agentic/session-resume! agd-sp "worker-1" 5))
+
+(agentic-test
+  "resume replays to the next effect"
+  (get agd-s2 :tag)
+  "ask-factor")
+(agentic-test
+  "resume on session-less agent fails"
+  (get (agentic/session-resume! agd-sp "worker-1b" 1) :error)
+  "no-session")
+
+(define agd-s3 (agentic/session-resume! agd-sp "worker-1" 3))
+
+(agentic-test
+  "final resume completes the session"
+  (get agd-s3 :status)
+  "done")
+(agentic-test
+  "deterministic replay computes the result"
+  (= (get agd-s3 :result) 45)
+  true)
+(agentic-test
+  "session-status done"
+  (agentic/session-status agd-sp "worker-1")
+  "done")
+(agentic-test
+  "session-result reads back"
+  (= (agentic/session-result agd-sp "worker-1") 45)
+  true)
+(agentic-test
+  "resume after done fails"
+  (get (agentic/session-resume! agd-sp "worker-1" 9) :error)
+  "not-suspended")
+(agentic-test
+  "the record keeps the full replay history"
+  (=
+    (get (agentic/session-record agd-sp "worker-1") :resumes)
+    (list 5 3))
+  true)
+
+; ---- restart: a fresh space handle over the same backend ----
+(define agd-sp2 (agentic/space agd-db "agentic-durable-test"))
+
+(agentic-test
+  "restart sees the finished session"
+  (agentic/session-status agd-sp2 "worker-1")
+  "done")
+(agentic-test
+  "restart sees the result"
+  (= (agentic/session-result agd-sp2 "worker-1") 45)
+  true)
+
+(define
+  agd-s4
+  (agentic/session-start! agd-sp "worker-1b" "triage" 100))
+(define agd-sp3 (agentic/space agd-db "agentic-durable-test"))
+
+(agentic-test
+  "restart mid-flight stays suspended"
+  (agentic/session-status agd-sp3 "worker-1b")
+  "suspended")
+(agentic-test
+  "resume across the restart replays deterministically"
+  (get (agentic/session-resume! agd-sp3 "worker-1b" 2) :tag)
+  "ask-factor")
+(agentic-test
+  "the resumed run completes across the restart"
+  (=
+    (get (agentic/session-resume! agd-sp3 "worker-1b" 7) :result)
+    714)
+  true)
+
+; ---- fork-an-agent-run: copy the record, replays diverge ----
+(define
+  agd-w2
+  (agentic/spawn!
+    agd-sp
+    "worker-2"
+    (agentic/briefing "explore" "mainline run" {})))
+(define
+  agd-w2b
+  (agentic/spawn-from!
+    agd-sp
+    "worker-2b"
+    (agentic/briefing "explore alt" "forked run" {})
+    "worker-2"))
+(define agd-f0 (agentic/session-start! agd-sp "worker-2" "triage" 10))
+(define agd-f1 (agentic/session-resume! agd-sp "worker-2" 5))
+(define agd-fork (agentic/session-fork! agd-sp "worker-2" "worker-2b"))
+
+(agentic-test
+  "fork replays to the same suspended state"
+  (get agd-fork :tag)
+  "ask-factor")
+(agentic-test
+  "forked session is live"
+  (agentic/session-status agd-sp "worker-2b")
+  "suspended")
+(agentic-test
+  "forked history is copied"
+  (=
+    (get (agentic/session-record agd-sp "worker-2b") :resumes)
+    (list 5))
+  true)
+(agentic-test
+  "mainline resumes its own way"
+  (=
+    (get (agentic/session-resume! agd-sp "worker-2" 3) :result)
+    45)
+  true)
+(agentic-test
+  "fork diverges independently"
+  (=
+    (get (agentic/session-resume! agd-sp "worker-2b" 100) :result)
+    1500)
+  true)
+(agentic-test
+  "the fork's divergence never touches the mainline"
+  (= (agentic/session-result agd-sp "worker-2") 45)
+  true)
+(agentic-test
+  "fork needs an existing session"
+  (get (agentic/session-fork! agd-sp "worker-1x" "worker-2b") :error)
+  "no-session")
+(agentic-test
+  "fork target must be spawned"
+  (get (agentic/session-fork! agd-sp "worker-2" "ghost") :error)
+  "no-such-agent")
+(agentic-test
+  "fork refuses to clobber a session"
+  (get (agentic/session-fork! agd-sp "worker-2" "worker-2b") :error)
+  "session-exists")
+
+; ---- typed effects: (request kind payload) envelopes as data ----
+(agentic/defsession!
+  agd-sp
+  "review-loop"
+  "(defflow review-loop (sequence (lambda (x) (await-human (list (quote approve?) x))) (branch (lambda (d) (eq? d 1)) (flow-const (quote shipped)) (flow-const (quote parked)))))")
+
+(define
+  agd-w3
+  (agentic/spawn!
+    agd-sp
+    "worker-3"
+    (agentic/briefing "ship it" "review then ship" {})))
+(define
+  agd-r1
+  (agentic/session-start! agd-sp "worker-3" "review-loop" 7))
+
+(agentic-test
+  "request effects are typed envelopes"
+  (agentic/effect-request? (get agd-r1 :tag))
+  true)
+(agentic-test "effect kind" (agentic/effect-kind (get agd-r1 :tag)) "human")
+(agentic-test
+  "effect payload"
+  (=
+    (agentic/effect-payload (get agd-r1 :tag))
+    (list "approve?" 7))
+  true)
+(agentic-test
+  "plain tags are not request envelopes"
+  (agentic/effect-request? "ask-priority")
+  false)
+(agentic-test
+  "the human decision resumes the session"
+  (get (agentic/session-resume! agd-sp "worker-3" 1) :result)
+  "shipped")
+
+; ---- composition with Phase 3: transitions ride the trace buffer ----
+(agentic-test
+  "session transitions land in the trace buffer"
+  (len
+    (filter
+      (fn (e) (= (get e :kind) "session"))
+      (agentic/trace-pending agd-sp "worker-3")))
+  2)
+
+(define
+  agd-c
+  (agentic/commit-with-trace!
+    agd-sp
+    "worker-3"
+    "decision"
+    (assoc {} "ship.md" "approved\n")
+    {:message "shipped"}))
+
+(agentic-test
+  "the session history travels with the commit"
+  (len (agentic/trace-entries (agentic/trace-for agd-sp (get agd-c :cid))))
+  2)
+(agentic-test
+  "the bound trace records the session start"
+  (get
+    (nth
+      (agentic/trace-entries (agentic/trace-for agd-sp (get agd-c :cid)))
+      0)
+    :text)
+  "start review-loop")

lib/agentic/tests/schema.sx

@@ -0,0 +1,326 @@
+; Phase 1 — schema: agentic object types as content-addressed typed objects
+; over the sx-git store. Fixture: one repo, one briefing, a spawn genesis
+; commit + a finding child (both real git commits), a console trace bound to
+; the genesis by cid, a behaviour tag object. Reused as the assertion target.
+
+(define ag-fix-db (persist/mem-backend))
+(define ag-fix-repo (git/repo-named ag-fix-db "agentic-test"))
+
+(define
+  ag-fix-briefing
+  (agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"}))
+(define ag-fix-briefing-cid (git/write ag-fix-repo ag-fix-briefing))
+
+(define
+  ag-fix-tree-cid
+  (git/tree-from-files ag-fix-repo (assoc {} "notes.md" "start\n")))
+
+(define
+  ag-fix-genesis
+  (agentic/agent-commit ag-fix-tree-cid (list) "spawn" {:message "genesis" :agent "agent-1" :briefing ag-fix-briefing-cid}))
+(define ag-fix-genesis-cid (git/write ag-fix-repo ag-fix-genesis))
+
+(define
+  ag-fix-finding
+  (agentic/agent-commit
+    ag-fix-tree-cid
+    (list ag-fix-genesis-cid)
+    "finding"
+    {:message "found tokenizer bug" :behaviour-cid "sx1:beefbeef" :agent "agent-1" :briefing ag-fix-briefing-cid}))
+(define ag-fix-finding-cid (git/write ag-fix-repo ag-fix-finding))
+
+(define
+  ag-fix-trace
+  (agentic/console-trace
+    (list
+      (agentic/trace-entry "console" "$ run tests")
+      (agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
+    {:commit ag-fix-genesis-cid}))
+(define ag-fix-trace-cid (git/write ag-fix-repo ag-fix-trace))
+
+(define
+  ag-fix-behaviour
+  (agentic/behaviour "tdd-loop" "(red green refactor)" {}))
+
+; ---- type registry ----
+(agentic-test "briefing is a registered type" (agentic/type? "briefing") true)
+(agentic-test
+  "console-trace is a registered type"
+  (agentic/type? "console-trace")
+  true)
+(agentic-test "behaviour TAG is registered" (agentic/type? "behaviour") true)
+(agentic-test
+  "agent-commit base is registered"
+  (agentic/type? "agent-commit")
+  true)
+(agentic-test
+  "all commit subtypes registered"
+  (every?
+    (fn (n) (agentic/type? n))
+    (list "spawn" "finding" "refactor" "test" "session-merge" "decision"))
+  true)
+(agentic-test
+  "unknown type is not registered"
+  (agentic/type? "frobnicate")
+  false)
+(agentic-test "type? is nil-safe" (agentic/type? nil) false)
+(agentic-test
+  "finding's parent is agent-commit"
+  (agentic/type-parent "finding")
+  "agent-commit")
+(agentic-test
+  "agent-commit has no parent"
+  (agentic/type-parent "agent-commit")
+  nil)
+(agentic-test
+  "is-a? walks subtype to base"
+  (agentic/is-a? "finding" "agent-commit")
+  true)
+(agentic-test "is-a? is reflexive" (agentic/is-a? "finding" "finding") true)
+(agentic-test
+  "is-a? rejects unrelated types"
+  (agentic/is-a? "finding" "briefing")
+  false)
+(agentic-test
+  "object types are not commit kinds"
+  (agentic/is-a? "briefing" "agent-commit")
+  false)
+(agentic-test
+  "commit-kind? on a subtype"
+  (agentic/commit-kind? "decision")
+  true)
+(agentic-test
+  "commit-kind? rejects object types"
+  (agentic/commit-kind? "briefing")
+  false)
+(agentic-test
+  "commit-kinds sorted"
+  (=
+    (agentic/commit-kinds)
+    (list
+      "agent-commit"
+      "decision"
+      "finding"
+      "refactor"
+      "session-merge"
+      "spawn"
+      "test"))
+  true)
+(agentic-test
+  "register-type! extends the registry"
+  (begin
+    (agentic/register-type!
+      "review"
+      "agent-commit"
+      "commit"
+      "review of another session")
+    (agentic/type? "review"))
+  true)
+(agentic-test
+  "registered subtype is-a agent-commit"
+  (agentic/is-a? "review" "agent-commit")
+  true)
+(agentic-test
+  "register-type! is create-only"
+  (agentic/register-type! "finding" "agent-commit" "commit" "dup")
+  nil)
+(agentic-test
+  "register-type! requires an existing parent"
+  (agentic/register-type! "orphan" "no-such-base" "commit" "x")
+  nil)
+
+; ---- briefing ----
+(agentic-test "briefing is typed" (get ag-fix-briefing :type) "briefing")
+(agentic-test
+  "briefing? true on briefing"
+  (agentic/briefing? ag-fix-briefing)
+  true)
+(agentic-test
+  "briefing? false on commit"
+  (agentic/briefing? ag-fix-genesis)
+  false)
+(agentic-test
+  "briefing title accessor"
+  (agentic/briefing-title ag-fix-briefing)
+  "harden parser")
+(agentic-test
+  "briefing goal accessor"
+  (agentic/briefing-goal ag-fix-briefing)
+  "find tokenizer edge cases")
+(agentic-test
+  "briefing open meta round-trips"
+  (get ag-fix-briefing :author)
+  "giles")
+(agentic-test
+  "briefing protected keys win over meta"
+  (agentic/briefing-title (agentic/briefing "real" "g" {:type "hack" :title "fake"}))
+  "real")
+(agentic-test
+  "briefing cid is deterministic"
+  (=
+    ag-fix-briefing-cid
+    (git/cid
+      (agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"})))
+  true)
+(agentic-test
+  "briefing cid differs by goal"
+  (=
+    ag-fix-briefing-cid
+    (git/cid (agentic/briefing "harden parser" "other goal" {:author "giles"})))
+  false)
+(agentic-test
+  "briefing cid carries the native scheme"
+  (starts-with? ag-fix-briefing-cid "sx1:")
+  true)
+(agentic-test
+  "briefing round-trips through the store"
+  (agentic/briefing? (git/read ag-fix-repo ag-fix-briefing-cid))
+  true)
+(agentic-test
+  "stored briefing title survives"
+  (agentic/briefing-title (git/read ag-fix-repo ag-fix-briefing-cid))
+  "harden parser")
+(agentic-test
+  "git/object-type sees the briefing type"
+  (git/object-type (git/read ag-fix-repo ag-fix-briefing-cid))
+  "briefing")
+
+; ---- agent-commit ----
+(agentic-test
+  "agent-commit IS a git commit"
+  (git/commit? ag-fix-genesis)
+  true)
+(agentic-test
+  "agent-commit? true on agent commit"
+  (agentic/agent-commit? ag-fix-genesis)
+  true)
+(agentic-test
+  "agent-commit? false on plain git commit"
+  (agentic/agent-commit? (git/commit ag-fix-tree-cid (list) {:message "plain"}))
+  false)
+(agentic-test
+  "agent-commit? false on briefing"
+  (agentic/agent-commit? ag-fix-briefing)
+  false)
+(agentic-test
+  "commit-kind reads the subtype"
+  (agentic/commit-kind ag-fix-genesis)
+  "spawn")
+(agentic-test
+  "kind-of? walks to the base"
+  (agentic/kind-of? ag-fix-finding "agent-commit")
+  true)
+(agentic-test
+  "kind-of? exact kind"
+  (agentic/kind-of? ag-fix-finding "finding")
+  true)
+(agentic-test
+  "kind-of? rejects a sibling kind"
+  (agentic/kind-of? ag-fix-finding "refactor")
+  false)
+(agentic-test
+  "unknown kind is rejected"
+  (agentic/agent-commit ag-fix-tree-cid (list) "frobnicate" {})
+  nil)
+(agentic-test
+  "object type rejected as commit kind"
+  (agentic/agent-commit ag-fix-tree-cid (list) "briefing" {})
+  nil)
+(agentic-test
+  "commit-briefing links the genesis briefing"
+  (agentic/commit-briefing ag-fix-finding)
+  ag-fix-briefing-cid)
+(agentic-test
+  "linked briefing reads back as a briefing"
+  (agentic/briefing?
+    (git/read ag-fix-repo (agentic/commit-briefing ag-fix-finding)))
+  true)
+(agentic-test
+  "commit-agent accessor"
+  (agentic/commit-agent ag-fix-finding)
+  "agent-1")
+(agentic-test
+  "behaviour-cid rides an agent-commit"
+  (agentic/commit-behaviour ag-fix-finding)
+  "sx1:beefbeef")
+(agentic-test
+  "agentic fields participate in the cid"
+  (=
+    ag-fix-genesis-cid
+    (git/cid (git/commit ag-fix-tree-cid (list) {:message "genesis"})))
+  false)
+(agentic-test
+  "stored agent-commit round-trips its kind"
+  (agentic/commit-kind (git/read ag-fix-repo ag-fix-genesis-cid))
+  "spawn")
+(agentic-test
+  "git message accessor still applies"
+  (git/commit-message ag-fix-finding)
+  "found tokenizer bug")
+(agentic-test
+  "agent-commit participates in the DAG"
+  (= (git/parents ag-fix-repo ag-fix-finding-cid) (list ag-fix-genesis-cid))
+  true)
+(agentic-test
+  "log walks agent commits newest first"
+  (=
+    (git/log ag-fix-repo ag-fix-finding-cid)
+    (list ag-fix-finding-cid ag-fix-genesis-cid))
+  true)
+
+; ---- console-trace ----
+(agentic-test "trace is typed" (get ag-fix-trace :type) "console-trace")
+(agentic-test
+  "console-trace? true on trace"
+  (agentic/console-trace? ag-fix-trace)
+  true)
+(agentic-test
+  "console-trace? false on briefing"
+  (agentic/console-trace? ag-fix-briefing)
+  false)
+(agentic-test
+  "trace holds its entries"
+  (len (agentic/trace-entries ag-fix-trace))
+  2)
+(agentic-test
+  "trace entry kind"
+  (get (nth (agentic/trace-entries ag-fix-trace) 0) :kind)
+  "console")
+(agentic-test
+  "trace entry text"
+  (get (nth (agentic/trace-entries ag-fix-trace) 1) :text)
+  "sx_eval (+ 1 2)")
+(agentic-test
+  "trace names its commit by cid"
+  (get ag-fix-trace :commit)
+  ag-fix-genesis-cid)
+(agentic-test
+  "trace cid is deterministic"
+  (=
+    ag-fix-trace-cid
+    (git/cid
+      (agentic/console-trace
+        (list
+          (agentic/trace-entry "console" "$ run tests")
+          (agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
+        {:commit ag-fix-genesis-cid})))
+  true)
+(agentic-test
+  "trace round-trips through the store"
+  (agentic/console-trace? (git/read ag-fix-repo ag-fix-trace-cid))
+  true)
+
+; ---- behaviour (TAG only — library HELD Phase 8) ----
+(agentic-test "behaviour is typed" (get ag-fix-behaviour :type) "behaviour")
+(agentic-test
+  "behaviour? true on behaviour"
+  (agentic/behaviour? ag-fix-behaviour)
+  true)
+(agentic-test
+  "behaviour tag is an object type"
+  (agentic/type-kind "behaviour")
+  "object")
+(agentic-test
+  "behaviour is content-addressable"
+  (starts-with? (git/cid ag-fix-behaviour) "sx1:")
+  true)

lib/agentic/tests/trace.sx

@@ -0,0 +1,289 @@
+; Phase 3 — trace: console output as attached content-addressed objects.
+; Fixture story: tracer-1 logs console/tool entries and commits with traces
+; (drain-at-commit granularity); quiet-1 stays silent and gets a manual
+; genesis trace attached + rebound; a failed commit keeps the buffer; a
+; plain commit! deliberately leaves the buffer alone (agent-chosen binding).
+
+(define agt-db (persist/mem-backend))
+(define agt-sp (agentic/space agt-db "agentic-trace-test"))
+(define agt-repo (agentic/space-repo agt-sp))
+(define
+  agt-a
+  (agentic/spawn!
+    agt-sp
+    "tracer-1"
+    (agentic/briefing "trace things" "exercise the trace layer" {})))
+(define
+  agt-b
+  (agentic/spawn!
+    agt-sp
+    "quiet-1"
+    (agentic/briefing "stay quiet" "no console output" {})))
+
+(agentic-test
+  "fresh agent has an empty buffer"
+  (= (agentic/trace-pending agt-sp "tracer-1") (list))
+  true)
+(agentic-test
+  "trace! appends to the buffer"
+  (agentic/trace! agt-sp "tracer-1" "console" "$ compiling")
+  true)
+
+(agentic/trace! agt-sp "tracer-1" "tool" "sx_eval (+ 1 2)")
+
+(agentic-test
+  "pending sees logged entries"
+  (len (agentic/trace-pending agt-sp "tracer-1"))
+  2)
+(agentic-test
+  "pending preserves log order"
+  (get (nth (agentic/trace-pending agt-sp "tracer-1") 0) :text)
+  "$ compiling")
+(agentic-test
+  "buffers are per agent"
+  (= (agentic/trace-pending agt-sp "quiet-1") (list))
+  true)
+
+; ---- commit drains the buffer into an attached trace ----
+(define
+  agt-c1
+  (agentic/commit-with-trace!
+    agt-sp
+    "tracer-1"
+    "finding"
+    (assoc {} "notes.md" "found it\n")
+    {:message "first finding"}))
+
+(agentic-test
+  "commit-with-trace! commits"
+  (starts-with? (get agt-c1 :cid) "sx1:")
+  true)
+(agentic-test
+  "commit-with-trace! attaches a trace"
+  (starts-with? (get agt-c1 :trace) "sx1:")
+  true)
+(agentic-test
+  "commit advances the head"
+  (= (agentic/head agt-sp "tracer-1") (get agt-c1 :cid))
+  true)
+(agentic-test
+  "trace-for finds the bound trace"
+  (agentic/console-trace? (agentic/trace-for agt-sp (get agt-c1 :cid)))
+  true)
+(agentic-test
+  "bound trace carries the entries"
+  (len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid))))
+  2)
+(agentic-test
+  "bound trace keeps entry order"
+  (get
+    (nth
+      (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid)))
+      0)
+    :text)
+  "$ compiling")
+(agentic-test
+  "trace names its commit by cid"
+  (get (agentic/trace-for agt-sp (get agt-c1 :cid)) :commit)
+  (get agt-c1 :cid))
+(agentic-test
+  "trace names its agent"
+  (get (agentic/trace-for agt-sp (get agt-c1 :cid)) :agent)
+  "tracer-1")
+(agentic-test
+  "trace is NOT in the commit tree"
+  (=
+    (git/tree-names
+      (git/read
+        agt-repo
+        (git/commit-tree (git/read agt-repo (get agt-c1 :cid)))))
+    (list "notes.md"))
+  true)
+(agentic-test
+  "buffer drained after commit"
+  (= (agentic/trace-pending agt-sp "tracer-1") (list))
+  true)
+
+; ---- granularity = the commit: only entries since the last drain travel ----
+(agentic/trace! agt-sp "tracer-1" "console" "$ second round")
+(define
+  agt-c2
+  (agentic/commit-with-trace!
+    agt-sp
+    "tracer-1"
+    "refactor"
+    (assoc {} "notes.md" "refined\n")
+    {:message "second"}))
+
+(agentic-test
+  "next trace carries only new entries"
+  (len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c2 :cid))))
+  1)
+(agentic-test
+  "next trace text"
+  (get
+    (nth
+      (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c2 :cid)))
+      0)
+    :text)
+  "$ second round")
+(agentic-test
+  "earlier trace is unchanged"
+  (len (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c1 :cid))))
+  2)
+
+; ---- a silent commit binds nothing ----
+(define
+  agt-c3
+  (agentic/commit-with-trace!
+    agt-sp
+    "tracer-1"
+    "decision"
+    (assoc {} "notes.md" "done\n")
+    {:message "silent"}))
+
+(agentic-test "silent commit has no trace key" (has-key? agt-c3 :trace) false)
+(agentic-test
+  "silent commit still commits"
+  (= (agentic/head agt-sp "tracer-1") (get agt-c3 :cid))
+  true)
+(agentic-test
+  "trace-for nil on a traceless commit"
+  (agentic/trace-for agt-sp (get agt-c3 :cid))
+  nil)
+
+; ---- attachment is external to the object layer ----
+(agentic-test
+  "attached commit round-trips to the same cid"
+  (= (git/cid (git/read agt-repo (get agt-c1 :cid))) (get agt-c1 :cid))
+  true)
+(agentic-test
+  "trace object is content-addressed"
+  (=
+    (get agt-c1 :trace)
+    (git/cid
+      (agentic/console-trace
+        (list
+          (agentic/trace-entry "console" "$ compiling")
+          (agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
+        {:agent "tracer-1" :commit (get agt-c1 :cid)})))
+  true)
+
+(define
+  agt-manual
+  (agentic/attach-trace!
+    agt-sp
+    (get agt-b :genesis)
+    (agentic/console-trace
+      (list (agentic/trace-entry "console" "spawn log"))
+      {:commit (get agt-b :genesis)})))
+
+(agentic-test
+  "manual attach to any commit"
+  (starts-with? agt-manual "sx1:")
+  true)
+(agentic-test
+  "manual attachment is found"
+  (= (agentic/trace-cid-for agt-sp (get agt-b :genesis)) agt-manual)
+  true)
+(agentic-test
+  "attach validates the object type"
+  (get
+    (agentic/attach-trace!
+      agt-sp
+      (get agt-b :genesis)
+      (agentic/briefing "x" "y" {}))
+    :error)
+  "not-a-console-trace")
+
+(define
+  agt-manual2
+  (agentic/attach-trace!
+    agt-sp
+    (get agt-b :genesis)
+    (agentic/console-trace
+      (list (agentic/trace-entry "console" "amended log"))
+      {:commit (get agt-b :genesis)})))
+
+(agentic-test
+  "re-attach rebinds the note ref"
+  (= (agentic/trace-cid-for agt-sp (get agt-b :genesis)) agt-manual2)
+  true)
+(agentic-test
+  "rebinding keeps the old object in the store"
+  (agentic/console-trace? (git/read agt-repo agt-manual))
+  true)
+
+; ---- session-wide view ----
+(agentic-test
+  "session-traces pairs commits with traces, newest first"
+  (=
+    (agentic/session-traces agt-sp "tracer-1")
+    (list
+      (list (get agt-c2 :cid) (get agt-c2 :trace))
+      (list (get agt-c1 :cid) (get agt-c1 :trace))))
+  true)
+(agentic-test
+  "session-traces sees manual genesis attachments"
+  (=
+    (agentic/session-traces agt-sp "quiet-1")
+    (list (list (get agt-b :genesis) agt-manual2)))
+  true)
+
+; ---- failed commits keep the buffer ----
+(agentic/trace! agt-sp "tracer-1" "console" "$ doomed")
+(define
+  agt-bad
+  (agentic/commit-with-trace!
+    agt-sp
+    "tracer-1"
+    "frobnicate"
+    {}
+    {}))
+
+(agentic-test
+  "failed commit passes the error through"
+  (get agt-bad :error)
+  "unknown-kind")
+(agentic-test
+  "failed commit keeps the buffer"
+  (len (agentic/trace-pending agt-sp "tracer-1"))
+  1)
+
+(define
+  agt-c4
+  (agentic/commit-with-trace!
+    agt-sp
+    "tracer-1"
+    "test"
+    (assoc {} "notes.md" "recovered\n")
+    {:message "recover"}))
+
+(agentic-test
+  "kept entries travel with the next commit"
+  (get
+    (nth
+      (agentic/trace-entries (agentic/trace-for agt-sp (get agt-c4 :cid)))
+      0)
+    :text)
+  "$ doomed")
+
+; ---- binding is agent-chosen: plain commit! leaves the buffer alone ----
+(agentic/trace! agt-sp "tracer-1" "console" "$ held back")
+(define
+  agt-c5
+  (agentic/commit!
+    agt-sp
+    "tracer-1"
+    "decision"
+    (assoc {} "notes.md" "plain\n")
+    {:message "plain"}))
+
+(agentic-test
+  "plain commit! binds nothing"
+  (agentic/trace-for agt-sp agt-c5)
+  nil)
+(agentic-test
+  "plain commit! leaves the buffer"
+  (len (agentic/trace-pending agt-sp "tracer-1"))
+  1)

lib/agentic/trace.sx

@@ -0,0 +1,136 @@
+; lib/agentic/trace.sx — agentic-sx Phase 3: console traces as ATTACHED
+; content-addressed objects. An agent's console/tool output accumulates in a
+; per-agent append-only persist log stream; the commit verb drains everything
+; since the last commit into a console-trace object and binds it to the new
+; commit git-note style: ref "notes/trace/<commit-cid>" -> trace cid. The
+; trace is NOT in the commit's tree — attaching never changes the commit cid,
+; and the note is a re-bindable ref layer over immutable objects.
+; Granularity = the commit, agent-chosen: whatever was logged since the last
+; drain travels with the next commit.
+; Requires: lib/agentic/branch.sx (and its deps).
+
+; ---- buffer stream + drain cursor (namespaced under the repo prefix) ----
+(define
+  agentic/trace-stream
+  (fn
+    (sp agent)
+    (str (get (agentic/space-repo sp) :prefix) "/trace/" agent)))
+
+(define
+  agentic/trace-cursor-key
+  (fn
+    (sp agent)
+    (str (get (agentic/space-repo sp) :prefix) "/trace-cursor/" agent)))
+
+; append one console/tool entry to the agent's buffer => true
+(define
+  agentic/trace!
+  (fn
+    (sp agent kind text)
+    (begin
+      (persist/append
+        (git/repo-db (agentic/space-repo sp))
+        (agentic/trace-stream sp agent)
+        "trace-entry"
+        0
+        (agentic/trace-entry kind text))
+      true)))
+
+; entries logged since the last drain, oldest first
+(define
+  agentic/trace-pending
+  (fn
+    (sp agent)
+    (let
+      ((db (git/repo-db (agentic/space-repo sp))))
+      (let
+        ((cur (persist/kv-get db (agentic/trace-cursor-key sp agent))))
+        (map
+          (fn (e) (persist/event-data e))
+          (persist/read-from
+            db
+            (agentic/trace-stream sp agent)
+            (+ (if (nil? cur) 0 cur) 1)))))))
+
+; advance the drain cursor to the stream's high-water mark
+(define
+  agentic/trace-mark!
+  (fn
+    (sp agent)
+    (let
+      ((db (git/repo-db (agentic/space-repo sp))))
+      (begin
+        (persist/kv-put
+          db
+          (agentic/trace-cursor-key sp agent)
+          (persist/last-seq db (agentic/trace-stream sp agent)))
+        true))))
+
+; ---- git-note-style binding: commit cid -> trace cid ----
+(define
+  agentic/trace-note-ref
+  (fn (commit-cid) (str "notes/trace/" commit-cid)))
+
+; write the trace object and bind it to the commit => trace cid | {:error}
+(define
+  agentic/attach-trace!
+  (fn
+    (sp commit-cid trace-obj)
+    (let
+      ((repo (agentic/space-repo sp)))
+      (if
+        (not (agentic/console-trace? trace-obj))
+        {:error "not-a-console-trace"}
+        (let
+          ((tcid (git/write repo trace-obj)))
+          (begin
+            (git/ref-set! repo (agentic/trace-note-ref commit-cid) tcid)
+            tcid))))))
+
+(define
+  agentic/trace-cid-for
+  (fn
+    (sp commit-cid)
+    (git/ref-get (agentic/space-repo sp) (agentic/trace-note-ref commit-cid))))
+
+(define
+  agentic/trace-for
+  (fn
+    (sp commit-cid)
+    (let
+      ((tcid (agentic/trace-cid-for sp commit-cid)))
+      (if (nil? tcid) nil (git/read (agentic/space-repo sp) tcid)))))
+
+; ---- the commit verb with trace binding ----
+; commit! then drain the buffer into an attached console-trace.
+; => {:cid cid :trace tcid} | {:cid cid} when nothing was logged
+;  | commit!'s {:error ...}/{:conflict ...} passthrough (buffer kept)
+(define
+  agentic/commit-with-trace!
+  (fn
+    (sp agent kind files meta)
+    (let
+      ((cid (agentic/commit! sp agent kind files meta)))
+      (if
+        (dict? cid)
+        cid
+        (let
+          ((entries (agentic/trace-pending sp agent)))
+          (if
+            (= (len entries) 0)
+            {:cid cid}
+            (let
+              ((tcid (agentic/attach-trace! sp cid (agentic/console-trace entries {:agent agent :commit cid}))))
+              (begin (agentic/trace-mark! sp agent) {:trace tcid :cid cid}))))))))
+
+; (commit-cid trace-cid) pairs for the agent's session, newest first,
+; commits without a bound trace omitted
+(define
+  agentic/session-traces
+  (fn
+    (sp agent)
+    (filter
+      (fn (p) (not (nil? (nth p 1))))
+      (map
+        (fn (cid) (list cid (agentic/trace-cid-for sp cid)))
+        (agentic/session-log sp agent)))))

lib/apl/conformance.conf

@@ -0,0 +1,63 @@
+# APL conformance config — sourced by lib/guest/conformance.sh.
+
+LANG_NAME=apl
+MODE=counters
+COUNTERS_PASS=apl-test-pass
+COUNTERS_FAIL=apl-test-fail
+TIMEOUT_PER_SUITE=300
+
+PRELOADS=(
+  spec/stdlib.sx
+  lib/r7rs.sx
+  lib/apl/runtime.sx
+  lib/apl/tokenizer.sx
+  lib/apl/parser.sx
+  lib/apl/transpile.sx
+  lib/apl/test-harness.sx
+)
+
+SUITES=(
+  "structural:lib/apl/tests/structural.sx"
+  "operators:lib/apl/tests/operators.sx"
+  "dfn:lib/apl/tests/dfn.sx"
+  "tradfn:lib/apl/tests/tradfn.sx"
+  "valence:lib/apl/tests/valence.sx"
+  "programs:lib/apl/tests/programs.sx"
+  "system:lib/apl/tests/system.sx"
+  "idioms:lib/apl/tests/idioms.sx"
+  "eval-ops:lib/apl/tests/eval-ops.sx"
+  "pipeline:lib/apl/tests/pipeline.sx"
+)
+
+emit_scoreboard_json() {
+  local n=${#GC_NAMES[@]} i sep
+  printf '{\n'
+  printf '  "suites": {\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 '  "total_pass": %d,\n' "$GC_TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$GC_TOTAL_FAIL"
+  printf '  "total": %d\n' "$GC_TOTAL"
+  printf '}\n'
+}
+
+emit_scoreboard_md() {
+  local n=${#GC_NAMES[@]} i
+  printf '# APL Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/apl/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for ((i=0; i<n; i++)); do
+    printf '| %s | %d | %d | %d |\n' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "${GC_TOTAL_S[$i]}"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$GC_TOTAL_PASS" "$GC_TOTAL_FAIL" "$GC_TOTAL"
+  printf '\n'
+  printf '## Notes\n\n'
+  printf '%s\n' '- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.'
+  printf '%s\n' '- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.'
+}

lib/apl/conformance.sh

@@ -1,116 +1,5 @@
 #!/usr/bin/env bash
-# lib/apl/conformance.sh — run APL test suites, emit scoreboard.json + scoreboard.md.
-
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then
-  echo "ERROR: sx_server.exe not found." >&2
-  exit 1
-fi
-
-SUITES=(structural operators dfn tradfn valence programs system idioms eval-ops pipeline)
-
-OUT_JSON="lib/apl/scoreboard.json"
-OUT_MD="lib/apl/scoreboard.md"
-
-run_suite() {
-  local suite=$1
-  local file="lib/apl/tests/${suite}.sx"
-  local TMP
-  TMP=$(mktemp)
-  cat > "$TMP" << EPOCHS
-(epoch 1)
-(load "spec/stdlib.sx")
-(load "lib/r7rs.sx")
-(load "lib/apl/runtime.sx")
-(load "lib/apl/tokenizer.sx")
-(load "lib/apl/parser.sx")
-(load "lib/apl/transpile.sx")
-(epoch 2)
-(eval "(define apl-test-pass 0)")
-(eval "(define apl-test-fail 0)")
-(eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (set! apl-test-fail (+ apl-test-fail 1)))))")
-(epoch 3)
-(load "${file}")
-(epoch 4)
-(eval "(list apl-test-pass apl-test-fail)")
-EPOCHS
-
-  local OUTPUT
-  OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
-  rm -f "$TMP"
-
-  local LINE
-  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
-  if [ -z "$LINE" ]; then
-    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
-            | sed -E 's/^\(ok 4 //; s/\)$//')
-  fi
-
-  local P F
-  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
-  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
-  P=${P:-0}
-  F=${F:-0}
-  echo "${P} ${F}"
-}
-
-declare -A SUITE_PASS
-declare -A SUITE_FAIL
-TOTAL_PASS=0
-TOTAL_FAIL=0
-
-echo "Running APL conformance suite..." >&2
-for s in "${SUITES[@]}"; do
-  read -r p f < <(run_suite "$s")
-  SUITE_PASS[$s]=$p
-  SUITE_FAIL[$s]=$f
-  TOTAL_PASS=$((TOTAL_PASS + p))
-  TOTAL_FAIL=$((TOTAL_FAIL + f))
-  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
-done
-
-# scoreboard.json
-{
-  printf '{\n'
-  printf '  "suites": {\n'
-  first=1
-  for s in "${SUITES[@]}"; do
-    if [ $first -eq 0 ]; then printf ',\n'; fi
-    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
-    first=0
-  done
-  printf '\n  },\n'
-  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
-  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
-  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
-  printf '}\n'
-} > "$OUT_JSON"
-
-# scoreboard.md
-{
-  printf '# APL Conformance Scoreboard\n\n'
-  printf '_Generated by `lib/apl/conformance.sh`_\n\n'
-  printf '| Suite | Pass | Fail | Total |\n'
-  printf '|-------|-----:|-----:|------:|\n'
-  for s in "${SUITES[@]}"; do
-    p=${SUITE_PASS[$s]}
-    f=${SUITE_FAIL[$s]}
-    printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
-  done
-  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
-  printf '\n'
-  printf '## Notes\n\n'
-  printf '%s\n' '- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.'
-  printf '%s\n' '- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.'
-} > "$OUT_MD"
-
-echo "Wrote $OUT_JSON and $OUT_MD" >&2
-echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
-
-[ "$TOTAL_FAIL" -eq 0 ]
+# lib/apl/conformance.sh — APL conformance via the shared guest driver.
+# Config lives in lib/apl/conformance.conf (MODE=counters). Override the binary
+# with SX_SERVER=path/to/sx_server.exe bash lib/apl/conformance.sh
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/apl/parser.sx

@@ -416,10 +416,20 @@
                 ((apl-parse-op-glyph? tv)
                   (if
                     (or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀"))
-                    (collect-segments-loop
-                      tokens
-                      (+ i 1)
-                      (append acc {:kind "fn" :node (list :fn-glyph tv)}))
+                    (let
+                      ((next-i (+ i 1)))
+                      (let
+                        ((next-tok (if (< next-i n) (nth tokens next-i) nil)))
+                        (let
+                          ((mod (if (and next-tok (= (tok-type next-tok) :glyph) (or (= (get next-tok :value) "⍨") (= (get next-tok :value) "¨"))) (get next-tok :value) nil))
+                            (base-fn-node (list :fn-glyph tv)))
+                          (let
+                            ((node (if mod (list :derived-fn mod base-fn-node) base-fn-node))
+                              (advance (if mod 2 1)))
+                            (collect-segments-loop
+                              tokens
+                              (+ i advance)
+                              (append acc {:kind "fn" :node node}))))))
                     (collect-segments-loop tokens (+ i 1) acc)))
                 (true (collect-segments-loop tokens (+ i 1) acc))))
             (true (collect-segments-loop tokens (+ i 1) acc))))))))

lib/apl/runtime.sx

@@ -65,10 +65,30 @@
             (get a :shape)
             (map (fn (x) (f x sv)) (get a :ravel)))))
       (else
-        (if
-          (equal? (get a :shape) (get b :shape))
-          (make-array (get a :shape) (map f (get a :ravel) (get b :ravel)))
-          (error "length error: shape mismatch"))))))
+        (let
+          ((a-shape (get a :shape)) (b-shape (get b :shape)))
+          (cond
+            ((equal? a-shape b-shape)
+              (make-array a-shape (map f (get a :ravel) (get b :ravel))))
+            ((and (= (len a-shape) 1) (> (len b-shape) 1))
+              (make-array
+                (append a-shape b-shape)
+                (flatten
+                  (map
+                    (fn
+                      (x)
+                      (get (broadcast-dyadic f (apl-scalar x) b) :ravel))
+                    (get a :ravel)))))
+            ((and (= (len b-shape) 1) (> (len a-shape) 1))
+              (make-array
+                (append a-shape b-shape)
+                (flatten
+                  (map
+                    (fn
+                      (acell)
+                      (get (broadcast-dyadic f (apl-scalar acell) b) :ravel))
+                    (get a :ravel)))))
+            (else (error "length error: shape mismatch"))))))))
 
 ; ============================================================
 ; Arithmetic primitives
@@ -827,6 +847,106 @@
               ((new-ravel (reduce (fn (acc r) (append acc (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) (list) kept-rows)))
               (make-array (cons (len kept-rows) (rest shape)) new-ravel))))))))
 
+(define
+  apl-where
+  (fn
+    (arr)
+    (let
+      ((ravel (get arr :ravel)) (io (disclose (apl-quad-io))))
+      (let
+        ((indices (filter (fn (i) (not (= (nth ravel i) 0))) (range 0 (len ravel)))))
+        (apl-vector (map (fn (i) (+ i io)) indices))))))
+
+(define
+  apl-interval-index
+  (fn
+    (breaks vals)
+    (let
+      ((b-ravel (get breaks :ravel))
+        (v-ravel
+          (if (scalar? vals) (list (disclose vals)) (get vals :ravel))))
+      (let
+        ((result (map (fn (y) (len (filter (fn (b) (<= b y)) b-ravel))) v-ravel)))
+        (if
+          (scalar? vals)
+          (apl-scalar (first result))
+          (make-array (get vals :shape) result))))))
+
+(define
+  apl-unique
+  (fn
+    (arr)
+    (let
+      ((ravel (if (scalar? arr) (list (disclose arr)) (get arr :ravel))))
+      (let
+        ((dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) ravel)))
+        (apl-vector dedup)))))
+
+(define
+  apl-union
+  (fn
+    (a b)
+    (let
+      ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel)))
+        (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel))))
+      (let
+        ((a-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) a-ravel)))
+        (let
+          ((b-extra (filter (fn (x) (not (index-of a-dedup x))) b-ravel)))
+          (let
+            ((b-extra-dedup (reduce (fn (acc x) (if (index-of acc x) acc (append acc (list x)))) (list) b-extra)))
+            (apl-vector (append a-dedup b-extra-dedup))))))))
+
+(define
+  apl-intersect
+  (fn
+    (a b)
+    (let
+      ((a-ravel (if (scalar? a) (list (disclose a)) (get a :ravel)))
+        (b-ravel (if (scalar? b) (list (disclose b)) (get b :ravel))))
+      (apl-vector (filter (fn (x) (index-of b-ravel x)) a-ravel)))))
+
+(define
+  apl-decode
+  (fn
+    (base digits)
+    (let
+      ((d-ravel (if (scalar? digits) (list (disclose digits)) (get digits :ravel))))
+      (let
+        ((d-len (len d-ravel)))
+        (let
+          ((b-ravel (if (scalar? base) (let ((b (disclose base))) (map (fn (i) b) (range 0 d-len))) (get base :ravel))))
+          (let
+            ((result (reduce (fn (acc i) (if (= i 0) (nth d-ravel 0) (+ (* acc (nth b-ravel i)) (nth d-ravel i)))) 0 (range 0 d-len))))
+            (apl-scalar result)))))))
+
+(define
+  apl-encode
+  (fn
+    (base val)
+    (let
+      ((b-ravel (if (scalar? base) (list (disclose base)) (get base :ravel)))
+        (n (if (scalar? val) (disclose val) (first (get val :ravel)))))
+      (let
+        ((b-len (len b-ravel)))
+        (let
+          ((result (reduce (fn (acc-and-n i) (let ((acc (first acc-and-n)) (rem (nth acc-and-n 1))) (let ((b (nth b-ravel (- (- b-len 1) i)))) (if (= b 0) (list (cons rem acc) 0) (list (cons (modulo rem b) acc) (floor (/ rem b))))))) (list (list) n) (range 0 b-len))))
+          (apl-vector (first result)))))))
+
+(define
+  apl-partition
+  (fn
+    (mask val)
+    (let
+      ((m-ravel (if (scalar? mask) (list (disclose mask)) (get mask :ravel)))
+        (v-ravel
+          (if (scalar? val) (list (disclose val)) (get val :ravel))))
+      (let
+        ((n (len m-ravel)))
+        (let
+          ((built (reduce (fn (acc-and-prev i) (let ((acc (first acc-and-prev)) (prev (nth acc-and-prev 1))) (let ((mi (nth m-ravel i)) (vi (nth v-ravel i))) (cond ((= mi 0) (list acc 0)) ((> mi prev) (list (append acc (list (list vi))) mi)) (else (let ((idx (- (len acc) 1))) (list (append (slice acc 0 idx) (list (append (nth acc idx) (list vi)))) mi))))))) (list (list) 0) (range 0 n))))
+          (apl-vector (map (fn (part) (apl-vector part)) (first built))))))))
+
 (define
   apl-primes
   (fn
@@ -1074,11 +1194,9 @@
             (if
               (= n 0)
               (apl-scalar 0)
-              (apl-scalar
-                (reduce
-                  (fn (a b) (disclose (f (apl-scalar a) (apl-scalar b))))
-                  (first ravel)
-                  (rest ravel)))))
+              (let
+                ((rr (reduce (fn (a b) (let ((wa (if (= (type-of a) "dict") a (apl-scalar a))) (wb (if (= (type-of b) "dict") b (apl-scalar b)))) (let ((r (f wa wb))) (if (scalar? r) (disclose r) r)))) (first ravel) (rest ravel))))
+                (if (= (type-of rr) "dict") rr (apl-scalar rr)))))
           (let
             ((last-dim (last shape))
               (pre-shape (take shape (- (len shape) 1)))
@@ -1100,7 +1218,13 @@
                       (reduce
                         (fn
                           (a b)
-                          (disclose (f (apl-scalar a) (apl-scalar b))))
+                          (let
+                            ((wa (if (= (type-of a) "dict") a (apl-scalar a)))
+                              (wb
+                                (if (= (type-of b) "dict") b (apl-scalar b))))
+                            (let
+                              ((r (f wa wb)))
+                              (if (scalar? r) (disclose r) r))))
                         (first elems)
                         (rest elems)))))
                 (range 0 pre-size)))))))))
@@ -1241,13 +1365,29 @@
     (cond
       ((and (scalar? a) (scalar? b)) (apl-scalar (disclose (f a b))))
       ((scalar? a)
-        (make-array
-          (get b :shape)
-          (map (fn (x) (disclose (f a (apl-scalar x)))) (get b :ravel))))
+        (let
+          ((a-eff (let ((d (disclose a))) (if (= (type-of d) "dict") d a))))
+          (make-array
+            (get b :shape)
+            (map
+              (fn
+                (x)
+                (let
+                  ((r (f a-eff (apl-scalar x))))
+                  (if (scalar? r) (disclose r) r)))
+              (get b :ravel)))))
       ((scalar? b)
-        (make-array
-          (get a :shape)
-          (map (fn (x) (disclose (f (apl-scalar x) b))) (get a :ravel))))
+        (let
+          ((b-eff (let ((d (disclose b))) (if (= (type-of d) "dict") d b))))
+          (make-array
+            (get a :shape)
+            (map
+              (fn
+                (x)
+                (let
+                  ((r (f (apl-scalar x) b-eff)))
+                  (if (scalar? r) (disclose r) r)))
+              (get a :ravel)))))
       (else
         (if
           (equal? (get a :shape) (get b :shape))
@@ -1268,16 +1408,22 @@
         (b-shape (get b :shape))
         (a-ravel (get a :ravel))
         (b-ravel (get b :ravel)))
-      (make-array
-        (append a-shape b-shape)
-        (flatten
-          (map
-            (fn
-              (x)
-              (map
-                (fn (y) (disclose (f (apl-scalar x) (apl-scalar y))))
-                b-ravel))
-            a-ravel))))))
+      (let
+        ((wrap (fn (x) (if (= (type-of x) "dict") x (apl-scalar x)))))
+        (make-array
+          (append a-shape b-shape)
+          (flatten
+            (map
+              (fn
+                (x)
+                (map
+                  (fn
+                    (y)
+                    (let
+                      ((r (f (wrap x) (wrap y))))
+                      (if (scalar? r) (disclose r) r)))
+                  b-ravel))
+              a-ravel)))))))
 
 (define
   apl-inner
@@ -1301,25 +1447,12 @@
               ((a-pre-size (reduce * 1 a-pre))
                 (b-post-size (reduce * 1 b-post))
                 (new-shape (append a-pre b-post)))
-              (make-array
-                new-shape
-                (flatten
-                  (map
-                    (fn
-                      (i)
-                      (map
-                        (fn
-                          (j)
-                          (let
-                            ((pairs (map (fn (k) (disclose (g (apl-scalar (nth a-ravel (+ (* i inner-dim) k))) (apl-scalar (nth b-ravel (+ (* k b-post-size) j)))))) (range 0 inner-dim))))
-                            (reduce
-                              (fn
-                                (x y)
-                                (disclose (f (apl-scalar x) (apl-scalar y))))
-                              (first pairs)
-                              (rest pairs))))
-                        (range 0 b-post-size)))
-                    (range 0 a-pre-size)))))))))))
+              (let
+                ((result (make-array new-shape (flatten (map (fn (i) (map (fn (j) (let ((pairs (map (fn (k) (let ((a-elem (nth a-ravel (+ (* i inner-dim) k))) (b-elem (nth b-ravel (+ (* k b-post-size) j)))) (let ((a-cell (if (= (type-of a-elem) "dict") (nth (get a-elem :ravel) j) a-elem)) (b-cell (if (= (type-of b-elem) "dict") (nth (get b-elem :ravel) 0) b-elem))) (disclose (g (apl-scalar a-cell) (apl-scalar b-cell)))))) (range 0 inner-dim)))) (reduce (fn (x y) (let ((wx (if (= (type-of x) "dict") x (apl-scalar x))) (wy (if (= (type-of y) "dict") y (apl-scalar y)))) (let ((r (f wx wy))) (if (scalar? r) (disclose r) r)))) (first pairs) (rest pairs)))) (range 0 b-post-size))) (range 0 a-pre-size))))))
+                (if
+                  (some (fn (x) (= (type-of x) "dict")) a-ravel)
+                  (enclose result)
+                  result)))))))))
 
 (define apl-commute (fn (f x) (f x x)))
 

lib/apl/scoreboard.json

@@ -9,9 +9,9 @@
     "system": {"pass": 13, "fail": 0},
     "idioms": {"pass": 64, "fail": 0},
     "eval-ops": {"pass": 14, "fail": 0},
-    "pipeline": {"pass": 40, "fail": 0}
+    "pipeline": {"pass": 152, "fail": 0}
   },
-  "total_pass": 450,
+  "total_pass": 562,
   "total_fail": 0,
-  "total": 450
+  "total": 562
 }

lib/apl/scoreboard.md

@@ -13,8 +13,8 @@ _Generated by `lib/apl/conformance.sh`_
 | system | 13 | 0 | 13 |
 | idioms | 64 | 0 | 64 |
 | eval-ops | 14 | 0 | 14 |
-| pipeline | 40 | 0 | 40 |
-| **Total** | **450** | **0** | **450** |
+| pipeline | 152 | 0 | 152 |
+| **Total** | **562** | **0** | **562** |
 
 ## Notes
 

lib/apl/test-harness.sx

@@ -0,0 +1,15 @@
+; lib/apl/test-harness.sx — counters + assertion fn for the shared conformance
+; driver (lib/guest/conformance.sh, MODE=counters). Loaded as a PRELOAD so each
+; suite starts from a fresh 0/0; suites call (apl-test name got expected).
+
+(define apl-test-pass 0)
+(define apl-test-fail 0)
+
+(define
+  apl-test
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! apl-test-pass (+ apl-test-pass 1))
+      (set! apl-test-fail (+ apl-test-fail 1)))))

lib/apl/tests/pipeline.sx

@@ -455,3 +455,233 @@
   (list 1 2 3))
 
 (apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42")
+
+(begin
+  (apl-test
+    "⍸ where: indices of truthy cells"
+    (mkrv (apl-run "⍸ 0 1 0 1 1"))
+    (list 2 4 5))
+  (apl-test
+    "⍸ where: leading truthy"
+    (mkrv (apl-run "⍸ 1 0 0 1 1"))
+    (list 1 4 5))
+  (apl-test
+    "⍸ where: all-zero → empty"
+    (mkrv (apl-run "⍸ 0 0 0"))
+    (list))
+  (apl-test
+    "⍸ where: all-truthy"
+    (mkrv (apl-run "⍸ 1 1 1"))
+    (list 1 2 3))
+  (apl-test
+    "⍸ where: ⎕IO=1 (1-based)"
+    (mkrv (apl-run "⍸ (⍳5)=3"))
+    (list 3))
+  (apl-test
+    "⍸ interval-index: 2 4 6 ⍸ 5 → 2"
+    (mkrv (apl-run "2 4 6 ⍸ 5"))
+    (list 2))
+  (apl-test
+    "⍸ interval-index: 2 4 6 ⍸ 1 3 5 6 7 → 0 1 2 3 3"
+    (mkrv (apl-run "2 4 6 ⍸ 1 3 5 6 7"))
+    (list 0 1 2 3 3))
+  (apl-test
+    "⍸ interval-index: ⍳5 ⍸ 3 → 3"
+    (mkrv (apl-run "(⍳5) ⍸ 3"))
+    (list 3))
+  (apl-test
+    "⍸ interval-index: y below all → 0"
+    (mkrv (apl-run "10 20 30 ⍸ 5"))
+    (list 0))
+  (apl-test
+    "⍸ interval-index: y above all → len breaks"
+    (mkrv (apl-run "10 20 30 ⍸ 100"))
+    (list 3)))
+
+(begin
+  (apl-test
+    "∪ unique: dedup keeps first-occurrence order"
+    (mkrv (apl-run "∪ 1 2 1 3 2 1 4"))
+    (list 1 2 3 4))
+  (apl-test
+    "∪ unique: already-unique unchanged"
+    (mkrv (apl-run "∪ 5 4 3 2 1"))
+    (list 5 4 3 2 1))
+  (apl-test "∪ unique: scalar" (mkrv (apl-run "∪ 7")) (list 7))
+  (apl-test
+    "∪ unique: string mississippi → misp"
+    (mkrv (apl-run "∪ 'mississippi'"))
+    (list "m" "i" "s" "p"))
+  (apl-test
+    "∪ union: 1 2 3 ∪ 3 4 5 → 1 2 3 4 5"
+    (mkrv (apl-run "1 2 3 ∪ 3 4 5"))
+    (list 1 2 3 4 5))
+  (apl-test
+    "∪ union: dedups left side too"
+    (mkrv (apl-run "1 2 1 ∪ 1 3 2"))
+    (list 1 2 3))
+  (apl-test
+    "∪ union: disjoint → catenated"
+    (mkrv (apl-run "1 2 ∪ 3 4"))
+    (list 1 2 3 4))
+  (apl-test
+    "∩ intersection: 1 2 3 4 ∩ 2 4 6 → 2 4"
+    (mkrv (apl-run "1 2 3 4 ∩ 2 4 6"))
+    (list 2 4))
+  (apl-test
+    "∩ intersection: disjoint → empty"
+    (mkrv (apl-run "1 2 3 ∩ 4 5 6"))
+    (list))
+  (apl-test
+    "∩ intersection: preserves left order"
+    (mkrv (apl-run "(⍳5) ∩ 5 3 1"))
+    (list 1 3 5))
+  (apl-test
+    "∩ intersection: identical"
+    (mkrv (apl-run "1 2 3 ∩ 1 2 3"))
+    (list 1 2 3))
+  (apl-test
+    "∪/∩ identity: A ∪ A = ∪A"
+    (mkrv (apl-run "1 2 1 ∪ 1 2 1"))
+    (list 1 2)))
+
+(begin
+  (apl-test
+    "⊥ decode: 2 2 2 ⊥ 1 0 1 → 5"
+    (mkrv (apl-run "2 2 2 ⊥ 1 0 1"))
+    (list 5))
+  (apl-test
+    "⊥ decode: 10 10 10 ⊥ 1 2 3 → 123"
+    (mkrv (apl-run "10 10 10 ⊥ 1 2 3"))
+    (list 123))
+  (apl-test
+    "⊥ decode: 24 60 60 ⊥ 2 3 4 → 7384 (mixed-radix HMS)"
+    (mkrv (apl-run "24 60 60 ⊥ 2 3 4"))
+    (list 7384))
+  (apl-test
+    "⊥ decode: scalar base 2 ⊥ 1 0 1 0 → 10"
+    (mkrv (apl-run "2 ⊥ 1 0 1 0"))
+    (list 10))
+  (apl-test
+    "⊥ decode: 16 16 ⊥ 15 15 → 255"
+    (mkrv (apl-run "16 16 ⊥ 15 15"))
+    (list 255))
+  (apl-test
+    "⊤ encode: 2 2 2 ⊤ 5 → 1 0 1"
+    (mkrv (apl-run "2 2 2 ⊤ 5"))
+    (list 1 0 1))
+  (apl-test
+    "⊤ encode: 24 60 60 ⊤ 7384 → 2 3 4 (HMS)"
+    (mkrv (apl-run "24 60 60 ⊤ 7384"))
+    (list 2 3 4))
+  (apl-test
+    "⊤ encode: 2 2 2 2 ⊤ 13 → 1 1 0 1"
+    (mkrv (apl-run "2 2 2 2 ⊤ 13"))
+    (list 1 1 0 1))
+  (apl-test
+    "⊤ encode: 10 10 ⊤ 42 → 4 2"
+    (mkrv (apl-run "10 10 ⊤ 42"))
+    (list 4 2))
+  (apl-test
+    "⊤ encode: round-trip B⊥(B⊤N) = N"
+    (mkrv (apl-run "24 60 60 ⊥ 24 60 60 ⊤ 7384"))
+    (list 7384))
+  (apl-test
+    "⊥ decode: round-trip B⊤(B⊥V) = V"
+    (mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1"))
+    (list 1 0 1)))
+
+(begin
+  (define
+    mk-parts
+    (fn (s) (map (fn (p) (get p :ravel)) (get (apl-run s) :ravel))))
+  (apl-test
+    "⊆ partition: 1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')"
+    (mk-parts "1 1 0 1 1 ⊆ 'abcde'")
+    (list (list "a" "b") (list "d" "e")))
+  (apl-test
+    "⊆ partition: 1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))"
+    (mk-parts "1 0 0 1 1 ⊆ ⍳5")
+    (list (list 1) (list 4 5)))
+  (apl-test
+    "⊆ partition: all-zero mask → empty"
+    (len (get (apl-run "0 0 0 ⊆ 1 2 3") :ravel))
+    0)
+  (apl-test
+    "⊆ partition: all-one mask → single partition"
+    (mk-parts "1 1 1 ⊆ 7 8 9")
+    (list (list 7 8 9)))
+  (apl-test
+    "⊆ partition: strict increase 1 2 starts new"
+    (mk-parts "1 2 ⊆ 10 20")
+    (list (list 10) (list 20)))
+  (apl-test
+    "⊆ partition: same level continues 2 2 → one partition"
+    (mk-parts "2 2 ⊆ 10 20")
+    (list (list 10 20)))
+  (apl-test
+    "⊆ partition: 0 separates"
+    (mk-parts "1 1 0 0 1 ⊆ 1 2 3 4 5")
+    (list (list 1 2) (list 5)))
+  (apl-test
+    "⊆ partition: outer length matches partition count"
+    (len (get (apl-run "1 0 1 0 1 ⊆ ⍳5") :ravel))
+    3))
+
+(begin
+  (apl-test
+    "⍎ execute: ⍎ '1 + 2' → 3"
+    (mkrv (apl-run "⍎ '1 + 2'"))
+    (list 3))
+  (apl-test
+    "⍎ execute: ⍎ '+/⍳10' → 55"
+    (mkrv (apl-run "⍎ '+/⍳10'"))
+    (list 55))
+  (apl-test
+    "⍎ execute: ⍎ '⌈/ 1 3 9 5 7' → 9"
+    (mkrv (apl-run "⍎ '⌈/ 1 3 9 5 7'"))
+    (list 9))
+  (apl-test
+    "⍎ execute: ⍎ '⍳5' → 1..5"
+    (mkrv (apl-run "⍎ '⍳5'"))
+    (list 1 2 3 4 5))
+  (apl-test
+    "⍎ execute: ⍎ '×/⍳5' → 120"
+    (mkrv (apl-run "⍎ '×/⍳5'"))
+    (list 120))
+  (apl-test
+    "⍎ execute: round-trip ⍎ ⎕FMT 42 → 42"
+    (mkrv (apl-run "⍎ ⎕FMT 42"))
+    (list 42))
+  (apl-test
+    "⍎ execute: nested ⍎ ⍎"
+    (mkrv (apl-run "⍎ '⍎ ''2 × 3'''"))
+    (list 6))
+  (apl-test
+    "⍎ execute: with assignment side-effect"
+    (mkrv (apl-run "⍎ 'q ← 99 ⋄ q + 1'"))
+    (list 100)))
+
+(begin
+  (apl-test
+    "het-inner: 1 ⍵ ∨.∧ X — result is enclosed (5 5)"
+    (let
+      ((r (apl-run "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ 1 B ∨.∧ X")))
+      (list
+        (len (get r :shape))
+        (= (type-of (first (get r :ravel))) "dict")))
+    (list 0 true))
+  (apl-test
+    "het-inner: ⊃ unwraps to (5 5) board"
+    (mksh
+      (apl-run
+        "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ ⊃ 1 B ∨.∧ X"))
+    (list 5 5))
+  (apl-test
+    "het-inner: homogeneous inner product unaffected"
+    (mkrv (apl-run "1 2 3 +.× 4 5 6"))
+    (list 32))
+  (apl-test
+    "het-inner: matrix inner product unaffected"
+    (mkrv (apl-run "(2 2 ⍴ 1 2 3 4) +.× 2 2 ⍴ 5 6 7 8"))
+    (list 19 22 43 50)))

lib/apl/tests/programs-e2e.sx

@@ -94,3 +94,96 @@
   "e2e: sqrt-via-newton 1 step from 1 → 2.5"
   (mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
   (list 2.5))
+
+(begin
+  (apl-test
+    "life.apl: blinker 5×5 → vertical blinker"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
+    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: blinker oscillates (period 2)"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
+    (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: 2×2 block stable"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 4 4 ⍴ 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0"))
+    (list 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0))
+  (apl-test
+    "life.apl: empty grid stays empty"
+    (mkrv
+      (apl-run
+        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0"))
+    (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
+  (apl-test
+    "life.apl: source-file as-written runs"
+    (let
+      ((dfn (apl-run-file "lib/apl/tests/programs/life.apl"))
+        (board
+          (apl-run "5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0")))
+      (get (apl-call-dfn-m dfn board) :ravel))
+    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0)))
+
+(begin
+  (apl-test
+    "quicksort.apl: 11-element with duplicates"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 3 1 4 1 5 9 2 6 5 3 5")))
+    (list 1 1 2 3 3 4 5 5 5 6 9))
+  (apl-test
+    "quicksort.apl: already sorted"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 1 2 3 4 5")))
+    (list 1 2 3 4 5))
+  (apl-test
+    "quicksort.apl: reverse sorted"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 5 4 3 2 1")))
+    (list 1 2 3 4 5))
+  (apl-test
+    "quicksort.apl: all equal"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 7 7 7 7")))
+    (list 7 7 7 7))
+  (apl-test
+    "quicksort.apl: single element"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort ,42")))
+    (list 42))
+  (apl-test
+    "quicksort.apl: matches grade-up"
+    (begin
+      (apl-rng-seed! 42)
+      (mkrv
+        (apl-run
+          "V ← 8 3 1 9 2 7 5 6 4 ⋄ quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort V")))
+    (list 1 2 3 4 5 6 7 8 9))
+  (apl-test
+    "quicksort.apl: source-file as-written runs"
+    (begin
+      (apl-rng-seed! 42)
+      (let
+        ((dfn (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
+          (vec (apl-run "5 2 8 1 9 3 7 4 6")))
+        (get (apl-call-dfn-m dfn vec) :ravel)))
+    (list 1 2 3 4 5 6 7 8 9)))

lib/apl/tests/programs/life.apl

@@ -8,9 +8,9 @@
 ⍝   ¯1 0 1 ⌽¨ ⊂⍵      : produce 3 horizontally-shifted copies
 ⍝   ¯1 0 1 ∘.⊖ …      : outer-product with vertical shifts → 3×3 = 9 shifts
 ⍝   +/ +/ …           : sum the 9 boards element-wise → neighbor-count + self
-⍝   3 4 = …           : boolean — count is exactly 3 or exactly 4
+⍝   3 4 = …           : leading-axis-extended boolean — count is 3 (born) or 4 (survive)
 ⍝   1 ⍵ ∨.∧ …         : "alive next" iff (count=3) or (alive AND count=4)
-⍝   ⊃ …               : disclose back to a 2D board
+⍝   ⊃ …               : disclose the enclosed result back to a 2D board
 ⍝
 ⍝ Rules in plain language:
 ⍝   - dead cell + 3 live neighbors → born

lib/apl/tokenizer.sx

@@ -19,162 +19,180 @@
              (and (>= ch "A") (<= ch "Z"))
              (= ch "_")))))
 
-(define apl-tokenize
-  (fn (source)
-    (let ((pos 0)
-          (src-len (len source))
-          (tokens (list)))
-
-      (define tok-push!
-        (fn (type value)
-          (append! tokens {:type type :value value})))
-
-      (define cur-sw?
-        (fn (ch)
+(define
+  apl-tokenize
+  (fn
+    (source)
+    (let
+      ((pos 0) (src-len (len source)) (tokens (list)))
+      (define tok-push! (fn (type value) (append! tokens {:value value :type type})))
+      (define
+        cur-sw?
+        (fn
+          (ch)
           (and (< pos src-len) (starts-with? (slice source pos) ch))))
-
-      (define cur-byte
-        (fn ()
-          (if (< pos src-len) (nth source pos) nil)))
-
-      (define advance!
-        (fn ()
-          (set! pos (+ pos 1))))
-
-      (define consume!
-        (fn (ch)
-          (set! pos (+ pos (len ch)))))
-
-      (define find-glyph
-        (fn ()
-          (let ((rem (slice source pos)))
-            (let ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set)))
+      (define cur-byte (fn () (if (< pos src-len) (nth source pos) nil)))
+      (define advance! (fn () (set! pos (+ pos 1))))
+      (define consume! (fn (ch) (set! pos (+ pos (len ch)))))
+      (define
+        find-glyph
+        (fn
+          ()
+          (let
+            ((rem (slice source pos)))
+            (let
+              ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set)))
               (if (> (len matches) 0) (first matches) nil)))))
-
-      (define read-digits!
-        (fn (acc)
-          (if (and (< pos src-len) (apl-digit? (cur-byte)))
-            (let ((ch (cur-byte)))
-              (begin
-                (advance!)
-                (read-digits! (str acc ch))))
+      (define
+        read-digits!
+        (fn
+          (acc)
+          (if
+            (and (< pos src-len) (apl-digit? (cur-byte)))
+            (let
+              ((ch (cur-byte)))
+              (begin (advance!) (read-digits! (str acc ch))))
             acc)))
-
-      (define read-ident-cont!
-        (fn ()
-          (when (and (< pos src-len)
-                     (let ((ch (cur-byte)))
-                       (or (apl-alpha? ch) (apl-digit? ch))))
-            (begin
-              (advance!)
-              (read-ident-cont!)))))
-
-      (define read-string!
-        (fn (acc)
+      (define
+        read-ident-cont!
+        (fn
+          ()
+          (when
+            (and
+              (< pos src-len)
+              (let
+                ((ch (cur-byte)))
+                (or (apl-alpha? ch) (apl-digit? ch))))
+            (begin (advance!) (read-ident-cont!)))))
+      (define
+        read-string!
+        (fn
+          (acc)
           (cond
             ((>= pos src-len) acc)
             ((cur-sw? "'")
-             (if (and (< (+ pos 1) src-len) (cur-sw? "'"))
-               (begin
-                 (advance!)
-                 (advance!)
-                 (read-string! (str acc "'")))
-               (begin (advance!) acc)))
+              (if
+                (and (< (+ pos 1) src-len) (cur-sw? "'"))
+                (begin (advance!) (advance!) (read-string! (str acc "'")))
+                (begin (advance!) acc)))
             (true
-             (let ((ch (cur-byte)))
-               (begin
-                 (advance!)
-                 (read-string! (str acc ch))))))))
-
-      (define skip-line!
-        (fn ()
-          (when (and (< pos src-len) (not (cur-sw? "\n")))
-            (begin
-              (advance!)
-              (skip-line!)))))
-
-      (define scan!
-        (fn ()
-          (when (< pos src-len)
-            (let ((ch (cur-byte)))
+              (let
+                ((ch (cur-byte)))
+                (begin (advance!) (read-string! (str acc ch))))))))
+      (define
+        skip-line!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (not (cur-sw? "\n")))
+            (begin (advance!) (skip-line!)))))
+      (define
+        scan!
+        (fn
+          ()
+          (when
+            (< pos src-len)
+            (let
+              ((ch (cur-byte)))
               (cond
                 ((or (= ch " ") (= ch "\t") (= ch "\r"))
-                 (begin (advance!) (scan!)))
+                  (begin (advance!) (scan!)))
                 ((= ch "\n")
-                 (begin (advance!) (tok-push! :newline nil) (scan!)))
-                ((cur-sw? "⍝")
-                 (begin (skip-line!) (scan!)))
+                  (begin (advance!) (tok-push! :newline nil) (scan!)))
+                ((cur-sw? "⍝") (begin (skip-line!) (scan!)))
                 ((cur-sw? "⋄")
-                 (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
+                  (begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
                 ((= ch "(")
-                 (begin (advance!) (tok-push! :lparen nil) (scan!)))
+                  (begin (advance!) (tok-push! :lparen nil) (scan!)))
                 ((= ch ")")
-                 (begin (advance!) (tok-push! :rparen nil) (scan!)))
+                  (begin (advance!) (tok-push! :rparen nil) (scan!)))
                 ((= ch "[")
-                 (begin (advance!) (tok-push! :lbracket nil) (scan!)))
+                  (begin (advance!) (tok-push! :lbracket nil) (scan!)))
                 ((= ch "]")
-                 (begin (advance!) (tok-push! :rbracket nil) (scan!)))
+                  (begin (advance!) (tok-push! :rbracket nil) (scan!)))
                 ((= ch "{")
-                 (begin (advance!) (tok-push! :lbrace nil) (scan!)))
+                  (begin (advance!) (tok-push! :lbrace nil) (scan!)))
                 ((= ch "}")
-                 (begin (advance!) (tok-push! :rbrace nil) (scan!)))
+                  (begin (advance!) (tok-push! :rbrace nil) (scan!)))
                 ((= ch ";")
-                 (begin (advance!) (tok-push! :semi nil) (scan!)))
+                  (begin (advance!) (tok-push! :semi nil) (scan!)))
                 ((cur-sw? "←")
-                 (begin (consume! "←") (tok-push! :assign nil) (scan!)))
+                  (begin (consume! "←") (tok-push! :assign nil) (scan!)))
                 ((= ch ":")
-                 (let ((start pos))
-                   (begin
-                     (advance!)
-                     (if (and (< pos src-len) (apl-alpha? (cur-byte)))
-                       (begin
-                         (read-ident-cont!)
-                         (tok-push! :keyword (slice source start pos)))
-                       (tok-push! :colon nil))
-                     (scan!))))
-                ((and (cur-sw? "¯")
-                      (< (+ pos (len "¯")) src-len)
-                      (apl-digit? (nth source (+ pos (len "¯")))))
-                 (begin
-                   (consume! "¯")
-                   (let ((digits (read-digits! "")))
-                     (if (and (< pos src-len) (= (cur-byte) ".")
-                              (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
-                       (begin (advance!)
-                              (let ((frac (read-digits! "")))
-                                (tok-push! :num (- 0 (string->number (str digits "." frac))))))
-                       (tok-push! :num (- 0 (parse-int digits 0)))))
-                   (scan!)))
+                  (let
+                    ((start pos))
+                    (begin
+                      (advance!)
+                      (if
+                        (and (< pos src-len) (apl-alpha? (cur-byte)))
+                        (begin
+                          (read-ident-cont!)
+                          (tok-push! :keyword (slice source start pos)))
+                        (tok-push! :colon nil))
+                      (scan!))))
+                ((and (cur-sw? "¯") (< (+ pos (len "¯")) src-len) (apl-digit? (nth source (+ pos (len "¯")))))
+                  (begin
+                    (consume! "¯")
+                    (let
+                      ((digits (read-digits! "")))
+                      (if
+                        (and
+                          (< pos src-len)
+                          (= (cur-byte) ".")
+                          (< (+ pos 1) src-len)
+                          (apl-digit? (nth source (+ pos 1))))
+                        (begin
+                          (advance!)
+                          (let
+                            ((frac (read-digits! "")))
+                            (tok-push!
+                              :num (- 0 (string->number (str digits "." frac))))))
+                        (tok-push! :num (- 0 (parse-int digits 0)))))
+                    (scan!)))
                 ((apl-digit? ch)
-                 (begin
-                   (let ((digits (read-digits! "")))
-                     (if (and (< pos src-len) (= (cur-byte) ".")
-                              (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
-                       (begin (advance!)
-                              (let ((frac (read-digits! "")))
-                                (tok-push! :num (string->number (str digits "." frac)))))
-                       (tok-push! :num (parse-int digits 0))))
-                   (scan!)))
+                  (begin
+                    (let
+                      ((digits (read-digits! "")))
+                      (if
+                        (and
+                          (< pos src-len)
+                          (= (cur-byte) ".")
+                          (< (+ pos 1) src-len)
+                          (apl-digit? (nth source (+ pos 1))))
+                        (begin
+                          (advance!)
+                          (let
+                            ((frac (read-digits! "")))
+                            (tok-push!
+                              :num (string->number (str digits "." frac)))))
+                        (tok-push! :num (parse-int digits 0))))
+                    (scan!)))
                 ((= ch "'")
-                 (begin
-                   (advance!)
-                   (let ((s (read-string! "")))
-                     (tok-push! :str s))
-                   (scan!)))
+                  (begin
+                    (advance!)
+                    (let ((s (read-string! ""))) (tok-push! :str s))
+                    (scan!)))
                 ((or (apl-alpha? ch) (cur-sw? "⎕"))
-                 (let ((start pos))
-                   (begin
-                     (if (cur-sw? "⎕") (consume! "⎕") (advance!))
-                     (if (and (< pos src-len) (cur-sw? "←"))
-                       (consume! "←")
-                       (read-ident-cont!))
-                     (tok-push! :name (slice source start pos))
-                     (scan!))))
+                  (let
+                    ((start pos))
+                    (begin
+                      (if
+                        (cur-sw? "⎕")
+                        (begin
+                          (consume! "⎕")
+                          (if
+                            (and (< pos src-len) (cur-sw? "←"))
+                            (consume! "←")
+                            (read-ident-cont!)))
+                        (begin (advance!) (read-ident-cont!)))
+                      (tok-push! :name (slice source start pos))
+                      (scan!))))
                 (true
-                 (let ((g (find-glyph)))
-                   (if g
-                     (begin (consume! g) (tok-push! :glyph g) (scan!))
-                     (begin (advance!) (scan!))))))))))
-
+                  (let
+                    ((g (find-glyph)))
+                    (if
+                      g
+                      (begin (consume! g) (tok-push! :glyph g) (scan!))
+                      (begin (advance!) (scan!))))))))))
       (scan!)
       tokens)))

lib/apl/transpile.sx

@@ -46,6 +46,9 @@
       ((= g "⍕") apl-quad-fmt)
       ((= g "⎕FMT") apl-quad-fmt)
       ((= g "⎕←") apl-quad-print)
+      ((= g "⍸") apl-where)
+      ((= g "∪") apl-unique)
+      ((= g "⍎") apl-execute)
       (else (error "no monadic fn for glyph")))))
 
 (define
@@ -90,6 +93,12 @@
       ((= g "⍉") apl-transpose-dyadic)
       ((= g "⊢") (fn (a b) b))
       ((= g "⊣") (fn (a b) a))
+      ((= g "⍸") apl-interval-index)
+      ((= g "∪") apl-union)
+      ((= g "∩") apl-intersect)
+      ((= g "⊥") apl-decode)
+      ((= g "⊤") apl-encode)
+      ((= g "⊆") apl-partition)
       (else (error "no dyadic fn for glyph")))))
 
 (define
@@ -124,7 +133,14 @@
               ((vals (map (fn (n) (apl-eval-ast n env)) items)))
               (make-array
                 (list (len vals))
-                (map (fn (v) (first (get v :ravel))) vals)))))
+                (map
+                  (fn
+                    (v)
+                    (if
+                      (= (len (get v :shape)) 0)
+                      (first (get v :ravel))
+                      v))
+                  vals)))))
         ((= tag :name)
           (let
             ((nm (nth node 1)))
@@ -566,3 +582,11 @@
 (define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
 
 (define apl-run-file (fn (path) (apl-run (file-read path))))
+
+(define
+  apl-execute
+  (fn
+    (arr)
+    (let
+      ((src (cond ((string? arr) arr) ((scalar? arr) (disclose arr)) (else (reduce str "" (get arr :ravel))))))
+      (apl-run src))))

lib/artdag/analyze.sx

@@ -0,0 +1,88 @@
+; lib/artdag/analyze.sx — Phase 2: Analyze on Datalog.
+; Project the DAG's edges into a Datalog db and answer dependency questions
+; (deps, dependents, transitive reachability) plus dirty-closure propagation
+; as recursive Datalog — the acl/relations reachability shape. Depends on
+; lib/artdag/dag.sx and the lib/datalog/ public API.
+
+; edge(input-id, node-id): data flows input -> node (input is a dependency).
+(define
+  artdag/edge-facts
+  (fn
+    (dag)
+    (reduce
+      (fn
+        (acc id)
+        (concat
+          acc
+          (map
+            (fn (in) (list (quote edge) in id))
+            (artdag/node-inputs (artdag/dag-get dag id)))))
+      (list)
+      (keys (artdag/dag-nodes dag)))))
+
+; reachable(X,Y): Y is a transitive dependent of X (forward, downstream).
+(define
+  artdag/reach-rules
+  (quote
+    ((reachable X Y <- (edge X Y))
+      (reachable X Z <- (edge X Y) (reachable Y Z)))))
+
+(define
+  artdag/analyze
+  (fn (dag) (dl-program-data (artdag/edge-facts dag) artdag/reach-rules)))
+
+; pull a single variable's bindings out of a subst list, sorted for determinism.
+(define
+  artdag/-bindings
+  (fn
+    (substs var)
+    (artdag/sort-strings (map (fn (s) (get s var)) substs))))
+
+; direct dependencies (inputs) of a node.
+(define
+  artdag/deps-of
+  (fn
+    (db id)
+    (artdag/-bindings (dl-query db (list (quote edge) (quote X) id)) :X)))
+
+; direct dependents of a node.
+(define
+  artdag/dependents-of
+  (fn
+    (db id)
+    (artdag/-bindings (dl-query db (list (quote edge) id (quote Y))) :Y)))
+
+; transitive dependents (everything downstream of a node).
+(define
+  artdag/reachable-from
+  (fn
+    (db id)
+    (artdag/-bindings
+      (dl-query db (list (quote reachable) id (quote Y)))
+      :Y)))
+
+; transitive dependencies (everything upstream of a node).
+(define
+  artdag/ancestors-of
+  (fn
+    (db id)
+    (artdag/-bindings
+      (dl-query db (list (quote reachable) (quote X) id))
+      :X)))
+
+; dirty propagation: dirty(Y) :- edge(X,Y), dirty(X). Seeds are changed nodes.
+(define artdag/dirty-rules (quote ((dirty Y <- (edge X Y) (dirty X)))))
+
+(define
+  artdag/dirty-seeds
+  (fn (changed) (map (fn (c) (list (quote dirty) c)) changed)))
+
+; transitive dirty closure of a set of changed node-ids: the changed nodes plus
+; every transitive dependent that must recompute. Sorted, deduplicated.
+(define
+  artdag/dirty-closure
+  (fn
+    (dag changed)
+    (let
+      ((db (dl-program-data (concat (artdag/edge-facts dag) (artdag/dirty-seeds changed)) artdag/dirty-rules)))
+      (artdag/-bindings (dl-query db (list (quote dirty) (quote X))) :X))))

lib/artdag/api.sx

@@ -0,0 +1,91 @@
+; lib/artdag/api.sx — public API index for the artdag content-addressed dataflow
+; DAG engine. Reference-only: `load` is an epoch-protocol command, not an SX
+; function, so this file cannot reload the modules from inside another `.sx`. To
+; set up a session, issue these loads in order (after spec/stdlib.sx + lib/r7rs.sx,
+; the lib/datalog/* modules, and the lib/persist/* modules):
+;
+;   (load "lib/artdag/dag.sx")
+;   (load "lib/artdag/analyze.sx")      ; requires lib/datalog/*
+;   (load "lib/artdag/plan.sx")
+;   (load "lib/artdag/execute.sx")      ; requires lib/persist/*
+;   (load "lib/artdag/optimize.sx")
+;   (load "lib/artdag/federation.sx")
+;   (load "lib/artdag/cost.sx")
+;   (load "lib/artdag/serialize.sx")
+;   (load "lib/artdag/stats.sx")
+;   (load "lib/artdag/fault.sx")
+;
+; (lib/artdag/conformance.sh runs this load list automatically.)
+;
+; ── Public API surface ─────────────────────────────────────────────
+;
+;   Model / content addressing (dag.sx):
+;     (artdag/node op inputs params)        node spec (non-commutative)
+;     (artdag/cnode op inputs params)       commutative node spec
+;     (artdag/content-id node)              structural digest "node:..."
+;     (artdag/build entries)                {:ok :nodes :names :order} | {:ok false :error}
+;       entry = (name op (input-names...) params [commutative?])
+;     (artdag/dag-id dag name)              local name -> content-id
+;     (artdag/dag-get dag id)               content-id -> node
+;     (artdag/dag-node-by-name dag name)    name -> node
+;     (artdag/dag-order dag)                topo-ordered content-ids
+;     (artdag/node-count dag)               distinct node count
+;
+;   Analyze on Datalog (analyze.sx):
+;     (artdag/analyze dag)                  -> datalog db
+;     (artdag/deps-of db id)                direct dependencies
+;     (artdag/dependents-of db id)          direct dependents
+;     (artdag/reachable-from db id)         transitive dependents
+;     (artdag/ancestors-of db id)           transitive dependencies
+;     (artdag/dirty-closure dag changed)    changed nodes + all dependents
+;
+;   Plan (plan.sx):
+;     (artdag/plan dag cap)                 topo batches under width cap (0 = unlimited)
+;     (artdag/plan-dirty dag changed cap)   incremental plan over the dirty closure
+;     (artdag/plan-batches/-width/-size/-flatten plan)
+;
+;   Execute (execute.sx):
+;     (artdag/op-table-runner table)        runner from op-name -> (fn (params inputs))
+;     (artdag/run dag runner cache)         full memoized run
+;     (artdag/run-dirty dag changed runner cache)
+;     (artdag/execute dag plan runner cache) -> {:results :recomputed :hits}
+;     (artdag/result-of/recompute-count/hit-count/recomputed exec)
+;       cache = a lib/persist kv backend (persist/open)
+;
+;   Optimize (optimize.sx):
+;     (artdag/dce dag outputs)              drop nodes not feeding the outputs
+;     (artdag/cse entries)                  == build (sharing is free from content ids)
+;     (artdag/fuse entries fusible?)        collapse fusible unary chains -> pipeline nodes
+;     (artdag/fusing-runner base-runner)    runner that replays pipeline stages
+;     (artdag/optimize entries outputs fusible?)  fuse then dce
+;
+;   Federation (federation.sx):
+;     (artdag/fed-open)                     {:cache :prov}
+;     (artdag/fed-run fed dag runner)       run against the instance cache
+;     (artdag/fed-export fed peer-id)       bundle of {:cid :result :peer}
+;     (artdag/fed-import fed bundle trusted?)  trust-gated import + provenance
+;     (artdag/fed-pull fed fetch-fn peer-id trusted?)  pull via injected transport
+;     (artdag/fed-invalidate fed peer-id)   drop a peer's results (peer-scoped)
+;
+;   Cost / scheduling (cost.sx):
+;     (artdag/const-cost) (artdag/op-cost table)   cost-fn (op params) -> number
+;     (artdag/critical-path dag cost-fn)    longest weighted path
+;     (artdag/makespan dag plan cost-fn)    estimated wall-clock under a plan
+;     (artdag/total-work dag cost-fn) (artdag/speedup dag plan cost-fn)
+;
+;   Serialize (serialize.sx):
+;     (artdag/dag->wire dag) (artdag/wire->dag records)  portable record form
+;     (artdag/wire-verify records)          content-id integrity check
+;     (artdag/dag->string dag) (artdag/string->dag s)    text transport
+;
+;   Stats (stats.sx):
+;     (artdag/hit-ratio exec)
+;     (artdag/work-recomputed/work-saved exec dag cost-fn)
+;     (artdag/savings-ratio exec dag cost-fn) (artdag/exec-summary exec dag cost-fn)
+;
+;   Fault tolerance (fault.sx):
+;     (artdag/fail reason) (artdag/failed? v)
+;     (artdag/run-safe dag runner cache)    -> {:results :recomputed :hits :failed}
+;     (artdag/failed-nodes/failure-count/all-ok? exec)
+
+(define artdag/version "1.0")

lib/artdag/conformance.sh

@@ -0,0 +1,179 @@
+#!/usr/bin/env bash
+# lib/artdag/conformance.sh — run artdag test suites, emit scoreboard.json + scoreboard.md.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found." >&2
+  exit 1
+fi
+
+SUITES=(dag analyze plan execute optimize fed cost serialize stats fault post maude-optimize schedule)
+
+OUT_JSON="lib/artdag/scoreboard.json"
+OUT_MD="lib/artdag/scoreboard.md"
+
+run_suite() {
+  local suite=$1
+  local file="lib/artdag/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  local MAUDE_LOADS=""
+  local BRIDGE_LOAD=""
+  local MK_LOADS=""
+  local SCHED_LOAD=""
+  if [ "$suite" = "schedule" ]; then
+    MK_LOADS='(load "lib/guest/match.sx")
+(load "lib/minikanren/unify.sx")
+(load "lib/minikanren/stream.sx")
+(load "lib/minikanren/goals.sx")
+(load "lib/minikanren/fresh.sx")
+(load "lib/minikanren/conde.sx")
+(load "lib/minikanren/run.sx")
+(load "lib/minikanren/relations.sx")
+(load "lib/minikanren/project.sx")
+(load "lib/minikanren/diseq.sx")
+(load "lib/minikanren/intarith.sx")
+(load "lib/minikanren/matche.sx")
+(load "lib/minikanren/defrel.sx")
+(load "lib/minikanren/nafc.sx")
+(load "lib/minikanren/fd.sx")
+(load "lib/minikanren/clpfd.sx")'
+    SCHED_LOAD='(load "lib/artdag/schedule.sx")'
+  fi
+  if [ "$suite" = "maude-optimize" ]; then
+    MAUDE_LOADS='(load "lib/guest/lex.sx")
+(load "lib/guest/pratt.sx")
+(load "lib/maude/term.sx")
+(load "lib/maude/parser.sx")
+(load "lib/maude/sorts.sx")
+(load "lib/maude/reduce.sx")
+(load "lib/maude/matching.sx")
+(load "lib/maude/conditional.sx")
+(load "lib/maude/fire.sx")
+(load "lib/maude/confluence.sx")
+(load "lib/maude/rewrite.sx")
+(load "lib/maude/searchpath.sx")
+(load "lib/maude/strategy.sx")
+(load "lib/maude/meta.sx")
+(load "lib/maude/pretty.sx")
+(load "lib/maude/run.sx")'
+    BRIDGE_LOAD='(load "lib/artdag/maude-bridge.sx")
+(load "lib/artdag/optimize-rules.sx")'
+  fi
+  cat > "$TMP" << EPOCHS
+(epoch 1)
+(load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
+(load "lib/datalog/tokenizer.sx")
+(load "lib/datalog/parser.sx")
+(load "lib/datalog/unify.sx")
+(load "lib/datalog/db.sx")
+(load "lib/datalog/builtins.sx")
+(load "lib/datalog/aggregates.sx")
+(load "lib/datalog/strata.sx")
+(load "lib/datalog/eval.sx")
+(load "lib/datalog/api.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/persist/api.sx")
+${MAUDE_LOADS}
+${MK_LOADS}
+(load "lib/artdag/dag.sx")
+(load "lib/artdag/analyze.sx")
+(load "lib/artdag/plan.sx")
+(load "lib/artdag/execute.sx")
+(load "lib/artdag/optimize.sx")
+(load "lib/artdag/federation.sx")
+(load "lib/artdag/cost.sx")
+(load "lib/artdag/serialize.sx")
+(load "lib/artdag/stats.sx")
+(load "lib/artdag/fault.sx")
+(load "lib/artdag/post.sx")
+(load "lib/artdag/api.sx")
+${BRIDGE_LOAD}
+${SCHED_LOAD}
+(epoch 2)
+(eval "(define artdag-test-pass 0)")
+(eval "(define artdag-test-fail 0)")
+(eval "(define artdag-test (fn (name got expected) (if (= got expected) (set! artdag-test-pass (+ artdag-test-pass 1)) (set! artdag-test-fail (+ artdag-test-fail 1)))))")
+(epoch 3)
+(load "${file}")
+(epoch 4)
+(eval "(list artdag-test-pass artdag-test-fail)")
+EPOCHS
+
+  local OUTPUT
+  OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
+  rm -f "$TMP"
+
+  local LINE
+  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
+  if [ -z "$LINE" ]; then
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
+            | sed -E 's/^\(ok 4 //; s/\)$//')
+  fi
+
+  local P F
+  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
+  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
+  P=${P:-0}
+  F=${F:-0}
+  echo "${P} ${F}"
+}
+
+declare -A SUITE_PASS
+declare -A SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running artdag conformance suite..." >&2
+for s in "${SUITES[@]}"; do
+  read -r p f < <(run_suite "$s")
+  SUITE_PASS[$s]=$p
+  SUITE_FAIL[$s]=$f
+  TOTAL_PASS=$((TOTAL_PASS + p))
+  TOTAL_FAIL=$((TOTAL_FAIL + f))
+  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
+done
+
+{
+  printf '{\n'
+  printf '  "suites": {\n'
+  first=1
+  for s in "${SUITES[@]}"; do
+    if [ $first -eq 0 ]; then printf ',\n'; fi
+    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
+    first=0
+  done
+  printf '\n  },\n'
+  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
+  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
+  printf '}\n'
+} > "$OUT_JSON"
+
+{
+  printf '# artdag Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/artdag/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    p=${SUITE_PASS[$s]}
+    f=${SUITE_FAIL[$s]}
+    printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_MD"
+
+echo "Wrote $OUT_JSON and $OUT_MD" >&2
+echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
+
+[ "$TOTAL_FAIL" -eq 0 ]

lib/artdag/cost.sx

@@ -0,0 +1,66 @@
+; lib/artdag/cost.sx — cost model for the scheduler: per-node weights, critical
+; path (min makespan with unlimited parallelism), plan makespan under batching/cap,
+; total serial work, and the resulting speedup. Costs come from an injected
+; cost-fn (op params) -> number so media-op costs stay opaque. Depends on dag.sx.
+
+(define artdag/const-cost (fn (op params) 1))
+
+(define
+  artdag/op-cost
+  (fn
+    (table)
+    (fn (op params) (if (has-key? table op) (get table op) 1))))
+
+(define
+  artdag/-node-cost
+  (fn
+    (dag cost-fn id)
+    (let
+      ((n (artdag/dag-get dag id)))
+      (cost-fn (artdag/node-op n) (artdag/node-params n)))))
+
+(define
+  artdag/-max
+  (fn (xs) (reduce (fn (mx x) (if (> x mx) x mx)) 0 xs)))
+
+; longest weighted path through the dag = makespan with unlimited workers.
+(define
+  artdag/critical-path
+  (fn
+    (dag cost-fn)
+    (let
+      ((ft (reduce (fn (m id) (let ((maxdep (artdag/-max (map (fn (d) (get m d)) (artdag/node-inputs (artdag/dag-get dag id)))))) (assoc m id (+ (artdag/-node-cost dag cost-fn id) maxdep)))) {} (artdag/dag-order dag))))
+      (artdag/-max (map (fn (id) (get ft id)) (keys ft))))))
+
+; estimated wall-clock for a plan: each batch runs in parallel (costs its
+; slowest node), batches run in sequence.
+(define
+  artdag/makespan
+  (fn
+    (dag plan cost-fn)
+    (reduce
+      (fn
+        (total batch)
+        (+
+          total
+          (artdag/-max
+            (map (fn (id) (artdag/-node-cost dag cost-fn id)) batch))))
+      0
+      plan)))
+
+; total serial work = sum of all node costs.
+(define
+  artdag/total-work
+  (fn
+    (dag cost-fn)
+    (reduce
+      (fn (s id) (+ s (artdag/-node-cost dag cost-fn id)))
+      0
+      (keys (artdag/dag-nodes dag)))))
+
+; speedup of a plan vs running everything serially.
+(define
+  artdag/speedup
+  (fn
+    (dag plan cost-fn)
+    (/ (artdag/total-work dag cost-fn) (artdag/makespan dag plan cost-fn))))

lib/artdag/dag.sx

@@ -0,0 +1,226 @@
+; lib/artdag/dag.sx — DAG model + structural content addressing.
+; A node = {:op :inputs :params :commutative}. inputs are content-ids of upstream
+; nodes. The content-id is a deterministic structural digest so identical
+; subgraphs collapse to one id (and one cache slot). No clock, no randomness.
+
+; ---- string ordering (no host sort/string<?) ----
+
+(define
+  artdag/str<?-at
+  (fn
+    (a b i la lb)
+    (cond
+      ((and (>= i la) (>= i lb)) false)
+      ((>= i la) true)
+      ((>= i lb) false)
+      (else
+        (let
+          ((ca (char-code (substring a i (+ i 1))))
+            (cb (char-code (substring b i (+ i 1)))))
+          (cond
+            ((< ca cb) true)
+            ((> ca cb) false)
+            (else (artdag/str<?-at a b (+ i 1) la lb))))))))
+
+(define
+  artdag/str<?
+  (fn
+    (a b)
+    (artdag/str<?-at a b 0 (string-length a) (string-length b))))
+
+(define
+  artdag/insert-string
+  (fn
+    (sorted x)
+    (cond
+      ((empty? sorted) (list x))
+      ((artdag/str<? x (first sorted)) (cons x sorted))
+      (else (cons (first sorted) (artdag/insert-string (rest sorted) x))))))
+
+(define
+  artdag/sort-strings
+  (fn (xs) (reduce (fn (acc x) (artdag/insert-string acc x)) (list) xs)))
+
+; ---- canonical serialization ----
+
+(define
+  artdag/canon-list
+  (fn
+    (xs)
+    (if
+      (empty? xs)
+      ""
+      (reduce
+        (fn (acc x) (str acc " " (artdag/canon x)))
+        (artdag/canon (first xs))
+        (rest xs)))))
+
+(define
+  artdag/canon-dict
+  (fn
+    (d)
+    (str
+      "{"
+      (reduce
+        (fn (acc k) (str acc " " k "=" (artdag/canon (get d k))))
+        ""
+        (artdag/sort-strings (keys d)))
+      "}")))
+
+(define
+  artdag/canon
+  (fn
+    (v)
+    (let
+      ((t (type-of v)))
+      (cond
+        ((equal? t "nil") "nil")
+        ((equal? t "boolean") (if v "#t" "#f"))
+        ((equal? t "number") (number->string v))
+        ((equal? t "string") (str "\"" v "\""))
+        ((equal? t "keyword") (str ":" (keyword-name v)))
+        ((equal? t "symbol") (str "'" (write-to-string v)))
+        ((equal? t "list") (str "(" (artdag/canon-list v) ")"))
+        ((equal? t "dict") (artdag/canon-dict v))
+        (else (str "<" t ">" (write-to-string v)))))))
+
+; ---- node + content id ----
+
+(define artdag/node (fn (op inputs params) {:inputs inputs :commutative false :op op :params params}))
+
+(define artdag/cnode (fn (op inputs params) {:inputs inputs :commutative true :op op :params params}))
+
+(define artdag/node-op (fn (n) (get n :op)))
+(define artdag/node-inputs (fn (n) (get n :inputs)))
+(define artdag/node-params (fn (n) (get n :params)))
+
+(define
+  artdag/content-id
+  (fn
+    (node)
+    (let
+      ((ins (if (get node :commutative) (artdag/sort-strings (get node :inputs)) (get node :inputs))))
+      (str
+        "node:"
+        (artdag/canon (list (get node :op) ins (get node :params)))))))
+
+(define artdag/id-of artdag/content-id)
+
+; ---- list helpers ----
+
+(define artdag/member? (fn (x xs) (some (fn (y) (equal? y x)) xs)))
+
+(define
+  artdag/all-in?
+  (fn (xs placed) (every? (fn (x) (artdag/member? x placed)) xs)))
+
+; ---- build: entries -> validated, content-addressed dag ----
+; entry = (local-name op (input-local-names...) params [commutative?])
+
+(define artdag/entry-name (fn (e) (nth e 0)))
+(define artdag/entry-op (fn (e) (nth e 1)))
+(define artdag/entry-inputs (fn (e) (nth e 2)))
+(define artdag/entry-params (fn (e) (nth e 3)))
+(define
+  artdag/entry-commutative
+  (fn (e) (if (> (len e) 4) (nth e 4) false)))
+
+(define
+  artdag/entries->map
+  (fn
+    (entries)
+    (reduce
+      (fn (m e) (assoc m (artdag/entry-name e) {:inputs (artdag/entry-inputs e) :commutative (artdag/entry-commutative e) :op (artdag/entry-op e) :params (artdag/entry-params e)}))
+      {}
+      entries)))
+
+(define
+  artdag/dangling
+  (fn
+    (spec-map)
+    (reduce
+      (fn
+        (acc name)
+        (reduce
+          (fn (a in) (if (has-key? spec-map in) a (cons in a)))
+          acc
+          (get (get spec-map name) :inputs)))
+      (list)
+      (keys spec-map))))
+
+(define
+  artdag/ready-names
+  (fn
+    (spec-map placed)
+    (filter
+      (fn
+        (name)
+        (and
+          (not (artdag/member? name placed))
+          (artdag/all-in? (get (get spec-map name) :inputs) placed)))
+      (artdag/sort-strings (keys spec-map)))))
+
+(define
+  artdag/topo-loop
+  (fn
+    (spec-map placed)
+    (if
+      (= (len placed) (len (keys spec-map)))
+      {:order placed :ok true}
+      (let
+        ((ready (artdag/ready-names spec-map placed)))
+        (if
+          (empty? ready)
+          {:error "cycle" :ok false}
+          (artdag/topo-loop spec-map (concat placed ready)))))))
+
+(define artdag/topo (fn (spec-map) (artdag/topo-loop spec-map (list))))
+
+(define
+  artdag/resolve-ids
+  (fn
+    (spec-map order)
+    (reduce
+      (fn
+        (dag name)
+        (let
+          ((spec (get spec-map name)))
+          (let
+            ((resolved (map (fn (in) (get (get dag :names) in)) (get spec :inputs))))
+            (let
+              ((node {:inputs resolved :commutative (get spec :commutative) :op (get spec :op) :params (get spec :params)}))
+              (let ((id (artdag/content-id node))) {:names (assoc (get dag :names) name id) :order (if (artdag/member? id (get dag :order)) (get dag :order) (concat (get dag :order) (list id))) :nodes (assoc (get dag :nodes) id node)})))))
+      {:names {} :order (list) :nodes {}}
+      order)))
+
+(define
+  artdag/build
+  (fn
+    (entries)
+    (let
+      ((spec-map (artdag/entries->map entries)))
+      (let
+        ((dang (artdag/dangling spec-map)))
+        (if
+          (not (empty? dang))
+          {:refs dang :error "dangling" :ok false}
+          (let
+            ((topo (artdag/topo spec-map)))
+            (if
+              (not (get topo :ok))
+              {:error (get topo :error) :ok false}
+              (assoc
+                (artdag/resolve-ids spec-map (get topo :order))
+                :ok true))))))))
+
+; ---- dag accessors ----
+
+(define artdag/dag-nodes (fn (dag) (get dag :nodes)))
+(define artdag/dag-names (fn (dag) (get dag :names)))
+(define artdag/dag-order (fn (dag) (get dag :order)))
+(define artdag/dag-id (fn (dag name) (get (get dag :names) name)))
+(define artdag/dag-get (fn (dag id) (get (get dag :nodes) id)))
+(define
+  artdag/dag-node-by-name
+  (fn (dag name) (artdag/dag-get dag (artdag/dag-id dag name))))
+(define artdag/node-count (fn (dag) (len (keys (get dag :nodes)))))

lib/artdag/execute.sx

@@ -0,0 +1,82 @@
+; lib/artdag/execute.sx — Phase 4: interpret a plan with a content-addressed
+; memo cache. A node's result is keyed by its content-id, so a node whose id is
+; already in the cache is skipped (cache hit). Because changing a leaf changes
+; the content-ids of its whole dirty closure, re-running recomputes exactly those
+; nodes and cache-hits the rest — incremental recompute falls out of content
+; addressing. Depends on dag.sx and plan.sx; the cache is a lib/persist/ backend.
+
+; runner: (fn (op params input-results) -> result). The injected effect interface.
+; In production this performs the op (perform -> JAX/IPFS adapter); in tests it
+; dispatches a pure SX op over its already-computed input results.
+
+; build a runner from a dict of op-name -> (fn (params inputs) -> result).
+(define
+  artdag/op-table-runner
+  (fn (table) (fn (op params inputs) ((get table op) params inputs))))
+
+; resolve an input id's result: this run's results first, then the warm cache.
+(define
+  artdag/-input-result
+  (fn
+    (results cache in)
+    (if (has-key? results in) (get results in) (persist/kv-get cache in))))
+
+(define
+  artdag/-exec-node
+  (fn
+    (dag runner cache acc id)
+    (let
+      ((node (artdag/dag-get dag id)))
+      (if
+        (persist/kv-has? cache id)
+        (assoc
+          acc
+          :results (assoc (get acc :results) id (persist/kv-get cache id))
+          :hits (concat (get acc :hits) (list id)))
+        (let
+          ((inputs (map (fn (in) (artdag/-input-result (get acc :results) cache in)) (artdag/node-inputs node))))
+          (let
+            ((result (runner (artdag/node-op node) (artdag/node-params node) inputs)))
+            (begin
+              (persist/kv-put cache id result)
+              (assoc
+                acc
+                :results (assoc (get acc :results) id result)
+                :recomputed (concat (get acc :recomputed) (list id))))))))))
+
+; execute a plan against a memo cache, returning {:results :recomputed :hits}.
+(define
+  artdag/execute
+  (fn
+    (dag plan runner cache)
+    (reduce
+      (fn (acc id) (artdag/-exec-node dag runner cache acc id))
+      {:recomputed (list) :results {} :hits (list)}
+      (artdag/plan-flatten plan))))
+
+; full run over every node, unlimited width.
+(define
+  artdag/run
+  (fn
+    (dag runner cache)
+    (artdag/execute dag (artdag/plan dag 0) runner cache)))
+
+; incremental run: schedule only the dirty closure of the changed nodes.
+(define
+  artdag/run-dirty
+  (fn
+    (dag changed runner cache)
+    (artdag/execute
+      dag
+      (artdag/plan-dirty dag changed 0)
+      runner
+      cache)))
+
+; ---- result inspection ----
+
+(define artdag/result-of (fn (exec id) (get (get exec :results) id)))
+(define
+  artdag/recomputed
+  (fn (exec) (artdag/sort-strings (get exec :recomputed))))
+(define artdag/recompute-count (fn (exec) (len (get exec :recomputed))))
+(define artdag/hit-count (fn (exec) (len (get exec :hits))))

lib/artdag/fault.sx

@@ -0,0 +1,56 @@
+; lib/artdag/fault.sx — fault-tolerant execution. A node op may fail by returning
+; (artdag/fail reason); the failure is confined to that node and its transitive
+; dependents (which cannot run without it), while independent branches still
+; compute. Failed results are NEVER cached, so a later run with the fault fixed
+; recomputes only the failed closure. Depends on execute.sx and plan.sx.
+
+(define artdag/fail (fn (reason) {:artdag-fail true :reason reason}))
+(define artdag/failed? (fn (v) (and (dict? v) (has-key? v :artdag-fail))))
+
+(define
+  artdag/-exec-safe-node
+  (fn
+    (dag runner cache acc id)
+    (let
+      ((node (artdag/dag-get dag id)))
+      (let
+        ((ins (artdag/node-inputs node)))
+        (if
+          (some (fn (in) (artdag/member? in (get acc :failed))) ins)
+          (assoc acc :failed (concat (get acc :failed) (list id)))
+          (if
+            (persist/kv-has? cache id)
+            (assoc
+              acc
+              :results (assoc (get acc :results) id (persist/kv-get cache id))
+              :hits (concat (get acc :hits) (list id)))
+            (let
+              ((inputs (map (fn (in) (artdag/-input-result (get acc :results) cache in)) ins)))
+              (let
+                ((result (runner (artdag/node-op node) (artdag/node-params node) inputs)))
+                (if
+                  (artdag/failed? result)
+                  (assoc acc :failed (concat (get acc :failed) (list id)))
+                  (begin
+                    (persist/kv-put cache id result)
+                    (assoc
+                      acc
+                      :results (assoc (get acc :results) id result)
+                      :recomputed (concat (get acc :recomputed) (list id)))))))))))))
+
+(define
+  artdag/run-safe
+  (fn
+    (dag runner cache)
+    (reduce
+      (fn (acc id) (artdag/-exec-safe-node dag runner cache acc id))
+      {:recomputed (list) :results {} :hits (list) :failed (list)}
+      (artdag/plan-flatten (artdag/plan dag 0)))))
+
+(define
+  artdag/failed-nodes
+  (fn (exec) (artdag/sort-strings (get exec :failed))))
+(define artdag/failure-count (fn (exec) (len (get exec :failed))))
+(define
+  artdag/all-ok?
+  (fn (exec) (= (len (get exec :failed)) 0)))

lib/artdag/federation.sx

@@ -0,0 +1,75 @@
+; lib/artdag/federation.sx — Phase 6: shared content-addressed cache across
+; instances (the L2-registry analog). Because content-ids are global, a result
+; computed on one instance is reusable on another by id. Imports are trust-gated
+; and carry provenance so a peer's results can be invalidated when trust is
+; withdrawn. Transport is injected (mock in tests). Depends on dag.sx, execute.sx
+; (the cache is a lib/persist/ kv backend) — federation tracks provenance beside it.
+
+; an instance: a persist kv cache + a provenance map {cid -> origin-peer}.
+(define artdag/fed-open (fn () {:cache (persist/open) :prov {}}))
+(define artdag/fed-cache (fn (fed) (get fed :cache)))
+(define artdag/fed-prov (fn (fed) (get fed :prov)))
+
+(define
+  artdag/-dict-remove
+  (fn
+    (d key)
+    (reduce
+      (fn (acc k) (if (= k key) acc (assoc acc k (get d k))))
+      {}
+      (keys d))))
+
+; export every cached result as a bundle of {:cid :result :peer}, tagged with
+; the exporting instance's peer id (the result's origin/provenance).
+(define
+  artdag/fed-export
+  (fn
+    (fed peer-id)
+    (map (fn (cid) {:peer peer-id :cid cid :result (persist/kv-get (get fed :cache) cid)}) (persist/kv-keys (get fed :cache)))))
+
+; import a bundle, accepting only records from trusted peers (trust gating) and
+; recording each accepted result's provenance. Returns the updated instance.
+(define
+  artdag/fed-import
+  (fn
+    (fed bundle trusted?)
+    (reduce
+      (fn
+        (f rec)
+        (if
+          (trusted? (get rec :peer))
+          (begin
+            (persist/kv-put (get f :cache) (get rec :cid) (get rec :result))
+            {:cache (get f :cache) :prov (assoc (get f :prov) (get rec :cid) (get rec :peer))})
+          f))
+      fed
+      bundle)))
+
+; pull from a peer through an injected transport (fetch-fn peer-id -> bundle).
+(define
+  artdag/fed-pull
+  (fn
+    (fed fetch-fn peer-id trusted?)
+    (artdag/fed-import fed (fetch-fn peer-id) trusted?)))
+
+; invalidate: drop every cached result provenanced to a peer (trust withdrawn),
+; from both the cache and the provenance map. Locally-computed results (no
+; provenance) are untouched. Returns the updated instance.
+(define
+  artdag/fed-invalidate
+  (fn
+    (fed peer-id)
+    (reduce
+      (fn
+        (f cid)
+        (if
+          (= (get (get f :prov) cid) peer-id)
+          (begin (persist/kv-delete (get f :cache) cid) {:cache (get f :cache) :prov (artdag/-dict-remove (get f :prov) cid)})
+          f))
+      fed
+      (keys (get fed :prov)))))
+
+; convenience: run a dag against an instance's cache.
+(define
+  artdag/fed-run
+  (fn (fed dag runner) (artdag/run dag runner (artdag/fed-cache fed))))

lib/artdag/maude-bridge.sx

@@ -0,0 +1,118 @@
+; lib/artdag/maude-bridge.sx — adapter between an artdag effect DAG and maude terms.
+; A node {:op :inputs :params :commutative} <-> a maude (mau/app op (args...)).
+; Inputs become argument subterms (recursively from the DAG). A trailing
+; "artdag:meta" subterm carries the params (a write-to-string token) and the
+; commutativity flag, so the encoding is lossless and dag->term->dag is the
+; identity on canonical (content-id) form. Commutative ops map to maude AC
+; operators in the optimizer module, so input order is irrelevant there —
+; mirroring the content-id's order-insensitivity for commutative nodes.
+;
+; maude (lib/maude) is a READ-ONLY consumed substrate: mau/app, mau/const,
+; mau/op, mau/args, mau/app? are its term constructors/accessors.
+
+; ---- list helpers (no host last/but-last) ----
+
+(define
+  artdag/mb-last
+  (fn
+    (xs)
+    (if (empty? (rest xs)) (first xs) (artdag/mb-last (rest xs)))))
+
+(define
+  artdag/mb-but-last
+  (fn
+    (xs)
+    (if
+      (empty? (rest xs))
+      (list)
+      (cons (first xs) (artdag/mb-but-last (rest xs))))))
+
+; ---- params <-> token ----
+; params are keyword-keyed dicts; write-to-string/read round-trips them
+; (key order may differ but the dicts compare structurally equal).
+
+(define artdag/mb-meta-op "artdag:meta")
+
+(define artdag/params->token (fn (params) (write-to-string params)))
+
+(define artdag/token->params (fn (token) (read (open-input-string token))))
+
+(define
+  artdag/mb-meta-term
+  (fn
+    (params commutative)
+    (mau/app
+      artdag/mb-meta-op
+      (list
+        (mau/const (artdag/params->token params))
+        (mau/const (if commutative "c" "n"))))))
+
+(define
+  artdag/mb-meta-term?
+  (fn (t) (and (mau/app? t) (= (mau/op t) artdag/mb-meta-op))))
+
+; ---- dag -> term ----
+
+(define
+  artdag/node->term
+  (fn
+    (node input-terms)
+    (mau/app
+      (artdag/node-op node)
+      (concat
+        input-terms
+        (list
+          (artdag/mb-meta-term
+            (artdag/node-params node)
+            (get node :commutative)))))))
+
+(define
+  artdag/dag->term
+  (fn
+    (dag id)
+    (let
+      ((node (artdag/dag-get dag id)))
+      (artdag/node->term
+        node
+        (map (fn (in) (artdag/dag->term dag in)) (artdag/node-inputs node))))))
+
+; ---- term -> dag ----
+; build-entries with synthesized local names; artdag/build recomputes content-ids
+; (which are name-independent), so the reconstructed dag is identical on canonical
+; form. Shared subterms re-collapse to one node/id during build's dedup.
+
+(define artdag/term-meta (fn (t) (artdag/mb-last (mau/args t))))
+
+(define artdag/term-input-terms (fn (t) (artdag/mb-but-last (mau/args t))))
+
+(define
+  artdag/term-params
+  (fn
+    (t)
+    (artdag/token->params (mau/op (first (mau/args (artdag/term-meta t)))))))
+
+(define
+  artdag/term-commutative
+  (fn
+    (t)
+    (= "c" (mau/op (nth (mau/args (artdag/term-meta t)) 1)))))
+
+(define
+  artdag/term->build
+  (fn
+    (t counter acc)
+    (let
+      ((built (reduce (fn (st child) (let ((r (artdag/term->build child (get st :counter) (get st :acc)))) {:counter (get r :counter) :acc (get r :acc) :names (concat (get st :names) (list (get r :name)))})) {:counter counter :acc acc :names (list)} (artdag/term-input-terms t))))
+      (let ((my-name (str "mb" (get built :counter)))) {:name my-name :counter (+ (get built :counter) 1) :acc (concat (get built :acc) (list (list my-name (mau/op t) (get built :names) (artdag/term-params t) (artdag/term-commutative t))))}))))
+
+(define
+  artdag/term->entries
+  (fn (t) (get (artdag/term->build t 0 (list)) :acc)))
+
+(define artdag/term->dag (fn (t) (artdag/build (artdag/term->entries t))))
+
+; ---- round-trip convenience ----
+
+(define
+  artdag/mb-roundtrip
+  (fn (dag id) (artdag/term->dag (artdag/dag->term dag id))))

lib/artdag/optimize-rules.sx

@@ -0,0 +1,213 @@
+; lib/artdag/optimize-rules.sx — Phase 7: optimisation laws as a confluent maude module.
+; The optimised effect pipeline IS the normal form of the rule set, so confluence
+; (mau/confluent?) is exactly content-id stability: every rewrite order reaches the
+; same normal form. Media ops (blur/bright/id/over) are the opaque-op model from
+; lib/maude/tests/effects.sx — the engine reasons about the pipeline algebra, never
+; pixels. The radius algebra is an AC operator with identity 0 (unary 1s): Peano
+; successor rules (s M + N = s(M+N), 0 + N = N) are NOT confluent here (the symbolic
+; critical pairs M + 0 and (A+B)+C vs A+(B+C) stick), whereas [assoc comm id: 0]
+; joins them via canonical form. maude (lib/maude) is a READ-ONLY consumed substrate:
+; mau/parse-module, mau/creduce, mau/creduce->str, mau/ccanon, mau/confluent?,
+; mau/non-joinable-pairs, mau/cp->str, mau/app/const/op/args/app?.
+
+(define
+  artdag/opt-module-src
+  (str
+    "fmod ARTDAGOPT is\n"
+    "  sorts Img Num .\n"
+    "  op 0 : -> Num .\n"
+    "  op 1 : -> Num .\n"
+    "  op _+_ : Num Num -> Num [assoc comm id: 0] .\n"
+    "  op blur : Img Num -> Img .\n"
+    "  op bright : Img Num -> Img .\n"
+    "  op id : Img -> Img .\n"
+    "  op over : Img Img -> Img [comm] .\n"
+    "  vars I J : Img .\n"
+    "  vars M N : Num .\n"
+    "  eq id(I) = I .\n"
+    "  eq blur(I, 0) = I .\n"
+    "  eq bright(I, 0) = I .\n"
+    "  eq blur(blur(I, M), N) = blur(I, M + N) .\n"
+    "  eq bright(bright(I, M), N) = bright(I, M + N) .\n"
+    "  eq over(I, I) = I .\n"
+    "endfm"))
+
+(define artdag/opt-module (mau/parse-module artdag/opt-module-src))
+
+; ops whose last term arg is the radius (Num); other args are image inputs.
+(define artdag/opt-radius-ops (list "blur" "bright"))
+; commutative ops (mirror the content-id's order-insensitivity).
+(define artdag/opt-comm-ops (list "over"))
+
+; ---- reduce a surface pipeline (source string) to its optimised normal form ----
+
+(define
+  artdag/opt-reduce-term
+  (fn (src) (mau/creduce-term artdag/opt-module src)))
+
+(define
+  artdag/opt-normal-form
+  (fn (src) (mau/creduce->str artdag/opt-module src)))
+
+(define artdag/opt-canon (fn (src) (mau/ccanon artdag/opt-module src)))
+
+; two surface pipelines optimise to the same pipeline (=> same content id) iff
+; their normal forms coincide.
+(define
+  artdag/opt-same-form?
+  (fn (a b) (= (artdag/opt-normal-form a) (artdag/opt-normal-form b))))
+
+; ---- confluence / content-id stability (consume lib/maude/confluence.sx) ----
+
+(define artdag/opt-confluent? (fn () (mau/confluent? artdag/opt-module)))
+
+(define
+  artdag/opt-non-joinable
+  (fn () (mau/non-joinable-pairs artdag/opt-module)))
+
+(define
+  artdag/opt-non-joinable->strs
+  (fn
+    ()
+    (map
+      (fn (cp) (mau/cp->str artdag/opt-module cp))
+      (artdag/opt-non-joinable))))
+
+; ---- radius <-> unary Num term ----
+
+(define
+  artdag/num->unary
+  (fn
+    (n)
+    (if
+      (<= n 0)
+      (mau/const "0")
+      (reduce
+        (fn (acc i) (mau/app "_+_" (list acc (mau/const "1"))))
+        (mau/const "1")
+        (range 1 n)))))
+
+(define
+  artdag/unary->num
+  (fn
+    (t)
+    (let
+      ((op (mau/op t)))
+      (cond
+        ((= op "1") 1)
+        ((= op "_+_")
+          (reduce
+            (fn (a x) (+ a (artdag/unary->num x)))
+            0
+            (mau/args t)))
+        (else 0)))))
+
+; ---- dag cone -> opt-term ----
+; leaves -> nullary const (op name); a :radius node -> op(inputs..., unary radius);
+; any other op -> op(inputs...). over (commutative) maps to the module's comm op.
+
+(define
+  artdag/dag->opt-term
+  (fn
+    (dag id)
+    (let
+      ((node (artdag/dag-get dag id)))
+      (let
+        ((op (artdag/node-op node))
+          (ins
+            (map
+              (fn (i) (artdag/dag->opt-term dag i))
+              (artdag/node-inputs node)))
+          (params (artdag/node-params node)))
+        (if
+          (empty? ins)
+          (mau/const op)
+          (if
+            (artdag/member? op artdag/opt-radius-ops)
+            (mau/app
+              op
+              (concat ins (list (artdag/num->unary (get params :radius)))))
+            (mau/app op ins)))))))
+
+; ---- opt-term -> build entries (synthesized names; build recomputes content-ids) ----
+
+(define
+  artdag/opt-last
+  (fn
+    (xs)
+    (if (empty? (rest xs)) (first xs) (artdag/opt-last (rest xs)))))
+
+(define
+  artdag/opt-but-last
+  (fn
+    (xs)
+    (if
+      (empty? (rest xs))
+      (list)
+      (cons (first xs) (artdag/opt-but-last (rest xs))))))
+
+(define
+  artdag/opt-term->build
+  (fn
+    (t counter acc)
+    (if
+      (not (mau/app? t))
+      (let ((nm (str "ob" counter))) {:name nm :acc (concat acc (list (list nm (mau/op t) (list) {}))) :counter (+ counter 1)})
+      (let
+        ((op (mau/op t))
+          (radius? (artdag/member? (mau/op t) artdag/opt-radius-ops)))
+        (let
+          ((in-terms (if radius? (artdag/opt-but-last (mau/args t)) (mau/args t)))
+            (params (if radius? {:radius (artdag/unary->num (artdag/opt-last (mau/args t)))} {}))
+            (comm? (artdag/member? op artdag/opt-comm-ops)))
+          (let
+            ((built (reduce (fn (st ct) (let ((r (artdag/opt-term->build ct (get st :counter) (get st :acc)))) {:acc (get r :acc) :counter (get r :counter) :names (concat (get st :names) (list (get r :name)))})) {:acc acc :counter counter :names (list)} in-terms)))
+            (let ((nm (str "ob" (get built :counter)))) {:name nm :acc (concat (get built :acc) (list (list nm op (get built :names) params comm?))) :counter (+ (get built :counter) 1)})))))))
+
+(define
+  artdag/opt-term->entries
+  (fn (t) (get (artdag/opt-term->build t 0 (list)) :acc)))
+
+; ---- optimise a DAG via maude: encode -> creduce -> decode -> rebuild ----
+; result-preserving: the optimised DAG executes to the same result as the original.
+(define
+  artdag/opt-reduce
+  (fn
+    (dag id)
+    (artdag/build
+      (artdag/opt-term->entries
+        (mau/creduce artdag/opt-module (artdag/dag->opt-term dag id))))))
+
+; content-id of the optimised sink (the head of the reduced term's rebuilt DAG).
+(define
+  artdag/opt-reduce-sink
+  (fn
+    (dag id)
+    (let
+      ((o (artdag/opt-reduce dag id)))
+      (artdag/opt-last (artdag/dag-order o)))))
+
+; ---- cost-directed: the maude-optimised cone never costs more than the original ----
+; compares the original output cone (dce to id) against the maude-reduced DAG under an
+; injected cost-fn (op params). Monotone per-node costs => optimisation is never a
+; pessimisation: fewer nodes (DCE/dedup) and fused ops (one blur(M+N) for two blurs).
+
+(define
+  artdag/opt-improvement
+  (fn
+    (dag id cost-fn)
+    (let
+      ((orig (artdag/dce dag (list id))) (opt (artdag/opt-reduce dag id)))
+      {:before (artdag/total-work orig cost-fn)
+        :after (artdag/total-work opt cost-fn)
+        :before-path (artdag/critical-path orig cost-fn)
+        :after-path (artdag/critical-path opt cost-fn)
+        :optimized opt})))
+
+(define
+  artdag/opt-cheaper?
+  (fn
+    (dag id cost-fn)
+    (let
+      ((imp (artdag/opt-improvement dag id cost-fn)))
+      (<= (get imp :after) (get imp :before)))))

lib/artdag/optimize.sx

@@ -0,0 +1,202 @@
+; lib/artdag/optimize.sx — Phase 5: result-preserving DAG rewrites.
+;   DCE    — drop nodes not reachable upstream from the requested outputs.
+;   CSE    — free from content addressing: structurally identical subexpressions
+;            already collapse to one node at build time (artdag/cse == build).
+;   Fusion — collapse a maximal 1-to-1 chain of fusible unary ops into a single
+;            "artdag/pipeline" node that replays the stages; output-equivalent.
+;   optimize — fuse then DCE in one pass.
+; Depends on dag.sx and analyze.sx.
+
+; ---- dict helper ----
+
+(define
+  artdag/-dict-filter
+  (fn
+    (d keep?)
+    (reduce
+      (fn (acc k) (if (keep? k (get d k)) (assoc acc k (get d k)) acc))
+      {}
+      (keys d))))
+
+(define
+  artdag/-union
+  (fn
+    (a b)
+    (reduce (fn (acc x) (if (artdag/member? x acc) acc (cons x acc))) a b)))
+
+; ---- dead-node elimination ----
+; keep only the outputs and their transitive dependencies; ids are preserved.
+(define
+  artdag/dce
+  (fn
+    (dag outputs)
+    (let
+      ((db (artdag/analyze dag)))
+      (let
+        ((live (reduce (fn (acc out) (artdag/-union (artdag/-union acc (list out)) (artdag/ancestors-of db out))) (list) outputs)))
+        {:names (artdag/-dict-filter (artdag/dag-names dag) (fn (k v) (artdag/member? v live))) :order (filter (fn (id) (artdag/member? id live)) (artdag/dag-order dag)) :ok true :nodes (artdag/-dict-filter (artdag/dag-nodes dag) (fn (k v) (artdag/member? k live)))}))))
+
+; ---- common-subexpression elimination ----
+; structural sharing is inherent to content addressing: build already maps
+; structurally identical specs to a single node/id.
+(define artdag/cse artdag/build)
+
+; ---- adjacent-op fusion (entry-level rewrite) ----
+
+(define artdag/pipeline-op "artdag/pipeline")
+
+(define
+  artdag/-name->entry
+  (fn
+    (entries)
+    (reduce
+      (fn (m e) (assoc m (artdag/entry-name e) e))
+      {}
+      entries)))
+
+; name -> list of dependent names
+(define
+  artdag/-deps-map
+  (fn
+    (entries)
+    (reduce
+      (fn
+        (m e)
+        (reduce
+          (fn
+            (mm i)
+            (assoc
+              mm
+              i
+              (cons
+                (artdag/entry-name e)
+                (if (has-key? mm i) (get mm i) (list)))))
+          m
+          (artdag/entry-inputs e)))
+      {}
+      entries)))
+
+(define artdag/-stage (fn (e) {:op (artdag/entry-op e) :params (artdag/entry-params e)}))
+
+; the single predecessor that `name` may absorb, or nil. Requires: name is a
+; fusible unary op; its one input is a locally-defined fusible node whose ONLY
+; dependent is name (so fusing cannot break sharing).
+(define
+  artdag/-absorbs
+  (fn
+    (n->e deps fusible? name)
+    (let
+      ((e (get n->e name)))
+      (let
+        ((ins (artdag/entry-inputs e)))
+        (if
+          (= (len ins) 1)
+          (let
+            ((x (first ins)))
+            (if
+              (and
+                (has-key? n->e x)
+                (fusible? (artdag/entry-op e))
+                (fusible? (artdag/entry-op (get n->e x)))
+                (= (get deps x) (list name)))
+              x
+              nil))
+          nil)))))
+
+(define
+  artdag/-absorbed-set
+  (fn
+    (n->e deps fusible? names)
+    (reduce
+      (fn
+        (acc y)
+        (let
+          ((p (artdag/-absorbs n->e deps fusible? y)))
+          (if (nil? p) acc (cons p acc))))
+      (list)
+      names)))
+
+; walk predecessors from a tail, building stages head->tail.
+(define
+  artdag/-fuse-chain
+  (fn
+    (n->e deps fusible? cur stages)
+    (let
+      ((p (artdag/-absorbs n->e deps fusible? cur)))
+      (if
+        (nil? p)
+        {:stages (cons (artdag/-stage (get n->e cur)) stages) :head cur}
+        (artdag/-fuse-chain
+          n->e
+          deps
+          fusible?
+          p
+          (cons (artdag/-stage (get n->e cur)) stages))))))
+
+(define
+  artdag/fuse-entries
+  (fn
+    (entries fusible?)
+    (let
+      ((n->e (artdag/-name->entry entries))
+        (deps (artdag/-deps-map entries))
+        (names (map artdag/entry-name entries)))
+      (let
+        ((absorbed (artdag/-absorbed-set n->e deps fusible? names)))
+        (map
+          (fn
+            (name)
+            (let
+              ((c (artdag/-fuse-chain n->e deps fusible? name (list))))
+              (if
+                (> (len (get c :stages)) 1)
+                (list
+                  name
+                  artdag/pipeline-op
+                  (artdag/entry-inputs (get n->e (get c :head)))
+                  {:stages (get c :stages)})
+                (get n->e name))))
+          (filter (fn (name) (not (artdag/member? name absorbed))) names))))))
+
+(define
+  artdag/fuse
+  (fn
+    (entries fusible?)
+    (artdag/build (artdag/fuse-entries entries fusible?))))
+
+; runner that replays a fused pipeline over its single input, delegating each
+; stage to a base runner; non-pipeline ops fall through unchanged.
+(define
+  artdag/pipeline-run
+  (fn
+    (base-runner)
+    (fn
+      (params inputs)
+      (reduce
+        (fn
+          (val stage)
+          (base-runner (get stage :op) (get stage :params) (list val)))
+        (first inputs)
+        (get params :stages)))))
+
+(define
+  artdag/fusing-runner
+  (fn
+    (base-runner)
+    (fn
+      (op params inputs)
+      (if
+        (= op artdag/pipeline-op)
+        ((artdag/pipeline-run base-runner) params inputs)
+        (base-runner op params inputs)))))
+
+; ---- full optimization pass ----
+; fuse the entry list, then drop everything not feeding the requested output
+; names. Output names survive fusion (sinks are never absorbed).
+(define
+  artdag/optimize
+  (fn
+    (entries outputs fusible?)
+    (let
+      ((fused (artdag/fuse entries fusible?)))
+      (artdag/dce fused (map (fn (nm) (artdag/dag-id fused nm)) outputs)))))

lib/artdag/plan.sx

@@ -0,0 +1,100 @@
+; lib/artdag/plan.sx — Phase 3: schedule a DAG (or its dirty subset) into
+; topological batches under a max-parallelism cap. A batch is a set of nodes
+; whose deps are all satisfied by earlier batches, so they run in parallel.
+; cap <= 0 means unlimited width. Depends on dag.sx and analyze.sx.
+
+; inputs of id that also lie inside the scheduled set (out-of-set deps are
+; treated as already satisfied — e.g. clean cache hits in an incremental plan).
+(define
+  artdag/-deps-in
+  (fn
+    (dag id sset)
+    (filter
+      (fn (in) (artdag/member? in sset))
+      (artdag/node-inputs (artdag/dag-get dag id)))))
+
+(define
+  artdag/-ready-in
+  (fn
+    (dag sset placed)
+    (filter
+      (fn
+        (id)
+        (and
+          (not (artdag/member? id placed))
+          (artdag/all-in? (artdag/-deps-in dag id sset) placed)))
+      (artdag/sort-strings sset))))
+
+(define
+  artdag/-batch-loop
+  (fn
+    (dag sset placed batches)
+    (if
+      (= (len placed) (len sset))
+      batches
+      (let
+        ((wave (artdag/-ready-in dag sset placed)))
+        (artdag/-batch-loop
+          dag
+          sset
+          (concat placed wave)
+          (concat batches (list wave)))))))
+
+; split a wave into consecutive chunks of at most n (sorted order preserved).
+(define
+  artdag/-chunk
+  (fn
+    (xs n)
+    (if
+      (<= (len xs) n)
+      (list xs)
+      (cons
+        (slice xs 0 n)
+        (artdag/-chunk (slice xs n (len xs)) n)))))
+
+(define
+  artdag/-cap-split
+  (fn
+    (batches cap)
+    (if
+      (<= cap 0)
+      batches
+      (reduce
+        (fn (acc b) (concat acc (artdag/-chunk b cap)))
+        (list)
+        batches))))
+
+; schedule an explicit set of node-ids into capped topological batches.
+(define
+  artdag/plan-subset
+  (fn
+    (dag node-ids cap)
+    (artdag/-cap-split (artdag/-batch-loop dag node-ids (list) (list)) cap)))
+
+; full plan over every node in the dag.
+(define
+  artdag/plan
+  (fn (dag cap) (artdag/plan-subset dag (keys (artdag/dag-nodes dag)) cap)))
+
+; incremental plan: schedule only the dirty closure of the changed nodes.
+(define
+  artdag/plan-dirty
+  (fn
+    (dag changed cap)
+    (artdag/plan-subset dag (artdag/dirty-closure dag changed) cap)))
+
+; ---- plan inspection ----
+
+(define artdag/plan-batches (fn (plan) (len plan)))
+
+(define
+  artdag/plan-width
+  (fn
+    (plan)
+    (reduce (fn (m b) (if (> (len b) m) (len b) m)) 0 plan)))
+
+(define
+  artdag/plan-flatten
+  (fn (plan) (reduce (fn (acc b) (concat acc b)) (list) plan)))
+
+(define artdag/plan-size (fn (plan) (len (artdag/plan-flatten plan))))

lib/artdag/post.sx

@@ -0,0 +1,68 @@
+; lib/artdag/post.sx — project an artdag job to/from a feed "post object", so a job
+; can ride as the :object of a feed activity ({:actor :verb :object :at :tags}) per the
+; host loop. A post object is content-addressed and self-verifying:
+;   {:type "artdag/job" :id <content-id of the output node> :wire <dag->wire>}
+; The :id IS the post/object id (the stable structural digest = natural AP object id);
+; the :wire is the self-describing, write/read-safe payload from serialize.sx whose
+; records each carry their own content-id. The dag<->feed-activity wrapping (actor/verb/
+; at/tags) stays on the host/feed side; this file is only the job<->object projection.
+; Depends on dag.sx + serialize.sx (and execute.sx for post-run).
+
+(define artdag/post-type "artdag/job")
+
+; a job = a dag + the output node (by author name) the post is "about".
+(define artdag/job->post-object (fn (dag output-name) {:id (artdag/dag-id dag output-name) :type artdag/post-type :wire (artdag/dag->wire dag)}))
+
+(define
+  artdag/post-object?
+  (fn
+    (x)
+    (and
+      (= (type-of x) "dict")
+      (= (get x :type) artdag/post-type)
+      (has-key? x :id)
+      (has-key? x :wire))))
+
+(define artdag/post-object-id (fn (post) (get post :id)))
+
+(define artdag/post-object-wire (fn (post) (get post :wire)))
+
+; integrity: the payload's records each verify (id == recomputed content-id) AND the
+; claimed post id is actually produced by the job (present among the wire records).
+(define
+  artdag/post-object-verify
+  (fn
+    (post)
+    (and
+      (artdag/post-object? post)
+      (artdag/wire-verify (get post :wire))
+      (artdag/member?
+        (get post :id)
+        (map (fn (rec) (nth rec 0)) (get post :wire))))))
+
+; decode the payload back into a runnable dag (pure; verify separately, mirroring
+; serialize.sx's wire->dag / wire-verify split).
+(define
+  artdag/post-object->job
+  (fn (post) (artdag/wire->dag (get post :wire))))
+
+; ---- string transport (drop into a feed activity / SXTP body) ----
+
+(define
+  artdag/job->post-string
+  (fn
+    (dag output-name)
+    (write-to-string (artdag/job->post-object dag output-name))))
+
+(define artdag/post-string->object (fn (s) (read (open-input-string s))))
+
+; ---- run a received post: decode -> run -> result at the post id ----
+; the peer recomputes the job (content-addressed, so a warm cache hits everything it
+; already has). Returns the result of the output node the post is about.
+(define
+  artdag/post-run
+  (fn
+    (post runner cache)
+    (artdag/result-of
+      (artdag/run (artdag/post-object->job post) runner cache)
+      (artdag/post-object-id post))))

lib/artdag/schedule.sx

@@ -0,0 +1,139 @@
+; lib/artdag/schedule.sx — relational scheduling on lib/minikanren CLP(FD).
+; Each node gets a slot var in [1..max-slots]; every edge (input->node) imposes
+; `fd-lt slot(input) slot(node)`. `fd-label` searches the finite domains; a solution
+; is a {node-id -> slot} assignment respecting all dependencies. Grouping by slot
+; gives parallel batches (plan.sx's batch shape). Labeling picks smallest slots
+; first, so the FIRST solution is the ASAP leveling — it agrees with plan.sx's greedy
+; Kahn waves; the relational extra is enumerating EVERY valid schedule. The
+; parallelism cap is a cardinality property, enforced by filtering labeled solutions
+; (the FD core handles precedence only). lib/minikanren is a READ-ONLY consumed
+; substrate: make-var, fd-in, fd-lt, fd-label, mk-conj, reify, stream-take, empty-s.
+
+(define
+  artdag/range1
+  (fn (n) (map (fn (i) (+ i 1)) (range 0 n))))
+
+(define
+  artdag/-zip-assoc
+  (fn
+    (ids vals)
+    (reduce
+      (fn (m p) (assoc m (first p) (nth p 1)))
+      {}
+      (zip ids vals))))
+
+; build the constraint goal + the ordered slot vars for a dag over domain 1..maxslots.
+(define
+  artdag/sched-goal-and-vars
+  (fn
+    (dag maxslots)
+    (let
+      ((ids (artdag/dag-order dag)))
+      (let
+        ((vars (map (fn (id) (make-var)) ids)))
+        (let
+          ((id->var (artdag/-zip-assoc ids vars))
+            (dom (artdag/range1 maxslots)))
+          (let
+            ((in-goals (map (fn (v) (fd-in v dom)) vars))
+              (lt-goals
+                (reduce
+                  (fn
+                    (acc id)
+                    (concat
+                      acc
+                      (map
+                        (fn
+                          (inp)
+                          (fd-lt (get id->var inp) (get id->var id)))
+                        (artdag/node-inputs (artdag/dag-get dag id)))))
+                  (list)
+                  ids)))
+            {:goal (apply mk-conj (concat in-goals lt-goals (list (fd-label vars)))) :vars vars :ids ids}))))))
+
+(define
+  artdag/-sched-solutions
+  (fn
+    (g limit)
+    (map
+      (fn (sol) (artdag/-zip-assoc (get g :ids) sol))
+      (map
+        (fn (s) (reify (get g :vars) s))
+        (stream-take limit ((get g :goal) empty-s))))))
+
+; all valid dependency-respecting slot assignments within 1..maxslots.
+(define
+  artdag/schedules
+  (fn
+    (dag maxslots)
+    (artdag/-sched-solutions
+      (artdag/sched-goal-and-vars dag maxslots)
+      -1)))
+
+; one valid assignment (ASAP within the bound), or nil if maxslots is too small.
+(define
+  artdag/schedule
+  (fn
+    (dag maxslots)
+    (let
+      ((ss (artdag/-sched-solutions (artdag/sched-goal-and-vars dag maxslots) 1)))
+      (if (empty? ss) nil (first ss)))))
+
+; ASAP schedule: node-count slots are always sufficient (a linear chain is the worst
+; case), and smallest-first labeling yields the tightest leveling.
+(define
+  artdag/schedule-asap
+  (fn (dag) (artdag/schedule dag (artdag/node-count dag))))
+
+(define
+  artdag/schedule-makespan
+  (fn
+    (assignment)
+    (reduce
+      (fn (m id) (max m (get assignment id)))
+      0
+      (keys assignment))))
+
+; group node-ids by slot (ascending), each batch id-sorted for determinism.
+(define
+  artdag/schedule->batches
+  (fn
+    (dag assignment)
+    (let
+      ((mx (artdag/schedule-makespan assignment)))
+      (filter
+        (fn (b) (not (empty? b)))
+        (map
+          (fn
+            (slot)
+            (artdag/sort-strings
+              (filter
+                (fn (id) (= (get assignment id) slot))
+                (keys assignment))))
+          (artdag/range1 mx))))))
+
+; independent check: every input is scheduled strictly before its consumer.
+(define
+  artdag/schedule-valid?
+  (fn
+    (dag assignment)
+    (every?
+      (fn
+        (id)
+        (every?
+          (fn (inp) (< (get assignment inp) (get assignment id)))
+          (artdag/node-inputs (artdag/dag-get dag id))))
+      (artdag/dag-order dag))))
+
+; schedules whose every slot holds <= cap nodes (parallelism cap as a post-filter).
+(define
+  artdag/schedules-capped
+  (fn
+    (dag maxslots cap)
+    (filter
+      (fn
+        (asn)
+        (every?
+          (fn (b) (<= (len b) cap))
+          (artdag/schedule->batches dag asn)))
+      (artdag/schedules dag maxslots))))

lib/artdag/scoreboard.json

@@ -0,0 +1,20 @@
+{
+  "suites": {
+    "dag": {"pass": 20, "fail": 0},
+    "analyze": {"pass": 16, "fail": 0},
+    "plan": {"pass": 18, "fail": 0},
+    "execute": {"pass": 15, "fail": 0},
+    "optimize": {"pass": 22, "fail": 0},
+    "fed": {"pass": 15, "fail": 0},
+    "cost": {"pass": 13, "fail": 0},
+    "serialize": {"pass": 13, "fail": 0},
+    "stats": {"pass": 12, "fail": 0},
+    "fault": {"pass": 14, "fail": 0},
+    "post": {"pass": 12, "fail": 0},
+    "maude-optimize": {"pass": 40, "fail": 0},
+    "schedule": {"pass": 15, "fail": 0}
+  },
+  "total_pass": 225,
+  "total_fail": 0,
+  "total": 225
+}

lib/artdag/scoreboard.md

@@ -0,0 +1,20 @@
+# artdag Conformance Scoreboard
+
+_Generated by `lib/artdag/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| dag | 20 | 0 | 20 |
+| analyze | 16 | 0 | 16 |
+| plan | 18 | 0 | 18 |
+| execute | 15 | 0 | 15 |
+| optimize | 22 | 0 | 22 |
+| fed | 15 | 0 | 15 |
+| cost | 13 | 0 | 13 |
+| serialize | 13 | 0 | 13 |
+| stats | 12 | 0 | 12 |
+| fault | 14 | 0 | 14 |
+| post | 12 | 0 | 12 |
+| maude-optimize | 40 | 0 | 40 |
+| schedule | 15 | 0 | 15 |
+| **Total** | **225** | **0** | **225** |

lib/artdag/serialize.sx

@@ -0,0 +1,62 @@
+; lib/artdag/serialize.sx — portable wire form for whole DAGs, so a peer can
+; receive and run a graph it did not author. The form is a topo-ordered list of
+; node records (id op inputs params commutative) — plain lists with keyword-keyed
+; param dicts, which survive write/read (unlike string-keyed node dicts). The id
+; is the content-id, so the form is self-verifying. Depends on dag.sx.
+
+(define
+  artdag/node->record
+  (fn
+    (dag id)
+    (let
+      ((n (artdag/dag-get dag id)))
+      (list
+        id
+        (artdag/node-op n)
+        (artdag/node-inputs n)
+        (artdag/node-params n)
+        (get n :commutative)))))
+
+; dag -> list of records, in topological order.
+(define
+  artdag/dag->wire
+  (fn
+    (dag)
+    (map (fn (id) (artdag/node->record dag id)) (artdag/dag-order dag))))
+
+; an empty input list reads back as nil; normalize it.
+(define
+  artdag/-rec-inputs
+  (fn (rec) (let ((i (nth rec 2))) (if (nil? i) (list) i))))
+
+(define artdag/-rec->node (fn (rec) {:inputs (artdag/-rec-inputs rec) :commutative (nth rec 4) :op (nth rec 1) :params (nth rec 3)}))
+
+; records -> dag. Local author names are not part of the wire form; the receiver
+; works by content-id. :names is left empty.
+(define
+  artdag/wire->dag
+  (fn
+    (records)
+    (reduce
+      (fn (dag rec) (let ((id (nth rec 0))) {:names (get dag :names) :order (concat (get dag :order) (list id)) :ok true :nodes (assoc (get dag :nodes) id (artdag/-rec->node rec))}))
+      {:names {} :order (list) :ok true :nodes {}}
+      records)))
+
+; integrity: each record's id must equal the content-id recomputed from its spec.
+(define
+  artdag/wire-verify
+  (fn
+    (records)
+    (every?
+      (fn
+        (rec)
+        (= (nth rec 0) (artdag/content-id (artdag/-rec->node rec))))
+      records)))
+
+; string transport.
+(define
+  artdag/dag->string
+  (fn (dag) (write-to-string (artdag/dag->wire dag))))
+(define
+  artdag/string->dag
+  (fn (s) (artdag/wire->dag (read (open-input-string s)))))

lib/artdag/stats.sx

@@ -0,0 +1,51 @@
+; lib/artdag/stats.sx — observability over an execution: cache hit ratio and the
+; compute work saved by memoization (weighted by the cost model). An exec is the
+; {:results :recomputed :hits} record returned by artdag/execute. Depends on
+; execute.sx (exec accessors) and cost.sx (artdag/-node-cost).
+
+(define
+  artdag/exec-total
+  (fn (exec) (+ (artdag/recompute-count exec) (artdag/hit-count exec))))
+
+; fraction of executed nodes served from cache (0 when nothing ran).
+(define
+  artdag/hit-ratio
+  (fn
+    (exec)
+    (let
+      ((n (artdag/exec-total exec)))
+      (if (= n 0) 0 (/ (artdag/hit-count exec) n)))))
+
+(define
+  artdag/-sum-cost
+  (fn
+    (dag cost-fn ids)
+    (reduce
+      (fn (s id) (+ s (artdag/-node-cost dag cost-fn id)))
+      0
+      ids)))
+
+; weighted compute work that actually ran this execution.
+(define
+  artdag/work-recomputed
+  (fn
+    (exec dag cost-fn)
+    (artdag/-sum-cost dag cost-fn (get exec :recomputed))))
+
+; weighted compute work avoided by cache hits.
+(define
+  artdag/work-saved
+  (fn (exec dag cost-fn) (artdag/-sum-cost dag cost-fn (get exec :hits))))
+
+; fraction of total weighted work that the cache saved (0 when no work at all).
+(define
+  artdag/savings-ratio
+  (fn
+    (exec dag cost-fn)
+    (let
+      ((saved (artdag/work-saved exec dag cost-fn))
+        (ran (artdag/work-recomputed exec dag cost-fn)))
+      (if (= (+ saved ran) 0) 0 (/ saved (+ saved ran))))))
+
+; compact summary dict for logging.
+(define artdag/exec-summary (fn (exec dag cost-fn) {:work-saved (artdag/work-saved exec dag cost-fn) :recomputed (artdag/recompute-count exec) :total (artdag/exec-total exec) :work-ran (artdag/work-recomputed exec dag cost-fn) :hits (artdag/hit-count exec)}))

lib/artdag/tests/analyze.sx

@@ -0,0 +1,119 @@
+; Phase 2 — Analyze on Datalog: deps/dependents/reachability + dirty closure.
+
+; diamond:  a -> b, a -> c, (b,c) -> d
+(define
+  an-D
+  (artdag/build
+    (list
+      (list "a" "load" (list) {})
+      (list "b" "f" (list "a") {})
+      (list "c" "g" (list "a") {})
+      (list "d" "add" (list "b" "c") {} true))))
+(define an-db (artdag/analyze an-D))
+(define an-a (artdag/dag-id an-D "a"))
+(define an-b (artdag/dag-id an-D "b"))
+(define an-c (artdag/dag-id an-D "c"))
+(define an-d (artdag/dag-id an-D "d"))
+
+; ---- direct deps / dependents ----
+
+(artdag-test
+  "deps-of: direct inputs"
+  (artdag/deps-of an-db an-d)
+  (artdag/sort-strings (list an-b an-c)))
+
+(artdag-test "deps-of: leaf has none" (artdag/deps-of an-db an-a) (list))
+
+(artdag-test
+  "dependents-of: direct consumers"
+  (artdag/dependents-of an-db an-a)
+  (artdag/sort-strings (list an-b an-c)))
+
+(artdag-test
+  "dependents-of: output has none"
+  (artdag/dependents-of an-db an-d)
+  (list))
+
+; ---- transitive reachability ----
+
+(artdag-test
+  "reachable-from: all downstream"
+  (artdag/reachable-from an-db an-a)
+  (artdag/sort-strings (list an-b an-c an-d)))
+
+(artdag-test
+  "reachable-from: mid node reaches output"
+  (artdag/reachable-from an-db an-b)
+  (list an-d))
+
+(artdag-test
+  "ancestors-of: all upstream"
+  (artdag/ancestors-of an-db an-d)
+  (artdag/sort-strings (list an-a an-b an-c)))
+
+(artdag-test
+  "ancestors-of: leaf has none"
+  (artdag/ancestors-of an-db an-a)
+  (list))
+
+; ---- deep chain ----
+
+(define
+  ch-D
+  (artdag/build
+    (list
+      (list "a" "load" (list) {})
+      (list "b" "f" (list "a") {})
+      (list "c" "f" (list "b") {})
+      (list "d" "f" (list "c") {}))))
+(define ch-db (artdag/analyze ch-D))
+
+(artdag-test
+  "deep chain: reachable-from leaf"
+  (artdag/reachable-from ch-db (artdag/dag-id ch-D "a"))
+  (artdag/sort-strings
+    (list
+      (artdag/dag-id ch-D "b")
+      (artdag/dag-id ch-D "c")
+      (artdag/dag-id ch-D "d"))))
+
+(artdag-test
+  "deep chain: ancestors of tip"
+  (artdag/ancestors-of ch-db (artdag/dag-id ch-D "d"))
+  (artdag/sort-strings
+    (list
+      (artdag/dag-id ch-D "a")
+      (artdag/dag-id ch-D "b")
+      (artdag/dag-id ch-D "c"))))
+
+; ---- dirty closure ----
+
+(artdag-test
+  "dirty closure: change leaf dirties all"
+  (artdag/dirty-closure an-D (list an-a))
+  (artdag/sort-strings (list an-a an-b an-c an-d)))
+
+(artdag-test
+  "dirty closure: change mid touches only downstream"
+  (artdag/dirty-closure an-D (list an-b))
+  (artdag/sort-strings (list an-b an-d)))
+
+(artdag-test
+  "dirty closure: unaffected stay clean (count)"
+  (len (artdag/dirty-closure an-D (list an-b)))
+  2)
+
+(artdag-test
+  "dirty closure: change output dirties only itself"
+  (artdag/dirty-closure an-D (list an-d))
+  (list an-d))
+
+(artdag-test
+  "dirty closure: multiple seeds union"
+  (artdag/dirty-closure an-D (list an-b an-c))
+  (artdag/sort-strings (list an-b an-c an-d)))
+
+(artdag-test
+  "dirty closure: empty seed set"
+  (artdag/dirty-closure an-D (list))
+  (list))

lib/artdag/tests/cost.sx

@@ -0,0 +1,117 @@
+; cost model: critical path, makespan under cap, total work, speedup.
+
+(define
+  cost-CHAIN
+  (artdag/build
+    (list
+      (list "a" "in" (list) {})
+      (list "b" "f" (list "a") {})
+      (list "c" "f" (list "b") {})
+      (list "d" "f" (list "c") {}))))
+
+(define
+  cost-DIA
+  (artdag/build
+    (list
+      (list "a" "in" (list) {})
+      (list "b" "f" (list "a") {})
+      (list "c" "g" (list "a") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+(define cost-W (artdag/op-cost {:f 2 :add 5}))
+
+; ---- unit cost ----
+
+(artdag-test
+  "critical path: chain is its length"
+  (artdag/critical-path cost-CHAIN artdag/const-cost)
+  4)
+
+(artdag-test
+  "critical path: diamond longest path"
+  (artdag/critical-path cost-DIA artdag/const-cost)
+  3)
+
+(artdag-test
+  "total work: unit cost equals node count"
+  (artdag/total-work cost-DIA artdag/const-cost)
+  4)
+
+(artdag-test
+  "single node critical path is its cost"
+  (artdag/critical-path
+    (artdag/build (list (list "a" "in" (list) {})))
+    artdag/const-cost)
+  1)
+
+; ---- makespan vs cap ----
+
+(artdag-test
+  "full plan makespan equals critical path"
+  (artdag/makespan
+    cost-DIA
+    (artdag/plan cost-DIA 0)
+    artdag/const-cost)
+  (artdag/critical-path cost-DIA artdag/const-cost))
+
+(artdag-test
+  "serial plan makespan equals total work"
+  (artdag/makespan
+    cost-DIA
+    (artdag/plan cost-DIA 1)
+    artdag/const-cost)
+  (artdag/total-work cost-DIA artdag/const-cost))
+
+(artdag-test
+  "capped makespan is never below the critical path"
+  (>=
+    (artdag/makespan
+      cost-DIA
+      (artdag/plan cost-DIA 1)
+      artdag/const-cost)
+    (artdag/critical-path cost-DIA artdag/const-cost))
+  true)
+
+; ---- weighted costs ----
+
+(artdag-test
+  "weighted critical path follows heavy ops"
+  (artdag/critical-path cost-DIA cost-W)
+  8)
+
+(artdag-test
+  "weighted total work sums all node costs"
+  (artdag/total-work cost-DIA cost-W)
+  9)
+
+(artdag-test
+  "op-cost defaults unknown ops to 1"
+  (artdag/total-work
+    (artdag/build (list (list "a" "in" (list) {})))
+    cost-W)
+  1)
+
+(artdag-test
+  "weighted full-plan makespan equals critical path"
+  (artdag/makespan cost-DIA (artdag/plan cost-DIA 0) cost-W)
+  (artdag/critical-path cost-DIA cost-W))
+
+; ---- speedup ----
+
+(artdag-test
+  "serial plan has no speedup"
+  (artdag/speedup
+    cost-DIA
+    (artdag/plan cost-DIA 1)
+    artdag/const-cost)
+  1)
+
+(artdag-test
+  "parallel plan beats serial"
+  (>
+    (artdag/speedup
+      cost-DIA
+      (artdag/plan cost-DIA 0)
+      artdag/const-cost)
+    1)
+  true)