HS: socket namespaced names + timeout plumbing (+2)

Native JS wrapper: replace SX dict with (host-new "Object") so
host-set! mutations persist for rpc and closed? updates. bind-path!
uses (host-new "Object") for intermediate namespace nodes so dotted
paths like MyApp.chat bind correctly. Fix _hs_make_rpc_proxy call
wrapper to strip the nil this-arg. Land tests 4+16: namespaced sockets
work, with timeout parses and uses the configured timeout. 5/16 total.

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

.claude/scheduled_tasks.lock

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

.mcp.json

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

CLAUDE.md

@@ -173,16 +173,15 @@ artdag/
 
 ## SX Language — Canonical Reference
 
-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).
+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.
 
 ### Specification files
 
-- **`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.
+- **`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/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).
 
@@ -311,7 +310,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 `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:
+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:
 
 - `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**.
@@ -451,7 +450,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 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.
+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.
 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,42 +97,6 @@
       (: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
@@ -184,23 +148,6 @@
           :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

@@ -1,44 +0,0 @@
-# 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

@@ -1,201 +0,0 @@
-# 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/javascript/run_tests.js

@@ -293,8 +293,6 @@ env["pop-suite"] = function() {
   return null;
 };
 
-env["test-allowed?"] = function(name) { return true; };
-
 // Load test framework
 const projectDir = path.join(__dirname, "..", "..");
 const specTests = path.join(projectDir, "spec", "tests");
@@ -343,20 +341,6 @@ if (fs.existsSync(swapPath)) {
   }
 }
 
-// Load spec library files (define-library modules imported by tests)
-for (const libFile of ["stdlib.sx", "signals.sx", "coroutines.sx"]) {
-  const libPath = path.join(projectDir, "spec", libFile);
-  if (fs.existsSync(libPath)) {
-    const libSrc = fs.readFileSync(libPath, "utf8");
-    const libExprs = Sx.parse(libSrc);
-    for (const expr of libExprs) {
-      try { Sx.eval(expr, env); } catch (e) {
-        console.error(`Error loading spec/${libFile}: ${e.message}`);
-      }
-    }
-  }
-}
-
 // Load tw system (needed by spec/tests/test-tw.sx)
 const twDir = path.join(projectDir, "shared", "sx", "templates");
 for (const twFile of ["tw-type.sx", "tw-layout.sx", "tw.sx"]) {

hosts/ocaml/bin/bench_cek.ml

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

hosts/ocaml/bin/bench_inspect.ml

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

hosts/ocaml/bin/bench_vm.ml

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

hosts/ocaml/bin/dune

@@ -1,5 +1,5 @@
 (executables
- (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect bench_vm repro_jit_resume)
+ (names run_tests debug_set sx_server integration_tests)
  (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 _] | [VmClosure _] -> Bool true | _ -> Bool false);
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> 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,34 +375,18 @@ 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 -> Integer (Char.code s.[0])
-    | _ -> Integer 0);
+    | [String s] when String.length s > 0 -> Number (float_of_int (Char.code s.[0]))
+    | _ -> Number 0.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] ->
-      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))
+    | [String s] -> (try Number (float_of_string s) with _ -> 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 ->
@@ -443,10 +427,8 @@ 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
-    | _ -> raise (Eval_error "keyword-name: expected keyword"));
+    | [Keyword k] -> String k | _ -> String "");
   bind "make-symbol" (fun args -> match args with
     | [String s] -> Symbol s | _ -> Nil);
   (* Environment operations needed by harness *)
@@ -461,30 +443,12 @@ let setup_env () =
     | _ -> Bool false);
   bind "make-env" (fun _args -> Env (make_env ()));
   bind "keys" (fun args -> match args with
-    | [Dict d] -> List (dict_keys d)
+    | [Dict d] -> List (Hashtbl.fold (fun k _ acc -> String k :: acc) d [])
     | _ -> List []);
-  (* 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)
+  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)
     | _ -> Nil);
   bind "dict-set!" (fun args -> match args with
     | [Dict d; String k; v] -> Hashtbl.replace d k v; v
@@ -513,13 +477,9 @@ 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 _ | 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). *)
+    | [NativeFn _ | Lambda _ | Component _ | Island _] -> Bool true | _ -> Bool 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] ->
@@ -530,11 +490,6 @@ 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] ->
@@ -605,28 +560,9 @@ 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 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
+    | [String s; String d] ->
+      List (List.map (fun p -> String p) (String.split_on_char d.[0] s))
     | _ -> List []);
   (* sx-parse — use the native OCaml parser for bootstrapping *)
   bind "sx-parse" (fun args -> match args with
@@ -1956,34 +1892,8 @@ let handle_sx_harness_eval args =
     let file = args |> member "file" |> to_string_option in
     let setup_str = args |> member "setup" |> to_string_option in
     let files_json = try args |> member "files" with _ -> `Null in
-    let host_stubs = match args |> member "host_stubs" with `Bool b -> b | _ -> false in
     let e = !env in
     let warnings = ref [] in
-    (* Inject stub host primitives so files using host-get/host-new/etc. can load *)
-    if host_stubs then begin
-      let stubs = {|
-        (define host-global (fn (&rest _) nil))
-        (define host-get (fn (&rest _) nil))
-        (define host-set! (fn (obj k v) v))
-        (define host-call (fn (&rest _) nil))
-        (define host-new (fn (&rest _) (dict)))
-        (define host-callback (fn (f) f))
-        (define host-typeof (fn (&rest _) "string"))
-        (define hs-ref-eq (fn (a b) (identical? a b)))
-        (define host-call-fn (fn (&rest _) nil))
-        (define host-iter? (fn (&rest _) false))
-        (define host-to-list (fn (&rest _) (list)))
-        (define host-await (fn (&rest _) nil))
-        (define host-new-function (fn (&rest _) nil))
-        (define load-library! (fn (&rest _) false))
-      |} in
-      let stub_exprs = Sx_parser.parse_all stubs in
-      List.iter (fun expr ->
-        try ignore (Sx_ref.eval_expr expr (Env e))
-        with exn ->
-          warnings := Printf.sprintf "Stub warning: %s" (Printexc.to_string exn) :: !warnings
-      ) stub_exprs
-    end;
     (* Collect all files to load *)
     let all_files = match files_json with
       | `List items ->
@@ -3108,8 +3018,7 @@ let tool_definitions = `List [
      ("mock", `Assoc [("type", `String "string"); ("description", `String "Optional mock platform overrides as SX dict, e.g. {:fetch (fn (url) {:status 200})}")]);
      ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")]);
      ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order")]);
-     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")]);
-     ("host_stubs", `Assoc [("type", `String "boolean"); ("description", `String "If true, inject nil-returning stubs for host-get/host-set!/host-call/host-new/etc. so files that use host primitives can load in the harness")])]
+     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")])]
     ["expr"];
   tool "sx_nav" "Manage sx-docs navigation and articles. Modes: list (all nav items with status), check (validate consistency), add (create article + nav entry), delete (remove nav entry + page fn), move (move entry between sections, rewriting hrefs)."
     [("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: list, check, add, delete, or move")]);

hosts/ocaml/bin/repro_jit_resume.ml

@@ -1,202 +0,0 @@
-(* 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/sx_server.ml

@@ -18,28 +18,6 @@
 
 open Sx_types
 
-(* Force-link Sx_vm_extensions so its module-init runs: installs the
-   extension dispatch fallthrough and registers the `extension-opcode-id`
-   SX primitive. Without a reference here OCaml dead-code-eliminates the
-   module from sx_server.exe (it's only otherwise reached from run_tests),
-   leaving guest-language opcode extensions (Erlang Phase 9, etc.)
-   invisible to the runtime. The applied call is a harmless lookup. *)
-let () = ignore (Sx_vm_extensions.id_of_name "")
-
-(* Register the Erlang opcode extension (Phase 9h) so
-   `extension-opcode-id "erlang.OP_*"` resolves to the host ids the SX
-   stub dispatcher consults. Guarded: a double-register raises Failure,
-   which we swallow so a re-entered server process doesn't die. *)
-let () = try Erlang_ext.register () with Failure _ -> ()
-
-(* Ignore SIGPIPE: a client that closes its connection mid-response (a browser
-   aborting an in-flight fetch — the SX engine cancels superseded requests on a
-   debounced filter or a fast nav) must NOT kill the server. SIGPIPE's default
-   action terminates the process before any exception is raised; ignoring it
-   turns the failed write into a catchable Sys_error (EPIPE), which the
-   per-connection handler already swallows, dropping just that one connection. *)
-let () = try Sys.set_signal Sys.sigpipe Sys.Signal_ignore with _ -> ()
-
 (* ====================================================================== *)
 (* Font measurement via otfm — reads OpenType/TrueType font tables         *)
 (* ====================================================================== *)
@@ -318,10 +296,6 @@ let read_blob () =
       (* consume trailing newline *)
       (try ignore (input_line stdin) with End_of_file -> ());
       data
-    | [List [Symbol "blob"; Integer n]] ->
-      let data = read_exact_bytes n in
-      (try ignore (input_line stdin) with End_of_file -> ());
-      data
     | _ -> raise (Eval_error ("read_blob: expected (blob N), got: " ^ line))
 
 (** Batch IO mode — collect requests during aser-slot, resolve after. *)
@@ -383,11 +357,6 @@ let rec read_io_response () =
     | [List (Symbol "io-response" :: Number n :: values)]
       when int_of_float n = !current_epoch ->
       (match values with [v] -> v | _ -> List values)
-    | [List [Symbol "io-response"; Integer n; value]]
-      when n = !current_epoch -> value
-    | [List (Symbol "io-response" :: Integer n :: values)]
-      when n = !current_epoch ->
-      (match values with [v] -> v | _ -> List values)
     (* Legacy untagged: (io-response value) — accept for backwards compat *)
     | [List [Symbol "io-response"; value]] -> value
     | [List (Symbol "io-response" :: values)] ->
@@ -427,12 +396,6 @@ let read_batched_io_response () =
         when int_of_float n = !current_epoch -> s
       | [List [Symbol "io-response"; Number n; v]]
         when int_of_float n = !current_epoch -> serialize_value v
-      | [List [Symbol "io-response"; Integer n; String s]]
-        when n = !current_epoch -> s
-      | [List [Symbol "io-response"; Integer n; SxExpr s]]
-        when n = !current_epoch -> s
-      | [List [Symbol "io-response"; Integer n; v]]
-        when n = !current_epoch -> serialize_value v
       (* Legacy untagged *)
       | [List [Symbol "io-response"; String s]]
       | [List [Symbol "io-response"; SxExpr s]] -> s
@@ -530,61 +493,9 @@ let rec load_library_file path =
       Printf.eprintf "[load-library] %s: %s\n%!" (Filename.basename path) msg
   ) exprs
 
-(* IO-aware CEK run (cek_run_with_io, below) — handles suspension by dispatching
-   IO requests. Import requests are handled locally (load .sx file). *)
-(** Resolve a single IO request value to its response. Shared by
-    cek_run_with_io's suspension loop AND the _cek_io_resolver installed for the
-    http-listen serving path, so the synchronous inline-resolve path (sx_vm.ml's
-    HO-callback suspend fix) resolves durable reads byte-identically to the
-    CEK-driven path. Without an installed resolver, a `perform` inside an HO
-    primitive callback (map/filter/…) unwinds the native loop and corrupts the
-    stack — the host's map/rest/drop serving-JIT miscompile. *)
-and resolve_io_request request =
-  let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
-  (match op with
-   | "import" ->
-     (* Resolve library locally — load the .sx file *)
-     let lib_spec = Sx_runtime.get_val request (String "library") in
-     (* library_loaded_p takes the library SPEC and computes the key itself —
-        passing an already-computed key string double-applies library_name_key
-        and crashes (sx_to_list on a string). *)
-     if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
-       (* Already loaded — just resume *)
-       Nil
-     else begin
-       (match resolve_library_path lib_spec with
-        | Some path -> load_library_file path
-        | None ->
-          Printf.eprintf "[import] WARNING: no file for library %s\n%!"
-            (Sx_runtime.value_to_str lib_spec));
-       Nil
-     end
-   | "text-measure" ->
-     let args = let a = Sx_runtime.get_val request (String "args") in
-       (match a with List l -> l | _ -> [a]) in
-     let font = match args with String f :: _ -> f | _ -> "serif" in
-     let size = match args with
-       | [_font; Number sz; _text] -> sz
-       | [_font; Number sz] -> sz
-       | _ -> 16.0 in
-     let text = match args with
-       | [_font; _sz; String t] -> t
-       | _ -> "" in
-     let (w, h, asc, desc) = measure_text_otfm font size text in
-     let d = Hashtbl.create 4 in
-     Hashtbl.replace d "width" (Number w);
-     Hashtbl.replace d "height" (Number h);
-     Hashtbl.replace d "ascent" (Number asc);
-     Hashtbl.replace d "descent" (Number desc);
-     Dict d
-   | _ ->
-     let argsv = Sx_runtime.get_val request (String "args") in
-     (match Sx_persist_store.handle_op op argsv with
-      | Some resp -> resp
-      | None ->
-        let args = (match argsv with List l -> l | _ -> [argsv]) in
-        io_request op args))
-
+(** 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
@@ -595,7 +506,46 @@ and cek_run_with_io state =
     done;
     if is_suspended !s then begin
       let request = Sx_runtime.get_val !s (String "request") in
-      let response = resolve_io_request request in
+      let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
+      let response = match op with
+        | "import" ->
+          (* Resolve library locally — load the .sx file *)
+          let lib_spec = Sx_runtime.get_val request (String "library") in
+          let key = Sx_ref.library_name_key lib_spec in
+          if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
+            (* Already loaded — just resume *)
+            Nil
+          else begin
+            (match resolve_library_path lib_spec with
+             | Some path -> load_library_file path
+             | None ->
+               Printf.eprintf "[import] WARNING: no file for library %s\n%!"
+                 (Sx_runtime.value_to_str lib_spec));
+            Nil
+          end
+        | "text-measure" ->
+          let args = let a = Sx_runtime.get_val request (String "args") in
+            (match a with List l -> l | _ -> [a]) in
+          let font = match args with String f :: _ -> f | _ -> "serif" in
+          let size = match args with
+            | [_font; Number sz; _text] -> sz
+            | [_font; Number sz] -> sz
+            | _ -> 16.0 in
+          let text = match args with
+            | [_font; _sz; String t] -> t
+            | _ -> "" in
+          let (w, h, asc, desc) = measure_text_otfm font size text in
+          let d = Hashtbl.create 4 in
+          Hashtbl.replace d "width" (Number w);
+          Hashtbl.replace d "height" (Number h);
+          Hashtbl.replace d "ascent" (Number asc);
+          Hashtbl.replace d "descent" (Number desc);
+          Dict d
+        | _ ->
+          let args = let a = Sx_runtime.get_val request (String "args") in
+            (match a with List l -> l | _ -> [a]) in
+          io_request op args
+      in
       s := Sx_ref.cek_resume !s response;
       loop ()
     end else
@@ -738,354 +688,6 @@ let setup_evaluator_bridge env =
     | [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
     | [expr] -> Sx_ref.eval_expr expr (Env env)
     | _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
-  (* eval-in-env: (env expr) → result.  Evaluates expr in the given env. *)
-  Sx_primitives.register "eval-in-env" (fun args ->
-    match args with
-    | [e; expr] -> Sx_ref.eval_expr expr e
-    | _ -> raise (Eval_error "eval-in-env: (env expr)"));
-
-  (* fed-sx Milestone 1 Step 8 transport. NATIVE ONLY — sockets +
-     threads; deliberately absent from the WASM kernel (registered
-     here in bin/, never in lib/sx_primitives.ml). Minimal HTTP/1.1,
-     Connection: close. handler : req-dict -> resp-dict where
-     req = {:method :path :query :headers :body},
-     resp = {:status :headers :body}. Never returns. *)
-  Sx_primitives.register "http-listen" (fun args ->
-    let strip_cr s =
-      let n = String.length s in
-      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
-    in
-    match args with
-    | [port_v; handler] ->
-      let port = match port_v with
-        | Integer n -> n
-        | Number f -> int_of_float f
-        | _ -> raise (Eval_error "http-listen: (port handler)") in
-      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-      Unix.setsockopt sock Unix.SO_REUSEADDR true;
-      (* Bind host: loopback by default (safe for tests + local runs); set
-         SX_HTTP_HOST=0.0.0.0 to expose on the network (container/Caddy). *)
-      let bind_addr =
-        match Sys.getenv_opt "SX_HTTP_HOST" with
-        | Some h -> (try Unix.inet_addr_of_string h
-                     with _ -> Unix.inet_addr_loopback)
-        | None -> Unix.inet_addr_loopback in
-      Unix.bind sock
-        (Unix.ADDR_INET (bind_addr, port));
-      Unix.listen sock 64;
-      (* Install the synchronous IO resolver for the serving path. Without it, a
-         `perform` (durable kv read) that fires inside an HO-primitive callback
-         (map/filter/reduce/…) during request handling suspends through the
-         native OCaml loop, dropping its iteration state and leaving the stack
-         misaligned — the serving-JIT host miscompile (map/rest/drop wrong args,
-         blank pages, empty picker). With a resolver installed, sx_vm.ml resolves
-         that callback's IO inline (byte-identically to cek_run_with_io) and the
-         loop is never unwound. Only set if one isn't already installed. *)
-      (if !Sx_types._cek_io_resolver = None then
-         Sx_types._cek_io_resolver :=
-           Some (fun request _state -> resolve_io_request request));
-      (* SX runtime is shared across threads — serialize handler calls. *)
-      let mtx = Mutex.create () in
-      let reason = function
-        | 200 -> "OK" | 201 -> "Created" | 204 -> "No Content"
-        | 301 -> "Moved Permanently" | 302 -> "Found"
-        | 400 -> "Bad Request" | 401 -> "Unauthorized"
-        | 403 -> "Forbidden" | 404 -> "Not Found"
-        | 405 -> "Method Not Allowed" | 500 -> "Internal Server Error"
-        | _ -> "OK" in
-      let handle fd =
-        (try
-          let ic = Unix.in_channel_of_descr fd in
-          let oc = Unix.out_channel_of_descr fd in
-          let reqline = strip_cr (input_line ic) in
-          (match String.split_on_char ' ' reqline with
-           | meth :: target :: _ ->
-             let path, query =
-               match String.index_opt target '?' with
-               | Some i ->
-                 String.sub target 0 i,
-                 String.sub target (i + 1)
-                   (String.length target - i - 1)
-               | None -> target, "" in
-             let headers = Sx_types.make_dict () in
-             let clen = ref 0 in
-             let rec rdh () =
-               let h = strip_cr (input_line ic) in
-               if h = "" then ()
-               else begin
-                 (match String.index_opt h ':' with
-                  | Some i ->
-                    let name =
-                      String.lowercase_ascii
-                        (String.trim (String.sub h 0 i)) in
-                    let value =
-                      String.trim
-                        (String.sub h (i + 1)
-                           (String.length h - i - 1)) in
-                    Hashtbl.replace headers name (String value);
-                    if name = "content-length" then
-                      (try clen := int_of_string value with _ -> ())
-                  | None -> ());
-                 rdh ()
-               end in
-             rdh ();
-             let body =
-               if !clen > 0 then begin
-                 let b = Bytes.create !clen in
-                 really_input ic b 0 !clen;
-                 Bytes.unsafe_to_string b
-               end else "" in
-             let req = Sx_types.make_dict () in
-             Hashtbl.replace req "method" (String meth);
-             Hashtbl.replace req "path" (String path);
-             Hashtbl.replace req "query" (String query);
-             Hashtbl.replace req "headers" (Dict headers);
-             Hashtbl.replace req "body" (String body);
-             Mutex.lock mtx;
-             let resp =
-               (* Run the handler through the IO-aware CEK runner (not bare
-                  sx_call) so request handlers can perform per-request IO —
-                  durable store reads/writes resolve via cek_run_with_io's
-                  suspension loop instead of returning an unresolved suspension.
-                  On ANY handler exception, synthesise a 500 response rather than
-                  letting it escape: an escaped exception drops the connection
-                  with no bytes written, which a reverse proxy (Caddy/Cloudflare)
-                  surfaces as a 502 error page. A real 500 keeps the origin
-                  responsive and debuggable. Note: a native exception (e.g. the
-                  parser's Parse_error) cannot be caught by an SX (guard ...), so
-                  this boundary is the only place it can be trapped. *)
-               (try
-                  let st = Sx_ref.continue_with_call handler
-                             (List [Dict req]) (Env (Sx_types.make_env ()))
-                             (List [Dict req]) (List []) in
-                  let r = cek_run_with_io st in
-                  Mutex.unlock mtx; r
-                with e ->
-                  Mutex.unlock mtx;
-                  Printf.eprintf "[http-listen] handler error: %s\n%!"
-                    (Printexc.to_string e);
-                  let d = Sx_types.make_dict () in
-                  Hashtbl.replace d "status" (Integer 500);
-                  Hashtbl.replace d "body" (String "Internal Server Error");
-                  Dict d) in
-             let getk k = match resp with
-               | Dict h -> Hashtbl.find_opt h k | _ -> None in
-             let status = match getk "status" with
-               | Some (Integer n) -> n
-               | Some (Number f) -> int_of_float f
-               | _ -> 200 in
-             let rbody = match getk "body" with
-               | Some (String s) -> s
-               | Some v -> Sx_types.value_to_string v
-               | None -> "" in
-             let rhdrs = match getk "headers" with
-               | Some (Dict h) ->
-                 Hashtbl.fold (fun k v acc ->
-                   (k, (match v with
-                        | String s -> s
-                        | v -> Sx_types.value_to_string v)) :: acc)
-                   h []
-               | _ -> [] in
-             let buf = Buffer.create 256 in
-             Buffer.add_string buf
-               (Printf.sprintf "HTTP/1.1 %d %s\r\n" status
-                  (reason status));
-             List.iter (fun (k, v) ->
-               Buffer.add_string buf
-                 (Printf.sprintf "%s: %s\r\n" k v)) rhdrs;
-             (* Cookies: a response carries :set-cookies as a LIST of pre-formatted
-                cookie strings (Dream's dream-set-cookie), because a headers Dict
-                cannot hold more than one Set-Cookie. Emit one header per item. *)
-             (match getk "set-cookies" with
-              | Some (List items) ->
-                List.iter (fun v ->
-                  match v with
-                  | String s ->
-                    Buffer.add_string buf
-                      (Printf.sprintf "Set-Cookie: %s\r\n" s)
-                  | _ -> ()) items
-              | _ -> ());
-             if not (List.exists
-                       (fun (k, _) ->
-                          String.lowercase_ascii k = "content-type")
-                       rhdrs)
-             then Buffer.add_string buf
-                 "Content-Type: text/plain\r\n";
-             Buffer.add_string buf
-               (Printf.sprintf "Content-Length: %d\r\n"
-                  (String.length rbody));
-             Buffer.add_string buf "Connection: close\r\n\r\n";
-             Buffer.add_string buf rbody;
-             output_string oc (Buffer.contents buf);
-             flush oc
-           | _ -> ())
-         with _ -> ());
-        (try Unix.close fd with _ -> ())
-      in
-      while true do
-        let fd, _ = Unix.accept sock in
-        ignore (Thread.create handle fd)
-      done;
-      Nil
-    | _ -> raise (Eval_error "http-listen: (port handler)"));
-
-  (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
-     Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
-     request: TCP connect, write request line + headers + body,
-     read status + headers + body, return {:status :headers :body}.
-     URL must be http://...; HTTPS is a later phase (needs TLS).
-     Body read: Content-Length first, else read to EOF (we send
-     Connection: close). Transfer-Encoding: chunked is rejected —
-     fed-sx Phase 8 wires this for inter-server POSTs which will
-     all carry Content-Length. *)
-  Sx_primitives.register "http-request" (fun args ->
-    let strip_cr s =
-      let n = String.length s in
-      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
-    in
-    match args with
-    | [String meth; String url; headers_v; body_v] ->
-      let body = match body_v with
-        | String s -> s
-        | Nil -> ""
-        | v -> Sx_types.value_to_string v in
-      let prefix = "http://" in
-      let plen = String.length prefix in
-      let ulen = String.length url in
-      if ulen < plen || String.sub url 0 plen <> prefix
-      then raise (Eval_error "http-request: URL must start with http://");
-      let rest = String.sub url plen (ulen - plen) in
-      let host_port, path =
-        match String.index_opt rest '/' with
-        | Some i ->
-          String.sub rest 0 i,
-          String.sub rest i (String.length rest - i)
-        | None -> rest, "/" in
-      if host_port = "" then
-        raise (Eval_error "http-request: missing host");
-      let host, port =
-        match String.index_opt host_port ':' with
-        | Some i ->
-          let h = String.sub host_port 0 i in
-          let ps = String.sub host_port (i + 1)
-                     (String.length host_port - i - 1) in
-          (h,
-           (try int_of_string ps with _ ->
-              raise (Eval_error "http-request: bad port")))
-        | None -> host_port, 80 in
-      let addr =
-        (try (Unix.gethostbyname host).h_addr_list.(0)
-         with Not_found ->
-           raise (Eval_error ("http-request: dns: " ^ host))) in
-      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-      let cleanup () = try Unix.close sock with _ -> () in
-      let result =
-        (try
-          (try Unix.connect sock (Unix.ADDR_INET (addr, port))
-           with Unix.Unix_error (e, _, _) ->
-             raise (Eval_error
-                      ("http-request: connect: " ^ Unix.error_message e)));
-          let oc = Unix.out_channel_of_descr sock in
-          let ic = Unix.in_channel_of_descr sock in
-          let buf = Buffer.create 256 in
-          Buffer.add_string buf
-            (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
-          let host_hdr_sent = ref false in
-          let clen_sent = ref false in
-          let conn_sent = ref false in
-          (match headers_v with
-           | Dict h ->
-             Hashtbl.iter (fun k v ->
-               let kl = String.lowercase_ascii k in
-               if kl = "host" then host_hdr_sent := true;
-               if kl = "content-length" then clen_sent := true;
-               if kl = "connection" then conn_sent := true;
-               let vs = match v with
-                 | String s -> s
-                 | x -> Sx_types.value_to_string x in
-               Buffer.add_string buf
-                 (Printf.sprintf "%s: %s\r\n" k vs)) h
-           | Nil -> ()
-           | _ -> raise (Eval_error "http-request: headers must be dict"));
-          if not !host_hdr_sent then
-            Buffer.add_string buf
-              (Printf.sprintf "Host: %s\r\n" host_port);
-          if not !clen_sent then
-            Buffer.add_string buf
-              (Printf.sprintf "Content-Length: %d\r\n"
-                 (String.length body));
-          if not !conn_sent then
-            Buffer.add_string buf "Connection: close\r\n";
-          Buffer.add_string buf "\r\n";
-          Buffer.add_string buf body;
-          output_string oc (Buffer.contents buf);
-          flush oc;
-          let sl =
-            (try strip_cr (input_line ic)
-             with End_of_file ->
-               raise (Eval_error
-                        "http-request: connection closed before status")) in
-          let status =
-            match String.split_on_char ' ' sl with
-            | _ver :: code :: _ ->
-              (try int_of_string code with _ ->
-                 raise (Eval_error "http-request: bad status code"))
-            | _ -> raise (Eval_error "http-request: bad status line") in
-          let rhdrs = Sx_types.make_dict () in
-          let clen = ref (-1) in
-          let chunked = ref false in
-          let rec rdh () =
-            let h =
-              (try strip_cr (input_line ic)
-               with End_of_file -> "") in
-            if h = "" then ()
-            else begin
-              (match String.index_opt h ':' with
-               | Some i ->
-                 let name =
-                   String.lowercase_ascii
-                     (String.trim (String.sub h 0 i)) in
-                 let value =
-                   String.trim
-                     (String.sub h (i + 1)
-                        (String.length h - i - 1)) in
-                 Hashtbl.replace rhdrs name (String value);
-                 if name = "content-length" then
-                   (try clen := int_of_string value with _ -> ())
-                 else if name = "transfer-encoding" &&
-                         String.lowercase_ascii value = "chunked"
-                 then chunked := true
-               | None -> ());
-              rdh ()
-            end in
-          rdh ();
-          if !chunked then
-            raise (Eval_error
-                     "http-request: chunked transfer-encoding not supported");
-          let rbody =
-            if !clen >= 0 then begin
-              let b = Bytes.create !clen in
-              really_input ic b 0 !clen;
-              Bytes.unsafe_to_string b
-            end else begin
-              let b = Buffer.create 256 in
-              (try
-                 while true do
-                   Buffer.add_channel b ic 4096
-                 done; assert false
-               with End_of_file -> ());
-              Buffer.contents b
-            end in
-          let resp = Sx_types.make_dict () in
-          Hashtbl.replace resp "status" (Integer status);
-          Hashtbl.replace resp "headers" (Dict rhdrs);
-          Hashtbl.replace resp "body" (String rbody);
-          Dict resp
-        with e -> cleanup (); raise e) in
-      cleanup ();
-      result
-    | _ -> raise (Eval_error "http-request: (method url headers body)"));
-
   bind "trampoline" (fun args ->
     match args with
     | [v] ->
@@ -1147,13 +749,7 @@ let setup_evaluator_bridge env =
     | _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
   ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
   ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
-    List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
-  (* current-env: special form — returns current lexical env as a first-class value *)
-  ignore (Sx_ref.register_special_form (String "current-env")
-    (NativeFn ("current-env", fun args ->
-      match args with
-      | [_arg_list; env_val] -> env_val
-      | _ -> Nil)))
+    List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))))
 
 (* ---- Type predicates and introspection ---- *)
 let setup_introspection env =
@@ -1167,11 +763,7 @@ let setup_introspection env =
   bind "component?" (fun args ->
     match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
   bind "callable?" (fun args ->
-    (* 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);
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> 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);
@@ -1297,20 +889,6 @@ 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);
@@ -1357,24 +935,7 @@ let setup_env_operations env =
   bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string"));
   bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value"));
   bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value"));
-  bind "env-extend" (fun args ->
-    match args with
-    | e :: pairs ->
-      let child = Sx_types.env_extend (uw e) in
-      let rec go = function
-        | [] -> ()
-        | k :: v :: rest ->
-          ignore (Sx_types.env_bind child (Sx_runtime.value_to_str k) v); go rest
-        | [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
-      go pairs; Env child
-    | _ -> raise (Eval_error "env-extend: expected env"));
-  bind "env-lookup" (fun args ->
-    match args with
-    | [e; key] ->
-      let k = Sx_runtime.value_to_str key in
-      let raw = uw e in
-      if Sx_types.env_has raw k then Sx_types.env_get raw k else Nil
-    | _ -> raise (Eval_error "env-lookup: (env key)"));
+  bind "env-extend" (fun args -> match args with [e] -> Env (Sx_types.env_extend (uw e)) | _ -> raise (Eval_error "env-extend: expected env"));
   bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs"))
 
 (* ---- Strict mode (gradual type system support) ---- *)
@@ -1398,7 +959,6 @@ let setup_io_bridges env =
   bind "sleep" (fun args -> io_request "sleep" args);
   bind "set-response-status" (fun args -> match args with
     | [Number n] -> _pending_response_status := int_of_float n; Nil
-    | [Integer n] -> _pending_response_status := n; Nil
     | _ -> Nil);
   bind "set-response-header" (fun args -> io_request "set-response-header" args)
 
@@ -1556,22 +1116,6 @@ 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);
@@ -1590,8 +1134,6 @@ 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) ->
@@ -1608,23 +1150,7 @@ 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
-                  | 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)
+                  with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
                in
                resolve_loop request saved_vm
              | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1657,16 +1183,7 @@ 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
-                      | 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)
+                      with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
                    in
                    resolve_loop request saved_vm
                  | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1798,10 +1315,6 @@ 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) ^ ")"
@@ -1829,20 +1342,14 @@ let rec dispatch env cmd =
             | _ -> "" in
           let response = if op = "import" then begin
             let lib_spec = Sx_runtime.get_val request (String "library") in
-            (* 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
+            let key = Sx_ref.library_name_key lib_spec in
+            if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then Nil
             else begin
               (match resolve_library_path lib_spec with
                | Some path -> load_library_file path | None -> ());
               Nil
             end
-          end else
-            (* durable-storage ops: service against on-disk store *)
-            let args = Sx_runtime.get_val request (String "args") in
-            (match Sx_persist_store.handle_op op args with
-             | Some resp -> resp
-             | None -> Nil (* non-import IO: resume with nil *)) in
+          end else Nil (* non-import IO: resume with nil *) in
           s := Sx_ref.cek_resume !s response
         done;
         Sx_ref.cek_value !s
@@ -1854,7 +1361,6 @@ let rec dispatch env cmd =
         | Bool true -> "true"
         | Bool false -> "false"
         | Number n -> Sx_types.format_number n
-        | Integer n -> string_of_int n
         | String s -> "\"" ^ escape_sx_string s ^ "\""
         | Symbol s -> s
         | Keyword k -> ":" ^ k
@@ -1868,10 +1374,6 @@ let rec dispatch env cmd =
         | Island i -> "~" ^ i.i_name
         | SxExpr s -> s
         | RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
-        | Char n -> Sx_types.inspect (Char n)
-        | Eof -> Sx_types.inspect Eof
-        | Port _ -> Sx_types.inspect result
-        | Rational (n, d) -> Printf.sprintf "%d/%d" n d
         | _ -> "nil"
       in
       send_ok_raw (raw_serialize result)
@@ -2631,12 +2133,8 @@ 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.
-       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
+    (* Build an error page AST that keeps the layout intact *)
     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"];
@@ -2676,7 +2174,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, !is_error_page)
+          Some body_str
         end else begin
           (* Full page: aser → SSR → shell *)
           let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in
@@ -2731,7 +2229,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, !is_error_page)
+          Some html
         end
       end
 
@@ -4163,18 +3661,8 @@ 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. *)
-  (* 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%!");
+  (* Enable lazy JIT — compile lambdas to bytecode on first call *)
+  register_jit_hook env;
   (* 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 ->
@@ -4209,10 +3697,7 @@ let http_mode port =
       Dict d
     | "io-sleep" | "sleep" -> Nil
     | "import" -> Nil
-    | _ ->
-      (match Sx_persist_store.handle_op op args with
-       | Some resp -> resp
-       | None -> Nil));
+    | _ -> Nil);
   (* Response cache — path → full HTTP response string.
      Populated during pre-warm, serves cached responses in <0.1ms.
      Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for
@@ -4221,9 +3706,7 @@ let http_mode port =
 
   let cache_response path =
     match http_render_page env path [] with
-    | Some (_, true) ->
-      Printf.eprintf "[cache] %s → error page, not cached\n%!" path
-    | Some (html, false) ->
+    | Some html ->
       let resp = http_response html in
       Hashtbl.replace response_cache path resp;
       Printf.eprintf "[cache] %s → %d bytes\n%!" path (String.length html)
@@ -4313,7 +3796,7 @@ let http_mode port =
         let response =
           try
             match http_render_page env path headers with
-            | Some (body, is_err) ->
+            | Some body ->
               (* htmx requests get HTML; SX requests get SX wire format *)
               let final_body = if is_htmx then
                 (try
@@ -4325,7 +3808,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
-              if not is_err then Hashtbl.replace response_cache cache_key resp;
+              Hashtbl.replace response_cache cache_key resp;
               resp
             | None -> http_response ~status:404 "<h1>Not Found</h1>"
           with e ->
@@ -4679,7 +4162,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, is_err) ->
+                  | Some body ->
                     let final_body = if is_htmx then
                       (try
                         let exprs = Sx_parser.parse_all body in
@@ -4690,7 +4173,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 && not is_err then Hashtbl.replace response_cache cache_key resp;
+                    if not is_htmx 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\"))"
@@ -4706,7 +4189,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);
@@ -4963,20 +4446,14 @@ let site_mode () =
         let line = String.trim line in
         if line = "" then ()
         else begin
-          (* 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 ->
+          let exprs = Sx_parser.parse_all line in
           match exprs with
           | [List [Symbol "epoch"; Number n]] ->
             current_epoch := int_of_float n
-          | [List [Symbol "epoch"; Integer n]] ->
-            current_epoch := n
           (* 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 *)
@@ -5010,46 +4487,6 @@ 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
@@ -5065,17 +4502,11 @@ let () =
             Printf.eprintf "[sx-server] discarding stale io-response (%d chars)\n%!"
               (String.length line)
           else begin
-            (* 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 ->
+            let exprs = Sx_parser.parse_all line in
             match exprs with
             (* Epoch marker: (epoch N) — set current epoch, read next command *)
             | [List [Symbol "epoch"; Number n]] ->
               current_epoch := int_of_float n
-            | [List [Symbol "epoch"; Integer n]] ->
-              current_epoch := n
             | [cmd] -> dispatch env cmd
             | _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
           end

hosts/ocaml/bin/test_http.sh

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

hosts/ocaml/bin/test_http_client.sh

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

hosts/ocaml/bootstrap.py

@@ -47,9 +47,7 @@ open Sx_runtime
 let trampoline_fn : (value -> value) ref = ref (fun v -> v)
 let trampoline v = !trampoline_fn v
 
-(* Step limit for timeout detection — set to 0 to disable *)
-let step_limit : int ref = ref 0
-let step_count : int ref = ref 0
+
 
 (* === Mutable globals — backing refs for transpiler's !_ref / _ref := === *)
 let _strict_ref = ref (Bool false)
@@ -82,10 +80,7 @@ let cek_run_iterative state =
       s := cek_step !s
     done;
     (match cek_suspended_p !s with
-     | Bool true ->
-       (match !_cek_io_suspend_hook with
-        | Some hook -> hook !s
-        | None -> raise (Eval_error "IO suspension in non-IO context"))
+     | Bool true -> raise (Eval_error "IO suspension in non-IO context")
      | _ -> cek_value !s)
   with Eval_error msg ->
     _last_error_kont_ref := cek_kont !s;
@@ -131,111 +126,6 @@ let enhance_error_with_trace msg =
   _last_error_kont_ref := Nil;
   msg ^ (format_comp_trace trace)
 
-(* Hand-written sf_define_type — skipped from transpile because the spec uses
-   &rest params and empty-dict literals that the transpiler can't emit cleanly.
-   Implements: (define-type Name (Ctor1 f1 f2) (Ctor2 f3) ...)
-   Creates constructor fns, Name?/Ctor? predicates, Ctor-field accessors,
-   and records ctors in *adt-registry*. *)
-let sf_define_type args env_val =
-  let items = (match args with List l -> l | _ -> []) in
-  let type_sym = List.nth items 0 in
-  let type_name = value_to_string type_sym in
-  let ctor_specs = List.tl items in
-  let env_has_v k = sx_truthy (env_has env_val (String k)) in
-  let env_bind_v k v = ignore (env_bind env_val (String k) v) in
-  let env_get_v k = env_get env_val (String k) in
-  if not (env_has_v "*adt-registry*") then
-    env_bind_v "*adt-registry*" (Dict (Hashtbl.create 8));
-  let registry = env_get_v "*adt-registry*" in
-  let ctor_names = List.map (fun spec ->
-    (match spec with List (sym :: _) -> String (value_to_string sym) | _ -> Nil)
-  ) ctor_specs in
-  (match registry with Dict d -> Hashtbl.replace d type_name (List ctor_names) | _ -> ());
-  env_bind_v (type_name ^ "?")
-    (NativeFn (type_name ^ "?", fun pargs ->
-      (match pargs with
-      | [v] ->
-        (match v with
-        | AdtValue a -> Bool (a.av_type = type_name)
-        | _ -> Bool false)
-      | _ -> Bool false)));
-  List.iter (fun spec ->
-    (match spec with
-    | List (sym :: fields) ->
-      let cn = value_to_string sym in
-      let field_names = List.map value_to_string fields in
-      let arity = List.length fields in
-      env_bind_v cn
-        (NativeFn (cn, fun ctor_args ->
-          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
-            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
-            | AdtValue a -> Bool (a.av_ctor = cn)
-            | _ -> Bool false)
-          | _ -> Bool false)));
-      List.iteri (fun idx fname ->
-        env_bind_v (cn ^ "-" ^ fname)
-          (NativeFn (cn ^ "-" ^ fname, fun pargs ->
-            (match pargs with
-            | [v] ->
-              (match v with
-              | AdtValue a ->
-                if idx < Array.length a.av_fields then a.av_fields.(idx)
-                else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
-              | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
-            | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
-      ) field_names
-    | _ -> ())
-  ) ctor_specs;
-  Nil
-
-(* Register 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)))
 
 
 """
@@ -281,24 +171,7 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
                 "debug-log", "debug_log", "range", "chunk-every", "zip-pairs",
                 "string-contains?", "starts-with?", "ends-with?",
                 "string-replace", "trim", "split", "index-of",
-                "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",
-                # 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"}
+                "pad-left", "pad-right", "char-at", "substring"}
         defines = [(n, e) for n, e in defines if n not in skip]
 
         # Deduplicate — keep last definition for each name (CEK overrides tree-walk)
@@ -346,23 +219,6 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
         output
     )
 
-    # Patch transpiled cek_run to invoke _cek_io_suspend_hook on suspension
-    # instead of unconditionally raising Eval_error. This is the fix for the
-    # tree-walk eval_expr path: sf_letrec init exprs / non-last body exprs,
-    # macro bodies, qq_expand, dynamic-wind / scope / provide bodies all use
-    # `trampoline (eval_expr ...)` and were swallowing CEK suspensions as
-    # "IO suspension in non-IO context" errors. With the hook, the suspension
-    # propagates as VmSuspended to the outer driver (browser callFn / server
-    # eval_expr_io). When the hook is unset (pure-CEK harness), the legacy
-    # error is preserved as the fallback.
-    output = re.sub(
-        r'\(raise \(Eval_error \(value_to_str \(String "IO suspension in non-IO context"\)\)\)\)',
-        '(match !_cek_io_suspend_hook with Some hook -> hook final | None -> '
-        '(raise (Eval_error (value_to_str (String "IO suspension in non-IO context")))))',
-        output,
-        count=1,
-    )
-
     return output
 
 

hosts/ocaml/bootstrap_vm.py

@@ -355,9 +355,7 @@ let vm_create_closure vm_val frame_val code_val =
   let f = unwrap_frame frame_val in
   let uv_count = match code_val with
     | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-        | Some (Integer n) -> n
-        | Some (Number n) -> int_of_float n
-        | _ -> 0)
+        | Some (Number n) -> int_of_float n | _ -> 0)
     | _ -> 0
   in
   let upvalues = Array.init uv_count (fun _ ->

hosts/ocaml/browser/bundle.sh

@@ -71,18 +71,10 @@ 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"
 done
-for f in worker prolog; do
-  cp "$ROOT/lib/hyperscript/plugins/$f.sx" "$DIST/sx/hs-$f.sx"
-done
 
 # Summary
 WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)

hosts/ocaml/browser/compile-modules.js

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

hosts/ocaml/browser/eval_wasm_probes.js

@@ -1,68 +0,0 @@
-#!/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

@@ -1,170 +0,0 @@
-#!/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,18 +646,6 @@
     // 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,7 +73,6 @@ 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 ->
@@ -330,9 +329,8 @@ 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
-  (* 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
+  let key = Sx_ref.library_name_key lib_spec in
+  if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
     Some Nil  (* Already loaded — resume immediately *)
   else
     None  (* Not loaded — JS platform must fetch it *)
@@ -346,12 +344,6 @@ let api_eval src_js =
     sync_env_to_vm ();
     return_via_side_channel (value_to_js result)
   with
-  | Sx_vm.VmSuspended _ ->
-    (* Top-level eval encountered an IO suspension propagated via the
-       cek_run hook (perform inside letrec init / non-last body / macro /
-       qq tree-walked path). K.eval doesn't drive resumption — surface as
-       a clear error so the caller knows to use callFn instead. *)
-    Js.Unsafe.inject (Js.string "Error: IO suspension in non-IO context (use callFn for IO-aware paths)")
   | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
   | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
 
@@ -379,8 +371,6 @@ let api_eval_vm src_js =
     ) _vm_globals;
     return_via_side_channel (value_to_js result)
   with
-  | Sx_vm.VmSuspended _ ->
-    Js.Unsafe.inject (Js.string "Error: IO suspension in non-IO context (use callFn for IO-aware paths)")
   | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
   | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
   | Not_found -> Js.Unsafe.inject (Js.string "Error: compile-module not loaded")
@@ -391,10 +381,7 @@ let api_eval_expr expr_js _env_js =
     let result = Sx_ref.eval_expr expr (Env global_env) in
     sync_env_to_vm ();
     return_via_side_channel (value_to_js result)
-  with
-  | Sx_vm.VmSuspended _ ->
-    Js.Unsafe.inject (Js.string "Error: IO suspension in non-IO context (use callFn for IO-aware paths)")
-  | Eval_error msg ->
+  with Eval_error msg ->
     Js.Unsafe.inject (Js.string ("Error: " ^ msg))
 
 let api_load src_js =
@@ -678,11 +665,7 @@ let () =
   let rec deep_equal a b =
     match a, b with
     | Nil, Nil -> true | Bool a, Bool b -> a = b
-    | Integer a, Integer b -> a = b
-    | Number a, Number b -> a = b
-    | Integer a, Number b -> float_of_int a = b
-    | Number a, Integer b -> a = float_of_int b
-    | String a, String b -> a = b
+    | Number a, Number b -> a = b | String a, String b -> a = b
     | Symbol a, Symbol b -> a = b | Keyword a, Keyword b -> a = b
     | (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
       List.length a = List.length b && List.for_all2 deep_equal a b
@@ -721,10 +704,8 @@ let () =
         | List (Symbol "code" :: rest) ->
           let d = Hashtbl.create 8 in
           let rec parse_kv = function
-            | Keyword "arity" :: (Number _ as n) :: rest -> Hashtbl.replace d "arity" n; parse_kv rest
-            | Keyword "arity" :: (Integer _ as n) :: rest -> Hashtbl.replace d "arity" n; parse_kv rest
-            | Keyword "upvalue-count" :: (Number _ as n) :: rest -> Hashtbl.replace d "upvalue-count" n; parse_kv rest
-            | Keyword "upvalue-count" :: (Integer _ as n) :: rest -> Hashtbl.replace d "upvalue-count" n; parse_kv rest
+            | Keyword "arity" :: Number n :: rest -> Hashtbl.replace d "arity" (Number n); parse_kv rest
+            | Keyword "upvalue-count" :: Number n :: rest -> Hashtbl.replace d "upvalue-count" (Number n); parse_kv rest
             | Keyword "bytecode" :: List nums :: rest ->
               Hashtbl.replace d "bytecode" (List nums); parse_kv rest
             | Keyword "constants" :: List consts :: rest ->

hosts/ocaml/browser/test_letrec_resume.js

@@ -1,172 +0,0 @@
-#!/usr/bin/env node
-// Repro: letrec sibling bindings nil after perform/resume in browser kernel
-//
-// Bug: After a CEK IO suspension (perform / hs-wait) resumes in the
-// WASM browser kernel, calling a sibling letrec binding could return
-// nil, with the error surfaced as `[sx] resume: Not callable: nil`.
-//
-// Root cause: cek-run / cek_run_iterative raised
-// `"IO suspension in non-IO context"` when a tree-walked eval_expr
-// (sf_letrec init exprs / non-last body, macro body, qq unquote, scope
-// body, provide body, dynamic-wind) hit a perform. The CEK suspension
-// was created correctly but never propagated through the OCaml-side
-// _cek_io_suspend_hook, so the outer driver never saw VmSuspended.
-//
-// Fix: cek_run / cek_run_iterative now invoke _cek_io_suspend_hook on
-// suspension (raising VmSuspended for the outer driver). When the hook
-// is unset (pure-CEK harness), they fall back to the legacy error.
-//
-// This test exercises the WASM kernel through K.callFn — the path that
-// browser event handlers use. Suspension surfaces as a JS object with
-// {suspended, request, resume(result)} that the test drives synchronously.
-//
-// Companion: spec/tests/test-letrec-resume-treewalk.sx tests the
-// CEK-only path through the OCaml test runner.
-
-const path = require('path');
-const fs = require('fs');
-
-const KERNEL = path.join(__dirname, '..', '_build', 'default', 'browser', 'sx_browser.bc.js');
-if (!fs.existsSync(KERNEL)) {
-  console.error('FATAL: missing ' + KERNEL + ' — run `dune build` from hosts/ocaml first');
-  process.exit(2);
-}
-require(KERNEL);
-const K = globalThis.SxKernel;
-
-let passed = 0, failed = 0;
-const failures = [];
-
-function test(name, fn) {
-  try {
-    const r = fn();
-    if (r === true) {
-      passed++;
-      console.log('  PASS: ' + name);
-    } else {
-      failed++;
-      failures.push({ name, error: 'got ' + JSON.stringify(r) });
-      console.log('  FAIL: ' + name + ' — got ' + JSON.stringify(r));
-    }
-  } catch (e) {
-    failed++;
-    failures.push({ name, error: e.message || String(e) });
-    console.log('  FAIL: ' + name + ' — ' + (e.message || e));
-  }
-}
-
-function driveSync(result) {
-  while (result && typeof result === 'object' && result.suspended) {
-    result = result.resume(null);
-  }
-  return result;
-}
-
-function callExpr(src) {
-  K.eval('(define _t-fn (fn () ' + src + '))');
-  const fn = K.eval('_t-fn');
-  return driveSync(K.callFn(fn, []));
-}
-
-console.log('\n=== letrec + perform/resume regression tests ===\n');
-
-test('basic letrec without perform', () =>
-  callExpr('(letrec ((f (fn () "ok"))) (f))') === 'ok');
-
-test('callFn perform suspends and resumes with nil', () => {
-  K.eval('(define _t-perform (fn () (perform {:op "io"})))');
-  let r = K.callFn(K.eval('_t-perform'), []);
-  if (!r || !r.suspended) return 'no suspension: ' + JSON.stringify(r);
-  return r.resume(null) === null;
-});
-
-test('letrec, single binding, perform/resume', () =>
-  callExpr('(letrec ((f (fn () (perform {:op "io"})))) (f))') === null);
-
-test('letrec, 2 bindings, body calls sibling after suspended call', () =>
-  callExpr(`
-    (letrec
-      ((wait-then (fn () (do (perform {:op "io"}) "wait-done")))
-       (other-fn (fn () "other-result")))
-      (do (wait-then) (other-fn)))`) === 'other-result');
-
-test('letrec, suspending fn calls sibling after own perform', () =>
-  callExpr(`
-    (letrec
-      ((wait-and-call (fn () (do (perform {:op "io"}) (other-fn))))
-       (other-fn (fn () "from-sibling")))
-      (wait-and-call))`) === 'from-sibling');
-
-test('letrec, fn references sibling value after perform/resume', () =>
-  callExpr(`
-    (letrec
-      ((shared "shared-state")
-       (do-fn (fn () (do (perform {:op "io"}) shared))))
-      (do-fn))`) === 'shared-state');
-
-test('letrec, recursive self-call after perform (wait-boot pattern)', () => {
-  K.eval('(define _wb-c 0)');
-  K.eval('(set! _wb-c 0)');
-  return callExpr(`
-    (letrec ((wait-boot (fn ()
-                (do (perform {:op "io"})
-                    (if (>= _wb-c 1)
-                        "done"
-                        (do (set! _wb-c (+ 1 _wb-c))
-                            (wait-boot)))))))
-      (wait-boot))`) === 'done';
-});
-
-test('top-level define + perform + sibling call after resume', () => {
-  K.eval('(define do-suspend-x (fn () (do (perform {:op "io"}) (do-other-x))))');
-  K.eval('(define do-other-x (fn () "ok-from-other"))');
-  return callExpr('(do-suspend-x)') === 'ok-from-other';
-});
-
-test('letrec, two performs (sequential) then sibling call', () =>
-  callExpr(`
-    (letrec
-      ((wait-twice (fn () (do (perform {:op "io1"}) (perform {:op "io2"}) (other))))
-       (other (fn () "after-double")))
-      (wait-twice))`) === 'after-double');
-
-// === Tree-walk paths that previously raised "IO suspension in non-IO context" ===
-
-test('letrec init expr with perform — suspension propagates (no error)', () => {
-  let r;
-  try { r = callExpr('(letrec ((x (perform {:op "io"}))) "ok")'); }
-  catch (e) { return 'threw: ' + e.message; }
-  return r === null || r === 'ok';
-});
-
-test('letrec non-last body with perform — suspension propagates (no error)', () => {
-  let r;
-  try { r = callExpr('(letrec ((x 1)) (perform {:op "io"}) "after")'); }
-  catch (e) { return 'threw: ' + e.message; }
-  return r === null || r === 'after';
-});
-
-test('macro body with perform — suspension propagates', () => {
-  K.eval('(defmacro _m1 (form) (do (perform {:op "io"}) form))');
-  let r;
-  try { r = callExpr('(_m1 "macro-ok")'); }
-  catch (e) { return 'threw: ' + e.message; }
-  return r === 'macro-ok' || r === null;
-});
-
-test('quasiquote unquote with perform — suspension propagates', () => {
-  let r;
-  try { r = callExpr('(let ((y "yyy")) `(a ,(do (perform {:op "io"}) y) c))'); }
-  catch (e) { return 'threw: ' + e.message; }
-  return r !== undefined;
-});
-
-console.log('\n--- Results ---');
-console.log('passed: ' + passed);
-console.log('failed: ' + failed);
-if (failed > 0) {
-  console.log('\nFailures:');
-  failures.forEach(f => console.log('  - ' + f.name + ': ' + f.error));
-  process.exit(1);
-}
-process.exit(0);

hosts/ocaml/lib/dune

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

hosts/ocaml/lib/extensions/README.md

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

hosts/ocaml/lib/extensions/erlang_ext.ml

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

hosts/ocaml/lib/extensions/test_ext.ml

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

hosts/ocaml/lib/sx_cbor.ml

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

hosts/ocaml/lib/sx_cid.ml

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

hosts/ocaml/lib/sx_compiler.ml

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

hosts/ocaml/lib/sx_ed25519.ml

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

hosts/ocaml/lib/sx_parser.ml

@@ -89,38 +89,10 @@ let read_symbol s =
   while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
   String.sub s.src start (s.pos - start)
 
-let gcd a b =
-  let rec g a b = if b = 0 then a else g b (a mod b) in g (abs a) (abs b)
-
-let make_rat n d =
-  if d = 0 then raise (Parse_error "rational: division by zero");
-  let sign = if d < 0 then -1 else 1 in
-  let g = gcd (abs n) (abs d) in
-  let rn = sign * n / g and rd = sign * d / g in
-  if rd = 1 then Integer rn else Rational (rn, rd)
-
 let try_number str =
-  (* Integers (no '.' or 'e'/'E') → exact Integer; rationals N/D; floats → inexact Number *)
-  let has_dec = String.contains str '.' in
-  let has_exp = String.contains str 'e' || String.contains str 'E' in
-  if has_dec || has_exp then
-    match float_of_string_opt str with
-    | Some n -> Some (Number n)
-    | None -> None
-  else
-    match String.split_on_char '/' str with
-    | [num_s; den_s] when num_s <> "" && den_s <> "" ->
-      (match int_of_string_opt num_s, int_of_string_opt den_s with
-       | Some n, Some d -> (try Some (make_rat n d) with _ -> None)
-       | _ -> None)
-    | _ ->
-      match int_of_string_opt str with
-      | Some n -> Some (Integer n)
-      | None ->
-        (* handles "nan", "inf", "-inf" *)
-        match float_of_string_opt str with
-        | Some n -> Some (Number n)
-        | None -> None
+  match float_of_string_opt str with
+  | Some n -> Some (Number n)
+  | None -> None
 
 let rec read_value s : value =
   skip_whitespace_and_comments s;
@@ -136,34 +108,6 @@ let rec read_value s : value =
   | '"' -> String (read_string s)
   | '\'' -> advance s; List [Symbol "quote"; read_value s]
   | '`' -> advance s; List [Symbol "quasiquote"; read_value s]
-  | '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '\\' ->
-    (* Character literal: #\a, #\space, #\newline, etc. *)
-    advance s; advance s;
-    if at_end s then raise (Parse_error "Unexpected end of input after #\\");
-    let char_start = s.pos in
-    (* Read a name if starts with ident char, else single char *)
-    if is_ident_start s.src.[s.pos] then begin
-      while s.pos < s.len && is_ident_char s.src.[s.pos] do advance s done;
-      let name = String.sub s.src char_start (s.pos - char_start) in
-      let cp = match name with
-        | "space" -> 32 | "newline" -> 10 | "tab" -> 9
-        | "return" -> 13 | "nul" -> 0 | "null" -> 0
-        | "escape" -> 27 | "delete" -> 127 | "backspace" -> 8
-        | "altmode" -> 27 | "rubout" -> 127
-        | _ -> Char.code name.[0]  (* single letter like #\a *)
-      in Char cp
-    end else begin
-      let c = s.src.[s.pos] in
-      advance s;
-      Char (Char.code c)
-    end
-  | '#' when s.pos + 1 < s.len &&
-             (s.src.[s.pos + 1] = 't' || s.src.[s.pos + 1] = 'f') &&
-             (s.pos + 2 >= s.len || not (is_ident_char s.src.[s.pos + 2])) ->
-    (* #t / #f — boolean literals (R7RS shorthand) *)
-    let b = s.src.[s.pos + 1] = 't' in
-    advance s; advance s;
-    Bool b
   | '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = ';' ->
     (* Datum comment: #; discards next expression *)
     advance s; advance s;

hosts/ocaml/lib/sx_persist_store.ml

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

hosts/ocaml/lib/sx_rsa.ml

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

hosts/ocaml/lib/sx_runtime.ml

@@ -6,80 +6,11 @@
 
 open Sx_types
 
-(** Fast path equality — same as Sx_primitives.safe_eq for the common cases
-    that show up in hot dispatch (string vs string, etc). Falls through to
-    the registered "=" primitive for complex cases. *)
-let rec _fast_eq a b =
-  if a == b then true
-  else match a, b with
-  | String x, String y -> x = y
-  | Integer x, Integer y -> x = y
-  | Number x, Number y -> x = y
-  | Integer x, Number y -> float_of_int x = y
-  | Number x, Integer y -> x = float_of_int y
-  (* 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 | ListRef { contents = la }),
-    (List lb | ListRef { contents = lb }) ->
-    (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
-  | _ -> false
-
-(** Call a registered primitive by name.
-    Fast path for hot dispatch primitives ([=], [<], [>], [<=], [>=], [empty?],
-    [first], [rest], [len]) skips the Hashtbl lookup entirely — these are
-    called millions of times in the CEK [step_continue]/[step_eval] dispatch. *)
+(** Call a registered primitive by name. *)
 let prim_call name args =
-  (* Hot path: most-frequently-called primitives by step_continue dispatch *)
-  match name, args with
-  | "=", [a; b] -> Bool (_fast_eq a b)
-  | "empty?", [List []] -> Bool true
-  | "empty?", [List _] -> Bool false
-  | "empty?", [ListRef { contents = [] }] -> Bool true
-  | "empty?", [ListRef _] -> Bool false
-  | "empty?", [Nil] -> Bool true
-  | "first", [List (x :: _)] -> x
-  | "first", [List []] -> Nil
-  | "first", [ListRef { contents = (x :: _) }] -> x
-  | "first", [ListRef _] -> Nil
-  | "first", [Nil] -> Nil
-  | "rest", [List (_ :: xs)] -> List xs
-  | "rest", [List []] -> List []
-  | "rest", [ListRef { contents = (_ :: xs) }] -> List xs
-  | "rest", [ListRef _] -> List []
-  | "rest", [Nil] -> List []
-  | "len", [List l] -> Integer (List.length l)
-  | "len", [ListRef r] -> Integer (List.length !r)
-  | "len", [String s] -> Integer (String.length s)
-  | "len", [Nil] -> Integer 0
-  | "<", [Integer x; Integer y] -> Bool (x < y)
-  | "<", [Number x; Number y] -> Bool (x < y)
-  | "<", [Integer x; Number y] -> Bool (float_of_int x < y)
-  | "<", [Number x; Integer y] -> Bool (x < float_of_int y)
-  | ">", [Integer x; Integer y] -> Bool (x > y)
-  | ">", [Number x; Number y] -> Bool (x > y)
-  | ">", [Integer x; Number y] -> Bool (float_of_int x > y)
-  | ">", [Number x; Integer y] -> Bool (x > float_of_int y)
-  | "<=", [Integer x; Integer y] -> Bool (x <= y)
-  | "<=", [Number x; Number y] -> Bool (x <= y)
-  | "<=", [Integer x; Number y] -> Bool (float_of_int x <= y)
-  | "<=", [Number x; Integer y] -> Bool (x <= float_of_int y)
-  | ">=", [Integer x; Integer y] -> Bool (x >= y)
-  | ">=", [Number x; Number y] -> Bool (x >= y)
-  | ">=", [Integer x; Number y] -> Bool (float_of_int x >= y)
-  | ">=", [Number x; Integer y] -> Bool (x >= float_of_int y)
-  | _ ->
-    match Hashtbl.find_opt Sx_primitives.primitives name with
-    | Some f -> f args
-    | None -> raise (Eval_error ("Unknown primitive: " ^ name))
+  match Hashtbl.find_opt Sx_primitives.primitives name with
+  | Some f -> f args
+  | None -> raise (Eval_error ("Unknown primitive: " ^ name))
 
 (** Convert any SX value to an OCaml string (internal). *)
 let value_to_str = function
@@ -115,7 +46,7 @@ let sx_call f args =
     !Sx_types._cek_eval_lambda_ref f args
   | Continuation (k, _) ->
     k (match args with x :: _ -> x | [] -> Nil)
-  | CallccContinuation (_, _) ->
+  | CallccContinuation _ ->
     raise (Eval_error "callcc continuations must be invoked through the CEK machine")
   | _ ->
     let nargs = List.length args in
@@ -225,9 +156,6 @@ let get_val container key =
      | "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
      | "subscribers" -> f.cf_results
      | "prev-tracking" -> f.cf_extra
-     | "after-thunk" -> f.cf_f        (* wind-after frame *)
-     | "winders-len" -> f.cf_extra    (* wind-after frame *)
-     | "body-result" -> f.cf_name     (* wind-return frame *)
      | _ -> Nil)
   | VmFrame f, String k ->
     (match k with
@@ -278,17 +206,8 @@ let get_val container key =
      | _ -> Nil)
   | Dict d, String k -> dict_get d k
   | Dict d, Keyword k -> dict_get d k
-  | AdtValue a, String k | AdtValue a, Keyword k ->
-    (match k with
-     | "_adt"    -> Bool true
-     | "_type"   -> String a.av_type
-     | "_ctor"   -> String a.av_ctor
-     | "_fields" -> List (Array.to_list a.av_fields)
-     | _         -> Nil)
   | (List l | ListRef { contents = l }), Number n ->
     (try List.nth l (int_of_float n) with _ -> Nil)
-  | (List l | ListRef { contents = l }), Integer n ->
-    (try List.nth l n with _ -> Nil)
   | Nil, _ -> Nil  (* nil.anything → nil *)
   | _, _ -> Nil    (* type mismatch → nil (matches JS/Python behavior) *)
 
@@ -462,28 +381,19 @@ let continuation_data v = match v with
   | _ -> raise (Eval_error "not a continuation")
 
 (* Callcc (undelimited) continuation support *)
-let callcc_continuation_p v = match v with CallccContinuation (_, _) -> Bool true | _ -> Bool false
+let callcc_continuation_p v = match v with CallccContinuation _ -> Bool true | _ -> Bool false
 
-let make_callcc_continuation captured winders_len =
-  let n = match winders_len with Number f -> int_of_float f | Integer n -> n | _ -> 0 in
-  CallccContinuation (sx_to_list captured, n)
+let make_callcc_continuation captured =
+  CallccContinuation (sx_to_list captured)
 
 let callcc_continuation_data v = match v with
-  | CallccContinuation (frames, _) -> List frames
+  | CallccContinuation frames -> List frames
   | _ -> raise (Eval_error "not a callcc continuation")
 
-let callcc_continuation_winders_len v = match v with
-  | CallccContinuation (_, n) -> Number (float_of_int n)
-  | _ -> Number 0.0
-
 (* Dynamic wind — simplified for OCaml (no async) *)
 let host_error msg =
   raise (Eval_error (value_to_str msg))
 
-let host_warn msg =
-  prerr_endline (value_to_str msg);
-  Nil
-
 let dynamic_wind_call before body after _env =
   ignore (sx_call before []);
   let result = sx_call body [] in
@@ -619,4 +529,3 @@ let jit_try_call f args =
       (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel)
     | _ -> incr _jit_skip; _jit_skip_sentinel
 
-

hosts/ocaml/lib/sx_sha2.ml

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

hosts/ocaml/lib/sx_sha3.ml

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

hosts/ocaml/lib/sx_types.ml

@@ -43,10 +43,9 @@ type env = {
 
 and value =
   | Nil
-  | Bool    of bool
-  | Integer of int    (** Exact integer — distinct from inexact float. *)
-  | Number  of float  (** Inexact float. *)
-  | String  of string
+  | Bool   of bool
+  | Number of float
+  | String of string
   | Symbol of string
   | Keyword of string
   | List   of value list
@@ -57,7 +56,7 @@ and value =
   | Macro  of macro
   | Thunk  of value * env
   | Continuation of (value -> value) * dict option
-  | CallccContinuation of value list * int  (** Undelimited continuation — captured kont frames + winders depth at capture *)
+  | CallccContinuation of value list  (** Undelimited continuation — captured kont frames *)
   | NativeFn of string * (value list -> value)
   | Signal of signal
   | RawHTML of string
@@ -73,35 +72,6 @@ and value =
   | Record of record  (** R7RS record — opaque, generative, field-indexed. *)
   | Parameter of parameter  (** R7RS parameter — dynamic binding via kont-stack provide frames. *)
   | Vector of value array  (** R7RS vector — mutable fixed-size array. *)
-  | StringBuffer of Buffer.t  (** Mutable string buffer — O(1) amortized append. *)
-  | HashTable of (value, value) Hashtbl.t  (** Mutable hash table with arbitrary keys. *)
-  | Char of int  (** Unicode codepoint — R7RS char type. *)
-  | Eof            (** EOF sentinel — returned by read-char etc. at end of input. *)
-  | Port of sx_port  (** String port — input (string cursor) or output (buffer). *)
-  | Rational of int * int  (** Exact rational: numerator, denominator (reduced, denom>0). *)
-  | SxSet of (string, value) Hashtbl.t  (** Mutable set keyed by inspect(value). *)
-  | SxRegexp of string * string * Re.re  (** Regexp: source, flags, compiled. *)
-  | SxBytevector of bytes  (** Mutable bytevector — R7RS bytevector type. *)
-  | AdtValue of adt_value  (** Native algebraic data type instance — opaque sum type. *)
-
-(** Algebraic data type instance — produced by [define-type] constructors.
-    [av_type] is the type name (e.g. "Maybe"), [av_ctor] is the constructor
-    name (e.g. "Just"), [av_fields] are the positional field values. *)
-and adt_value = {
-  av_type   : string;
-  av_ctor   : string;
-  av_fields : value array;
-}
-
-(** String input port: source string + mutable cursor position. *)
-and sx_port_kind =
-  | PortInput of string * int ref
-  | PortOutput of Buffer.t
-
-and sx_port = {
-  mutable sp_closed : bool;
-  sp_kind : sx_port_kind;
-}
 
 (** CEK machine state — record instead of Dict for performance.
     5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *)
@@ -138,8 +108,6 @@ and lambda = {
   l_closure : env;
   mutable l_name : string option;
   mutable l_compiled : vm_closure option;  (** Lazy JIT cache *)
-  mutable l_call_count : int;              (** Tiered-compilation counter — JIT after threshold calls *)
-  l_uid : int;                             (** Unique identity for LRU cache tracking *)
 }
 
 and component = {
@@ -424,7 +392,6 @@ let format_number n =
 
 let value_to_string = function
   | String s -> s | Symbol s -> s | Keyword k -> k
-  | Integer n -> string_of_int n
   | Number n -> format_number n
   | Bool true -> "true" | Bool false -> "false"
   | Nil -> "" | _ -> "<value>"
@@ -446,106 +413,12 @@ let unwrap_env_val = function
   | Env e -> e
   | _ -> raise (Eval_error "make_lambda: expected env for closure")
 
-(* Lambda UID — minted on construction, used as LRU cache key (Phase 2). *)
-let lambda_uid_counter = ref 0
-let next_lambda_uid () = incr lambda_uid_counter; !lambda_uid_counter
-
 let make_lambda params body closure =
   let ps = match params with
     | List items -> List.map value_to_string items
     | _ -> value_to_string_list params
   in
-  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0; l_uid = next_lambda_uid () }
-
-(** {1 JIT cache control}
-
-    Tiered compilation: only JIT a lambda after it's been called [jit_threshold]
-    times. This filters out one-shot lambdas (test harness, dynamic eval, REPLs)
-    so they never enter the JIT cache. Counters are exposed to SX as [(jit-stats)].
-
-    These live here (in sx_types) rather than sx_vm so [sx_primitives] can read
-    them without creating a sx_primitives → sx_vm dependency cycle. *)
-let jit_threshold = ref 4
-let jit_compiled_count = ref 0
-let jit_skipped_count = ref 0
-let jit_threshold_skipped_count = ref 0
-
-(** Runtime, data-driven JIT exclusion set. Names added here are never
-    JIT-compiled — they run on the CEK interpreter instead.
-
-    This is how a guest interpreter declares its *interpret-only* functions:
-    those that capture or invoke first-class continuations (e.g. Smalltalk's
-    [call/cc]-based non-local return [^expr], or block escape). The stack VM
-    cannot transfer control through a CEK continuation, so a JIT-compiled
-    frame on the OCaml/VM stack between a [call/cc] and its [(k v)] invocation
-    would either fail at runtime or (worse) re-run with duplicated side
-    effects. Marking the dispatch core interpret-only keeps those functions on
-    the CEK while pure helpers still JIT.
-
-    Populated from SX via the [jit-exclude!] primitive (see sx_primitives).
-    Consulted in [Sx_vm.jit_compile_lambda], so it covers BOTH JIT entry
-    points: the CEK call hook and the in-VM tiered-compilation path. *)
-let jit_excluded : (string, unit) Hashtbl.t = Hashtbl.create 64
-
-(** Namespace-prefix exclusions. A guest interpreter declares its whole
-    function namespace interpret-only with one entry (e.g. ["er-"], ["scm-"]),
-    which is far more robust than enumerating every function — a name-list
-    misses functions in extra files (the erlang VM dispatcher, etc.) and
-    silently regresses. Set via [jit-exclude!] with a trailing ["*"]
-    (e.g. [(jit-exclude! "er-*")]). Checked via [jit_name_excluded]. *)
-let jit_excluded_prefixes : string list ref = ref []
-
-(** True if [name] is excluded from JIT — by exact name or by namespace prefix. *)
-let jit_name_excluded name =
-  Hashtbl.mem jit_excluded name
-  || List.exists (fun p ->
-       String.length name >= String.length p
-       && String.sub name 0 (String.length p) = p) !jit_excluded_prefixes
-
-(** Names of functions that ESTABLISH an escaping continuation via call/cc
-    (e.g. Common-Lisp's [cl-restart-case] / [cl-handler-case] — the condition
-    system). Any SX function that *calls* one of these is itself unsafe to JIT:
-    JIT-compiling the caller forces the call/cc-wrapping form to run in a nested
-    cek-run, where invoking the captured continuation runs-to-completion-and-
-    returns instead of escaping — so a restart/non-local exit silently fails
-    and the body falls through (observed as result accumulation / no-abort).
-
-    These callers are NOT a fixed namespace (they are arbitrary user/test code),
-    so they cannot be prefix-excluded. Instead a guest declares its escaping
-    forms here (via [jit-exclude-callers-of!]) and [jit_compile_lambda] skips
-    any function whose constant pool references one of them. *)
-let jit_excluded_caller_names : (string, unit) Hashtbl.t = Hashtbl.create 16
-
-(** {2 JIT cache LRU eviction — Phase 2}
-
-    Once a lambda crosses the threshold, its [l_compiled] slot is filled.
-    To bound memory under unbounded compilation pressure, track all live
-    compiled lambdas in FIFO order, and evict from the head when the count
-    exceeds [jit_budget].
-
-    [lambda_uid_counter] mints unique identities on lambda creation; the
-    LRU queue holds these IDs paired with a back-reference to the lambda
-    so we can clear its [l_compiled] slot on eviction.
-
-    Budget of 0 = no cache (disable JIT entirely).
-    Budget of [max_int] = unbounded (legacy behaviour). Default 5000 is
-    a generous ceiling for any realistic page; the test harness compiles
-    ~3000 distinct one-shot lambdas in a full run but tiered compilation
-    (Phase 1) means most never enter the cache, so steady-state count
-    stays small.
-
-    [lambda_uid_counter] and [next_lambda_uid] are defined above
-    [make_lambda] (which uses them on construction). *)
-let jit_budget = ref 5000
-let jit_evicted_count = ref 0
-
-(** Live compiled lambdas in FIFO order — front is oldest, back is newest.
-    Each entry is (uid, lambda); on eviction we clear lambda.l_compiled and
-    drop from the queue. Using a mutable Queue rather than a hand-rolled
-    linked list because eviction is amortised O(1) at the head and inserts
-    are O(1) at the tail. *)
-let jit_cache_queue : (int * value) Queue.t = Queue.create ()
-let jit_cache_size () = Queue.length jit_cache_queue
+  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None }
 
 let make_component name params has_children body closure affinity =
   let n = value_to_string name in
@@ -588,7 +461,6 @@ let make_keyword name = Keyword (value_to_string name)
 let type_of = function
   | Nil            -> "nil"
   | Bool _         -> "boolean"
-  | Integer _      -> "number"
   | Number _       -> "number"
   | String _       -> "string"
   | Symbol _       -> "symbol"
@@ -601,7 +473,7 @@ let type_of = function
   | Macro _        -> "macro"
   | Thunk _        -> "thunk"
   | Continuation (_, _) -> "continuation"
-  | CallccContinuation (_, _) -> "continuation"
+  | CallccContinuation _ -> "continuation"
   | NativeFn _     -> "function"
   | Signal _       -> "signal"
   | RawHTML _      -> "raw-html"
@@ -616,17 +488,6 @@ let type_of = function
   | Record r       -> r.r_type.rt_name
   | Parameter _    -> "parameter"
   | Vector _       -> "vector"
-  | StringBuffer _ -> "string-buffer"
-  | HashTable _    -> "hash-table"
-  | Char _         -> "char"
-  | Eof            -> "eof-object"
-  | Port { sp_kind = PortInput _; _ }  -> "input-port"
-  | Port { sp_kind = PortOutput _; _ } -> "output-port"
-  | Rational _  -> "rational"
-  | SxSet _          -> "set"
-  | SxRegexp _       -> "regexp"
-  | SxBytevector _   -> "bytevector"
-  | AdtValue a       -> a.av_type
 
 let is_nil = function Nil -> true | _ -> false
 let is_lambda = function Lambda _ -> true | _ -> false
@@ -642,7 +503,7 @@ let is_signal = function
 let is_record = function Record _ -> true | _ -> false
 
 let is_callable = function
-  | Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation (_, _) | VmClosure _ -> true
+  | Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation _ | VmClosure _ -> true
   | _ -> false
 
 
@@ -755,7 +616,6 @@ let thunk_env = function
 (** {1 Record operations} *)
 
 let val_to_int = function
-  | Integer n -> n
   | Number n -> int_of_float n
   | v -> raise (Eval_error ("Expected number, got " ^ type_of v))
 
@@ -904,12 +764,6 @@ 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 []
 
@@ -919,15 +773,13 @@ let dict_vals (d : dict) =
 
 (** {1 Value display} *)
 
-(* Single shared buffer for the entire inspect recursion — eliminates
-   the per-level [String.concat (List.map inspect ...)] allocation. *)
-let rec inspect_into buf = function
-  | Nil -> Buffer.add_string buf "nil"
-  | Bool true -> Buffer.add_string buf "true"
-  | Bool false -> Buffer.add_string buf "false"
-  | Integer n -> Buffer.add_string buf (string_of_int n)
-  | Number n -> Buffer.add_string buf (format_number n)
+let rec inspect = function
+  | Nil -> "nil"
+  | Bool true -> "true"
+  | Bool false -> "false"
+  | Number n -> format_number n
   | String s ->
+    let buf = Buffer.create (String.length s + 2) in
     Buffer.add_char buf '"';
     String.iter (function
       | '"'  -> Buffer.add_string buf "\\\""
@@ -936,129 +788,46 @@ let rec inspect_into buf = function
       | '\r' -> Buffer.add_string buf "\\r"
       | '\t' -> Buffer.add_string buf "\\t"
       | c    -> Buffer.add_char buf c) s;
-    Buffer.add_char buf '"'
-  | Symbol s -> Buffer.add_string buf s
-  | Keyword k -> Buffer.add_char buf ':'; Buffer.add_string buf k
+    Buffer.add_char buf '"';
+    Buffer.contents buf
+  | Symbol s -> s
+  | Keyword k -> ":" ^ k
   | List items | ListRef { contents = items } ->
-    Buffer.add_char buf '(';
-    (match items with
-     | [] -> ()
-     | x :: rest ->
-       inspect_into buf x;
-       List.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) rest);
-    Buffer.add_char buf ')'
+    "(" ^ String.concat " " (List.map inspect items) ^ ")"
   | Dict d ->
-    Buffer.add_char buf '{';
-    let first = ref true in
-    Hashtbl.iter (fun k v ->
-      if !first then first := false else Buffer.add_char buf ' ';
-      Buffer.add_char buf ':'; Buffer.add_string buf k;
-      Buffer.add_char buf ' '; inspect_into buf v) d;
-    Buffer.add_char buf '}'
+    let pairs = Hashtbl.fold (fun k v acc ->
+      (Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in
+    "{" ^ String.concat " " pairs ^ "}"
   | Lambda l ->
     let tag = match l.l_name with Some n -> n | None -> "lambda" in
-    Buffer.add_char buf '<'; Buffer.add_string buf tag;
-    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " l.l_params);
-    Buffer.add_string buf ")>"
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params)
   | Component c ->
-    Buffer.add_string buf "<Component ~"; Buffer.add_string buf c.c_name;
-    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " c.c_params);
-    Buffer.add_string buf ")>"
+    Printf.sprintf "<Component ~%s(%s)>" c.c_name (String.concat ", " c.c_params)
   | Island i ->
-    Buffer.add_string buf "<Island ~"; Buffer.add_string buf i.i_name;
-    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " i.i_params);
-    Buffer.add_string buf ")>"
+    Printf.sprintf "<Island ~%s(%s)>" i.i_name (String.concat ", " i.i_params)
   | Macro m ->
     let tag = match m.m_name with Some n -> n | None -> "macro" in
-    Buffer.add_char buf '<'; Buffer.add_string buf tag;
-    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " m.m_params);
-    Buffer.add_string buf ")>"
-  | Thunk _ -> Buffer.add_string buf "<thunk>"
-  | Continuation (_, _) -> Buffer.add_string buf "<continuation>"
-  | CallccContinuation (_, _) -> Buffer.add_string buf "<callcc-continuation>"
-  | NativeFn (name, _) ->
-    Buffer.add_string buf "<native:"; Buffer.add_string buf name; Buffer.add_char buf '>'
-  | Signal _ -> Buffer.add_string buf "<signal>"
-  | RawHTML s ->
-    Buffer.add_string buf "\"<raw-html:";
-    Buffer.add_string buf (string_of_int (String.length s));
-    Buffer.add_string buf ">\""
-  | Spread _ -> Buffer.add_string buf "<spread>"
-  | SxExpr s ->
-    Buffer.add_string buf "\"<sx-expr:";
-    Buffer.add_string buf (string_of_int (String.length s));
-    Buffer.add_string buf ">\""
-  | Env _ -> Buffer.add_string buf "<env>"
-  | CekState _ -> Buffer.add_string buf "<cek-state>"
-  | CekFrame f ->
-    Buffer.add_string buf "<frame:"; Buffer.add_string buf f.cf_type; Buffer.add_char buf '>'
-  | VmClosure cl ->
-    Buffer.add_string buf "<vm:";
-    Buffer.add_string buf (match cl.vm_name with Some n -> n | None -> "anon");
-    Buffer.add_char buf '>'
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
+  | Thunk _ -> "<thunk>"
+  | Continuation (_, _) -> "<continuation>"
+  | CallccContinuation _ -> "<callcc-continuation>"
+  | NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
+  | Signal _ -> "<signal>"
+  | RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)
+  | Spread _ -> "<spread>"
+  | SxExpr s -> Printf.sprintf "\"<sx-expr:%d>\"" (String.length s)
+  | Env _ -> "<env>"
+  | CekState _ -> "<cek-state>"
+  | CekFrame f -> Printf.sprintf "<frame:%s>" f.cf_type
+  | VmClosure cl -> Printf.sprintf "<vm:%s>" (match cl.vm_name with Some n -> n | None -> "anon")
   | Record r ->
-    Buffer.add_string buf "<record:"; Buffer.add_string buf r.r_type.rt_name;
-    Array.iteri (fun i v ->
-      Buffer.add_char buf ' ';
-      Buffer.add_string buf r.r_type.rt_fields.(i);
-      Buffer.add_char buf '=';
-      inspect_into buf v) r.r_fields;
-    Buffer.add_char buf '>'
-  | Parameter p ->
-    Buffer.add_string buf "<parameter:"; Buffer.add_string buf p.pm_uid; Buffer.add_char buf '>'
+    let fields = Array.to_list (Array.mapi (fun i v ->
+      Printf.sprintf "%s=%s" r.r_type.rt_fields.(i) (inspect v)
+    ) r.r_fields) in
+    Printf.sprintf "<record:%s %s>" r.r_type.rt_name (String.concat " " fields)
+  | Parameter p -> Printf.sprintf "<parameter:%s>" p.pm_uid
   | Vector arr ->
-    Buffer.add_string buf "#(";
-    Array.iteri (fun i v ->
-      if i > 0 then Buffer.add_char buf ' ';
-      inspect_into buf v) arr;
-    Buffer.add_char buf ')'
-  | VmFrame f ->
-    Buffer.add_string buf (Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base)
-  | VmMachine m ->
-    Buffer.add_string buf (Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames))
-  | StringBuffer b ->
-    Buffer.add_string buf (Printf.sprintf "<string-buffer:%d>" (Buffer.length b))
-  | HashTable ht ->
-    Buffer.add_string buf (Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht))
-  | Char n ->
-    Buffer.add_string buf "#\\";
-    (match n with
-     | 32 -> Buffer.add_string buf "space"
-     | 10 -> Buffer.add_string buf "newline"
-     | 9 -> Buffer.add_string buf "tab"
-     | 13 -> Buffer.add_string buf "return"
-     | 0 -> Buffer.add_string buf "nul"
-     | 27 -> Buffer.add_string buf "escape"
-     | 127 -> Buffer.add_string buf "delete"
-     | 8 -> Buffer.add_string buf "backspace"
-     | _ -> Buffer.add_utf_8_uchar buf (Uchar.of_int n))
-  | Eof -> Buffer.add_string buf "#!eof"
-  | Port { sp_kind = PortInput (_, pos); sp_closed } ->
-    Buffer.add_string buf (Printf.sprintf "<input-port:pos=%d%s>" !pos (if sp_closed then ":closed" else ""))
-  | Port { sp_kind = PortOutput b; sp_closed } ->
-    Buffer.add_string buf (Printf.sprintf "<output-port:len=%d%s>" (Buffer.length b) (if sp_closed then ":closed" else ""))
-  | Rational (n, d) ->
-    Buffer.add_string buf (string_of_int n); Buffer.add_char buf '/';
-    Buffer.add_string buf (string_of_int d)
-  | SxSet ht ->
-    Buffer.add_string buf (Printf.sprintf "<set:%d>" (Hashtbl.length ht))
-  | SxRegexp (src, flags, _) ->
-    Buffer.add_string buf "#/"; Buffer.add_string buf src;
-    Buffer.add_char buf '/'; Buffer.add_string buf flags
-  | SxBytevector b ->
-    Buffer.add_string buf "#u8(";
-    let n = Bytes.length b in
-    for i = 0 to n - 1 do
-      if i > 0 then Buffer.add_char buf ' ';
-      Buffer.add_string buf (string_of_int (Char.code (Bytes.get b i)))
-    done;
-    Buffer.add_char buf ')'
-  | AdtValue a ->
-    Buffer.add_char buf '('; Buffer.add_string buf a.av_ctor;
-    Array.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) a.av_fields;
-    Buffer.add_char buf ')'
-
-let inspect v =
-  let buf = Buffer.create 64 in
-  inspect_into buf v;
-  Buffer.contents buf
+    let elts = Array.to_list (Array.map inspect arr) in
+    Printf.sprintf "#(%s)" (String.concat " " elts)
+  | VmFrame f -> Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base
+  | VmMachine m -> Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames)

hosts/ocaml/lib/sx_vm.ml

@@ -44,11 +44,6 @@ type vm = {
     ip past OP_PERFORM, stack ready for a result push). *)
 exception VmSuspended of value * vm
 
-(** Raised by the extension dispatch fallthrough when an opcode in the
-    extension range (≥ 200) is encountered with no handler registered.
-    Carries the offending opcode id. See plans/sx-vm-opcode-extension.md. *)
-exception Invalid_opcode of int
-
 (* Register the VM suspension converter so sx_runtime.sx_apply_cek can
    catch VmSuspended and convert it to CekPerformRequest without a
    direct dependency on this module. *)
@@ -62,24 +57,6 @@ let () = Sx_types._convert_vm_suspension := (fun exn ->
 let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
   ref (fun _ _ -> None)
 
-(** Forward reference for extension opcode dispatch — Phase B installs the
-    real registry's dispatch function here at module init. Until then, any
-    opcode in the extension range raises [Invalid_opcode]. Same forward-ref
-    pattern as [jit_compile_ref] above; keeps [Sx_vm_extensions] free to
-    depend on [Sx_vm]'s [vm] / [frame] types without a cycle. *)
-let extension_dispatch_ref : (int -> vm -> frame -> unit) ref =
-  ref (fun op _vm _frame -> raise (Invalid_opcode op))
-
-(** Forward reference for extension opcode → name lookup, used by
-    [opcode_name] / [disassemble] for human-readable disassembly.  The
-    registry installs a real lookup at module init; default returns
-    [None] (then [opcode_name] falls back to "UNKNOWN_n"). *)
-let extension_opcode_name_ref : (int -> string option) ref =
-  ref (fun _ -> None)
-
-(* JIT threshold and counters live in Sx_types so primitives can read them
-   without creating a sx_primitives → sx_vm dependency cycle. *)
-
 (** Sentinel closure indicating JIT compilation was attempted and failed.
     Prevents retrying compilation on every call. *)
 let jit_failed_sentinel = {
@@ -208,8 +185,7 @@ let code_from_value v =
       | Some _ as r -> r | None -> Hashtbl.find_opt d k2 in
     let bc_list = match find2 "bytecode" "vc-bytecode" with
       | Some (List l | ListRef { contents = l }) ->
-        Array.of_list (List.map (fun x -> match x with
-          | Integer n -> n | Number n -> int_of_float n | _ -> 0) l)
+        Array.of_list (List.map (fun x -> match x with Number n -> int_of_float n | _ -> 0) l)
       | _ -> [||]
     in
     let entries = match find2 "constants" "vc-constants" with
@@ -222,10 +198,10 @@ let code_from_value v =
       | _ -> entry
     ) entries in
     let arity = match find2 "arity" "vc-arity" with
-      | Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> 0
+      | Some (Number n) -> int_of_float n | _ -> 0
     in
     let rest_arity = match find2 "rest-arity" "vc-rest-arity" with
-      | Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> -1
+      | Some (Number n) -> int_of_float n | _ -> -1
     in
     (* Compute locals from bytecode: scan for highest LOCAL_GET/LOCAL_SET slot.
        The compiler's arity may undercount when nested lets add many locals. *)
@@ -336,53 +312,21 @@ 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];
-    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 (req, _) as e ->
-         (match !Sx_types._cek_io_resolver with
-          | Some resolver ->
-            (* Serving path: a `perform` fired inside this HO-primitive
-               callback (map/filter/reduce/for-each/…). The primitive's native
-               OCaml loop sits between us and the resume point, so we CANNOT
-               unwind it and resume later (the loop state would be lost and the
-               remaining elements dropped — corrupting the stack so the next
-               CALL_PRIM sees wrong args). Instead resolve the callback's IO
-               inline and run it to completion right here, returning its value
-               to the native loop exactly as a non-suspending callback would.
-               reuse_stack is isolated so an outer suspension's saved
-               continuations aren't consumed by this nested resume. *)
-            let saved_reuse = vm.reuse_stack in
-            vm.reuse_stack <- [];
-            let rec settle req =
-              let r = resolver req Nil in
-              (try resume_vm vm r
-               with VmSuspended (req2, _) -> settle req2)
-            in
-            let cb = settle req in
-            vm.reuse_stack <- saved_reuse;
-            cb
-          | None ->
-            (* CEK-driven path (no synchronous resolver): preserve the existing
-               behaviour — save the caller's continuation on the reuse stack and
-               re-raise so resume_vm restores it after the callback finishes.
-               DON'T merge frames — that corrupts the frame chain. *)
-            vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
-            raise e)
-       | e ->
-         vm.frames <- saved_frames;
-         vm.sp <- saved_sp;
-         raise e)
-    in
+    (try run vm
+     with
+     | VmSuspended _ as e ->
+       (* IO suspension: save the caller's continuation on the reuse stack.
+          DON'T merge frames — that corrupts the frame chain with nested
+          closures. On resume, restore_reuse in resume_vm processes these
+          in innermost-first order after the callback finishes. *)
+       vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
+       raise e
+     | e ->
+       vm.frames <- saved_frames;
+       vm.sp <- saved_sp;
+       raise e);
     vm.frames <- saved_frames;
-    vm.sp <- saved_sp;
-    result
+    pop vm
   | None ->
     call_closure cl args cl.vm_env_ref
 
@@ -408,29 +352,13 @@ and vm_call vm f args =
      | None ->
        if l.l_name <> None
        then begin
-         l.l_call_count <- l.l_call_count + 1;
-         if l.l_call_count >= !Sx_types.jit_threshold && !Sx_types.jit_budget > 0 then begin
-           l.l_compiled <- Some jit_failed_sentinel;
-           match !jit_compile_ref l vm.globals with
-           | Some cl ->
-             incr Sx_types.jit_compiled_count;
-             l.l_compiled <- Some cl;
-             (* Phase 2 LRU: track this compiled lambda; if cache exceeds budget,
-                evict the oldest by clearing its l_compiled slot. *)
-             Queue.add (l.l_uid, Lambda l) Sx_types.jit_cache_queue;
-             while Queue.length Sx_types.jit_cache_queue > !Sx_types.jit_budget do
-               (match Queue.pop Sx_types.jit_cache_queue with
-                | (_, Lambda ev_l) -> ev_l.l_compiled <- None; incr Sx_types.jit_evicted_count
-                | _ -> ())
-             done;
-             push_closure_frame vm cl args
-           | None ->
-             incr Sx_types.jit_skipped_count;
-             push vm (cek_call_or_suspend vm f (List args))
-         end else begin
-           incr Sx_types.jit_threshold_skipped_count;
+         l.l_compiled <- Some jit_failed_sentinel;
+         match !jit_compile_ref l vm.globals with
+         | Some cl ->
+           l.l_compiled <- Some cl;
+           push_closure_frame vm cl args
+         | None ->
            push vm (cek_call_or_suspend vm f (List args))
-         end
        end
        else
          push vm (cek_call_or_suspend vm f (List args)))
@@ -702,9 +630,7 @@ and run vm =
           (* Read upvalue descriptors from bytecode *)
           let uv_count = match code_val with
             | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-                | Some (Integer n) -> n
-                | Some (Number n) -> int_of_float n
-                | _ -> 0)
+                | Some (Number n) -> int_of_float n | _ -> 0)
             | _ -> 0
           in
           let upvalues = Array.init uv_count (fun _ ->
@@ -804,84 +730,51 @@ and run vm =
         | 160 (* OP_ADD *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y -> Integer (x + y)
             | Number x, Number y -> Number (x +. y)
-            | Integer x, Number y -> Number (float_of_int x +. y)
-            | Number x, Integer y -> Number (x +. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "+") [a; b])
         | 161 (* OP_SUB *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y -> Integer (x - y)
             | Number x, Number y -> Number (x -. y)
-            | Integer x, Number y -> Number (float_of_int x -. y)
-            | Number x, Integer y -> Number (x -. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "-") [a; b])
         | 162 (* OP_MUL *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y -> Integer (x * y)
             | Number x, Number y -> Number (x *. y)
-            | Integer x, Number y -> Number (float_of_int x *. y)
-            | Number x, Integer y -> Number (x *. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "*") [a; b])
         | 163 (* OP_DIV *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y)
-            (* 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
-          (* 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])
+          let rec norm = function
+            | ListRef { contents = l } -> List (List.map norm l)
+            | List l -> List (List.map norm l) | v -> v in
+          push vm (Bool (norm a = norm b))
         | 165 (* OP_LT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y -> Bool (x < y)
             | Number x, Number y -> Bool (x < y)
-            | Integer x, Number y -> Bool (float_of_int x < y)
-            | Number x, Integer y -> Bool (x < float_of_int y)
             | String x, String y -> Bool (x < y)
-            | _ -> Sx_runtime.prim_call "<" [a; b])
+            | _ -> (Hashtbl.find Sx_primitives.primitives "<") [a; b])
         | 166 (* OP_GT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
-            | Integer x, Integer y -> Bool (x > y)
             | Number x, Number y -> Bool (x > y)
-            | Integer x, Number y -> Bool (float_of_int x > y)
-            | Number x, Integer y -> Bool (x > float_of_int y)
             | String x, String y -> Bool (x > y)
-            | _ -> Sx_runtime.prim_call ">" [a; b])
+            | _ -> (Hashtbl.find Sx_primitives.primitives ">") [a; b])
         | 167 (* OP_NOT *) ->
           let v = pop vm in
           push vm (Bool (not (sx_truthy v)))
         | 168 (* OP_LEN *) ->
           let v = pop vm in
           push vm (match v with
-            | List l | ListRef { contents = l } -> Integer (List.length l)
-            | String s -> Integer (String.length s)
-            | Dict d -> Integer (Hashtbl.length d)
-            | Nil -> Integer 0
+            | List l | ListRef { contents = l } -> Number (float_of_int (List.length l))
+            | String s -> Number (float_of_int (String.length s))
+            | Dict d -> Number (float_of_int (Hashtbl.length d))
+            | Nil -> Number 0.0
             | _ -> (Hashtbl.find Sx_primitives.primitives "len") [v])
         | 169 (* OP_FIRST *) ->
           let v = pop vm in
@@ -933,15 +826,6 @@ and run vm =
           let request = pop vm in
           raise (VmSuspended (request, vm))
 
-        (* ---- Extension dispatch fallthrough ----
-           Opcode partition (see plans/sx-vm-opcode-extension.md):
-             0       reserved / NOP
-             1-199   core opcodes (current ceiling 175 = OP_DEC)
-             200-247 extension opcodes (registered via Sx_vm_extensions)
-             248-255 reserved for future expansion / multi-byte
-           Any opcode ≥ 200 routes through the extension registry. *)
-        | op when op >= 200 -> !extension_dispatch_ref op vm frame
-
         | opcode ->
           raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
                                opcode (frame.ip - 1)))
@@ -959,17 +843,7 @@ and run vm =
 
     After the callback finishes, restores any call_closure_reuse
     continuations saved on vm.reuse_stack (innermost first). *)
-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
+let resume_vm vm result =
   (match vm.pending_cek with
    | Some cek_state ->
      vm.pending_cek <- None;
@@ -1013,17 +887,9 @@ and resume_vm vm result =
   let rec restore_reuse pending =
     match pending with
     | [] -> ()
-    | (saved_frames, saved_sp) :: rest ->
+    | (saved_frames, _saved_sp) :: rest ->
       let callback_result = pop vm in
       vm.frames <- saved_frames;
-      (* Restore sp to the value captured before the suspended callee was
-         pushed. The callee's locals/temps may still be on the stack above
-         saved_sp; without this reset, subsequent LOCAL_GET/SET in the
-         caller frame (e.g. letrec sibling bindings waiting on the call)
-         see stale callee data instead of their own slots. Mirrors the
-         OP_RETURN+sp-reset semantics that sync `call_closure_reuse`
-         relies on for clean caller-frame state. *)
-      if saved_sp < vm.sp then vm.sp <- saved_sp;
       push vm callback_result;
       (try
         run vm;
@@ -1041,9 +907,7 @@ and resume_vm vm result =
   let pending = List.rev vm.reuse_stack in
   vm.reuse_stack <- [];
   restore_reuse pending;
-  let r = pop vm in
-  restore (); r
-  with e -> restore (); raise e)
+  pop vm
 
 (** Execute a compiled module (top-level bytecode). *)
 let execute_module code globals =
@@ -1106,105 +970,6 @@ let _jit_is_broken_name n =
   || n = "hs-repeat-while" || n = "hs-repeat-until"
   || n = "hs-for-each" || n = "hs-put!"
 
-(** Scan bytecode for any extension opcode (≥ 200, the registry's
-    [Sx_vm_extensions.extension_min]). Walks operand bytes correctly
-    so values that happen to be ≥200 (e.g. a CONST u16 index pointing
-    into a large pool) do not trigger false positives. CLOSURE's
-    dynamic upvalue descriptors are read from the constant pool entry
-    at the same index it pushes.
-
-    Used by [jit_compile_lambda] (Phase E of the opcode-extension
-    plan): a lambda whose compiled body contains any extension opcode
-    is routed through interpretation rather than JIT.  Extensions
-    interpret their opcodes via the registry; the JIT does not
-    currently know how to compile them.
-
-    Operand-size logic mirrors [opcode_operand_size] (which is defined
-    later, in the disassembly section); inlined here so this helper can
-    sit before [jit_compile_lambda] in the file. *)
-let bytecode_find_opcode (pred : int -> bool) (bc : int array) (consts : value array) =
-  let core_operand_size = function
-    | 1 | 20 | 21 | 64 | 65 | 128 -> 2  (* u16 *)
-    | 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1  (* u8 *)
-    | 32 | 33 | 34 | 35 -> 2  (* i16 *)
-    | 52 -> 3  (* CALL_PRIM: u16 + u8 *)
-    | _ -> 0
-  in
-  let len = Array.length bc in
-  let ip = ref 0 in
-  let found = ref false in
-  while not !found && !ip < len do
-    let op = bc.(!ip) in
-    if pred op then found := true
-    else begin
-      ip := !ip + 1;
-      let extra = match op with
-        | 51 (* CLOSURE *) when !ip + 1 < len ->
-          let lo = bc.(!ip) in
-          let hi = bc.(!ip + 1) in
-          let idx = lo lor (hi lsl 8) in
-          let uv_count =
-            if idx < Array.length consts then
-              (match consts.(idx) with
-               | Dict d ->
-                 (match Hashtbl.find_opt d "upvalue-count" with
-                  | Some (Integer n) -> n
-                  | Some (Number n) -> int_of_float n
-                  | _ -> 0)
-               | _ -> 0)
-            else 0
-          in
-          2 + uv_count * 2
-        | _ -> core_operand_size op
-      in
-      ip := !ip + extra
-    end
-  done;
-  !found
-
-let bytecode_uses_extension_opcodes bc consts =
-  bytecode_find_opcode (fun op -> op >= 200) bc consts
-
-(** True if [code] — or any closure nested in its constant pool — installs an
-    exception handler (OP_PUSH_HANDLER = 35), i.e. contains a `guard` /
-    `handler-bind` / dream-catch form. The VM's PUSH_HANDLER only intercepts a
-    VM-level RAISE (opcode 37); it does NOT catch the OCaml [Eval_error] that
-    the `error` primitive throws from inside a CALL/CALL_PRIM in a callee
-    frame. So a JIT-compiled guard silently fails to catch thrown errors (they
-    escape across the JIT frame).
-
-    The scan is RECURSIVE: a curried higher-order function (e.g. Dream's
-    `dream-catch-with = (fn (on-error) (fn (next) (fn (req) (guard ...))))`)
-    has no PUSH_HANDLER in its own body — the guard lives in a nested
-    `OP_CLOSURE` whose code sits in the constant pool. JIT-compiling the outer
-    function would mint that inner guard as a VmClosure with the broken VM
-    handler. Descending into nested closure codes catches this, so the whole
-    closure family runs on the CEK (whose guard catches correctly). Covers
-    dream-catch-with, host wrap-errors, and every guard user centrally. *)
-let rec code_uses_handler code =
-  bytecode_find_opcode (fun op -> op = 35) code.vc_bytecode code.vc_constants
-  || Array.exists (fun c ->
-       match c with
-       | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
-         (try code_uses_handler (code_from_value c) with _ -> false)
-       | _ -> false) code.vc_constants
-
-(** True if [code] — or any nested closure code — references (in its constant
-    pool, as a GLOBAL_GET/CALL name) a function registered in
-    [Sx_types.jit_excluded_caller_names] (a call/cc-establishing form like
-    Common-Lisp's cl-restart-case/cl-handler-case). Such a caller must run on
-    the CEK so the continuation captured inside the called form can escape.
-    The constant-pool string IS the referenced symbol name, so membership is a
-    direct lookup; recurse into nested closure codes. Skipped entirely (no
-    Hashtbl walk) when no escaping forms are registered. *)
-let rec code_refs_escaping_caller code =
-  Array.exists (fun c ->
-    match c with
-    | String s -> Hashtbl.mem Sx_types.jit_excluded_caller_names s
-    | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
-      (try code_refs_escaping_caller (code_from_value c) with _ -> false)
-    | _ -> false) code.vc_constants
-
 let jit_compile_lambda (l : lambda) globals =
   let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
   if !_jit_compiling then (
@@ -1220,13 +985,6 @@ 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;
@@ -1274,32 +1032,8 @@ let jit_compile_lambda (l : lambda) globals =
         if idx < Array.length outer_code.vc_constants then
           let inner_val = outer_code.vc_constants.(idx) in
           let code = code_from_value inner_val in
-          (* Phase E: if the inner lambda's bytecode contains any
-             extension opcode (≥200), skip JIT and let the lambda run
-             interpreted via CEK. Extension opcodes dispatch correctly
-             through the VM's registry fallthrough, but the JIT has no
-             knowledge of them and shouldn't claim ownership. *)
-          if bytecode_uses_extension_opcodes code.vc_bytecode code.vc_constants then begin
-            Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!"
-              fn_name;
-            None
-          end else if code_uses_handler code then begin
-            (* guard / handler-bind (possibly in a nested closure): VM
-               PUSH_HANDLER doesn't catch the `error` primitive's OCaml
-               exception across frames — run on the CEK. *)
-            Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
-              fn_name;
-            None
-          end else if Hashtbl.length Sx_types.jit_excluded_caller_names > 0
-                      && code_refs_escaping_caller code then begin
-            (* Calls a call/cc-establishing form (e.g. cl-restart-case): must
-               run on the CEK so the captured continuation can escape. *)
-            Printf.eprintf "[jit] SKIP %s: calls a call/cc-establishing form — interpret-only\n%!"
-              fn_name;
-            None
-          end else
-            Some { vm_code = code; vm_upvalues = [||];
-                   vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }
+          Some { vm_code = code; vm_upvalues = [||];
+                 vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }
         else begin
           Printf.eprintf "[jit] FAIL %s: closure index %d out of bounds (pool=%d)\n%!"
             fn_name idx (Array.length outer_code.vc_constants);
@@ -1409,12 +1143,7 @@ let opcode_name = function
   | 164 -> "EQ" | 165 -> "LT" | 166 -> "GT" | 167 -> "NOT"
   | 168 -> "LEN" | 169 -> "FIRST" | 170 -> "REST" | 171 -> "NTH"
   | 172 -> "CONS" | 173 -> "NEG" | 174 -> "INC" | 175 -> "DEC"
-  | n ->
-    (* Extension opcodes (≥200) get their human-readable name from the
-       registry; defaults to UNKNOWN_n if the extension isn't loaded. *)
-    (match !extension_opcode_name_ref n with
-     | Some name -> name
-     | None -> Printf.sprintf "UNKNOWN_%d" n)
+  | n -> Printf.sprintf "UNKNOWN_%d" n
 
 (** Number of extra operand bytes consumed by each opcode.
     Returns (format, total_bytes) where format describes the operand types. *)
@@ -1542,9 +1271,7 @@ let trace_run src globals =
             let code_val2 = frame.closure.vm_code.vc_constants.(idx) in
             let uv_count = match code_val2 with
               | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-                  | Some (Integer n) -> n
-                  | Some (Number n) -> int_of_float n
-                  | _ -> 0)
+                  | Some (Number n) -> int_of_float n | _ -> 0)
               | _ -> 0 in
             let upvalues = Array.init uv_count (fun _ ->
               let is_local = read_u8 frame in
@@ -1665,9 +1392,7 @@ let disassemble (code : vm_code) =
         if op = 51 && idx < Array.length consts then begin
           let uv_count = match consts.(idx) with
             | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-                | Some (Integer n) -> n
-                | Some (Number n) -> int_of_float n
-                | _ -> 0)
+                | Some (Number n) -> int_of_float n | _ -> 0)
             | _ -> 0 in
           ip := !ip + uv_count * 2
         end

hosts/ocaml/lib/sx_vm_extension.ml

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

hosts/ocaml/lib/sx_vm_extensions.ml

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

hosts/ocaml/lib/sx_vm_ref.ml

@@ -270,9 +270,7 @@ let vm_create_closure vm_val frame_val code_val =
   let f = unwrap_frame frame_val in
   let uv_count = match code_val with
     | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-        | Some (Integer n) -> n
-        | Some (Number n) -> int_of_float n
-        | _ -> 0)
+        | Some (Number n) -> int_of_float n | _ -> 0)
     | _ -> 0
   in
   let upvalues = Array.init uv_count (fun _ ->

hosts/ocaml/sx_vm_ref.ml

@@ -265,9 +265,7 @@ let vm_create_closure vm_val frame_val code_val =
   let f = unwrap_frame frame_val in
   let uv_count = match code_val with
     | Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
-        | Some (Integer n) -> n
-        | Some (Number n) -> int_of_float n
-        | _ -> 0)
+        | Some (Number n) -> int_of_float n | _ -> 0)
     | _ -> 0
   in
   let upvalues = Array.init uv_count (fun _ ->

hosts/ocaml/test/persist_durable_test.sh

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

hosts/ocaml/transpiler.sx

@@ -256,7 +256,6 @@
     "callcc-continuation?"
     "callcc-continuation-data"
     "make-callcc-continuation"
-    "callcc-continuation-winders-len"
     "dynamic-wind-call"
     "strip-prefix"
     "component-set-param-types!"
@@ -296,8 +295,7 @@
     "*bind-tracking*"
     "*provide-batch-depth*"
     "*provide-batch-queue*"
-    "*provide-subscribers*"
-    "*winders*"))
+    "*provide-subscribers*"))
 
 (define
   ml-is-mutable-global?
@@ -535,13 +533,13 @@
               "; cf_env = "
               (ef "env")
               "; cf_name = "
-              (if (= frame-type "if") (ef "else") (cond (some (fn (k) (= k "body-result")) items) (ef "body-result") :else (ef "name")))
+              (if (= frame-type "if") (ef "else") (ef "name"))
               "; cf_body = "
               (if (= frame-type "if") (ef "then") (ef "body"))
               "; cf_remaining = "
               (ef "remaining")
               "; cf_f = "
-              (cond (some (fn (k) (= k "after-thunk")) items) (ef "after-thunk") (some (fn (k) (= k "f")) items) (ef "f") :else "Nil")
+              (ef "f")
               "; cf_args = "
               (cond
                 (some (fn (k) (= k "evaled")) items)
@@ -584,8 +582,6 @@
                 (ef "prev-tracking")
                 (some (fn (k) (= k "extra")) items)
                 (ef "extra")
-                (some (fn (k) (= k "winders-len")) items)
-                (ef "winders-len")
                 :else "Nil")
               "; cf_extra2 = "
               (cond
@@ -956,13 +952,7 @@
               (= op "starts-with?")
               (= op "ends-with?")
               (= op "string-contains?")
-              (= op "string-length")
-              (= op "vector?")
-              (= op "vector->list")
-              (= op "list->vector")
-              (= op "vector-length")
-              (= op "vector-ref")
-              (= op "gensym"))
+              (= op "string-length"))
             (str
               "(prim_call "
               (ml-quote-string op)

lib/acl/api.sx

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

lib/acl/audit.sx

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

lib/acl/conformance.conf

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

lib/acl/conformance.sh

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

lib/acl/engine.sx

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

lib/acl/explain.sx

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

lib/acl/facts.sx

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

lib/acl/federation.sx

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

lib/acl/schema.sx

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

lib/acl/scoreboard.json

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

lib/acl/scoreboard.md

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

lib/acl/tests/direct.sx

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

lib/acl/tests/explain.sx

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

lib/acl/tests/fed.sx

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

lib/acl/tests/harden.sx

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

lib/acl/tests/inherit.sx

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

lib/agentic/branch.sx

@@ -1,317 +0,0 @@
-; 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

@@ -1,191 +0,0 @@
-#!/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

@@ -1,235 +0,0 @@
-; 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

@@ -1,160 +0,0 @@
-; 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

@@ -1,11 +0,0 @@
-{
-  "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

@@ -1,11 +0,0 @@
-# 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

@@ -1,333 +0,0 @@
-; 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

@@ -1,281 +0,0 @@
-; 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

@@ -1,326 +0,0 @@
-; 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

@@ -1,289 +0,0 @@
-; 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

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

lib/apl/conformance.conf

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

lib/apl/conformance.sh

@@ -1,5 +0,0 @@
-#!/usr/bin/env bash
-# lib/apl/conformance.sh — APL conformance via the shared guest driver.
-# Config lives in lib/apl/conformance.conf (MODE=counters). Override the binary
-# with SX_SERVER=path/to/sx_server.exe bash lib/apl/conformance.sh
-exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/apl/parser.sx

@@ -1,711 +0,0 @@
-; APL Parser — right-to-left expression parser
-;
-; Takes a token list (output of apl-tokenize) and produces an AST.
-; APL evaluates right-to-left with no precedence among functions.
-; Operators bind to the function immediately to their left in the source.
-;
-; AST node types:
-;   (:num n)                     number literal
-;   (:str s)                     string literal
-;   (:vec n1 n2 ...)             strand (juxtaposed literals)
-;   (:name "x")                  name reference / alpha / omega
-;   (:assign "x" expr)           assignment  x←expr
-;   (:monad fn arg)              monadic function call
-;   (:dyad fn left right)        dyadic function call
-;   (:derived-fn op fn)          derived function: f/ f¨ f⍨
-;   (:derived-fn2 "." f g)       inner product: f.g
-;   (:outer "∘." fn)             outer product: ∘.f
-;   (:fn-glyph "⍳")             function reference
-;   (:fn-name "foo")             named-function reference (dfn variable)
-;   (:dfn stmt...)               {⍺+⍵} anonymous function
-;   (:guard cond expr)           cond:expr guard inside dfn
-;   (:program stmt...)           multi-statement sequence
-
-; ============================================================
-; Glyph classification sets
-; ============================================================
-
-(define
-  apl-parse-op-glyphs
-  (list "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
-
-(define
-  apl-parse-fn-glyphs
-  (list
-    "+"
-    "-"
-    "×"
-    "÷"
-    "*"
-    "⍟"
-    "⌈"
-    "⌊"
-    "|"
-    "!"
-    "?"
-    "○"
-    "~"
-    "<"
-    "≤"
-    "="
-    "≥"
-    ">"
-    "≠"
-    "≢"
-    "≡"
-    "∊"
-    "∧"
-    "∨"
-    "⍱"
-    "⍲"
-    ","
-    "⍪"
-    "⍴"
-    "⌽"
-    "⊖"
-    "⍉"
-    "↑"
-    "↓"
-    "⊂"
-    "⊃"
-    "⊆"
-    "∪"
-    "∩"
-    "⍳"
-    "⍸"
-    "⌷"
-    "⍋"
-    "⍒"
-    "⊥"
-    "⊤"
-    "⊣"
-    "⊢"
-    "⍎"
-    "⍕"))
-
-(define apl-quad-fn-names (list "⎕FMT" "⎕←"))
-
-(define apl-known-fn-names (list))
-
-; ============================================================
-; Token accessors
-; ============================================================
-
-(define
-  apl-collect-fn-bindings
-  (fn
-    (stmt-groups)
-    (set! apl-known-fn-names (list))
-    (for-each
-      (fn
-        (toks)
-        (when
-          (and
-            (>= (len toks) 3)
-            (= (tok-type (nth toks 0)) :name)
-            (= (tok-type (nth toks 1)) :assign)
-            (= (tok-type (nth toks 2)) :lbrace))
-          (set!
-            apl-known-fn-names
-            (cons (tok-val (nth toks 0)) apl-known-fn-names))))
-      stmt-groups)))
-
-(define
-  apl-parse-op-glyph?
-  (fn (v) (some (fn (g) (= g v)) apl-parse-op-glyphs)))
-
-(define
-  apl-parse-fn-glyph?
-  (fn (v) (some (fn (g) (= g v)) apl-parse-fn-glyphs)))
-
-(define tok-type (fn (tok) (get tok :type)))
-
-; ============================================================
-; Collect trailing operators starting at index i
-; Returns {:ops (op ...) :end new-i}
-; ============================================================
-
-(define tok-val (fn (tok) (get tok :value)))
-
-(define
-  is-op-tok?
-  (fn
-    (tok)
-    (and (= (tok-type tok) :glyph) (apl-parse-op-glyph? (tok-val tok)))))
-
-; ============================================================
-; Build a derived-fn node by chaining operators left-to-right
-; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
-; ============================================================
-
-(define
-  is-fn-tok?
-  (fn
-    (tok)
-    (or
-      (and (= (tok-type tok) :glyph) (apl-parse-fn-glyph? (tok-val tok)))
-      (and
-        (= (tok-type tok) :name)
-        (or
-          (some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)
-          (some (fn (q) (= q (tok-val tok))) apl-known-fn-names))))))
-
-; ============================================================
-; Find matching close bracket/paren/brace
-; Returns the index of the matching close token
-; ============================================================
-
-(define collect-ops (fn (tokens i) (collect-ops-loop tokens i (list))))
-
-(define
-  collect-ops-loop
-  (fn
-    (tokens i acc)
-    (if
-      (>= i (len tokens))
-      {:end i :ops acc}
-      (let
-        ((tok (nth tokens i)))
-        (if
-          (is-op-tok? tok)
-          (collect-ops-loop tokens (+ i 1) (append acc (tok-val tok)))
-          {:end i :ops acc})))))
-
-; ============================================================
-; Segment collection: scan tokens left-to-right, building
-; a list of {:kind "val"/"fn" :node ast} segments.
-; Operators following function glyphs are merged into
-; derived-fn nodes during this pass.
-; ============================================================
-
-(define
-  build-derived-fn
-  (fn
-    (fn-node ops)
-    (if
-      (= (len ops) 0)
-      fn-node
-      (build-derived-fn (list :derived-fn (first ops) fn-node) (rest ops)))))
-
-(define
-  find-matching-close
-  (fn
-    (tokens start open-type close-type)
-    (find-matching-close-loop tokens start open-type close-type 1)))
-
-; ============================================================
-; Build tree from segment list
-;
-; The segments are in left-to-right order.
-; APL evaluates right-to-left, so the LEFTMOST function is
-; the outermost (last-evaluated) node.
-;
-; Patterns:
-;   [val]              → val node
-;   [fn val ...]       → (:monad fn (build-tree rest))
-;   [val fn val ...]   → (:dyad fn val (build-tree rest))
-;   [val val ...]      → (:vec val1 val2 ...) — strand
-; ============================================================
-
-; Find the index of the first function segment (returns -1 if none)
-(define
-  find-matching-close-loop
-  (fn
-    (tokens i open-type close-type depth)
-    (if
-      (>= i (len tokens))
-      (len tokens)
-      (let
-        ((tt (tok-type (nth tokens i))))
-        (cond
-          ((= tt open-type)
-            (find-matching-close-loop
-              tokens
-              (+ i 1)
-              open-type
-              close-type
-              (+ depth 1)))
-          ((= tt close-type)
-            (if
-              (= depth 1)
-              i
-              (find-matching-close-loop
-                tokens
-                (+ i 1)
-                open-type
-                close-type
-                (- depth 1))))
-          (true
-            (find-matching-close-loop
-              tokens
-              (+ i 1)
-              open-type
-              close-type
-              depth)))))))
-
-(define
-  collect-segments
-  (fn (tokens) (collect-segments-loop tokens 0 (list))))
-
-; Build an array node from 0..n value segments
-; If n=1 → return that segment's node
-; If n>1 → return (:vec node1 node2 ...)
-(define
-  collect-segments-loop
-  (fn
-    (tokens i acc)
-    (if
-      (>= i (len tokens))
-      acc
-      (let
-        ((tok (nth tokens i)) (n (len tokens)))
-        (let
-          ((tt (tok-type tok)) (tv (tok-val tok)))
-          (cond
-            ((or (= tt :diamond) (= tt :newline) (= tt :semi))
-              (collect-segments-loop tokens (+ i 1) acc))
-            ((= tt :num)
-              (collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :num tv)})))
-            ((= tt :str)
-              (collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :str tv)})))
-            ((= tt :name)
-              (cond
-                ((and (< (+ i 1) (len tokens)) (= (tok-type (nth tokens (+ i 1))) :assign))
-                  (let
-                    ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
-                    (let
-                      ((rhs-expr (parse-apl-expr rhs-tokens)))
-                      (collect-segments-loop
-                        tokens
-                        (len tokens)
-                        (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)})))))
-                ((some (fn (q) (= q tv)) apl-quad-fn-names)
-                  (let
-                    ((op-result (collect-ops tokens (+ i 1))))
-                    (let
-                      ((ops (get op-result :ops))
-                        (ni (get op-result :end)))
-                      (let
-                        ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
-                        (collect-segments-loop
-                          tokens
-                          ni
-                          (append acc {:kind "fn" :node fn-node}))))))
-                ((some (fn (q) (= q tv)) apl-known-fn-names)
-                  (let
-                    ((op-result (collect-ops tokens (+ i 1))))
-                    (let
-                      ((ops (get op-result :ops))
-                        (ni (get op-result :end)))
-                      (let
-                        ((fn-node (build-derived-fn (list :fn-name tv) ops)))
-                        (collect-segments-loop
-                          tokens
-                          ni
-                          (append acc {:kind "fn" :node fn-node}))))))
-                (else
-                  (let
-                    ((br (maybe-bracket (list :name tv) tokens (+ i 1))))
-                    (collect-segments-loop
-                      tokens
-                      (nth br 1)
-                      (append acc {:kind "val" :node (nth br 0)}))))))
-            ((= tt :lparen)
-              (let
-                ((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
-                (let
-                  ((inner-tokens (slice tokens (+ i 1) end))
-                    (after (+ end 1)))
-                  (let
-                    ((inner-segs (collect-segments inner-tokens)))
-                    (if
-                      (and
-                        (>= (len inner-segs) 2)
-                        (every? (fn (s) (= (get s :kind) "fn")) inner-segs))
-                      (let
-                        ((train-node (cons :train (map (fn (s) (get s :node)) inner-segs))))
-                        (collect-segments-loop
-                          tokens
-                          after
-                          (append acc {:kind "fn" :node train-node})))
-                      (let
-                        ((br (maybe-bracket (parse-apl-expr inner-tokens) tokens after)))
-                        (collect-segments-loop
-                          tokens
-                          (nth br 1)
-                          (append acc {:kind "val" :node (nth br 0)}))))))))
-            ((= tt :lbrace)
-              (let
-                ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace)))
-                (let
-                  ((inner-tokens (slice tokens (+ i 1) end))
-                    (after (+ end 1)))
-                  (collect-segments-loop tokens after (append acc {:kind "fn" :node (parse-dfn inner-tokens)})))))
-            ((= tt :glyph)
-              (cond
-                ((or (= tv "⍺") (= tv "⍵"))
-                  (if
-                    (and
-                      (< (+ i 1) (len tokens))
-                      (= (tok-type (nth tokens (+ i 1))) :assign))
-                    (let
-                      ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
-                      (let
-                        ((rhs-expr (parse-apl-expr rhs-tokens)))
-                        (collect-segments-loop
-                          tokens
-                          (len tokens)
-                          (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)}))))
-                    (collect-segments-loop
-                      tokens
-                      (+ i 1)
-                      (append acc {:kind "val" :node (list :name tv)}))))
-                ((= tv "∇")
-                  (collect-segments-loop
-                    tokens
-                    (+ i 1)
-                    (append acc {:kind "fn" :node (list :fn-glyph "∇")})))
-                ((and (= tv "∘") (< (+ i 1) n) (= (tok-val (nth tokens (+ i 1))) "."))
-                  (if
-                    (and (< (+ i 2) n) (is-fn-tok? (nth tokens (+ i 2))))
-                    (let
-                      ((fn-tv (tok-val (nth tokens (+ i 2)))))
-                      (let
-                        ((op-result (collect-ops tokens (+ i 3))))
-                        (let
-                          ((ops (get op-result :ops))
-                            (ni (get op-result :end)))
-                          (let
-                            ((fn-node (build-derived-fn (list :fn-glyph fn-tv) ops)))
-                            (collect-segments-loop
-                              tokens
-                              ni
-                              (append acc {:kind "fn" :node (list :outer "∘." fn-node)}))))))
-                    (collect-segments-loop tokens (+ i 1) acc)))
-                ((apl-parse-fn-glyph? tv)
-                  (let
-                    ((op-result (collect-ops tokens (+ i 1))))
-                    (let
-                      ((ops (get op-result :ops))
-                        (ni (get op-result :end)))
-                      (if
-                        (and
-                          (= (len ops) 1)
-                          (= (first ops) ".")
-                          (< ni n)
-                          (is-fn-tok? (nth tokens ni)))
-                        (let
-                          ((g-tv (tok-val (nth tokens ni))))
-                          (let
-                            ((op-result2 (collect-ops tokens (+ ni 1))))
-                            (let
-                              ((ops2 (get op-result2 :ops))
-                                (ni2 (get op-result2 :end)))
-                              (let
-                                ((g-node (build-derived-fn (list :fn-glyph g-tv) ops2)))
-                                (collect-segments-loop
-                                  tokens
-                                  ni2
-                                  (append acc {:kind "fn" :node (list :derived-fn2 "." (list :fn-glyph tv) g-node)}))))))
-                        (let
-                          ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
-                          (collect-segments-loop
-                            tokens
-                            ni
-                            (append acc {:kind "fn" :node fn-node})))))))
-                ((apl-parse-op-glyph? tv)
-                  (if
-                    (or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀"))
-                    (let
-                      ((next-i (+ i 1)))
-                      (let
-                        ((next-tok (if (< next-i n) (nth tokens next-i) nil)))
-                        (let
-                          ((mod (if (and next-tok (= (tok-type next-tok) :glyph) (or (= (get next-tok :value) "⍨") (= (get next-tok :value) "¨"))) (get next-tok :value) nil))
-                            (base-fn-node (list :fn-glyph tv)))
-                          (let
-                            ((node (if mod (list :derived-fn mod base-fn-node) base-fn-node))
-                              (advance (if mod 2 1)))
-                            (collect-segments-loop
-                              tokens
-                              (+ i advance)
-                              (append acc {:kind "fn" :node node}))))))
-                    (collect-segments-loop tokens (+ i 1) acc)))
-                (true (collect-segments-loop tokens (+ i 1) acc))))
-            (true (collect-segments-loop tokens (+ i 1) acc))))))))
-
-(define find-first-fn (fn (segs) (find-first-fn-loop segs 0)))
-
-
-; ============================================================
-; Split token list on statement separators (diamond / newline)
-; Only splits at depth 0 (ignores separators inside { } or ( ) )
-; ============================================================
-
-(define
-  find-first-fn-loop
-  (fn
-    (segs i)
-    (if
-      (>= i (len segs))
-      -1
-      (if
-        (= (get (nth segs i) :kind) "fn")
-        i
-        (find-first-fn-loop segs (+ i 1))))))
-
-(define
-  segs-to-array
-  (fn
-    (segs)
-    (if
-      (= (len segs) 1)
-      (get (first segs) :node)
-      (cons :vec (map (fn (s) (get s :node)) segs)))))
-
-; ============================================================
-; Parse a dfn body (tokens between { and })
-; Handles guard expressions: cond : expr
-; ============================================================
-
-(define
-  build-tree
-  (fn
-    (segs)
-    (cond
-      ((= (len segs) 0) nil)
-      ((= (len segs) 1) (get (first segs) :node))
-      ((every? (fn (s) (= (get s :kind) "val")) segs)
-        (segs-to-array segs))
-      (true
-        (let
-          ((fn-idx (find-first-fn segs)))
-          (cond
-            ((= fn-idx -1) (segs-to-array segs))
-            ((= fn-idx 0)
-              (list
-                :monad (get (first segs) :node)
-                (build-tree (rest segs))))
-            (true
-              (let
-                ((left-segs (slice segs 0 fn-idx))
-                  (fn-seg (nth segs fn-idx))
-                  (right-segs (slice segs (+ fn-idx 1))))
-                (list
-                  :dyad (get fn-seg :node)
-                  (segs-to-array left-segs)
-                  (build-tree right-segs))))))))))
-
-(define
-  split-statements
-  (fn (tokens) (split-statements-loop tokens (list) (list) 0)))
-
-(define
-  split-statements-loop
-  (fn
-    (tokens current-stmt acc depth)
-    (if
-      (= (len tokens) 0)
-      (if (> (len current-stmt) 0) (append acc (list current-stmt)) acc)
-      (let
-        ((tok (first tokens))
-          (rest-toks (rest tokens))
-          (tt (tok-type (first tokens))))
-        (cond
-          ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
-            (split-statements-loop
-              rest-toks
-              (append current-stmt tok)
-              acc
-              (+ depth 1)))
-          ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
-            (split-statements-loop
-              rest-toks
-              (append current-stmt tok)
-              acc
-              (- depth 1)))
-          ((and (> depth 0) (or (= tt :diamond) (= tt :newline)))
-            (split-statements-loop
-              rest-toks
-              (append current-stmt tok)
-              acc
-              depth))
-          ((and (= depth 0) (or (= tt :diamond) (= tt :newline)))
-            (if
-              (> (len current-stmt) 0)
-              (split-statements-loop
-                rest-toks
-                (list)
-                (append acc (list current-stmt))
-                depth)
-              (split-statements-loop rest-toks (list) acc depth)))
-          (true
-            (split-statements-loop
-              rest-toks
-              (append current-stmt tok)
-              acc
-              depth)))))))
-
-(define
-  parse-dfn
-  (fn
-    (tokens)
-    (let
-      ((stmt-groups (split-statements tokens)))
-      (let ((stmts (map parse-dfn-stmt stmt-groups))) (cons :dfn stmts)))))
-
-; ============================================================
-; Parse a single statement (assignment or expression)
-; ============================================================
-
-(define
-  parse-dfn-stmt
-  (fn
-    (tokens)
-    (let
-      ((colon-idx (find-top-level-colon tokens 0)))
-      (if
-        (>= colon-idx 0)
-        (let
-          ((cond-tokens (slice tokens 0 colon-idx))
-            (body-tokens (slice tokens (+ colon-idx 1))))
-          (list
-            :guard (parse-apl-expr cond-tokens)
-            (parse-apl-expr body-tokens)))
-        (parse-stmt tokens)))))
-
-; ============================================================
-; Parse an expression from a flat token list
-; ============================================================
-
-(define
-  find-top-level-colon
-  (fn (tokens i) (find-top-level-colon-loop tokens i 0)))
-
-; ============================================================
-; Main entry point
-; parse-apl: string → AST
-; ============================================================
-
-(define
-  find-top-level-colon-loop
-  (fn
-    (tokens i depth)
-    (if
-      (>= i (len tokens))
-      -1
-      (let
-        ((tok (nth tokens i)) (tt (tok-type (nth tokens i))))
-        (cond
-          ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
-            (find-top-level-colon-loop tokens (+ i 1) (+ depth 1)))
-          ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
-            (find-top-level-colon-loop tokens (+ i 1) (- depth 1)))
-          ((and (= tt :colon) (= depth 0)) i)
-          (true (find-top-level-colon-loop tokens (+ i 1) depth)))))))
-
-(define
-  parse-stmt
-  (fn
-    (tokens)
-    (if
-      (and
-        (>= (len tokens) 2)
-        (= (tok-type (nth tokens 0)) :name)
-        (= (tok-type (nth tokens 1)) :assign))
-      (list
-        :assign (tok-val (nth tokens 0))
-        (parse-apl-expr (slice tokens 2)))
-      (parse-apl-expr tokens))))
-
-(define
-  parse-apl-expr
-  (fn
-    (tokens)
-    (let
-      ((segs (collect-segments tokens)))
-      (if (= (len segs) 0) nil (build-tree segs)))))
-
-(define
-  parse-apl
-  (fn
-    (src)
-    (let
-      ((tokens (apl-tokenize src)))
-      (let
-        ((stmt-groups (split-statements tokens)))
-        (begin
-          (apl-collect-fn-bindings stmt-groups)
-          (if
-            (= (len stmt-groups) 0)
-            nil
-            (if
-              (= (len stmt-groups) 1)
-              (parse-stmt (first stmt-groups))
-              (cons :program (map parse-stmt stmt-groups)))))))))
-
-(define
-  split-bracket-loop
-  (fn
-    (tokens current acc depth)
-    (if
-      (= (len tokens) 0)
-      (append acc (list current))
-      (let
-        ((tok (first tokens)) (more (rest tokens)))
-        (let
-          ((tt (tok-type tok)))
-          (cond
-            ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
-              (split-bracket-loop
-                more
-                (append current (list tok))
-                acc
-                (+ depth 1)))
-            ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
-              (split-bracket-loop
-                more
-                (append current (list tok))
-                acc
-                (- depth 1)))
-            ((and (= tt :semi) (= depth 0))
-              (split-bracket-loop
-                more
-                (list)
-                (append acc (list current))
-                depth))
-            (else
-              (split-bracket-loop more (append current (list tok)) acc depth))))))))
-
-(define
-  split-bracket-content
-  (fn (tokens) (split-bracket-loop tokens (list) (list) 0)))
-
-(define
-  maybe-bracket
-  (fn
-    (val-node tokens after)
-    (if
-      (and
-        (< after (len tokens))
-        (= (tok-type (nth tokens after)) :lbracket))
-      (let
-        ((end (find-matching-close tokens (+ after 1) :lbracket :rbracket)))
-        (let
-          ((inner-tokens (slice tokens (+ after 1) end))
-            (next-after (+ end 1)))
-          (let
-            ((sections (split-bracket-content inner-tokens)))
-            (if
-              (= (len sections) 1)
-              (let
-                ((idx-expr (parse-apl-expr inner-tokens)))
-                (let
-                  ((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
-                  (maybe-bracket indexed tokens next-after)))
-              (let
-                ((axis-exprs (map (fn (toks) (if (= (len toks) 0) :all (parse-apl-expr toks))) sections)))
-                (let
-                  ((indexed (cons :bracket (cons val-node axis-exprs))))
-                  (maybe-bracket indexed tokens next-after)))))))
-      (list val-node after))))

lib/apl/scoreboard.json

@@ -1,17 +0,0 @@
-{
-  "suites": {
-    "structural": {"pass": 94, "fail": 0},
-    "operators": {"pass": 117, "fail": 0},
-    "dfn": {"pass": 24, "fail": 0},
-    "tradfn": {"pass": 25, "fail": 0},
-    "valence": {"pass": 14, "fail": 0},
-    "programs": {"pass": 45, "fail": 0},
-    "system": {"pass": 13, "fail": 0},
-    "idioms": {"pass": 64, "fail": 0},
-    "eval-ops": {"pass": 14, "fail": 0},
-    "pipeline": {"pass": 152, "fail": 0}
-  },
-  "total_pass": 562,
-  "total_fail": 0,
-  "total": 562
-}

lib/apl/scoreboard.md

@@ -1,22 +0,0 @@
-# APL Conformance Scoreboard
-
-_Generated by `lib/apl/conformance.sh`_
-
-| Suite | Pass | Fail | Total |
-|-------|-----:|-----:|------:|
-| structural | 94 | 0 | 94 |
-| operators | 117 | 0 | 117 |
-| dfn | 24 | 0 | 24 |
-| tradfn | 25 | 0 | 25 |
-| valence | 14 | 0 | 14 |
-| programs | 45 | 0 | 45 |
-| system | 13 | 0 | 13 |
-| idioms | 64 | 0 | 64 |
-| eval-ops | 14 | 0 | 14 |
-| pipeline | 152 | 0 | 152 |
-| **Total** | **562** | **0** | **562** |
-
-## Notes
-
-- Suites use the standard `apl-test name got expected` framework loaded against `lib/apl/runtime.sx` + `lib/apl/transpile.sx`.
-- `lib/apl/tests/parse.sx` and `lib/apl/tests/scalar.sx` use their own self-contained frameworks and are excluded from this scoreboard.

lib/apl/test-harness.sx

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

lib/apl/test.sh

@@ -1,70 +0,0 @@
-#!/usr/bin/env bash
-# lib/apl/test.sh — smoke-test the APL runtime layer.
-
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then
-  echo "ERROR: sx_server.exe not found."
-  exit 1
-fi
-
-TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
-
-cat > "$TMPFILE" << 'EPOCHS'
-(epoch 1)
-(load "spec/stdlib.sx")
-(load "lib/r7rs.sx")
-(load "lib/apl/runtime.sx")
-(load "lib/apl/tokenizer.sx")
-(load "lib/apl/parser.sx")
-(load "lib/apl/transpile.sx")
-(epoch 2)
-(eval "(define apl-test-pass 0)")
-(eval "(define apl-test-fail 0)")
-(eval "(define apl-test-fails (list))")
-(eval "(define apl-test (fn (name got expected) (if (= got expected) (set! apl-test-pass (+ apl-test-pass 1)) (begin (set! apl-test-fail (+ apl-test-fail 1)) (set! apl-test-fails (append apl-test-fails (list {:name name :got got :expected expected})))))))")
-(epoch 3)
-(load "lib/apl/tests/structural.sx")
-(load "lib/apl/tests/operators.sx")
-(load "lib/apl/tests/dfn.sx")
-(load "lib/apl/tests/tradfn.sx")
-(load "lib/apl/tests/valence.sx")
-(load "lib/apl/tests/programs.sx")
-(load "lib/apl/tests/system.sx")
-(load "lib/apl/tests/idioms.sx")
-(load "lib/apl/tests/eval-ops.sx")
-(load "lib/apl/tests/pipeline.sx")
-(load "lib/apl/tests/programs-e2e.sx")
-(epoch 4)
-(eval "(list apl-test-pass apl-test-fail)")
-EPOCHS
-
-OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
-
-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
-if [ -z "$LINE" ]; then
-  echo "ERROR: could not extract summary"
-  echo "$OUTPUT" | tail -10
-  exit 1
-fi
-
-P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
-F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
-TOTAL=$((P + F))
-
-if [ "$F" -eq 0 ]; then
-  echo "ok $P/$TOTAL lib/apl tests passed"
-else
-  echo "FAIL $P/$TOTAL passed, $F failed"
-fi
-
-[ "$F" -eq 0 ]

lib/apl/tests/dfn.sx

@@ -1,227 +0,0 @@
-; Tests for apl-eval-ast and apl-call-dfn (manual AST construction).
-
-(define rv (fn (arr) (get arr :ravel)))
-(define sh (fn (arr) (get arr :shape)))
-
-(define mknum (fn (n) (list :num n)))
-(define mkname (fn (s) (list :name s)))
-(define mkfg (fn (g) (list :fn-glyph g)))
-(define mkmon (fn (g a) (list :monad (mkfg g) a)))
-(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r)))
-(define mkdfn1 (fn (body) (list :dfn body)))
-(define mkprog (fn (stmts) (cons :program stmts)))
-
-(define mkasg (fn (mkname expr) (list :assign mkname expr)))
-
-(define mkgrd (fn (c e) (list :guard c e)))
-
-(define mkdfn (fn (stmts) (cons :dfn stmts)))
-
-(apl-test
-  "eval :num literal"
-  (rv (apl-eval-ast (mknum 42) {}))
-  (list 42))
-
-(apl-test
-  "eval :num literal shape"
-  (sh (apl-eval-ast (mknum 42) {}))
-  (list))
-
-(apl-test
-  "eval :dyad +"
-  (rv (apl-eval-ast (mkdyd "+" (mknum 2) (mknum 3)) {}))
-  (list 5))
-
-(apl-test
-  "eval :dyad ×"
-  (rv (apl-eval-ast (mkdyd "×" (mknum 6) (mknum 7)) {}))
-  (list 42))
-
-(apl-test
-  "eval :monad - (negate)"
-  (rv (apl-eval-ast (mkmon "-" (mknum 7)) {}))
-  (list -7))
-
-(apl-test
-  "eval :monad ⌊ (floor)"
-  (rv (apl-eval-ast (mkmon "⌊" (mknum 3)) {}))
-  (list 3))
-
-(apl-test
-  "eval :name ⍵ from env"
-  (rv (apl-eval-ast (mkname "⍵") {:omega (apl-scalar 99) :alpha nil}))
-  (list 99))
-
-(apl-test
-  "eval :name ⍺ from env"
-  (rv (apl-eval-ast (mkname "⍺") {:omega nil :alpha (apl-scalar 7)}))
-  (list 7))
-
-(apl-test
-  "dfn {⍵+1} called monadic"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn1 (mkdyd "+" (mkname "⍵") (mknum 1)))
-      (apl-scalar 5)))
-  (list 6))
-
-(apl-test
-  "dfn {⍺+⍵} called dyadic"
-  (rv
-    (apl-call-dfn
-      (mkdfn1 (mkdyd "+" (mkname "⍺") (mkname "⍵")))
-      (apl-scalar 4)
-      (apl-scalar 9)))
-  (list 13))
-
-(apl-test
-  "dfn {⍺×⍵} dyadic on vectors"
-  (rv
-    (apl-call-dfn
-      (mkdfn1 (mkdyd "×" (mkname "⍺") (mkname "⍵")))
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 10 20 30))))
-  (list 10 40 90))
-
-(apl-test
-  "dfn {-⍵} monadic negate"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn1 (mkmon "-" (mkname "⍵")))
-      (make-array (list 3) (list 1 2 3))))
-  (list -1 -2 -3))
-
-(apl-test
-  "dfn {⍺-⍵} dyadic subtract scalar"
-  (rv
-    (apl-call-dfn
-      (mkdfn1 (mkdyd "-" (mkname "⍺") (mkname "⍵")))
-      (apl-scalar 10)
-      (apl-scalar 3)))
-  (list 7))
-
-(apl-test
-  "dfn {⌈⍺,⍵} not used (just verify : missing) — ceiling of right"
-  (rv
-    (apl-call-dfn-m (mkdfn1 (mkmon "⌈" (mkname "⍵"))) (apl-scalar 5)))
-  (list 5))
-
-(apl-test
-  "dfn nested dyad"
-  (rv
-    (apl-call-dfn
-      (mkdfn1
-        (mkdyd "+" (mkname "⍺") (mkdyd "×" (mkname "⍵") (mknum 2))))
-      (apl-scalar 1)
-      (apl-scalar 3)))
-  (list 7))
-
-(apl-test
-  "dfn local assign x←⍵+1; ⍺×x"
-  (rv
-    (apl-call-dfn
-      (mkdfn
-        (list
-          (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 1)))
-          (mkdyd "×" (mkname "⍺") (mkname "x"))))
-      (apl-scalar 3)
-      (apl-scalar 4)))
-  (list 15))
-
-(apl-test
-  "dfn guard: 0=⍵:99; ⍵×2 (true branch)"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99))
-          (mkdyd "×" (mkname "⍵") (mknum 2))))
-      (apl-scalar 0)))
-  (list 99))
-
-(apl-test
-  "dfn guard: 0=⍵:99; ⍵×2 (false branch)"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 99))
-          (mkdyd "×" (mkname "⍵") (mknum 2))))
-      (apl-scalar 5)))
-  (list 10))
-
-(apl-test
-  "dfn default ⍺←10 used (monadic call)"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkasg "⍺" (mknum 10))
-          (mkdyd "+" (mkname "⍺") (mkname "⍵"))))
-      (apl-scalar 5)))
-  (list 15))
-
-(apl-test
-  "dfn default ⍺←10 ignored when ⍺ given (dyadic call)"
-  (rv
-    (apl-call-dfn
-      (mkdfn
-        (list
-          (mkasg "⍺" (mknum 10))
-          (mkdyd "+" (mkname "⍺") (mkname "⍵"))))
-      (apl-scalar 100)
-      (apl-scalar 5)))
-  (list 105))
-
-(apl-test
-  "dfn ∇ recursion: factorial via guard"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1))
-          (mkdyd
-            "×"
-            (mkname "⍵")
-            (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1))))))
-      (apl-scalar 5)))
-  (list 120))
-
-(apl-test
-  "dfn ∇ recursion: 3 → 6 (factorial)"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkgrd (mkdyd "=" (mknum 0) (mkname "⍵")) (mknum 1))
-          (mkdyd
-            "×"
-            (mkname "⍵")
-            (mkmon "∇" (mkdyd "-" (mkname "⍵") (mknum 1))))))
-      (apl-scalar 3)))
-  (list 6))
-
-(apl-test
-  "dfn local: x←⍵+10; y←x×2; y"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkasg "x" (mkdyd "+" (mkname "⍵") (mknum 10)))
-          (mkasg "y" (mkdyd "×" (mkname "x") (mknum 2)))
-          (mkname "y")))
-      (apl-scalar 5)))
-  (list 30))
-
-(apl-test
-  "dfn first guard wins: many guards"
-  (rv
-    (apl-call-dfn-m
-      (mkdfn
-        (list
-          (mkgrd (mkdyd "=" (mknum 1) (mkname "⍵")) (mknum 100))
-          (mkgrd (mkdyd "=" (mknum 2) (mkname "⍵")) (mknum 200))
-          (mkgrd (mkdyd "=" (mknum 3) (mkname "⍵")) (mknum 300))
-          (mknum 0)))
-      (apl-scalar 2)))
-  (list 200))

lib/apl/tests/eval-ops.sx

@@ -1,147 +0,0 @@
-; Tests for operator handling in apl-eval-ast (Phase 7).
-; Manual AST construction; verifies :derived-fn / :outer / :derived-fn2
-; route through apl-resolve-monadic / apl-resolve-dyadic correctly.
-
-(define mkrv (fn (arr) (get arr :ravel)))
-(define mksh (fn (arr) (get arr :shape)))
-(define mknum (fn (n) (list :num n)))
-(define mkfg (fn (g) (list :fn-glyph g)))
-(define mkmon (fn (g a) (list :monad g a)))
-(define mkdyd (fn (g l r) (list :dyad g l r)))
-(define mkder (fn (op f) (list :derived-fn op f)))
-(define mkdr2 (fn (op f g) (list :derived-fn2 op f g)))
-(define mkout (fn (f) (list :outer "∘." f)))
-
-; helper: literal vector AST via :vec (from list of values)
-(define mkvec (fn (xs) (cons :vec (map (fn (n) (mknum n)) xs))))
-
-; ---------- monadic operators ----------
-
-(apl-test
-  "eval-ast +/ ⍳5 → 15"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "/" (mkfg "+")) (mkmon (mkfg "⍳") (mknum 5)))
-      {}))
-  (list 15))
-
-(apl-test
-  "eval-ast ×/ ⍳5 → 120"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "/" (mkfg "×")) (mkmon (mkfg "⍳") (mknum 5)))
-      {}))
-  (list 120))
-
-(apl-test
-  "eval-ast ⌈/ — max reduce"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "/" (mkfg "⌈")) (mkvec (list 3 1 4 1 5 9 2 6)))
-      {}))
-  (list 9))
-
-(apl-test
-  "eval-ast +\\ scan"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "\\" (mkfg "+")) (mkvec (list 1 2 3 4 5)))
-      {}))
-  (list 1 3 6 10 15))
-
-(apl-test
-  "eval-ast +⌿ first-axis reduce on vector"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "⌿" (mkfg "+")) (mkvec (list 1 2 3 4 5)))
-      {}))
-  (list 15))
-
-(apl-test
-  "eval-ast -¨ each-negate"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "¨" (mkfg "-")) (mkvec (list 1 2 3 4)))
-      {}))
-  (list -1 -2 -3 -4))
-
-(apl-test
-  "eval-ast +⍨ commute (double via x+x)"
-  (mkrv
-    (apl-eval-ast (mkmon (mkder "⍨" (mkfg "+")) (mknum 7)) {}))
-  (list 14))
-
-; ---------- dyadic operators ----------
-
-(apl-test
-  "eval-ast outer ∘.× — multiplication table"
-  (mkrv
-    (apl-eval-ast
-      (mkdyd
-        (mkout (mkfg "×"))
-        (mkvec (list 1 2 3))
-        (mkvec (list 1 2 3)))
-      {}))
-  (list 1 2 3 2 4 6 3 6 9))
-
-(apl-test
-  "eval-ast outer ∘.× shape (3 3)"
-  (mksh
-    (apl-eval-ast
-      (mkdyd
-        (mkout (mkfg "×"))
-        (mkvec (list 1 2 3))
-        (mkvec (list 1 2 3)))
-      {}))
-  (list 3 3))
-
-(apl-test
-  "eval-ast inner +.× — dot product"
-  (mkrv
-    (apl-eval-ast
-      (mkdyd
-        (mkdr2 "." (mkfg "+") (mkfg "×"))
-        (mkvec (list 1 2 3))
-        (mkvec (list 4 5 6)))
-      {}))
-  (list 32))
-
-(apl-test
-  "eval-ast inner ∧.= equal vectors"
-  (mkrv
-    (apl-eval-ast
-      (mkdyd
-        (mkdr2 "." (mkfg "∧") (mkfg "="))
-        (mkvec (list 1 2 3))
-        (mkvec (list 1 2 3)))
-      {}))
-  (list 1))
-
-(apl-test
-  "eval-ast each-dyadic +¨"
-  (mkrv
-    (apl-eval-ast
-      (mkdyd
-        (mkder "¨" (mkfg "+"))
-        (mkvec (list 1 2 3))
-        (mkvec (list 10 20 30)))
-      {}))
-  (list 11 22 33))
-
-(apl-test
-  "eval-ast commute -⍨ (subtract swapped)"
-  (mkrv
-    (apl-eval-ast
-      (mkdyd (mkder "⍨" (mkfg "-")) (mknum 5) (mknum 3))
-      {}))
-  (list -2))
-
-; ---------- nested operators ----------
-
-(apl-test
-  "eval-ast +/¨ — sum of each"
-  (mkrv
-    (apl-eval-ast
-      (mkmon (mkder "/" (mkfg "+")) (mkvec (list 10 20 30)))
-      {}))
-  (list 60))

lib/apl/tests/idioms.sx

@@ -1,359 +0,0 @@
-; APL idiom corpus — classic Roger Hui / Phil Last idioms expressed
-; through our runtime primitives.  Each test names the APL one-liner
-; and verifies the equivalent runtime call.
-
-(define mkrv (fn (arr) (get arr :ravel)))
-(define mksh (fn (arr) (get arr :shape)))
-
-; ---------- reductions ----------
-
-(apl-test
-  "+/⍵ — sum"
-  (mkrv (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 15))
-
-(apl-test
-  "(+/⍵)÷⍴⍵ — mean"
-  (mkrv
-    (apl-div
-      (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5)))
-      (apl-scalar 5)))
-  (list 3))
-
-(apl-test
-  "⌈/⍵ — max"
-  (mkrv (apl-reduce apl-max (make-array (list 6) (list 3 1 4 1 5 9))))
-  (list 9))
-
-(apl-test
-  "⌊/⍵ — min"
-  (mkrv (apl-reduce apl-min (make-array (list 6) (list 3 1 4 1 5 9))))
-  (list 1))
-
-(apl-test
-  "(⌈/⍵)-⌊/⍵ — range"
-  (mkrv
-    (apl-sub
-      (apl-reduce apl-max (make-array (list 6) (list 3 1 4 1 5 9)))
-      (apl-reduce apl-min (make-array (list 6) (list 3 1 4 1 5 9)))))
-  (list 8))
-
-(apl-test
-  "×/⍵ — product"
-  (mkrv (apl-reduce apl-mul (make-array (list 4) (list 1 2 3 4))))
-  (list 24))
-
-(apl-test
-  "+\\⍵ — running sum"
-  (mkrv (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 3 6 10 15))
-
-; ---------- sort / order ----------
-
-(apl-test
-  "⍵[⍋⍵] — sort ascending"
-  (mkrv (apl-quicksort (make-array (list 5) (list 3 1 4 1 5))))
-  (list 1 1 3 4 5))
-
-(apl-test
-  "⌽⍵ — reverse"
-  (mkrv (apl-reverse (make-array (list 5) (list 1 2 3 4 5))))
-  (list 5 4 3 2 1))
-
-(apl-test
-  "⊃⌽⍵ — last element"
-  (mkrv
-    (apl-disclose (apl-reverse (make-array (list 4) (list 10 20 30 40)))))
-  (list 40))
-
-(apl-test
-  "1↑⍵ — first element"
-  (mkrv
-    (apl-take (apl-scalar 1) (make-array (list 4) (list 10 20 30 40))))
-  (list 10))
-
-(apl-test
-  "1↓⍵ — drop first"
-  (mkrv
-    (apl-drop (apl-scalar 1) (make-array (list 4) (list 10 20 30 40))))
-  (list 20 30 40))
-
-(apl-test
-  "¯1↓⍵ — drop last"
-  (mkrv
-    (apl-drop (apl-scalar -1) (make-array (list 4) (list 10 20 30 40))))
-  (list 10 20 30))
-
-; ---------- counts / membership ----------
-
-(apl-test
-  "≢⍵ — tally"
-  (mkrv (apl-tally (make-array (list 7) (list 9 8 7 6 5 4 3))))
-  (list 7))
-
-(apl-test
-  "+/⍵=v — count occurrences of v"
-  (mkrv
-    (apl-reduce
-      apl-add
-      (apl-eq (make-array (list 7) (list 1 2 3 2 1 3 2)) (apl-scalar 2))))
-  (list 3))
-
-(apl-test
-  "0=N|M — divisibility test"
-  (mkrv (apl-eq (apl-scalar 0) (apl-mod (apl-scalar 3) (apl-scalar 12))))
-  (list 1))
-
-; ---------- shape constructors ----------
-
-(apl-test
-  "N⍴1 — vector of N ones"
-  (mkrv (apl-reshape (apl-scalar 5) (apl-scalar 1)))
-  (list 1 1 1 1 1))
-
-(apl-test
-  "(N N)⍴0 — N×N zero matrix"
-  (mkrv (apl-reshape (make-array (list 2) (list 3 3)) (apl-scalar 0)))
-  (list 0 0 0 0 0 0 0 0 0))
-
-(apl-test
-  "⍳∘.=⍳ — N×N identity matrix"
-  (mkrv
-    (apl-outer apl-eq (apl-iota (apl-scalar 3)) (apl-iota (apl-scalar 3))))
-  (list 1 0 0 0 1 0 0 0 1))
-
-(apl-test
-  "⍳∘.×⍳ — multiplication table"
-  (mkrv
-    (apl-outer apl-mul (apl-iota (apl-scalar 3)) (apl-iota (apl-scalar 3))))
-  (list 1 2 3 2 4 6 3 6 9))
-
-; ---------- numerical idioms ----------
-
-(apl-test
-  "+\\⍳N — triangular numbers"
-  (mkrv (apl-scan apl-add (apl-iota (apl-scalar 5))))
-  (list 1 3 6 10 15))
-
-(apl-test
-  "+/⍳N=N×(N+1)÷2 — sum of 1..N"
-  (mkrv (apl-reduce apl-add (apl-iota (apl-scalar 10))))
-  (list 55))
-
-(apl-test
-  "×/⍳N — factorial via iota"
-  (mkrv (apl-reduce apl-mul (apl-iota (apl-scalar 5))))
-  (list 120))
-
-(apl-test
-  "2|⍵ — parity (1=odd)"
-  (mkrv (apl-mod (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 0 1 0 1))
-
-(apl-test
-  "+/2|⍵ — count odd"
-  (mkrv
-    (apl-reduce
-      apl-add
-      (apl-mod (apl-scalar 2) (make-array (list 5) (list 1 2 3 4 5)))))
-  (list 3))
-
-; ---------- boolean idioms ----------
-
-(apl-test
-  "∧/⍵ — all-true"
-  (mkrv (apl-reduce apl-and (make-array (list 4) (list 1 1 1 1))))
-  (list 1))
-
-(apl-test
-  "∧/⍵ — all-true with zero is false"
-  (mkrv (apl-reduce apl-and (make-array (list 4) (list 1 1 0 1))))
-  (list 0))
-
-(apl-test
-  "∨/⍵ — any-true"
-  (mkrv (apl-reduce apl-or (make-array (list 4) (list 0 0 1 0))))
-  (list 1))
-
-(apl-test
-  "∨/⍵ — any-true all zero is false"
-  (mkrv (apl-reduce apl-or (make-array (list 4) (list 0 0 0 0))))
-  (list 0))
-
-; ---------- selection / scaling ----------
-
-(apl-test
-  "⍵×⍵ — square each"
-  (mkrv
-    (apl-mul
-      (make-array (list 4) (list 1 2 3 4))
-      (make-array (list 4) (list 1 2 3 4))))
-  (list 1 4 9 16))
-
-(apl-test
-  "+/⍵×⍵ — sum of squares"
-  (mkrv
-    (apl-reduce
-      apl-add
-      (apl-mul
-        (make-array (list 4) (list 1 2 3 4))
-        (make-array (list 4) (list 1 2 3 4)))))
-  (list 30))
-
-(apl-test
-  "⍵-(+/⍵)÷⍴⍵ — mean-centered"
-  (mkrv
-    (apl-sub
-      (make-array (list 5) (list 2 4 6 8 10))
-      (apl-div
-        (apl-reduce apl-add (make-array (list 5) (list 2 4 6 8 10)))
-        (apl-scalar 5))))
-  (list -4 -2 0 2 4))
-
-; ---------- shape / structure ----------
-
-(apl-test
-  ",⍵ — ravel"
-  (mkrv (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 1 2 3 4 5 6))
-
-(apl-test
-  "⍴⍴⍵ — rank"
-  (mkrv
-    (apl-shape (apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))))
-  (list 2))
-
-(apl-test
-  "src: +/⍳N → triangular(N)"
-  (mkrv (apl-run "+/⍳100"))
-  (list 5050))
-
-(apl-test "src: ×/⍳N → N!" (mkrv (apl-run "×/⍳6")) (list 720))
-
-(apl-test
-  "src: ⌈/V — max"
-  (mkrv (apl-run "⌈/3 1 4 1 5 9 2 6"))
-  (list 9))
-
-(apl-test
-  "src: ⌊/V — min"
-  (mkrv (apl-run "⌊/3 1 4 1 5 9 2 6"))
-  (list 1))
-
-(apl-test
-  "src: range = (⌈/V) - ⌊/V"
-  (mkrv (apl-run "(⌈/3 1 4 1 5 9 2 6) - ⌊/3 1 4 1 5 9 2 6"))
-  (list 8))
-
-(apl-test
-  "src: +\\V — running sum"
-  (mkrv (apl-run "+\\1 2 3 4 5"))
-  (list 1 3 6 10 15))
-
-(apl-test
-  "src: ×\\V — running product"
-  (mkrv (apl-run "×\\1 2 3 4 5"))
-  (list 1 2 6 24 120))
-
-(apl-test
-  "src: V × V — squares"
-  (mkrv (apl-run "(⍳5) × ⍳5"))
-  (list 1 4 9 16 25))
-
-(apl-test
-  "src: +/V × V — sum of squares"
-  (mkrv (apl-run "+/(⍳5) × ⍳5"))
-  (list 55))
-
-(apl-test "src: ∧/V — all-true" (mkrv (apl-run "∧/1 1 1 1")) (list 1))
-
-(apl-test "src: ∨/V — any-true" (mkrv (apl-run "∨/0 0 1 0")) (list 1))
-
-(apl-test "src: 0 = N|M — divides" (mkrv (apl-run "0 = 3 | 12")) (list 1))
-
-(apl-test
-  "src: 2 | V — parity"
-  (mkrv (apl-run "2 | 1 2 3 4 5 6"))
-  (list 1 0 1 0 1 0))
-
-(apl-test
-  "src: +/2|V — count odd"
-  (mkrv (apl-run "+/2 | 1 2 3 4 5 6"))
-  (list 3))
-
-(apl-test "src: ⍴ V" (mkrv (apl-run "⍴ 1 2 3 4 5")) (list 5))
-
-(apl-test
-  "src: ⍴⍴ M — rank"
-  (mkrv (apl-run "⍴ ⍴ (2 3) ⍴ ⍳6"))
-  (list 2))
-
-(apl-test
-  "src: N⍴1 — vector of ones"
-  (mkrv (apl-run "5 ⍴ 1"))
-  (list 1 1 1 1 1))
-
-(apl-test
-  "src: ⍳N ∘.= ⍳N — identity matrix"
-  (mkrv (apl-run "(⍳3) ∘.= ⍳3"))
-  (list 1 0 0 0 1 0 0 0 1))
-
-(apl-test
-  "src: ⍳N ∘.× ⍳N — multiplication table"
-  (mkrv (apl-run "(⍳3) ∘.× ⍳3"))
-  (list 1 2 3 2 4 6 3 6 9))
-
-(apl-test
-  "src: V +.× V — dot product"
-  (mkrv (apl-run "1 2 3 +.× 4 5 6"))
-  (list 32))
-
-(apl-test
-  "src: ∧.= V — vectors equal?"
-  (mkrv (apl-run "1 2 3 ∧.= 1 2 3"))
-  (list 1))
-
-(apl-test
-  "src: V[1] — first element"
-  (mkrv (apl-run "(10 20 30 40)[1]"))
-  (list 10))
-
-(apl-test
-  "src: 1↑V — first via take"
-  (mkrv (apl-run "1 ↑ 10 20 30 40"))
-  (list 10))
-
-(apl-test
-  "src: 1↓V — drop first"
-  (mkrv (apl-run "1 ↓ 10 20 30 40"))
-  (list 20 30 40))
-
-(apl-test
-  "src: ¯1↓V — drop last"
-  (mkrv (apl-run "¯1 ↓ 10 20 30 40"))
-  (list 10 20 30))
-
-(apl-test
-  "src: ⌽V — reverse"
-  (mkrv (apl-run "⌽ 1 2 3 4 5"))
-  (list 5 4 3 2 1))
-
-(apl-test
-  "src: ≢V — tally"
-  (mkrv (apl-run "≢ 9 8 7 6 5 4 3 2 1"))
-  (list 9))
-
-(apl-test
-  "src: ,M — ravel"
-  (mkrv (apl-run ", (2 3) ⍴ ⍳6"))
-  (list 1 2 3 4 5 6))
-
-(apl-test
-  "src: A=V — count occurrences"
-  (mkrv (apl-run "+/2 = 1 2 3 2 1 3 2"))
-  (list 3))
-
-(apl-test
-  "src: ⌈/(V × V) — max squared"
-  (mkrv (apl-run "⌈/(1 2 3 4 5) × 1 2 3 4 5"))
-  (list 25))

lib/apl/tests/operators.sx

@@ -1,791 +0,0 @@
-(define rv (fn (arr) (get arr :ravel)))
-(define sh (fn (arr) (get arr :shape)))
-
-(apl-test
-  "reduce +/ vector"
-  (rv (apl-reduce apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 15))
-
-(apl-test
-  "reduce x/ vector"
-  (rv (apl-reduce apl-mul (make-array (list 4) (list 1 2 3 4))))
-  (list 24))
-
-(apl-test
-  "reduce max/ vector"
-  (rv (apl-reduce apl-max (make-array (list 5) (list 3 1 4 1 5))))
-  (list 5))
-
-(apl-test
-  "reduce min/ vector"
-  (rv (apl-reduce apl-min (make-array (list 3) (list 3 1 4))))
-  (list 1))
-
-(apl-test
-  "reduce and/ all true"
-  (rv (apl-reduce apl-and (make-array (list 3) (list 1 1 1))))
-  (list 1))
-
-(apl-test
-  "reduce or/ with true"
-  (rv (apl-reduce apl-or (make-array (list 3) (list 0 0 1))))
-  (list 1))
-
-(apl-test
-  "reduce +/ single element"
-  (rv (apl-reduce apl-add (make-array (list 1) (list 42))))
-  (list 42))
-
-(apl-test
-  "reduce +/ scalar no-op"
-  (rv (apl-reduce apl-add (apl-scalar 7)))
-  (list 7))
-
-(apl-test
-  "reduce +/ shape is scalar"
-  (sh (apl-reduce apl-add (make-array (list 4) (list 1 2 3 4))))
-  (list))
-
-(apl-test
-  "reduce +/ matrix row sums shape"
-  (sh (apl-reduce apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2))
-
-(apl-test
-  "reduce +/ matrix row sums values"
-  (rv (apl-reduce apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 6 15))
-
-(apl-test
-  "reduce max/ matrix row maxima"
-  (rv (apl-reduce apl-max (make-array (list 2 3) (list 3 1 4 1 5 9))))
-  (list 4 9))
-
-(apl-test
-  "reduce-first +/ vector same as reduce"
-  (rv (apl-reduce-first apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 15))
-
-(apl-test
-  "reduce-first +/ matrix col sums shape"
-  (sh
-    (apl-reduce-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 3))
-
-(apl-test
-  "reduce-first +/ matrix col sums values"
-  (rv
-    (apl-reduce-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 5 7 9))
-
-(apl-test
-  "reduce-first max/ matrix col maxima"
-  (rv
-    (apl-reduce-first apl-max (make-array (list 3 2) (list 1 9 2 8 3 7))))
-  (list 3 9))
-
-(apl-test
-  "scan +\\ vector"
-  (rv (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 3 6 10 15))
-
-(apl-test
-  "scan x\\ vector cumulative product"
-  (rv (apl-scan apl-mul (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 2 6 24 120))
-
-(apl-test
-  "scan max\\ vector running max"
-  (rv (apl-scan apl-max (make-array (list 5) (list 3 1 4 1 5))))
-  (list 3 3 4 4 5))
-
-(apl-test
-  "scan min\\ vector running min"
-  (rv (apl-scan apl-min (make-array (list 5) (list 3 1 4 1 5))))
-  (list 3 1 1 1 1))
-
-(apl-test
-  "scan +\\ single element"
-  (rv (apl-scan apl-add (make-array (list 1) (list 42))))
-  (list 42))
-
-(apl-test
-  "scan +\\ scalar no-op"
-  (rv (apl-scan apl-add (apl-scalar 7)))
-  (list 7))
-
-(apl-test
-  "scan +\\ vector preserves shape"
-  (sh (apl-scan apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 5))
-
-(apl-test
-  "scan +\\ matrix preserves shape"
-  (sh (apl-scan apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2 3))
-
-(apl-test
-  "scan +\\ matrix row-wise"
-  (rv (apl-scan apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 1 3 6 4 9 15))
-
-(apl-test
-  "scan max\\ matrix row-wise running max"
-  (rv (apl-scan apl-max (make-array (list 2 3) (list 3 1 4 1 5 9))))
-  (list 3 3 4 1 5 9))
-
-(apl-test
-  "scan-first +\\ vector same as scan"
-  (rv (apl-scan-first apl-add (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 3 6 10 15))
-
-(apl-test
-  "scan-first +\\ scalar no-op"
-  (rv (apl-scan-first apl-add (apl-scalar 9)))
-  (list 9))
-
-(apl-test
-  "scan-first +\\ matrix preserves shape"
-  (sh (apl-scan-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2 3))
-
-(apl-test
-  "scan-first +\\ matrix col-wise"
-  (rv (apl-scan-first apl-add (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 1 2 3 5 7 9))
-
-(apl-test
-  "scan-first max\\ matrix col-wise running max"
-  (rv (apl-scan-first apl-max (make-array (list 3 2) (list 3 1 4 1 5 9))))
-  (list 3 1 4 1 5 9))
-
-(apl-test
-  "each negate vector"
-  (rv (apl-each apl-neg-m (make-array (list 3) (list 1 2 3))))
-  (list -1 -2 -3))
-
-(apl-test
-  "each negate vector preserves shape"
-  (sh (apl-each apl-neg-m (make-array (list 3) (list 1 2 3))))
-  (list 3))
-
-(apl-test
-  "each reciprocal vector"
-  (rv (apl-each apl-recip (make-array (list 3) (list 1 2 4))))
-  (list 1 (/ 1 2) (/ 1 4)))
-
-(apl-test
-  "each abs vector"
-  (rv (apl-each apl-abs (make-array (list 4) (list -1 2 -3 4))))
-  (list 1 2 3 4))
-
-(apl-test "each scalar" (rv (apl-each apl-neg-m (apl-scalar 5))) (list -5))
-
-(apl-test
-  "each scalar shape"
-  (sh (apl-each apl-neg-m (apl-scalar 5)))
-  (list))
-
-(apl-test
-  "each negate matrix shape"
-  (sh (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2 3))
-
-(apl-test
-  "each negate matrix values"
-  (rv (apl-each apl-neg-m (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list -1 -2 -3 -4 -5 -6))
-
-(apl-test
-  "each-dyadic scalar+scalar"
-  (rv (apl-each-dyadic apl-add (apl-scalar 3) (apl-scalar 4)))
-  (list 7))
-
-(apl-test
-  "each-dyadic scalar+vector"
-  (rv
-    (apl-each-dyadic
-      apl-add
-      (apl-scalar 10)
-      (make-array (list 3) (list 1 2 3))))
-  (list 11 12 13))
-
-(apl-test
-  "each-dyadic vector+scalar"
-  (rv
-    (apl-each-dyadic
-      apl-add
-      (make-array (list 3) (list 1 2 3))
-      (apl-scalar 10)))
-  (list 11 12 13))
-
-(apl-test
-  "each-dyadic vector+vector"
-  (rv
-    (apl-each-dyadic
-      apl-add
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 10 20 30))))
-  (list 11 22 33))
-
-(apl-test
-  "each-dyadic mul matrix+matrix shape"
-  (sh
-    (apl-each-dyadic
-      apl-mul
-      (make-array (list 2 2) (list 1 2 3 4))
-      (make-array (list 2 2) (list 5 6 7 8))))
-  (list 2 2))
-
-(apl-test
-  "each-dyadic mul matrix+matrix values"
-  (rv
-    (apl-each-dyadic
-      apl-mul
-      (make-array (list 2 2) (list 1 2 3 4))
-      (make-array (list 2 2) (list 5 6 7 8))))
-  (list 5 12 21 32))
-
-(apl-test
-  "outer product mult table values"
-  (rv
-    (apl-outer
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 1 2 3))))
-  (list 1 2 3 2 4 6 3 6 9))
-
-(apl-test
-  "outer product mult table shape"
-  (sh
-    (apl-outer
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 1 2 3))))
-  (list 3 3))
-
-(apl-test
-  "outer product add table values"
-  (rv
-    (apl-outer
-      apl-add
-      (make-array (list 2) (list 1 2))
-      (make-array (list 3) (list 10 20 30))))
-  (list 11 21 31 12 22 32))
-
-(apl-test
-  "outer product add table shape"
-  (sh
-    (apl-outer
-      apl-add
-      (make-array (list 2) (list 1 2))
-      (make-array (list 3) (list 10 20 30))))
-  (list 2 3))
-
-(apl-test
-  "outer product scalar+vector shape"
-  (sh
-    (apl-outer apl-mul (apl-scalar 5) (make-array (list 3) (list 1 2 3))))
-  (list 3))
-
-(apl-test
-  "outer product scalar+vector values"
-  (rv
-    (apl-outer apl-mul (apl-scalar 5) (make-array (list 3) (list 1 2 3))))
-  (list 5 10 15))
-
-(apl-test
-  "outer product vector+scalar shape"
-  (sh
-    (apl-outer apl-mul (make-array (list 3) (list 1 2 3)) (apl-scalar 10)))
-  (list 3))
-
-(apl-test
-  "outer product scalar+scalar"
-  (rv (apl-outer apl-mul (apl-scalar 6) (apl-scalar 7)))
-  (list 42))
-
-(apl-test
-  "outer product scalar+scalar shape"
-  (sh (apl-outer apl-mul (apl-scalar 6) (apl-scalar 7)))
-  (list))
-
-(apl-test
-  "outer product equality identity matrix values"
-  (rv
-    (apl-outer
-      apl-eq
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 1 2 3))))
-  (list 1 0 0 0 1 0 0 0 1))
-
-(apl-test
-  "outer product matrix+vector rank doubling shape"
-  (sh
-    (apl-outer
-      apl-add
-      (make-array (list 2 2) (list 1 2 3 4))
-      (make-array (list 3) (list 10 20 30))))
-  (list 2 2 3))
-
-(apl-test
-  "outer product matrix+vector rank doubling values"
-  (rv
-    (apl-outer
-      apl-add
-      (make-array (list 2 2) (list 1 2 3 4))
-      (make-array (list 3) (list 10 20 30))))
-  (list 11 21 31 12 22 32 13 23 33 14 24 34))
-
-(apl-test
-  "inner +.× dot product"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 4 5 6))))
-  (list 32))
-
-(apl-test
-  "inner +.× dot product shape is scalar"
-  (sh
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 4 5 6))))
-  (list))
-
-(apl-test
-  "inner +.× matrix multiply 2x3 * 3x2 shape"
-  (sh
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 2 3) (list 1 2 3 4 5 6))
-      (make-array (list 3 2) (list 7 8 9 10 11 12))))
-  (list 2 2))
-
-(apl-test
-  "inner +.× matrix multiply 2x3 * 3x2 values"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 2 3) (list 1 2 3 4 5 6))
-      (make-array (list 3 2) (list 7 8 9 10 11 12))))
-  (list 58 64 139 154))
-
-(apl-test
-  "inner +.× identity matrix 2x2"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 2 2) (list 1 0 0 1))
-      (make-array (list 2 2) (list 5 6 7 8))))
-  (list 5 6 7 8))
-
-(apl-test
-  "inner ∧.= equal vectors"
-  (rv
-    (apl-inner
-      apl-and
-      apl-eq
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 1 2 3))))
-  (list 1))
-
-(apl-test
-  "inner ∧.= unequal vectors"
-  (rv
-    (apl-inner
-      apl-and
-      apl-eq
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 1 9 3))))
-  (list 0))
-
-(apl-test
-  "inner +.× matrix * vector shape"
-  (sh
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 2 3) (list 1 2 3 4 5 6))
-      (make-array (list 3) (list 7 8 9))))
-  (list 2))
-
-(apl-test
-  "inner +.× matrix * vector values"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 2 3) (list 1 2 3 4 5 6))
-      (make-array (list 3) (list 7 8 9))))
-  (list 50 122))
-
-(apl-test
-  "inner +.× vector * matrix shape"
-  (sh
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3 2) (list 4 5 6 7 8 9))))
-  (list 2))
-
-(apl-test
-  "inner +.× vector * matrix values"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3 2) (list 4 5 6 7 8 9))))
-  (list 40 46))
-
-(apl-test
-  "inner +.× single-element vectors"
-  (rv
-    (apl-inner
-      apl-add
-      apl-mul
-      (make-array (list 1) (list 6))
-      (make-array (list 1) (list 7))))
-  (list 42))
-
-(apl-test
-  "commute +⍨ scalar doubles"
-  (rv (apl-commute apl-add (apl-scalar 5)))
-  (list 10))
-
-(apl-test
-  "commute ×⍨ vector squares"
-  (rv (apl-commute apl-mul (make-array (list 4) (list 1 2 3 4))))
-  (list 1 4 9 16))
-
-(apl-test
-  "commute +⍨ vector doubles"
-  (rv (apl-commute apl-add (make-array (list 3) (list 1 2 3))))
-  (list 2 4 6))
-
-(apl-test
-  "commute +⍨ shape preserved"
-  (sh (apl-commute apl-add (make-array (list 3) (list 1 2 3))))
-  (list 3))
-
-(apl-test
-  "commute ×⍨ matrix shape preserved"
-  (sh (apl-commute apl-mul (make-array (list 2 2) (list 1 2 3 4))))
-  (list 2 2))
-
-(apl-test
-  "commute-dyadic -⍨ swaps subtraction"
-  (rv (apl-commute-dyadic apl-sub (apl-scalar 5) (apl-scalar 3)))
-  (list -2))
-
-(apl-test
-  "commute-dyadic ÷⍨ swaps division"
-  (rv (apl-commute-dyadic apl-div (apl-scalar 4) (apl-scalar 12)))
-  (list 3))
-
-(apl-test
-  "commute-dyadic -⍨ on vectors"
-  (rv
-    (apl-commute-dyadic
-      apl-sub
-      (make-array (list 3) (list 10 20 30))
-      (make-array (list 3) (list 1 2 3))))
-  (list -9 -18 -27))
-
-(apl-test
-  "commute-dyadic +⍨ commutative same result"
-  (rv
-    (apl-commute-dyadic
-      apl-add
-      (make-array (list 3) (list 1 2 3))
-      (make-array (list 3) (list 10 20 30))))
-  (list 11 22 33))
-
-(apl-test
-  "commute-dyadic ×⍨ commutative same result"
-  (rv
-    (apl-commute-dyadic
-      apl-mul
-      (make-array (list 3) (list 2 3 4))
-      (make-array (list 3) (list 5 6 7))))
-  (list 10 18 28))
-
-(apl-test
-  "compose -∘| scalar (negative abs)"
-  (rv (apl-compose apl-neg-m apl-abs (apl-scalar -7)))
-  (list -7))
-
-(apl-test
-  "compose -∘| vector"
-  (rv
-    (apl-compose apl-neg-m apl-abs (make-array (list 4) (list -1 2 -3 4))))
-  (list -1 -2 -3 -4))
-
-(apl-test
-  "compose ⌊∘- (floor of negate)"
-  (rv (apl-compose apl-floor apl-neg-m (make-array (list 3) (list 1 2 3))))
-  (list -1 -2 -3))
-
-(apl-test
-  "compose -∘| matrix shape preserved"
-  (sh
-    (apl-compose apl-neg-m apl-abs (make-array (list 2 2) (list -1 2 -3 4))))
-  (list 2 2))
-
-(apl-test
-  "compose-dyadic +∘- equals subtract scalar"
-  (rv (apl-compose-dyadic apl-add apl-neg-m (apl-scalar 10) (apl-scalar 3)))
-  (list 7))
-
-(apl-test
-  "compose-dyadic +∘- equals subtract vector"
-  (rv
-    (apl-compose-dyadic
-      apl-add
-      apl-neg-m
-      (make-array (list 3) (list 10 20 30))
-      (make-array (list 3) (list 1 2 3))))
-  (list 9 18 27))
-
-(apl-test
-  "compose-dyadic -∘| (subtract abs)"
-  (rv (apl-compose-dyadic apl-sub apl-abs (apl-scalar 10) (apl-scalar -3)))
-  (list 7))
-
-(apl-test
-  "compose-dyadic ×∘- (multiply by negative)"
-  (rv
-    (apl-compose-dyadic
-      apl-mul
-      apl-neg-m
-      (make-array (list 3) (list 2 3 4))
-      (make-array (list 3) (list 1 2 3))))
-  (list -2 -6 -12))
-
-(apl-test
-  "compose-dyadic shape preserved"
-  (sh
-    (apl-compose-dyadic
-      apl-add
-      apl-neg-m
-      (make-array (list 2 3) (list 1 2 3 4 5 6))
-      (make-array (list 2 3) (list 1 1 1 1 1 1))))
-  (list 2 3))
-
-(apl-test
-  "power n=0 identity"
-  (rv (apl-power (fn (a) (apl-add a (apl-scalar 1))) 0 (apl-scalar 5)))
-  (list 5))
-
-(apl-test
-  "power increment by 3"
-  (rv (apl-power (fn (a) (apl-add a (apl-scalar 1))) 3 (apl-scalar 0)))
-  (list 3))
-
-(apl-test
-  "power double 4 times = 16"
-  (rv (apl-power (fn (a) (apl-mul a (apl-scalar 2))) 4 (apl-scalar 1)))
-  (list 16))
-
-(apl-test
-  "power on vector +5"
-  (rv
-    (apl-power
-      (fn (a) (apl-add a (apl-scalar 1)))
-      5
-      (make-array (list 3) (list 1 2 3))))
-  (list 6 7 8))
-
-(apl-test
-  "power on vector preserves shape"
-  (sh
-    (apl-power
-      (fn (a) (apl-add a (apl-scalar 1)))
-      5
-      (make-array (list 3) (list 1 2 3))))
-  (list 3))
-
-(apl-test
-  "power on matrix"
-  (rv
-    (apl-power
-      (fn (a) (apl-mul a (apl-scalar 3)))
-      2
-      (make-array (list 2 2) (list 1 2 3 4))))
-  (list 9 18 27 36))
-
-(apl-test
-  "power-fixed identity stops immediately"
-  (rv (apl-power-fixed (fn (a) a) (make-array (list 3) (list 1 2 3))))
-  (list 1 2 3))
-
-(apl-test
-  "power-fixed floor half scalar to 0"
-  (rv
-    (apl-power-fixed
-      (fn (a) (apl-floor (apl-div a (apl-scalar 2))))
-      (apl-scalar 100)))
-  (list 0))
-
-(apl-test
-  "power-fixed shape preserved"
-  (sh
-    (apl-power-fixed (fn (a) a) (make-array (list 2 2) (list 1 2 3 4))))
-  (list 2 2))
-
-(apl-test
-  "rank tally⍤1 row tallies"
-  (rv (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 3 3))
-
-(apl-test
-  "rank tally⍤1 row tallies shape"
-  (sh (apl-rank apl-tally 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2))
-
-(apl-test
-  "rank neg⍤0 vector scalar cells"
-  (rv (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3))))
-  (list -1 -2 -3))
-
-(apl-test
-  "rank neg⍤0 vector preserves shape"
-  (sh (apl-rank apl-neg-m 0 (make-array (list 3) (list 1 2 3))))
-  (list 3))
-
-(apl-test
-  "rank neg⍤1 matrix per-row"
-  (rv (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list -1 -2 -3 -4 -5 -6))
-
-(apl-test
-  "rank neg⍤1 matrix preserves shape"
-  (sh (apl-rank apl-neg-m 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2 3))
-
-(apl-test
-  "rank k>=rank fallthrough"
-  (rv (apl-rank apl-tally 5 (make-array (list 4) (list 1 2 3 4))))
-  (list 4))
-
-(apl-test
-  "rank tally⍤2 whole matrix tally"
-  (rv
-    (apl-rank
-      apl-tally
-      2
-      (make-array (list 3 5) (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))))
-  (list 3))
-
-(apl-test
-  "rank reverse⍤1 matrix reverse rows"
-  (rv (apl-rank apl-reverse 1 (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 3 2 1 6 5 4))
-
-(apl-test
-  "rank tally⍤1 3x4 row tallies"
-  (rv
-    (apl-rank
-      apl-tally
-      1
-      (make-array (list 3 4) (list 1 2 3 4 5 6 7 8 9 10 11 12))))
-  (list 4 4 4))
-
-(apl-test
-  "at-replace single index"
-  (rv
-    (apl-at-replace
-      (apl-scalar 99)
-      (make-array (list 1) (list 2))
-      (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 99 3 4 5))
-
-(apl-test
-  "at-replace multiple indices vector vals"
-  (rv
-    (apl-at-replace
-      (make-array (list 2) (list 99 88))
-      (make-array (list 2) (list 2 4))
-      (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 99 3 88 5))
-
-(apl-test
-  "at-replace scalar broadcast"
-  (rv
-    (apl-at-replace
-      (apl-scalar 0)
-      (make-array (list 3) (list 1 3 5))
-      (make-array (list 5) (list 10 20 30 40 50))))
-  (list 0 20 0 40 0))
-
-(apl-test
-  "at-replace preserves shape"
-  (sh
-    (apl-at-replace
-      (apl-scalar 99)
-      (make-array (list 1) (list 2))
-      (make-array (list 5) (list 1 2 3 4 5))))
-  (list 5))
-
-(apl-test
-  "at-replace last index"
-  (rv
-    (apl-at-replace
-      (apl-scalar 99)
-      (make-array (list 1) (list 5))
-      (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 2 3 4 99))
-
-(apl-test
-  "at-replace on matrix linear-index"
-  (rv
-    (apl-at-replace
-      (apl-scalar 99)
-      (make-array (list 1) (list 3))
-      (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 1 2 99 4 5 6))
-
-(apl-test
-  "at-apply negate at indices"
-  (rv
-    (apl-at-apply
-      apl-neg-m
-      (make-array (list 3) (list 1 3 5))
-      (make-array (list 5) (list 1 2 3 4 5))))
-  (list -1 2 -3 4 -5))
-
-(apl-test
-  "at-apply double at index 1"
-  (rv
-    (apl-at-apply
-      (fn (a) (apl-mul a (apl-scalar 2)))
-      (make-array (list 1) (list 1))
-      (make-array (list 2) (list 5 10))))
-  (list 10 10))
-
-(apl-test
-  "at-apply preserves shape"
-  (sh
-    (apl-at-apply
-      apl-neg-m
-      (make-array (list 2) (list 1 3))
-      (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list 2 3))
-
-(apl-test
-  "at-apply on matrix linear-index"
-  (rv
-    (apl-at-apply
-      apl-neg-m
-      (make-array (list 2) (list 1 6))
-      (make-array (list 2 3) (list 1 2 3 4 5 6))))
-  (list -1 2 3 4 5 -6))

lib/apl/tests/parse.sx

@@ -1,340 +0,0 @@
-(define apl-test-count 0)
-(define apl-test-pass  0)
-(define apl-test-fails (list))
-
-(define apl-test
-  (fn (name actual expected)
-    (begin
-      (set! apl-test-count (+ apl-test-count 1))
-      (if (= actual expected)
-        (set! apl-test-pass (+ apl-test-pass 1))
-        (append! apl-test-fails {:name name :actual actual :expected expected})))))
-
-(define tok-types
-  (fn (src)
-    (map (fn (t) (get t :type)) (apl-tokenize src))))
-
-(define tok-values
-  (fn (src)
-    (map (fn (t) (get t :value)) (apl-tokenize src))))
-
-(define tok-count
-  (fn (src)
-    (len (apl-tokenize src))))
-
-(define tok-type-at
-  (fn (src i)
-    (get (nth (apl-tokenize src) i) :type)))
-
-(define tok-value-at
-  (fn (src i)
-    (get (nth (apl-tokenize src) i) :value)))
-
-(apl-test "empty: no tokens"        (tok-count "")           0)
-(apl-test "empty: whitespace only"  (tok-count "   ")        0)
-(apl-test "num: zero"               (tok-values "0")         (list 0))
-(apl-test "num: positive"           (tok-values "42")        (list 42))
-(apl-test "num: large"              (tok-values "12345")     (list 12345))
-(apl-test "num: negative"           (tok-values "¯5")        (list -5))
-(apl-test "num: negative zero"      (tok-values "¯0")        (list 0))
-(apl-test "num: strand count"       (tok-count "1 2 3")      3)
-(apl-test "num: strand types"       (tok-types "1 2 3")      (list :num :num :num))
-(apl-test "num: strand values"      (tok-values "1 2 3")     (list 1 2 3))
-(apl-test "num: neg in strand"      (tok-values "1 ¯2 3")    (list 1 -2 3))
-(apl-test "str: empty"              (tok-values "''")        (list ""))
-(apl-test "str: single char"        (tok-values "'a'")       (list "a"))
-(apl-test "str: word"               (tok-values "'hello'")   (list "hello"))
-(apl-test "str: escaped quote"      (tok-values "''''")      (list "'"))
-(apl-test "str: type"               (tok-types "'abc'")      (list :str))
-(apl-test "name: simple"            (tok-values "foo")       (list "foo"))
-(apl-test "name: type"              (tok-types "foo")        (list :name))
-(apl-test "name: mixed case"        (tok-values "MyVar")     (list "MyVar"))
-(apl-test "name: with digits"       (tok-values "x1")        (list "x1"))
-(apl-test "name: system var"        (tok-values "⎕IO")       (list "⎕IO"))
-(apl-test "name: system var type"   (tok-types "⎕IO")        (list :name))
-(apl-test "glyph: plus"             (tok-types "+")          (list :glyph))
-(apl-test "glyph: plus value"       (tok-values "+")         (list "+"))
-(apl-test "glyph: iota"             (tok-values "⍳")         (list "⍳"))
-(apl-test "glyph: reduce"           (tok-values "+/")        (list "+" "/"))
-(apl-test "glyph: floor"            (tok-values "⌊")         (list "⌊"))
-(apl-test "glyph: rho"              (tok-values "⍴")         (list "⍴"))
-(apl-test "glyph: alpha omega"      (tok-types "⍺ ⍵")        (list :glyph :glyph))
-(apl-test "punct: lparen"           (tok-types "(")          (list :lparen))
-(apl-test "punct: rparen"           (tok-types ")")          (list :rparen))
-(apl-test "punct: brackets"         (tok-types "[42]")       (list :lbracket :num :rbracket))
-(apl-test "punct: braces"           (tok-types "{}")         (list :lbrace :rbrace))
-(apl-test "punct: semi"             (tok-types ";")          (list :semi))
-(apl-test "assign: arrow"           (tok-types "x←1")        (list :name :assign :num))
-(apl-test "diamond: separator"      (tok-types "1⋄2")        (list :num :diamond :num))
-(apl-test "newline: emitted"        (tok-types "1\n2")       (list :num :newline :num))
-(apl-test "comment: skipped"        (tok-count "⍝ ignore me") 0)
-(apl-test "comment: rest ignored"   (tok-count "1 ⍝ note")  1)
-(apl-test "colon: bare"             (tok-types ":")          (list :colon))
-(apl-test "keyword: If"             (tok-values ":If")       (list ":If"))
-(apl-test "keyword: type"           (tok-types ":While")     (list :keyword))
-(apl-test "keyword: EndFor"         (tok-values ":EndFor")   (list ":EndFor"))
-(apl-test "expr: +/ ⍳ 5"           (tok-types "+/ ⍳ 5")     (list :glyph :glyph :glyph :num))
-(apl-test "expr: x←42"             (tok-count "x←42")       3)
-(apl-test "expr: dfn body"          (tok-types "{⍺+⍵}")
-                                    (list :lbrace :glyph :glyph :glyph :rbrace))
-
-(define apl-tokenize-test-summary
-  (str "tokenizer " apl-test-pass "/" apl-test-count
-       (if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))
-
-; ===========================================================================
-; Parser tests
-; ===========================================================================
-
-; Helper: parse an APL source string and return the AST
-(define parse
-  (fn (src) (parse-apl src)))
-
-; Helper: build an expected AST node using keyword-tagged lists
-(define num-node    (fn (n)       (list :num n)))
-(define str-node    (fn (s)       (list :str s)))
-(define name-node   (fn (n)       (list :name n)))
-(define fn-node     (fn (g)       (list :fn-glyph g)))
-(define fn-nm       (fn (n)       (list :fn-name n)))
-(define assign-node (fn (nm expr) (list :assign nm expr)))
-(define monad-node  (fn (f a)     (list :monad f a)))
-(define dyad-node   (fn (f l r)   (list :dyad f l r)))
-(define derived-fn  (fn (op f)    (list :derived-fn op f)))
-(define derived-fn2 (fn (op f g)  (list :derived-fn2 op f g)))
-(define outer-node  (fn (f)       (list :outer "∘." f)))
-(define guard-node  (fn (c e)     (list :guard c e)))
-
-; ---- numeric literals ----
-
-(apl-test "parse: num literal"
-  (parse "42")
-  (num-node 42))
-
-(apl-test "parse: negative num"
-  (parse "¯3")
-  (num-node -3))
-
-(apl-test "parse: zero"
-  (parse "0")
-  (num-node 0))
-
-; ---- string literals ----
-
-(apl-test "parse: str literal"
-  (parse "'hello'")
-  (str-node "hello"))
-
-(apl-test "parse: empty str"
-  (parse "''")
-  (str-node ""))
-
-; ---- name reference ----
-
-(apl-test "parse: name"
-  (parse "x")
-  (name-node "x"))
-
-(apl-test "parse: system name"
-  (parse "⎕IO")
-  (name-node "⎕IO"))
-
-; ---- strands (vec nodes) ----
-
-(apl-test "parse: strand 3 nums"
-  (parse "1 2 3")
-  (list :vec (num-node 1) (num-node 2) (num-node 3)))
-
-(apl-test "parse: strand 2 nums"
-  (parse "1 2")
-  (list :vec (num-node 1) (num-node 2)))
-
-(apl-test "parse: strand with negatives"
-  (parse "1 ¯2 3")
-  (list :vec (num-node 1) (num-node -2) (num-node 3)))
-
-; ---- assignment ----
-
-(apl-test "parse: assignment"
-  (parse "x←42")
-  (assign-node "x" (num-node 42)))
-
-(apl-test "parse: assignment with spaces"
-  (parse "x ← 42")
-  (assign-node "x" (num-node 42)))
-
-(apl-test "parse: assignment of expr"
-  (parse "r←2+3")
-  (assign-node "r" (dyad-node (fn-node "+") (num-node 2) (num-node 3))))
-
-; ---- monadic functions ----
-
-(apl-test "parse: monadic iota"
-  (parse "⍳5")
-  (monad-node (fn-node "⍳") (num-node 5)))
-
-(apl-test "parse: monadic iota with space"
-  (parse "⍳ 5")
-  (monad-node (fn-node "⍳") (num-node 5)))
-
-(apl-test "parse: monadic negate"
-  (parse "-3")
-  (monad-node (fn-node "-") (num-node 3)))
-
-(apl-test "parse: monadic floor"
-  (parse "⌊2")
-  (monad-node (fn-node "⌊") (num-node 2)))
-
-(apl-test "parse: monadic of name"
-  (parse "⍴x")
-  (monad-node (fn-node "⍴") (name-node "x")))
-
-; ---- dyadic functions ----
-
-(apl-test "parse: dyadic plus"
-  (parse "2+3")
-  (dyad-node (fn-node "+") (num-node 2) (num-node 3)))
-
-(apl-test "parse: dyadic times"
-  (parse "2×3")
-  (dyad-node (fn-node "×") (num-node 2) (num-node 3)))
-
-(apl-test "parse: dyadic with names"
-  (parse "x+y")
-  (dyad-node (fn-node "+") (name-node "x") (name-node "y")))
-
-; ---- right-to-left evaluation ----
-
-(apl-test "parse: right-to-left 2×3+4"
-  (parse "2×3+4")
-  (dyad-node (fn-node "×") (num-node 2)
-    (dyad-node (fn-node "+") (num-node 3) (num-node 4))))
-
-(apl-test "parse: right-to-left chain"
-  (parse "1+2×3-4")
-  (dyad-node (fn-node "+") (num-node 1)
-    (dyad-node (fn-node "×") (num-node 2)
-      (dyad-node (fn-node "-") (num-node 3) (num-node 4)))))
-
-; ---- parenthesized subexpressions ----
-
-(apl-test "parse: parens override order"
-  (parse "(2+3)×4")
-  (dyad-node (fn-node "×")
-    (dyad-node (fn-node "+") (num-node 2) (num-node 3))
-    (num-node 4)))
-
-(apl-test "parse: nested parens"
-  (parse "((2+3))")
-  (dyad-node (fn-node "+") (num-node 2) (num-node 3)))
-
-(apl-test "parse: paren in dyadic right"
-  (parse "2×(3+4)")
-  (dyad-node (fn-node "×") (num-node 2)
-    (dyad-node (fn-node "+") (num-node 3) (num-node 4))))
-
-; ---- operators → derived functions ----
-
-(apl-test "parse: reduce +"
-  (parse "+/x")
-  (monad-node (derived-fn "/" (fn-node "+")) (name-node "x")))
-
-(apl-test "parse: reduce iota"
-  (parse "+/⍳5")
-  (monad-node (derived-fn "/" (fn-node "+"))
-    (monad-node (fn-node "⍳") (num-node 5))))
-
-(apl-test "parse: scan"
-  (parse "+\\x")
-  (monad-node (derived-fn "\\" (fn-node "+")) (name-node "x")))
-
-(apl-test "parse: each"
-  (parse "⍳¨x")
-  (monad-node (derived-fn "¨" (fn-node "⍳")) (name-node "x")))
-
-(apl-test "parse: commute"
-  (parse "-⍨3")
-  (monad-node (derived-fn "⍨" (fn-node "-")) (num-node 3)))
-
-(apl-test "parse: stacked ops"
-  (parse "+/¨x")
-  (monad-node (derived-fn "¨" (derived-fn "/" (fn-node "+"))) (name-node "x")))
-
-; ---- outer product ----
-
-(apl-test "parse: outer product monadic"
-  (parse "∘.×")
-  (outer-node (fn-node "×")))
-
-(apl-test "parse: outer product dyadic names"
-  (parse "x ∘.× y")
-  (dyad-node (outer-node (fn-node "×")) (name-node "x") (name-node "y")))
-
-(apl-test "parse: outer product dyadic strands"
-  (parse "1 2 3 ∘.× 4 5 6")
-  (dyad-node (outer-node (fn-node "×"))
-    (list :vec (num-node 1) (num-node 2) (num-node 3))
-    (list :vec (num-node 4) (num-node 5) (num-node 6))))
-
-; ---- inner product ----
-
-(apl-test "parse: inner product"
-  (parse "+.×")
-  (derived-fn2 "." (fn-node "+") (fn-node "×")))
-
-(apl-test "parse: inner product applied"
-  (parse "a +.× b")
-  (dyad-node (derived-fn2 "." (fn-node "+") (fn-node "×"))
-    (name-node "a") (name-node "b")))
-
-; ---- dfn (anonymous function) ----
-
-(apl-test "parse: simple dfn"
-  (parse "{⍺+⍵}")
-  (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵"))))
-
-(apl-test "parse: monadic dfn"
-  (parse "{⍵×2}")
-  (list :dfn (dyad-node (fn-node "×") (name-node "⍵") (num-node 2))))
-
-(apl-test "parse: dfn self-ref"
-  (parse "{⍵≤1:1 ⋄ ⍵×∇ ⍵-1}")
-  (list :dfn
-    (guard-node (dyad-node (fn-node "≤") (name-node "⍵") (num-node 1)) (num-node 1))
-    (dyad-node (fn-node "×") (name-node "⍵")
-      (monad-node (fn-node "∇") (dyad-node (fn-node "-") (name-node "⍵") (num-node 1))))))
-
-; ---- dfn applied ----
-
-(apl-test "parse: dfn as function"
-  (parse "{⍺+⍵} 3")
-  (monad-node
-    (list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵")))
-    (num-node 3)))
-
-; ---- multi-statement ----
-
-(apl-test "parse: diamond separator"
-  (let ((result (parse "x←1 ⋄ x+2")))
-    (= (first result) :program))
-  true)
-
-(apl-test "parse: diamond first stmt"
-  (let ((result (parse "x←1 ⋄ x+2")))
-    (nth result 1))
-  (assign-node "x" (num-node 1)))
-
-(apl-test "parse: diamond second stmt"
-  (let ((result (parse "x←1 ⋄ x+2")))
-    (nth result 2))
-  (dyad-node (fn-node "+") (name-node "x") (num-node 2)))
-
-; ---- combined summary ----
-
-(define apl-parse-test-count (- apl-test-count 46))
-(define apl-parse-test-pass  (- apl-test-pass 46))
-
-(define apl-test-summary
-  (str
-    "tokenizer 46/46  |  "
-    "parser " apl-parse-test-pass "/" apl-parse-test-count
-    (if (= (len apl-test-fails) 0) "" (str "  FAILS: " apl-test-fails))))

lib/apl/tests/pipeline.sx

@@ -1,687 +0,0 @@
-; End-to-end pipeline tests: source string → tokenize → parse → eval-ast → array.
-; Verifies the full stack as a single function call (apl-run).
-
-(define mkrv (fn (arr) (get arr :ravel)))
-(define mksh (fn (arr) (get arr :shape)))
-
-; ---------- scalars ----------
-
-(apl-test "apl-run \"42\" → scalar 42" (mkrv (apl-run "42")) (list 42))
-
-(apl-test "apl-run \"¯7\" → scalar -7" (mkrv (apl-run "¯7")) (list -7))
-
-; ---------- strands ----------
-
-(apl-test
-  "apl-run \"1 2 3\" → vector"
-  (mkrv (apl-run "1 2 3"))
-  (list 1 2 3))
-
-(apl-test "apl-run \"1 2 3\" shape" (mksh (apl-run "1 2 3")) (list 3))
-
-; ---------- dyadic arithmetic ----------
-
-(apl-test "apl-run \"2 + 3\" → 5" (mkrv (apl-run "2 + 3")) (list 5))
-
-(apl-run "2 × 3 + 4")  ; right-to-left
-
-(apl-test
-  "apl-run \"2 × 3 + 4\" → 14 (right-to-left)"
-  (mkrv (apl-run "2 × 3 + 4"))
-  (list 14))
-
-(apl-test
-  "apl-run \"1 2 3 + 4 5 6\" → 5 7 9"
-  (mkrv (apl-run "1 2 3 + 4 5 6"))
-  (list 5 7 9))
-
-(apl-test
-  "apl-run \"3 × 1 2 3 4\" → scalar broadcast"
-  (mkrv (apl-run "3 × 1 2 3 4"))
-  (list 3 6 9 12))
-
-; ---------- monadic primitives ----------
-
-(apl-test
-  "apl-run \"⍳5\" → 1..5"
-  (mkrv (apl-run "⍳5"))
-  (list 1 2 3 4 5))
-
-(apl-test
-  "apl-run \"-3\" → -3 (monadic negate)"
-  (mkrv (apl-run "-3"))
-  (list -3))
-
-(apl-test
-  "apl-run \"⌈/ 1 3 9 5 7\" → 9 (max-reduce)"
-  (mkrv (apl-run "⌈/ 1 3 9 5 7"))
-  (list 9))
-
-(apl-test
-  "apl-run \"⌊/ 4 7 2 9 1 3\" → 1 (min-reduce)"
-  (mkrv (apl-run "⌊/ 4 7 2 9 1 3"))
-  (list 1))
-
-; ---------- operators ----------
-
-(apl-test "apl-run \"+/⍳5\" → 15" (mkrv (apl-run "+/⍳5")) (list 15))
-
-(apl-test "apl-run \"×/⍳5\" → 120" (mkrv (apl-run "×/⍳5")) (list 120))
-
-(apl-test
-  "apl-run \"⌈/3 1 4 1 5 9 2\" → 9"
-  (mkrv (apl-run "⌈/3 1 4 1 5 9 2"))
-  (list 9))
-
-(apl-test
-  "apl-run \"+\\\\⍳5\" → triangular numbers"
-  (mkrv (apl-run "+\\⍳5"))
-  (list 1 3 6 10 15))
-
-; ---------- outer / inner products ----------
-
-(apl-test
-  "apl-run \"1 2 3 ∘.× 1 2 3\" → mult table values"
-  (mkrv (apl-run "1 2 3 ∘.× 1 2 3"))
-  (list 1 2 3 2 4 6 3 6 9))
-
-(apl-test
-  "apl-run \"1 2 3 +.× 4 5 6\" → dot product 32"
-  (mkrv (apl-run "1 2 3 +.× 4 5 6"))
-  (list 32))
-
-; ---------- shape ----------
-
-(apl-test
-  "apl-run \"⍴ 1 2 3 4 5\" → 5"
-  (mkrv (apl-run "⍴ 1 2 3 4 5"))
-  (list 5))
-
-(apl-test "apl-run \"⍴⍳10\" → 10" (mkrv (apl-run "⍴⍳10")) (list 10))
-
-; ---------- comparison ----------
-
-(apl-test "apl-run \"3 < 5\" → 1" (mkrv (apl-run "3 < 5")) (list 1))
-
-(apl-test "apl-run \"5 = 5\" → 1" (mkrv (apl-run "5 = 5")) (list 1))
-
-(apl-test
-  "apl-run \"1 2 3 = 1 0 3\" → 1 0 1"
-  (mkrv (apl-run "1 2 3 = 1 0 3"))
-  (list 1 0 1))
-
-; ---------- famous one-liners ----------
-
-(apl-test
-  "apl-run \"+/(⍳10)\" → sum 1..10 = 55"
-  (mkrv (apl-run "+/(⍳10)"))
-  (list 55))
-
-(apl-test
-  "apl-run \"×/⍳10\" → 10! = 3628800"
-  (mkrv (apl-run "×/⍳10"))
-  (list 3628800))
-
-(apl-test "apl-run \"⎕IO\" → 1" (mkrv (apl-run "⎕IO")) (list 1))
-
-(apl-test "apl-run \"⎕ML\" → 1" (mkrv (apl-run "⎕ML")) (list 1))
-
-(apl-test "apl-run \"⎕FR\" → 1248" (mkrv (apl-run "⎕FR")) (list 1248))
-
-(apl-test "apl-run \"⎕TS\" shape (7)" (mksh (apl-run "⎕TS")) (list 7))
-
-(apl-test "apl-run \"⎕FMT 42\" → \"42\"" (apl-run "⎕FMT 42") "42")
-
-(apl-test
-  "apl-run \"⎕FMT 1 2 3\" → \"1 2 3\""
-  (apl-run "⎕FMT 1 2 3")
-  "1 2 3")
-
-(apl-test
-  "apl-run \"⎕FMT ⍳5\" → \"1 2 3 4 5\""
-  (apl-run "⎕FMT ⍳5")
-  "1 2 3 4 5")
-
-(apl-test "apl-run \"⎕IO + 4\" → 5" (mkrv (apl-run "⎕IO + 4")) (list 5))
-
-(apl-test
-  "apl-run \"(10 20 30 40 50)[3]\" → 30"
-  (mkrv (apl-run "(10 20 30 40 50)[3]"))
-  (list 30))
-
-(apl-test
-  "apl-run \"(⍳10)[5]\" → 5"
-  (mkrv (apl-run "(⍳10)[5]"))
-  (list 5))
-
-(apl-test
-  "apl-run \"A ← 100 200 300 ⋄ A[2]\" → 200"
-  (mkrv (apl-run "A ← 100 200 300 ⋄ A[2]"))
-  (list 200))
-
-(apl-test
-  "apl-run \"V ← ⍳10 ⋄ V[3]\" → 3"
-  (mkrv (apl-run "V ← ⍳10 ⋄ V[3]"))
-  (list 3))
-
-(apl-test
-  "apl-run \"(10 20 30)[1]\" → 10 (1-indexed)"
-  (mkrv (apl-run "(10 20 30)[1]"))
-  (list 10))
-
-(apl-test
-  "apl-run \"V ← 10 20 30 40 50 ⋄ V[3] + 1\" → 31"
-  (mkrv (apl-run "V ← 10 20 30 40 50 ⋄ V[3] + 1"))
-  (list 31))
-
-(apl-test
-  "apl-run \"(⍳5)[3] × 7\" → 21"
-  (mkrv (apl-run "(⍳5)[3] × 7"))
-  (list 21))
-
-(apl-test "decimal: 3.7 → 3.7" (mkrv (apl-run "3.7")) (list 3.7))
-
-(apl-test "decimal: ¯2.5 → -2.5" (mkrv (apl-run "¯2.5")) (list -2.5))
-
-(apl-test "decimal: 1.5 + 2.5 → 4" (mkrv (apl-run "1.5 + 2.5")) (list 4))
-
-(apl-test "decimal: ⌊3.7 → 3" (mkrv (apl-run "⌊ 3.7")) (list 3))
-
-(apl-test "decimal: ⌈3.7 → 4" (mkrv (apl-run "⌈ 3.7")) (list 4))
-
-(apl-test
-  "⎕← scalar passthrough"
-  (mkrv (apl-run "⎕← 42"))
-  (list 42))
-
-(apl-test
-  "⎕← vector passthrough"
-  (mkrv (apl-run "⎕← 1 2 3"))
-  (list 1 2 3))
-
-(apl-test
-  "string: 'abc' → 3-char vector"
-  (mkrv (apl-run "'abc'"))
-  (list "a" "b" "c"))
-
-(apl-test "string: 'a' is rank-0 scalar" (mksh (apl-run "'a'")) (list))
-
-(apl-test "string: 'hello' shape (5)" (mksh (apl-run "'hello'")) (list 5))
-
-(apl-test
-  "named-fn: f ← {⍺+⍵} ⋄ 3 f 4 → 7"
-  (mkrv (apl-run "f ← {⍺+⍵} ⋄ 3 f 4"))
-  (list 7))
-
-(apl-test
-  "named-fn monadic: sq ← {⍵×⍵} ⋄ sq 7 → 49"
-  (mkrv (apl-run "sq ← {⍵×⍵} ⋄ sq 7"))
-  (list 49))
-
-(apl-test
-  "named-fn dyadic: hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4 → 25"
-  (mkrv (apl-run "hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4"))
-  (list 25))
-
-(apl-test
-  "named-fn: dbl ← {⍵+⍵} ⋄ dbl ⍳5"
-  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ dbl ⍳5"))
-  (list 2 4 6 8 10))
-
-(apl-test
-  "named-fn factorial via ∇ recursion"
-  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
-  (list 120))
-
-(apl-test
-  "named-fn used twice in expr: dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"
-  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"))
-  (list 14))
-
-(apl-test
-  "named-fn with vector arg: neg ← {-⍵} ⋄ neg 1 2 3"
-  (mkrv (apl-run "neg ← {-⍵} ⋄ neg 1 2 3"))
-  (list -1 -2 -3))
-
-(apl-test
-  "multi-axis: M[2;2] → center"
-  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[2;2]"))
-  (list 5))
-
-(apl-test
-  "multi-axis: M[1;] → first row"
-  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
-  (list 1 2 3))
-
-(apl-test
-  "multi-axis: M[;2] → second column"
-  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[;2]"))
-  (list 2 5 8))
-
-(apl-test
-  "multi-axis: M[1 2;1 2] → 2x2 block"
-  (mkrv (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
-  (list 1 2 4 5))
-
-(apl-test
-  "multi-axis: M[1 2;1 2] shape (2 2)"
-  (mksh (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
-  (list 2 2))
-
-(apl-test
-  "multi-axis: M[;] full matrix"
-  (mkrv (apl-run "M ← (2 2) ⍴ 10 20 30 40 ⋄ M[;]"))
-  (list 10 20 30 40))
-
-(apl-test
-  "multi-axis: M[1;] shape collapsed"
-  (mksh (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
-  (list 3))
-
-(apl-test
-  "multi-axis: select all rows of column 3"
-  (mkrv (apl-run "M ← (4 3) ⍴ 1 2 3 4 5 6 7 8 9 10 11 12 ⋄ M[;3]"))
-  (list 3 6 9 12))
-
-(apl-test
-  "train: mean = (+/÷≢) on 1..5"
-  (mkrv (apl-run "(+/÷≢) 1 2 3 4 5"))
-  (list 3))
-
-(apl-test
-  "train: mean of 2 4 6 8 10"
-  (mkrv (apl-run "(+/÷≢) 2 4 6 8 10"))
-  (list 6))
-
-(apl-test
-  "train 2-atop: (- ⌊) 5 → -5"
-  (mkrv (apl-run "(- ⌊) 5"))
-  (list -5))
-
-(apl-test
-  "train 3-fork dyadic: 2(+×-)5 → -21"
-  (mkrv (apl-run "2 (+ × -) 5"))
-  (list -21))
-
-(apl-test
-  "train: range = (⌈/-⌊/) on vector"
-  (mkrv (apl-run "(⌈/-⌊/) 3 1 4 1 5 9 2 6"))
-  (list 8))
-
-(apl-test
-  "train: mean of ⍳10 has shape ()"
-  (mksh (apl-run "(+/÷≢) ⍳10"))
-  (list))
-
-(apl-test
-  "compress: 1 0 1 0 1 / 10 20 30 40 50"
-  (mkrv (apl-run "1 0 1 0 1 / 10 20 30 40 50"))
-  (list 10 30 50))
-
-(apl-test
-  "compress: empty mask → empty"
-  (mkrv (apl-run "0 0 0 / 1 2 3"))
-  (list))
-
-(apl-test
-  "primes via classic idiom (multi-stmt)"
-  (mkrv (apl-run "P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
-  (list 2 3 5 7 11 13 17 19 23 29))
-
-(apl-test
-  "primes via classic idiom (n=20)"
-  (mkrv (apl-run "P ← ⍳ 20 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
-  (list 2 3 5 7 11 13 17 19))
-
-(apl-test
-  "compress: filter even values"
-  (mkrv (apl-run "(0 = 2 | 1 2 3 4 5 6) / 1 2 3 4 5 6"))
-  (list 2 4 6))
-
-(apl-test "inline-assign: x ← 5" (mkrv (apl-run "x ← 5")) (list 5))
-
-(apl-test
-  "inline-assign: (2×x) + x←10 → 30"
-  (mkrv (apl-run "(2 × x) + x ← 10"))
-  (list 30))
-
-(apl-test
-  "inline-assign primes one-liner: (2=+⌿0=a∘.|a)/a←⍳30"
-  (mkrv (apl-run "(2 = +⌿ 0 = a ∘.| a) / a ← ⍳ 30"))
-  (list 2 3 5 7 11 13 17 19 23 29))
-
-(apl-test
-  "inline-assign: x is reusable — x + x ← 7 → 14"
-  (mkrv (apl-run "x + x ← 7"))
-  (list 14))
-
-(apl-test
-  "inline-assign in dfn: f ← {x + x ← ⍵} ⋄ f 8 → 16"
-  (mkrv (apl-run "f ← {x + x ← ⍵} ⋄ f 8"))
-  (list 16))
-
-(begin (apl-rng-seed! 42) nil)
-
-(apl-test
-  "?10 with seed 42 → 8 (deterministic)"
-  (mkrv (apl-run "?10"))
-  (list 8))
-
-(apl-test "?10 next call → 5" (mkrv (apl-run "?10")) (list 5))
-
-(apl-test
-  "?100 stays in range"
-  (let ((v (first (mkrv (apl-run "?100"))))) (and (>= v 1) (<= v 100)))
-  true)
-
-(begin (apl-rng-seed! 42) nil)
-
-(apl-test
-  "?10 with re-seed 42 → 8 (reproducible)"
-  (mkrv (apl-run "?10"))
-  (list 8))
-
-(apl-test
-  "apl-run-file: load primes.apl returns dfn AST"
-  (first (apl-run-file "lib/apl/tests/programs/primes.apl"))
-  :dfn)
-
-(apl-test
-  "apl-run-file: life.apl parses without error"
-  (first (apl-run-file "lib/apl/tests/programs/life.apl"))
-  :dfn)
-
-(apl-test
-  "apl-run-file: quicksort.apl parses without error"
-  (first (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
-  :dfn)
-
-(apl-test
-  "apl-run-file: source-then-call returns primes count"
-  (mksh
-    (apl-run
-      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 30")))
-  (list 10))
-
-(apl-test
-  "primes one-liner with ⍵-rebind: primes 30"
-  (mkrv
-    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 30"))
-  (list 2 3 5 7 11 13 17 19 23 29))
-
-(apl-test
-  "primes one-liner: primes 50"
-  (mkrv
-    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"))
-  (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
-
-(apl-test
-  "primes.apl loaded + called via apl-run-file"
-  (mkrv
-    (apl-run
-      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 20")))
-  (list 2 3 5 7 11 13 17 19))
-
-(apl-test
-  "primes.apl loaded — count of primes ≤ 100"
-  (first
-    (mksh
-      (apl-run
-        (str
-          (file-read "lib/apl/tests/programs/primes.apl")
-          " ⋄ primes 100"))))
-  25)
-
-(apl-test
-  "⍉ monadic transpose 2x3 → 3x2"
-  (mkrv (apl-run "⍉ (2 3) ⍴ ⍳6"))
-  (list 1 4 2 5 3 6))
-
-(apl-test
-  "⍉ transpose shape (3 2)"
-  (mksh (apl-run "⍉ (2 3) ⍴ ⍳6"))
-  (list 3 2))
-
-(apl-test "⊢ monadic identity" (mkrv (apl-run "⊢ 1 2 3")) (list 1 2 3))
-
-(apl-test
-  "5 ⊣ 1 2 3 → 5 (left)"
-  (mkrv (apl-run "5 ⊣ 1 2 3"))
-  (list 5))
-
-(apl-test
-  "5 ⊢ 1 2 3 → 1 2 3 (right)"
-  (mkrv (apl-run "5 ⊢ 1 2 3"))
-  (list 1 2 3))
-
-(apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42")
-
-(begin
-  (apl-test
-    "⍸ where: indices of truthy cells"
-    (mkrv (apl-run "⍸ 0 1 0 1 1"))
-    (list 2 4 5))
-  (apl-test
-    "⍸ where: leading truthy"
-    (mkrv (apl-run "⍸ 1 0 0 1 1"))
-    (list 1 4 5))
-  (apl-test
-    "⍸ where: all-zero → empty"
-    (mkrv (apl-run "⍸ 0 0 0"))
-    (list))
-  (apl-test
-    "⍸ where: all-truthy"
-    (mkrv (apl-run "⍸ 1 1 1"))
-    (list 1 2 3))
-  (apl-test
-    "⍸ where: ⎕IO=1 (1-based)"
-    (mkrv (apl-run "⍸ (⍳5)=3"))
-    (list 3))
-  (apl-test
-    "⍸ interval-index: 2 4 6 ⍸ 5 → 2"
-    (mkrv (apl-run "2 4 6 ⍸ 5"))
-    (list 2))
-  (apl-test
-    "⍸ interval-index: 2 4 6 ⍸ 1 3 5 6 7 → 0 1 2 3 3"
-    (mkrv (apl-run "2 4 6 ⍸ 1 3 5 6 7"))
-    (list 0 1 2 3 3))
-  (apl-test
-    "⍸ interval-index: ⍳5 ⍸ 3 → 3"
-    (mkrv (apl-run "(⍳5) ⍸ 3"))
-    (list 3))
-  (apl-test
-    "⍸ interval-index: y below all → 0"
-    (mkrv (apl-run "10 20 30 ⍸ 5"))
-    (list 0))
-  (apl-test
-    "⍸ interval-index: y above all → len breaks"
-    (mkrv (apl-run "10 20 30 ⍸ 100"))
-    (list 3)))
-
-(begin
-  (apl-test
-    "∪ unique: dedup keeps first-occurrence order"
-    (mkrv (apl-run "∪ 1 2 1 3 2 1 4"))
-    (list 1 2 3 4))
-  (apl-test
-    "∪ unique: already-unique unchanged"
-    (mkrv (apl-run "∪ 5 4 3 2 1"))
-    (list 5 4 3 2 1))
-  (apl-test "∪ unique: scalar" (mkrv (apl-run "∪ 7")) (list 7))
-  (apl-test
-    "∪ unique: string mississippi → misp"
-    (mkrv (apl-run "∪ 'mississippi'"))
-    (list "m" "i" "s" "p"))
-  (apl-test
-    "∪ union: 1 2 3 ∪ 3 4 5 → 1 2 3 4 5"
-    (mkrv (apl-run "1 2 3 ∪ 3 4 5"))
-    (list 1 2 3 4 5))
-  (apl-test
-    "∪ union: dedups left side too"
-    (mkrv (apl-run "1 2 1 ∪ 1 3 2"))
-    (list 1 2 3))
-  (apl-test
-    "∪ union: disjoint → catenated"
-    (mkrv (apl-run "1 2 ∪ 3 4"))
-    (list 1 2 3 4))
-  (apl-test
-    "∩ intersection: 1 2 3 4 ∩ 2 4 6 → 2 4"
-    (mkrv (apl-run "1 2 3 4 ∩ 2 4 6"))
-    (list 2 4))
-  (apl-test
-    "∩ intersection: disjoint → empty"
-    (mkrv (apl-run "1 2 3 ∩ 4 5 6"))
-    (list))
-  (apl-test
-    "∩ intersection: preserves left order"
-    (mkrv (apl-run "(⍳5) ∩ 5 3 1"))
-    (list 1 3 5))
-  (apl-test
-    "∩ intersection: identical"
-    (mkrv (apl-run "1 2 3 ∩ 1 2 3"))
-    (list 1 2 3))
-  (apl-test
-    "∪/∩ identity: A ∪ A = ∪A"
-    (mkrv (apl-run "1 2 1 ∪ 1 2 1"))
-    (list 1 2)))
-
-(begin
-  (apl-test
-    "⊥ decode: 2 2 2 ⊥ 1 0 1 → 5"
-    (mkrv (apl-run "2 2 2 ⊥ 1 0 1"))
-    (list 5))
-  (apl-test
-    "⊥ decode: 10 10 10 ⊥ 1 2 3 → 123"
-    (mkrv (apl-run "10 10 10 ⊥ 1 2 3"))
-    (list 123))
-  (apl-test
-    "⊥ decode: 24 60 60 ⊥ 2 3 4 → 7384 (mixed-radix HMS)"
-    (mkrv (apl-run "24 60 60 ⊥ 2 3 4"))
-    (list 7384))
-  (apl-test
-    "⊥ decode: scalar base 2 ⊥ 1 0 1 0 → 10"
-    (mkrv (apl-run "2 ⊥ 1 0 1 0"))
-    (list 10))
-  (apl-test
-    "⊥ decode: 16 16 ⊥ 15 15 → 255"
-    (mkrv (apl-run "16 16 ⊥ 15 15"))
-    (list 255))
-  (apl-test
-    "⊤ encode: 2 2 2 ⊤ 5 → 1 0 1"
-    (mkrv (apl-run "2 2 2 ⊤ 5"))
-    (list 1 0 1))
-  (apl-test
-    "⊤ encode: 24 60 60 ⊤ 7384 → 2 3 4 (HMS)"
-    (mkrv (apl-run "24 60 60 ⊤ 7384"))
-    (list 2 3 4))
-  (apl-test
-    "⊤ encode: 2 2 2 2 ⊤ 13 → 1 1 0 1"
-    (mkrv (apl-run "2 2 2 2 ⊤ 13"))
-    (list 1 1 0 1))
-  (apl-test
-    "⊤ encode: 10 10 ⊤ 42 → 4 2"
-    (mkrv (apl-run "10 10 ⊤ 42"))
-    (list 4 2))
-  (apl-test
-    "⊤ encode: round-trip B⊥(B⊤N) = N"
-    (mkrv (apl-run "24 60 60 ⊥ 24 60 60 ⊤ 7384"))
-    (list 7384))
-  (apl-test
-    "⊥ decode: round-trip B⊤(B⊥V) = V"
-    (mkrv (apl-run "2 2 2 ⊤ 2 2 2 ⊥ 1 0 1"))
-    (list 1 0 1)))
-
-(begin
-  (define
-    mk-parts
-    (fn (s) (map (fn (p) (get p :ravel)) (get (apl-run s) :ravel))))
-  (apl-test
-    "⊆ partition: 1 1 0 1 1 ⊆ 'abcde' → ('ab' 'de')"
-    (mk-parts "1 1 0 1 1 ⊆ 'abcde'")
-    (list (list "a" "b") (list "d" "e")))
-  (apl-test
-    "⊆ partition: 1 0 0 1 1 ⊆ ⍳5 → ((1) (4 5))"
-    (mk-parts "1 0 0 1 1 ⊆ ⍳5")
-    (list (list 1) (list 4 5)))
-  (apl-test
-    "⊆ partition: all-zero mask → empty"
-    (len (get (apl-run "0 0 0 ⊆ 1 2 3") :ravel))
-    0)
-  (apl-test
-    "⊆ partition: all-one mask → single partition"
-    (mk-parts "1 1 1 ⊆ 7 8 9")
-    (list (list 7 8 9)))
-  (apl-test
-    "⊆ partition: strict increase 1 2 starts new"
-    (mk-parts "1 2 ⊆ 10 20")
-    (list (list 10) (list 20)))
-  (apl-test
-    "⊆ partition: same level continues 2 2 → one partition"
-    (mk-parts "2 2 ⊆ 10 20")
-    (list (list 10 20)))
-  (apl-test
-    "⊆ partition: 0 separates"
-    (mk-parts "1 1 0 0 1 ⊆ 1 2 3 4 5")
-    (list (list 1 2) (list 5)))
-  (apl-test
-    "⊆ partition: outer length matches partition count"
-    (len (get (apl-run "1 0 1 0 1 ⊆ ⍳5") :ravel))
-    3))
-
-(begin
-  (apl-test
-    "⍎ execute: ⍎ '1 + 2' → 3"
-    (mkrv (apl-run "⍎ '1 + 2'"))
-    (list 3))
-  (apl-test
-    "⍎ execute: ⍎ '+/⍳10' → 55"
-    (mkrv (apl-run "⍎ '+/⍳10'"))
-    (list 55))
-  (apl-test
-    "⍎ execute: ⍎ '⌈/ 1 3 9 5 7' → 9"
-    (mkrv (apl-run "⍎ '⌈/ 1 3 9 5 7'"))
-    (list 9))
-  (apl-test
-    "⍎ execute: ⍎ '⍳5' → 1..5"
-    (mkrv (apl-run "⍎ '⍳5'"))
-    (list 1 2 3 4 5))
-  (apl-test
-    "⍎ execute: ⍎ '×/⍳5' → 120"
-    (mkrv (apl-run "⍎ '×/⍳5'"))
-    (list 120))
-  (apl-test
-    "⍎ execute: round-trip ⍎ ⎕FMT 42 → 42"
-    (mkrv (apl-run "⍎ ⎕FMT 42"))
-    (list 42))
-  (apl-test
-    "⍎ execute: nested ⍎ ⍎"
-    (mkrv (apl-run "⍎ '⍎ ''2 × 3'''"))
-    (list 6))
-  (apl-test
-    "⍎ execute: with assignment side-effect"
-    (mkrv (apl-run "⍎ 'q ← 99 ⋄ q + 1'"))
-    (list 100)))
-
-(begin
-  (apl-test
-    "het-inner: 1 ⍵ ∨.∧ X — result is enclosed (5 5)"
-    (let
-      ((r (apl-run "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ 1 B ∨.∧ X")))
-      (list
-        (len (get r :shape))
-        (= (type-of (first (get r :ravel))) "dict")))
-    (list 0 true))
-  (apl-test
-    "het-inner: ⊃ unwraps to (5 5) board"
-    (mksh
-      (apl-run
-        "B ← 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 ⋄ X ← 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂B ⋄ ⊃ 1 B ∨.∧ X"))
-    (list 5 5))
-  (apl-test
-    "het-inner: homogeneous inner product unaffected"
-    (mkrv (apl-run "1 2 3 +.× 4 5 6"))
-    (list 32))
-  (apl-test
-    "het-inner: matrix inner product unaffected"
-    (mkrv (apl-run "(2 2 ⍴ 1 2 3 4) +.× 2 2 ⍴ 5 6 7 8"))
-    (list 19 22 43 50)))

lib/apl/tests/programs-e2e.sx

@@ -1,189 +0,0 @@
-; End-to-end tests of the classic-program archetypes — running APL
-; source through the full pipeline (tokenize → parse → eval-ast → runtime).
-;
-; These mirror the algorithms documented in lib/apl/tests/programs/*.apl
-; but use forms our pipeline supports today (named functions instead of
-; the inline ⍵← rebinding idiom; multi-stmt over single one-liners).
-
-(define mkrv (fn (arr) (get arr :ravel)))
-(define mksh (fn (arr) (get arr :shape)))
-
-; ---------- factorial via ∇ recursion (cf. n-queens style) ----------
-
-(apl-test
-  "e2e: factorial 5! = 120"
-  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
-  (list 120))
-
-(apl-test
-  "e2e: factorial 7! = 5040"
-  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 7"))
-  (list 5040))
-
-(apl-test
-  "e2e: factorial via ×/⍳N (no recursion)"
-  (mkrv (apl-run "fact ← {×/⍳⍵} ⋄ fact 6"))
-  (list 720))
-
-; ---------- sum / triangular numbers (sum-1..N) ----------
-
-(apl-test
-  "e2e: triangular(10) = 55"
-  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 10"))
-  (list 55))
-
-(apl-test
-  "e2e: triangular(100) = 5050"
-  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 100"))
-  (list 5050))
-
-; ---------- sum of squares ----------
-
-(apl-test
-  "e2e: sum-of-squares 1..5 = 55"
-  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳5"))
-  (list 55))
-
-(apl-test
-  "e2e: sum-of-squares 1..10 = 385"
-  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳10"))
-  (list 385))
-
-; ---------- divisor-counting (prime-sieve building blocks) ----------
-
-(apl-test
-  "e2e: divisor counts 1..5 via outer mod"
-  (mkrv (apl-run "P ← ⍳ 5 ⋄ +⌿ 0 = P ∘.| P"))
-  (list 1 2 2 3 2))
-
-(apl-test
-  "e2e: divisor counts 1..10"
-  (mkrv (apl-run "P ← ⍳ 10 ⋄ +⌿ 0 = P ∘.| P"))
-  (list 1 2 2 3 2 4 2 4 3 4))
-
-(apl-test
-  "e2e: prime-mask 1..10 (count==2)"
-  (mkrv (apl-run "P ← ⍳ 10 ⋄ 2 = +⌿ 0 = P ∘.| P"))
-  (list 0 1 1 0 1 0 1 0 0 0))
-
-; ---------- monadic primitives chained ----------
-
-(apl-test
-  "e2e: sum of |abs| = 15"
-  (mkrv (apl-run "+/|¯1 ¯2 ¯3 ¯4 ¯5"))
-  (list 15))
-
-(apl-test
-  "e2e: max of squares 1..6"
-  (mkrv (apl-run "⌈/(⍳6)×⍳6"))
-  (list 36))
-
-; ---------- nested named functions ----------
-
-(apl-test
-  "e2e: compose dbl and sq via two named fns"
-  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ sq ← {⍵×⍵} ⋄ sq dbl 3"))
-  (list 36))
-
-(apl-test
-  "e2e: max-of-two as named dyadic fn"
-  (mkrv (apl-run "mx ← {⍺⌈⍵} ⋄ 5 mx 3"))
-  (list 5))
-
-(apl-test
-  "e2e: sqrt-via-newton 1 step from 1 → 2.5"
-  (mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
-  (list 2.5))
-
-(begin
-  (apl-test
-    "life.apl: blinker 5×5 → vertical blinker"
-    (mkrv
-      (apl-run
-        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
-    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))
-  (apl-test
-    "life.apl: blinker oscillates (period 2)"
-    (mkrv
-      (apl-run
-        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life life 5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0"))
-    (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))
-  (apl-test
-    "life.apl: 2×2 block stable"
-    (mkrv
-      (apl-run
-        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 4 4 ⍴ 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0"))
-    (list 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0))
-  (apl-test
-    "life.apl: empty grid stays empty"
-    (mkrv
-      (apl-run
-        "life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵} ⋄ life 5 5 ⍴ 0"))
-    (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
-  (apl-test
-    "life.apl: source-file as-written runs"
-    (let
-      ((dfn (apl-run-file "lib/apl/tests/programs/life.apl"))
-        (board
-          (apl-run "5 5 ⍴ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0")))
-      (get (apl-call-dfn-m dfn board) :ravel))
-    (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0)))
-
-(begin
-  (apl-test
-    "quicksort.apl: 11-element with duplicates"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 3 1 4 1 5 9 2 6 5 3 5")))
-    (list 1 1 2 3 3 4 5 5 5 6 9))
-  (apl-test
-    "quicksort.apl: already sorted"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 1 2 3 4 5")))
-    (list 1 2 3 4 5))
-  (apl-test
-    "quicksort.apl: reverse sorted"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 5 4 3 2 1")))
-    (list 1 2 3 4 5))
-  (apl-test
-    "quicksort.apl: all equal"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort 7 7 7 7")))
-    (list 7 7 7 7))
-  (apl-test
-    "quicksort.apl: single element"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort ,42")))
-    (list 42))
-  (apl-test
-    "quicksort.apl: matches grade-up"
-    (begin
-      (apl-rng-seed! 42)
-      (mkrv
-        (apl-run
-          "V ← 8 3 1 9 2 7 5 6 4 ⋄ quicksort ← {1≥≢⍵:⍵ ⋄ p←⍵⌷⍨?≢⍵ ⋄ (∇⍵⌿⍨⍵<p),(p=⍵)/⍵,∇⍵⌿⍨⍵>p} ⋄ quicksort V")))
-    (list 1 2 3 4 5 6 7 8 9))
-  (apl-test
-    "quicksort.apl: source-file as-written runs"
-    (begin
-      (apl-rng-seed! 42)
-      (let
-        ((dfn (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
-          (vec (apl-run "5 2 8 1 9 3 7 4 6")))
-        (get (apl-call-dfn-m dfn vec) :ravel)))
-    (list 1 2 3 4 5 6 7 8 9)))

lib/apl/tests/programs.sx

@@ -1,304 +0,0 @@
-; Tests for classic APL programs (lib/apl/tests/programs/*.apl).
-; Programs are showcase APL source; runtime impl is in lib/apl/runtime.sx.
-
-(define mkrv (fn (arr) (get arr :ravel)))
-(define mksh (fn (arr) (get arr :shape)))
-
-; ===== primes (Sieve of Eratosthenes) =====
-
-(apl-test "primes 1 → empty" (mkrv (apl-primes 1)) (list))
-
-(apl-test "primes 2 → just 2" (mkrv (apl-primes 2)) (list 2))
-
-(apl-test "primes 10 → 2 3 5 7" (mkrv (apl-primes 10)) (list 2 3 5 7))
-
-(apl-test
-  "primes 20 → 2 3 5 7 11 13 17 19"
-  (mkrv (apl-primes 20))
-  (list 2 3 5 7 11 13 17 19))
-
-(apl-test
-  "primes 30"
-  (mkrv (apl-primes 30))
-  (list 2 3 5 7 11 13 17 19 23 29))
-
-(apl-test
-  "primes 50"
-  (mkrv (apl-primes 50))
-  (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
-
-(apl-test "primes 7 length" (first (mksh (apl-primes 7))) 4)
-
-(apl-test "primes 100 has 25 primes" (first (mksh (apl-primes 100))) 25)
-
-; ===== compress helper sanity =====
-
-(apl-test
-  "compress 1 0 1 0 1 / 10 20 30 40 50"
-  (mkrv
-    (apl-compress
-      (make-array (list 5) (list 1 0 1 0 1))
-      (make-array (list 5) (list 10 20 30 40 50))))
-  (list 10 30 50))
-
-(apl-test
-  "compress all-zero mask → empty"
-  (mkrv
-    (apl-compress
-      (make-array (list 3) (list 0 0 0))
-      (make-array (list 3) (list 1 2 3))))
-  (list))
-
-(apl-test
-  "compress all-one mask → full vector"
-  (mkrv
-    (apl-compress
-      (make-array (list 3) (list 1 1 1))
-      (make-array (list 3) (list 1 2 3))))
-  (list 1 2 3))
-
-(apl-test
-  "life: empty 5x5 stays empty"
-  (mkrv
-    (apl-life-step
-      (make-array
-        (list 5 5)
-        (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
-  (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
-
-(apl-test
-  "life: horizontal blinker → vertical blinker"
-  (mkrv
-    (apl-life-step
-      (make-array
-        (list 5 5)
-        (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))))
-  (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))
-
-(apl-test
-  "life: vertical blinker → horizontal blinker"
-  (mkrv
-    (apl-life-step
-      (make-array
-        (list 5 5)
-        (list 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0))))
-  (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))
-
-(apl-test
-  "life: blinker has period 2"
-  (mkrv
-    (apl-life-step
-      (apl-life-step
-        (make-array
-          (list 5 5)
-          (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))))
-  (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))
-
-(apl-test
-  "life: 2x2 block stable on 5x5"
-  (mkrv
-    (apl-life-step
-      (make-array
-        (list 5 5)
-        (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0))))
-  (list 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0))
-
-(apl-test
-  "life: shape preserved"
-  (mksh
-    (apl-life-step
-      (make-array
-        (list 5 5)
-        (list 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0))))
-  (list 5 5))
-
-(apl-test
-  "life: glider on 6x6 advances"
-  (mkrv
-    (apl-life-step
-      (make-array
-        (list 6 6)
-        (list
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          1
-          0
-          0
-          0
-          0
-          0
-          0
-          1
-          0
-          0
-          0
-          1
-          1
-          1
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0
-          0))))
-  (list
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    1
-    0
-    1
-    0
-    0
-    0
-    0
-    1
-    1
-    0
-    0
-    0
-    0
-    1
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0
-    0))
-
-(apl-test
-  "mandelbrot c=0 stays bounded"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0)) 100))
-  (list 100))
-
-(apl-test
-  "mandelbrot c=-1 cycle bounded"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -1)) 100))
-  (list 100))
-
-(apl-test
-  "mandelbrot c=-2 boundary stays bounded"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -2)) 100))
-  (list 100))
-
-(apl-test
-  "mandelbrot c=0.25 boundary stays bounded"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0.25)) 100))
-  (list 100))
-
-(apl-test
-  "mandelbrot c=1 escapes at iter 3"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 1)) 100))
-  (list 3))
-
-(apl-test
-  "mandelbrot c=0.5 escapes at iter 5"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list 0.5)) 100))
-  (list 5))
-
-(apl-test
-  "mandelbrot batched grid (rank-polymorphic)"
-  (mkrv (apl-mandelbrot-1d (make-array (list 5) (list -2 -1 0 1 2)) 10))
-  (list 10 10 10 3 2))
-
-(apl-test
-  "mandelbrot batched preserves shape"
-  (mksh (apl-mandelbrot-1d (make-array (list 5) (list -2 -1 0 1 2)) 10))
-  (list 5))
-
-(apl-test
-  "mandelbrot c=-1.5 stays bounded"
-  (mkrv (apl-mandelbrot-1d (make-array (list 1) (list -1.5)) 100))
-  (list 100))
-
-(apl-test "queens 1 → 1 solution" (mkrv (apl-queens 1)) (list 1))
-
-(apl-test "queens 2 → 0 solutions" (mkrv (apl-queens 2)) (list 0))
-
-(apl-test "queens 3 → 0 solutions" (mkrv (apl-queens 3)) (list 0))
-
-(apl-test "queens 4 → 2 solutions" (mkrv (apl-queens 4)) (list 2))
-
-(apl-test "queens 5 → 10 solutions" (mkrv (apl-queens 5)) (list 10))
-
-(apl-test "queens 6 → 4 solutions" (mkrv (apl-queens 6)) (list 4))
-
-(apl-test "queens 7 → 40 solutions" (mkrv (apl-queens 7)) (list 40))
-
-(apl-test "permutations of 3 has 6" (len (apl-permutations 3)) 6)
-
-(apl-test "permutations of 4 has 24" (len (apl-permutations 4)) 24)
-
-(apl-test
-  "quicksort empty"
-  (mkrv (apl-quicksort (make-array (list 0) (list))))
-  (list))
-
-(apl-test
-  "quicksort single"
-  (mkrv (apl-quicksort (make-array (list 1) (list 42))))
-  (list 42))
-
-(apl-test
-  "quicksort already sorted"
-  (mkrv (apl-quicksort (make-array (list 5) (list 1 2 3 4 5))))
-  (list 1 2 3 4 5))
-
-(apl-test
-  "quicksort reverse sorted"
-  (mkrv (apl-quicksort (make-array (list 5) (list 5 4 3 2 1))))
-  (list 1 2 3 4 5))
-
-(apl-test
-  "quicksort with duplicates"
-  (mkrv (apl-quicksort (make-array (list 7) (list 3 1 4 1 5 9 2))))
-  (list 1 1 2 3 4 5 9))
-
-(apl-test
-  "quicksort all equal"
-  (mkrv (apl-quicksort (make-array (list 5) (list 7 7 7 7 7))))
-  (list 7 7 7 7 7))
-
-(apl-test
-  "quicksort negatives"
-  (mkrv (apl-quicksort (make-array (list 5) (list -3 1 -1 2 0))))
-  (list -3 -1 0 1 2))
-
-(apl-test
-  "quicksort 11-element pi"
-  (mkrv
-    (apl-quicksort (make-array (list 11) (list 3 1 4 1 5 9 2 6 5 3 5))))
-  (list 1 1 2 3 3 4 5 5 5 6 9))
-
-(apl-test
-  "quicksort preserves length"
-  (first
-    (mksh (apl-quicksort (make-array (list 7) (list 3 1 4 1 5 9 2)))))
-  7)

lib/apl/tests/programs/life.apl

@@ -1,22 +0,0 @@
-⍝ Conway's Game of Life — toroidal one-liner
-⍝
-⍝ The classic Roger Hui formulation:
-⍝   life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}
-⍝
-⍝ Read right-to-left:
-⍝   ⊂⍵                : enclose the board (so it's a single scalar item)
-⍝   ¯1 0 1 ⌽¨ ⊂⍵      : produce 3 horizontally-shifted copies
-⍝   ¯1 0 1 ∘.⊖ …      : outer-product with vertical shifts → 3×3 = 9 shifts
-⍝   +/ +/ …           : sum the 9 boards element-wise → neighbor-count + self
-⍝   3 4 = …           : leading-axis-extended boolean — count is 3 (born) or 4 (survive)
-⍝   1 ⍵ ∨.∧ …         : "alive next" iff (count=3) or (alive AND count=4)
-⍝   ⊃ …               : disclose the enclosed result back to a 2D board
-⍝
-⍝ Rules in plain language:
-⍝   - dead cell + 3 live neighbors → born
-⍝   - live cell + 2 or 3 live neighbors → survives
-⍝   - all else → dies
-⍝
-⍝ Toroidal: edges wrap (rotate is cyclic).
-
-life ← {⊃1 ⍵ ∨.∧ 3 4 = +/ +/ ¯1 0 1 ∘.⊖ ¯1 0 1 ⌽¨ ⊂⍵}

lib/apl/tests/programs/mandelbrot.apl

@@ -1,29 +0,0 @@
-⍝ Mandelbrot — real-axis subset
-⍝
-⍝ For complex c, the Mandelbrot set is { c : |z_n| stays bounded } where
-⍝   z_0 = 0, z_{n+1} = z_n² + c.
-⍝ Restricting c (and z) to ℝ gives the segment c ∈ [-2, 1/4]
-⍝ where the iteration stays bounded.
-⍝
-⍝ Rank-polymorphic batched-iteration form:
-⍝   mandelbrot ← {⍵ ⍵⍵ ⍺⍺ +,(⍺⍺ × ⍺⍺) }
-⍝
-⍝ Pseudocode (as we don't have ⎕ system fns yet):
-⍝   z      ← 0×c                             ⍝ start at zero
-⍝   alive  ← 1+0×c                           ⍝ all "still in"
-⍝   for k iterations:
-⍝     alive ← alive ∧ 4 ≥ z×z                ⍝ still bounded?
-⍝     z     ← alive × c + z×z                ⍝ freeze escaped via mask
-⍝     count ← count + alive                  ⍝ tally surviving iters
-⍝
-⍝ Examples (count after 100 iterations):
-⍝   c=0      : 100  (z stays at 0)
-⍝   c=-1     : 100  (cycles 0,-1,0,-1,...)
-⍝   c=-2     : 100  (settles at 2 — boundary)
-⍝   c=0.25   : 100  (boundary — converges to 0.5)
-⍝   c=0.5    : 5    (escapes by iteration 6)
-⍝   c=1      : 3    (escapes quickly)
-⍝
-⍝ Real-axis Mandelbrot set: bounded for c ∈ [-2, 0.25].
-
-mandelbrot ← {z←alive←count←0×⍵ ⋄ {alive←alive∧4≥z×z ⋄ z←alive×⍵+z×z ⋄ count+←alive}⍣⍺⊢⍵}

lib/apl/tests/programs/n-queens.apl

@@ -1,18 +0,0 @@
-⍝ N-Queens — count solutions to placing N non-attacking queens on N×N
-⍝
-⍝ A solution is encoded as a permutation P of 1..N where P[i] is the
-⍝ column of the queen in row i.  Rows and columns are then automatically
-⍝ unique (it's a permutation).  We must additionally rule out queens
-⍝ sharing a diagonal: |i-j| = |P[i]-P[j]| for any pair.
-⍝
-⍝ Backtracking via reduce — the classic Roger Hui style:
-⍝   queens ← {≢{⍵,¨⍨↓(0=∊(¨⍳⍴⍵)≠.+|⍵)/⍳⍴⍵}/(⍳⍵)⍴⊂⍳⍵}
-⍝
-⍝ Plain reading:
-⍝   permute 1..N, keep those where no two queens share a diagonal.
-⍝
-⍝ Known solution counts (OEIS A000170):
-⍝     N    1   2   3   4   5   6   7    8    9    10
-⍝   q(N)   1   0   0   2  10   4  40   92  352   724
-
-queens ← {≢({(i j)←⍺⍵ ⋄ (|i-j)≠|(P[i])-(P[j])}⌿permutations ⍵)}

lib/apl/tests/programs/primes.apl

@@ -1,16 +0,0 @@
-⍝ Sieve of Eratosthenes — the classic APL one-liner
-⍝   primes ← (2=+⌿0=A∘.|A)/A←⍳N
-⍝
-⍝ Read right-to-left:
-⍝   A ← ⍳N        : A is 1..N
-⍝   A∘.|A         : outer-product residue table — M[i,j] = A[j] mod A[i]
-⍝   0=...         : boolean — true where A[i] divides A[j]
-⍝   +⌿...         : column sums — count of divisors per A[j]
-⍝   2=...         : true for numbers with exactly 2 divisors (1 and self) → primes
-⍝   .../A         : compress — select A[j] where mask[j] is true
-⍝
-⍝ Examples:
-⍝   primes 10  →  2 3 5 7
-⍝   primes 30  →  2 3 5 7 11 13 17 19 23 29
-
-primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵}