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":"c4d97db1-361c-4a04-a99b-c838f9385469","pid":2426590,"procStart":"349789073","acquiredAt":1780789990975}
+{"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
@@ -576,8 +583,19 @@ and cek_run_with_io state =
       | Some resp -> resp
       | None ->
         let args = (match argsv with List l -> l | _ -> [argsv]) in
-             io_request op args)
-      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
@@ -745,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
@@ -807,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
@@ -835,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")
@@ -1097,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);
@@ -1223,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);
@@ -1468,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);
@@ -1486,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) ->
@@ -1502,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))
@@ -1535,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))
@@ -1667,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) ^ ")"
@@ -1694,8 +1829,9 @@ 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 -> ());
@@ -2495,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"];
@@ -2536,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
@@ -2591,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
 
@@ -4023,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 ->
@@ -4071,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)
@@ -4161,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
@@ -4173,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 ->
@@ -4527,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
@@ -4538,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\"))"
@@ -4554,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);
@@ -4811,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
@@ -4820,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 *)
@@ -4854,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
@@ -4869,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/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_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/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/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/artdag/conformance.sh

@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
   exit 1
 fi
 
-SUITES=(dag analyze plan execute optimize fed cost serialize stats fault)
+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"
@@ -23,6 +23,49 @@ run_suite() {
   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")
@@ -41,6 +84,8 @@ run_suite() {
 (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")
@@ -51,7 +96,10 @@ run_suite() {
 (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)")

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

@@ -9,9 +9,12 @@
     "cost": {"pass": 13, "fail": 0},
     "serialize": {"pass": 13, "fail": 0},
     "stats": {"pass": 12, "fail": 0},
-    "fault": {"pass": 14, "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": 158,
+  "total_pass": 225,
   "total_fail": 0,
-  "total": 158
+  "total": 225
 }

lib/artdag/scoreboard.md

@@ -14,4 +14,7 @@ _Generated by `lib/artdag/conformance.sh`_
 | serialize | 13 | 0 | 13 |
 | stats | 12 | 0 | 12 |
 | fault | 14 | 0 | 14 |
-| **Total** | **158** | **0** | **158** |
+| post | 12 | 0 | 12 |
+| maude-optimize | 40 | 0 | 40 |
+| schedule | 15 | 0 | 15 |
+| **Total** | **225** | **0** | **225** |

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

lib/blogimport/scoreboard.json

@@ -0,0 +1,11 @@
+{
+  "suites": {
+    "lexical": {"pass": 23, "fail": 0},
+    "import": {"pass": 21, "fail": 0},
+    "verify": {"pass": 11, "fail": 0},
+    "source": {"pass": 21, "fail": 0}
+  },
+  "total_pass": 76,
+  "total_fail": 0,
+  "total": 76
+}

lib/blogimport/scoreboard.md

@@ -0,0 +1,11 @@
+# blogimport Conformance Scoreboard
+
+_Generated by `lib/blogimport/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| lexical | 23 | 0 | 23 |
+| import | 21 | 0 | 21 |
+| verify | 11 | 0 | 11 |
+| source | 21 | 0 | 21 |
+| **Total** | **76** | **0** | **76** |

lib/blogimport/source.sx

@@ -0,0 +1,84 @@
+; lib/blogimport/source.sx
+; Live source adapter — Q-M4 RESOLVED: import via the blog INTERNAL-DATA QUERY
+; surface (decoupled), not direct Postgres. Reuses the existing query contracts
+; (blog/queries.sx: post-by-id/post-by-slug/posts-by-ids) and keeps the importer in
+; the SX/host world (plans/migration/data-migration.md §7 recommended default).
+;
+; TRANSPORT SEAM (hexagonal, like every other subsystem): a `fetch-fn` port is
+; INJECTED. Contract:
+;     (fetch-fn query-name params-dict) -> response-data
+; In production `fetch-fn` is the host's HMAC-signed fetch_data wrapper
+; (GET /internal/data/{query}); in tests it's a mock. The importer never knows how
+; the bytes arrive.
+;
+; RESPONSE CONTRACT (one published-post row), the blog `get-post-by-*` data handler:
+;   {:uuid|:id  :slug :title :status :visibility :tags :authors :lexical}
+;   :lexical is the Ghost body as a JSON STRING (the Post.lexical DB column) — parsed
+;   here with dream-json-parse into the SX dict shape blogimport/lex-blocks expects.
+;   (If a handler returns :lexical already-structured, it is used as-is.)
+;
+; REQUIRED BLOG-SIDE ADDITION (the one gap — draft in drafts/published-posts.sx):
+; the migration needs a `published-posts` query that returns full published-post ROWS
+; INCLUDING the raw `:lexical` body. The existing post-by-id/slug providers return a
+; PostDTO that carries sx_content/html but NOT lexical (blog/services/__init__.py
+; _post_to_dto), so they cannot feed the canonical lexical->blocks converter. One new
+; provider (Python list_published_posts over list_posts(status="published"),
+; blog/bp/blog/ghost_db.py:102) covers both enumeration AND bodies in one batch call.
+; Mocked here against that contract; see drafts/ for the paste-ready blog-side change.
+
+(define blogimport/dep-json-parse dream-json-parse)
+
+; --- lexical field -> SX dict (string from DB column, or already structured) -----
+(define
+  blogimport/parse-lexical
+  (fn (lx)
+    (cond
+      ((equal? lx nil) {:root {:children (list)}})
+      ((string? lx) (blogimport/dep-json-parse lx))
+      (else lx))))
+
+; --- service post-row -> importer `post` dict -----------------------------------
+(define
+  blogimport/parse-row
+  (fn (row)
+    {:id (or (get row :uuid) (get row :id))
+     :slug (or (get row :slug) "")
+     :title (or (get row :title) "")
+     :status (or (get row :status) "")
+     :visibility (or (get row :visibility) "")
+     :tags (or (get row :tags) (list))
+     :authors (or (get row :authors) (list))
+     :lexical (blogimport/parse-lexical (get row :lexical))}))
+
+; --- the published-post rows from the live source (one batch query) -------------
+(define
+  blogimport/source-rows
+  (fn (fetch-fn) (fetch-fn "published-posts" {})))
+
+; --- all published posts as importer `post` dicts -------------------------------
+(define
+  blogimport/source-posts
+  (fn (fetch-fn) (map blogimport/parse-row (blogimport/source-rows fetch-fn))))
+
+; --- end-to-end drivers ---------------------------------------------------------
+; backfill = enumerate+fetch -> genesis-import (idempotent). Re-runnable as the
+; one-way DB->persist sync (data-migration.md Strategy 1).
+(define
+  blogimport/backfill!
+  (fn (b fetch-fn at)
+    (blogimport/import-all! b (blogimport/source-posts fetch-fn) at)))
+
+; partial backfill: client-side filter to a subset of ids (no extra blog query).
+(define
+  blogimport/backfill-ids!
+  (fn (b fetch-fn ids at)
+    (blogimport/import-all!
+      b
+      (filter (fn (p) (contains? ids (get p :id))) (blogimport/source-posts fetch-fn))
+      at)))
+
+; sync-verify = fetch -> shadow-diff the persisted streams at rest.
+(define
+  blogimport/sync-verify
+  (fn (b fetch-fn)
+    (blogimport/verify-all b (blogimport/source-posts fetch-fn))))

lib/blogimport/tests/import.sx

@@ -0,0 +1,62 @@
+; lib/blogimport/tests/import.sx — genesis import + idempotency
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+
+(define
+  p1
+  {:id "post-1" :slug "hello" :title "Hello" :status "published"
+   :visibility "public" :tags (list "news") :authors (list "u1")
+   :lexical {:root {:children (list
+     {:type "heading" :tag "h1" :children (list {:type "text" :text "Hello"})}
+     {:type "paragraph" :children (list {:type "text" :text "world"})})}}})
+
+(define
+  p2
+  {:id "post-2" :slug "two" :title "Two" :status "published"
+   :lexical {:children (list
+     {:type "paragraph" :children (list {:type "text" :text "second"})})}})
+
+; ---- genesis-ops ordering ----
+(define ops1 (blogimport/genesis-ops (blogimport/lex-blocks (get p1 :lexical))))
+(bi-test "genesis op kinds" (map (fn (o) (get o :op)) ops1) (list "insert" "insert"))
+(bi-test "genesis first after nil" (get (nth ops1 0) :after) nil)
+(bi-test "genesis second after first id" (get (nth ops1 1) :after) "b0")
+
+; ---- import one ----
+(define B (persist/open))
+(define r1 (blogimport/import-post! B p1 10))
+(bi-test "import imported flag" (get r1 :imported) true)
+(bi-test "import block count" (get r1 :blocks) 2)
+(bi-test "stream version-count" (content/version-count B "post-1") 2)
+(bi-test "head ids" (doc-ids (content/head B "post-1")) (list "b0" "b1"))
+(bi-test "head body text"
+  (str (blk-send (doc-find (content/head B "post-1") "b1") "text")) "world")
+(bi-test "head heading level"
+  (blk-send (doc-find (content/head B "post-1") "b0") "level") 1)
+
+; ---- metadata round-trip ----
+(bi-test "meta round-trip" (blogimport/load-meta B "post-1") (blogimport/post-meta p1))
+(bi-test "meta title" (get (blogimport/load-meta B "post-1") :title) "Hello")
+(bi-test "meta tags" (get (blogimport/load-meta B "post-1") :tags) (list "news"))
+
+; ---- idempotent re-import (skip-if-exists, no duplication) ----
+(define r1b (blogimport/import-post! B p1 99))
+(bi-test "reimport skipped" (get r1b :imported) false)
+(bi-test "reimport reason" (get r1b :reason) "exists")
+(bi-test "version-count unchanged after reimport" (content/version-count B "post-1") 2)
+(bi-test "head ids unchanged after reimport"
+  (doc-ids (content/head B "post-1")) (list "b0" "b1"))
+
+; ---- import-all! coverage scoreboard ----
+(define B2 (persist/open))
+(define cov1 (blogimport/import-all! B2 (list p1 p2) 5))
+(bi-test "import-all total" (get cov1 :total) 2)
+(bi-test "import-all imported" (get cov1 :imported) 2)
+(bi-test "import-all skipped" (get cov1 :skipped) 0)
+; re-run is fully idempotent
+(define cov2 (blogimport/import-all! B2 (list p1 p2) 6))
+(bi-test "import-all rerun imported" (get cov2 :imported) 0)
+(bi-test "import-all rerun skipped" (get cov2 :skipped) 2)

lib/blogimport/tests/lexical.sx

@@ -0,0 +1,92 @@
+; lib/blogimport/tests/lexical.sx — lexical -> content block converter
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+
+; ---- a representative lexical document (Ghost editor JSON, as SX dicts) ----
+(define
+  doc
+  {:root {:children (list
+    {:type "heading" :tag "h2" :children (list {:type "text" :text "Title"})}
+    {:type "paragraph" :children (list
+      {:type "text" :text "plain "}
+      {:type "text" :text "bold" :format 1}
+      {:type "text" :text " then "}
+      {:type "link" :url "/x" :children (list {:type "text" :text "a link"})})}
+    {:type "quote" :children (list {:type "text" :text "wise words"})}
+    {:type "list" :listType "number" :children (list
+      {:type "listitem" :children (list {:type "text" :text "one"})}
+      {:type "listitem" :children (list {:type "text" :text "two"})})}
+    {:type "codeblock" :language "python" :code "print(1)"}
+    {:type "horizontalrule"}
+    {:type "image" :src "/c.png" :alt "a cat"}
+    {:type "callout" :backgroundColor "blue" :children (list {:type "text" :text "note!"})}
+    {:type "twitter" :url "https://t/x"})}})
+
+(define blocks (blogimport/lex-blocks doc))
+
+; ---- structure ----
+(bi-test "block count" (len blocks) 9)
+(bi-test "ids by position" (map blk-id blocks)
+  (list "b0" "b1" "b2" "b3" "b4" "b5" "b6" "b7" "b8"))
+(bi-test "types in order" (map blk-type blocks)
+  (list "heading" "text" "quote" "list" "code" "divider" "image" "callout" "embed"))
+
+; ---- heading ----
+(bi-test "heading level" (blk-send (nth blocks 0) "level") 2)
+(bi-test "heading text" (str (blk-send (nth blocks 0) "text")) "Title")
+
+; ---- paragraph with inline bold + link, flattened to plain concatenation ----
+(bi-test "paragraph flattened text"
+  (str (blk-send (nth blocks 1) "text")) "plain bold then a link")
+
+; ---- quote ----
+(bi-test "quote text" (str (blk-send (nth blocks 2) "text")) "wise words")
+
+; ---- ordered list with items ----
+(bi-test "list ordered" (blk-send (nth blocks 3) "ordered") true)
+(bi-test "list items" (blk-send (nth blocks 3) "items") (list "one" "two"))
+
+; ---- code block ----
+(bi-test "code language" (str (blk-send (nth blocks 4) "language")) "python")
+(bi-test "code text" (str (blk-send (nth blocks 4) "text")) "print(1)")
+
+; ---- image ----
+(bi-test "image src" (str (blk-send (nth blocks 6) "src")) "/c.png")
+(bi-test "image alt" (str (blk-send (nth blocks 6) "alt")) "a cat")
+
+; ---- callout ----
+(bi-test "callout kind" (str (blk-send (nth blocks 7) "kind")) "blue")
+(bi-test "callout text" (str (blk-send (nth blocks 7) "text")) "note!")
+
+; ---- unknown card routed to embed, provider records original type ----
+(bi-test "unknown -> embed provider" (str (blk-send (nth blocks 8) "provider")) "twitter")
+
+; ---- heading level mapping ----
+(bi-test "h1 level" (lex-heading-level "h1") 1)
+(bi-test "h4 level" (lex-heading-level "h4") 4)
+(bi-test "unknown tag default" (lex-heading-level "hx") 2)
+
+; ---- bullet list ----
+(define
+  bdoc
+  {:children (list {:type "list" :listType "bullet" :children (list
+    {:type "listitem" :children (list {:type "text" :text "x"})})})})
+(bi-test "bullet not ordered" (blk-send (nth (blogimport/lex-blocks bdoc) 0) "ordered") false)
+
+; ---- empty doc ----
+(bi-test "empty doc -> no blocks" (len (blogimport/lex-blocks {:root {:children (list)}})) 0)
+
+; ---- bare-children doc (no :root wrapper) ----
+(bi-test "bare children doc"
+  (map blk-type (blogimport/lex-blocks {:children (list {:type "paragraph" :children (list {:type "text" :text "hi"})})}))
+  (list "text"))
+
+; ---- linebreak/tab in inline flattening ----
+(bi-test "linebreak flatten"
+  (str (blk-send (nth (blogimport/lex-blocks
+    {:children (list {:type "paragraph" :children (list
+      {:type "text" :text "a"} {:type "linebreak"} {:type "text" :text "b"})})}) 0) "text"))
+  "a\nb")

lib/blogimport/tests/source.sx

@@ -0,0 +1,80 @@
+; lib/blogimport/tests/source.sx — live-source adapter (Q-M4 internal-data query)
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+
+; ---- canned service rows (lexical arrives as a JSON STRING, the DB column) ----
+(define
+  lex1
+  "{\"root\":{\"children\":[{\"type\":\"heading\",\"tag\":\"h2\",\"children\":[{\"type\":\"text\",\"text\":\"Live\"}]},{\"type\":\"paragraph\",\"children\":[{\"type\":\"text\",\"text\":\"from db\"}]}]}}")
+(define
+  row1
+  {:uuid "post-1" :slug "live" :title "Live" :status "published"
+   :visibility "public" :tags (list "x") :authors (list "u") :lexical lex1})
+(define
+  row2
+  {:uuid "post-2" :slug "two" :title "Two" :status "published"
+   :lexical "{\"children\":[{\"type\":\"paragraph\",\"children\":[{\"type\":\"text\",\"text\":\"second\"}]}]}"})
+
+; ---- mock transport: (fetch-fn query params) -> response ----
+; the `published-posts` migration query returns full rows (incl. lexical) in one batch.
+(define
+  mock-fetch
+  (fn (query params)
+    (cond
+      ((equal? query "published-posts") (list row1 row2))
+      (else nil))))
+
+; ---- parse-row maps fields + parses the lexical JSON string ----
+(define post1 (blogimport/parse-row row1))
+(bi-test "parse-row id from uuid" (get post1 :id) "post-1")
+(bi-test "parse-row title" (get post1 :title) "Live")
+(bi-test "parse-row tags" (get post1 :tags) (list "x"))
+(bi-test "parse-row lexical parsed to blocks"
+  (map blk-type (blogimport/lex-blocks (get post1 :lexical))) (list "heading" "text"))
+
+; ---- id fallback (:id when no :uuid) + structured (non-string) lexical ----
+(define
+  post3
+  (blogimport/parse-row
+    {:id "post-3" :slug "s3"
+     :lexical {:children (list {:type "paragraph" :children (list {:type "text" :text "x"})})}}))
+(bi-test "parse-row id fallback" (get post3 :id) "post-3")
+(bi-test "parse-row structured lexical used as-is"
+  (map blk-type (blogimport/lex-blocks (get post3 :lexical))) (list "text"))
+
+; ---- source-rows / source-posts ----
+(bi-test "source-rows count" (len (blogimport/source-rows mock-fetch)) 2)
+(bi-test "source-posts ids"
+  (map (fn (p) (get p :id)) (blogimport/source-posts mock-fetch))
+  (list "post-1" "post-2"))
+
+; ---- end-to-end backfill from the live source ----
+(define B (persist/open))
+(define cov (blogimport/backfill! B mock-fetch 10))
+(bi-test "backfill total" (get cov :total) 2)
+(bi-test "backfill imported" (get cov :imported) 2)
+(bi-test "backfill post-1 version-count" (content/version-count B "post-1") 2)
+(bi-test "backfill post-1 head ids" (doc-ids (content/head B "post-1")) (list "b0" "b1"))
+(bi-test "backfill post-1 body text"
+  (str (blk-send (doc-find (content/head B "post-1") "b1") "text")) "from db")
+(bi-test "backfill meta title" (get (blogimport/load-meta B "post-1") :title) "Live")
+
+; ---- backfill is idempotent (one-way sync re-run) ----
+(define cov2 (blogimport/backfill! B mock-fetch 11))
+(bi-test "backfill rerun skipped" (get cov2 :skipped) 2)
+
+; ---- sync-verify: persisted streams match the live-source oracle ----
+(define sv (blogimport/sync-verify B mock-fetch))
+(bi-test "sync-verify total" (get sv :total) 2)
+(bi-test "sync-verify ok" (get sv :ok) 2)
+(bi-test "sync-verify no mismatch" (get sv :mismatched) (list))
+
+; ---- partial backfill: client-side id filter (no extra blog query) ----
+(define B2 (persist/open))
+(define covx (blogimport/backfill-ids! B2 mock-fetch (list "post-2") 10))
+(bi-test "backfill-ids imported" (get covx :imported) 1)
+(bi-test "backfill-ids post-2 ids" (doc-ids (content/head B2 "post-2")) (list "b0"))
+(bi-test "backfill-ids other not imported" (content/version-count B2 "post-1") 0)

lib/blogimport/tests/verify.sx

@@ -0,0 +1,57 @@
+; lib/blogimport/tests/verify.sx — shadow-diff at rest (round-trip parity)
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-callout!)
+(content-bootstrap-media!)
+
+(define
+  p1
+  {:id "post-1" :slug "hello" :title "Hello" :status "published"
+   :visibility "public" :tags (list "news") :authors (list "u1")
+   :lexical {:root {:children (list
+     {:type "heading" :tag "h2" :children (list {:type "text" :text "Title"})}
+     {:type "paragraph" :children (list
+       {:type "text" :text "plain "}
+       {:type "text" :text "bold" :format 1})}
+     {:type "list" :listType "number" :children (list
+       {:type "listitem" :children (list {:type "text" :text "one"})}
+       {:type "listitem" :children (list {:type "text" :text "two"})})}
+     {:type "image" :src "/c.png" :alt "cat"})}}})
+
+(define
+  px
+  {:id "post-x" :slug "ghost" :title "Ghost" :status "published"
+   :lexical {:children (list {:type "paragraph" :children (list {:type "text" :text "never imported"})})}})
+
+; ---- happy path: replayed == oracle ----
+(define B (persist/open))
+(blogimport/import-post! B p1 10)
+(define v1 (blogimport/verify-post B p1))
+(bi-test "verify ok" (get v1 :ok) true)
+(bi-test "verify block-ok" (get v1 :block-ok) true)
+(bi-test "verify meta-ok" (get v1 :meta-ok) true)
+
+; ---- oracle block model is what we expect (inline bold flattened) ----
+(define orc (blogimport/oracle p1))
+(bi-test "oracle types"
+  (get (get orc :blocks) :types) (list "heading" "text" "list" "image"))
+(bi-test "oracle contents"
+  (get (get orc :blocks) :contents) (list "Title" "plain bold" (list "one" "two") "/c.png"))
+
+; ---- corruption is DETECTED (op-log diverges from oracle) ----
+(content/commit! B "post-1" (op-update "b1" "text" "CORRUPTED") 100)
+(define v2 (blogimport/verify-post B p1))
+(bi-test "verify detects corruption" (get v2 :ok) false)
+(bi-test "verify corruption is block-level" (get v2 :block-ok) false)
+
+; ---- an un-imported post fails verification (empty replay vs non-empty oracle) ----
+(bi-test "unimported not ok" (get (blogimport/verify-post B px) :ok) false)
+
+; ---- verify-all coverage scoreboard ----
+(define B3 (persist/open))
+(blogimport/import-post! B3 p1 10)
+(define cov (blogimport/verify-all B3 (list p1 px)))
+(bi-test "verify-all total" (get cov :total) 2)
+(bi-test "verify-all ok count" (get cov :ok) 1)
+(bi-test "verify-all mismatched" (get cov :mismatched) (list "post-x"))

lib/blogimport/verify.sx

@@ -0,0 +1,73 @@
+; lib/blogimport/verify.sx
+; Shadow-diff at rest (plans/migration/data-migration.md §6, slice-01-blog.md §4).
+;
+; After backfill, replay each content:<id> stream -> materialized doc -> block
+; model, and diff against the row-derived oracle (lexical->blocks computed directly).
+; Structural compare with `=` (not equal?). This proves the genesis import + op-log
+; replay is LOSSLESS — "did the backfill corrupt anything" at rest.
+;
+; The oracle here is the in-memory lexical->blocks of the SAME post, so the property
+; verified is round-trip fidelity through persist. Cross-checking against the LIVE
+; Python block model (the "does SX match Python" half of Q-D2) is a later wiring
+; step that needs the Python oracle via the internal-data query (Q-M4) — flagged,
+; not built. The diff plumbing here is the twin that step reuses.
+
+; --- salient content per block (normalized; same on both sides) -----------------
+; ids are deterministic + identical on both sides, so they are kept (not stripped).
+(define
+  blogimport/blk-content
+  (fn (b)
+    (let ((t (blk-type b)))
+      (cond
+        ((equal? t "image") (str (blk-send b "src")))
+        ((equal? t "media") (str (blk-send b "src")))
+        ((equal? t "embed") (str (blk-send b "url")))
+        ((equal? t "list") (blk-send b "items"))
+        ((equal? t "divider") "")
+        (else (str (blk-send b "text")))))))
+
+; --- block model of a block list ------------------------------------------------
+(define
+  blogimport/blocks-model
+  (fn (blocks)
+    {:ids (map blk-id blocks)
+     :types (map blk-type blocks)
+     :contents (map blogimport/blk-content blocks)}))
+
+; --- oracle: lexical->blocks computed directly from the post (no persist) --------
+(define
+  blogimport/oracle
+  (fn (post)
+    {:blocks (blogimport/blocks-model (blogimport/lex-blocks (get post :lexical)))
+     :meta (blogimport/post-meta post)}))
+
+; --- replayed: from the persisted stream ----------------------------------------
+(define
+  blogimport/replayed
+  (fn (b id)
+    {:blocks (blogimport/blocks-model (content/blocks (content/head b id)))
+     :meta (blogimport/load-meta b id)}))
+
+; --- verify one post: replayed must equal oracle --------------------------------
+(define
+  blogimport/verify-post
+  (fn (b post)
+    (let ((id (get post :id)))
+      (let ((orc (blogimport/oracle post))
+            (rep (blogimport/replayed b id)))
+        (let ((block-ok (= (get orc :blocks) (get rep :blocks)))
+              (meta-ok (= (get orc :meta) (get rep :meta))))
+          {:id id
+           :ok (and block-ok meta-ok)
+           :block-ok block-ok
+           :meta-ok meta-ok})))))
+
+; --- verify many: coverage scoreboard -------------------------------------------
+(define
+  blogimport/verify-all
+  (fn (b posts)
+    (let ((results (map (fn (p) (blogimport/verify-post b p)) posts)))
+      {:total (len results)
+       :ok (len (filter (fn (r) (get r :ok)) results))
+       :mismatched (map (fn (r) (get r :id))
+                     (filter (fn (r) (not (get r :ok))) results))})))

lib/common-lisp/runtime.sx

@@ -758,3 +758,23 @@
       (cl-restart-case
         (fn () (cl-signal-obj obj cl-handler-stack))
         (list "continue" (list) (fn () nil))))))
+;; ── JIT interpret-only boundary ───────────────────────────────────────────
+;; The Common-Lisp evaluator implements block/return-from, catch/throw, and
+;; the condition system via non-local control (host continuations); under JIT
+;; a compiled frame can't transfer control through a CEK continuation. Exclude
+;; the cl-/clos- namespaces from JIT. See Sx_types.jit_excluded_prefixes.
+(jit-exclude! "cl-*" "clos-*")
+
+;; cl-restart-case / cl-handler-case / cl-handler-bind wrap their body in
+;; call/cc (restarts + non-local handler exit). Any function that CALLS one of
+;; these (e.g. SX fixtures driving the condition system: parse-recover,
+;; interactive-debugger) must also be interpret-only: JIT'ing such a caller
+;; forces the call/cc form into a nested cek-run where the captured
+;; continuation runs-to-completion-and-returns instead of escaping, so a
+;; restart fails to abort and the body falls through (accumulation/no-abort).
+(jit-exclude-callers-of! "cl-restart-case" "cl-handler-case" "cl-handler-bind")
+;; Also the INVOKE side: cl-invoke-restart / cl-invoke-debugger / cl-signal
+;; trigger the continuation escape; a JIT'd caller can't let the escape
+;; propagate out of its frame (e.g. make-policy-debugger building a debugger
+;; hook that invokes a restart). Mark their callers interpret-only too.
+(jit-exclude-callers-of! "cl-invoke-restart" "cl-invoke-debugger" "cl-signal" "cl-error-with-debugger")

lib/compiler.sx

@@ -387,6 +387,60 @@
                           (emit-op em 5))
                         (init forms))
                       (compile-expr em (last forms) scope false))))
+                (= name "map")
+                (if
+                  (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hacc (list)) (_hc _hcl)) (if (empty? _hc) (reverse _hacc) (_hml (cons (_hf (first _hc)) _hacc) (rest _hc)))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
+                (= name "filter")
+                (if
+                  (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hacc (list)) (_hc _hcl)) (if (empty? _hc) (reverse _hacc) (_hml (if (_hf (first _hc)) (cons (first _hc) _hacc) _hacc) (rest _hc)))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
+                (= name "reduce")
+                (if
+                  (and (= (len args) 3) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hin ,(nth args 1)) (_hcl ,(nth args 2))) (let _hml ((_hacc _hin) (_hc _hcl)) (if (empty? _hc) _hacc (_hml (_hf _hacc (first _hc)) (rest _hc)))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
+                (= name "for-each")
+                (if
+                  (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) nil (begin (_hf (first _hc)) (_hml (rest _hc))))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
+                (= name "some")
+                (if
+                  (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) false (let ((_hr (_hf (first _hc)))) (if _hr _hr (_hml (rest _hc)))))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
+                (= name "every?")
+                (if
+                  (and (= (len args) 2) (list? (first args)) (not (empty? (first args))) (= (type-of (first (first args))) "symbol") (or (= (symbol-name (first (first args))) "fn") (= (symbol-name (first (first args))) "lambda")))
+                  (compile-list
+                    em
+                    `(let ((_hf ,(first args)) (_hcl ,(nth args 1))) (let _hml ((_hc _hcl)) (if (empty? _hc) true (if (_hf (first _hc)) (_hml (rest _hc)) false))))
+                    scope
+                    tail?)
+                  (compile-call em head args scope tail?))
                 :else (compile-call em head args scope tail?)))))))
     (define
       compile-if
@@ -602,6 +656,7 @@
                 ((temp-slot (scope-define-local let-scope "__dict_src")))
                 (emit-op em 17)
                 (emit-byte em temp-slot)
+                (emit-op em 5)
                 (for-each
                   (fn
                     (k)
@@ -623,7 +678,8 @@
                       (let
                         ((slot (scope-define-local let-scope (if (= (type-of var-name) "symbol") (symbol-name var-name) var-name))))
                         (emit-op em 17)
-                        (emit-byte em slot))))
+                        (emit-byte em slot)
+                        (emit-op em 5))))
                   (keys pattern))
                 (compile-begin em body let-scope tail?)))
             (let
@@ -641,7 +697,8 @@
                     (let
                       ((slot (scope-define-local let-scope (symbol-name name))))
                       (emit-op em 17)
-                      (emit-byte em slot))))
+                      (emit-byte em slot)
+                      (emit-op em 5))))
                 bindings)
               (compile-begin em body let-scope tail?))))))
     (define
@@ -655,7 +712,7 @@
             (let-scope (make-scope scope)))
           (dict-set! let-scope "next-slot" (get scope "next-slot"))
           (let
-            ((slots (map (fn (binding) (let ((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding)))) (let ((slot (scope-define-local let-scope name))) (emit-op em 2) (emit-op em 17) (emit-byte em slot) slot))) bindings)))
+            ((slots (map (fn (binding) (let ((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding)))) (let ((slot (scope-define-local let-scope name))) (emit-op em 2) (emit-op em 17) (emit-byte em slot) (emit-op em 5) slot))) bindings)))
             (for-each
               (fn
                 (pair)
@@ -663,7 +720,8 @@
                   ((binding (first pair)) (slot (nth pair 1)))
                   (compile-expr em (nth binding 1) let-scope false)
                   (emit-op em 17)
-                  (emit-byte em slot)))
+                  (emit-byte em slot)
+                  (emit-op em 5)))
               (map
                 (fn (i) (list (nth bindings i) (nth slots i)))
                 (range 0 (len bindings)))))
@@ -783,11 +841,7 @@
                 (rest-clauses
                   (if (> (len flat-args) 2) (slice flat-args 2) (list))))
               (if
-                (or
-                  (and
-                    (= (type-of test) "keyword")
-                    (= (keyword-name test) "else"))
-                  (= test true))
+                (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
                 (compile-expr em body scope tail?)
                 (do
                   (compile-expr em test scope false)
@@ -828,11 +882,7 @@
               (rest-clauses
                 (if (> (len clauses) 2) (slice clauses 2) (list))))
             (if
-              (or
-                (and
-                  (= (type-of test) "keyword")
-                  (= (keyword-name test) "else"))
-                (= test true))
+              (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
               (do (emit-op em 5) (compile-expr em body scope tail?))
               (do
                 (emit-op em 6)
@@ -1172,11 +1222,7 @@
               (test (first clause))
               (body (rest clause)))
             (if
-              (or
-                (and
-                  (= (type-of test) "keyword")
-                  (= (keyword-name test) "else"))
-                (= test true))
+              (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
               (compile-begin em body scope tail?)
               (do
                 (compile-expr em test scope false)

lib/content/api.sx

@@ -25,8 +25,13 @@
 (define content/append doc-append)
 (define content/blocks doc-blocks)
 (define content/count doc-count)
-(define content/find doc-find)
-(define content/has? doc-has?)
+;; find / has? are TREE-WIDE by id (descend into sections) — so the facade reads
+;; back any block content/edit can update or delete. content/find-top / has-top?
+;; keep the top-level-only lookup for callers that mean the ordered sequence.
+(define content/find doc-find-deep)
+(define content/has? doc-has-deep?)
+(define content/find-top doc-find)
+(define content/has-top? doc-has?)
 (define content/ids doc-ids)
 (define content/types doc-types)
 

lib/content/doc.sx

@@ -5,14 +5,19 @@
 ;; and returns a NEW document — the input is never mutated, so any version is the
 ;; head of an op stream (replay-friendly for persist + CRDT merge).
 ;;
-;; CtDoc also carries optional metadata (title/slug/tags) — see meta.sx for the
-;; ergonomic API; they default nil and do not affect block operations.
+;; By-id ops (update/delete) and by-id lookup (doc-find-deep/doc-has-deep?) are
+;; TREE-WIDE: they descend into any block carrying a `children` list (i.e.
+;; sections), since ids are unique across the tree. This keeps the persist
+;; op-log, content/edit and content/find correct for nested documents.
+;; insert/move are positional and act at the top level.
+;;
+;; CtDoc also carries optional metadata (title/slug/tags) — see meta.sx.
 ;;
 ;; Op shapes (data, not objects — they are the persist event payload):
-;;   {:op "insert" :block <blk> :after <id|nil>}   ; after nil = prepend
-;;   {:op "update" :id <id> :field <name> :value <v>}
-;;   {:op "move"   :id <id> :index <n>}
-;;   {:op "delete" :id <id>}
+;;   {:op "insert" :block <blk> :after <id|nil>}   ; after nil = prepend (top level)
+;;   {:op "update" :id <id> :field <name> :value <v>}   ; tree-wide by id
+;;   {:op "move"   :id <id> :index <n>}                 ; top level
+;;   {:op "delete" :id <id>}                            ; tree-wide by id
 
 (define
   content-bootstrap-doc!
@@ -76,17 +81,58 @@
           (first blocks)
           (ct-insert-at (rest blocks) (- i 1) x))))))
 
+;; tree-wide remove by id: drop matches at this level, recurse into children
+;; (blocks carrying a `children` list, i.e. sections).
 (define
   ct-remove-id
   (fn
     (blocks id)
-    (filter (fn (b) (if (= (blk-id b) id) false true)) blocks)))
+    (map
+      (fn
+        (b)
+        (let
+          ((ch (st-iv-get b "children")))
+          (if (list? ch) (st-iv-set! b "children" (ct-remove-id ch id)) b)))
+      (filter (fn (b) (if (= (blk-id b) id) false true)) blocks))))
 
+;; tree-wide replace by id: apply f to the match wherever it sits in the tree.
 (define
   ct-replace-id
   (fn
     (blocks id f)
-    (map (fn (b) (if (= (blk-id b) id) (f b) b)) blocks)))
+    (map
+      (fn
+        (b)
+        (if
+          (= (blk-id b) id)
+          (f b)
+          (let
+            ((ch (st-iv-get b "children")))
+            (if
+              (list? ch)
+              (st-iv-set! b "children" (ct-replace-id ch id f))
+              b))))
+      blocks)))
+
+;; tree-wide find by id: first block matching id anywhere in the tree, or nil.
+;; Descends into any `children` list, mirroring ct-replace-id/ct-remove-id.
+(define
+  ct-find-id
+  (fn
+    (blocks id)
+    (if
+      (= (len blocks) 0)
+      nil
+      (let
+        ((b (first blocks)))
+        (if
+          (= (blk-id b) id)
+          b
+          (let
+            ((ch (st-iv-get b "children")))
+            (let
+              ((nested (if (list? ch) (ct-find-id ch id) nil)))
+              (if (= nested nil) (ct-find-id (rest blocks) id) nested))))))))
 
 ;; ── query ──
 (define doc-index-of (fn (doc id) (ct-index-of (doc-blocks doc) id)))
@@ -103,6 +149,14 @@
   doc-has?
   (fn (doc id) (if (= (doc-index-of doc id) -1) false true)))
 
+;; tree-wide lookup by id — reads a nested block by the same id content/edit can
+;; update/delete (no section.sx dependency; uses the generic children descent).
+(define doc-find-deep (fn (doc id) (ct-find-id (doc-blocks doc) id)))
+
+(define
+  doc-has-deep?
+  (fn (doc id) (if (= (doc-find-deep doc id) nil) false true)))
+
 ;; ── structural edits (each returns a new document) ──
 (define doc-with-blocks (fn (doc blocks) (st-iv-set! doc "blocks" blocks)))
 

lib/content/find-replace.sx

@@ -1,10 +1,17 @@
-;; content-on-sx — global find/replace across text-bearing blocks.
+;; content-on-sx — global find/replace across every text-bearing field.
 ;;
-;; Replaces every occurrence of `from` with `to` in the text field of text /
-;; heading / code / quote blocks, tree-wide (via the transform layer). For
-;; renaming a term throughout a document. Immutable; case-sensitive.
+;; Replaces every occurrence of `from` with `to` in the text-bearing fields of
+;; a document, tree-wide (via the transform layer):
+;;   - the `text` of text / heading / code / quote / callout blocks
+;;   - the `alt` of image blocks
+;;   - each item of list blocks
+;;   - every header and cell of table blocks
+;; This is exactly the set asText / stats / summary draw prose from, so a rename
+;; via content/find-replace and a word count over asText stay consistent.
+;; Immutable; case-sensitive.
 ;;
-;; Requires (loaded by harness): block.sx, transform.sx (content/map-blocks).
+;; Requires (loaded by harness): block.sx, transform.sx (content/map-blocks),
+;; table.sx (CtTable ivars).
 
 (define
   fr-in?
@@ -15,17 +22,54 @@
       ((= (first xs) x) true)
       (else (fr-in? x (rest xs))))))
 
+(define fr-rep (fn (s from to) (replace (str s) from to)))
+
+;; Blocks whose prose content find/replace rewrites (matches asText's set).
 (define
   fr-has-text?
-  (fn (b) (fr-in? (blk-type b) (list "text" "heading" "code" "quote"))))
+  (fn
+    (b)
+    (fr-in?
+      (blk-type b)
+      (list "text" "heading" "code" "quote" "callout" "image" "list" "table"))))
+
+;; Per-type field rewrite. Each branch returns a new (copy-on-write) block.
+(define
+  fr-rewrite
+  (fn
+    (b from to)
+    (let
+      ((t (blk-type b)))
+      (cond
+        ((= t "image")
+          (blk-set b "alt" (fr-rep (blk-get b "alt") from to)))
+        ((= t "list")
+          (let
+            ((items (blk-get b "items")))
+            (if
+              (list? items)
+              (blk-set b "items" (map (fn (it) (fr-rep it from to)) items))
+              b)))
+        ((= t "table")
+          (let
+            ((hs (blk-get b "headers")) (rs (blk-get b "rows")))
+            (let
+              ((b1 (if (list? hs) (blk-set b "headers" (map (fn (h) (fr-rep h from to)) hs)) b)))
+              (if
+                (list? rs)
+                (blk-set
+                  b1
+                  "rows"
+                  (map
+                    (fn
+                      (r)
+                      (if (list? r) (map (fn (c) (fr-rep c from to)) r) r))
+                    rs))
+                b1))))
+        (else (blk-set b "text" (fr-rep (blk-get b "text") from to)))))))
 
 (define
   content/find-replace
   (fn
     (doc from to)
-    (content/map-blocks
-      doc
-      fr-has-text?
-      (fn
-        (b)
-        (blk-set b "text" (replace (str (blk-get b "text")) from to))))))
+    (content/map-blocks doc fr-has-text? (fn (b) (fr-rewrite b from to)))))

lib/content/query.sx

@@ -1,10 +1,10 @@
 ;; content-on-sx — block query + table of contents.
 ;;
 ;; Collect blocks across the whole tree (descending into sections) by predicate
-;; or type, and derive a table of contents from headings. Tree detection is
-;; inline (class + st-iv-get) so this needs no section.sx.
+;; or type, search them by prose, and derive a table of contents from headings.
+;; Tree detection is inline (class + st-iv-get) so this needs no section.sx.
 ;;
-;; Requires (loaded by harness): block.sx, doc.sx.
+;; Requires (loaded by harness): block.sx, doc.sx, text.sx (asText for search).
 
 (define
   qry-section?
@@ -45,6 +45,30 @@
   content/select-ids
   (fn (doc pred) (map (fn (b) (blk-id b)) (content/select doc pred))))
 
+;; Blocks (tree-wide, excluding section containers) whose own prose contains
+;; `term`. "Prose" is (asText b), so search covers exactly what every block
+;; exposes as text — text/heading/code/quote/callout text, image alt, list
+;; items, table headers+cells — with no separate field list to drift from
+;; asText / find-replace / stats. Case-sensitive substring match.
+(define
+  content/search-text
+  (fn
+    (doc term)
+    (content/select
+      doc
+      (fn
+        (b)
+        (and
+          (not (qry-section? b))
+          (>= (index-of (asText b) term) 0))))))
+
+;; Same search, returning matching block ids in document order.
+(define
+  content/search-text-ids
+  (fn
+    (doc term)
+    (map (fn (b) (blk-id b)) (content/search-text doc term))))
+
 ;; table of contents: {:id :level :text} for every heading, in document order.
 (define
   content/headings

lib/content/scoreboard.json

@@ -3,7 +3,7 @@
     "block": {"pass": 38, "fail": 0},
     "doc": {"pass": 40, "fail": 0},
     "render": {"pass": 42, "fail": 0},
-    "api": {"pass": 26, "fail": 0},
+    "api": {"pass": 32, "fail": 0},
     "meta": {"pass": 27, "fail": 0},
     "page": {"pass": 7, "fail": 0},
     "page-full": {"pass": 4, "fail": 0},
@@ -14,14 +14,14 @@
     "tree-edit": {"pass": 17, "fail": 0},
     "move": {"pass": 11, "fail": 0},
     "clone": {"pass": 10, "fail": 0},
-    "query": {"pass": 13, "fail": 0},
+    "query": {"pass": 20, "fail": 0},
     "toc": {"pass": 8, "fail": 0},
     "anchor": {"pass": 6, "fail": 0},
     "outline": {"pass": 14, "fail": 0},
     "flatten": {"pass": 10, "fail": 0},
     "transform": {"pass": 12, "fail": 0},
     "normalize": {"pass": 11, "fail": 0},
-    "find-replace": {"pass": 10, "fail": 0},
+    "find-replace": {"pass": 16, "fail": 0},
     "stats": {"pass": 17, "fail": 0},
     "summary": {"pass": 14, "fail": 0},
     "index": {"pass": 13, "fail": 0},
@@ -31,7 +31,7 @@
     "data": {"pass": 25, "fail": 0},
     "wire": {"pass": 11, "fail": 0},
     "validate": {"pass": 23, "fail": 0},
-    "store": {"pass": 33, "fail": 0},
+    "store": {"pass": 46, "fail": 0},
     "snapshot": {"pass": 20, "fail": 0},
     "crdt": {"pass": 34, "fail": 0},
     "crdt-tree": {"pass": 21, "fail": 0},
@@ -42,7 +42,7 @@
     "md-doc": {"pass": 12, "fail": 0},
     "fed": {"pass": 20, "fail": 0}
   },
-  "total_pass": 746,
+  "total_pass": 778,
   "total_fail": 0,
-  "total": 746
+  "total": 778
 }

lib/content/scoreboard.md

@@ -7,7 +7,7 @@ _Generated by `lib/content/conformance.sh`_
 | block | 38 | 0 | 38 |
 | doc | 40 | 0 | 40 |
 | render | 42 | 0 | 42 |
-| api | 26 | 0 | 26 |
+| api | 32 | 0 | 32 |
 | meta | 27 | 0 | 27 |
 | page | 7 | 0 | 7 |
 | page-full | 4 | 0 | 4 |
@@ -18,14 +18,14 @@ _Generated by `lib/content/conformance.sh`_
 | tree-edit | 17 | 0 | 17 |
 | move | 11 | 0 | 11 |
 | clone | 10 | 0 | 10 |
-| query | 13 | 0 | 13 |
+| query | 20 | 0 | 20 |
 | toc | 8 | 0 | 8 |
 | anchor | 6 | 0 | 6 |
 | outline | 14 | 0 | 14 |
 | flatten | 10 | 0 | 10 |
 | transform | 12 | 0 | 12 |
 | normalize | 11 | 0 | 11 |
-| find-replace | 10 | 0 | 10 |
+| find-replace | 16 | 0 | 16 |
 | stats | 17 | 0 | 17 |
 | summary | 14 | 0 | 14 |
 | index | 13 | 0 | 13 |
@@ -35,7 +35,7 @@ _Generated by `lib/content/conformance.sh`_
 | data | 25 | 0 | 25 |
 | wire | 11 | 0 | 11 |
 | validate | 23 | 0 | 23 |
-| store | 33 | 0 | 33 |
+| store | 46 | 0 | 46 |
 | snapshot | 20 | 0 | 20 |
 | crdt | 34 | 0 | 34 |
 | crdt-tree | 21 | 0 | 21 |
@@ -45,4 +45,4 @@ _Generated by `lib/content/conformance.sh`_
 | md-import | 38 | 0 | 38 |
 | md-doc | 12 | 0 | 12 |
 | fed | 20 | 0 | 20 |
-| **Total** | **746** | **0** | **746** |
+| **Total** | **778** | **0** | **778** |

lib/content/store.sx

@@ -5,9 +5,10 @@
 ;; replay of its op stream up to a sequence number; the materialised doc is a
 ;; cache, never primary state.
 ;;
-;; Requires (loaded by the harness): block.sx, doc.sx, and persist
-;; (event/backend/log/kv/api). The persist backend `b` is opened by the caller
-;; via (persist/open) and injected — content knows nothing about which backend.
+;; Requires (loaded by the harness): block.sx, doc.sx, section.sx (doc-deep-find
+;; + doc-tree-ids, for the tree-wide diff), plus persist (event/backend/log/kv/
+;; api). The persist backend `b` is opened by the caller via (persist/open) and
+;; injected — content knows nothing about which backend.
 
 (define content/-stream (fn (doc-id) (str "content:" doc-id)))
 
@@ -69,11 +70,18 @@
   (fn (b doc-id) (map (fn (ev) {:type (persist/event-type ev) :at (persist/event-at ev) :seq (persist/event-seq ev)}) (content/log b doc-id))))
 
 ;; ── diff between two materialised document versions ──
-;; Returns {:added (ids) :removed (ids) :changed (ids)} where changed = ids
-;; present in both whose block content differs.
-(define
-  content/-missing?
-  (fn (doc id) (= (ct-index-of (doc-blocks doc) id) -1)))
+;; Tree-wide: ids are enumerated across the whole block tree (descending into
+;; sections), so nested-block adds/removes/changes are detected, not just
+;; top-level ones. Returns {:added :removed :changed} (lists of ids):
+;;   :added   — ids present (anywhere) in `new` but not in `old`
+;;   :removed — ids present (anywhere) in `old` but not in `new`
+;;   :changed — content blocks present in both whose block value differs
+;; Section containers never appear in :changed (they hold no own content — a
+;; child change surfaces as that child's own entry); a whole section appearing
+;; or disappearing shows up in :added / :removed by its id.
+(define content/-all-ids (fn (doc) (doc-tree-ids doc)))
+
+(define content/-missing? (fn (doc id) (= (doc-deep-find doc id) nil)))
 
 (define
   content/-changed
@@ -83,15 +91,16 @@
       (fn
         (id)
         (let
-          ((bo (doc-find old id)) (bn (doc-find new id)))
+          ((bo (doc-deep-find old id)) (bn (doc-deep-find new id)))
           (cond
             ((= bo nil) false)
             ((= bn nil) false)
+            ((= (blk-type bo) "section") false)
             ((= bo bn) false)
             (else true))))
-      (doc-ids old))))
+      (content/-all-ids old))))
 
-(define content/diff (fn (old new) {:changed (content/-changed old new) :removed (filter (fn (id) (content/-missing? new id)) (doc-ids old)) :added (filter (fn (id) (content/-missing? old id)) (doc-ids new))}))
+(define content/diff (fn (old new) {:changed (content/-changed old new) :removed (filter (fn (id) (content/-missing? new id)) (content/-all-ids old)) :added (filter (fn (id) (content/-missing? old id)) (content/-all-ids new))}))
 
 ;; convenience: diff two persisted versions by seq.
 (define

lib/content/tests/api.sx

@@ -97,3 +97,37 @@
   "render original unchanged"
   (content/render d1 "html")
   "<h1>Hi</h1><p>World</p>")
+
+;; ── facade find/has? are TREE-WIDE (reach into sections); find-top/has-top?
+;; keep the top-level-only lookup. This makes the read-by-id surface consistent
+;; with content/edit, whose update/delete are already tree-wide. ──
+(content-bootstrap-section!)
+(define
+  nd
+  (content/append
+    (content/empty "nested")
+    (mk-section
+      "sec"
+      (list (content/block "text" "inner" (list (list "text" "deep")))))))
+(content-test
+  "find nested (deep)"
+  (blk-id (content/find nd "inner"))
+  "inner")
+(content-test "has? nested (deep)" (content/has? nd "inner") true)
+(content-test "find-top misses nested" (content/find-top nd "inner") nil)
+(content-test "has-top? misses nested" (content/has-top? nd "inner") false)
+(content-test
+  "find-top sees top-level"
+  (blk-id (content/find-top nd "sec"))
+  "sec")
+;; a nested block updated by id via content/edit is now readable by id via
+;; content/find (was impossible when find was top-level-only).
+(content-test
+  "edit-then-find nested round-trip"
+  (str
+    (blk-send
+      (content/find
+        (content/edit nd (content/update "inner" "text" "edited"))
+        "inner")
+      "text"))
+  "edited")

lib/content/tests/find-replace.sx

@@ -1,8 +1,10 @@
-;; Extension — global find/replace across text-bearing blocks.
+;; Extension — global find/replace across every text-bearing field.
 
 (st-bootstrap-classes!)
 (content/bootstrap!)
 (content-bootstrap-section!)
+(content-bootstrap-callout!)
+(content-bootstrap-table!)
 
 (define
   d
@@ -30,11 +32,12 @@
   (str (blk-send (doc-deep-find r "n") "text"))
   "nested Bar")
 
-;; ── does NOT touch image alt/src (not a text field) ──
+;; ── image alt IS a text field (asText ^ alt), so it is rewritten ──
 (content-test
-  "image alt untouched"
+  "image alt replaced"
   (str (blk-send (doc-deep-find r "img") "alt"))
-  "Foo alt")
+  "Bar alt")
+;; ── but src is a URL, not prose, so it stays put ──
 (content-test
   "image src untouched"
   (str (blk-send (doc-deep-find r "img") "src"))
@@ -76,6 +79,68 @@
   (str (blk-send (doc-find r2 "q") "text"))
   "new saying")
 
+;; ── callout text is covered (consistency with asText/stats/summary) ──
+(content-test
+  "replace callout text"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-callout "co" "note" "Foo here"))
+          "Foo"
+          "Bar")
+        "co")
+      "text"))
+  "Bar here")
+(content-test
+  "callout kind untouched by text replace"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-callout "co" "note" "x"))
+          "note"
+          "X")
+        "co")
+      "kind"))
+  "note")
+
+;; ── list items are rewritten (asText folds items) ──
+(define
+  rl
+  (content/find-replace
+    (doc-append
+      (doc-empty "d")
+      (mk-list "l" false (list "Foo one" "two Foo")))
+    "Foo"
+    "Bar"))
+(content-test
+  "replace first list item"
+  (str (first (blk-send (doc-find rl "l") "items")))
+  "Bar one")
+(content-test
+  "replace second list item"
+  (str (first (rest (blk-send (doc-find rl "l") "items"))))
+  "two Bar")
+
+;; ── table headers + cells are rewritten (asText folds rows) ──
+(define
+  rt
+  (content/find-replace
+    (doc-append
+      (doc-empty "d")
+      (mk-table "t" (list "Foo head") (list (list "a Foo" "b"))))
+    "Foo"
+    "Bar"))
+(content-test
+  "replace table header"
+  (str (first (table-headers (doc-find rt "t"))))
+  "Bar head")
+(content-test
+  "replace table cell"
+  (str (first (first (table-rows (doc-find rt "t")))))
+  "a Bar")
+
 ;; ── no match → unchanged render ──
 (content-test
   "no match"

lib/content/tests/query.sx

@@ -1,8 +1,11 @@
-;; Extension — block query + table of contents.
+;; Extension — block query + table of contents + prose search.
 
 (st-bootstrap-classes!)
 (content/bootstrap!)
+(content-bootstrap-text!)
 (content-bootstrap-section!)
+(content-bootstrap-table!)
+(content-bootstrap-callout!)
 
 (define
   d
@@ -87,3 +90,49 @@
   "deep toc level"
   (get (first (content/headings deep)) :level)
   3)
+
+;; ── prose search (content/search-text) ──
+;; "cat" appears in text, image alt, a list item, a table cell, and a callout
+;; — every text-bearing field — so search must find all five via asText.
+(define
+  sd
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append
+          (doc-append
+            (doc-empty "sd")
+            (mk-heading "sh" 1 "Welcome aboard"))
+          (mk-text "st" "the cat sat"))
+        (mk-image "si" "/x.png" "a cat photo"))
+      (mk-list "sl" false (list "first cat" "second dog")))
+    (mk-section
+      "sec"
+      (list
+        (mk-table "stb" (list "Animal") (list (list "cat") (list "fish")))
+        (mk-callout "sc" "note" "beware of cat")))))
+
+(content-test
+  "search across every text-bearing field"
+  (content/search-text-ids sd "cat")
+  (list "st" "si" "sl" "stb" "sc"))
+(content-test "search count" (len (content/search-text sd "cat")) 5)
+(content-test
+  "search heading text"
+  (content/search-text-ids sd "Welcome")
+  (list "sh"))
+(content-test
+  "search list item only"
+  (content/search-text-ids sd "dog")
+  (list "sl"))
+(content-test "search no match" (content/search-text-ids sd "zzz") (list))
+;; section containers are excluded — a term living only inside a section's
+;; children returns the child, never the section wrapper.
+(content-test
+  "search excludes section wrapper"
+  (content/search-text-ids sd "fish")
+  (list "stb"))
+(content-test
+  "search returns block objects"
+  (blk-id (first (content/search-text sd "Welcome")))
+  "sh")

lib/content/tests/store.sx

@@ -151,3 +151,58 @@
   "op-log media type"
   (blk-type (doc-find (content/head B3 "rich") "v"))
   "media")
+
+;; ── op-log update/delete reach NESTED blocks (tree-wide by id) ──
+(content-bootstrap-section!)
+(define B4 (persist/open))
+(content/commit!
+  B4
+  "nest"
+  (op-insert (mk-section "sec" (list (mk-text "n" "orig"))) nil)
+  1)
+(content/commit! B4 "nest" (op-update "n" "text" "edited") 2)
+(content-test
+  "op-log nested update"
+  (str (blk-send (doc-deep-find (content/head B4 "nest") "n") "text"))
+  "edited")
+(content-test
+  "op-log nested update tree intact"
+  (doc-tree-ids (content/head B4 "nest"))
+  (list "sec" "n"))
+(content/commit! B4 "nest" (op-delete "n") 3)
+(content-test
+  "op-log nested delete"
+  (doc-tree-ids (content/head B4 "nest"))
+  (list "sec"))
+(content-test
+  "op-log nested delete via content/at seq2"
+  (doc-tree-ids (content/at B4 "nest" 2))
+  (list "sec" "n"))
+
+;; ── diff is TREE-WIDE: nested-block add/change/remove are detected, and
+;; section containers never appear in :changed (a top-level-only diff would miss
+;; "n" entirely and instead flag the section). ──
+(define dn01 (content/diff-versions B4 "nest" 0 1))
+(content-test
+  "diff nested added (section + child)"
+  (get dn01 :added)
+  (list "sec" "n"))
+(content-test "diff nested added removed empty" (get dn01 :removed) (list))
+(content-test "diff nested added changed empty" (get dn01 :changed) (list))
+
+(define dn12 (content/diff-versions B4 "nest" 1 2))
+(content-test
+  "diff nested changed child only"
+  (get dn12 :changed)
+  (list "n"))
+(content-test "diff nested changed no add" (get dn12 :added) (list))
+(content-test "diff nested changed no remove" (get dn12 :removed) (list))
+
+(define dn23 (content/diff-versions B4 "nest" 2 3))
+(content-test "diff nested removed child" (get dn23 :removed) (list "n"))
+(content-test "diff nested removed no change" (get dn23 :changed) (list))
+
+(content-test
+  "diff nested no-op"
+  (get (content/diff-versions B4 "nest" 1 1) :changed)
+  (list))

lib/dream/README.md

@@ -0,0 +1,79 @@
+# dream-on-sx
+
+OCaml's [Dream](https://aantron.github.io/dream/) web framework, reimplemented in
+**plain SX** on the CEK evaluator. Dream is the cleanest middleware-shaped HTTP
+framework in any language, and it maps onto SX with almost no impedance:
+
+| Dream | SX |
+|-------|-----|
+| `handler = request -> response promise` | `(fn (req) … (perform …))` |
+| `middleware = handler -> handler` | `(fn (next) (fn (req) …))` |
+| `m1 @@ m2 @@ handler` | `(m1 (m2 handler))` — left fold |
+| `Dream.run handler` | `(dream-run handler)` → `(perform (:http/listen …))` |
+
+There are five types — **request, response, route**, and (as plain functions)
+**handler** and **middleware**. Everything else is a function over them.
+
+## Quickstart
+
+```lisp
+(dream-run
+  (dream-make-app
+    (list
+      (dream-get "/" (fn (req) (dream-html "<h1>Hello, World!</h1>")))
+      (dream-get "/hello/:name"
+        (fn (req) (dream-text (str "Hi, " (dream-param req "name"))))))))
+```
+
+`dream-make-app` wraps the router in the default stack (error catch + content-type).
+`dream-run` installs the root handler on the existing SX HTTP server — it does **not**
+open its own socket.
+
+## Public surface
+
+- **types** — `dream-request`/`dream-response`/`dream-route`, accessors
+  (`dream-method`/`-path`/`-body`/`-header`/`-query-param`/`-param`), smart
+  constructors (`dream-html`/`-text`/`-json`/`-empty`/`-not-found`/`-redirect`),
+  convenience (`dream-queries`, `*-or` defaults, `dream-accepts?`/`dream-wants-json?`).
+- **router** — `dream-get`/`-post`/`-put`/`-delete`/`-patch`/`-head`/`-options`/`-any`,
+  `dream-router`, `dream-scope` (prefix + middleware), `:name` params + `**` catch-all,
+  405 + `Allow`, automatic HEAD.
+- **middleware** — `dream-pipeline`, `dream-no-middleware`, `dream-logger`,
+  `dream-content-type`, `dream-set-header`, `dream-tap-request`.
+- **session** — `dream-sessions` / `dream-sessions-signed`, `dream-session-field` /
+  `dream-set-session-field` / `dream-session-all` / `dream-invalidate-session`; cookie
+  helpers (`dream-cookie`, `dream-set-cookie`, `dream-cookie-sign`/`-unsign`).
+- **flash** — `dream-flash`, `dream-add-flash-message`, `dream-flash-messages`.
+- **form** — `dream-form` (Ok/Err), `dream-form-fields`, `dream-multipart`, CSRF
+  (`dream-csrf` / `dream-csrf-protect` / `dream-csrf-token` / `dream-csrf-tag`).
+- **websocket** — `dream-websocket`, `dream-send`/`-receive`/`-close`/`-broadcast`.
+- **static** — `dream-static` (mime, ETags, 304, ranges, traversal guard).
+- **error** — `dream-catch`, `dream-status-text`/`-line`, `dream-status-page`.
+- **cors** — `dream-cors`, `dream-cors-origin`, `dream-cors-with`.
+- **json** — `dream-json-encode`/`-parse`, `dream-json-value`, `dream-json-body`.
+- **run / api** — `dream-run`/`-port`/`-opts`, `dream-app`, `dream-make-app`,
+  `dream-serve`.
+
+## Testing story
+
+Every effectful concern is **dependency-injected**, so the whole framework is testable
+without a running host:
+
+- sessions take a backend `(fn (op) …)` — `dream-memory-sessions` for tests,
+  `dream-perform-sessions` in production;
+- static files take an fs — `dream-memory-fs` vs `dream-static-perform-fs`;
+- websockets take an io — `dream-mock-ws` vs `dream-ws-perform-io`;
+- `dream-run` takes a listen transport (`dream-run-with`).
+
+Run the suite: `bash lib/dream/conformance.sh` (367 tests, 14 suites).
+
+## Notes & caveats
+
+- Headers are dicts with **lowercased string keys** (in SX keywords *are* strings, so
+  `:content-type` == `"content-type"`).
+- Outgoing cookies accumulate in a `:set-cookies` list on the response so multiple
+  `Set-Cookie` headers don't collide.
+- The CSRF/cookie/ETag signing uses a pure-SX keyed hash — **not cryptographic**.
+  Production should inject a host HMAC (`dream-csrf-with`, and the signed-session
+  secret path).
+- JSON and multipart are in-memory (not streaming).

lib/dream/api.sx

@@ -0,0 +1,33 @@
+;; lib/dream/api.sx — Dream-on-SX public facade.
+;; Loaded last; bundles the modules into a batteries-included surface. The full
+;; public API is the `dream-*` functions across types/router/middleware/session/
+;; flash/form/websocket/static/error/cors/json/run; this file adds convenience
+;; app builders. Depends on all other dream modules.
+
+(define dream-version "0.1.0")
+
+;; standard middleware stack (pure — no IO): error catch outermost, then
+;; content-type sniffing. Logger is opt-in since it performs host IO.
+(define
+  dream-defaults
+  (fn
+    (handler)
+    (dream-pipeline (list dream-catch dream-content-type) handler)))
+
+;; build a complete app handler from a route list with the default stack
+(define
+  dream-make-app
+  (fn (routes) (dream-defaults (dream-router routes))))
+
+;; build an app and wrap it with extra middleware (outermost first)
+(define
+  dream-make-app-with
+  (fn
+    (middlewares routes)
+    (dream-pipeline middlewares (dream-make-app routes))))
+
+;; one-call serve: routes + opts -> installed on the host
+(define
+  dream-serve
+  (fn (routes opts) (dream-run-opts (dream-make-app routes) opts)))
+(define dream-serve-port (fn (routes port) (dream-serve routes {:port port})))

lib/dream/auth.sx

@@ -0,0 +1,172 @@
+;; lib/dream/auth.sx — Dream-on-SX authentication helpers.
+;; HTTP Basic auth (with a pure-SX base64 codec) and Bearer-token guards.
+;; Depends on types.sx.
+
+;; ── base64 (pure SX; arithmetic, no bitwise) ───────────────────────
+(define
+  dr/b64-alpha
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+(define dr/b64-char (fn (n) (char-at dr/b64-alpha n)))
+(define dr/b64-index (fn (c) (index-of dr/b64-alpha c)))
+
+(define
+  dr/b64-encode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((b0 (char-code (char-at s i))) (rem (- n i)))
+        (cond
+          ((>= rem 3)
+            (let
+              ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256) (char-code (char-at s (+ i 2))))))
+              (dr/b64-encode-loop
+                s
+                (+ i 3)
+                n
+                (str
+                  acc
+                  (dr/b64-char (mod (quotient triple 262144) 64))
+                  (dr/b64-char (mod (quotient triple 4096) 64))
+                  (dr/b64-char (mod (quotient triple 64) 64))
+                  (dr/b64-char (mod triple 64))))))
+          ((= rem 2)
+            (let
+              ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256))))
+              (str
+                acc
+                (dr/b64-char (mod (quotient triple 262144) 64))
+                (dr/b64-char (mod (quotient triple 4096) 64))
+                (dr/b64-char (mod (quotient triple 64) 64))
+                "=")))
+          (else
+            (let
+              ((triple (* b0 65536)))
+              (str
+                acc
+                (dr/b64-char (mod (quotient triple 262144) 64))
+                (dr/b64-char (mod (quotient triple 4096) 64))
+                "=="))))))))
+
+(define
+  dream-base64-encode
+  (fn (s) (dr/b64-encode-loop s 0 (string-length s) "")))
+
+(define
+  dr/b64-decode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((p2 (char-at s (+ i 2)))
+          (p3 (char-at s (+ i 3))))
+        (let
+          ((c0 (dr/b64-index (char-at s i)))
+            (c1 (dr/b64-index (char-at s (+ i 1))))
+            (c2 (if (= p2 "=") 0 (dr/b64-index p2)))
+            (c3 (if (= p3 "=") 0 (dr/b64-index p3))))
+          (let
+            ((triple (+ (* c0 262144) (* c1 4096) (* c2 64) c3)))
+            (dr/b64-decode-loop
+              s
+              (+ i 4)
+              n
+              (str
+                acc
+                (char-from-code
+                  (mod (quotient triple 65536) 256))
+                (if
+                  (= p2 "=")
+                  ""
+                  (char-from-code
+                    (mod (quotient triple 256) 256)))
+                (if (= p3 "=") "" (char-from-code (mod triple 256)))))))))))
+
+(define
+  dream-base64-decode
+  (fn
+    (s)
+    (if (= s "") "" (dr/b64-decode-loop s 0 (string-length s) ""))))
+
+;; ── Authorization header parsing ───────────────────────────────────
+(define dream-authorization (fn (req) (dream-header req "authorization")))
+
+(define
+  dream-bearer-token
+  (fn
+    (req)
+    (let
+      ((a (dream-authorization req)))
+      (if (and a (starts-with? a "Bearer ")) (substr a 7) nil))))
+
+(define
+  dream-basic-credentials
+  (fn
+    (req)
+    (let
+      ((a (dream-authorization req)))
+      (if
+        (and a (starts-with? a "Basic "))
+        (let
+          ((decoded (dream-base64-decode (substr a 6))))
+          (let
+            ((colon (index-of decoded ":")))
+            (if (< colon 0) nil {:pass (substr decoded (+ colon 1)) :user (substr decoded 0 colon)})))
+        nil))))
+
+;; ── Basic auth middleware ──────────────────────────────────────────
+;; check is (fn (user pass) -> bool). On success the request gains :dream-user.
+(define
+  dr/www-authenticate
+  (fn
+    (realm)
+    (dream-add-header
+      (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized")
+      "www-authenticate"
+      (str "Basic realm=\"" realm "\""))))
+
+(define
+  dream-basic-auth
+  (fn
+    (realm check)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((creds (dream-basic-credentials req)))
+          (if
+            (and creds (check (get creds :user) (get creds :pass)))
+            (next (assoc req :dream-user (get creds :user)))
+            (dr/www-authenticate realm)))))))
+
+(define dream-user (fn (req) (get req :dream-user)))
+
+;; ── Bearer-token middleware ────────────────────────────────────────
+;; check is (fn (token) -> principal | nil). On success the request gains
+;; :dream-principal. Missing/invalid -> 401.
+(define
+  dream-require-bearer
+  (fn
+    (check)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((tok (dream-bearer-token req)))
+          (let
+            ((principal (if tok (check tok) nil)))
+            (if
+              (nil? principal)
+              (dream-add-header
+                (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized")
+                "www-authenticate"
+                "Bearer")
+              (next (assoc req :dream-principal principal)))))))))
+
+(define dream-principal (fn (req) (get req :dream-principal)))

lib/dream/conformance.sh

@@ -0,0 +1,122 @@
+#!/usr/bin/env bash
+# dream-on-sx conformance runner — loads all dream modules + test suites in one
+# sx_server process and reports pass/fail per suite.
+#
+# Usage:
+#   bash lib/dream/conformance.sh        # run all suites
+#   bash lib/dream/conformance.sh -v     # verbose (list each suite)
+
+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
+
+VERBOSE="${1:-}"
+
+# Dream library modules loaded before any test suite.
+MODULES=(
+  "lib/dream/types.sx"
+  "lib/dream/router.sx"
+  "lib/dream/middleware.sx"
+  "lib/dream/session.sx"
+  "lib/dream/flash.sx"
+  "lib/dream/form.sx"
+  "lib/dream/websocket.sx"
+  "lib/dream/static.sx"
+  "lib/dream/error.sx"
+  "lib/dream/cors.sx"
+  "lib/dream/json.sx"
+  "lib/dream/auth.sx"
+  "lib/dream/html.sx"
+  "lib/dream/headers.sx"
+  "lib/dream/run.sx"
+  "lib/dream/api.sx"
+  "lib/dream/demos/hello.sx"
+  "lib/dream/demos/counter.sx"
+  "lib/dream/demos/chat.sx"
+  "lib/dream/demos/todo.sx"
+)
+
+# Suites: NAME RUNNER-FN PATH
+SUITES=(
+  "types       dream-ty-tests-run!  lib/dream/tests/types.sx"
+  "router      dream-rt-tests-run!  lib/dream/tests/router.sx"
+  "middleware  dream-mw-tests-run!  lib/dream/tests/middleware.sx"
+  "session     dream-ss-tests-run!  lib/dream/tests/session.sx"
+  "flash       dream-fl-tests-run!  lib/dream/tests/flash.sx"
+  "form        dream-fo-tests-run!  lib/dream/tests/form.sx"
+  "websocket   dream-ws-tests-run!  lib/dream/tests/websocket.sx"
+  "static      dream-st-tests-run!  lib/dream/tests/static.sx"
+  "error       dream-er-tests-run!  lib/dream/tests/error.sx"
+  "cors        dream-co-tests-run!  lib/dream/tests/cors.sx"
+  "json        dream-js-tests-run!  lib/dream/tests/json.sx"
+  "auth        dream-au-tests-run!  lib/dream/tests/auth.sx"
+  "html        dream-ht-tests-run!  lib/dream/tests/html.sx"
+  "headers     dream-hd-tests-run!  lib/dream/tests/headers.sx"
+  "run         dream-rn-tests-run!  lib/dream/tests/run.sx"
+  "api         dream-ap-tests-run!  lib/dream/tests/api.sx"
+  "demos       dream-dm-tests-run!  lib/dream/tests/demos.sx"
+)
+
+TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
+EPOCH=1
+emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
+emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
+
+{
+  for M in "${MODULES[@]}"; do emit_load "$M"; done
+  for SUITE in "${SUITES[@]}"; do
+    read -r _NAME _RUNNER FILE <<< "$SUITE"
+    emit_load "$FILE"
+    emit_eval "($_RUNNER)"
+  done
+} > "$TMPFILE"
+
+OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+
+TOTAL_PASS=0
+TOTAL_FAIL=0
+FAILED_SUITES=()
+LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
+
+I=0
+while read -r LINE; do
+  [ -z "$LINE" ] && continue
+  P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
+  F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
+  [ -z "$P" ] && P=0
+  [ -z "$F" ] && F=0
+  SUITE_INFO="${SUITES[$I]}"
+  SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
+  TOTAL_PASS=$((TOTAL_PASS + P))
+  TOTAL_FAIL=$((TOTAL_FAIL + F))
+  if [ "$F" -gt 0 ]; then
+    FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
+    printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
+    echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name /    fail: /'
+  elif [ "$VERBOSE" = "-v" ]; then
+    printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
+  fi
+  I=$((I+1))
+done <<< "$LAST_DICT_LINES"
+
+TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
+if [ "$TOTAL" -eq 0 ]; then
+  echo "ERROR: no suite results parsed. Raw output:" >&2
+  echo "$OUTPUT" >&2
+  exit 1
+fi
+if [ $TOTAL_FAIL -eq 0 ]; then
+  echo "ok $TOTAL_PASS/$TOTAL dream-on-sx tests passed (${#SUITES[@]} suites)"
+else
+  echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
+  for S in "${FAILED_SUITES[@]}"; do echo "  $S"; done
+  exit 1
+fi

lib/dream/cors.sx

@@ -0,0 +1,51 @@
+;; lib/dream/cors.sx — Dream-on-SX CORS middleware.
+;; Decorates responses with Access-Control-Allow-* headers and short-circuits
+;; preflight OPTIONS requests with a 204. Depends on types.sx.
+
+(define dream-cors-defaults {:methods "GET, POST, PUT, PATCH, DELETE, OPTIONS" :headers "Content-Type" :max-age 86400 :credentials false :origin "*"})
+
+(define
+  dr/cors-origin-headers
+  (fn
+    (opts resp)
+    (let
+      ((r1 (dream-add-header resp "access-control-allow-origin" (get opts :origin))))
+      (if
+        (get opts :credentials)
+        (dream-add-header r1 "access-control-allow-credentials" "true")
+        r1))))
+
+(define
+  dr/cors-preflight
+  (fn
+    (opts)
+    (dr/cors-origin-headers
+      opts
+      (dream-add-header
+        (dream-add-header
+          (dream-add-header
+            (dream-empty 204)
+            "access-control-allow-methods"
+            (get opts :methods))
+          "access-control-allow-headers"
+          (get opts :headers))
+        "access-control-max-age"
+        (str (get opts :max-age))))))
+
+(define
+  dream-cors-with
+  (fn
+    (opts)
+    (fn
+      (next)
+      (fn
+        (req)
+        (if
+          (= (dream-method req) "OPTIONS")
+          (dr/cors-preflight opts)
+          (dr/cors-origin-headers opts (next req)))))))
+
+(define dream-cors (dream-cors-with dream-cors-defaults))
+(define
+  dream-cors-origin
+  (fn (origin) (dream-cors-with (assoc dream-cors-defaults :origin origin))))

lib/dream/demos/chat.sx

@@ -0,0 +1,46 @@
+;; lib/dream/demos/chat.sx — multi-room WebSocket chat (chat.ml).
+;; A room registry holds the live connections per room; each ws session joins its
+;; room, broadcasts every received message to the room, and leaves on close.
+
+(define dream-chat-rooms (fn () (let ((rooms {})) {:join (fn (room ws) (set! rooms (assoc rooms room (concat (or (get rooms room) (list)) (list ws))))) :broadcast (fn (room msg) (for-each (fn (w) (dream-send w msg)) (or (get rooms room) (list)))) :members (fn (room) (or (get rooms room) (list))) :leave (fn (room ws) (set! rooms (assoc rooms room (filter (fn (w) (not (= w ws))) (or (get rooms room) (list))))))})))
+
+(define
+  dream-chat-loop
+  (fn
+    (rooms room ws)
+    (let
+      ((m (dream-receive ws)))
+      (if
+        (nil? m)
+        (begin ((get rooms :leave) room ws) (dream-close ws))
+        (begin
+          ((get rooms :broadcast) room m)
+          (dream-chat-loop rooms room ws))))))
+
+(define
+  dream-chat-session
+  (fn
+    (rooms room)
+    (fn
+      (ws)
+      (begin ((get rooms :join) room ws) (dream-chat-loop rooms room ws)))))
+
+(define
+  dream-chat-route
+  (fn
+    (rooms)
+    (fn
+      (req)
+      ((dream-websocket (dream-chat-session rooms (dream-param req "room")))
+        req))))
+
+(define
+  dream-chat-app-with
+  (fn
+    (rooms)
+    (dream-router
+      (list
+        (dream-get "/" (fn (req) (dream-html "<h1>Rooms</h1>")))
+        (dream-get "/chat/:room" (dream-chat-route rooms))))))
+
+;; entry point: (dream-run (dream-chat-app-with (dream-chat-rooms)))

lib/dream/demos/counter.sx

@@ -0,0 +1,35 @@
+;; lib/dream/demos/counter.sx — per-session visit counter (counter.ml).
+;; Demonstrates the session middleware: each browser session keeps its own count.
+
+(define
+  dream-counter-handler
+  (fn
+    (req)
+    (let
+      ((n (+ 1 (or (dream-session-field req "count") 0))))
+      (begin
+        (dream-set-session-field req "count" n)
+        (dream-html (str "<p>You have visited this page " n " time(s).</p>"))))))
+
+;; reset clears the session counter
+(define
+  dream-counter-reset
+  (fn
+    (req)
+    (begin
+      (dream-set-session-field req "count" 0)
+      (dream-redirect "/"))))
+
+(define
+  dream-counter-app-with
+  (fn
+    (backend)
+    ((dream-sessions backend)
+      (dream-router
+        (list
+          (dream-get "/" dream-counter-handler)
+          (dream-post "/reset" dream-counter-reset))))))
+
+(define dream-counter-app (dream-counter-app-with (dream-memory-sessions)))
+
+;; entry point: (dream-run (dream-counter-app-with (dream-memory-sessions)))

lib/dream/demos/hello.sx

@@ -0,0 +1,16 @@
+;; lib/dream/demos/hello.sx — the canonical Dream "Hello, World!" (hello.ml).
+;; Dream.run (Dream.router [Dream.get "/" (fun _ -> Dream.html "Hello!")]).
+
+(define
+  dream-hello-app
+  (dream-router
+    (list
+      (dream-get "/" (fn (req) (dream-html "<h1>Hello, World!</h1>")))
+      (dream-get
+        "/hello/:name"
+        (fn
+          (req)
+          (dream-html (str "<h1>Hello, " (dream-param req "name") "!</h1>")))))))
+
+;; entry point (installs the handler on the host):
+;;   (dream-run dream-hello-app)

lib/dream/demos/todo.sx

@@ -0,0 +1,96 @@
+;; lib/dream/demos/todo.sx — CRUD todo list with forms + CSRF (todo.ml).
+;; An in-memory store holds items; add/toggle/delete go through POST forms guarded
+;; by the CSRF middleware. User text is HTML-escaped on render (dream-escape).
+;; Wires session -> csrf -> router.
+
+(define
+  dream-todo-store
+  (fn () (let ((items (list)) (next-id 0)) {:all (fn () items) :add (fn (text) (begin (set! next-id (+ next-id 1)) (set! items (concat items (list {:id next-id :text text :done false}))) next-id)) :delete (fn (id) (set! items (filter (fn (it) (not (= (get it :id) id))) items))) :toggle (fn (id) (set! items (map (fn (it) (if (= (get it :id) id) (assoc it :done (not (get it :done))) it)) items)))})))
+
+(define
+  dr/todo-render
+  (fn
+    (store req)
+    (str
+      "<ul>"
+      (reduce
+        (fn
+          (acc it)
+          (str
+            acc
+            "<li>"
+            (if (get it :done) "[x] " "[ ] ")
+            (dream-escape (get it :text))
+            "</li>"))
+        ""
+        ((get store :all)))
+      "</ul>"
+      "<form method=\"post\" action=\"/add\">"
+      (dream-csrf-tag req)
+      "<input name=\"text\"><button>Add</button></form>")))
+
+(define
+  dream-todo-index
+  (fn (store) (fn (req) (dream-html (dr/todo-render store req)))))
+
+(define
+  dream-todo-add
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :add) (get (dream-ok-value r) "text"))
+            (dream-redirect "/"))
+          (dream-html-status
+            403
+            (str "Rejected: " (dream-err-reason r))))))))
+
+(define
+  dream-todo-toggle
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :toggle) (parse-int (dream-param req "id")))
+            (dream-redirect "/"))
+          (dream-html-status 403 "Rejected"))))))
+
+(define
+  dream-todo-delete
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :delete) (parse-int (dream-param req "id")))
+            (dream-redirect "/"))
+          (dream-html-status 403 "Rejected"))))))
+
+(define
+  dream-todo-app-with
+  (fn
+    (store backend secret)
+    ((dream-sessions backend)
+      ((dream-csrf secret)
+        (dream-router
+          (list
+            (dream-get "/" (dream-todo-index store))
+            (dream-post "/add" (dream-todo-add store))
+            (dream-post "/toggle/:id" (dream-todo-toggle store))
+            (dream-post "/delete/:id" (dream-todo-delete store))))))))
+
+;; entry: (dream-run (dream-todo-app-with (dream-todo-store) (dream-memory-sessions) "change-me"))

lib/dream/error.sx

@@ -0,0 +1,41 @@
+;; lib/dream/error.sx — Dream-on-SX status phrases + error-handling middleware.
+;; dream-catch wraps a handler and turns a raised error into a 500 response (or a
+;; custom page). Depends on types.sx.
+
+;; ── status reason phrases ──────────────────────────────────────────
+(define dr/status-texts {:206 "Partial Content" :202 "Accepted" :422 "Unprocessable Entity" :400 "Bad Request" :302 "Found" :204 "No Content" :502 "Bad Gateway" :429 "Too Many Requests" :301 "Moved Permanently" :415 "Unsupported Media Type" :405 "Method Not Allowed" :303 "See Other" :401 "Unauthorized" :304 "Not Modified" :503 "Service Unavailable" :404 "Not Found" :308 "Permanent Redirect" :504 "Gateway Timeout" :416 "Range Not Satisfiable" :500 "Internal Server Error" :307 "Temporary Redirect" :201 "Created" :501 "Not Implemented" :409 "Conflict" :200 "OK" :410 "Gone" :403 "Forbidden"})
+
+(define
+  dream-status-text
+  (fn (status) (or (get dr/status-texts (str status)) "Unknown")))
+(define
+  dream-status-line
+  (fn (status) (str status " " (dream-status-text status))))
+
+;; ── error-handling middleware ──────────────────────────────────────
+(define
+  dream-default-error-page
+  (fn
+    (req e)
+    (dream-html-status
+      500
+      (str "<h1>" (dream-status-line 500) "</h1>"))))
+
+(define
+  dream-catch-with
+  (fn
+    (on-error)
+    (fn
+      (next)
+      (fn (req) (guard (e (true (on-error req e))) (next req))))))
+
+(define dream-catch (dream-catch-with dream-default-error-page))
+
+;; a fallback handler that renders a status page for any code
+(define
+  dream-status-page
+  (fn
+    (status)
+    (dream-html-status
+      status
+      (str "<h1>" (dream-status-line status) "</h1>"))))

lib/dream/flash.sx

@@ -0,0 +1,91 @@
+;; lib/dream/flash.sx — Dream-on-SX flash messages.
+;; A single-request cookie store: messages added during one request are read on
+;; the NEXT request, then the cookie is cleared. Depends on types.sx + session.sx
+;; (shared cookie helpers). A message is {:category c :message m}.
+
+;; ── cookie codec ───────────────────────────────────────────────────
+;; escape the field separators so categories/messages round-trip safely
+(define
+  dr/flash-esc
+  (fn (s) (replace (replace (replace s "%" "%25") "|" "%7C") "~" "%7E")))
+(define
+  dr/flash-unesc
+  (fn (s) (replace (replace (replace s "%7E" "~") "%7C" "|") "%25" "%")))
+
+(define
+  dr/flash-encode
+  (fn
+    (msgs)
+    (join
+      "~"
+      (map
+        (fn
+          (m)
+          (str
+            (dr/flash-esc (get m :category))
+            "|"
+            (dr/flash-esc (get m :message))))
+        msgs))))
+
+(define
+  dr/flash-decode
+  (fn
+    (s)
+    (if
+      (= s "")
+      (list)
+      (map
+        (fn (part) (let ((i (index-of part "|"))) {:message (dr/flash-unesc (substr part (+ i 1))) :category (dr/flash-unesc (substr part 0 i))}))
+        (split s "~")))))
+
+;; ── mutable outbox cell ────────────────────────────────────────────
+(define dr/flash-box (fn () (let ((items (list))) {:add (fn (x) (set! items (concat items (list x)))) :get (fn () items)})))
+
+;; ── middleware ─────────────────────────────────────────────────────
+(define dream-flash-cookie-name "dream.flash")
+
+(define
+  dream-flash
+  (fn
+    (next)
+    (fn
+      (req)
+      (let
+        ((incoming (dr/flash-decode (or (dream-cookie req dream-flash-cookie-name) "")))
+          (box (dr/flash-box)))
+        (let
+          ((resp (next (assoc req :dream-flash {:box box :incoming incoming}))))
+          (let
+            ((out ((get box :get))))
+            (cond
+              ((not (empty? out))
+                (dream-set-cookie
+                  resp
+                  dream-flash-cookie-name
+                  (dr/flash-encode out)
+                  {:path "/" :http-only true :same-site "Lax"}))
+              ((not (empty? incoming))
+                (dream-drop-cookie resp dream-flash-cookie-name))
+              (else resp))))))))
+
+;; ── handler-facing API ─────────────────────────────────────────────
+(define
+  dream-add-flash-message
+  (fn
+    (req category msg)
+    (begin ((get (get (get req :dream-flash) :box) :add) {:message msg :category category}) req)))
+
+(define
+  dream-flash-messages
+  (fn (req) (get (get req :dream-flash) :incoming)))
+(define dream-flash-category (fn (m) (get m :category)))
+(define dream-flash-message (fn (m) (get m :message)))
+
+;; convenience: only messages of a given category
+(define
+  dream-flash-of
+  (fn
+    (req category)
+    (filter
+      (fn (m) (= (get m :category) category))
+      (dream-flash-messages req))))

lib/dream/form.sx

@@ -0,0 +1,403 @@
+;; lib/dream/form.sx — Dream-on-SX forms + CSRF.
+;; Parses application/x-www-form-urlencoded bodies; CSRF tokens are stateless,
+;; signed, and session-scoped. The signing function is injectable (a pure-SX keyed
+;; hash by default — production should swap in a host HMAC). Depends on types.sx +
+;; session.sx. dream-form returns an Ok/Err result value.
+
+;; ── Result (Ok/Err) ────────────────────────────────────────────────
+(define dream-ok (fn (v) {:value v :result "ok"}))
+(define dream-err (fn (r) {:reason r :result "err"}))
+(define dream-ok? (fn (x) (= (get x :result) "ok")))
+(define dream-err? (fn (x) (= (get x :result) "err")))
+(define dream-ok-value (fn (x) (get x :value)))
+(define dream-err-reason (fn (x) (get x :reason)))
+
+;; ── percent decoding ───────────────────────────────────────────────
+(define
+  dr/hex-digit
+  (fn
+    (c)
+    (let
+      ((n (char-code c)))
+      (cond
+        ((and (>= n 48) (<= n 57)) (- n 48))
+        ((and (>= n 65) (<= n 70))
+          (+ 10 (- n 65)))
+        ((and (>= n 97) (<= n 102))
+          (+ 10 (- n 97)))
+        (else 0)))))
+
+(define
+  dr/url-decode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((c (char-at s i)))
+        (if
+          (and (= c "%") (< (+ i 2) n))
+          (dr/url-decode-loop
+            s
+            (+ i 3)
+            n
+            (str
+              acc
+              (char-from-code
+                (+
+                  (* 16 (dr/hex-digit (char-at s (+ i 1))))
+                  (dr/hex-digit (char-at s (+ i 2)))))))
+          (dr/url-decode-loop s (+ i 1) n (str acc c)))))))
+
+(define
+  dr/url-decode
+  (fn
+    (s)
+    (let
+      ((s2 (replace s "+" " ")))
+      (dr/url-decode-loop s2 0 (string-length s2) ""))))
+
+;; ── percent encoding (symmetric with dr/url-decode) ────────────────
+;; RFC3986 unreserved set passes through; everything else is %XX (uppercase
+;; hex). Space becomes %20 (not +), so the result is safe in a query value.
+(define dr/hex-chars "0123456789ABCDEF")
+(define
+  dr/url-encode-char
+  (fn
+    (c)
+    (let
+      ((n (char-code c)))
+      (if
+        (or
+          (and (>= n 48) (<= n 57))   ;; 0-9
+          (and (>= n 65) (<= n 90))   ;; A-Z
+          (and (>= n 97) (<= n 122))  ;; a-z
+          (= c "-") (= c "_") (= c ".") (= c "~"))
+        c
+        (str "%"
+          (char-at dr/hex-chars (quotient n 16))
+          (char-at dr/hex-chars (mod n 16)))))))
+
+(define
+  dr/url-encode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (dr/url-encode-loop s (+ i 1) n
+        (str acc (dr/url-encode-char (char-at s i)))))))
+
+(define
+  dr/url-encode
+  (fn
+    (s)
+    (dr/url-encode-loop (or s "") 0 (string-length (or s "")) "")))
+
+;; ── substring splitter (split primitive is char-class based) ───────
+(define
+  dr/split-on
+  (fn
+    (s sep)
+    (let
+      ((i (index-of s sep)))
+      (if
+        (< i 0)
+        (list s)
+        (cons
+          (substr s 0 i)
+          (dr/split-on (substr s (+ i (string-length sep))) sep))))))
+
+;; ── urlencoded body parsing ────────────────────────────────────────
+(define
+  dr/parse-form-body
+  (fn
+    (body)
+    (if
+      (= body "")
+      {}
+      (reduce
+        (fn
+          (acc pair)
+          (if
+            (= pair "")
+            acc
+            (let
+              ((j (index-of pair "=")))
+              (if
+                (< j 0)
+                (assoc acc (dr/url-decode pair) "")
+                (assoc
+                  acc
+                  (dr/url-decode (substr pair 0 j))
+                  (dr/url-decode (substr pair (+ j 1))))))))
+        {}
+        (split body "&")))))
+
+;; raw fields, no CSRF check
+(define dream-form-fields (fn (req) (dr/parse-form-body (dream-body req))))
+(define
+  dream-form-field
+  (fn (req name) (get (dream-form-fields req) name)))
+
+;; ── CSRF signing (injectable; pure-SX keyed hash default) ──────────
+(define
+  dr/poly-hash
+  (fn (s base seed) (dr/poly-loop s 0 (string-length s) seed base)))
+(define
+  dr/poly-loop
+  (fn
+    (s i n h base)
+    (if
+      (>= i n)
+      h
+      (dr/poly-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h base) (char-code (char-at s i))) 2147483647)
+        base))))
+
+;; NOTE: not cryptographic — adequate to demonstrate stateless CSRF; production
+;; should inject a real HMAC via dream-csrf-with.
+(define
+  dream-csrf-sign-default
+  (fn
+    (secret msg)
+    (let
+      ((m (str secret "|" msg)))
+      (str
+        (dr/poly-hash m 131 7)
+        "-"
+        (dr/poly-hash m 137 13)))))
+
+(define dream-csrf-field-name "dream.csrf")
+
+(define
+  dr/csrf-make-token
+  (fn (sign secret sid) (str sid "." (sign secret sid))))
+
+(define
+  dr/csrf-valid?
+  (fn
+    (sign secret sid token)
+    (if
+      (or (nil? token) (= token ""))
+      false
+      (let
+        ((dot (index-of token ".")))
+        (if
+          (< dot 0)
+          false
+          (let
+            ((tsid (substr token 0 dot))
+              (tsig (substr token (+ dot 1))))
+            (and (= tsid sid) (= tsig (sign secret sid)))))))))
+
+;; ── CSRF middleware: attach signing context (needs session upstream) ──
+(define
+  dream-csrf-with
+  (fn
+    (secret sign)
+    (fn (next) (fn (req) (next (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret}))))))
+
+(define
+  dream-csrf
+  (fn (secret) (dream-csrf-with secret dream-csrf-sign-default)))
+
+(define dr/csrf-of (fn (req) (get req :dream-csrf)))
+
+;; current token + hidden-input tag for templates
+(define
+  dream-csrf-token
+  (fn
+    (req)
+    (let
+      ((c (dr/csrf-of req)))
+      (dr/csrf-make-token (get c :sign) (get c :secret) (get c :sid)))))
+
+(define
+  dream-csrf-tag
+  (fn
+    (req)
+    (str
+      "<input type=\"hidden\" name=\""
+      dream-csrf-field-name
+      "\" value=\""
+      (dream-csrf-token req)
+      "\">")))
+
+;; ── dream-form: parse + verify CSRF -> Ok fields | Err reason ──────
+(define
+  dream-form
+  (fn
+    (req)
+    (let
+      ((c (dr/csrf-of req)))
+      (if
+        (nil? c)
+        (dream-err :csrf-context-missing)
+        (let
+          ((fields (dream-form-fields req)))
+          (if
+            (dr/csrf-valid?
+              (get c :sign)
+              (get c :secret)
+              (get c :sid)
+              (get fields dream-csrf-field-name))
+            (dream-ok fields)
+            (dream-err :csrf-token-invalid)))))))
+
+;; ── CSRF auto-rejecting middleware (unsafe methods need a valid token) ──
+(define
+  dr/csrf-safe-method?
+  (fn (m) (or (= m "GET") (= m "HEAD") (= m "OPTIONS"))))
+
+(define
+  dream-csrf-protect-with
+  (fn
+    (secret sign)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((req2 (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret})))
+          (if
+            (dr/csrf-safe-method? (dream-method req2))
+            (next req2)
+            (let
+              ((token (get (dream-form-fields req2) dream-csrf-field-name)))
+              (if
+                (dr/csrf-valid? sign secret (dream-session-id req2) token)
+                (next req2)
+                (dream-html-status 403 "CSRF token invalid")))))))))
+
+(define
+  dream-csrf-protect
+  (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default)))
+
+;; ── multipart/form-data parsing ────────────────────────────────────
+;; In-memory (not yet streaming): parses the whole body into parts, each
+;; {:name :filename :content-type :content}. Returns Ok parts | Err :not-multipart.
+(define
+  dr/multipart-boundary
+  (fn
+    (ctype)
+    (let
+      ((i (index-of ctype "boundary=")))
+      (if
+        (< i 0)
+        ""
+        (let
+          ((raw (trim (substr ctype (+ i 9)))))
+          (if
+            (starts-with? raw "\"")
+            (substr raw 1 (- (string-length raw) 2))
+            raw))))))
+
+;; strip one leading and one trailing CRLF
+(define
+  dr/strip-edges
+  (fn
+    (s)
+    (let
+      ((s1 (if (starts-with? s "\r\n") (substr s 2) s)))
+      (if
+        (ends-with? s1 "\r\n")
+        (substr s1 0 (- (string-length s1) 2))
+        s1))))
+
+;; value of attr="..." within a header block
+(define
+  dr/cd-attr
+  (fn
+    (block attr)
+    (let
+      ((key (str attr "=\"")))
+      (let
+        ((i (index-of block key)))
+        (if
+          (< i 0)
+          nil
+          (let
+            ((rest (substr block (+ i (string-length key)))))
+            (substr rest 0 (index-of rest "\""))))))))
+
+;; value of a named header line within a header block
+(define
+  dr/block-header
+  (fn
+    (block name)
+    (reduce
+      (fn
+        (acc line)
+        (if
+          (and
+            (nil? acc)
+            (starts-with? (lower line) (str (lower name) ":")))
+          (trim (substr line (+ (index-of line ":") 1)))
+          acc))
+      nil
+      (dr/split-on block "\r\n"))))
+
+(define
+  dr/parse-part
+  (fn
+    (seg)
+    (let
+      ((s (dr/strip-edges seg)))
+      (let
+        ((sp (index-of s "\r\n\r\n")))
+        (if
+          (< sp 0)
+          nil
+          (let
+            ((block (substr s 0 sp))
+              (content (substr s (+ sp 4))))
+            {:name (dr/cd-attr block "name") :filename (dr/cd-attr block "filename") :content-type (dr/block-header block "content-type") :content content}))))))
+
+(define
+  dream-multipart
+  (fn
+    (req)
+    (let
+      ((boundary (dr/multipart-boundary (or (dream-header req "content-type") ""))))
+      (if
+        (= boundary "")
+        (dream-err :not-multipart)
+        (let
+          ((segs (dr/split-on (dream-body req) (str "--" boundary))))
+          (dream-ok
+            (filter
+              (fn (p) (not (nil? p)))
+              (map
+                dr/parse-part
+                (filter (fn (seg) (starts-with? seg "\r\n")) segs)))))))))
+
+;; accessors over a parts list
+(define
+  dream-multipart-field
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if (and (nil? acc) (= (get p :name) name)) (get p :content) acc))
+      nil
+      parts)))
+
+(define
+  dream-multipart-file
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if
+          (and (nil? acc) (= (get p :name) name) (get p :filename))
+          p
+          acc))
+      nil
+      parts)))

lib/dream/headers.sx

@@ -0,0 +1,54 @@
+;; lib/dream/headers.sx — Dream-on-SX security headers + cache-control helpers.
+;; Depends on types.sx.
+
+;; ── security headers middleware ────────────────────────────────────
+(define dream-security-defaults {:x-frame-options "DENY" :referrer-policy "no-referrer" :x-content-type-options "nosniff" :hsts false})
+
+(define
+  dr/apply-security
+  (fn
+    (opts resp)
+    (let
+      ((r1 (dream-add-header (dream-add-header (dream-add-header resp "x-content-type-options" (get opts :x-content-type-options)) "x-frame-options" (get opts :x-frame-options)) "referrer-policy" (get opts :referrer-policy))))
+      (if
+        (get opts :hsts)
+        (dream-add-header
+          r1
+          "strict-transport-security"
+          "max-age=31536000; includeSubDomains")
+        r1))))
+
+(define
+  dream-security-headers-with
+  (fn (opts) (fn (next) (fn (req) (dr/apply-security opts (next req))))))
+(define
+  dream-security-headers
+  (dream-security-headers-with dream-security-defaults))
+
+;; ── cache-control response helpers ─────────────────────────────────
+(define
+  dream-cache
+  (fn
+    (resp seconds)
+    (dream-add-header resp "cache-control" (str "public, max-age=" seconds))))
+(define
+  dream-private-cache
+  (fn
+    (resp seconds)
+    (dream-add-header resp "cache-control" (str "private, max-age=" seconds))))
+(define
+  dream-no-store
+  (fn (resp) (dream-add-header resp "cache-control" "no-store")))
+(define
+  dream-no-cache
+  (fn
+    (resp)
+    (dream-add-header
+      resp
+      "cache-control"
+      "no-cache, no-store, must-revalidate")))
+
+;; cache-control middleware: stamp a max-age on every response
+(define
+  dream-cache-for
+  (fn (seconds) (fn (next) (fn (req) (dream-cache (next req) seconds)))))

lib/dream/html.sx

@@ -0,0 +1,24 @@
+;; lib/dream/html.sx — Dream-on-SX HTML escaping for safe templating.
+;; Interpolating user input into HTML without escaping is an XSS hole; dream-escape
+;; neutralises it. Depends on nothing (pure string ops).
+
+;; escape text for HTML element content / double-quoted attributes
+(define
+  dream-escape
+  (fn
+    (s)
+    (replace
+      (replace
+        (replace (replace (replace s "&" "&amp;") "<" "&lt;") ">" "&gt;")
+        "\""
+        "&quot;")
+      "'"
+      "&#39;")))
+
+;; build a single attribute: name="escaped-value"
+(define dream-attr (fn (name val) (str name "=\"" (dream-escape val) "\"")))
+
+;; join escaped text with a separator, escaping each piece
+(define
+  dream-escape-join
+  (fn (sep pieces) (join sep (map dream-escape pieces))))

lib/dream/json.sx

@@ -0,0 +1,183 @@
+;; lib/dream/json.sx — Dream-on-SX JSON encode/parse (pure SX).
+;; The host JSON primitives live in the ocaml-on-sx runtime, not the base env, so
+;; Dream ships its own. Depends on types.sx. (number? is unreliable in this env —
+;; type-of "number" is used instead.)
+
+;; ── encoding ───────────────────────────────────────────────────────
+(define
+  dr/json-escape
+  (fn
+    (s)
+    (replace
+      (replace
+        (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n")
+        "\r"
+        "\\r")
+      "\t"
+      "\\t")))
+(define dr/json-quote (fn (s) (str "\"" (dr/json-escape s) "\"")))
+
+(define
+  dream-json-encode
+  (fn
+    (v)
+    (cond
+      ((nil? v) "null")
+      ((boolean? v) (if v "true" "false"))
+      ((= (type-of v) "number") (str v))
+      ((string? v) (dr/json-quote v))
+      ((list? v) (str "[" (join "," (map dream-json-encode v)) "]"))
+      ((dict? v)
+        (str
+          "{"
+          (join
+            ","
+            (map
+              (fn
+                (k)
+                (str (dr/json-quote k) ":" (dream-json-encode (get v k))))
+              (keys v)))
+          "}"))
+      (else (dr/json-quote (str v))))))
+
+;; ── parsing (recursive descent; returns {:val :pos}) ───────────────
+(define
+  dr/json-space?
+  (fn (c) (or (= c " ") (= c "\n") (= c "\r") (= c "\t"))))
+(define
+  dr/json-ws
+  (fn
+    (s i)
+    (if
+      (and (< i (string-length s)) (dr/json-space? (char-at s i)))
+      (dr/json-ws s (+ i 1))
+      i)))
+
+(define
+  dr/json-digit?
+  (fn
+    (c)
+    (let ((n (char-code c))) (and (>= n 48) (<= n 57)))))
+(define
+  dr/json-num-char?
+  (fn
+    (c)
+    (or
+      (dr/json-digit? c)
+      (= c "-")
+      (= c "+")
+      (= c ".")
+      (= c "e")
+      (= c "E"))))
+(define
+  dr/json-num-end
+  (fn
+    (s i)
+    (if
+      (and (< i (string-length s)) (dr/json-num-char? (char-at s i)))
+      (dr/json-num-end s (+ i 1))
+      i)))
+(define
+  dr/json-to-number
+  (fn
+    (str-val)
+    (if
+      (or
+        (contains? str-val ".")
+        (contains? str-val "e")
+        (contains? str-val "E"))
+      (parse-float str-val)
+      (parse-int str-val))))
+
+(define
+  dr/json-str
+  (fn
+    (s i acc)
+    (let
+      ((c (char-at s i)))
+      (cond
+        ((= c "\"") {:val acc :pos (+ i 1)})
+        ((= c "\\")
+          (let
+            ((e (char-at s (+ i 1))))
+            (cond
+              ((= e "n") (dr/json-str s (+ i 2) (str acc "\n")))
+              ((= e "r") (dr/json-str s (+ i 2) (str acc "\r")))
+              ((= e "t") (dr/json-str s (+ i 2) (str acc "\t")))
+              (else (dr/json-str s (+ i 2) (str acc e))))))
+        (else (dr/json-str s (+ i 1) (str acc c)))))))
+
+(define
+  dr/json-num
+  (fn (s i) (let ((j (dr/json-num-end s i))) {:val (dr/json-to-number (substr s i (- j i))) :pos j})))
+
+(define
+  dr/json-arr
+  (fn
+    (s i acc)
+    (let
+      ((i (dr/json-ws s i)))
+      (if
+        (= (char-at s i) "]")
+        {:val acc :pos (+ i 1)}
+        (let
+          ((r (dr/json-val s i)))
+          (let
+            ((i2 (dr/json-ws s (get r :pos))))
+            (if
+              (= (char-at s i2) ",")
+              (dr/json-arr
+                s
+                (+ i2 1)
+                (concat acc (list (get r :val))))
+              {:val (concat acc (list (get r :val))) :pos (+ i2 1)})))))))
+
+(define
+  dr/json-obj
+  (fn
+    (s i acc)
+    (let
+      ((i (dr/json-ws s i)))
+      (if
+        (= (char-at s i) "}")
+        {:val acc :pos (+ i 1)}
+        (let
+          ((kr (dr/json-str s (+ i 1) "")))
+          (let
+            ((i2 (dr/json-ws s (get kr :pos))))
+            (let
+              ((vr (dr/json-val s (+ i2 1))))
+              (let
+                ((i3 (dr/json-ws s (get vr :pos))))
+                (if
+                  (= (char-at s i3) ",")
+                  (dr/json-obj
+                    s
+                    (+ i3 1)
+                    (assoc acc (get kr :val) (get vr :val)))
+                  {:val (assoc acc (get kr :val) (get vr :val)) :pos (+ i3 1)})))))))))
+
+(define
+  dr/json-val
+  (fn
+    (s i)
+    (let
+      ((i (dr/json-ws s i)))
+      (let
+        ((c (char-at s i)))
+        (cond
+          ((= c "{") (dr/json-obj s (+ i 1) {}))
+          ((= c "[") (dr/json-arr s (+ i 1) (list)))
+          ((= c "\"") (dr/json-str s (+ i 1) ""))
+          ((= c "t") {:val true :pos (+ i 4)})
+          ((= c "f") {:val false :pos (+ i 5)})
+          ((= c "n") {:val nil :pos (+ i 4)})
+          (else (dr/json-num s i)))))))
+
+(define dream-json-parse (fn (s) (get (dr/json-val s 0) :val)))
+
+;; ── responses ──────────────────────────────────────────────────────
+;; encode a value into a JSON response (dream-json takes a raw string body)
+(define dream-json-value (fn (v) (dream-json (dream-json-encode v))))
+;; read + parse the request body as JSON
+(define dream-json-body (fn (req) (dream-json-parse (dream-body req))))

lib/dream/middleware.sx

@@ -0,0 +1,92 @@
+;; lib/dream/middleware.sx — Dream-on-SX middleware.
+;; A middleware is handler->handler. Composition is plain function composition:
+;; m1 @@ m2 @@ handler = (m1 (m2 handler)). Depends on types.sx + router.sx
+;; (reuses dr/apply-middlewares for the fold).
+
+;; ── composition ────────────────────────────────────────────────────
+;; (dream-pipeline (list m1 m2 m3) handler) = (m1 (m2 (m3 handler))).
+(define
+  dream-pipeline
+  (fn (middlewares handler) (dr/apply-middlewares middlewares handler)))
+
+;; identity middleware
+(define dream-no-middleware (fn (next) next))
+
+;; ── logger ─────────────────────────────────────────────────────────
+;; Parameterised on a clock and a sink so it is testable without IO.
+;; sink receives {:method :path :status :elapsed}.
+(define
+  dream-logger-with
+  (fn
+    (clock sink)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((t0 (clock)))
+          (let ((resp (next req))) (begin (sink {:path (dream-path req) :status (dream-status resp) :method (dream-method req) :elapsed (- (clock) t0)}) resp)))))))
+
+;; default logger performs host effects for the clock and the log sink
+(define
+  dream-logger
+  (dream-logger-with
+    (fn () (perform (:dream-clock)))
+    (fn (entry) (perform (:dream-log entry)))))
+
+;; format a log entry as a one-line string (apache-ish)
+(define
+  dream-log-line
+  (fn
+    (entry)
+    (str
+      (get entry :method)
+      " "
+      (get entry :path)
+      " -> "
+      (get entry :status)
+      " ("
+      (get entry :elapsed)
+      "ms)")))
+
+;; ── content-type sniffer ───────────────────────────────────────────
+(define
+  dr/sniff-content-type
+  (fn
+    (body)
+    (cond
+      ((= body "") "text/plain; charset=utf-8")
+      ((starts-with? body "<") "text/html; charset=utf-8")
+      ((starts-with? body "{") "application/json")
+      ((starts-with? body "[") "application/json")
+      (else "text/plain; charset=utf-8"))))
+
+;; sets Content-Type from the body only when the handler left it unset
+(define
+  dream-content-type
+  (fn
+    (next)
+    (fn
+      (req)
+      (let
+        ((resp (next req)))
+        (if
+          (dream-resp-header resp "content-type")
+          resp
+          (dream-add-header
+            resp
+            "content-type"
+            (dr/sniff-content-type (dream-resp-body resp))))))))
+
+;; ── small reusable middlewares ─────────────────────────────────────
+;; always attach a response header
+(define
+  dream-set-header
+  (fn
+    (name val)
+    (fn (next) (fn (req) (dream-add-header (next req) name val)))))
+
+;; rewrite/observe the request before the handler sees it
+(define
+  dream-tap-request
+  (fn (f) (fn (next) (fn (req) (next (f req))))))

lib/dream/router.sx

@@ -0,0 +1,170 @@
+;; lib/dream/router.sx — Dream-on-SX routing.
+;; Routes are dicts {:method :path :handler}; a router is a handler that
+;; dispatches request -> response by method + path, extracting :name path
+;; params and binding a ** catch-all. No path match -> 404; path matches but
+;; method doesn't -> 405 + Allow. HEAD falls back to the GET handler with an
+;; empty body. Depends on types.sx.
+
+;; ── route constructors (one per HTTP method) ───────────────────────
+(define dream-get (fn (path handler) (dream-route "GET" path handler)))
+(define dream-post (fn (path handler) (dream-route "POST" path handler)))
+(define dream-put (fn (path handler) (dream-route "PUT" path handler)))
+(define
+  dream-delete
+  (fn (path handler) (dream-route "DELETE" path handler)))
+(define dream-patch (fn (path handler) (dream-route "PATCH" path handler)))
+(define dream-head (fn (path handler) (dream-route "HEAD" path handler)))
+(define
+  dream-options
+  (fn (path handler) (dream-route "OPTIONS" path handler)))
+(define dream-any (fn (path handler) (dream-route "ANY" path handler)))
+
+;; ── path segmentation ──────────────────────────────────────────────
+;; "/users/42/" -> ("users" "42"); "/" -> ()
+(define
+  dr/segs
+  (fn (path) (filter (fn (s) (not (= s ""))) (split path "/"))))
+
+(define
+  dr/join-path
+  (fn
+    (prefix path)
+    (str "/" (join "/" (concat (dr/segs prefix) (dr/segs path))))))
+
+;; ── segment matching ───────────────────────────────────────────────
+;; Returns a params dict on match (possibly empty {}), nil on no match.
+(define
+  dr/match-segs
+  (fn
+    (pat path params)
+    (cond
+      ((and (empty? pat) (empty? path)) params)
+      ((empty? pat) nil)
+      (else
+        (let
+          ((ps (first pat)))
+          (cond
+            ((= ps "**") (assoc params "**" (join "/" path)))
+            ((empty? path) nil)
+            ((starts-with? ps ":")
+              (dr/match-segs
+                (rest pat)
+                (rest path)
+                (assoc params (substr ps 1) (first path))))
+            ((= ps (first path))
+              (dr/match-segs (rest pat) (rest path) params))
+            (else nil)))))))
+
+;; path-only match: returns params dict or nil
+(define
+  dr/route-params
+  (fn
+    (r req)
+    (dr/match-segs
+      (dr/segs (dream-route-path r))
+      (dr/segs (dream-path req))
+      {})))
+
+;; method acceptance: exact, ANY, or HEAD served by a GET route
+(define
+  dr/method-accepts?
+  (fn
+    (route-method req-method)
+    (or
+      (= route-method "ANY")
+      (= route-method req-method)
+      (and (= req-method "HEAD") (= route-method "GET")))))
+
+;; ── middleware pipeline (shared with middleware.sx) ────────────────
+;; m1 @@ m2 @@ handler = (m1 (m2 handler)); first in list is outermost.
+(define
+  dr/apply-middlewares
+  (fn (mws handler) (reduce (fn (h mw) (mw h)) handler (reverse mws))))
+
+;; ── scope: prefix mount + middleware chain ─────────────────────────
+;; Returns a flat list of routes; nested scopes flatten correctly.
+(define
+  dr/flatten-routes
+  (fn
+    (items)
+    (reduce
+      (fn
+        (acc it)
+        (if
+          (dream-route? it)
+          (concat acc (list it))
+          (concat acc (dr/flatten-routes it))))
+      (list)
+      items)))
+
+(define
+  dream-scope
+  (fn
+    (prefix middlewares routes)
+    (map
+      (fn
+        (r)
+        (dream-route
+          (dream-route-method r)
+          (dr/join-path prefix (dream-route-path r))
+          (dr/apply-middlewares middlewares (dream-route-handler r))))
+      (dr/flatten-routes routes))))
+
+;; ── dispatch ───────────────────────────────────────────────────────
+;; allowed = methods of routes whose PATH matched (for 405 + Allow).
+(define
+  dr/dispatch
+  (fn
+    (routes req allowed)
+    (if
+      (empty? routes)
+      (if
+        (empty? allowed)
+        (dream-not-found)
+        (dream-method-not-allowed allowed))
+      (let
+        ((r (first routes)))
+        (let
+          ((params (dr/route-params r req)))
+          (if
+            (nil? params)
+            (dr/dispatch (rest routes) req allowed)
+            (if
+              (dr/method-accepts? (dream-route-method r) (dream-method req))
+              (dr/run-route r req params)
+              (dr/dispatch
+                (rest routes)
+                req
+                (concat allowed (list (dream-route-method r)))))))))))
+
+;; run a matched route; blank the body for an auto-HEAD on a GET route
+(define
+  dr/run-route
+  (fn
+    (r req params)
+    (let
+      ((resp (dream-coerce-response ((dream-route-handler r) (dream-with-params req params)))))
+      (if
+        (and
+          (= (dream-method req) "HEAD")
+          (not (= (dream-route-method r) "HEAD")))
+        (dream-response (dream-status resp) (dream-headers resp) "")
+        resp))))
+
+;; 405 response with an Allow header listing the path's methods
+(define
+  dream-method-not-allowed
+  (fn
+    (allowed)
+    (dream-add-header
+      (dream-response 405 {:content-type "text/plain; charset=utf-8"} "Method Not Allowed")
+      "allow"
+      (join ", " allowed))))
+
+(define
+  dream-router
+  (fn
+    (routes)
+    (let
+      ((flat (dr/flatten-routes routes)))
+      (fn (req) (dr/dispatch flat req (list))))))

lib/dream/run.sx

@@ -0,0 +1,42 @@
+;; lib/dream/run.sx — Dream-on-SX entry point.
+;; dream-run installs a root handler into the existing SX HTTP server via
+;; (perform (:http/listen …)) — it does NOT implement its own socket loop. The
+;; host invokes the installed app per request with a raw request dict; the app
+;; adapts it to a dream-request, runs the handler, and serialises the response
+;; (status/headers/body/set-cookies, or a websocket upgrade). Depends on types.sx
+;; + websocket.sx. The listen transport is injectable for testing.
+
+;; ── response serialisation for the host ────────────────────────────
+(define
+  dr/serialize-response
+  (fn (resp) (if (dream-websocket? resp) {:websocket (dream-ws-handler resp) :body "" :headers (dream-headers resp) :status 101 :set-cookies (list)} {:body (dream-resp-body resp) :headers (dream-headers resp) :status (dream-status resp) :set-cookies (dream-resp-cookies resp)})))
+
+;; ── the app: raw host request -> serialised response ───────────────
+(define
+  dream-app
+  (fn
+    (handler)
+    (fn
+      (raw)
+      (let
+        ((req (dream-request (or (get raw :method) "GET") (or (get raw :target) (or (get raw :path) "/")) (or (get raw :headers) {}) (or (get raw :body) ""))))
+        (dr/serialize-response (dream-coerce-response (handler req)))))))
+
+;; ── dream-run ──────────────────────────────────────────────────────
+(define dream-default-port 8080)
+
+(define dream-run-with (fn (listen handler opts) (listen {:op "http/listen" :port (or (get opts :port) dream-default-port) :app (dream-app handler) :host (or (get opts :host) "0.0.0.0")})))
+
+(define dream-perform-listen (fn (op) (perform op)))
+
+(define
+  dream-run
+  (fn (handler) (dream-run-with dream-perform-listen handler {})))
+(define
+  dream-run-port
+  (fn
+    (handler port)
+    (dream-run-with dream-perform-listen handler {:port port})))
+(define
+  dream-run-opts
+  (fn (handler opts) (dream-run-with dream-perform-listen handler opts)))

lib/dream/session.sx

@@ -0,0 +1,238 @@
+;; lib/dream/session.sx — Dream-on-SX cookie-backed sessions.
+;; The session cookie carries only a session id; fields live in a back-end store.
+;; The store is injectable: production wires it to (perform op); tests pass an
+;; in-memory store. Depends on types.sx. Also hosts shared cookie helpers reused
+;; by flash.sx and form.sx.
+
+;; ── cookie helpers (shared) ────────────────────────────────────────
+(define
+  dr/parse-cookies
+  (fn
+    (header)
+    (if
+      (or (nil? header) (= header ""))
+      {}
+      (reduce
+        (fn
+          (acc part)
+          (let
+            ((kv (trim part)))
+            (let
+              ((j (index-of kv "=")))
+              (if
+                (< j 0)
+                acc
+                (assoc
+                  acc
+                  (substr kv 0 j)
+                  (substr kv (+ j 1)))))))
+        {}
+        (split header ";")))))
+
+(define
+  dream-cookie
+  (fn (req name) (get (dr/parse-cookies (dream-header req "cookie")) name)))
+(define
+  dream-cookies
+  (fn (req) (dr/parse-cookies (dream-header req "cookie"))))
+
+(define
+  dr/build-cookie
+  (fn
+    (name val opts)
+    (let
+      ((o (if (nil? opts) {} opts)))
+      (str
+        name
+        "="
+        val
+        "; Path="
+        (or (get o :path) "/")
+        (if (get o :http-only) "; HttpOnly" "")
+        (if (get o :secure) "; Secure" "")
+        (if (get o :same-site) (str "; SameSite=" (get o :same-site)) "")
+        (if (get o :max-age) (str "; Max-Age=" (get o :max-age)) "")))))
+
+(define
+  dream-set-cookie
+  (fn
+    (resp name val opts)
+    (assoc
+      resp
+      :set-cookies (concat
+        (or (get resp :set-cookies) (list))
+        (list (dr/build-cookie name val opts))))))
+
+(define
+  dream-resp-cookies
+  (fn (resp) (or (get resp :set-cookies) (list))))
+
+;; expire a cookie on the client
+(define
+  dream-drop-cookie
+  (fn (resp name) (dream-set-cookie resp name "" {:max-age 0})))
+
+;; ── signed cookie values (tamper-evident) ──────────────────────────
+;; NOTE: pure-SX keyed hash — not cryptographic; production should inject a host
+;; HMAC. Value carries no "." so the first "." splits value from signature.
+(define
+  dr/sess-hash
+  (fn (s) (dr/sess-hash-loop s 0 (string-length s) 7)))
+(define
+  dr/sess-hash-loop
+  (fn
+    (s i n h)
+    (if
+      (>= i n)
+      h
+      (dr/sess-hash-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h 131) (char-code (char-at s i))) 2147483647)))))
+(define
+  dr/sess-sig
+  (fn (secret val) (str (dr/sess-hash (str secret "|" val)))))
+
+(define
+  dream-cookie-sign
+  (fn (secret val) (str val "." (dr/sess-sig secret val))))
+(define
+  dream-cookie-unsign
+  (fn
+    (secret signed)
+    (if
+      (or (nil? signed) (= signed ""))
+      nil
+      (let
+        ((dot (index-of signed ".")))
+        (if
+          (< dot 0)
+          nil
+          (let
+            ((val (substr signed 0 dot))
+              (sig (substr signed (+ dot 1))))
+            (if (= sig (dr/sess-sig secret val)) val nil)))))))
+
+;; ── in-memory session store (tests + demos) ────────────────────────
+;; A backend is (fn (op) result) where op is a dict {:op ... :sid ... :key ...}.
+(define
+  dream-memory-sessions
+  (fn
+    ()
+    (let
+      ((store {}) (counter 0))
+      (fn
+        (op)
+        (let
+          ((kind (get op :op)))
+          (cond
+            ((= kind "session/create")
+              (begin
+                (set! counter (+ counter 1))
+                (let
+                  ((sid (str "s" counter)))
+                  (begin (set! store (assoc store sid {})) sid))))
+            ((= kind "session/exists") (has-key? store (get op :sid)))
+            ((= kind "session/get")
+              (get (or (get store (get op :sid)) {}) (get op :key)))
+            ((= kind "session/set")
+              (let
+                ((sid (get op :sid)))
+                (set!
+                  store
+                  (assoc
+                    store
+                    sid
+                    (assoc
+                      (or (get store sid) {})
+                      (get op :key)
+                      (get op :val))))))
+            ((= kind "session/load")
+              (or (get store (get op :sid)) {}))
+            ((= kind "session/clear")
+              (set! store (dissoc store (get op :sid))))
+            (else nil)))))))
+
+;; production back-end: every op suspends to the host
+(define dream-perform-sessions (fn (op) (perform op)))
+
+;; ── session middleware ─────────────────────────────────────────────
+(define dream-session-cookie-name "dream.session")
+
+(define
+  dream-sessions
+  (fn
+    (backend)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((sid0 (dream-cookie req dream-session-cookie-name)))
+          (let
+            ((have (and sid0 (backend {:op "session/exists" :sid sid0}))))
+            (let
+              ((sid (if have sid0 (backend {:op "session/create"}))))
+              (let
+                ((resp (next (assoc req :dream-session {:io backend :sid sid}))))
+                (if
+                  have
+                  resp
+                  (dream-set-cookie
+                    resp
+                    dream-session-cookie-name
+                    sid
+                    {:path "/" :http-only true :same-site "Lax"}))))))))))
+
+;; signed variant: the cookie value is signed so a guessed/forged sid is rejected
+(define
+  dream-sessions-signed
+  (fn
+    (backend secret)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((sid0 (dream-cookie-unsign secret (dream-cookie req dream-session-cookie-name))))
+          (let
+            ((have (and sid0 (backend {:op "session/exists" :sid sid0}))))
+            (let
+              ((sid (if have sid0 (backend {:op "session/create"}))))
+              (let
+                ((resp (next (assoc req :dream-session {:io backend :sid sid}))))
+                (if
+                  have
+                  resp
+                  (dream-set-cookie
+                    resp
+                    dream-session-cookie-name
+                    (dream-cookie-sign secret sid)
+                    {:path "/" :http-only true :same-site "Lax"}))))))))))
+
+;; ── handler-facing session API ─────────────────────────────────────
+(define dr/session-of (fn (req) (get req :dream-session)))
+(define dream-session-id (fn (req) (get (dr/session-of req) :sid)))
+
+(define
+  dream-session-field
+  (fn
+    (req key)
+    (let ((s (dr/session-of req))) ((get s :io) {:key key :op "session/get" :sid (get s :sid)}))))
+
+(define
+  dream-set-session-field
+  (fn
+    (req key val)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:val val :key key :op "session/set" :sid (get s :sid)}) req))))
+
+(define
+  dream-session-all
+  (fn (req) (let ((s (dr/session-of req))) ((get s :io) {:op "session/load" :sid (get s :sid)}))))
+
+(define
+  dream-invalidate-session
+  (fn
+    (req)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:op "session/clear" :sid (get s :sid)}) req))))

lib/dream/static.sx

@@ -0,0 +1,182 @@
+;; lib/dream/static.sx — Dream-on-SX static file serving.
+;; dream-static mounts at a ** route and serves files under a root: content-type by
+;; extension, ETags + If-None-Match (304), and Range requests (206). The filesystem
+;; is injectable: production reads via (perform op); tests pass an in-memory map.
+;; Depends on types.sx.
+
+;; ── filesystem backends ────────────────────────────────────────────
+;; An fs is (fn (op) result); op {:op "file/read" :path p} -> content | nil.
+(define dream-static-perform-fs (fn (op) (perform op)))
+
+;; in-memory fs over a {path -> content} dict (tests + demos)
+(define
+  dream-memory-fs
+  (fn
+    (files)
+    (fn
+      (op)
+      (if (= (get op :op) "file/read") (get files (get op :path)) nil))))
+
+;; ── content-type by extension ──────────────────────────────────────
+(define dr/mime-types {:js "application/javascript" :jpeg "image/jpeg" :css "text/css; charset=utf-8" :ico "image/x-icon" :mjs "application/javascript" :html "text/html; charset=utf-8" :pdf "application/pdf" :jpg "image/jpeg" :json "application/json" :htm "text/html; charset=utf-8" :wasm "application/wasm" :webp "image/webp" :gif "image/gif" :png "image/png" :svg "image/svg+xml" :md "text/markdown; charset=utf-8" :xml "application/xml" :sx "text/plain; charset=utf-8" :txt "text/plain; charset=utf-8"})
+
+(define
+  dr/ext-of
+  (fn
+    (path)
+    (let
+      ((segs (split path ".")))
+      (if
+        (> (len segs) 1)
+        (lower (nth segs (- (len segs) 1)))
+        ""))))
+
+(define
+  dream-content-type-for
+  (fn
+    (path)
+    (or (get dr/mime-types (dr/ext-of path)) "application/octet-stream")))
+
+;; ── ETag (weak content hash) ───────────────────────────────────────
+(define
+  dr/static-hash
+  (fn (s) (dr/static-hash-loop s 0 (string-length s) 7)))
+(define
+  dr/static-hash-loop
+  (fn
+    (s i n h)
+    (if
+      (>= i n)
+      h
+      (dr/static-hash-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h 131) (char-code (char-at s i))) 2147483647)))))
+(define
+  dr/etag-of
+  (fn
+    (content)
+    (str "\"" (dr/static-hash content) "-" (string-length content) "\"")))
+(define
+  dr/etag-match?
+  (fn (inm etag) (and (not (nil? inm)) (or (= inm "*") (= inm etag)))))
+
+;; ── path safety ────────────────────────────────────────────────────
+(define
+  dr/static-relpath
+  (fn
+    (req)
+    (or (dream-param req "**") (substr (dream-path req) 1))))
+(define
+  dr/unsafe-path?
+  (fn (rel) (or (contains? rel "..") (starts-with? rel "/")))) 
+(define
+  dr/path-join
+  (fn
+    (root rel)
+    (if (ends-with? root "/") (str root rel) (str root "/" rel))))
+
+;; ── range requests ─────────────────────────────────────────────────
+(define
+  dr/parse-range
+  (fn
+    (header total)
+    (let
+      ((eq (index-of header "=")))
+      (if
+        (< eq 0)
+        nil
+        (let
+          ((spec (substr header (+ eq 1))))
+          (let
+            ((dash (index-of spec "-")))
+            (if
+              (< dash 0)
+              nil
+              (let
+                ((s (substr spec 0 dash))
+                  (e (substr spec (+ dash 1))))
+                (let
+                  ((start (if (= s "") 0 (parse-int s)))
+                    (end (if (= e "") (- total 1) (parse-int e))))
+                  (if
+                    (or
+                      (< start 0)
+                      (>= start total)
+                      (> end (- total 1))
+                      (> start end))
+                    nil
+                    {:start start :end end}))))))))))
+
+(define
+  dr/serve-range
+  (fn
+    (req content etag ctype)
+    (let
+      ((total (string-length content)))
+      (let
+        ((r (dr/parse-range (dream-header req "range") total)))
+        (if
+          (nil? r)
+          (dream-add-header
+            (dream-response 416 {:content-type ctype} "")
+            "content-range"
+            (str "bytes */" total))
+          (let
+            ((start (get r :start)) (end (get r :end)))
+            (dream-add-header
+              (dream-add-header
+                (dream-response
+                  206
+                  {:content-type ctype}
+                  (substr content start (+ 1 (- end start))))
+                "content-range"
+                (str "bytes " start "-" end "/" total))
+              "etag"
+              etag)))))))
+
+;; ── serving ────────────────────────────────────────────────────────
+(define
+  dr/serve-file
+  (fn
+    (req content)
+    (let
+      ((rel (dr/static-relpath req)))
+      (let
+        ((etag (dr/etag-of content)) (ctype (dream-content-type-for rel)))
+        (cond
+          ((dr/etag-match? (dream-header req "if-none-match") etag)
+            (dream-add-header (dream-empty 304) "etag" etag))
+          ((dream-header req "range")
+            (dr/serve-range req content etag ctype))
+          (else
+            (dream-add-header
+              (dream-add-header
+                (dream-response 200 {:content-type ctype} content)
+                "etag"
+                etag)
+              "accept-ranges"
+              "bytes")))))))
+
+(define
+  dream-static-with
+  (fn
+    (root fs)
+    (fn
+      (req)
+      (let
+        ((rel (dr/static-relpath req)))
+        (if
+          (dr/unsafe-path? rel)
+          (dream-html-status 403 "Forbidden")
+          (let
+            ((content (fs {:path (dr/path-join root rel) :op "file/read"})))
+            (if
+              (nil? content)
+              (dream-not-found)
+              (dr/serve-file req content))))))))
+
+(define
+  dream-static
+  (fn (root) (dream-static-with root dream-static-perform-fs)))

lib/dream/tests/api.sx

@@ -0,0 +1,77 @@
+;; lib/dream/tests/api.sx — facade: app builders + default stack.
+
+(define dream-ap-pass 0)
+(define dream-ap-fail 0)
+(define dream-ap-fails (list))
+
+(define
+  dream-ap-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ap-pass (+ dream-ap-pass 1))
+      (begin
+        (set! dream-ap-fail (+ dream-ap-fail 1))
+        (append! dream-ap-fails {:name name :actual actual :expected expected})))))
+
+(dream-ap-test "version is a string" (string? dream-version) true)
+
+;; ── dream-make-app: routes -> handler with default stack ───────────
+(define
+  dream-ap-routes
+  (list
+    (dream-get "/" (fn (req) (dream-html "<h1>hi</h1>")))
+    (dream-get "/boom" (fn (req) (error "kaboom")))
+    (dream-get
+      "/raw"
+      (fn (req) (dream-response 200 {} "plain words")))))
+(define dream-ap-app (dream-make-app dream-ap-routes))
+
+(dream-ap-test
+  "app serves"
+  (dream-resp-body (dream-ap-app (dream-request "GET" "/" {} "")))
+  "<h1>hi</h1>")
+(dream-ap-test
+  "app catches errors -> 500"
+  (dream-status (dream-ap-app (dream-request "GET" "/boom" {} "")))
+  500)
+(dream-ap-test
+  "app 404 for unknown"
+  (dream-status (dream-ap-app (dream-request "GET" "/nope" {} "")))
+  404)
+(dream-ap-test
+  "app sniffs content-type"
+  (dream-resp-header
+    (dream-ap-app (dream-request "GET" "/raw" {} ""))
+    "content-type")
+  "text/plain; charset=utf-8")
+
+;; ── dream-make-app-with: extra outer middleware ────────────────────
+(define
+  dream-ap-tag
+  (fn (next) (fn (req) (dream-add-header (next req) "X-App" "1"))))
+(define
+  dream-ap-app2
+  (dream-make-app-with (list dream-ap-tag) dream-ap-routes))
+(dream-ap-test
+  "extra middleware header"
+  (dream-resp-header
+    (dream-ap-app2 (dream-request "GET" "/" {} ""))
+    "x-app")
+  "1")
+
+;; ── dream-serve wires through dream-run ────────────────────────────
+(define dream-ap-captured nil)
+(define dream-ap-listen (fn (op) (begin (set! dream-ap-captured op) :ok)))
+(define
+  dream-ap-served
+  (dream-run-with dream-ap-listen (dream-make-app dream-ap-routes) {:port 7000}))
+(dream-ap-test "serve listens" dream-ap-served :ok)
+(dream-ap-test "serve port" (get dream-ap-captured :port) 7000)
+(dream-ap-test
+  "served app runs"
+  (get ((get dream-ap-captured :app) {:method "GET" :target "/"}) :body)
+  "<h1>hi</h1>")
+
+(define dream-ap-tests-run! (fn () {:total (+ dream-ap-pass dream-ap-fail) :passed dream-ap-pass :failed dream-ap-fail :fails dream-ap-fails}))

lib/dream/tests/auth.sx

@@ -0,0 +1,109 @@
+;; lib/dream/tests/auth.sx — base64, basic auth, bearer tokens.
+
+(define dream-au-pass 0)
+(define dream-au-fail 0)
+(define dream-au-fails (list))
+
+(define
+  dream-au-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-au-pass (+ dream-au-pass 1))
+      (begin
+        (set! dream-au-fail (+ dream-au-fail 1))
+        (append! dream-au-fails {:name name :actual actual :expected expected})))))
+
+;; ── base64 ─────────────────────────────────────────────────────────
+(dream-au-test "encode Man" (dream-base64-encode "Man") "TWFu")
+(dream-au-test "encode Ma" (dream-base64-encode "Ma") "TWE=")
+(dream-au-test "encode M" (dream-base64-encode "M") "TQ==")
+(dream-au-test
+  "encode user:pass"
+  (dream-base64-encode "user:pass")
+  "dXNlcjpwYXNz")
+(dream-au-test "decode Man" (dream-base64-decode "TWFu") "Man")
+(dream-au-test "decode Ma" (dream-base64-decode "TWE=") "Ma")
+(dream-au-test "decode M" (dream-base64-decode "TQ==") "M")
+(dream-au-test
+  "decode user:pass"
+  (dream-base64-decode "dXNlcjpwYXNz")
+  "user:pass")
+(dream-au-test
+  "roundtrip phrase"
+  (dream-base64-decode (dream-base64-encode "Hello, World!"))
+  "Hello, World!")
+(dream-au-test
+  "roundtrip empty"
+  (dream-base64-decode (dream-base64-encode ""))
+  "")
+
+;; ── header parsing ─────────────────────────────────────────────────
+(dream-au-test
+  "bearer token"
+  (dream-bearer-token (dream-request "GET" "/" {:Authorization "Bearer abc.123"} ""))
+  "abc.123")
+(dream-au-test
+  "no bearer"
+  (dream-bearer-token (dream-request "GET" "/" {} ""))
+  nil)
+(dream-au-test
+  "basic creds"
+  (dream-basic-credentials (dream-request "GET" "/" {:Authorization "Basic dXNlcjpwYXNz"} ""))
+  {:pass "pass" :user "user"})
+(dream-au-test
+  "no basic"
+  (dream-basic-credentials (dream-request "GET" "/" {} ""))
+  nil)
+
+;; ── basic auth middleware ──────────────────────────────────────────
+(define dream-au-check (fn (u p) (and (= u "admin") (= p "secret"))))
+(define
+  dream-au-app
+  ((dream-basic-auth "Admin Area" dream-au-check)
+    (fn (req) (dream-text (str "hi " (dream-user req))))))
+
+(define dream-au-ok (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:secret"))} "")))
+(dream-au-test "basic ok reaches" (dream-resp-body dream-au-ok) "hi admin")
+(dream-au-test "basic ok status" (dream-status dream-au-ok) 200)
+
+(define dream-au-bad (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:wrong"))} "")))
+(dream-au-test "basic wrong 401" (dream-status dream-au-bad) 401)
+(dream-au-test
+  "basic wrong www-authenticate"
+  (contains? (dream-resp-header dream-au-bad "www-authenticate") "Admin Area")
+  true)
+(dream-au-test
+  "basic missing 401"
+  (dream-status (dream-au-app (dream-request "GET" "/" {} "")))
+  401)
+
+;; ── bearer middleware ──────────────────────────────────────────────
+(define dream-au-tokens {:t-ada "ada" :t-bob "bob"})
+(define dream-au-lookup (fn (tok) (get dream-au-tokens tok)))
+(define
+  dream-au-bapp
+  ((dream-require-bearer dream-au-lookup)
+    (fn (req) (dream-text (dream-principal req)))))
+
+(dream-au-test
+  "bearer valid principal"
+  (dream-resp-body (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer t-ada"} "")))
+  "ada")
+(dream-au-test
+  "bearer invalid 401"
+  (dream-status (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer nope"} "")))
+  401)
+(dream-au-test
+  "bearer missing 401"
+  (dream-status (dream-au-bapp (dream-request "GET" "/" {} "")))
+  401)
+(dream-au-test
+  "bearer 401 header"
+  (dream-resp-header
+    (dream-au-bapp (dream-request "GET" "/" {} ""))
+    "www-authenticate")
+  "Bearer")
+
+(define dream-au-tests-run! (fn () {:total (+ dream-au-pass dream-au-fail) :passed dream-au-pass :failed dream-au-fail :fails dream-au-fails}))

lib/dream/tests/cors.sx

@@ -0,0 +1,93 @@
+;; lib/dream/tests/cors.sx — CORS decoration + preflight.
+
+(define dream-co-pass 0)
+(define dream-co-fail 0)
+(define dream-co-fails (list))
+
+(define
+  dream-co-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-co-pass (+ dream-co-pass 1))
+      (begin
+        (set! dream-co-fail (+ dream-co-fail 1))
+        (append! dream-co-fails {:name name :actual actual :expected expected})))))
+
+(define dream-co-h (fn (req) (dream-text "payload")))
+(define dream-co-app (dream-cors dream-co-h))
+
+;; ── decoration of normal responses ─────────────────────────────────
+(define dream-co-get (dream-co-app (dream-request "GET" "/" {} "")))
+(dream-co-test
+  "allow-origin star"
+  (dream-resp-header dream-co-get "access-control-allow-origin")
+  "*")
+(dream-co-test "body preserved" (dream-resp-body dream-co-get) "payload")
+(dream-co-test "status preserved" (dream-status dream-co-get) 200)
+(dream-co-test
+  "no credentials by default"
+  (dream-resp-header dream-co-get "access-control-allow-credentials")
+  nil)
+
+;; ── preflight OPTIONS ──────────────────────────────────────────────
+(define
+  dream-co-pre
+  (dream-co-app (dream-request "OPTIONS" "/" {} "")))
+(dream-co-test "preflight 204" (dream-status dream-co-pre) 204)
+(dream-co-test
+  "preflight origin"
+  (dream-resp-header dream-co-pre "access-control-allow-origin")
+  "*")
+(dream-co-test
+  "preflight methods"
+  (contains?
+    (dream-resp-header dream-co-pre "access-control-allow-methods")
+    "POST")
+  true)
+(dream-co-test
+  "preflight headers"
+  (dream-resp-header dream-co-pre "access-control-allow-headers")
+  "Content-Type")
+(dream-co-test
+  "preflight max-age"
+  (dream-resp-header dream-co-pre "access-control-max-age")
+  "86400")
+
+;; ── custom origin ──────────────────────────────────────────────────
+(define
+  dream-co-custom
+  ((dream-cors-origin "https://app.example.com") dream-co-h))
+(dream-co-test
+  "custom origin"
+  (dream-resp-header
+    (dream-co-custom (dream-request "GET" "/" {} ""))
+    "access-control-allow-origin")
+  "https://app.example.com")
+
+;; ── credentials enabled ────────────────────────────────────────────
+(define
+  dream-co-cred
+  ((dream-cors-with (assoc dream-cors-defaults :credentials true))
+    dream-co-h))
+(dream-co-test
+  "credentials header"
+  (dream-resp-header
+    (dream-co-cred (dream-request "GET" "/" {} ""))
+    "access-control-allow-credentials")
+  "true")
+
+;; ── composes around a router ───────────────────────────────────────
+(define
+  dream-co-router
+  (dream-cors
+    (dream-router (list (dream-get "/api" (fn (req) (dream-json "{}")))))))
+(dream-co-test
+  "router cors origin"
+  (dream-resp-header
+    (dream-co-router (dream-request "GET" "/api" {} ""))
+    "access-control-allow-origin")
+  "*")
+
+(define dream-co-tests-run! (fn () {:total (+ dream-co-pass dream-co-fail) :passed dream-co-pass :failed dream-co-fail :fails dream-co-fails}))

lib/dream/tests/demos.sx

@@ -0,0 +1,198 @@
+;; lib/dream/tests/demos.sx — end-to-end demo apps exercising the full stack.
+
+(define dream-dm-pass 0)
+(define dream-dm-fail 0)
+(define dream-dm-fails (list))
+
+(define
+  dream-dm-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-dm-pass (+ dream-dm-pass 1))
+      (begin
+        (set! dream-dm-fail (+ dream-dm-fail 1))
+        (append! dream-dm-fails {:name name :actual actual :expected expected})))))
+
+(define
+  dream-dm-req
+  (fn (method target headers) (dream-request method target headers "")))
+
+;; ── hello ──────────────────────────────────────────────────────────
+(dream-dm-test
+  "hello root"
+  (dream-resp-body (dream-hello-app (dream-dm-req "GET" "/" {})))
+  "<h1>Hello, World!</h1>")
+(dream-dm-test
+  "hello name"
+  (dream-resp-body
+    (dream-hello-app (dream-dm-req "GET" "/hello/Ada" {})))
+  "<h1>Hello, Ada!</h1>")
+(dream-dm-test
+  "hello content-type"
+  (dream-resp-header
+    (dream-hello-app (dream-dm-req "GET" "/" {}))
+    "content-type")
+  "text/html; charset=utf-8")
+
+;; ── counter (sessions) ─────────────────────────────────────────────
+(define dream-dm-cbackend (dream-memory-sessions))
+(define dream-dm-capp (dream-counter-app-with dream-dm-cbackend))
+
+(define dream-dm-c1 (dream-dm-capp (dream-dm-req "GET" "/" {})))
+(dream-dm-test
+  "counter first visit"
+  (dream-resp-body dream-dm-c1)
+  "<p>You have visited this page 1 time(s).</p>")
+(dream-dm-test
+  "counter sets cookie"
+  (len (dream-resp-cookies dream-dm-c1))
+  1)
+(dream-dm-test
+  "counter second visit"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 2 time(s).</p>")
+(dream-dm-test
+  "counter third visit"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 3 time(s).</p>")
+(define
+  dream-dm-reset
+  (dream-dm-capp (dream-dm-req "POST" "/reset" {:Cookie "dream.session=s1"})))
+(dream-dm-test
+  "counter reset redirects"
+  (dream-status dream-dm-reset)
+  303)
+(dream-dm-test
+  "counter after reset"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 1 time(s).</p>")
+(dream-dm-test
+  "counter distinct session"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {})))
+  "<p>You have visited this page 1 time(s).</p>")
+
+;; ── chat (websocket rooms) ─────────────────────────────────────────
+(define dream-dm-rooms (dream-chat-rooms))
+(define dream-dm-wsB (dream-mock-ws (list)))
+(define dream-dm-wsC (dream-mock-ws (list)))
+((get dream-dm-rooms :join) "general" dream-dm-wsB)
+((get dream-dm-rooms :join) "general" dream-dm-wsC)
+(dream-dm-test
+  "room has two members"
+  (len ((get dream-dm-rooms :members) "general"))
+  2)
+
+;; client A joins, sends two messages, then disconnects
+(define dream-dm-wsA (dream-mock-ws (list "hi" "again")))
+((dream-chat-session dream-dm-rooms "general") dream-dm-wsA)
+(dream-dm-test
+  "B got broadcasts"
+  (dream-ws-sent dream-dm-wsB)
+  (list "hi" "again"))
+(dream-dm-test
+  "C got broadcasts"
+  (dream-ws-sent dream-dm-wsC)
+  (list "hi" "again"))
+(dream-dm-test
+  "A echoed own messages"
+  (dream-ws-sent dream-dm-wsA)
+  (list "hi" "again"))
+(dream-dm-test
+  "A left on disconnect"
+  (len ((get dream-dm-rooms :members) "general"))
+  2)
+(dream-dm-test "A closed" (dream-ws-closed? dream-dm-wsA) true)
+
+;; route produces an upgrade response
+(define dream-dm-chat-app (dream-chat-app-with (dream-chat-rooms)))
+(dream-dm-test
+  "chat route upgrades"
+  (dream-websocket?
+    (dream-dm-chat-app (dream-dm-req "GET" "/chat/lobby" {})))
+  true)
+(dream-dm-test
+  "chat index html"
+  (dream-resp-body (dream-dm-chat-app (dream-dm-req "GET" "/" {})))
+  "<h1>Rooms</h1>")
+
+;; ── todo (forms + CSRF) ────────────────────────────────────────────
+(define dream-dm-todo-store (dream-todo-store))
+(define dream-dm-todo-backend (dream-memory-sessions))
+(define
+  dream-dm-todo-app
+  (dream-todo-app-with dream-dm-todo-store dream-dm-todo-backend "topsecret"))
+(define
+  dream-dm-todo-tok
+  (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1"))
+
+;; establish session s1
+(dream-dm-todo-app (dream-request "GET" "/" {} ""))
+(define
+  dream-dm-add1
+  (dream-dm-todo-app
+    (dream-request
+      "POST"
+      "/add"
+      {:Cookie "dream.session=s1"}
+      (str "text=Buy+milk&dream.csrf=" dream-dm-todo-tok))))
+(dream-dm-test "todo add redirects" (dream-status dream-dm-add1) 303)
+(dream-dm-test
+  "todo store has item"
+  (len ((get dream-dm-todo-store :all)))
+  1)
+
+(define
+  dream-dm-todo-page
+  (dream-resp-body
+    (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))))
+(dream-dm-test
+  "todo lists item"
+  (contains? dream-dm-todo-page "Buy milk")
+  true)
+(dream-dm-test
+  "todo has csrf tag"
+  (contains? dream-dm-todo-page "dream.csrf")
+  true)
+(dream-dm-test
+  "todo item not done"
+  (contains? dream-dm-todo-page "[ ] Buy milk")
+  true)
+
+(dream-dm-todo-app
+  (dream-request
+    "POST"
+    "/toggle/1"
+    {:Cookie "dream.session=s1"}
+    (str "dream.csrf=" dream-dm-todo-tok)))
+(dream-dm-test
+  "todo toggled done"
+  (contains?
+    (dream-resp-body
+      (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))
+    "[x] Buy milk")
+  true)
+
+(dream-dm-test
+  "todo add without token 403"
+  (dream-status
+    (dream-dm-todo-app (dream-request "POST" "/add" {:Cookie "dream.session=s1"} "text=Sneaky")))
+  403)
+(dream-dm-test
+  "todo unchanged after reject"
+  (len ((get dream-dm-todo-store :all)))
+  1)
+
+(dream-dm-todo-app
+  (dream-request
+    "POST"
+    "/delete/1"
+    {:Cookie "dream.session=s1"}
+    (str "dream.csrf=" dream-dm-todo-tok)))
+(dream-dm-test
+  "todo deleted"
+  (len ((get dream-dm-todo-store :all)))
+  0)
+
+(define dream-dm-tests-run! (fn () {:total (+ dream-dm-pass dream-dm-fail) :passed dream-dm-pass :failed dream-dm-fail :fails dream-dm-fails}))