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

@@ -1 +1 @@
-{"sessionId":"bf20a443-9df8-4cb9-932e-8c6f4c4625c2","pid":1303602,"procStart":"253831081","acquiredAt":1779865895644}
+{"sessionId":"d510140d-6197-40b7-9bd2-125ca304ad7a","pid":697492,"procStart":"125353752","acquiredAt":1783118024555}

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

@@ -595,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"));
@@ -1151,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 ->
@@ -1166,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
@@ -2812,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" ->
@@ -2961,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 ->
@@ -3070,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
@@ -3483,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 ->
@@ -3516,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
@@ -3660,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

@@ -32,6 +32,14 @@ let () = ignore (Sx_vm_extensions.id_of_name "")
    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         *)
 (* ====================================================================== *)
@@ -522,26 +530,25 @@ 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. *)
-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
-  let is_suspended s = match Sx_runtime.get_val s (String "phase") with String "io-suspended" -> true | _ -> false in
-  let rec loop () =
-    while not (is_terminal !s) && not (is_suspended !s) do
-      s := Sx_ref.cek_step !s
-    done;
-    if is_suspended !s then begin
-      let request = Sx_runtime.get_val !s (String "request") in
+(* 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
-      let response = match op with
+  (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
+     (* 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
@@ -571,10 +578,24 @@ and cek_run_with_io state =
      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 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
+  let is_suspended s = match Sx_runtime.get_val s (String "phase") with String "io-suspended" -> true | _ -> false in
+  let rec loop () =
+    while not (is_terminal !s) && not (is_suspended !s) do
+      s := Sx_ref.cek_step !s
+    done;
+    if is_suspended !s then begin
+      let request = Sx_runtime.get_val !s (String "request") in
+      let response = resolve_io_request request in
       s := Sx_ref.cek_resume !s response;
       loop ()
     end else
@@ -742,9 +763,27 @@ let setup_evaluator_bridge env =
         | _ -> 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 (Unix.inet_addr_loopback, port));
+        (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
@@ -804,9 +843,31 @@ let setup_evaluator_bridge env =
              Hashtbl.replace req "body" (String body);
              Mutex.lock mtx;
              let resp =
-               (try Sx_runtime.sx_call handler [Dict req]
-                with e -> Mutex.unlock mtx; raise e) in
+               (* 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
@@ -832,6 +893,18 @@ let setup_evaluator_bridge env =
              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")
@@ -855,6 +928,164 @@ let setup_evaluator_bridge env =
       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] ->
@@ -936,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);
@@ -1062,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);
@@ -1307,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);
@@ -1325,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) ->
@@ -1341,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))
@@ -1374,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))
@@ -1506,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) ^ ")"
@@ -1533,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
@@ -2329,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"];
@@ -2370,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
@@ -2425,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
 
@@ -3857,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 ->
@@ -3893,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
@@ -3902,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)
@@ -3992,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
@@ -4004,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 ->
@@ -4358,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
@@ -4369,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\"))"
@@ -4385,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);
@@ -4642,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
@@ -4651,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 *)
@@ -4685,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
@@ -4700,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_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
+              | 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 ^ ": not a dict")))
             | _ -> 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 *)

hosts/ocaml/lib/sx_cbor.ml

@@ -15,25 +15,29 @@ exception Cbor_error of string
 
 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));
-    Buffer.add_char buf (Char.chr v)
+    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));
-    Buffer.add_char buf (Char.chr ((v lsr 8) land 0xFF));
-    Buffer.add_char buf (Char.chr (v land 0xFF))
-  end else if v < 0x100000000 then begin
-    Buffer.add_char buf (Char.chr (m lor 26));
-    for i = 3 downto 0 do
-      Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
-    done
+    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));
-    for i = 7 downto 0 do
-      Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
-    done
+    Buffer.add_char buf (Char.chr (m lor 27)); put_be 8
   end
 
 (* dag-cbor map key order: shorter key first, then bytewise. *)

hosts/ocaml/lib/sx_cid.ml

@@ -32,7 +32,11 @@ let base32_lower (s : string) : string =
     while !bits >= 5 do
       bits := !bits - 5;
       Buffer.add_char buf b32_alpha.[(!acc lsr !bits) land 0x1f]
-    done) s;
+    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

hosts/ocaml/lib/sx_ed25519.ml

@@ -68,15 +68,22 @@ let sub (a : bn) (b : bn) : bn =
   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 0 in
+    let carry = ref 0L in
+    let ai = Int64.of_int a.(i) 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
+      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) + !carry
+    r.(i + lb) <- r.(i + lb) + Int64.to_int !carry
   done;
   norm r
 
@@ -109,12 +116,16 @@ let bn_mod (a : bn) (m : bn) : bn =
   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 0 in
+  let rem = ref 0L in
+  let dL = Int64.of_int d 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
+    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
 

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 ->
@@ -833,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 ->
@@ -1219,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
@@ -2298,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
@@ -2360,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 =
@@ -4168,6 +4208,38 @@ let () =
     ) 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;

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

@@ -3,37 +3,40 @@
     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 held in native int,
-   masked to 32 bits after every arithmetic op. ---- *)
-
-let mask32 = 0xFFFFFFFF
+(* ---- 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 = [|
-  0x428a2f98; 0x71374491; 0xb5c0fbcf; 0xe9b5dba5;
-  0x3956c25b; 0x59f111f1; 0x923f82a4; 0xab1c5ed5;
-  0xd807aa98; 0x12835b01; 0x243185be; 0x550c7dc3;
-  0x72be5d74; 0x80deb1fe; 0x9bdc06a7; 0xc19bf174;
-  0xe49b69c1; 0xefbe4786; 0x0fc19dc6; 0x240ca1cc;
-  0x2de92c6f; 0x4a7484aa; 0x5cb0a9dc; 0x76f988da;
-  0x983e5152; 0xa831c66d; 0xb00327c8; 0xbf597fc7;
-  0xc6e00bf3; 0xd5a79147; 0x06ca6351; 0x14292967;
-  0x27b70a85; 0x2e1b2138; 0x4d2c6dfc; 0x53380d13;
-  0x650a7354; 0x766a0abb; 0x81c2c92e; 0x92722c85;
-  0xa2bfe8a1; 0xa81a664b; 0xc24b8b70; 0xc76c51a3;
-  0xd192e819; 0xd6990624; 0xf40e3585; 0x106aa070;
-  0x19a4c116; 0x1e376c08; 0x2748774c; 0x34b0bcb5;
-  0x391c0cb3; 0x4ed8aa4a; 0x5b9cca4f; 0x682e6ff3;
-  0x748f82ee; 0x78a5636f; 0x84c87814; 0x8cc70208;
-  0x90befffa; 0xa4506ceb; 0xbef9a3f7; 0xc67178f2 |]
+  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 n = ((x lsr n) lor (x lsl (32 - n))) land mask32
+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 = [| 0x6a09e667; 0xbb67ae85; 0x3c6ef372; 0xa54ff53a;
-             0x510e527f; 0x9b05688c; 0x1f83d9ab; 0x5be0cd19 |] in
+  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 = len * 8 in
+  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
@@ -42,60 +45,79 @@ let sha256_hex (msg : string) : string =
   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 (we cap at OCaml int range). *)
+  (* 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 ((bitlen lsr (8 * i)) land 0xFF))
+      (Char.chr (Int64.to_int
+         (Int64.logand (Int64.shift_right_logical bitlen (8 * i)) 0xFFL)))
   done;
-  let w = Array.make 64 0 in
+  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) <-
-        (Char.code (Bytes.get buf o) lsl 24)
-        lor (Char.code (Bytes.get buf (o + 1)) lsl 16)
-        lor (Char.code (Bytes.get buf (o + 2)) lsl 8)
-        lor (Char.code (Bytes.get buf (o + 3)))
+        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 =
-        (rotr32 w.(t - 15) 7) lxor (rotr32 w.(t - 15) 18)
-        lxor (w.(t - 15) lsr 3) in
+        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 =
-        (rotr32 w.(t - 2) 17) lxor (rotr32 w.(t - 2) 19)
-        lxor (w.(t - 2) lsr 10) in
-      w.(t) <- (w.(t - 16) + s0 + w.(t - 7) + s1) land mask32
+        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 =
-        (rotr32 !e 6) lxor (rotr32 !e 11) lxor (rotr32 !e 25) in
-      let ch = (!e land !f) lxor ((lnot !e land mask32) land !g) in
-      let t1 = (!hh + s1 + ch + k256.(t) + w.(t)) land mask32 in
+        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 =
-        (rotr32 !a 2) lxor (rotr32 !a 13) lxor (rotr32 !a 22) in
-      let maj = (!a land !bb) lxor (!a land !c) lxor (!bb land !c) in
-      let t2 = (s0 + maj) land mask32 in
+        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 := (!d + t1) land mask32;
+      e := Int32.add !d t1;
       d := !c; c := !bb; bb := !a;
-      a := (t1 + t2) land mask32
+      a := Int32.add t1 t2
     done;
-    h.(0) <- (h.(0) + !a) land mask32;
-    h.(1) <- (h.(1) + !bb) land mask32;
-    h.(2) <- (h.(2) + !c) land mask32;
-    h.(3) <- (h.(3) + !d) land mask32;
-    h.(4) <- (h.(4) + !e) land mask32;
-    h.(5) <- (h.(5) + !f) land mask32;
-    h.(6) <- (h.(6) + !g) land mask32;
-    h.(7) <- (h.(7) + !hh) land mask32
+    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 "%08x" x)) h;
+  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.
@@ -146,7 +168,7 @@ let sha512_hex (msg : string) : string =
              0x510e527fade682d1L; 0x9b05688c2b3e6c1fL;
              0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L |] in
   let len = String.length msg in
-  let bitlen = len * 8 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
@@ -156,9 +178,12 @@ let sha512_hex (msg : string) : string =
   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 ((bitlen lsr (8 * i)) land 0xFF))
+      (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

hosts/ocaml/lib/sx_types.ml

@@ -470,6 +470,52 @@ 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.
@@ -858,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

@@ -336,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
+    let result =
+      (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 _ 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. *)
+       | 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
+            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
+         raise e)
     in
+    vm.frames <- saved_frames;
     vm.sp <- saved_sp;
     result
   | None ->
@@ -808,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
@@ -921,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;
@@ -993,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 =
@@ -1072,7 +1122,7 @@ let _jit_is_broken_name n =
     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_uses_extension_opcodes (bc : int array) (consts : value array) =
+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 *)
@@ -1085,7 +1135,7 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
   let found = ref false in
   while not !found && !ip < len do
     let op = bc.(!ip) in
-    if op >= 200 then found := true
+    if pred op then found := true
     else begin
       ip := !ip + 1;
       let extra = match op with
@@ -1112,6 +1162,49 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
   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 (
@@ -1127,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;
@@ -1183,6 +1283,20 @@ let jit_compile_lambda (l : lambda) globals =
             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 }

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

lib/artdag/tests/dag.sx

@@ -0,0 +1,182 @@
+; Phase 1 — dag model + structural content addressing.
+
+; ---- content-id determinism ----
+
+(artdag-test
+  "same spec -> same id"
+  (equal?
+    (artdag/content-id (artdag/node "blur" (list "i1") {:r 3}))
+    (artdag/content-id (artdag/node "blur" (list "i1") {:r 3})))
+  true)
+
+(artdag-test
+  "op affects id"
+  (equal?
+    (artdag/content-id (artdag/node "blur" (list "i1") {}))
+    (artdag/content-id (artdag/node "sharpen" (list "i1") {})))
+  false)
+
+(artdag-test
+  "params affect id"
+  (equal?
+    (artdag/content-id (artdag/node "blur" (list "i1") {:r 3}))
+    (artdag/content-id (artdag/node "blur" (list "i1") {:r 5})))
+  false)
+
+(artdag-test
+  "inputs affect id"
+  (equal?
+    (artdag/content-id (artdag/node "add" (list "i1") {}))
+    (artdag/content-id (artdag/node "add" (list "i2") {})))
+  false)
+
+(artdag-test
+  "param key order does not affect id"
+  (equal?
+    (artdag/content-id (artdag/node "op" (list) {:a 1 :b 2}))
+    (artdag/content-id (artdag/node "op" (list) {:a 1 :b 2})))
+  true)
+
+; ---- commutativity ----
+
+(artdag-test
+  "commutative op: input order ignored"
+  (equal?
+    (artdag/content-id (artdag/cnode "add" (list "i1" "i2") {}))
+    (artdag/content-id (artdag/cnode "add" (list "i2" "i1") {})))
+  true)
+
+(artdag-test
+  "non-commutative op: input order matters"
+  (equal?
+    (artdag/content-id (artdag/node "sub" (list "i1" "i2") {}))
+    (artdag/content-id (artdag/node "sub" (list "i2" "i1") {})))
+  false)
+
+; ---- build: success ----
+
+(artdag-test
+  "build ok for valid dag"
+  (get
+    (artdag/build
+      (list
+        (list "a" "load" (list) {})
+        (list "b" "load" (list) {:s 1})
+        (list "c" "add" (list "a" "b") {})))
+    :ok)
+  true)
+
+(artdag-test
+  "node-count counts distinct nodes"
+  (artdag/node-count
+    (artdag/build
+      (list
+        (list "a" "load" (list) {})
+        (list "b" "load" (list) {:s 1})
+        (list "c" "add" (list "a" "b") {}))))
+  3)
+
+; ---- subgraph sharing ----
+
+(artdag-test
+  "identical leaves dedup to one node"
+  (artdag/node-count
+    (artdag/build
+      (list
+        (list "a" "load" (list) {:s 1})
+        (list "b" "load" (list) {:s 1})
+        (list "c" "add" (list "a" "b") {}))))
+  2)
+
+(artdag-test
+  "duplicate names map to same id"
+  (let
+    ((d (artdag/build (list (list "a" "load" (list) {:s 1}) (list "b" "load" (list) {:s 1})))))
+    (equal? (artdag/dag-id d "a") (artdag/dag-id d "b")))
+  true)
+
+(artdag-test
+  "identical subgraph shares id across dags"
+  (let
+    ((d1 (artdag/build (list (list "x" "load" (list) {:s 7}) (list "y" "neg" (list "x") {}))))
+      (d2
+        (artdag/build
+          (list
+            (list "p" "load" (list) {:s 7})
+            (list "q" "neg" (list "p") {})))))
+    (equal? (artdag/dag-id d1 "y") (artdag/dag-id d2 "q")))
+  true)
+
+; ---- validation ----
+
+(artdag-test
+  "cycle rejected"
+  (get
+    (artdag/build
+      (list
+        (list "a" "f" (list "b") {})
+        (list "b" "g" (list "a") {})))
+    :error)
+  "cycle")
+
+(artdag-test
+  "self-cycle rejected"
+  (get (artdag/build (list (list "a" "f" (list "a") {}))) :error)
+  "cycle")
+
+(artdag-test
+  "dangling input rejected"
+  (get
+    (artdag/build (list (list "a" "f" (list "ghost") {})))
+    :error)
+  "dangling")
+
+(artdag-test
+  "dangling refs reported"
+  (get
+    (artdag/build (list (list "a" "f" (list "ghost") {})))
+    :refs)
+  (list "ghost"))
+
+; ---- topological order ----
+
+(artdag-test
+  "topo order: deps before dependents"
+  (let
+    ((d (artdag/build (list (list "c" "add" (list "a" "b") {}) (list "a" "load" (list) {:s 1}) (list "b" "load" (list) {:s 2})))))
+    (artdag/dag-order d))
+  (let
+    ((d (artdag/build (list (list "c" "add" (list "a" "b") {}) (list "a" "load" (list) {:s 1}) (list "b" "load" (list) {:s 2})))))
+    (list (artdag/dag-id d "a") (artdag/dag-id d "b") (artdag/dag-id d "c"))))
+
+(artdag-test
+  "topo order: deep chain"
+  (let
+    ((d (artdag/build (list (list "d" "f" (list "c") {}) (list "c" "f" (list "b") {}) (list "b" "f" (list "a") {}) (list "a" "load" (list) {})))))
+    (artdag/dag-order d))
+  (let
+    ((d (artdag/build (list (list "d" "f" (list "c") {}) (list "c" "f" (list "b") {}) (list "b" "f" (list "a") {}) (list "a" "load" (list) {})))))
+    (list
+      (artdag/dag-id d "a")
+      (artdag/dag-id d "b")
+      (artdag/dag-id d "c")
+      (artdag/dag-id d "d"))))
+
+; ---- accessors ----
+
+(artdag-test
+  "dag-node-by-name returns node spec"
+  (artdag/node-op
+    (artdag/dag-node-by-name
+      (artdag/build (list (list "a" "load" (list) {})))
+      "a"))
+  "load")
+
+(artdag-test
+  "resolved inputs are content-ids"
+  (let
+    ((d (artdag/build (list (list "a" "load" (list) {}) (list "b" "neg" (list "a") {})))))
+    (artdag/node-inputs (artdag/dag-node-by-name d "b")))
+  (let
+    ((d (artdag/build (list (list "a" "load" (list) {}) (list "b" "neg" (list "a") {})))))
+    (list (artdag/dag-id d "a"))))

lib/artdag/tests/execute.sx

@@ -0,0 +1,188 @@
+; Phase 4 — Execute: effect interpreter + content-addressed memo + incremental.
+
+(define ex-RT (artdag/op-table-runner {:in (fn (params inputs) (get params :v)) :add (fn (params inputs) (+ (nth inputs 0) (nth inputs 1))) :inc (fn (params inputs) (+ 1 (first inputs)))}))
+
+; two-leaf diamond: p,q leaves; b=inc(p); c=inc(q); d=add(b,c)
+(define
+  ex-D1
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 20})
+      (list "b" "inc" (list "p") {})
+      (list "c" "inc" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+; same shape, leaf q changed (20 -> 21)
+(define
+  ex-D2
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 21})
+      (list "b" "inc" (list "p") {})
+      (list "c" "inc" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+; a different dag that shares the p->b subgraph with ex-D1, plus z=inc(b)
+(define
+  ex-D3
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "b" "inc" (list "p") {})
+      (list "z" "inc" (list "b") {}))))
+
+; ---- full execution ----
+
+(artdag-test
+  "full run: result is correct"
+  (let
+    ((cache (persist/open)))
+    (artdag/result-of
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/dag-id ex-D1 "d")))
+  32)
+
+(artdag-test
+  "full run: cold cache recomputes every node"
+  (let
+    ((cache (persist/open)))
+    (artdag/recompute-count (artdag/run ex-D1 ex-RT cache)))
+  5)
+
+(artdag-test
+  "full run: cold cache has no hits"
+  (let
+    ((cache (persist/open)))
+    (artdag/hit-count (artdag/run ex-D1 ex-RT cache)))
+  0)
+
+; ---- memoization ----
+
+(artdag-test
+  "re-run unchanged: zero recomputes"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/recompute-count (artdag/run ex-D1 ex-RT cache))))
+  0)
+
+(artdag-test
+  "re-run unchanged: all cache hits"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/hit-count (artdag/run ex-D1 ex-RT cache))))
+  5)
+
+(artdag-test
+  "re-run unchanged: result preserved"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/result-of
+        (artdag/run ex-D1 ex-RT cache)
+        (artdag/dag-id ex-D1 "d"))))
+  32)
+
+; ---- incremental recompute (the keystone) ----
+
+(artdag-test
+  "leaf change recomputes only the dirty closure (count)"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/recompute-count (artdag/run ex-D2 ex-RT cache))))
+  3)
+
+(artdag-test
+  "leaf change: unchanged nodes are cache hits"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/hit-count (artdag/run ex-D2 ex-RT cache))))
+  2)
+
+(artdag-test
+  "leaf change: recomputed set is exactly q,c,d"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/recomputed (artdag/run ex-D2 ex-RT cache))))
+  (artdag/sort-strings
+    (list
+      (artdag/dag-id ex-D2 "q")
+      (artdag/dag-id ex-D2 "c")
+      (artdag/dag-id ex-D2 "d"))))
+
+(artdag-test
+  "leaf change: untouched sibling p is reused"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/member?
+        (artdag/dag-id ex-D2 "p")
+        (get (artdag/run ex-D2 ex-RT cache) :hits))))
+  true)
+
+(artdag-test
+  "leaf change: new result is correct"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/result-of
+        (artdag/run ex-D2 ex-RT cache)
+        (artdag/dag-id ex-D2 "d"))))
+  33)
+
+; ---- explicit dirty-only execution ----
+
+(artdag-test
+  "run-dirty: schedules only the changed closure"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/recompute-count
+        (artdag/run-dirty ex-D2 (list (artdag/dag-id ex-D2 "q")) ex-RT cache))))
+  3)
+
+; ---- cross-dag cache sharing (content addressing) ----
+
+(artdag-test
+  "shared subgraph hits cache across different dags"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/recompute-count (artdag/run ex-D3 ex-RT cache))))
+  1)
+
+(artdag-test
+  "shared subgraph: p and b reused across dags"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/hit-count (artdag/run ex-D3 ex-RT cache))))
+  2)
+
+(artdag-test
+  "shared subgraph: z still computes correctly"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run ex-D1 ex-RT cache)
+      (artdag/result-of
+        (artdag/run ex-D3 ex-RT cache)
+        (artdag/dag-id ex-D3 "z"))))
+  12)

lib/artdag/tests/fault.sx

@@ -0,0 +1,144 @@
+; fault-tolerant execution: failure confined to its closure, cache never poisoned.
+
+(define ft-BAD (artdag/op-table-runner {:boom (fn (p i) (artdag/fail "kaboom")) :in (fn (p i) (get p :v)) :add (fn (p i) (+ (nth i 0) (nth i 1))) :inc (fn (p i) (+ 1 (first i)))}))
+
+(define ft-GOOD (artdag/op-table-runner {:boom (fn (p i) 99) :in (fn (p i) (get p :v)) :add (fn (p i) (+ (nth i 0) (nth i 1))) :inc (fn (p i) (+ 1 (first i)))}))
+
+; p,q leaves; b=inc(p) (independent); c=boom(q); d=add(b,c)
+(define
+  ft-D
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 20})
+      (list "b" "inc" (list "p") {})
+      (list "c" "boom" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+; ---- markers ----
+
+(artdag-test
+  "fail constructor is detected"
+  (artdag/failed? (artdag/fail "x"))
+  true)
+
+(artdag-test
+  "plain values are not failures"
+  (artdag/failed? 42)
+  false)
+
+; ---- failure confinement ----
+
+(artdag-test
+  "failure count covers node and its dependents"
+  (let
+    ((cache (persist/open)))
+    (artdag/failure-count (artdag/run-safe ft-D ft-BAD cache)))
+  2)
+
+(artdag-test
+  "failed set is exactly c and d"
+  (let
+    ((cache (persist/open)))
+    (artdag/failed-nodes (artdag/run-safe ft-D ft-BAD cache)))
+  (artdag/sort-strings
+    (list (artdag/dag-id ft-D "c") (artdag/dag-id ft-D "d"))))
+
+(artdag-test
+  "independent branch still computes"
+  (let
+    ((cache (persist/open)))
+    (artdag/recompute-count (artdag/run-safe ft-D ft-BAD cache)))
+  3)
+
+(artdag-test
+  "independent node result is available"
+  (let
+    ((cache (persist/open)))
+    (artdag/result-of
+      (artdag/run-safe ft-D ft-BAD cache)
+      (artdag/dag-id ft-D "b")))
+  11)
+
+(artdag-test
+  "all-ok? is false when something failed"
+  (let
+    ((cache (persist/open)))
+    (artdag/all-ok? (artdag/run-safe ft-D ft-BAD cache)))
+  false)
+
+(artdag-test
+  "all-ok? is true on a clean run"
+  (let
+    ((cache (persist/open)))
+    (artdag/all-ok? (artdag/run-safe ft-D ft-GOOD cache)))
+  true)
+
+; ---- cache integrity ----
+
+(artdag-test
+  "good node is cached"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run-safe ft-D ft-BAD cache)
+      (persist/kv-has? cache (artdag/dag-id ft-D "b"))))
+  true)
+
+(artdag-test
+  "failed node is never cached"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run-safe ft-D ft-BAD cache)
+      (persist/kv-has? cache (artdag/dag-id ft-D "c"))))
+  false)
+
+; ---- retry after fix ----
+
+(artdag-test
+  "retry recomputes only the failed closure"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run-safe ft-D ft-BAD cache)
+      (artdag/recompute-count (artdag/run-safe ft-D ft-GOOD cache))))
+  2)
+
+(artdag-test
+  "retry reuses the good nodes from cache"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run-safe ft-D ft-BAD cache)
+      (artdag/hit-count (artdag/run-safe ft-D ft-GOOD cache))))
+  3)
+
+(artdag-test
+  "retry produces the correct result"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run-safe ft-D ft-BAD cache)
+      (artdag/result-of
+        (artdag/run-safe ft-D ft-GOOD cache)
+        (artdag/dag-id ft-D "d"))))
+  110)
+
+; ---- transitive cascade ----
+
+(artdag-test
+  "failure cascades through a deep chain"
+  (let
+    ((cache (persist/open)))
+    (artdag/failure-count
+      (artdag/run-safe
+        (artdag/build
+          (list
+            (list "a" "in" (list) {:v 1})
+            (list "b" "boom" (list "a") {})
+            (list "c" "inc" (list "b") {})
+            (list "d" "inc" (list "c") {})))
+        ft-BAD
+        cache)))
+  3)

lib/artdag/tests/fed.sx

@@ -0,0 +1,157 @@
+; Phase 6 — federation: shared content-addressed cache, trust gating, invalidation.
+
+(define fed-BASE (artdag/op-table-runner {:in (fn (params inputs) (get params :v)) :add (fn (params inputs) (+ (nth inputs 0) (nth inputs 1))) :inc (fn (params inputs) (+ 1 (first inputs)))}))
+
+(define
+  fed-D
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 20})
+      (list "b" "inc" (list "p") {})
+      (list "c" "inc" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+(define fed-trust-A (fn (p) (= p "A")))
+(define fed-trust-none (fn (p) false))
+
+; a warmed instance A and its export bundle (origin peer "A").
+(define fed-A (artdag/fed-open))
+(define fed-warm (artdag/fed-run fed-A fed-D fed-BASE))
+(define fed-bundle (artdag/fed-export fed-A "A"))
+
+; ---- export ----
+
+(artdag-test
+  "export: bundle covers every cached node"
+  (len fed-bundle)
+  5)
+
+; ---- remote cache hit ----
+
+(artdag-test
+  "trusted import enables remote cache hit (no recompute)"
+  (artdag/recompute-count
+    (artdag/fed-run
+      (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)
+      fed-D
+      fed-BASE))
+  0)
+
+(artdag-test
+  "trusted import: every node is a hit"
+  (artdag/hit-count
+    (artdag/fed-run
+      (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)
+      fed-D
+      fed-BASE))
+  5)
+
+(artdag-test
+  "remote hit yields correct result"
+  (artdag/result-of
+    (artdag/fed-run
+      (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)
+      fed-D
+      fed-BASE)
+    (artdag/dag-id fed-D "d"))
+  32)
+
+; ---- trust gating ----
+
+(artdag-test
+  "untrusted peer is rejected (recompute everything)"
+  (artdag/recompute-count
+    (artdag/fed-run
+      (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-none)
+      fed-D
+      fed-BASE))
+  5)
+
+(artdag-test
+  "trust gating: untrusted records never enter the cache"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) (cons {:peer "C" :cid "node:foreign" :result 99} fed-bundle) fed-trust-A)))
+    (persist/kv-has? (artdag/fed-cache B) "node:foreign"))
+  false)
+
+(artdag-test
+  "trust gating: trusted records still admitted alongside rejected"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) (cons {:peer "C" :cid "node:foreign" :result 99} fed-bundle) fed-trust-A)))
+    (persist/kv-has? (artdag/fed-cache B) (artdag/dag-id fed-D "d")))
+  true)
+
+; ---- provenance ----
+
+(artdag-test
+  "provenance is recorded for imported results"
+  (get
+    (artdag/fed-prov
+      (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A))
+    (artdag/dag-id fed-D "d"))
+  "A")
+
+(artdag-test
+  "locally computed results carry no provenance"
+  (len (keys (artdag/fed-prov fed-A)))
+  0)
+
+; ---- injected transport ----
+
+(artdag-test
+  "fed-pull imports via an injected fetch transport"
+  (artdag/recompute-count
+    (artdag/fed-run
+      (artdag/fed-pull
+        (artdag/fed-open)
+        (fn (peer) fed-bundle)
+        "A"
+        fed-trust-A)
+      fed-D
+      fed-BASE))
+  0)
+
+; ---- invalidation ----
+
+(artdag-test
+  "invalidation drops a peer's results (recompute again)"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)))
+    (artdag/recompute-count
+      (artdag/fed-run (artdag/fed-invalidate B "A") fed-D fed-BASE)))
+  5)
+
+(artdag-test
+  "invalidation: recomputed result still correct"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)))
+    (artdag/result-of
+      (artdag/fed-run (artdag/fed-invalidate B "A") fed-D fed-BASE)
+      (artdag/dag-id fed-D "d")))
+  32)
+
+(artdag-test
+  "invalidation: provenance map is cleared for that peer"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) fed-bundle fed-trust-A)))
+    (len (keys (artdag/fed-prov (artdag/fed-invalidate B "A")))))
+  0)
+
+(artdag-test
+  "invalidation is peer-scoped: other peers' results survive"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) (cons {:peer "C" :cid "node:fromC" :result 7} fed-bundle) (fn (p) true))))
+    (persist/kv-has?
+      (artdag/fed-cache (artdag/fed-invalidate B "A"))
+      "node:fromC"))
+  true)
+
+(artdag-test
+  "invalidation is peer-scoped: target peer's results removed"
+  (let
+    ((B (artdag/fed-import (artdag/fed-open) (cons {:peer "C" :cid "node:fromC" :result 7} fed-bundle) (fn (p) true))))
+    (persist/kv-has?
+      (artdag/fed-cache (artdag/fed-invalidate B "A"))
+      (artdag/dag-id fed-D "d")))
+  false)

lib/artdag/tests/maude-optimize.sx

@@ -0,0 +1,345 @@
+; Phase 7 — rule-based optimization via maude-on-sx.
+; Bridge round-trip: dag->term->dag is the identity on canonical (content-id) form.
+
+; ---- linear chain a -> b -> c (b carries params) ----
+
+(define
+  mo-chain
+  (artdag/build
+    (list
+      (list "a" "in" (list) {:v 5})
+      (list "b" "blur" (list "a") {:radius 2})
+      (list "c" "blur" (list "b") {:radius 3}))))
+(define mo-c-id (artdag/dag-id mo-chain "c"))
+(define mo-chain-rt (artdag/mb-roundtrip mo-chain mo-c-id))
+
+(artdag-test
+  "roundtrip: sink id preserved"
+  (artdag/member? mo-c-id (keys (artdag/dag-nodes mo-chain-rt)))
+  true)
+
+(artdag-test
+  "roundtrip: node count preserved"
+  (artdag/node-count mo-chain-rt)
+  3)
+
+(artdag-test
+  "roundtrip: sink op preserved"
+  (artdag/node-op (artdag/dag-get mo-chain-rt mo-c-id))
+  "blur")
+
+(artdag-test
+  "roundtrip: sink params preserved"
+  (artdag/node-params (artdag/dag-get mo-chain-rt mo-c-id))
+  {:radius 3})
+
+(artdag-test
+  "roundtrip: full reconstructed node equals original"
+  (= (artdag/dag-get mo-chain-rt mo-c-id) (artdag/dag-get mo-chain mo-c-id))
+  true)
+
+; ---- term shape ----
+
+(define mo-c-term (artdag/dag->term mo-chain mo-c-id))
+
+(artdag-test "term: sink op is the maude operator" (mau/op mo-c-term) "blur")
+
+(artdag-test
+  "term: params recovered from meta"
+  (artdag/term-params mo-c-term)
+  {:radius 3})
+
+(artdag-test
+  "term: commutative flag recovered (false)"
+  (artdag/term-commutative mo-c-term)
+  false)
+
+(artdag-test
+  "term->entries: one entry per node"
+  (len (artdag/term->entries mo-c-term))
+  3)
+
+; ---- commutative node: order-insensitive id survives round-trip ----
+
+(define
+  mo-comm
+  (artdag/build
+    (list
+      (list "x" "src" (list) {})
+      (list "y" "noise" (list) {})
+      (list "z" "over" (list "x" "y") {} true))))
+(define mo-z-id (artdag/dag-id mo-comm "z"))
+(define mo-comm-rt (artdag/mb-roundtrip mo-comm mo-z-id))
+
+(artdag-test
+  "roundtrip comm: commutative id preserved"
+  (artdag/member? mo-z-id (keys (artdag/dag-nodes mo-comm-rt)))
+  true)
+
+(artdag-test
+  "term comm: commutative flag recovered (true)"
+  (artdag/term-commutative (artdag/dag->term mo-comm mo-z-id))
+  true)
+
+; ---- diamond: shared subgraph re-collapses to one node ----
+
+(define
+  mo-diamond
+  (artdag/build
+    (list
+      (list "a" "src" (list) {})
+      (list "b" "blur" (list "a") {:radius 1})
+      (list "c" "bright" (list "a") {:gain 2})
+      (list "d" "over" (list "b" "c") {} true))))
+(define mo-d-id (artdag/dag-id mo-diamond "d"))
+(define mo-diamond-rt (artdag/mb-roundtrip mo-diamond mo-d-id))
+
+(artdag-test
+  "roundtrip diamond: shared node not duplicated"
+  (artdag/node-count mo-diamond-rt)
+  4)
+
+(artdag-test
+  "roundtrip diamond: sink id preserved"
+  (artdag/member? mo-d-id (keys (artdag/dag-nodes mo-diamond-rt)))
+  true)
+
+(artdag-test
+  "roundtrip diamond: shared src id preserved"
+  (artdag/member?
+    (artdag/dag-id mo-diamond "a")
+    (keys (artdag/dag-nodes mo-diamond-rt)))
+  true)
+
+; ---- optimisation laws as a confluent maude module (optimize-rules.sx) ----
+; The optimised pipeline is the normal form; confluence => stable content id.
+
+(artdag-test "opt module is confluent" (artdag/opt-confluent?) true)
+
+(artdag-test
+  "opt module has no non-joinable critical pairs"
+  (len (artdag/opt-non-joinable))
+  0)
+
+(artdag-test
+  "law: identity elimination"
+  (artdag/opt-normal-form "id(src)")
+  "src")
+
+(artdag-test
+  "law: zero-radius blur is a no-op"
+  (artdag/opt-normal-form "blur(src, 0)")
+  "src")
+
+(artdag-test
+  "law: zero-radius bright is a no-op"
+  (artdag/opt-normal-form "bright(src, 0)")
+  "src")
+
+(artdag-test
+  "law: adjacent blur fusion adds radii"
+  (artdag/opt-normal-form "blur(blur(src, 1), 1)")
+  "blur(src, _+_(1, 1))")
+
+(artdag-test
+  "fusion normal form is rewrite-order stable"
+  (artdag/opt-same-form?
+    "blur(blur(blur(src, 1), 1), 1)"
+    "blur(blur(src, 1 + 1), 1)")
+  true)
+
+(artdag-test
+  "laws compose: id + no-op + fusion"
+  (artdag/opt-normal-form "bright(id(blur(blur(src, 1), 1)), 0)")
+  "blur(src, _+_(1, 1))")
+
+(artdag-test
+  "law: idempotent over dedup (CSE)"
+  (artdag/opt-normal-form "over(blur(src, 1), blur(src, 1))")
+  "blur(src, 1)")
+
+(artdag-test
+  "distinct over operands do not dedup"
+  (artdag/opt-same-form? "over(blur(src, 1), blur(src, 1 + 1))" "blur(src, 1)")
+  false)
+
+(artdag-test
+  "distinct pipelines stay distinct"
+  (artdag/opt-same-form? "blur(src, 1)" "bright(src, 1)")
+  false)
+
+; ---- bridge the normal form back to a runnable DAG (opt-reduce) ----
+; result-preserving: the maude-optimised DAG executes to the same result as the
+; original, with fewer nodes. Runner is a numeric op model (blur/bright additive in
+; radius, id pass-through, over idempotent) so the pipeline algebra holds concretely.
+
+(define
+  mo-eq-runner
+  (artdag/op-table-runner
+    {:src (fn (params inputs) 0)
+      :blur (fn (params inputs) (+ (first inputs) (get params :radius)))
+      :bright (fn (params inputs) (+ (first inputs) (* 100 (get params :radius))))
+      :id (fn (params inputs) (first inputs))
+      :over (fn (params inputs) (if (= (nth inputs 0) (nth inputs 1)) (nth inputs 0) (+ (nth inputs 0) (nth inputs 1))))}))
+
+(define
+  mo-eq-result
+  (fn (dag id) (artdag/result-of (artdag/run dag mo-eq-runner (persist/open)) id)))
+
+(define
+  mo-eq-opt-result
+  (fn
+    (dag id)
+    (let
+      ((o (artdag/opt-reduce dag id)))
+      (artdag/result-of (artdag/run o mo-eq-runner (persist/open)) (artdag/opt-last (artdag/dag-order o))))))
+
+; fixture: blur;blur chain + id + zero-radius bright (all collapse to one blur)
+(define
+  mo-chain5
+  (artdag/build
+    (list
+      (list "s" "src" (list) {})
+      (list "b1" "blur" (list "s") {:radius 1})
+      (list "b2" "blur" (list "b1") {:radius 1})
+      (list "i" "id" (list "b2") {})
+      (list "z" "bright" (list "i") {:radius 0}))))
+(define mo-chain5-id (artdag/dag-id mo-chain5 "z"))
+(define mo-chain5-opt (artdag/opt-reduce mo-chain5 mo-chain5-id))
+(define mo-chain5-sink (artdag/opt-last (artdag/dag-order mo-chain5-opt)))
+
+(artdag-test
+  "opt-reduce: 5-node chain collapses to 2 nodes"
+  (artdag/node-count mo-chain5-opt)
+  2)
+
+(artdag-test
+  "opt-reduce: fused sink op is blur"
+  (artdag/node-op (artdag/dag-get mo-chain5-opt mo-chain5-sink))
+  "blur")
+
+(artdag-test
+  "opt-reduce: fused sink radius is the sum"
+  (artdag/node-params (artdag/dag-get mo-chain5-opt mo-chain5-sink))
+  {:radius 2})
+
+(artdag-test
+  "opt-reduce: result-preserving on chain"
+  (= (mo-eq-result mo-chain5 mo-chain5-id) (mo-eq-opt-result mo-chain5 mo-chain5-id))
+  true)
+
+; fixture: over of identical subpipelines (idempotent dedup)
+(define
+  mo-dedup
+  (artdag/build
+    (list
+      (list "s" "src" (list) {})
+      (list "b" "blur" (list "s") {:radius 2})
+      (list "o" "over" (list "b" "b") {} true))))
+(define mo-dedup-id (artdag/dag-id mo-dedup "o"))
+
+(artdag-test
+  "opt-reduce: over dedup collapses to 2 nodes"
+  (artdag/node-count (artdag/opt-reduce mo-dedup mo-dedup-id))
+  2)
+
+(artdag-test
+  "opt-reduce: result-preserving on dedup"
+  (= (mo-eq-result mo-dedup mo-dedup-id) (mo-eq-opt-result mo-dedup mo-dedup-id))
+  true)
+
+; non-optimisable DAG: opt-reduce is a faithful round-trip (no laws fire)
+(define
+  mo-plain
+  (artdag/build
+    (list
+      (list "s" "src" (list) {})
+      (list "b" "blur" (list "s") {:radius 3}))))
+(define mo-plain-id (artdag/dag-id mo-plain "b"))
+(define mo-plain-opt (artdag/opt-reduce mo-plain mo-plain-id))
+
+(artdag-test
+  "opt-reduce: untouched DAG keeps its node count"
+  (artdag/node-count mo-plain-opt)
+  2)
+
+(artdag-test
+  "opt-reduce: untouched DAG keeps its radius (unary round-trip)"
+  (artdag/node-params
+    (artdag/dag-get mo-plain-opt (artdag/opt-last (artdag/dag-order mo-plain-opt))))
+  {:radius 3})
+
+; ---- cost-directed: optimisation never increases cost ----
+
+(define
+  mo-rcost
+  (fn (op params) (if (= op "blur") (max 1 (get params :radius)) 1)))
+
+(artdag-test
+  "opt-improvement: const-cost total work drops on fused chain"
+  (let ((imp (artdag/opt-improvement mo-chain5 mo-chain5-id artdag/const-cost)))
+    (list (get imp :before) (get imp :after)))
+  (list 5 2))
+
+(artdag-test
+  "opt-improvement: critical path shrinks under const cost"
+  (let ((imp (artdag/opt-improvement mo-chain5 mo-chain5-id artdag/const-cost)))
+    (< (get imp :after-path) (get imp :before-path)))
+  true)
+
+(artdag-test
+  "opt-cheaper?: fused chain is cheaper under radius-weighted cost"
+  (artdag/opt-cheaper? mo-chain5 mo-chain5-id mo-rcost)
+  true)
+
+(artdag-test
+  "opt-cheaper?: over dedup is cheaper"
+  (artdag/opt-cheaper? mo-dedup mo-dedup-id artdag/const-cost)
+  true)
+
+(artdag-test
+  "opt-cheaper?: untouched DAG keeps equal cost (never a pessimisation)"
+  (artdag/opt-cheaper? mo-plain mo-plain-id artdag/const-cost)
+  true)
+
+; ---- the confluence gate is meaningful, not vacuous ----
+; the Peano-arithmetic variant of the same laws is KNOWN non-confluent (M+0 sticks,
+; (A+B)+C vs A+(B+C) don't join). Assert the checker actually catches it, so the
+; green "opt module is confluent" above is real evidence, not a checker that passes
+; everything.
+
+(define
+  mo-peano-module
+  (mau/parse-module
+    (str
+      "fmod ARTDAGPEANO is\n"
+      "  sorts Img Num .\n"
+      "  op src : -> Img .\n"
+      "  op 0 : -> Num .\n"
+      "  op s_ : Num -> Num .\n"
+      "  op _+_ : Num Num -> Num .\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 0 + N = N .\n"
+      "  eq s M + N = s (M + N) .\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")))
+
+(artdag-test
+  "confluence gate is real: Peano variant is flagged non-confluent"
+  (mau/confluent? mo-peano-module)
+  false)
+
+(artdag-test
+  "confluence gate is real: Peano variant names its non-joinable pairs"
+  (> (len (mau/non-joinable-pairs mo-peano-module)) 0)
+  true)

lib/artdag/tests/optimize.sx

@@ -0,0 +1,215 @@
+; Phase 5 — optimization: DCE, CSE (content-id sharing), adjacent-op fusion.
+
+(define opt-BASE (artdag/op-table-runner {:in (fn (params inputs) (get params :v)) :sq (fn (params inputs) (* (first inputs) (first inputs))) :add (fn (params inputs) (+ (nth inputs 0) (nth inputs 1))) :inc (fn (params inputs) (+ 1 (first inputs)))}))
+(define opt-RUN (artdag/fusing-runner opt-BASE))
+(define opt-inc? (fn (op) (= op "inc")))
+(define opt-incsq? (fn (op) (or (= op "inc") (= op "sq"))))
+
+; linear chain a(in) -> b -> c -> d, all inc
+(define
+  opt-chain
+  (list
+    (list "a" "in" (list) {:v 5})
+    (list "b" "inc" (list "a") {})
+    (list "c" "inc" (list "b") {})
+    (list "d" "inc" (list "c") {})))
+
+; ---- DCE ----
+
+(define
+  dce-entries
+  (list
+    (list "a" "in" (list) {:v 5})
+    (list "b" "inc" (list "a") {})
+    (list "c" "inc" (list "b") {})
+    (list "x" "sq" (list "a") {})))
+(define dce-G (artdag/build dce-entries))
+
+(artdag-test
+  "dce: removes dead node"
+  (artdag/node-count (artdag/dce dce-G (list (artdag/dag-id dce-G "c"))))
+  3)
+
+(artdag-test
+  "dce: keeps live closure intact"
+  (artdag/node-count (artdag/dce dce-G (list (artdag/dag-id dce-G "x"))))
+  2)
+
+(artdag-test
+  "dce: preserves surviving node ids"
+  (artdag/member?
+    (artdag/dag-id dce-G "c")
+    (keys
+      (artdag/dag-nodes (artdag/dce dce-G (list (artdag/dag-id dce-G "c"))))))
+  true)
+
+(artdag-test
+  "dce: output result unchanged after elimination"
+  (let
+    ((cache (persist/open)))
+    (artdag/result-of
+      (artdag/run
+        (artdag/dce dce-G (list (artdag/dag-id dce-G "c")))
+        opt-RUN
+        cache)
+      (artdag/dag-id dce-G "c")))
+  7)
+
+(artdag-test
+  "dce: nothing dead is a no-op on count"
+  (artdag/node-count
+    (artdag/dce
+      dce-G
+      (list (artdag/dag-id dce-G "c") (artdag/dag-id dce-G "x"))))
+  4)
+
+; ---- CSE (free from content addressing) ----
+
+(define
+  cse-entries
+  (list
+    (list "a" "in" (list) {:v 3})
+    (list "s1" "sq" (list "a") {})
+    (list "s2" "sq" (list "a") {})
+    (list "d" "add" (list "s1" "s2") {} true)))
+(define cse-C (artdag/cse cse-entries))
+
+(artdag-test
+  "cse: identical subexpressions collapse to one node"
+  (artdag/node-count cse-C)
+  3)
+
+(artdag-test
+  "cse: shared node computes once"
+  (let
+    ((cache (persist/open)))
+    (artdag/recompute-count (artdag/run cse-C opt-RUN cache)))
+  3)
+
+(artdag-test
+  "cse: s1 and s2 are the same id"
+  (equal? (artdag/dag-id cse-C "s1") (artdag/dag-id cse-C "s2"))
+  true)
+
+(artdag-test
+  "cse: result is correct"
+  (let
+    ((cache (persist/open)))
+    (artdag/result-of
+      (artdag/run cse-C opt-RUN cache)
+      (artdag/dag-id cse-C "d")))
+  18)
+
+; ---- fusion ----
+
+(artdag-test
+  "fusion: collapses a unary chain"
+  (artdag/node-count (artdag/fuse opt-chain opt-inc?))
+  2)
+
+(artdag-test
+  "fusion: unfused has all nodes"
+  (artdag/node-count (artdag/build opt-chain))
+  4)
+
+(artdag-test
+  "fusion: output-equivalent to unfused"
+  (let
+    ((c1 (persist/open)) (c2 (persist/open)))
+    (=
+      (artdag/result-of
+        (artdag/run (artdag/build opt-chain) opt-RUN c1)
+        (artdag/dag-id (artdag/build opt-chain) "d"))
+      (artdag/result-of
+        (artdag/run (artdag/fuse opt-chain opt-inc?) opt-RUN c2)
+        (artdag/dag-id (artdag/fuse opt-chain opt-inc?) "d"))))
+  true)
+
+(artdag-test
+  "fusion: leaf is never fused"
+  (artdag/node-op
+    (artdag/dag-node-by-name (artdag/fuse opt-chain opt-inc?) "a"))
+  "in")
+
+(artdag-test
+  "fusion: tail becomes a pipeline node"
+  (artdag/node-op
+    (artdag/dag-node-by-name (artdag/fuse opt-chain opt-inc?) "d"))
+  "artdag/pipeline")
+
+(artdag-test
+  "fusion: mixed fusible set fuses across op kinds"
+  (artdag/node-count
+    (artdag/fuse
+      (list
+        (list "a" "in" (list) {:v 2})
+        (list "b" "inc" (list "a") {})
+        (list "c" "sq" (list "b") {})
+        (list "d" "inc" (list "c") {}))
+      opt-incsq?))
+  2)
+
+(artdag-test
+  "fusion: mixed chain replays correctly"
+  (let
+    ((cache (persist/open)))
+    (let
+      ((f (artdag/fuse (list (list "a" "in" (list) {:v 2}) (list "b" "inc" (list "a") {}) (list "c" "sq" (list "b") {}) (list "d" "inc" (list "c") {})) opt-incsq?)))
+      (artdag/result-of (artdag/run f opt-RUN cache) (artdag/dag-id f "d"))))
+  10)
+
+(artdag-test
+  "fusion: fanout node is not fused"
+  (artdag/node-count
+    (artdag/fuse
+      (list
+        (list "a" "in" (list) {:v 1})
+        (list "b" "inc" (list "a") {})
+        (list "c" "inc" (list "b") {})
+        (list "e" "sq" (list "b") {}))
+      opt-inc?))
+  4)
+
+(artdag-test
+  "fusion: empty fusible set leaves dag unchanged"
+  (artdag/node-count (artdag/fuse opt-chain (fn (op) false)))
+  4)
+
+; ---- full optimization pass (fuse + dce) ----
+
+(define
+  optp-entries
+  (list
+    (list "a" "in" (list) {:v 5})
+    (list "b" "inc" (list "a") {})
+    (list "c" "inc" (list "b") {})
+    (list "x" "sq" (list "a") {})))
+
+(artdag-test
+  "optimize: fuses chain and drops dead node"
+  (artdag/node-count (artdag/optimize optp-entries (list "c") opt-inc?))
+  2)
+
+(artdag-test
+  "optimize: leaves dead node when it is an output"
+  (artdag/node-count (artdag/optimize optp-entries (list "c" "x") opt-inc?))
+  3)
+
+(artdag-test
+  "optimize: result equals the unoptimized dag"
+  (let
+    ((c1 (persist/open)) (c2 (persist/open)))
+    (let
+      ((o (artdag/optimize optp-entries (list "c") opt-inc?)))
+      (=
+        (artdag/result-of (artdag/run o opt-RUN c1) (artdag/dag-id o "c"))
+        (artdag/result-of
+          (artdag/run (artdag/build optp-entries) opt-RUN c2)
+          (artdag/dag-id (artdag/build optp-entries) "c")))))
+  true)
+
+(artdag-test
+  "optimize: no fusible ops still drops dead nodes"
+  (artdag/node-count
+    (artdag/optimize optp-entries (list "c") (fn (op) false)))
+  3)

lib/artdag/tests/plan.sx

@@ -0,0 +1,122 @@
+; Phase 3 — Plan: topological batches under a parallelism cap, incremental plan.
+
+; diamond:  a -> b, a -> c, (b,c) -> d
+(define
+  pl-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 pl-a (artdag/dag-id pl-D "a"))
+(define pl-b (artdag/dag-id pl-D "b"))
+(define pl-c (artdag/dag-id pl-D "c"))
+(define pl-d (artdag/dag-id pl-D "d"))
+
+; wide:  a -> b, c, e, f  (four independent dependents)
+(define
+  pl-W
+  (artdag/build
+    (list
+      (list "a" "load" (list) {})
+      (list "b" "f" (list "a") {})
+      (list "c" "g" (list "a") {})
+      (list "e" "h" (list "a") {})
+      (list "f" "k" (list "a") {}))))
+
+; ---- full plan, unlimited width ----
+
+(artdag-test
+  "full plan: batch count"
+  (artdag/plan-batches (artdag/plan pl-D 0))
+  3)
+
+(artdag-test
+  "full plan: schedules every node"
+  (artdag/plan-size (artdag/plan pl-D 0))
+  4)
+
+(artdag-test
+  "full plan: first batch is the leaf"
+  (first (artdag/plan pl-D 0))
+  (list pl-a))
+
+(artdag-test
+  "full plan: middle batch runs b,c in parallel"
+  (first (rest (artdag/plan pl-D 0)))
+  (artdag/sort-strings (list pl-b pl-c)))
+
+(artdag-test
+  "full plan: last batch is the sink"
+  (first (rest (rest (artdag/plan pl-D 0))))
+  (list pl-d))
+
+(artdag-test
+  "full plan: max width is 2"
+  (artdag/plan-width (artdag/plan pl-D 0))
+  2)
+
+; ---- parallelism cap ----
+
+(artdag-test
+  "cap 1: width never exceeds 1"
+  (artdag/plan-width (artdag/plan pl-D 1))
+  1)
+
+(artdag-test
+  "cap 1: serializes into one node per batch"
+  (artdag/plan-batches (artdag/plan pl-D 1))
+  4)
+
+(artdag-test
+  "cap larger than widest wave is a no-op"
+  (artdag/plan pl-D 10)
+  (artdag/plan pl-D 0))
+
+(artdag-test
+  "wide cap 2: width capped at 2"
+  (artdag/plan-width (artdag/plan pl-W 2))
+  2)
+
+(artdag-test
+  "wide cap 2: leaf wave then two capped sub-batches"
+  (artdag/plan-batches (artdag/plan pl-W 2))
+  3)
+
+(artdag-test
+  "wide cap 2: still schedules all five nodes"
+  (artdag/plan-size (artdag/plan pl-W 2))
+  5)
+
+(artdag-test
+  "wide unlimited: single wave of four after leaf"
+  (artdag/plan-width (artdag/plan pl-W 0))
+  4)
+
+; ---- incremental (dirty-only) plan ----
+
+(artdag-test
+  "dirty plan: schedules only the dirty closure"
+  (artdag/plan-size (artdag/plan-dirty pl-D (list pl-b) 0))
+  2)
+
+(artdag-test
+  "dirty plan: b then d"
+  (artdag/plan-dirty pl-D (list pl-b) 0)
+  (list (list pl-b) (list pl-d)))
+
+(artdag-test
+  "dirty plan: clean deps treated as satisfied"
+  (first (artdag/plan-dirty pl-D (list pl-b) 0))
+  (list pl-b))
+
+(artdag-test
+  "dirty plan: leaf change replans whole graph"
+  (artdag/plan-size (artdag/plan-dirty pl-D (list pl-a) 0))
+  4)
+
+(artdag-test
+  "dirty plan: sink change is a single batch"
+  (artdag/plan-dirty pl-D (list pl-d) 0)
+  (list (list pl-d)))

lib/artdag/tests/post.sx

@@ -0,0 +1,111 @@
+; Forward direction — artdag job as a feed "post object" (per the host loop).
+; A job projects to a content-addressed, self-verifying object suitable as a feed
+; activity :object; a peer decodes, verifies and runs it to the same result.
+
+(define po-runner (artdag/op-table-runner {:blur (fn (params inputs) (+ (first inputs) (get params :radius))) :src (fn (params inputs) 0) :over (fn (params inputs) (+ (nth inputs 0) (nth inputs 1)))}))
+
+(define
+  po-job
+  (artdag/build
+    (list
+      (list "s" "src" (list) {})
+      (list "b" "blur" (list "s") {:radius 2})
+      (list "c" "blur" (list "s") {:radius 3})
+      (list "out" "over" (list "b" "c") {} true))))
+(define po-out-id (artdag/dag-id po-job "out"))
+(define po-post (artdag/job->post-object po-job "out"))
+
+(artdag-test
+  "post: is a well-formed post object"
+  (artdag/post-object? po-post)
+  true)
+
+(artdag-test "post: type tag is artdag/job" (get po-post :type) "artdag/job")
+
+(artdag-test
+  "post: post id is the output node's content-id"
+  (artdag/post-object-id po-post)
+  po-out-id)
+
+(artdag-test
+  "post: payload is the whole dag (one record per node)"
+  (len (artdag/post-object-wire po-post))
+  (artdag/node-count po-job))
+
+(artdag-test
+  "post: verifies (ids intact, output present)"
+  (artdag/post-object-verify po-post)
+  true)
+
+; ---- round-trip: decode reconstructs the job by content-id ----
+
+(define po-job2 (artdag/post-object->job po-post))
+
+(artdag-test
+  "post: decoded job contains the output node by content-id"
+  (artdag/member? po-out-id (keys (artdag/dag-nodes po-job2)))
+  true)
+
+(artdag-test
+  "post: decoded job has the same node count"
+  (artdag/node-count po-job2)
+  (artdag/node-count po-job))
+
+; ---- string transport (feed activity / SXTP body) ----
+
+(define po-str (artdag/job->post-string po-job "out"))
+(define po-post2 (artdag/post-string->object po-str))
+
+(artdag-test
+  "post: survives string transport (id preserved)"
+  (artdag/post-object-id po-post2)
+  po-out-id)
+
+(artdag-test
+  "post: transported post still verifies"
+  (artdag/post-object-verify po-post2)
+  true)
+
+; ---- a peer runs the received post to the same result ----
+
+(define
+  po-local-result
+  (artdag/result-of (artdag/run po-job po-runner (persist/open)) po-out-id))
+(define po-peer-result (artdag/post-run po-post2 po-runner (persist/open)))
+
+(artdag-test
+  "post: peer runs the received job to the same result"
+  (= po-peer-result po-local-result)
+  true)
+
+; ---- tamper detection: mutate a param under a stale id ----
+
+(define
+  po-tampered
+  (assoc
+    po-post
+    :wire (map
+      (fn
+        (rec)
+        (if
+          (= (nth rec 1) "blur")
+          (list
+            (nth rec 0)
+            (nth rec 1)
+            (nth rec 2)
+            {:radius 99}
+            (nth rec 4))
+          rec))
+      (artdag/post-object-wire po-post))))
+
+(artdag-test
+  "post: tampered payload fails verification"
+  (artdag/post-object-verify po-tampered)
+  false)
+
+; ---- an id not produced by the job fails verification ----
+
+(artdag-test
+  "post: post id absent from payload fails verification"
+  (artdag/post-object-verify (assoc po-post :id "node:bogus"))
+  false)

lib/artdag/tests/schedule.sx

@@ -0,0 +1,127 @@
+; Phase 3/7 (optional) — relational scheduling on lib/minikanren CLP(FD).
+; Each node gets a slot var; edges impose fd-lt; fd-label searches. The ASAP solution
+; agrees with plan.sx's greedy Kahn waves; enumerating all solutions is the extra.
+
+; ---- linear chain a -> b -> c: exactly one minimal schedule ----
+
+(define
+  sc-chain
+  (artdag/build
+    (list
+      (list "a" "src" (list) {})
+      (list "b" "blur" (list "a") {:radius 1})
+      (list "c" "blur" (list "b") {:radius 2}))))
+(define sc-chain-a (artdag/dag-id sc-chain "a"))
+(define sc-chain-b (artdag/dag-id sc-chain "b"))
+(define sc-chain-c (artdag/dag-id sc-chain "c"))
+(define sc-chain-asap (artdag/schedule-asap sc-chain))
+
+(artdag-test "chain: ASAP schedule exists" (nil? sc-chain-asap) false)
+
+(artdag-test
+  "chain: slots are strictly increasing along the chain"
+  (list
+    (get sc-chain-asap sc-chain-a)
+    (get sc-chain-asap sc-chain-b)
+    (get sc-chain-asap sc-chain-c))
+  (list 1 2 3))
+
+(artdag-test
+  "chain: makespan equals chain length"
+  (artdag/schedule-makespan sc-chain-asap)
+  3)
+
+(artdag-test
+  "chain: exactly one schedule when slots = node count (no slack)"
+  (len (artdag/schedules sc-chain 3))
+  1)
+
+(artdag-test
+  "chain: ASAP batches are one node per slot"
+  (map len (artdag/schedule->batches sc-chain sc-chain-asap))
+  (list 1 1 1))
+
+(artdag-test
+  "chain: ASAP schedule is valid (deps respected)"
+  (artdag/schedule-valid? sc-chain sc-chain-asap)
+  true)
+
+; ---- diamond a -> b,c -> d: b and c are parallel ----
+
+(define
+  sc-dia
+  (artdag/build
+    (list
+      (list "a" "src" (list) {})
+      (list "b" "blur" (list "a") {:radius 1})
+      (list "c" "bright" (list "a") {:radius 1})
+      (list "d" "over" (list "b" "c") {} true))))
+(define sc-dia-asap (artdag/schedule-asap sc-dia))
+
+(artdag-test
+  "diamond: ASAP makespan is 3 (a | b,c | d)"
+  (artdag/schedule-makespan sc-dia-asap)
+  3)
+
+(artdag-test
+  "diamond: ASAP batch sizes are 1,2,1"
+  (map len (artdag/schedule->batches sc-dia sc-dia-asap))
+  (list 1 2 1))
+
+(artdag-test
+  "diamond: FD ASAP batches agree with plan.sx greedy waves"
+  (=
+    (artdag/schedule->batches sc-dia sc-dia-asap)
+    (map artdag/sort-strings (artdag/plan sc-dia 0)))
+  true)
+
+(artdag-test
+  "diamond: every enumerated schedule is valid"
+  (every?
+    (fn (asn) (artdag/schedule-valid? sc-dia asn))
+    (artdag/schedules sc-dia 4))
+  true)
+
+(artdag-test
+  "diamond: b and c share a slot in the ASAP schedule"
+  (=
+    (get sc-dia-asap (artdag/dag-id sc-dia "b"))
+    (get sc-dia-asap (artdag/dag-id sc-dia "c")))
+  true)
+
+; ---- parallelism cap: filter schedules to <= cap nodes per slot ----
+
+(artdag-test
+  "cap 1: the ASAP (b,c parallel) schedule is excluded, serial ones remain"
+  (every?
+    (fn
+      (asn)
+      (every?
+        (fn (b) (<= (len b) 1))
+        (artdag/schedule->batches sc-dia asn)))
+    (artdag/schedules-capped sc-dia 4 1))
+  true)
+
+(artdag-test
+  "cap 1: at least one serial schedule exists within 4 slots"
+  (> (len (artdag/schedules-capped sc-dia 4 1)) 0)
+  true)
+
+(artdag-test
+  "cap 2: admits the parallel ASAP schedule"
+  (if
+    (some
+      (fn (shape) (= shape (list 1 2 1)))
+      (map
+        (fn (asn) (map len (artdag/schedule->batches sc-dia asn)))
+        (artdag/schedules-capped sc-dia 4 2)))
+    true
+    false)
+  true)
+
+; ---- unsatisfiable: too few slots for the chain ----
+
+(artdag-test
+  "chain: no schedule when slots < chain length"
+  (nil? (artdag/schedule sc-chain 2))
+  true)

lib/artdag/tests/serialize.sx

@@ -0,0 +1,115 @@
+; portable wire form: dag <-> records <-> string, with content-id integrity.
+
+(define ser-RT (artdag/op-table-runner {:in (fn (p i) (get p :v)) :add (fn (p i) (+ (nth i 0) (nth i 1))) :inc (fn (p i) (+ 1 (first i)))}))
+
+(define
+  ser-D
+  (artdag/build
+    (list
+      (list "a" "in" (list) {:v 10})
+      (list "b" "inc" (list "a") {})
+      (list "c" "add" (list "a" "b") {} true))))
+
+(define ser-cid (artdag/dag-id ser-D "c"))
+
+; ---- wire form ----
+
+(artdag-test
+  "wire has one record per node"
+  (len (artdag/dag->wire ser-D))
+  3)
+
+(artdag-test
+  "wire records follow topological order"
+  (map (fn (rec) (nth rec 0)) (artdag/dag->wire ser-D))
+  (artdag/dag-order ser-D))
+
+(artdag-test
+  "wire record carries the content-id"
+  (nth (nth (artdag/dag->wire ser-D) 0) 0)
+  (artdag/dag-id ser-D "a"))
+
+; ---- reconstruction ----
+
+(artdag-test
+  "wire->dag restores node count"
+  (artdag/node-count (artdag/wire->dag (artdag/dag->wire ser-D)))
+  3)
+
+(artdag-test
+  "wire->dag restores order"
+  (artdag/dag-order (artdag/wire->dag (artdag/dag->wire ser-D)))
+  (artdag/dag-order ser-D))
+
+(artdag-test
+  "reconstructed leaf inputs normalize to empty list"
+  (artdag/node-inputs
+    (artdag/dag-get
+      (artdag/wire->dag (artdag/dag->wire ser-D))
+      (artdag/dag-id ser-D "a")))
+  (list))
+
+(artdag-test
+  "reconstructed node preserves inputs"
+  (artdag/node-inputs
+    (artdag/dag-get (artdag/wire->dag (artdag/dag->wire ser-D)) ser-cid))
+  (artdag/node-inputs (artdag/dag-get ser-D ser-cid)))
+
+(artdag-test
+  "reconstructed node id matches recomputed content-id"
+  (artdag/content-id
+    (artdag/dag-get (artdag/wire->dag (artdag/dag->wire ser-D)) ser-cid))
+  ser-cid)
+
+; ---- execution equivalence ----
+
+(artdag-test
+  "reconstructed dag executes to same result"
+  (let
+    ((c1 (persist/open)) (c2 (persist/open)))
+    (=
+      (artdag/result-of (artdag/run ser-D ser-RT c1) ser-cid)
+      (artdag/result-of
+        (artdag/run (artdag/wire->dag (artdag/dag->wire ser-D)) ser-RT c2)
+        ser-cid)))
+  true)
+
+(artdag-test
+  "string round-trip executes to same result"
+  (let
+    ((cache (persist/open)))
+    (artdag/result-of
+      (artdag/run
+        (artdag/string->dag (artdag/dag->string ser-D))
+        ser-RT
+        cache)
+      ser-cid))
+  21)
+
+; ---- integrity ----
+
+(artdag-test
+  "wire-verify accepts a genuine wire form"
+  (artdag/wire-verify (artdag/dag->wire ser-D))
+  true)
+
+(artdag-test
+  "wire-verify rejects a tampered id"
+  (artdag/wire-verify
+    (list (list "node:bogus" "in" (list) {:v 1} false)))
+  false)
+
+(artdag-test
+  "wire-verify rejects mutated params under a stale id"
+  (artdag/wire-verify
+    (map
+      (fn
+        (rec)
+        (list
+          (nth rec 0)
+          (nth rec 1)
+          (nth rec 2)
+          {:v 999}
+          (nth rec 4)))
+      (artdag/dag->wire ser-D)))
+  false)

lib/artdag/tests/stats.sx

@@ -0,0 +1,150 @@
+; execution stats: hit ratio + memoized work saved (cost-weighted).
+
+(define st-RT (artdag/op-table-runner {:in (fn (p i) (get p :v)) :add (fn (p i) (+ (nth i 0) (nth i 1))) :inc (fn (p i) (+ 1 (first i)))}))
+
+(define
+  st-D
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 20})
+      (list "b" "inc" (list "p") {})
+      (list "c" "inc" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+; same shape, leaf q changed -> dirty closure {q,c,d}
+(define
+  st-D2
+  (artdag/build
+    (list
+      (list "p" "in" (list) {:v 10})
+      (list "q" "in" (list) {:v 21})
+      (list "b" "inc" (list "p") {})
+      (list "c" "inc" (list "q") {})
+      (list "d" "add" (list "b" "c") {} true))))
+
+(define st-W (artdag/op-cost {:add 5 :inc 2}))
+
+; ---- cold run ----
+
+(artdag-test
+  "cold run: hit ratio is zero"
+  (let
+    ((cache (persist/open)))
+    (artdag/hit-ratio (artdag/run st-D st-RT cache)))
+  0)
+
+(artdag-test
+  "cold run: nothing saved"
+  (let
+    ((cache (persist/open)))
+    (artdag/work-saved (artdag/run st-D st-RT cache) st-D artdag/const-cost))
+  0)
+
+(artdag-test
+  "cold run: all work runs"
+  (let
+    ((cache (persist/open)))
+    (artdag/work-recomputed
+      (artdag/run st-D st-RT cache)
+      st-D
+      artdag/const-cost))
+  5)
+
+(artdag-test
+  "cold run: weighted work ran"
+  (let
+    ((cache (persist/open)))
+    (artdag/work-recomputed (artdag/run st-D st-RT cache) st-D st-W))
+  11)
+
+; ---- warm rerun ----
+
+(artdag-test
+  "warm rerun: hit ratio is one"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/hit-ratio (artdag/run st-D st-RT cache))))
+  1)
+
+(artdag-test
+  "warm rerun: savings ratio is one"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/savings-ratio
+        (artdag/run st-D st-RT cache)
+        st-D
+        artdag/const-cost)))
+  1)
+
+(artdag-test
+  "warm rerun: all weighted work saved"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/work-saved (artdag/run st-D st-RT cache) st-D st-W)))
+  11)
+
+; ---- partial (incremental) ----
+
+(artdag-test
+  "incremental: total is every node"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/exec-total (artdag/run st-D2 st-RT cache))))
+  5)
+
+(artdag-test
+  "incremental: saved work counts unchanged nodes"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/work-saved
+        (artdag/run st-D2 st-RT cache)
+        st-D2
+        artdag/const-cost)))
+  2)
+
+(artdag-test
+  "incremental: ran work counts dirty closure"
+  (let
+    ((cache (persist/open)))
+    (begin
+      (artdag/run st-D st-RT cache)
+      (artdag/work-recomputed
+        (artdag/run st-D2 st-RT cache)
+        st-D2
+        artdag/const-cost)))
+  3)
+
+(artdag-test
+  "summary reports recompute count"
+  (let
+    ((cache (persist/open)))
+    (get
+      (artdag/exec-summary
+        (artdag/run st-D st-RT cache)
+        st-D
+        artdag/const-cost)
+      :recomputed))
+  5)
+
+(artdag-test
+  "summary reports total"
+  (let
+    ((cache (persist/open)))
+    (get
+      (artdag/exec-summary
+        (artdag/run st-D st-RT cache)
+        st-D
+        artdag/const-cost)
+      :total))
+  5)

lib/blogimport/README.md

@@ -0,0 +1,61 @@
+# lib/blogimport — blog Postgres → persist genesis-import + parity verifier
+
+Implements **`plans/migration/data-migration.md`** (the "long-pole nobody had
+started") and the at-rest half of **`slice-01-blog.md` §4** — the data layer of the
+blog read-path migration. Host-ops migration tooling, **not** a domain core: it
+composes the public APIs of content-on-sx (`lib/content`) and persist
+(`lib/persist`). Kept in its own module (not `lib/host`, not `lib/content`) so it
+doesn't collide with the loops that own those.
+
+Status: **machinery complete + live-source wired, 75/75 conformance**
+(lexical 23, import 21, verify 11, source 20).
+
+## What it does
+
+| Module | Role |
+|---|---|
+| `lexical.sx` | `blogimport/lex-blocks doc` — Ghost **lexical** body (as SX dicts) → content-on-sx **block list**, ids deterministic by position (`b0,b1,…`). |
+| `import.sx` | `blogimport/import-post! b post at` — genesis import: convert the post's lexical, commit blocks as ordered `op-insert`s into the `content:<id>` op-log stream, record metadata in a sibling `postmeta:<id>` stream. Idempotent (skip-if-exists). `import-all!` → coverage scoreboard. |
+| `verify.sx` | `blogimport/verify-post b post` — replay the stream → block model, diff vs the row-derived oracle with `=`. `verify-all` → `{:total :ok :mismatched}` coverage. |
+| `source.sx` | **Live source (Q-M4 = internal-data query).** Injected `fetch-fn` transport port; `parse-row` maps a service post-row → importer `post` dict and parses the `:lexical` JSON string (`dream-json-parse`). `backfill! b fetch-fn at` = enumerate → fetch → import; `sync-verify b fetch-fn` = enumerate → fetch → verify. `backfill-ids!` is the explicit-id fallback. |
+
+## What is proven
+
+The verifier holds **`lexical → import → persist → replay → block-model`** equal to
+**`lexical → block-model`** computed directly. I.e. **the genesis import + op-log
+replay is lossless** — "did the backfill corrupt anything" at rest
+(`data-migration.md` §6). The `verify.sx` corruption test confirms a diverging stream
+is *detected*, not silently passed.
+
+## Known limitations / TODO (carry into the plan)
+
+- **Inline formatting is flattened to plain text.** Architecture's content model holds
+  plain-string text (`mk-text id text`); Phase-5 rich inline runs are not merged here.
+  The single swap-point is `lex-inline-text` in `lexical.sx` — return runs there once
+  content-on-sx Phase 5 lands on `architecture`. Bold/italic/links currently collapse
+  to their plain concatenation (drift-proof, == `asText`). (slice-01-blog Q-B1.)
+- **Q-M4 RESOLVED — live source = internal-data query** (`source.sx`), via an injected
+  `fetch-fn` port. The remaining real-world wiring is operational, not design:
+  1. **One blog-side query must be added**: `blog/queries.sx` has fetch-by-id/slug/ids
+     but **no enumeration query**. Add a `published-posts` defquery returning the
+     published ids/slugs (Python `list_posts(status="published")`,
+     `blog/bp/blog/ghost_db.py:102`). Until then, drive `backfill-ids!` with an explicit
+     id list. `source.sx` is mocked against this contract in `tests/source.sx`.
+  2. **Production `fetch-fn`** = the host's HMAC-signed `fetch_data` wrapper
+     (`GET /internal/data/{query}`). That wiring lives in `lib/host` (the host loop's
+     territory); `source.sx` only needs the port injected.
+  3. **Confirm the response field names** of the live `get-post-by-*` data handler
+     against `parse-row`'s contract (`:uuid|:id :slug :title :status :visibility :tags
+     :authors :lexical`); a mismatch is a one-line field fix.
+- **Oracle is the lexical→blocks of the SAME post, not the live Python block model.**
+  This proves round-trip fidelity through persist (no corruption at rest). The "does SX
+  match the *Python render*" half of Q-D2 would additionally diff against the Python
+  side's own block derivation — deferred with the read-path cutover.
+- **Re-import with an improved converter (Q-M5)** is import-once today (skip-if-exists).
+  Superseding prior genesis events (vs truncate+re-import) is future work.
+
+## Run
+
+```bash
+bash lib/blogimport/conformance.sh     # 75/75; writes scoreboard.{json,md}
+```

lib/blogimport/conformance.sh

@@ -0,0 +1,121 @@
+#!/usr/bin/env bash
+# lib/blogimport/conformance.sh — run blog-import suites, emit scoreboard.
+# Mirrors lib/content/conformance.sh: epoch-loaded modules + a bi-test counter.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX_SERVER" ]; then
+  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
+  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
+    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
+  else
+    echo "ERROR: sx_server.exe not found." >&2
+    exit 1
+  fi
+fi
+
+SUITES=(lexical import verify source)
+
+OUT_JSON="lib/blogimport/scoreboard.json"
+OUT_MD="lib/blogimport/scoreboard.md"
+
+run_suite() {
+  local suite=$1
+  local file="lib/blogimport/tests/${suite}.sx"
+  [ -f "$file" ] || { echo "0 0"; return; }
+  local TMP
+  TMP=$(mktemp)
+  cat > "$TMP" << EPOCHS
+(epoch 1)
+(load "lib/smalltalk/tokenizer.sx")
+(load "lib/smalltalk/parser.sx")
+(load "lib/guest/reflective/class-chain.sx")
+(load "lib/smalltalk/runtime.sx")
+(load "lib/guest/reflective/env.sx")
+(load "lib/smalltalk/eval.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")
+(load "lib/content/block.sx")
+(load "lib/content/doc.sx")
+(load "lib/content/render.sx")
+(load "lib/content/api.sx")
+(load "lib/content/meta.sx")
+(load "lib/content/section.sx")
+(load "lib/content/callout.sx")
+(load "lib/content/media.sx")
+(load "lib/content/store.sx")
+(load "lib/dream/json.sx")
+(load "lib/blogimport/lexical.sx")
+(load "lib/blogimport/import.sx")
+(load "lib/blogimport/verify.sx")
+(load "lib/blogimport/source.sx")
+(epoch 2)
+(eval "(define bi-test-pass 0)")
+(eval "(define bi-test-fail 0)")
+(eval "(define bi-test-fails (list))")
+(eval "(define bi-test (fn (name got expected) (if (= got expected) (set! bi-test-pass (+ bi-test-pass 1)) (begin (set! bi-test-fail (+ bi-test-fail 1)) (set! bi-test-fails (cons name bi-test-fails))))))")
+(epoch 3)
+(load "${file}")
+(epoch 4)
+(eval "(list bi-test-pass bi-test-fail)")
+EPOCHS
+
+  local OUTPUT
+  OUTPUT=$(timeout 240 "$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/')
+  echo "${P:-0} ${F:-0}"
+}
+
+declare -A SUITE_PASS SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running blogimport 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 "  %-10s %d/%d\n" "$s" "$p" "$((p+f))" >&2
+done
+
+{
+  printf '{\n  "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  "total_pass": %d,\n  "total_fail": %d,\n  "total": %d\n}\n' \
+    "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_JSON"
+
+{
+  printf '# blogimport Conformance Scoreboard\n\n_Generated by `lib/blogimport/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    printf '| %s | %d | %d | %d |\n' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}" "$(( ${SUITE_PASS[$s]} + ${SUITE_FAIL[$s]} ))"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_MD"
+
+echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
+[ "$TOTAL_FAIL" -eq 0 ]

lib/blogimport/drafts/README.md

@@ -0,0 +1,88 @@
+# Blog-side draft — the `published-posts` migration query
+
+The one blog-app change needed to make `lib/blogimport`'s live source (Q-M4) real.
+Two parts: an SX **defquery** (`published-posts.sx` in this dir) and a Python
+**provider** it binds to. Both go in the **blog app** (production `blog/` tree); they
+are drafted here so the importer ships with its dependency spelled out. Apply on the
+blog app's branch, not on this migration branch.
+
+## Why a new query (not reuse post-by-id)
+
+`blogimport/source.sx` needs, for every published post: `id, slug, title, status,
+visibility, tags, authors, lexical`. The existing providers
+(`blog/services/__init__.py` `SqlBlogService.get_post_by_*`) return a `PostDTO` whose
+`_post_to_dto` exposes `sx_content`/`html` but **not `lexical`** — and the canonical
+migration path is lexical→blocks (slice-01-blog Q-B1), not sx_content. So a dedicated
+migration provider that returns full rows including the raw lexical body is the
+minimal, honest change. One batch call covers both enumeration (Q-D2 corpus) and
+bodies.
+
+## 1. defquery (→ `blog/queries.sx`)
+
+See `published-posts.sx` in this directory:
+
+```lisp
+(defquery published-posts ()
+  "Enumerate every published, non-page blog post as a full row INCLUDING the raw
+   lexical body — the SX migration corpus (Q-D2). Read-only ..."
+  (service "blog" "list-published-posts"))
+```
+
+Kebab→snake convention (as for `get-post-by-slug` → `get_post_by_slug`) binds
+`"list-published-posts"` to the `SqlBlogService.list_published_posts` method below.
+
+## 2. Python provider (→ `blog/services/__init__.py`, in `SqlBlogService`)
+
+```python
+from sqlalchemy.orm import selectinload  # add to imports
+
+    async def list_published_posts(self, session: AsyncSession) -> list[dict]:
+        """Migration corpus: every published, non-page post as a full row INCLUDING
+        the raw lexical body (Q-D2). Read-only; consumed by the SX blogimport
+        backfill/verify. Mirrors ghost_db.list_posts() base visibility filters."""
+        result = await session.execute(
+            select(Post)
+            .where(
+                Post.deleted_at.is_(None),
+                Post.status == "published",
+                Post.is_page.is_(False),
+            )
+            .options(selectinload(Post.tags), selectinload(Post.authors))
+            .order_by(Post.published_at.desc().nullslast())
+        )
+        return [
+            {
+                "id": p.id,
+                "uuid": p.uuid,
+                "slug": p.slug,
+                "title": p.title,
+                "status": p.status,
+                "visibility": p.visibility,
+                "lexical": p.lexical,
+                "tags": [t.slug for t in p.tags],
+                "authors": [a.slug for a in p.authors],
+            }
+            for p in result.scalars().unique().all()
+        ]
+```
+
+**Confirm before applying:**
+- The relationship names on `Post` (`tags`, `authors`) — check `blog/models/content.py`
+  join tables (`post_tags`, `post_authors`); adjust `selectinload` + the comprehensions
+  if they differ. `.unique()` is needed because the eager joins fan out rows.
+- `Post.uuid` and `Post.lexical` columns exist (`models/content.py` ~lines 61-63).
+- Visibility filters match `ghost_db.list_posts()` (drafts excluded, pages excluded) so
+  the corpus is exactly the published read-path set.
+
+## 3. Verify the contract
+
+After applying, the response shape must match `blogimport/parse-row`
+(`lib/blogimport/source.sx`): keys `:uuid|:id :slug :title :status :visibility :tags
+:authors :lexical`, with `:lexical` a JSON string (parsed via `dream-json-parse`). The
+mock in `lib/blogimport/tests/source.sx` is the executable spec of this contract.
+
+## 4. Then wire the transport (host loop)
+
+`blogimport/backfill!`/`sync-verify` take an injected `fetch-fn`. In production that is
+the host's HMAC `fetch_data` wrapper (`GET /internal/data/published-posts`) — wiring
+that lives in `lib/host`, not here.

lib/blogimport/drafts/published-posts.sx

@@ -0,0 +1,16 @@
+; DRAFT — proposed addition to blog/queries.sx (the blog app's internal-data surface).
+; Resolves the one blog-side gap for Q-M4: blogimport needs to enumerate published
+; posts AND read their raw lexical bodies. The existing post-by-id/slug/ids queries
+; return a PostDTO that carries sx_content/html but NOT lexical, so a dedicated
+; migration query that returns full rows (incl. lexical) is the minimal change.
+;
+; Paste this defquery into blog/queries.sx alongside the others, and add the matching
+; `list_published_posts` provider to SqlBlogService (see drafts/README.md).
+;
+; This file is a DRAFT artifact (not loaded by anything); it is parse-validated only.
+
+(defquery published-posts ()
+  "Enumerate every published, non-page blog post as a full row INCLUDING the raw
+   lexical body — the SX migration corpus (Q-D2). Read-only; used by the blogimport
+   backfill + at-rest verify. Newest-first."
+  (service "blog" "list-published-posts"))

lib/blogimport/import.sx

@@ -0,0 +1,84 @@
+; lib/blogimport/import.sx
+; Genesis import: a blog Post row -> a persist content op-log stream.
+;
+; Per plans/migration/data-migration.md §3-5: for each Post, convert its lexical
+; body to content blocks and commit them as genesis insert ops into the
+; content:<id> stream, idempotently, with post metadata recorded as an event in a
+; sibling stream. The same code runs on mem and durable persist backends (every fn
+; takes the backend `b`, the acl.sx design principle).
+;
+; A `post` is a dict mirroring the blog Post row:
+;   {:id "uuid" :slug "hello" :title "Hello" :status "published"
+;    :visibility "public" :tags (list "a") :authors (list "u1")
+;    :lexical <lexical-doc-as-sx-dict>}
+; Reading real rows (internal-data query vs direct Postgres, Q-M4) is the live-source
+; edge, out of scope here; this drives content/commit! given a `post` dict.
+
+; --- genesis ops: insert each block in document order (deterministic) -----------
+; first block after nil (prepend), each subsequent after the previous block's id,
+; reproducing source order so re-import yields the same sequence (data-migration §5).
+(define
+  blogimport/genesis-ops
+  (fn (blocks)
+    (let ((ids (map blk-id blocks)))
+      (map-indexed
+        (fn (i blk) (op-insert blk (if (= i 0) nil (nth ids (- i 1)))))
+        blocks))))
+
+; --- post metadata (title/slug/status/visibility/tags/authors) ------------------
+(define
+  blogimport/post-meta
+  (fn (post)
+    {:title (or (get post :title) "")
+     :slug (or (get post :slug) "")
+     :status (or (get post :status) "")
+     :visibility (or (get post :visibility) "")
+     :tags (or (get post :tags) (list))
+     :authors (or (get post :authors) (list))}))
+
+; metadata is not a content op, so it rides a sibling event stream postmeta:<id>;
+; latest event wins (LWW). Replayable + durable like the block op-log.
+(define blogimport/meta-stream (fn (id) (str "postmeta:" id)))
+
+(define
+  blogimport/commit-meta!
+  (fn (b id meta at)
+    (persist/append b (blogimport/meta-stream id) "post-meta" at meta)))
+
+(define
+  blogimport/load-meta
+  (fn (b id)
+    (let ((evs (persist/read b (blogimport/meta-stream id))))
+      (if (= (len evs) 0) nil (persist/event-data (nth evs (- (len evs) 1)))))))
+
+; --- idempotency: a stream already holding events is already imported -----------
+; (host-persist guarantees monotonic seq but NOT dedupe — skip-if-exists is the
+; importer's dedupe, so re-running the backfill never double-imports. data-migration
+; §5.) Re-import with an improved converter (Q-M5) is future work — superseding,
+; not duplicating; this build is import-once.
+(define
+  blogimport/imported?
+  (fn (b id) (> (content/version-count b id) 0)))
+
+; --- import one post ------------------------------------------------------------
+(define
+  blogimport/import-post!
+  (fn (b post at)
+    (let ((id (get post :id)))
+      (if
+        (blogimport/imported? b id)
+        {:id id :imported false :reason "exists"}
+        (let ((blocks (blogimport/lex-blocks (get post :lexical))))
+          (begin
+            (content/commit-all! b id (blogimport/genesis-ops blocks) at)
+            (blogimport/commit-meta! b id (blogimport/post-meta post) at)
+            {:id id :imported true :blocks (len blocks)}))))))
+
+; --- import many: coverage scoreboard -------------------------------------------
+(define
+  blogimport/import-all!
+  (fn (b posts at)
+    (let ((results (map (fn (p) (blogimport/import-post! b p at)) posts)))
+      {:total (len results)
+       :imported (len (filter (fn (r) (get r :imported)) results))
+       :skipped (len (filter (fn (r) (not (get r :imported))) results))})))

lib/blogimport/lexical.sx

@@ -0,0 +1,129 @@
+; lib/blogimport/lexical.sx
+; Lexical (Ghost editor JSON, as SX dicts) -> content-on-sx block list.
+;
+; The blog migration's lexical->blocks converter. Lives on the blog/migration
+; side (NOT lib/content, NOT lib/host) per plans/migration/data-migration.md §7.
+;
+; Input shape: a lexical document is an SX dict mirroring the JSON 1:1, e.g.
+;   {:root {:children (list
+;      {:type "heading" :tag "h2" :children (list {:type "text" :text "Hi"})}
+;      {:type "paragraph" :children (list
+;          {:type "text" :text "plain "}
+;          {:type "text" :text "bold" :format 1}
+;          {:type "link" :url "/x" :children (list {:type "text" :text "here"})})})}}
+;
+; Block ids are assigned deterministically by top-level position ("b0","b1",...)
+; so a re-import yields the SAME block sequence (data-migration.md §5 ordering rule).
+;
+; INLINE FORMATTING: architecture's content model holds PLAIN-STRING text
+; (mk-text id text). Phase-5 rich inline runs are not merged here yet, so inline
+; nodes are flattened to their plain concatenation (== asText, drift-proof). The
+; single swap-point for the runs upgrade is `lex-inline-text` below — when
+; content-on-sx Phase 5 lands on architecture, return runs there instead of a
+; string. (slice-01-blog.md Q-B1; "prove the machinery first, then swap".)
+
+; Inline format bitmask (lexical): bold=1 italic=2 strikethrough=4 underline=8
+; code=16 subscript=32 superscript=64. Decoding the bitmask into mark keywords is
+; deferred to the Phase-5 runs upgrade (no bitwise prim on architecture, and the
+; active path flattens to plain text anyway). The :format field is read at the
+; swap-point `lex-inline-text` when runs land.
+
+; --- inline node -> plain text --------------------------------------------------
+(define
+  lex-inline-node-text
+  (fn (node)
+    (let ((t (get node :type)))
+      (cond
+        ((equal? t "text") (or (get node :text) ""))
+        ((equal? t "linebreak") "\n")
+        ((equal? t "tab") "\t")
+        ((equal? t "link") (lex-inline-text (or (get node :children) (list))))
+        ((equal? t "autolink") (lex-inline-text (or (get node :children) (list))))
+        ((equal? t "at-link") (lex-inline-text (or (get node :children) (list))))
+        ((equal? t "code-highlight") (or (get node :text) ""))
+        (else "")))))
+
+; flatten a list of inline nodes to one plain string.
+; *** Phase-5 swap-point: return a runs list here once mk-text accepts runs. ***
+(define
+  lex-inline-text
+  (fn (children)
+    (reduce
+      (fn (acc n) (str acc (lex-inline-node-text n)))
+      ""
+      children)))
+
+; --- helpers --------------------------------------------------------------------
+(define
+  lex-heading-level
+  (fn (tag)
+    (cond
+      ((equal? tag "h1") 1)
+      ((equal? tag "h2") 2)
+      ((equal? tag "h3") 3)
+      ((equal? tag "h4") 4)
+      ((equal? tag "h5") 5)
+      ((equal? tag "h6") 6)
+      (else 2))))
+
+(define
+  lex-listitem-text
+  (fn (item)
+    (lex-inline-text (or (get item :children) (list)))))
+
+; --- one lexical block node -> a content block (id assigned by caller) ----------
+(define
+  lex-block
+  (fn (node id)
+    (let ((t (get node :type)))
+      (cond
+        ((equal? t "paragraph")
+          (mk-text id (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "extended-text")
+          (mk-text id (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "heading")
+          (mk-heading id (lex-heading-level (get node :tag))
+            (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "extended-heading")
+          (mk-heading id (lex-heading-level (get node :tag))
+            (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "quote")
+          (mk-quote id "" (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "extended-quote")
+          (mk-quote id "" (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "codeblock")
+          (mk-code id (or (get node :language) "") (or (get node :code) "")))
+        ((equal? t "list")
+          (mk-list id
+            (equal? (get node :listType) "number")
+            (map lex-listitem-text (or (get node :children) (list)))))
+        ((equal? t "horizontalrule") (mk-divider id))
+        ((equal? t "image")
+          (mk-image id (or (get node :src) "") (or (get node :alt) "")))
+        ((equal? t "callout")
+          (mk-callout id (or (get node :backgroundColor) "grey")
+            (lex-inline-text (or (get node :children) (list)))))
+        ((equal? t "video") (mk-media id "video" (or (get node :src) "")))
+        ((equal? t "audio") (mk-media id "audio" (or (get node :src) "")))
+        ((equal? t "embed") (mk-embed id (or (get node :url) "") "embed"))
+        ((equal? t "bookmark") (mk-embed id (or (get node :url) "") "bookmark"))
+        ; unknown/unsupported card: route to a generic embed tagged by type so
+        ; nothing is silently dropped (provider records the original node type).
+        (else (mk-embed id "" (or t "unknown")))))))
+
+; --- doc -> top-level children list ---------------------------------------------
+(define
+  lex-doc-children
+  (fn (doc)
+    (cond
+      ((not (equal? (get doc :root) nil)) (or (get (get doc :root) :children) (list)))
+      ((not (equal? (get doc :children) nil)) (get doc :children))
+      (else (list)))))
+
+; --- doc -> content block list (deterministic ids by position) ------------------
+(define
+  blogimport/lex-blocks
+  (fn (doc)
+    (map-indexed
+      (fn (i node) (lex-block node (str "b" i)))
+      (lex-doc-children doc))))