fed-sx-m2: Pattern B from fed-prims diagnosis fails on reproducer

loops/fed-prims commit bf8d0bf2 (merged as 94f6ab9f) diagnosed
Blockers #4 as Erlang-substrate scope and sketched a Pattern B fix
purely in er-bif-http-listen: wrap the handler call in er-spawn-fun
+ er-sched-run-all! and read the spawned process's :exit-result.

Tried it on lib/erlang/runtime.sx — does not work. Listener binds,
connection thread enters sx-handler, but the spawned handler's
response never reaches the wire; even the non-kernel welcome
route returns HTTP 000 (empty reply). Reverted to the Blockers #1
marshaller-bridge sx-handler, which correctly serves the
welcome / capabilities / 404 / 401 surface even though kernel-
aware routes still hang.

Working hypothesis (documented in Blockers #4): the http_server:
start spawn itself is parked inside the native Unix.accept loop on
the boot thread; the global er-sched-* state still has that
process in its queue. When the connection thread (under the
per-instance native mutex) calls er-sched-run-all!, it re-enters
the SAME global scheduler — the boot thread's er-sched-step! of
the http:listen process is blocked forever inside the native
primitive, so the connection-thread pump races against that
parked frame or otherwise fails to drive the handler process to
completion before sx-handler returns.

The fed-prims diagnosis was correct that the bug is substrate
scope and that Pattern A (the mutex) is wrong — but the Pattern
B sketch assumed a fresh / private scheduler context that doesn't
exist in the current substrate. Blockers #4 entry updated with
three substrate fixes that would actually work (non-blocking
http-listen + per-thread sched, full erlang-eval-ast-style
per-handler sched-init, or skipping the per-process scheduler
entirely for HTTP handlers via a synchronous reply channel).

m2 stays at 11/12 steps done; Step 12 remains gated. Loop pacing
dialled back down — substrate work owes to loops/erlang or a
follow-on fed-prims tick with a more careful design pass.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

.claude/scheduled_tasks.lock

@@ -1 +1 @@
-{"sessionId":"c4d97db1-361c-4a04-a99b-c838f9385469","pid":2426590,"procStart":"349789073","acquiredAt":1780789990975}
+{"sessionId":"31c80255-eb92-43e4-8997-84ad84e27326","pid":90960,"procStart":"564684","acquiredAt":1777049890282}

.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",

hosts/ocaml/bin/sx_server.ml

@@ -571,12 +571,9 @@ and cek_run_with_io state =
           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)
+          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 ()
@@ -858,164 +855,6 @@ let setup_evaluator_bridge env =
       done;
       Nil
     | _ -> raise (Eval_error "http-listen: (port handler)"));
-
-  (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
-     Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
-     request: TCP connect, write request line + headers + body,
-     read status + headers + body, return {:status :headers :body}.
-     URL must be http://...; HTTPS is a later phase (needs TLS).
-     Body read: Content-Length first, else read to EOF (we send
-     Connection: close). Transfer-Encoding: chunked is rejected —
-     fed-sx Phase 8 wires this for inter-server POSTs which will
-     all carry Content-Length. *)
-  Sx_primitives.register "http-request" (fun args ->
-    let strip_cr s =
-      let n = String.length s in
-      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
-    in
-    match args with
-    | [String meth; String url; headers_v; body_v] ->
-      let body = match body_v with
-        | String s -> s
-        | Nil -> ""
-        | v -> Sx_types.value_to_string v in
-      let prefix = "http://" in
-      let plen = String.length prefix in
-      let ulen = String.length url in
-      if ulen < plen || String.sub url 0 plen <> prefix
-      then raise (Eval_error "http-request: URL must start with http://");
-      let rest = String.sub url plen (ulen - plen) in
-      let host_port, path =
-        match String.index_opt rest '/' with
-        | Some i ->
-          String.sub rest 0 i,
-          String.sub rest i (String.length rest - i)
-        | None -> rest, "/" in
-      if host_port = "" then
-        raise (Eval_error "http-request: missing host");
-      let host, port =
-        match String.index_opt host_port ':' with
-        | Some i ->
-          let h = String.sub host_port 0 i in
-          let ps = String.sub host_port (i + 1)
-                     (String.length host_port - i - 1) in
-          (h,
-           (try int_of_string ps with _ ->
-              raise (Eval_error "http-request: bad port")))
-        | None -> host_port, 80 in
-      let addr =
-        (try (Unix.gethostbyname host).h_addr_list.(0)
-         with Not_found ->
-           raise (Eval_error ("http-request: dns: " ^ host))) in
-      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-      let cleanup () = try Unix.close sock with _ -> () in
-      let result =
-        (try
-          (try Unix.connect sock (Unix.ADDR_INET (addr, port))
-           with Unix.Unix_error (e, _, _) ->
-             raise (Eval_error
-                      ("http-request: connect: " ^ Unix.error_message e)));
-          let oc = Unix.out_channel_of_descr sock in
-          let ic = Unix.in_channel_of_descr sock in
-          let buf = Buffer.create 256 in
-          Buffer.add_string buf
-            (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
-          let host_hdr_sent = ref false in
-          let clen_sent = ref false in
-          let conn_sent = ref false in
-          (match headers_v with
-           | Dict h ->
-             Hashtbl.iter (fun k v ->
-               let kl = String.lowercase_ascii k in
-               if kl = "host" then host_hdr_sent := true;
-               if kl = "content-length" then clen_sent := true;
-               if kl = "connection" then conn_sent := true;
-               let vs = match v with
-                 | String s -> s
-                 | x -> Sx_types.value_to_string x in
-               Buffer.add_string buf
-                 (Printf.sprintf "%s: %s\r\n" k vs)) h
-           | Nil -> ()
-           | _ -> raise (Eval_error "http-request: headers must be dict"));
-          if not !host_hdr_sent then
-            Buffer.add_string buf
-              (Printf.sprintf "Host: %s\r\n" host_port);
-          if not !clen_sent then
-            Buffer.add_string buf
-              (Printf.sprintf "Content-Length: %d\r\n"
-                 (String.length body));
-          if not !conn_sent then
-            Buffer.add_string buf "Connection: close\r\n";
-          Buffer.add_string buf "\r\n";
-          Buffer.add_string buf body;
-          output_string oc (Buffer.contents buf);
-          flush oc;
-          let sl =
-            (try strip_cr (input_line ic)
-             with End_of_file ->
-               raise (Eval_error
-                        "http-request: connection closed before status")) in
-          let status =
-            match String.split_on_char ' ' sl with
-            | _ver :: code :: _ ->
-              (try int_of_string code with _ ->
-                 raise (Eval_error "http-request: bad status code"))
-            | _ -> raise (Eval_error "http-request: bad status line") in
-          let rhdrs = Sx_types.make_dict () in
-          let clen = ref (-1) in
-          let chunked = ref false in
-          let rec rdh () =
-            let h =
-              (try strip_cr (input_line ic)
-               with End_of_file -> "") in
-            if h = "" then ()
-            else begin
-              (match String.index_opt h ':' with
-               | Some i ->
-                 let name =
-                   String.lowercase_ascii
-                     (String.trim (String.sub h 0 i)) in
-                 let value =
-                   String.trim
-                     (String.sub h (i + 1)
-                        (String.length h - i - 1)) in
-                 Hashtbl.replace rhdrs name (String value);
-                 if name = "content-length" then
-                   (try clen := int_of_string value with _ -> ())
-                 else if name = "transfer-encoding" &&
-                         String.lowercase_ascii value = "chunked"
-                 then chunked := true
-               | None -> ());
-              rdh ()
-            end in
-          rdh ();
-          if !chunked then
-            raise (Eval_error
-                     "http-request: chunked transfer-encoding not supported");
-          let rbody =
-            if !clen >= 0 then begin
-              let b = Bytes.create !clen in
-              really_input ic b 0 !clen;
-              Bytes.unsafe_to_string b
-            end else begin
-              let b = Buffer.create 256 in
-              (try
-                 while true do
-                   Buffer.add_channel b ic 4096
-                 done; assert false
-               with End_of_file -> ());
-              Buffer.contents b
-            end in
-          let resp = Sx_types.make_dict () in
-          Hashtbl.replace resp "status" (Integer status);
-          Hashtbl.replace resp "headers" (Dict rhdrs);
-          Hashtbl.replace resp "body" (String rbody);
-          Dict resp
-        with e -> cleanup (); raise e) in
-      cleanup ();
-      result
-    | _ -> raise (Eval_error "http-request: (method url headers body)"));
-
   bind "trampoline" (fun args ->
     match args with
     | [v] ->
@@ -1701,12 +1540,7 @@ let rec dispatch env cmd =
                | 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
@@ -4059,10 +3893,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

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

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

lib/apl/scoreboard.json

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

lib/apl/scoreboard.md

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

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/artdag/analyze.sx

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

lib/artdag/api.sx

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

lib/artdag/conformance.sh

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

lib/artdag/cost.sx

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

lib/artdag/dag.sx

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

lib/artdag/execute.sx

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

lib/artdag/fault.sx

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

lib/artdag/federation.sx

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

lib/artdag/optimize.sx

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

lib/artdag/plan.sx

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

lib/artdag/scoreboard.json

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

lib/artdag/scoreboard.md

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

lib/artdag/serialize.sx

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

lib/artdag/stats.sx

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

lib/artdag/tests/analyze.sx

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

lib/artdag/tests/cost.sx

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

lib/artdag/tests/dag.sx

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

lib/artdag/tests/execute.sx

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

lib/artdag/tests/fault.sx

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

lib/artdag/tests/fed.sx

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

lib/artdag/tests/optimize.sx

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

lib/artdag/tests/plan.sx

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

lib/artdag/tests/serialize.sx

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

lib/artdag/tests/stats.sx

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

lib/content/anchor.sx

@@ -1,51 +0,0 @@
-;; content-on-sx — anchored-heading HTML render.
-;;
-;; Like asHTML, but headings carry an id attribute (the block id), so the TOC's
-;; #id links resolve. A separate render so the plain asHTML stays unchanged.
-;; Tree-aware (sections recurse); other blocks use their normal asHTML.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, render.sx (asHTML +
-;; htmlEscaped).
-
-(define
-  anch-section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-(define anch-esc (fn (s) (str (st-send s "htmlEscaped" (list)))))
-
-(define
-  anchor-block
-  (fn
-    (b)
-    (cond
-      ((= (blk-type b) "heading")
-        (let
-          ((l (str (blk-get b "level"))) (id (blk-id b)))
-          (str
-            "<h"
-            l
-            " id=\""
-            id
-            "\">"
-            (anch-esc (str (blk-get b "text")))
-            "</h"
-            l
-            ">")))
-      ((anch-section? b)
-        (let
-          ((ch (st-iv-get b "children")))
-          (str
-            "<section>"
-            (anchor-blocks (if (list? ch) ch (list)))
-            "</section>")))
-      (else (str (st-send b "asHTML" (list)))))))
-
-(define
-  anchor-blocks
-  (fn
-    (blocks)
-    (if
-      (= (len blocks) 0)
-      ""
-      (str (anchor-block (first blocks)) (anchor-blocks (rest blocks))))))
-
-(define content/html-anchored (fn (doc) (anchor-blocks (doc-blocks doc))))

lib/content/api.sx

@@ -1,67 +0,0 @@
-;; content-on-sx — public API facade.
-;;
-;; The stable surface other code calls. Composes block + doc + render. Document
-;; values are immutable; every edit returns a new document, so callers hold
-;; explicit versions (the persist op log in Phase 2 becomes the source of truth).
-;;
-;; Requires (loaded by the harness): block.sx, doc.sx, render.sx and a base
-;; Smalltalk class table (st-bootstrap-classes!).
-
-;; Register the content class hierarchy + render methods. Caller bootstraps the
-;; base Smalltalk classes first; this only adds content classes (idempotent).
-(define
-  content/bootstrap!
-  (fn
-    ()
-    (begin
-      (content-bootstrap-blocks!)
-      (content-bootstrap-doc!)
-      (content-bootstrap-render!)
-      true)))
-
-;; ── documents ──
-(define content/new doc-new)
-(define content/empty doc-empty)
-(define content/append doc-append)
-(define content/blocks doc-blocks)
-(define content/count doc-count)
-(define content/find doc-find)
-(define content/has? doc-has?)
-(define content/ids doc-ids)
-(define content/types doc-types)
-
-;; ── blocks ──
-(define content/block mk-block)
-
-;; ── edit ops (data payload) ──
-(define content/insert op-insert)
-(define content/update op-update)
-(define content/move op-move)
-(define content/delete op-delete)
-
-(define content/op? (fn (x) (and (dict? x) (has-key? x :op))))
-
-;; edit — apply one op or a stream of ops; returns a new document.
-(define
-  content/edit
-  (fn
-    (doc ops)
-    (if (content/op? ops) (doc-apply doc ops) (doc-apply-all doc ops))))
-
-;; ── render boundary ──
-;; fmt is "html"/"sx"/"md"/"text" (or the matching keyword). "md" needs
-;; markdown.sx loaded; "text" needs text.sx loaded.
-(define
-  content/render
-  (fn
-    (doc fmt)
-    (cond
-      ((= fmt "html") (asHTML doc))
-      ((= fmt "sx") (asSx doc))
-      ((= fmt "md") (asMarkdown doc))
-      ((= fmt "markdown") (asMarkdown doc))
-      ((= fmt "text") (asText doc))
-      (else (error (str "unknown render format: " fmt))))))
-
-(define content/html asHTML)
-(define content/sx asSx)

lib/content/block.sx

@@ -1,171 +0,0 @@
-;; content-on-sx — typed block objects on Smalltalk-on-SX.
-;;
-;; A block is a Smalltalk instance. Behaviour (type tag, later render) is a
-;; message, not a property switch. Fields are immutable: blk-set / mk-* build a
-;; fresh instance via the functional st-iv-set!, so old versions are never
-;; clobbered (history-safe for the persist op log and CRDT merge).
-;;
-;; Hierarchy:
-;;   CtBlock (id)
-;;     CtText (text)
-;;       CtHeading (level)
-;;       CtCode (language)
-;;       CtQuote (cite)
-;;     CtImage (src alt)
-;;     CtEmbed (url provider)
-;;     CtDivider
-;;     CtList (ordered items)
-;; Plus self-contained blocks registered by their own files: CtSection,
-;; CtTable, CtCallout, CtMedia. ct-class-for-type maps every tag (so mk-block,
-;; content/from-data and CRDT materialise build them uniformly); the classes
-;; themselves are registered by content-bootstrap-section!/table!/callout!/media!.
-
-(define
-  ct-def-method!
-  (fn (cls sel src) (st-class-add-method! cls sel (st-parse-method src))))
-
-;; Register the block hierarchy in the Smalltalk class table. Call AFTER
-;; st-bootstrap-classes! (which resets the table). Idempotent.
-(define
-  content-bootstrap-blocks!
-  (fn
-    ()
-    (begin
-      (st-class-define! "CtBlock" "Object" (list "id"))
-      (ct-def-method! "CtBlock" "id" "id ^ id")
-      (ct-def-method! "CtBlock" "type" "type ^ #block")
-      (ct-def-method! "CtBlock" "isBlock" "isBlock ^ true")
-      (st-class-define! "CtText" "CtBlock" (list "text"))
-      (ct-def-method! "CtText" "text" "text ^ text")
-      (ct-def-method! "CtText" "type" "type ^ #text")
-      (st-class-define! "CtHeading" "CtText" (list "level"))
-      (ct-def-method! "CtHeading" "level" "level ^ level")
-      (ct-def-method! "CtHeading" "type" "type ^ #heading")
-      (st-class-define! "CtCode" "CtText" (list "language"))
-      (ct-def-method! "CtCode" "language" "language ^ language")
-      (ct-def-method! "CtCode" "type" "type ^ #code")
-      (st-class-define! "CtQuote" "CtText" (list "cite"))
-      (ct-def-method! "CtQuote" "cite" "cite ^ cite")
-      (ct-def-method! "CtQuote" "type" "type ^ #quote")
-      (st-class-define! "CtImage" "CtBlock" (list "src" "alt"))
-      (ct-def-method! "CtImage" "src" "src ^ src")
-      (ct-def-method! "CtImage" "alt" "alt ^ alt")
-      (ct-def-method! "CtImage" "type" "type ^ #image")
-      (st-class-define! "CtEmbed" "CtBlock" (list "url" "provider"))
-      (ct-def-method! "CtEmbed" "url" "url ^ url")
-      (ct-def-method! "CtEmbed" "provider" "provider ^ provider")
-      (ct-def-method! "CtEmbed" "type" "type ^ #embed")
-      (st-class-define! "CtDivider" "CtBlock" (list))
-      (ct-def-method! "CtDivider" "type" "type ^ #divider")
-      (st-class-define! "CtList" "CtBlock" (list "ordered" "items"))
-      (ct-def-method! "CtList" "ordered" "ordered ^ ordered")
-      (ct-def-method! "CtList" "items" "items ^ items")
-      (ct-def-method! "CtList" "type" "type ^ #list")
-      true)))
-
-;; Apply (name value) pairs functionally onto a fresh instance.
-(define
-  ct-apply-fields
-  (fn
-    (inst pairs)
-    (if
-      (= (len pairs) 0)
-      inst
-      (ct-apply-fields
-        (st-iv-set!
-          inst
-          (first (first pairs))
-          (first (rest (first pairs))))
-        (rest pairs)))))
-
-(define
-  ct-class-for-type
-  (fn
-    (tag)
-    (cond
-      ((= tag "text") "CtText")
-      ((= tag "heading") "CtHeading")
-      ((= tag "code") "CtCode")
-      ((= tag "quote") "CtQuote")
-      ((= tag "image") "CtImage")
-      ((= tag "embed") "CtEmbed")
-      ((= tag "divider") "CtDivider")
-      ((= tag "list") "CtList")
-      ((= tag "section") "CtSection")
-      ((= tag "table") "CtTable")
-      ((= tag "callout") "CtCallout")
-      ((= tag "media") "CtMedia")
-      (else (error (str "unknown block type: " tag))))))
-
-;; Generic constructor — wire tag + id + (name value) field pairs.
-(define
-  mk-block
-  (fn
-    (type-tag id fields)
-    (ct-apply-fields
-      (st-iv-set! (st-make-instance (ct-class-for-type type-tag)) "id" id)
-      fields)))
-
-(define
-  mk-text
-  (fn (id text) (mk-block "text" id (list (list "text" text)))))
-
-(define
-  mk-heading
-  (fn
-    (id level text)
-    (mk-block "heading" id (list (list "level" level) (list "text" text)))))
-
-(define
-  mk-code
-  (fn
-    (id language text)
-    (mk-block
-      "code"
-      id
-      (list (list "language" language) (list "text" text)))))
-
-(define
-  mk-quote
-  (fn
-    (id cite text)
-    (mk-block "quote" id (list (list "cite" cite) (list "text" text)))))
-
-(define
-  mk-image
-  (fn
-    (id src alt)
-    (mk-block "image" id (list (list "src" src) (list "alt" alt)))))
-
-(define
-  mk-embed
-  (fn
-    (id url provider)
-    (mk-block "embed" id (list (list "url" url) (list "provider" provider)))))
-
-(define mk-divider (fn (id) (mk-block "divider" id (list))))
-
-(define
-  mk-list
-  (fn
-    (id ordered items)
-    (mk-block
-      "list"
-      id
-      (list (list "ordered" ordered) (list "items" items)))))
-
-;; Accessors. blk-type / blk-id go through message dispatch (polymorphic);
-;; blk-get reads any ivar directly; blk-set is copy-on-write.
-(define blk-id (fn (b) (st-send b "id" (list))))
-(define blk-type (fn (b) (str (st-send b "type" (list)))))
-(define blk-send (fn (b sel) (st-send b sel (list))))
-(define blk-get (fn (b field) (st-iv-get b field)))
-(define blk-set (fn (b field val) (st-iv-set! b field val)))
-
-(define
-  block?
-  (fn
-    (v)
-    (and
-      (st-instance? v)
-      (st-class-inherits-from? (get v :class) "CtBlock"))))

lib/content/callout.sx

@@ -1,49 +0,0 @@
-;; content-on-sx — callout / admonition block.
-;;
-;; CtCallout holds a `kind` (note/warning/tip/…) and `text`. Self-contained: it
-;; answers asHTML/asSx/asText/asMarkdown: so it composes with the render boundary
-;; with no changes elsewhere. HTML text is htmlEscaped, SX text sxEscaped.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers);
-;; markdown.sx / text.sx for those formats.
-
-(define
-  content-bootstrap-callout!
-  (fn
-    ()
-    (begin
-      (st-class-define! "CtCallout" "CtBlock" (list "kind" "text"))
-      (ct-def-method! "CtCallout" "kind" "kind ^ kind")
-      (ct-def-method! "CtCallout" "text" "text ^ text")
-      (ct-def-method! "CtCallout" "type" "type ^ #callout")
-      (ct-def-method!
-        "CtCallout"
-        "asHTML"
-        "asHTML ^ '<aside class=\"callout callout-' , kind htmlEscaped , '\">' , text htmlEscaped , '</aside>'")
-      (ct-def-method!
-        "CtCallout"
-        "asSx"
-        "asSx ^ '(aside :class \"callout callout-' , kind sxEscaped , '\" \"' , text sxEscaped , '\")'")
-      (ct-def-method! "CtCallout" "asText" "asText ^ text")
-      (ct-def-method!
-        "CtCallout"
-        "asMarkdown:"
-        "asMarkdown: nl ^ '> **' , kind , ':** ' , text")
-      true)))
-
-(define
-  mk-callout
-  (fn
-    (id kind text)
-    (st-iv-set!
-      (st-iv-set!
-        (st-iv-set! (st-make-instance "CtCallout") "id" id)
-        "kind"
-        kind)
-      "text"
-      text)))
-
-(define
-  callout?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtCallout"))))
-(define callout-kind (fn (b) (st-send b "kind" (list))))

lib/content/clone.sx

@@ -1,34 +0,0 @@
-;; content-on-sx — block id remapping / clone.
-;;
-;; Deep-rewrite every block id in the tree (descending into sections) by applying
-;; a function. Enables collision-free composition: prefix one document's ids
-;; before concatenating it with another. Immutable; content is unchanged, only
-;; ids.
-;;
-;; Requires (loaded by harness): doc.sx, section.sx (section? /
-;; section-children / section-with-children).
-
-(define
-  block-remap-id
-  (fn
-    (b f)
-    (let
-      ((nb (blk-set b "id" (f (blk-id b)))))
-      (if
-        (section? nb)
-        (section-with-children
-          nb
-          (map (fn (c) (block-remap-id c f)) (section-children nb)))
-        nb))))
-
-(define
-  content/remap-ids
-  (fn
-    (doc f)
-    (doc-with-blocks
-      doc
-      (map (fn (b) (block-remap-id b f)) (doc-blocks doc)))))
-
-(define
-  content/prefix-ids
-  (fn (doc prefix) (content/remap-ids doc (fn (id) (str prefix id)))))

lib/content/compose.sx

@@ -1,42 +0,0 @@
-;; content-on-sx — document composition.
-;;
-;; Combine documents (header + body + footer, templates, partials) into a new
-;; document. The result keeps the FIRST document's id and metadata; blocks are
-;; concatenated. Immutable — inputs are untouched. Block-id collisions across
-;; combined docs are the caller's concern (content/validate flags duplicates).
-;;
-;; Requires (loaded by harness): doc.sx.
-
-(define
-  content/concat
-  (fn (a b) (doc-with-blocks a (append (doc-blocks a) (doc-blocks b)))))
-
-(define
-  content/prepend
-  (fn (a b) (doc-with-blocks a (append (doc-blocks b) (doc-blocks a)))))
-
-(define
-  content/-concat-fold
-  (fn
-    (acc more)
-    (if
-      (= (len more) 0)
-      acc
-      (content/-concat-fold (content/concat acc (first more)) (rest more)))))
-
-(define
-  content/concat-all
-  (fn
-    (docs)
-    (if
-      (= (len docs) 0)
-      (doc-empty "merged")
-      (content/-concat-fold (first docs) (rest docs)))))
-
-;; wrap a document's blocks inside a single section (collapse to a subtree).
-;; Requires section.sx (mk-section) when used.
-(define
-  content/wrap-section
-  (fn
-    (doc section-id)
-    (doc-with-blocks doc (list (mk-section section-id (doc-blocks doc))))))

lib/content/conformance.sh

@@ -1,158 +0,0 @@
-#!/usr/bin/env bash
-# lib/content/conformance.sh — run content-on-sx suites, emit scoreboard.
-
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
-if [ ! -x "$SX_SERVER" ]; then
-  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
-  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
-    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
-  else
-    echo "ERROR: sx_server.exe not found." >&2
-    exit 1
-  fi
-fi
-
-SUITES=(block doc render api meta page page-full markdown text section compose tree-edit move clone query toc anchor outline flatten transform normalize find-replace stats summary index table callout media data wire validate store snapshot crdt crdt-tree crdt-blocks crdt-store sync md-import md-doc fed)
-
-OUT_JSON="lib/content/scoreboard.json"
-OUT_MD="lib/content/scoreboard.md"
-
-run_suite() {
-  local suite=$1
-  local file="lib/content/tests/${suite}.sx"
-  local TMP
-  TMP=$(mktemp)
-  cat > "$TMP" << EPOCHS
-(epoch 1)
-(load "lib/smalltalk/tokenizer.sx")
-(load "lib/smalltalk/parser.sx")
-(load "lib/guest/reflective/class-chain.sx")
-(load "lib/smalltalk/runtime.sx")
-(load "lib/guest/reflective/env.sx")
-(load "lib/smalltalk/eval.sx")
-(load "lib/persist/event.sx")
-(load "lib/persist/backend.sx")
-(load "lib/persist/log.sx")
-(load "lib/persist/kv.sx")
-(load "lib/persist/api.sx")
-(load "lib/content/block.sx")
-(load "lib/content/doc.sx")
-(load "lib/content/render.sx")
-(load "lib/content/api.sx")
-(load "lib/content/meta.sx")
-(load "lib/content/text.sx")
-(load "lib/content/section.sx")
-(load "lib/content/compose.sx")
-(load "lib/content/tree-edit.sx")
-(load "lib/content/move.sx")
-(load "lib/content/clone.sx")
-(load "lib/content/query.sx")
-(load "lib/content/toc.sx")
-(load "lib/content/anchor.sx")
-(load "lib/content/outline.sx")
-(load "lib/content/flatten.sx")
-(load "lib/content/transform.sx")
-(load "lib/content/normalize.sx")
-(load "lib/content/find-replace.sx")
-(load "lib/content/stats.sx")
-(load "lib/content/summary.sx")
-(load "lib/content/index.sx")
-(load "lib/content/table.sx")
-(load "lib/content/callout.sx")
-(load "lib/content/media.sx")
-(load "lib/content/data.sx")
-(load "lib/content/wire.sx")
-(load "lib/content/page.sx")
-(load "lib/content/page-full.sx")
-(load "lib/content/markdown.sx")
-(load "lib/content/validate.sx")
-(load "lib/content/store.sx")
-(load "lib/content/snapshot.sx")
-(load "lib/content/crdt.sx")
-(load "lib/content/crdt-tree.sx")
-(load "lib/content/crdt-store.sx")
-(load "lib/content/sync.sx")
-(load "lib/content/md-import.sx")
-(load "lib/content/md-doc.sx")
-(load "lib/content/fed.sx")
-(epoch 2)
-(eval "(define content-test-pass 0)")
-(eval "(define content-test-fail 0)")
-(eval "(define content-test-fails (list))")
-(eval "(define content-test (fn (name got expected) (if (= got expected) (set! content-test-pass (+ content-test-pass 1)) (begin (set! content-test-fail (+ content-test-fail 1)) (set! content-test-fails (cons name content-test-fails))))))")
-(epoch 3)
-(load "${file}")
-(epoch 4)
-(eval "(list content-test-pass content-test-fail)")
-EPOCHS
-
-  local OUTPUT
-  OUTPUT=$(timeout 240 "$SX_SERVER" < "$TMP" 2>/dev/null)
-  rm -f "$TMP"
-
-  local LINE
-  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
-  if [ -z "$LINE" ]; then
-    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
-            | sed -E 's/^\(ok 4 //; s/\)$//')
-  fi
-
-  local P F
-  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
-  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
-  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 content conformance suite..." >&2
-for s in "${SUITES[@]}"; do
-  read -r p f < <(run_suite "$s")
-  SUITE_PASS[$s]=$p
-  SUITE_FAIL[$s]=$f
-  TOTAL_PASS=$((TOTAL_PASS + p))
-  TOTAL_FAIL=$((TOTAL_FAIL + f))
-  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
-done
-
-{
-  printf '{\n'
-  printf '  "suites": {\n'
-  first=1
-  for s in "${SUITES[@]}"; do
-    if [ $first -eq 0 ]; then printf ',\n'; fi
-    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
-    first=0
-  done
-  printf '\n  },\n'
-  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
-  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
-  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
-  printf '}\n'
-} > "$OUT_JSON"
-
-{
-  printf '# content-on-sx Conformance Scoreboard\n\n'
-  printf '_Generated by `lib/content/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/content/crdt-store.sx

@@ -1,71 +0,0 @@
-;; content-on-sx — durable collaborative replication: CRDT ops on persist.
-;;
-;; Each replica appends its CRDT ops to its own persist stream
-;; (crdt:<doc>:<replica>). Any node reconstructs the converged document by
-;; replaying every replica's log into a CvRDT state and merging them. Because
-;; the merge is a join and crdt-apply is order/duplicate-insensitive, the
-;; converged result is identical regardless of replica order or re-delivery —
-;; the durable log + CRDT give offline-capable, eventually-consistent editing.
-;;
-;; Requires (loaded by harness): crdt.sx (+ deps) and persist
-;; (event/backend/log/kv/api). Backend `b` injected via (persist/open).
-
-(define crdt/-stream (fn (doc-id replica) (str "crdt:" doc-id ":" replica)))
-
-;; ── commit ops to a replica's durable log ──
-(define
-  crdt/commit!
-  (fn
-    (b doc-id replica op at)
-    (persist/append b (crdt/-stream doc-id replica) (get op :op) at op)))
-
-(define
-  crdt/commit-all!
-  (fn
-    (b doc-id replica ops at)
-    (if
-      (= (len ops) 0)
-      nil
-      (begin
-        (crdt/commit! b doc-id replica (first ops) at)
-        (crdt/commit-all! b doc-id replica (rest ops) at)))))
-
-;; ── read a replica's log ──
-(define
-  crdt/log
-  (fn (b doc-id replica) (persist/read b (crdt/-stream doc-id replica))))
-
-(define
-  crdt/replica-ops
-  (fn
-    (b doc-id replica)
-    (map (fn (ev) (persist/event-data ev)) (crdt/log b doc-id replica))))
-
-(define
-  crdt/replica-version
-  (fn (b doc-id replica) (persist/last-seq b (crdt/-stream doc-id replica))))
-
-;; ── replay one replica's log into a CvRDT state ──
-(define
-  crdt/replay
-  (fn
-    (b doc-id replica)
-    (crdt-apply-all (crdt-empty) (crdt/replica-ops b doc-id replica))))
-
-;; ── converge: merge every replica's replayed state ──
-(define
-  crdt/converge
-  (fn
-    (b doc-id replicas)
-    (crdt-merge-all (map (fn (r) (crdt/replay b doc-id r)) replicas))))
-
-;; ── converged, materialised document ──
-(define
-  crdt/document
-  (fn
-    (b doc-id replicas)
-    (crdt-materialize doc-id (crdt/converge b doc-id replicas))))
-
-(define
-  crdt/order
-  (fn (b doc-id replicas) (crdt-order (crdt/converge b doc-id replicas))))

lib/content/crdt-tree.sx

@@ -1,193 +0,0 @@
-;; content-on-sx — nested-tree CvRDT.
-;;
-;; Extends the flat CvRDT (crdt.sx) to a TREE: each element carries a `parent`
-;; (the id of its containing section, "" = root) alongside its Logoot position.
-;; Merge is still a join — it reuses crdt.sx's position/register/field merges and
-;; adds parent (immutable, set once at insert). Materialisation rebuilds the
-;; ordered tree: root = elements with parent "" (plus ORPHANS — elements whose
-;; parent is not a live section, e.g. after a concurrent delete-section +
-;; insert-child, so content is never silently lost); a section's children =
-;; elements whose parent is that section's id. Commutative/associative/idempotent
-;; like the flat layer.
-;;
-;; Requires (loaded by harness): crdt.sx (merge helpers + live/sort/materialise
-;; bits + crdt-member?), block.sx, doc.sx, section.sx (mk-section).
-
-(define ctt-merge-parent (fn (p1 p2) (if (= p1 nil) p2 p1)))
-
-(define ctt-merge-element (fn (e1 e2) {:fields (crdt-merge-fields (get e1 :fields) (get e2 :fields)) :parent (ctt-merge-parent (get e1 :parent) (get e2 :parent)) :id (get e1 :id) :type (crdt-merge-type (get e1 :type) (get e2 :type)) :deleted (or (= (get e1 :deleted) true) (= (get e2 :deleted) true)) :pos (crdt-merge-pos (get e1 :pos) (get e2 :pos))}))
-
-(define
-  ctt-add-element
-  (fn
-    (state elem)
-    (let
-      ((elems (get state :elements)) (id (get elem :id)))
-      (let
-        ((existing (get elems id)))
-        (assoc
-          state
-          :elements (assoc
-            elems
-            id
-            (if (= existing nil) elem (ctt-merge-element existing elem))))))))
-
-;; ── ops as partial-element contributions ──
-(define
-  crdt-tree-insert
-  (fn
-    (state id type pos parent fields ts actor)
-    (ctt-add-element state {:fields (crdt-build-fields fields ts actor) :parent parent :id id :type type :deleted false :pos pos})))
-
-(define
-  crdt-tree-update
-  (fn (state id fname value ts actor) (ctt-add-element state {:fields (assoc {} fname {:ts ts :actor actor :value value}) :parent nil :id id :type nil :deleted false :pos nil})))
-
-(define crdt-tree-delete (fn (state id) (ctt-add-element state {:fields {} :parent nil :id id :type nil :deleted true :pos nil})))
-
-;; ── state merge (join) ──
-(define
-  ctt-merge-loop
-  (fn
-    (ids ea eb acc)
-    (if
-      (= (len ids) 0)
-      acc
-      (let
-        ((id (first ids)))
-        (let
-          ((x (get ea id)) (y (get eb id)))
-          (ctt-merge-loop
-            (rest ids)
-            ea
-            eb
-            (assoc
-              acc
-              id
-              (cond
-                ((= x nil) y)
-                ((= y nil) x)
-                (else (ctt-merge-element x y))))))))))
-
-(define crdt-tree-merge (fn (a b) {:elements (ctt-merge-loop (crdt-union-keys (get a :elements) (get b :elements)) (get a :elements) (get b :elements) {})}))
-
-(define
-  crdt-tree-merge-all
-  (fn
-    (states)
-    (if
-      (= (len states) 0)
-      (crdt-empty)
-      (if
-        (= (len states) 1)
-        (first states)
-        (crdt-tree-merge (first states) (crdt-tree-merge-all (rest states)))))))
-
-;; ── op interpreter ──
-(define
-  crdt-tree-op-insert
-  (fn (id type pos parent fields ts actor) {:ts ts :fields fields :parent parent :id id :type type :op "insert" :actor actor :pos pos}))
-
-(define crdt-tree-op-update (fn (id field value ts actor) {:ts ts :field field :id id :op "update" :actor actor :value value}))
-
-(define crdt-tree-op-delete (fn (id) {:id id :op "delete"}))
-
-(define
-  crdt-tree-apply
-  (fn
-    (state op)
-    (let
-      ((k (get op :op)))
-      (cond
-        ((= k "insert")
-          (crdt-tree-insert
-            state
-            (get op :id)
-            (get op :type)
-            (get op :pos)
-            (get op :parent)
-            (get op :fields)
-            (get op :ts)
-            (get op :actor)))
-        ((= k "update")
-          (crdt-tree-update
-            state
-            (get op :id)
-            (get op :field)
-            (get op :value)
-            (get op :ts)
-            (get op :actor)))
-        ((= k "delete") (crdt-tree-delete state (get op :id)))
-        (else (error (str "unknown crdt-tree op: " k)))))))
-
-(define
-  crdt-tree-apply-all
-  (fn
-    (state ops)
-    (if
-      (= (len ops) 0)
-      state
-      (crdt-tree-apply-all (crdt-tree-apply state (first ops)) (rest ops)))))
-
-;; ── materialise to a Phase-1 document (rebuild the ordered tree) ──
-(define
-  ctt-live-section-ids
-  (fn
-    (state)
-    (map
-      (fn (e) (get e :id))
-      (filter
-        (fn (e) (= (get e :type) "section"))
-        (crdt-live-elements state)))))
-
-;; an element belongs at root if its parent is "" or its parent is not a live
-;; section (orphan-reparenting: don't lose content when its section is deleted).
-(define
-  ctt-roots
-  (fn
-    (state)
-    (let
-      ((secids (ctt-live-section-ids state)))
-      (crdt-sort-by-pos
-        (filter
-          (fn
-            (e)
-            (if
-              (= (get e :parent) "")
-              true
-              (if (crdt-member? (get e :parent) secids) false true)))
-          (crdt-live-elements state))))))
-
-(define
-  ctt-children
-  (fn
-    (state parent-id)
-    (crdt-sort-by-pos
-      (filter
-        (fn (e) (= (get e :parent) parent-id))
-        (crdt-live-elements state)))))
-
-(define
-  ctt-element->block
-  (fn
-    (state e)
-    (if
-      (= (get e :type) "section")
-      (mk-section
-        (get e :id)
-        (map
-          (fn (c) (ctt-element->block state c))
-          (ctt-children state (get e :id))))
-      (crdt-element->block e))))
-
-(define
-  crdt-tree-materialize
-  (fn
-    (doc-id state)
-    (doc-new
-      doc-id
-      (map (fn (e) (ctt-element->block state e)) (ctt-roots state)))))
-
-(define
-  crdt-tree-order
-  (fn (state) (map (fn (e) (get e :id)) (ctt-roots state))))

lib/content/crdt.sx

@@ -1,378 +0,0 @@
-;; content-on-sx — collaborative merge (state-based CvRDT).
-;;
-;; The merge is a join (least upper bound) on a semilattice, so it is
-;; commutative, associative and idempotent BY CONSTRUCTION — applying ops in any
-;; order, or merging replicas in any order / twice, converges to the same
-;; document. This is NOT last-write-wins-as-cop-out: ordering uses unique dense
-;; position keys (Logoot), presence uses OR-tombstones (remove-wins), and each
-;; field is an LWW-Register keyed by a logical (ts, actor) clock — an explicit,
-;; deterministic per-field conflict policy.
-;;
-;; Every op (insert/update/delete) contributes a PARTIAL element; the per-id
-;; state is the join of all contributions. So update-before-insert and
-;; delete-before-insert are not lost — they merge when the rest arrives.
-;;
-;; Shapes:
-;;   state    = {:elements <dict id -> element>}
-;;   element  = {:id :pos :type :deleted :fields <dict fname -> register>}
-;;   register = {:value v :ts <int> :actor <int>}
-;;   position = list of cells; cell = (list digit actor); lexicographic order
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-(define CRDT-BASE 65536)
-
-;; ── position order (Logoot) ──
-(define
-  crdt-cell-cmp
-  (fn
-    (c1 c2)
-    (let
-      ((d1 (first c1)) (d2 (first c2)))
-      (cond
-        ((< d1 d2) -1)
-        ((> d1 d2) 1)
-        (else
-          (let
-            ((a1 (first (rest c1))) (a2 (first (rest c2))))
-            (cond
-              ((< a1 a2) -1)
-              ((> a1 a2) 1)
-              (else 0))))))))
-
-(define
-  crdt-pos-compare
-  (fn
-    (p1 p2)
-    (cond
-      ((and (= (len p1) 0) (= (len p2) 0)) 0)
-      ((= (len p1) 0) -1)
-      ((= (len p2) 0) 1)
-      (else
-        (let
-          ((c (crdt-cell-cmp (first p1) (first p2))))
-          (if (= c 0) (crdt-pos-compare (rest p1) (rest p2)) c))))))
-
-;; single-cell position constructor (handy for explicit tests)
-(define crdt-pos (fn (digit actor) (list (list digit actor))))
-
-;; allocate a position strictly between left and right (nil = unbounded)
-(define
-  cr-alloc
-  (fn
-    (left right actor i acc)
-    (let
-      ((ld (if (< i (len left)) (first (nth left i)) 0))
-        (rd (if (< i (len right)) (first (nth right i)) CRDT-BASE)))
-      (if
-        (> (- rd ld) 1)
-        (append
-          acc
-          (list
-            (list
-              (+
-                ld
-                (+
-                  1
-                  (floor (/ (- (- rd ld) 1) 2))))
-              actor)))
-        (cr-alloc
-          left
-          right
-          actor
-          (+ i 1)
-          (append
-            acc
-            (list
-              (list
-                ld
-                (if (< i (len left)) (first (rest (nth left i))) actor)))))))))
-
-(define
-  crdt-pos-between
-  (fn
-    (left right actor)
-    (cr-alloc
-      (if (= left nil) (list) left)
-      (if (= right nil) (list) right)
-      actor
-      0
-      (list))))
-
-;; ── register (LWW by logical (ts, actor)) ──
-(define
-  crdt-reg-max
-  (fn
-    (r1 r2)
-    (cond
-      ((= r1 nil) r2)
-      ((= r2 nil) r1)
-      (else
-        (let
-          ((t1 (get r1 :ts)) (t2 (get r2 :ts)))
-          (cond
-            ((> t1 t2) r1)
-            ((< t1 t2) r2)
-            (else (if (>= (get r1 :actor) (get r2 :actor)) r1 r2))))))))
-
-;; ── small set/dict helpers ──
-(define
-  crdt-member?
-  (fn
-    (x xs)
-    (cond
-      ((= (len xs) 0) false)
-      ((= (first xs) x) true)
-      (else (crdt-member? x (rest xs))))))
-
-(define
-  crdt-dedup-loop
-  (fn
-    (xs seen)
-    (if
-      (= (len xs) 0)
-      (reverse seen)
-      (if
-        (crdt-member? (first xs) seen)
-        (crdt-dedup-loop (rest xs) seen)
-        (crdt-dedup-loop (rest xs) (cons (first xs) seen))))))
-
-(define crdt-dedup (fn (xs) (crdt-dedup-loop xs (list))))
-
-(define
-  crdt-union-keys
-  (fn (d1 d2) (crdt-dedup (append (keys d1) (keys d2)))))
-
-;; ── element join ──
-(define
-  crdt-merge-pos
-  (fn
-    (p1 p2)
-    (cond
-      ((= p1 nil) p2)
-      ((= p2 nil) p1)
-      ((<= (crdt-pos-compare p1 p2) 0) p1)
-      (else p2))))
-
-(define crdt-merge-type (fn (t1 t2) (if (= t1 nil) t2 t1)))
-
-(define
-  crdt-merge-fields-loop
-  (fn
-    (names f1 f2 acc)
-    (if
-      (= (len names) 0)
-      acc
-      (let
-        ((nm (first names)))
-        (crdt-merge-fields-loop
-          (rest names)
-          f1
-          f2
-          (assoc acc nm (crdt-reg-max (get f1 nm) (get f2 nm))))))))
-
-(define
-  crdt-merge-fields
-  (fn
-    (f1 f2)
-    (crdt-merge-fields-loop (crdt-union-keys f1 f2) f1 f2 {})))
-
-(define crdt-merge-element (fn (e1 e2) {:fields (crdt-merge-fields (get e1 :fields) (get e2 :fields)) :id (get e1 :id) :type (crdt-merge-type (get e1 :type) (get e2 :type)) :deleted (or (= (get e1 :deleted) true) (= (get e2 :deleted) true)) :pos (crdt-merge-pos (get e1 :pos) (get e2 :pos))}))
-
-;; ── state ──
-(define crdt-empty (fn () {:elements {}}))
-
-(define
-  crdt-add-element
-  (fn
-    (state elem)
-    (let
-      ((elems (get state :elements)) (id (get elem :id)))
-      (let
-        ((existing (get elems id)))
-        (assoc
-          state
-          :elements (assoc
-            elems
-            id
-            (if (= existing nil) elem (crdt-merge-element existing elem))))))))
-
-(define
-  crdt-build-fields-loop
-  (fn
-    (pairs ts actor acc)
-    (if
-      (= (len pairs) 0)
-      acc
-      (crdt-build-fields-loop
-        (rest pairs)
-        ts
-        actor
-        (assoc acc (first (first pairs)) {:ts ts :actor actor :value (first (rest (first pairs)))})))))
-
-(define
-  crdt-build-fields
-  (fn (pairs ts actor) (crdt-build-fields-loop pairs ts actor {})))
-
-;; ── ops as partial-element contributions ──
-(define
-  crdt-insert
-  (fn
-    (state id type pos fields ts actor)
-    (crdt-add-element state {:fields (crdt-build-fields fields ts actor) :id id :type type :deleted false :pos pos})))
-
-(define
-  crdt-update
-  (fn (state id fname value ts actor) (crdt-add-element state {:fields (assoc {} fname {:ts ts :actor actor :value value}) :id id :type nil :deleted false :pos nil})))
-
-(define crdt-delete (fn (state id) (crdt-add-element state {:fields {} :id id :type nil :deleted true :pos nil})))
-
-;; ── state merge (join) ──
-(define
-  crdt-merge-loop
-  (fn
-    (ids ea eb acc)
-    (if
-      (= (len ids) 0)
-      acc
-      (let
-        ((id (first ids)))
-        (let
-          ((x (get ea id)) (y (get eb id)))
-          (crdt-merge-loop
-            (rest ids)
-            ea
-            eb
-            (assoc
-              acc
-              id
-              (cond
-                ((= x nil) y)
-                ((= y nil) x)
-                (else (crdt-merge-element x y))))))))))
-
-(define crdt-merge (fn (a b) {:elements (crdt-merge-loop (crdt-union-keys (get a :elements) (get b :elements)) (get a :elements) (get b :elements) {})}))
-
-(define
-  crdt-merge-all
-  (fn
-    (states)
-    (if
-      (= (len states) 0)
-      (crdt-empty)
-      (if
-        (= (len states) 1)
-        (first states)
-        (crdt-merge (first states) (crdt-merge-all (rest states)))))))
-
-;; ── op interpreter ──
-(define crdt-op-insert (fn (id type pos fields ts actor) {:ts ts :fields fields :id id :type type :op "insert" :actor actor :pos pos}))
-
-(define crdt-op-update (fn (id field value ts actor) {:ts ts :field field :id id :op "update" :actor actor :value value}))
-
-(define crdt-op-delete (fn (id) {:id id :op "delete"}))
-
-(define
-  crdt-apply
-  (fn
-    (state op)
-    (let
-      ((k (get op :op)))
-      (cond
-        ((= k "insert")
-          (crdt-insert
-            state
-            (get op :id)
-            (get op :type)
-            (get op :pos)
-            (get op :fields)
-            (get op :ts)
-            (get op :actor)))
-        ((= k "update")
-          (crdt-update
-            state
-            (get op :id)
-            (get op :field)
-            (get op :value)
-            (get op :ts)
-            (get op :actor)))
-        ((= k "delete") (crdt-delete state (get op :id)))
-        (else (error (str "unknown crdt op: " k)))))))
-
-(define
-  crdt-apply-all
-  (fn
-    (state ops)
-    (if
-      (= (len ops) 0)
-      state
-      (crdt-apply-all (crdt-apply state (first ops)) (rest ops)))))
-
-;; ── materialise to a Phase-1 document ──
-(define
-  crdt-elements-list
-  (fn
-    (state)
-    (map
-      (fn (id) (get (get state :elements) id))
-      (keys (get state :elements)))))
-
-(define
-  crdt-live?
-  (fn
-    (e)
-    (and
-      (= (get e :deleted) false)
-      (if (= (get e :pos) nil) false true)
-      (if (= (get e :type) nil) false true))))
-
-(define
-  crdt-live-elements
-  (fn (state) (filter crdt-live? (crdt-elements-list state))))
-
-(define
-  crdt-insert-sorted
-  (fn
-    (e sorted)
-    (cond
-      ((= (len sorted) 0) (list e))
-      ((< (crdt-pos-compare (get e :pos) (get (first sorted) :pos)) 0)
-        (cons e sorted))
-      (else (cons (first sorted) (crdt-insert-sorted e (rest sorted)))))))
-
-(define
-  crdt-sort-by-pos
-  (fn
-    (elems)
-    (if
-      (= (len elems) 0)
-      (list)
-      (crdt-insert-sorted (first elems) (crdt-sort-by-pos (rest elems))))))
-
-(define
-  crdt-field-pairs
-  (fn
-    (fields)
-    (map (fn (nm) (list nm (get (get fields nm) :value))) (keys fields))))
-
-(define
-  crdt-element->block
-  (fn
-    (e)
-    (mk-block (get e :type) (get e :id) (crdt-field-pairs (get e :fields)))))
-
-(define
-  crdt-order
-  (fn
-    (state)
-    (map
-      (fn (e) (get e :id))
-      (crdt-sort-by-pos (crdt-live-elements state)))))
-
-(define
-  crdt-materialize
-  (fn
-    (doc-id state)
-    (doc-new
-      doc-id
-      (map crdt-element->block (crdt-sort-by-pos (crdt-live-elements state))))))

lib/content/data.sx

@@ -1,79 +0,0 @@
-;; content-on-sx — portable data serialization.
-;;
-;; Converts documents to/from a plain SX data form, decoupling storage and
-;; transport from the Smalltalk instance shape. A document becomes
-;;   {:id :title :slug :tags :blocks (list block-data)}
-;; and a block becomes {:id :type :fields {...}} (section children recurse).
-;; content/from-data reconstructs real block objects.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, meta.sx, section.sx
-;; (mk-section), table.sx (mk-table).
-
-;; ── to-data ──
-(define
-  content/-fd-loop
-  (fn
-    (ks ivs acc)
-    (if
-      (= (len ks) 0)
-      acc
-      (let
-        ((k (first ks)))
-        (if
-          (= k "id")
-          (content/-fd-loop (rest ks) ivs acc)
-          (content/-fd-loop
-            (rest ks)
-            ivs
-            (assoc
-              acc
-              k
-              (if
-                (= k "children")
-                (map block->data (get ivs k))
-                (get ivs k)))))))))
-
-(define block->data (fn (b) {:fields (content/-fd-loop (keys (get b :ivars)) (get b :ivars) {}) :id (blk-id b) :type (blk-type b)}))
-
-(define content/to-data (fn (doc) {:blocks (map block->data (doc-blocks doc)) :slug (doc-slug doc) :id (doc-id doc) :title (doc-title doc) :tags (doc-tags doc)}))
-
-;; ── from-data ──
-(define
-  content/-field-pairs
-  (fn (fields) (map (fn (k) (list k (get fields k))) (keys fields))))
-
-(define
-  data->block
-  (fn
-    (d)
-    (let
-      ((type (get d :type)) (id (get d :id)) (fields (get d :fields)))
-      (cond
-        ((= type "section")
-          (mk-section id (map data->block (get fields "children"))))
-        ((= type "table")
-          (mk-table id (get fields "headers") (get fields "rows")))
-        (else (mk-block type id (content/-field-pairs fields)))))))
-
-(define
-  content/-meta-of
-  (fn
-    (data)
-    (let
-      ((m1 (if (= (get data :title) nil) {} (assoc {} :title (get data :title)))))
-      (let
-        ((m2 (if (= (get data :slug) nil) m1 (assoc m1 :slug (get data :slug)))))
-        (let
-          ((tags (get data :tags)))
-          (if
-            (or (= tags nil) (= (len tags) 0))
-            m2
-            (assoc m2 :tags tags)))))))
-
-(define
-  content/from-data
-  (fn
-    (data)
-    (doc-with-meta
-      (doc-new (get data :id) (map data->block (get data :blocks)))
-      (content/-meta-of data))))

lib/content/doc.sx

@@ -1,203 +0,0 @@
-;; content-on-sx — ordered block document on Smalltalk-on-SX.
-;;
-;; A document (CtDoc) is a Smalltalk object holding an ordered sequence of block
-;; objects. Editing is a stream of ops (data dicts); doc-apply interprets one op
-;; and returns a NEW document — the input is never mutated, so any version is the
-;; head of an op stream (replay-friendly for persist + CRDT merge).
-;;
-;; CtDoc also carries optional metadata (title/slug/tags) — see meta.sx for the
-;; ergonomic API; they default nil and do not affect block operations.
-;;
-;; Op shapes (data, not objects — they are the persist event payload):
-;;   {:op "insert" :block <blk> :after <id|nil>}   ; after nil = prepend
-;;   {:op "update" :id <id> :field <name> :value <v>}
-;;   {:op "move"   :id <id> :index <n>}
-;;   {:op "delete" :id <id>}
-
-(define
-  content-bootstrap-doc!
-  (fn
-    ()
-    (begin
-      (st-class-define!
-        "CtDoc"
-        "Object"
-        (list "id" "blocks" "title" "slug" "tags"))
-      (ct-def-method! "CtDoc" "id" "id ^ id")
-      (ct-def-method! "CtDoc" "blocks" "blocks ^ blocks")
-      (ct-def-method! "CtDoc" "type" "type ^ #document")
-      (ct-def-method! "CtDoc" "title" "title ^ title")
-      (ct-def-method! "CtDoc" "slug" "slug ^ slug")
-      (ct-def-method! "CtDoc" "tags" "tags ^ tags")
-      true)))
-
-;; ── construction ──
-(define
-  doc-new
-  (fn
-    (id blocks)
-    (st-iv-set!
-      (st-iv-set! (st-make-instance "CtDoc") "id" id)
-      "blocks"
-      blocks)))
-
-(define doc-empty (fn (id) (doc-new id (list))))
-
-;; ── accessors (message dispatch) ──
-(define doc-id (fn (doc) (st-send doc "id" (list))))
-(define doc-type (fn (doc) (str (st-send doc "type" (list)))))
-(define doc-blocks (fn (doc) (st-send doc "blocks" (list))))
-(define doc-count (fn (doc) (len (doc-blocks doc))))
-(define doc-block-at (fn (doc i) (nth (doc-blocks doc) i)))
-
-(define doc? (fn (v) (and (st-instance? v) (= (get v :class) "CtDoc"))))
-
-;; ── list helpers over block sequences ──
-(define
-  ct-index-loop
-  (fn
-    (blocks id i)
-    (cond
-      ((= (len blocks) 0) -1)
-      ((= (blk-id (first blocks)) id) i)
-      (else (ct-index-loop (rest blocks) id (+ i 1))))))
-
-(define ct-index-of (fn (blocks id) (ct-index-loop blocks id 0)))
-
-(define
-  ct-insert-at
-  (fn
-    (blocks i x)
-    (cond
-      ((= i 0) (cons x blocks))
-      ((= (len blocks) 0) (list x))
-      (else
-        (cons
-          (first blocks)
-          (ct-insert-at (rest blocks) (- i 1) x))))))
-
-(define
-  ct-remove-id
-  (fn
-    (blocks id)
-    (filter (fn (b) (if (= (blk-id b) id) false true)) blocks)))
-
-(define
-  ct-replace-id
-  (fn
-    (blocks id f)
-    (map (fn (b) (if (= (blk-id b) id) (f b) b)) blocks)))
-
-;; ── query ──
-(define doc-index-of (fn (doc id) (ct-index-of (doc-blocks doc) id)))
-
-(define
-  doc-find
-  (fn
-    (doc id)
-    (let
-      ((hits (filter (fn (b) (= (blk-id b) id)) (doc-blocks doc))))
-      (if (= (len hits) 0) nil (first hits)))))
-
-(define
-  doc-has?
-  (fn (doc id) (if (= (doc-index-of doc id) -1) false true)))
-
-;; ── structural edits (each returns a new document) ──
-(define doc-with-blocks (fn (doc blocks) (st-iv-set! doc "blocks" blocks)))
-
-(define
-  doc-append
-  (fn
-    (doc block)
-    (doc-with-blocks doc (append (doc-blocks doc) (list block)))))
-
-(define
-  doc-insert-at
-  (fn
-    (doc block i)
-    (doc-with-blocks doc (ct-insert-at (doc-blocks doc) i block))))
-
-(define
-  doc-insert-after
-  (fn
-    (doc block after-id)
-    (let
-      ((blocks (doc-blocks doc)))
-      (if
-        (= after-id nil)
-        (doc-with-blocks doc (cons block blocks))
-        (let
-          ((idx (ct-index-of blocks after-id)))
-          (if
-            (= idx -1)
-            (doc-with-blocks doc (append blocks (list block)))
-            (doc-with-blocks
-              doc
-              (ct-insert-at blocks (+ idx 1) block))))))))
-
-(define
-  doc-update
-  (fn
-    (doc id field value)
-    (doc-with-blocks
-      doc
-      (ct-replace-id (doc-blocks doc) id (fn (b) (blk-set b field value))))))
-
-(define
-  doc-delete
-  (fn (doc id) (doc-with-blocks doc (ct-remove-id (doc-blocks doc) id))))
-
-(define
-  doc-move
-  (fn
-    (doc id i)
-    (let
-      ((blk (doc-find doc id)))
-      (if
-        (= blk nil)
-        doc
-        (doc-with-blocks
-          doc
-          (ct-insert-at (ct-remove-id (doc-blocks doc) id) i blk))))))
-
-;; ── op constructors (data payload, reused by persist op log) ──
-(define op-insert (fn (block after) {:after after :op "insert" :block block}))
-
-(define op-update (fn (id field value) {:field field :id id :op "update" :value value}))
-
-(define op-move (fn (id index) {:id id :op "move" :index index}))
-
-(define op-delete (fn (id) {:id id :op "delete"}))
-
-;; ── op interpreter ──
-(define
-  doc-apply
-  (fn
-    (doc op)
-    (let
-      ((kind (get op :op)))
-      (cond
-        ((= kind "insert")
-          (doc-insert-after doc (get op :block) (get op :after)))
-        ((= kind "update")
-          (doc-update doc (get op :id) (get op :field) (get op :value)))
-        ((= kind "move") (doc-move doc (get op :id) (get op :index)))
-        ((= kind "delete") (doc-delete doc (get op :id)))
-        (else (error (str "unknown op: " kind)))))))
-
-(define
-  doc-apply-all
-  (fn
-    (doc ops)
-    (if
-      (= (len ops) 0)
-      doc
-      (doc-apply-all (doc-apply doc (first ops)) (rest ops)))))
-
-;; ── render-agnostic snapshot: list of (id . type) for assertions/debug ──
-(define doc-ids (fn (doc) (map (fn (b) (blk-id b)) (doc-blocks doc))))
-
-(define
-  doc-types
-  (fn (doc) (map (fn (b) (blk-type b)) (doc-blocks doc))))

lib/content/fed.sx

@@ -1,68 +0,0 @@
-;; content-on-sx — federated documents: trust-gated peer-authored ops.
-;;
-;; A peer-authored op carries provenance (:author, and a :sig stub). We never
-;; auto-accept: a peer op is applied only if it passes a trust gate. The gate is
-;; a predicate (fn op -> bool) so acl-on-sx can inject real trust facts later;
-;; the convenience form takes an explicit trusted-actor list (the stub).
-;;
-;; Accepted ops flow through the CvRDT merge (Phase 3), so concurrent local and
-;; external edits reconcile deterministically (same-field LWW, order-independent).
-;;
-;; Requires (loaded by harness): crdt.sx (and its deps).
-
-;; tag an op with provenance
-(define content/authored (fn (op author) (assoc op :author author)))
-
-(define
-  content/signed
-  (fn (op author sig) (assoc (assoc op :author author) :sig sig)))
-
-;; explicit trust stub: membership in a trusted-actor list
-(define content/trusted? (fn (trust author) (crdt-member? author trust)))
-
-;; general form: accept? is a predicate (fn op -> bool). Applies accepted ops
-;; through the CRDT; quarantines the rest. Returns
-;; {:state :accepted (ops) :rejected (ops)}.
-(define
-  content/-merge-peer-loop
-  (fn
-    (state accept? ops accepted rejected)
-    (if
-      (= (len ops) 0)
-      {:state state :accepted (reverse accepted) :rejected (reverse rejected)}
-      (let
-        ((op (first ops)))
-        (if
-          (accept? op)
-          (content/-merge-peer-loop
-            (crdt-apply state op)
-            accept?
-            (rest ops)
-            (cons op accepted)
-            rejected)
-          (content/-merge-peer-loop
-            state
-            accept?
-            (rest ops)
-            accepted
-            (cons op rejected)))))))
-
-(define
-  content/merge-peer-with
-  (fn
-    (state accept? ops)
-    (content/-merge-peer-loop state accept? ops (list) (list))))
-
-;; convenience: trust = list of trusted actor ids
-(define
-  content/merge-peer
-  (fn
-    (state trust ops)
-    (content/merge-peer-with
-      state
-      (fn (op) (content/trusted? trust (get op :author)))
-      ops)))
-
-(define content/accepted (fn (res) (get res :accepted)))
-(define content/rejected (fn (res) (get res :rejected)))
-(define content/peer-state (fn (res) (get res :state)))

lib/content/find-replace.sx

@@ -1,31 +0,0 @@
-;; content-on-sx — global find/replace across text-bearing blocks.
-;;
-;; Replaces every occurrence of `from` with `to` in the text field of text /
-;; heading / code / quote blocks, tree-wide (via the transform layer). For
-;; renaming a term throughout a document. Immutable; case-sensitive.
-;;
-;; Requires (loaded by harness): block.sx, transform.sx (content/map-blocks).
-
-(define
-  fr-in?
-  (fn
-    (x xs)
-    (cond
-      ((= (len xs) 0) false)
-      ((= (first xs) x) true)
-      (else (fr-in? x (rest xs))))))
-
-(define
-  fr-has-text?
-  (fn (b) (fr-in? (blk-type b) (list "text" "heading" "code" "quote"))))
-
-(define
-  content/find-replace
-  (fn
-    (doc from to)
-    (content/map-blocks
-      doc
-      fr-has-text?
-      (fn
-        (b)
-        (blk-set b "text" (replace (str (blk-get b "text")) from to))))))

lib/content/flatten.sx

@@ -1,34 +0,0 @@
-;; content-on-sx — document flatten.
-;;
-;; Un-nests a sectioned document into a flat block sequence: each section is
-;; replaced inline by its (recursively flattened) children, dropping the section
-;; wrapper. The inverse of content/wrap-section, for flat export targets.
-;; Immutable; inline tree handling (no section.sx dep).
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-(define
-  flat-section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-
-(define
-  flat-blocks
-  (fn
-    (blocks)
-    (if
-      (= (len blocks) 0)
-      (list)
-      (let
-        ((b (first blocks)))
-        (append
-          (if
-            (flat-section? b)
-            (let
-              ((ch (st-iv-get b "children")))
-              (if (list? ch) (flat-blocks ch) (list)))
-            (list b))
-          (flat-blocks (rest blocks)))))))
-
-(define
-  content/flatten
-  (fn (doc) (doc-with-blocks doc (flat-blocks (doc-blocks doc)))))

lib/content/index.sx

@@ -1,51 +0,0 @@
-;; content-on-sx — multi-document index.
-;;
-;; Projects a list of documents into summary cards (the blog index page), with
-;; tag filtering (category pages) and a tag cloud. Composes content/summary +
-;; doc metadata.
-;;
-;; Requires (loaded by harness): summary.sx (content/summary), meta.sx (doc-tags).
-
-(define
-  idx-in?
-  (fn
-    (x xs)
-    (cond
-      ((= (len xs) 0) false)
-      ((= (first xs) x) true)
-      (else (idx-in? x (rest xs))))))
-
-(define
-  idx-dedup
-  (fn
-    (xs seen)
-    (if
-      (= (len xs) 0)
-      (reverse seen)
-      (if
-        (idx-in? (first xs) seen)
-        (idx-dedup (rest xs) seen)
-        (idx-dedup (rest xs) (cons (first xs) seen))))))
-
-(define content/index (fn (docs) (map content/summary docs)))
-
-(define content/has-tag? (fn (doc tag) (idx-in? tag (doc-tags doc))))
-
-(define
-  content/index-by-tag
-  (fn
-    (docs tag)
-    (map content/summary (filter (fn (d) (content/has-tag? d tag)) docs))))
-
-(define
-  content/all-tags
-  (fn (docs) (idx-dedup (ct-flatmap-tags docs) (list))))
-
-(define
-  ct-flatmap-tags
-  (fn
-    (docs)
-    (if
-      (= (len docs) 0)
-      (list)
-      (append (doc-tags (first docs)) (ct-flatmap-tags (rest docs))))))

lib/content/markdown.sx

@@ -1,55 +0,0 @@
-;; content-on-sx — Markdown render mode.
-;;
-;; A third boundary format alongside asHTML / asSx, via the same polymorphic
-;; dispatch. The newline is supplied by the boundary as a keyword arg
-;; (asMarkdown: nl) because this Smalltalk dialect has no Character newline
-;; constructor — blocks that need internal newlines (code, lists, doc) use it.
-;;
-;; No Markdown escaping yet (Markdown's escaping rules differ from HTML); raw
-;; text is emitted. Ordered lists emit "1." for every item (Markdown renumbers).
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-(define
-  content-bootstrap-markdown!
-  (fn
-    ()
-    (begin
-      (ct-def-method!
-        "CtHeading"
-        "asMarkdown:"
-        "asMarkdown: nl | h i | h := ''. i := 0. [i < level] whileTrue: [h := h , '#'. i := i + 1]. ^ h , ' ' , text")
-      (ct-def-method! "CtText" "asMarkdown:" "asMarkdown: nl ^ text")
-      (ct-def-method!
-        "CtCode"
-        "asMarkdown:"
-        "asMarkdown: nl ^ '```' , language , nl , text , nl , '```'")
-      (ct-def-method! "CtQuote" "asMarkdown:" "asMarkdown: nl ^ '> ' , text")
-      (ct-def-method!
-        "CtImage"
-        "asMarkdown:"
-        "asMarkdown: nl ^ '![' , alt , '](' , src , ')'")
-      (ct-def-method!
-        "CtEmbed"
-        "asMarkdown:"
-        "asMarkdown: nl ^ '[embed](' , url , ')'")
-      (ct-def-method! "CtDivider" "asMarkdown:" "asMarkdown: nl ^ '---'")
-      (ct-def-method!
-        "CtList"
-        "asMarkdown:"
-        "asMarkdown: nl | mark | mark := ordered ifTrue: ['1. '] ifFalse: ['- ']. ^ (items inject: '' into: [:a :x | a , (a = '' ifTrue: [''] ifFalse: [nl]) , mark , x])")
-      (ct-def-method!
-        "CtDoc"
-        "asMarkdown:"
-        "asMarkdown: nl ^ (blocks inject: '' into: [:a :b | a , (a = '' ifTrue: [''] ifFalse: [nl , nl]) , (b asMarkdown: nl)])")
-      true)))
-
-(define ct-nl (str "\n"))
-
-;; ── SX boundary ──
-(define
-  asMarkdown
-  (fn (node) (str (st-send node "asMarkdown:" (list ct-nl)))))
-(define content/markdown asMarkdown)
-(define render-markdown asMarkdown)
-(define block-markdown asMarkdown)

lib/content/md-doc.sx

@@ -1,63 +0,0 @@
-;; content-on-sx — Markdown document export (frontmatter + body).
-;;
-;; content/markdown-doc emits a YAML-ish --- frontmatter block from the document
-;; metadata (title/slug/tags) followed by the Markdown body, completing the
-;; metadata round-trip with md/import (md/import ∘ content/markdown-doc keeps
-;; title/slug/tags). With no metadata it is just asMarkdown.
-;;
-;; Requires (loaded by harness): doc.sx, meta.sx (doc-title/slug/tags),
-;; markdown.sx (asMarkdown).
-
-(define mdd-nl (str "\n"))
-
-(define
-  mdd-join
-  (fn
-    (sep parts)
-    (cond
-      ((= (len parts) 0) "")
-      ((= (len parts) 1) (first parts))
-      (else (str (first parts) sep (mdd-join sep (rest parts)))))))
-
-(define
-  content/-fm-parts
-  (fn
-    (doc)
-    (append
-      (append
-        (if
-          (= (doc-title doc) nil)
-          (list)
-          (list (str "title: " (doc-title doc))))
-        (if
-          (= (doc-slug doc) nil)
-          (list)
-          (list (str "slug: " (doc-slug doc)))))
-      (let
-        ((tags (doc-tags doc)))
-        (if
-          (= (len tags) 0)
-          (list)
-          (list (str "tags: " (mdd-join ", " tags))))))))
-
-(define
-  content/-frontmatter
-  (fn
-    (doc)
-    (let
-      ((parts (content/-fm-parts doc)))
-      (if
-        (= (len parts) 0)
-        ""
-        (str "---" mdd-nl (mdd-join mdd-nl parts) mdd-nl "---")))))
-
-(define
-  content/markdown-doc
-  (fn
-    (doc)
-    (let
-      ((fm (content/-frontmatter doc)))
-      (if
-        (= fm "")
-        (asMarkdown doc)
-        (str fm mdd-nl mdd-nl (asMarkdown doc))))))

lib/content/md-import.sx

@@ -1,449 +0,0 @@
-;; content-on-sx — Markdown import adapter (markdown text -> block document).
-;;
-;; A line-based parser, the inverse of markdown.sx's asMarkdown. Confined to the
-;; adapter boundary: the core knows nothing about Markdown. Handles a leading
-;; --- frontmatter block (key: value -> doc metadata), ATX headings (#..######),
-;; fenced code (```lang), blockquotes (> ), unordered (- / * ) and ordered (1. )
-;; lists, thematic breaks (--- / ***), pipe tables (header + --- separator +
-;; body), and paragraphs (consecutive plain lines joined with a space). Block ids
-;; are assigned sequentially b0,b1…
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, table.sx (mk-table),
-;; meta.sx (doc-with-meta); markdown.sx for the adapter's export side.
-
-(define md/-id (fn (i) (str "b" i)))
-(define md/-blank? (fn (s) (= s "")))
-(define md/-hr? (fn (s) (if (= s "---") true (= s "***"))))
-
-(define
-  ct-in?
-  (fn
-    (x xs)
-    (cond
-      ((= (len xs) 0) false)
-      ((= (first xs) x) true)
-      (else (ct-in? x (rest xs))))))
-
-(define
-  ct-starts-with?
-  (fn
-    (s prefix)
-    (and
-      (>= (string-length s) (string-length prefix))
-      (= (substring s 0 (string-length prefix)) prefix))))
-
-(define
-  md/-drop
-  (fn (s prefix) (substring s (string-length prefix) (string-length s))))
-
-(define
-  md/-drop-n
-  (fn
-    (xs n)
-    (if
-      (= n 0)
-      xs
-      (if
-        (= (len xs) 0)
-        xs
-        (md/-drop-n (rest xs) (- n 1))))))
-
-(define
-  md/-join-with
-  (fn
-    (sep parts)
-    (cond
-      ((= (len parts) 0) "")
-      ((= (len parts) 1) (first parts))
-      (else (str (first parts) sep (md/-join-with sep (rest parts)))))))
-(define md/-join-sp (fn (parts) (md/-join-with " " parts)))
-(define md/-join-nl (fn (parts) (md/-join-with (str "\n") parts)))
-
-;; ── heading detection (leading #s then a space) ──
-(define
-  md/-hashes
-  (fn
-    (s n)
-    (if
-      (and
-        (< n (string-length s))
-        (= (substring s n (+ n 1)) "#"))
-      (md/-hashes s (+ n 1))
-      n)))
-(define
-  md/-heading?
-  (fn
-    (line)
-    (let
-      ((n (md/-hashes line 0)))
-      (and
-        (> n 0)
-        (<= n 6)
-        (> (string-length line) n)
-        (= (substring line n (+ n 1)) " ")))))
-(define
-  md/-heading-block
-  (fn
-    (line i)
-    (let
-      ((n (md/-hashes line 0)))
-      (mk-heading
-        (md/-id i)
-        n
-        (substring line (+ n 1) (string-length line))))))
-
-;; ── list detection ──
-(define
-  ct-digit?
-  (fn (ch) (ct-in? ch (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))))
-(define
-  md/-digits
-  (fn
-    (s n)
-    (if
-      (and
-        (< n (string-length s))
-        (ct-digit? (substring s n (+ n 1))))
-      (md/-digits s (+ n 1))
-      n)))
-(define
-  md/-ol?
-  (fn
-    (line)
-    (let
-      ((n (md/-digits line 0)))
-      (and
-        (> n 0)
-        (>= (string-length line) (+ n 2))
-        (= (substring line n (+ n 2)) ". ")))))
-(define
-  md/-drop-ol
-  (fn
-    (line)
-    (let
-      ((n (md/-digits line 0)))
-      (substring line (+ n 2) (string-length line)))))
-(define
-  md/-ul?
-  (fn
-    (line)
-    (if (ct-starts-with? line "- ") true (ct-starts-with? line "* "))))
-(define
-  md/-drop-ul
-  (fn (line) (substring line 2 (string-length line))))
-
-;; ── table detection ──
-(define md/-pipe-row? (fn (line) (ct-starts-with? (trim line) "|")))
-(define md/-sep-char? (fn (ch) (ct-in? ch (list "-" ":" "|" " "))))
-(define
-  md/-all-sep?
-  (fn
-    (s i)
-    (if
-      (>= i (string-length s))
-      true
-      (if
-        (md/-sep-char? (substring s i (+ i 1)))
-        (md/-all-sep? s (+ i 1))
-        false))))
-(define
-  md/-has-dash?
-  (fn
-    (s i)
-    (if
-      (>= i (string-length s))
-      false
-      (if
-        (= (substring s i (+ i 1)) "-")
-        true
-        (md/-has-dash? s (+ i 1))))))
-(define
-  md/-sep-row?
-  (fn
-    (line)
-    (and
-      (md/-pipe-row? line)
-      (md/-all-sep? (trim line) 0)
-      (md/-has-dash? line 0))))
-(define
-  md/-table-start?
-  (fn
-    (lines)
-    (and
-      (md/-pipe-row? (first lines))
-      (> (len lines) 1)
-      (md/-sep-row? (nth lines 1)))))
-(define
-  md/-strip-pipes
-  (fn
-    (s0)
-    (let
-      ((s (trim s0)))
-      (let
-        ((a (if (ct-starts-with? s "|") (substring s 1 (string-length s)) s)))
-        (if
-          (and
-            (> (string-length a) 0)
-            (=
-              (substring
-                a
-                (- (string-length a) 1)
-                (string-length a))
-              "|"))
-          (substring a 0 (- (string-length a) 1))
-          a)))))
-(define
-  md/-cells
-  (fn (line) (map (fn (c) (trim c)) (split (md/-strip-pipes line) "|"))))
-
-(define
-  md/-plain?
-  (fn
-    (line)
-    (if
-      (md/-blank? line)
-      false
-      (if
-        (ct-starts-with? line "```")
-        false
-        (if
-          (md/-heading? line)
-          false
-          (if
-            (ct-starts-with? line "> ")
-            false
-            (if
-              (md/-hr? line)
-              false
-              (if (md/-ul? line) false (if (md/-ol? line) false true)))))))))
-
-;; ── multi-line collectors ──
-(define
-  md/-code
-  (fn
-    (lines i acc)
-    (md/-code-collect
-      (rest lines)
-      (md/-drop (first lines) "```")
-      (list)
-      i
-      acc)))
-(define
-  md/-code-collect
-  (fn
-    (lines lang body i acc)
-    (cond
-      ((= (len lines) 0)
-        (md/-walk
-          lines
-          (+ i 1)
-          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
-      ((= (first lines) "```")
-        (md/-walk
-          (rest lines)
-          (+ i 1)
-          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
-      (else
-        (md/-code-collect (rest lines) lang (cons (first lines) body) i acc)))))
-
-(define
-  md/-table-body
-  (fn
-    (lines headers rows i acc)
-    (if
-      (= (len lines) 0)
-      (md/-walk
-        lines
-        (+ i 1)
-        (cons (mk-table (md/-id i) headers (reverse rows)) acc))
-      (let
-        ((line (first lines)))
-        (if
-          (md/-pipe-row? line)
-          (md/-table-body
-            (rest lines)
-            headers
-            (cons (md/-cells line) rows)
-            i
-            acc)
-          (md/-walk
-            lines
-            (+ i 1)
-            (cons (mk-table (md/-id i) headers (reverse rows)) acc)))))))
-(define
-  md/-table
-  (fn
-    (lines i acc)
-    (md/-table-body
-      (rest (rest lines))
-      (md/-cells (first lines))
-      (list)
-      i
-      acc)))
-
-(define
-  md/-list-collect
-  (fn
-    (lines items i acc ordered)
-    (if
-      (= (len lines) 0)
-      (md/-walk
-        lines
-        (+ i 1)
-        (cons (mk-list (md/-id i) ordered (reverse items)) acc))
-      (let
-        ((line (first lines)))
-        (cond
-          (ordered
-            (if
-              (md/-ol? line)
-              (md/-list-collect
-                (rest lines)
-                (cons (md/-drop-ol line) items)
-                i
-                acc
-                ordered)
-              (md/-walk
-                lines
-                (+ i 1)
-                (cons (mk-list (md/-id i) ordered (reverse items)) acc))))
-          (else
-            (if
-              (md/-ul? line)
-              (md/-list-collect
-                (rest lines)
-                (cons (md/-drop-ul line) items)
-                i
-                acc
-                ordered)
-              (md/-walk
-                lines
-                (+ i 1)
-                (cons (mk-list (md/-id i) ordered (reverse items)) acc)))))))))
-
-(define
-  md/-para-collect
-  (fn
-    (lines parts i acc)
-    (if
-      (= (len lines) 0)
-      (md/-walk
-        lines
-        (+ i 1)
-        (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc))
-      (let
-        ((line (first lines)))
-        (if
-          (md/-plain? line)
-          (md/-para-collect (rest lines) (cons line parts) i acc)
-          (md/-walk
-            lines
-            (+ i 1)
-            (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc)))))))
-
-;; ── main walk ──
-(define
-  md/-walk
-  (fn
-    (lines i acc)
-    (if
-      (= (len lines) 0)
-      (reverse acc)
-      (let
-        ((line (first lines)))
-        (cond
-          ((md/-blank? line) (md/-walk (rest lines) i acc))
-          ((ct-starts-with? line "```") (md/-code lines i acc))
-          ((md/-heading? line)
-            (md/-walk
-              (rest lines)
-              (+ i 1)
-              (cons (md/-heading-block line i) acc)))
-          ((ct-starts-with? line "> ")
-            (md/-walk
-              (rest lines)
-              (+ i 1)
-              (cons (mk-quote (md/-id i) "" (md/-drop line "> ")) acc)))
-          ((md/-hr? line)
-            (md/-walk
-              (rest lines)
-              (+ i 1)
-              (cons (mk-divider (md/-id i)) acc)))
-          ((md/-table-start? lines) (md/-table lines i acc))
-          ((md/-ul? line) (md/-list-collect lines (list) i acc false))
-          ((md/-ol? line) (md/-list-collect lines (list) i acc true))
-          (else (md/-para-collect lines (list) i acc)))))))
-
-(define
-  md/parse
-  (fn (text) (md/-walk (split text (str "\n")) 0 (list))))
-
-;; ── frontmatter (leading --- key: value --- block) ──
-(define
-  md/-frontmatter?
-  (fn (lines) (and (> (len lines) 0) (= (first lines) "---"))))
-(define
-  md/-fm-end
-  (fn
-    (lines i)
-    (cond
-      ((>= i (len lines)) -1)
-      ((= (nth lines i) "---") i)
-      (else (md/-fm-end lines (+ i 1))))))
-(define
-  md/-fm-add
-  (fn
-    (acc line)
-    (let
-      ((parts (split line ":")))
-      (if
-        (< (len parts) 2)
-        acc
-        (let
-          ((key (trim (first parts)))
-            (val (trim (md/-join-with ":" (rest parts)))))
-          (cond
-            ((= key "title") (assoc acc :title val))
-            ((= key "slug") (assoc acc :slug val))
-            ((= key "tags")
-              (assoc acc :tags (map (fn (t) (trim t)) (split val ","))))
-            (else acc)))))))
-(define
-  md/-fm-pairs
-  (fn
-    (lines start end acc)
-    (if
-      (>= start end)
-      acc
-      (md/-fm-pairs
-        lines
-        (+ start 1)
-        end
-        (md/-fm-add acc (nth lines start))))))
-
-;; ── adapter ──
-(define
-  md/import
-  (fn
-    (text doc-id)
-    (let
-      ((lines (split text (str "\n"))))
-      (if
-        (md/-frontmatter? lines)
-        (let
-          ((end (md/-fm-end lines 1)))
-          (if
-            (= end -1)
-            (doc-new doc-id (md/-walk lines 0 (list)))
-            (doc-with-meta
-              (doc-new
-                doc-id
-                (md/-walk
-                  (md/-drop-n lines (+ end 1))
-                  0
-                  (list)))
-              (md/-fm-pairs lines 1 end {}))))
-        (doc-new doc-id (md/-walk lines 0 (list)))))))
-
-(define content/from-markdown md/import)
-(define markdown-adapter {:export (fn (doc) (asMarkdown doc)) :import md/import})

lib/content/media.sx

@@ -1,52 +0,0 @@
-;; content-on-sx — video/audio media block.
-;;
-;; CtMedia holds a `kind` (video/audio) and `src`. Self-contained: answers
-;; asHTML/asSx/asText/asMarkdown: so it composes with the render boundary with no
-;; changes elsewhere. HTML src is htmlEscaped, SX src sxEscaped.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers);
-;; markdown.sx / text.sx for those formats.
-
-(define
-  content-bootstrap-media!
-  (fn
-    ()
-    (begin
-      (st-class-define! "CtMedia" "CtBlock" (list "kind" "src"))
-      (ct-def-method! "CtMedia" "kind" "kind ^ kind")
-      (ct-def-method! "CtMedia" "src" "src ^ src")
-      (ct-def-method! "CtMedia" "type" "type ^ #media")
-      (ct-def-method!
-        "CtMedia"
-        "asHTML"
-        "asHTML ^ '<' , kind , ' src=\"' , src htmlEscaped , '\" controls></' , kind , '>'")
-      (ct-def-method!
-        "CtMedia"
-        "asSx"
-        "asSx ^ '(' , kind , ' :src \"' , src sxEscaped , '\")'")
-      (ct-def-method! "CtMedia" "asText" "asText ^ ''")
-      (ct-def-method!
-        "CtMedia"
-        "asMarkdown:"
-        "asMarkdown: nl ^ '[' , kind , '](' , src , ')'")
-      true)))
-
-(define
-  mk-media
-  (fn
-    (id kind src)
-    (st-iv-set!
-      (st-iv-set!
-        (st-iv-set! (st-make-instance "CtMedia") "id" id)
-        "kind"
-        kind)
-      "src"
-      src)))
-
-(define
-  media?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtMedia"))))
-(define media-kind (fn (b) (st-send b "kind" (list))))
-
-(define mk-video (fn (id src) (mk-media id "video" src)))
-(define mk-audio (fn (id src) (mk-media id "audio" src)))

lib/content/meta.sx

@@ -1,53 +0,0 @@
-;; content-on-sx — document metadata (title / slug / tags).
-;;
-;; CtDoc carries optional metadata alongside its blocks (ivars declared in
-;; doc.sx). Reads go through message dispatch; setters are copy-on-write
-;; (functional st-iv-set!), consistent with the immutable document model.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-;; ── reads ──
-(define doc-title (fn (doc) (st-send doc "title" (list))))
-(define doc-slug (fn (doc) (st-send doc "slug" (list))))
-(define
-  doc-tags
-  (fn
-    (doc)
-    (let ((t (st-send doc "tags" (list)))) (if (= t nil) (list) t))))
-
-(define doc-meta (fn (doc) {:slug (doc-slug doc) :id (doc-id doc) :title (doc-title doc) :tags (doc-tags doc)}))
-
-;; ── copy-on-write setters ──
-(define doc-with-title (fn (doc title) (st-iv-set! doc "title" title)))
-(define doc-with-slug (fn (doc slug) (st-iv-set! doc "slug" slug)))
-(define doc-with-tags (fn (doc tags) (st-iv-set! doc "tags" tags)))
-
-(define
-  doc-add-tag
-  (fn (doc tag) (doc-with-tags doc (append (doc-tags doc) (list tag)))))
-
-;; set several at once: meta is a dict with optional :title :slug :tags
-(define
-  doc-with-meta
-  (fn
-    (doc meta)
-    (let
-      ((d1 (if (has-key? meta :title) (doc-with-title doc (get meta :title)) doc)))
-      (let
-        ((d2 (if (has-key? meta :slug) (doc-with-slug d1 (get meta :slug)) d1)))
-        (if (has-key? meta :tags) (doc-with-tags d2 (get meta :tags)) d2)))))
-
-;; constructor with metadata
-(define
-  doc-new-meta
-  (fn (id blocks meta) (doc-with-meta (doc-new id blocks) meta)))
-
-;; ── content/* facade aliases ──
-(define content/title doc-title)
-(define content/slug doc-slug)
-(define content/tags doc-tags)
-(define content/meta doc-meta)
-(define content/with-title doc-with-title)
-(define content/with-slug doc-with-slug)
-(define content/with-tags doc-with-tags)
-(define content/with-meta doc-with-meta)

lib/content/move.sx

@@ -1,69 +0,0 @@
-;; content-on-sx — relative block reorder.
-;;
-;; Move a top-level block to just before / after another block by id — more
-;; ergonomic than the index-based doc-move. No-op if either id is missing.
-;; Immutable; composes the doc.sx list helpers.
-;;
-;; Requires (loaded by harness): doc.sx.
-
-(define
-  content/move-before
-  (fn
-    (doc id target)
-    (let
-      ((blk (doc-find doc id)))
-      (if
-        (= blk nil)
-        doc
-        (let
-          ((without (ct-remove-id (doc-blocks doc) id)))
-          (let
-            ((idx (ct-index-of without target)))
-            (if
-              (= idx -1)
-              doc
-              (doc-with-blocks doc (ct-insert-at without idx blk)))))))))
-
-(define
-  content/move-after
-  (fn
-    (doc id target)
-    (let
-      ((blk (doc-find doc id)))
-      (if
-        (= blk nil)
-        doc
-        (let
-          ((without (ct-remove-id (doc-blocks doc) id)))
-          (let
-            ((idx (ct-index-of without target)))
-            (if
-              (= idx -1)
-              doc
-              (doc-with-blocks
-                doc
-                (ct-insert-at without (+ idx 1) blk)))))))))
-
-(define
-  content/move-to-front
-  (fn
-    (doc id)
-    (let
-      ((blk (doc-find doc id)))
-      (if
-        (= blk nil)
-        doc
-        (doc-with-blocks doc (cons blk (ct-remove-id (doc-blocks doc) id)))))))
-
-(define
-  content/move-to-back
-  (fn
-    (doc id)
-    (let
-      ((blk (doc-find doc id)))
-      (if
-        (= blk nil)
-        doc
-        (doc-with-blocks
-          doc
-          (append (ct-remove-id (doc-blocks doc) id) (list blk)))))))

lib/content/normalize.sx

@@ -1,49 +0,0 @@
-;; content-on-sx — document normalization.
-;;
-;; A cleanup pass: drop empty text blocks and empty sections across the tree.
-;; Sections are normalised first, so a section that becomes empty (all children
-;; dropped) is itself dropped. For tidying imported/edited documents. Immutable.
-;; Inline tree handling (no section.sx dep).
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-(define
-  norm-section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-(define
-  norm-empty-text?
-  (fn (b) (and (= (blk-type b) "text") (= (str (blk-get b "text")) ""))))
-(define
-  norm-empty-section?
-  (fn
-    (b)
-    (and
-      (norm-section? b)
-      (let
-        ((ch (st-iv-get b "children")))
-        (or (= ch nil) (= (len ch) 0))))))
-
-(define
-  norm-recurse
-  (fn
-    (b)
-    (if
-      (norm-section? b)
-      (let
-        ((ch (st-iv-get b "children")))
-        (if (list? ch) (st-iv-set! b "children" (norm-blocks ch)) b))
-      b)))
-
-(define
-  norm-keep?
-  (fn
-    (b)
-    (if (norm-empty-text? b) false (if (norm-empty-section? b) false true))))
-
-(define
-  norm-blocks
-  (fn (blocks) (filter norm-keep? (map norm-recurse blocks))))
-
-(define
-  content/normalize
-  (fn (doc) (doc-with-blocks doc (norm-blocks (doc-blocks doc)))))

lib/content/outline.sx

@@ -1,34 +0,0 @@
-;; content-on-sx — nested document outline.
-;;
-;; Builds a hierarchical heading tree from content/headings: each node is
-;; {:id :text :level :children}, where a heading nests under the nearest
-;; preceding heading of a lower level. The structured companion to the flat TOC,
-;; for rendering nested navigation.
-;;
-;; Requires (loaded by harness): query.sx (content/headings).
-
-;; consume a prefix of `hs` forming nodes whose level > minlevel; return
-;; {:nodes ... :rest ...}.
-(define
-  ol-forest
-  (fn
-    (hs minlevel)
-    (if
-      (= (len hs) 0)
-      {:rest (list) :nodes (list)}
-      (let
-        ((h (first hs)))
-        (if
-          (<= (get h :level) minlevel)
-          {:rest hs :nodes (list)}
-          (let
-            ((sub (ol-forest (rest hs) (get h :level))))
-            (let
-              ((node {:id (get h :id) :text (get h :text) :children (get sub :nodes) :level (get h :level)}))
-              (let
-                ((more (ol-forest (get sub :rest) minlevel)))
-                {:rest (get more :rest) :nodes (cons node (get more :nodes))}))))))))
-
-(define
-  content/outline
-  (fn (doc) (get (ol-forest (content/headings doc) 0) :nodes)))

lib/content/page-full.sx

@@ -1,23 +0,0 @@
-;; content-on-sx — SEO-complete HTML page.
-;;
-;; content/page-full extends content/page with a lang attribute and a
-;; <meta name="description"> drawn from the document excerpt (plain text,
-;; truncated). Composes the page, metadata and text layers.
-;;
-;; Requires (loaded by harness): page.sx (ct-html-escape, content/page-title),
-;; text.sx (content/excerpt), render.sx (asHTML).
-
-(define CONTENT-EXCERPT-LEN 160)
-
-(define
-  content/page-full
-  (fn
-    (doc)
-    (str
-      "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>"
-      (ct-html-escape (content/page-title doc))
-      "</title><meta name=\"description\" content=\""
-      (ct-html-escape (content/excerpt doc CONTENT-EXCERPT-LEN))
-      "\"></head><body>"
-      (asHTML doc)
-      "</body></html>")))

lib/content/page.sx

@@ -1,26 +0,0 @@
-;; content-on-sx — full HTML page wrapper.
-;;
-;; content/page composes the metadata + render layers into the shippable
-;; artifact the blog serves: a minimal valid HTML5 document with an escaped
-;; <title> (from doc metadata, falling back to the id) and the rendered blocks
-;; as the body.
-;;
-;; Requires (loaded by harness): doc.sx, render.sx (asHTML + htmlEscaped),
-;; meta.sx (doc-title).
-
-(define ct-html-escape (fn (s) (str (st-send s "htmlEscaped" (list)))))
-
-(define
-  content/page-title
-  (fn (doc) (let ((t (doc-title doc))) (if (= t nil) (doc-id doc) t))))
-
-(define
-  content/page
-  (fn
-    (doc)
-    (str
-      "<!doctype html><html><head><meta charset=\"utf-8\"><title>"
-      (ct-html-escape (content/page-title doc))
-      "</title></head><body>"
-      (asHTML doc)
-      "</body></html>")))

lib/content/query.sx

@@ -1,51 +0,0 @@
-;; content-on-sx — block query + table of contents.
-;;
-;; Collect blocks across the whole tree (descending into sections) by predicate
-;; or type, and derive a table of contents from headings. Tree detection is
-;; inline (class + st-iv-get) so this needs no section.sx.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-(define
-  qry-section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-(define
-  qry-tree
-  (fn
-    (blocks)
-    (if
-      (= (len blocks) 0)
-      (list)
-      (let
-        ((b (first blocks)))
-        (append
-          (cons
-            b
-            (if
-              (qry-section? b)
-              (let
-                ((ch (st-iv-get b "children")))
-                (if (list? ch) (qry-tree ch) (list)))
-              (list)))
-          (qry-tree (rest blocks)))))))
-
-(define
-  content/select
-  (fn (doc pred) (filter pred (qry-tree (doc-blocks doc)))))
-
-(define
-  content/select-type
-  (fn (doc type) (content/select doc (fn (b) (= (blk-type b) type)))))
-
-(define
-  content/count-type
-  (fn (doc type) (len (content/select-type doc type))))
-
-(define
-  content/select-ids
-  (fn (doc pred) (map (fn (b) (blk-id b)) (content/select doc pred))))
-
-;; table of contents: {:id :level :text} for every heading, in document order.
-(define
-  content/headings
-  (fn (doc) (map (fn (b) {:id (blk-id b) :text (blk-get b "text") :level (blk-get b "level")}) (content/select-type doc "heading"))))

lib/content/render.sx

@@ -1,99 +0,0 @@
-;; content-on-sx — render boundary.
-;;
-;; Rendering is a message, not a property switch: every block (and the document)
-;; answers asHTML and asSx. The internal model carries no presentation — the
-;; boundary format is chosen by which message you send. The document folds its
-;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
-;; sends with no type dispatch in the SX layer.
-;;
-;; Escaping happens HERE, at the boundary. asHTML routes text/attrs through
-;; String>>htmlEscaped (& < > "); asSx routes them through String>>sxEscaped
-;; (\ and ") so values cannot break out of an element or an SX string literal.
-
-(define
-  content-bootstrap-render!
-  (fn
-    ()
-    (begin
-      (ct-def-method!
-        "String"
-        "htmlEscaped"
-        "htmlEscaped | out i n c | out := ''. n := self size. i := 1. [i <= n] whileTrue: [c := self at: i. (c = $&) ifTrue: [out := out , '&amp;'] ifFalse: [(c = $<) ifTrue: [out := out , '&lt;'] ifFalse: [(c = $>) ifTrue: [out := out , '&gt;'] ifFalse: [(c = $\") ifTrue: [out := out , '&quot;'] ifFalse: [out := out , c asString]]]]. i := i + 1]. ^ out")
-      (ct-def-method!
-        "String"
-        "sxEscaped"
-        "sxEscaped | out i n c | out := ''. n := self size. i := 1. [i <= n] whileTrue: [c := self at: i. (c = $\\) ifTrue: [out := out , '\\\\'] ifFalse: [(c = $\") ifTrue: [out := out , '\\\"'] ifFalse: [out := out , c asString]]. i := i + 1]. ^ out")
-      (ct-def-method!
-        "CtHeading"
-        "asHTML"
-        "asHTML | t | t := level printString. ^ '<h' , t , '>' , text htmlEscaped , '</h' , t , '>'")
-      (ct-def-method!
-        "CtText"
-        "asHTML"
-        "asHTML ^ '<p>' , text htmlEscaped , '</p>'")
-      (ct-def-method!
-        "CtCode"
-        "asHTML"
-        "asHTML ^ '<pre><code class=\"language-' , language htmlEscaped , '\">' , text htmlEscaped , '</code></pre>'")
-      (ct-def-method!
-        "CtQuote"
-        "asHTML"
-        "asHTML ^ '<blockquote>' , text htmlEscaped , '</blockquote>'")
-      (ct-def-method!
-        "CtImage"
-        "asHTML"
-        "asHTML ^ '<img src=\"' , src htmlEscaped , '\" alt=\"' , alt htmlEscaped , '\">'")
-      (ct-def-method!
-        "CtEmbed"
-        "asHTML"
-        "asHTML ^ '<iframe src=\"' , url htmlEscaped , '\"></iframe>'")
-      (ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'")
-      (ct-def-method!
-        "CtList"
-        "asHTML"
-        "asHTML | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '<' , tag , '>' , (items inject: '' into: [:a :x | a , '<li>' , x htmlEscaped , '</li>']) , '</' , tag , '>'")
-      (ct-def-method!
-        "CtDoc"
-        "asHTML"
-        "asHTML ^ blocks inject: '' into: [:a :b | a , (b asHTML)]")
-      (ct-def-method!
-        "CtHeading"
-        "asSx"
-        "asSx | t | t := level printString. ^ '(h' , t , ' \"' , text sxEscaped , '\")'")
-      (ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text sxEscaped , '\")'")
-      (ct-def-method!
-        "CtCode"
-        "asSx"
-        "asSx ^ '(pre (code \"' , text sxEscaped , '\"))'")
-      (ct-def-method!
-        "CtQuote"
-        "asSx"
-        "asSx ^ '(blockquote \"' , text sxEscaped , '\")'")
-      (ct-def-method!
-        "CtImage"
-        "asSx"
-        "asSx ^ '(img :src \"' , src sxEscaped , '\" :alt \"' , alt sxEscaped , '\")'")
-      (ct-def-method!
-        "CtEmbed"
-        "asSx"
-        "asSx ^ '(iframe :src \"' , url sxEscaped , '\")'")
-      (ct-def-method! "CtDivider" "asSx" "asSx ^ '(hr)'")
-      (ct-def-method!
-        "CtList"
-        "asSx"
-        "asSx | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '(' , tag , ' ' , (items inject: '' into: [:a :x | a , '(li \"' , x sxEscaped , '\")']) , ')'")
-      (ct-def-method!
-        "CtDoc"
-        "asSx"
-        "asSx ^ '(article ' , (blocks inject: '' into: [:a :b | a , (b asSx)]) , ')'")
-      true)))
-
-;; ── SX boundary API — pure message sends ──
-(define asHTML (fn (node) (str (st-send node "asHTML" (list)))))
-(define asSx (fn (node) (str (st-send node "asSx" (list)))))
-
-;; readable aliases
-(define render-html asHTML)
-(define render-sx asSx)
-(define block-html asHTML)
-(define block-sx asSx)

lib/content/scoreboard.json

@@ -1,48 +0,0 @@
-{
-  "suites": {
-    "block": {"pass": 38, "fail": 0},
-    "doc": {"pass": 40, "fail": 0},
-    "render": {"pass": 42, "fail": 0},
-    "api": {"pass": 26, "fail": 0},
-    "meta": {"pass": 27, "fail": 0},
-    "page": {"pass": 7, "fail": 0},
-    "page-full": {"pass": 4, "fail": 0},
-    "markdown": {"pass": 20, "fail": 0},
-    "text": {"pass": 20, "fail": 0},
-    "section": {"pass": 25, "fail": 0},
-    "compose": {"pass": 17, "fail": 0},
-    "tree-edit": {"pass": 17, "fail": 0},
-    "move": {"pass": 11, "fail": 0},
-    "clone": {"pass": 10, "fail": 0},
-    "query": {"pass": 13, "fail": 0},
-    "toc": {"pass": 8, "fail": 0},
-    "anchor": {"pass": 6, "fail": 0},
-    "outline": {"pass": 14, "fail": 0},
-    "flatten": {"pass": 10, "fail": 0},
-    "transform": {"pass": 12, "fail": 0},
-    "normalize": {"pass": 11, "fail": 0},
-    "find-replace": {"pass": 10, "fail": 0},
-    "stats": {"pass": 17, "fail": 0},
-    "summary": {"pass": 14, "fail": 0},
-    "index": {"pass": 13, "fail": 0},
-    "table": {"pass": 15, "fail": 0},
-    "callout": {"pass": 12, "fail": 0},
-    "media": {"pass": 15, "fail": 0},
-    "data": {"pass": 25, "fail": 0},
-    "wire": {"pass": 11, "fail": 0},
-    "validate": {"pass": 23, "fail": 0},
-    "store": {"pass": 33, "fail": 0},
-    "snapshot": {"pass": 20, "fail": 0},
-    "crdt": {"pass": 34, "fail": 0},
-    "crdt-tree": {"pass": 21, "fail": 0},
-    "crdt-blocks": {"pass": 7, "fail": 0},
-    "crdt-store": {"pass": 14, "fail": 0},
-    "sync": {"pass": 14, "fail": 0},
-    "md-import": {"pass": 38, "fail": 0},
-    "md-doc": {"pass": 12, "fail": 0},
-    "fed": {"pass": 20, "fail": 0}
-  },
-  "total_pass": 746,
-  "total_fail": 0,
-  "total": 746
-}

lib/content/scoreboard.md

@@ -1,48 +0,0 @@
-# content-on-sx Conformance Scoreboard
-
-_Generated by `lib/content/conformance.sh`_
-
-| Suite | Pass | Fail | Total |
-|-------|-----:|-----:|------:|
-| block | 38 | 0 | 38 |
-| doc | 40 | 0 | 40 |
-| render | 42 | 0 | 42 |
-| api | 26 | 0 | 26 |
-| meta | 27 | 0 | 27 |
-| page | 7 | 0 | 7 |
-| page-full | 4 | 0 | 4 |
-| markdown | 20 | 0 | 20 |
-| text | 20 | 0 | 20 |
-| section | 25 | 0 | 25 |
-| compose | 17 | 0 | 17 |
-| tree-edit | 17 | 0 | 17 |
-| move | 11 | 0 | 11 |
-| clone | 10 | 0 | 10 |
-| query | 13 | 0 | 13 |
-| toc | 8 | 0 | 8 |
-| anchor | 6 | 0 | 6 |
-| outline | 14 | 0 | 14 |
-| flatten | 10 | 0 | 10 |
-| transform | 12 | 0 | 12 |
-| normalize | 11 | 0 | 11 |
-| find-replace | 10 | 0 | 10 |
-| stats | 17 | 0 | 17 |
-| summary | 14 | 0 | 14 |
-| index | 13 | 0 | 13 |
-| table | 15 | 0 | 15 |
-| callout | 12 | 0 | 12 |
-| media | 15 | 0 | 15 |
-| data | 25 | 0 | 25 |
-| wire | 11 | 0 | 11 |
-| validate | 23 | 0 | 23 |
-| store | 33 | 0 | 33 |
-| snapshot | 20 | 0 | 20 |
-| crdt | 34 | 0 | 34 |
-| crdt-tree | 21 | 0 | 21 |
-| crdt-blocks | 7 | 0 | 7 |
-| crdt-store | 14 | 0 | 14 |
-| sync | 14 | 0 | 14 |
-| md-import | 38 | 0 | 38 |
-| md-doc | 12 | 0 | 12 |
-| fed | 20 | 0 | 20 |
-| **Total** | **746** | **0** | **746** |

lib/content/section.sx

@@ -1,103 +0,0 @@
-;; content-on-sx — nested block trees (section container).
-;;
-;; CtSection is a block whose ivar `children` is an ordered list of blocks (any
-;; type, including nested sections → arbitrary depth). This turns the document
-;; from a flat sequence into the ordered TREE of the architecture sketch.
-;;
-;; Self-contained: CtSection answers asHTML/asSx/asText/asMarkdown: by folding
-;; its children's renderings — pure polymorphic recursion, so it composes with
-;; the existing render boundary with no changes to block.sx or render.sx. (The
-;; relevant per-block render bootstrap must be loaded for the children.)
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, render.sx (asHTML/asSx);
-;; markdown.sx / text.sx for those formats on children.
-
-(define
-  content-bootstrap-section!
-  (fn
-    ()
-    (begin
-      (st-class-define! "CtSection" "CtBlock" (list "children"))
-      (ct-def-method! "CtSection" "children" "children ^ children")
-      (ct-def-method! "CtSection" "type" "type ^ #section")
-      (ct-def-method!
-        "CtSection"
-        "asHTML"
-        "asHTML ^ '<section>' , (children inject: '' into: [:a :b | a , (b asHTML)]) , '</section>'")
-      (ct-def-method!
-        "CtSection"
-        "asSx"
-        "asSx ^ '(section ' , (children inject: '' into: [:a :b | a , (b asSx)]) , ')'")
-      (ct-def-method!
-        "CtSection"
-        "asText"
-        "asText ^ (children inject: '' into: [:a :b | (b asText = '') ifTrue: [a] ifFalse: [(a = '' ifTrue: [b asText] ifFalse: [a , ' ' , b asText])]])")
-      (ct-def-method!
-        "CtSection"
-        "asMarkdown:"
-        "asMarkdown: nl ^ (children inject: '' into: [:a :b | a , (a = '' ifTrue: [''] ifFalse: [nl , nl]) , (b asMarkdown: nl)])")
-      true)))
-
-(define
-  mk-section
-  (fn
-    (id children)
-    (st-iv-set!
-      (st-iv-set! (st-make-instance "CtSection") "id" id)
-      "children"
-      children)))
-
-(define
-  section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-
-(define section-children (fn (sec) (st-send sec "children" (list))))
-
-;; copy-on-write child edits (return a new section)
-(define
-  section-with-children
-  (fn (sec children) (st-iv-set! sec "children" children)))
-(define
-  section-append
-  (fn
-    (sec block)
-    (section-with-children sec (append (section-children sec) (list block)))))
-
-;; ── tree traversal (descends into nested sections) ──
-(define
-  block-deep-find
-  (fn
-    (blocks id)
-    (if
-      (= (len blocks) 0)
-      nil
-      (let
-        ((b (first blocks)))
-        (if
-          (= (blk-id b) id)
-          b
-          (let
-            ((nested (if (section? b) (block-deep-find (section-children b) id) nil)))
-            (if (= nested nil) (block-deep-find (rest blocks) id) nested)))))))
-
-(define doc-deep-find (fn (doc id) (block-deep-find (doc-blocks doc) id)))
-
-(define
-  block-tree-ids
-  (fn
-    (blocks)
-    (if
-      (= (len blocks) 0)
-      (list)
-      (let
-        ((b (first blocks)))
-        (append
-          (cons
-            (blk-id b)
-            (if (section? b) (block-tree-ids (section-children b)) (list)))
-          (block-tree-ids (rest blocks)))))))
-
-(define doc-tree-ids (fn (doc) (block-tree-ids (doc-blocks doc))))
-
-(define block-tree-count (fn (blocks) (len (block-tree-ids blocks))))
-(define doc-tree-count (fn (doc) (len (doc-tree-ids doc))))

lib/content/snapshot.sx

@@ -1,90 +0,0 @@
-;; content-on-sx — snapshot cache over the op-log replay.
-;;
-;; Snapshots are a CACHE, never primary state: the op log stays the source of
-;; truth. A snapshot stores a materialised document at a sequence in the persist
-;; KV; cached reads start from it and replay only the tail of ops, so they return
-;; a document IDENTICAL to a full replay — just faster. Drop the snapshot and
-;; nothing is lost.
-;;
-;; Requires (loaded by harness): store.sx (+ doc.sx, persist event/log/kv/api).
-
-(define content/-snap-key (fn (doc-id) (str "content-snap:" doc-id)))
-
-;; take a snapshot of the current head at the current version. Returns the seq.
-(define
-  content/snapshot!
-  (fn
-    (b doc-id)
-    (let
-      ((seq (content/version-count b doc-id)))
-      (begin (persist/kv-put b (content/-snap-key doc-id) {:doc (content/head b doc-id) :seq seq}) seq))))
-
-(define
-  content/-snapshot
-  (fn
-    (b doc-id)
-    (if
-      (persist/kv-has? b (content/-snap-key doc-id))
-      (persist/kv-get b (content/-snap-key doc-id))
-      nil)))
-
-(define
-  content/snapshot-seq
-  (fn
-    (b doc-id)
-    (let
-      ((s (content/-snapshot b doc-id)))
-      (if (= s nil) 0 (get s :seq)))))
-
-(define
-  content/has-snapshot?
-  (fn (b doc-id) (persist/kv-has? b (content/-snap-key doc-id))))
-
-(define
-  content/drop-snapshot!
-  (fn (b doc-id) (persist/kv-delete b (content/-snap-key doc-id))))
-
-;; ── cached reads (transparent: identical result to store.sx replay) ──
-(define
-  content/-tail-ops
-  (fn
-    (b doc-id from to)
-    (map
-      (fn (ev) (persist/event-data ev))
-      (filter
-        (fn
-          (ev)
-          (and
-            (> (persist/event-seq ev) from)
-            (<= (persist/event-seq ev) to)))
-        (content/log b doc-id)))))
-
-(define
-  content/head-cached
-  (fn
-    (b doc-id)
-    (let
-      ((snap (content/-snapshot b doc-id)))
-      (if
-        (= snap nil)
-        (content/head b doc-id)
-        (doc-apply-all
-          (get snap :doc)
-          (content/-tail-ops
-            b
-            doc-id
-            (get snap :seq)
-            (content/version-count b doc-id)))))))
-
-(define
-  content/at-cached
-  (fn
-    (b doc-id seq)
-    (let
-      ((snap (content/-snapshot b doc-id)))
-      (if
-        (or (= snap nil) (< seq (get snap :seq)))
-        (content/at b doc-id seq)
-        (doc-apply-all
-          (get snap :doc)
-          (content/-tail-ops b doc-id (get snap :seq) seq))))))

lib/content/stats.sx

@@ -1,49 +0,0 @@
-;; content-on-sx — document statistics (word/char/block counts, reading time).
-;;
-;; Counts derive from the plain-text projection (asText, tree-accurate via
-;; section recursion) and a tree block count (inline class check, so this needs
-;; no section.sx). Reading time uses 200 wpm, rounded up.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, text.sx (asText).
-
-(define
-  ct-words
-  (fn (s) (filter (fn (w) (if (= w "") false true)) (split s " "))))
-
-(define ct-ceil-div (fn (a b) (quotient (+ a (- b 1)) b)))
-
-(define
-  ct-stat-section?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtSection"))))
-(define
-  ct-stat-count
-  (fn
-    (blocks)
-    (if
-      (= (len blocks) 0)
-      0
-      (let
-        ((b (first blocks)))
-        (+
-          (+
-            1
-            (if
-              (ct-stat-section? b)
-              (let
-                ((ch (st-iv-get b "children")))
-                (if (list? ch) (ct-stat-count ch) 0))
-              0))
-          (ct-stat-count (rest blocks)))))))
-
-(define content/word-count (fn (doc) (len (ct-words (asText doc)))))
-(define content/char-count (fn (doc) (string-length (asText doc))))
-(define content/block-count (fn (doc) (ct-stat-count (doc-blocks doc))))
-(define
-  content/reading-minutes
-  (fn
-    (doc)
-    (let
-      ((w (content/word-count doc)))
-      (if (= w 0) 0 (ct-ceil-div w 200)))))
-
-(define content/stats (fn (doc) {:blocks (content/block-count doc) :reading-minutes (content/reading-minutes doc) :words (content/word-count doc) :chars (content/char-count doc)}))

lib/content/store.sx

@@ -1,101 +0,0 @@
-;; content-on-sx — op log + versioning over the persist event stream.
-;;
-;; The op log is the source of truth. Editing a document = appending the edit op
-;; as a persist event to the document's stream. Any version of the document is a
-;; replay of its op stream up to a sequence number; the materialised doc is a
-;; cache, never primary state.
-;;
-;; Requires (loaded by the harness): block.sx, doc.sx, and persist
-;; (event/backend/log/kv/api). The persist backend `b` is opened by the caller
-;; via (persist/open) and injected — content knows nothing about which backend.
-
-(define content/-stream (fn (doc-id) (str "content:" doc-id)))
-
-;; ── commit: append an edit op as an event. `at` is a caller-supplied logical
-;; timestamp (Date.now is unavailable in-kernel). Returns the stored event. ──
-(define
-  content/commit!
-  (fn
-    (b doc-id op at)
-    (persist/append b (content/-stream doc-id) (get op :op) at op)))
-
-(define
-  content/commit-all!
-  (fn
-    (b doc-id ops at)
-    (if
-      (= (len ops) 0)
-      nil
-      (begin
-        (content/commit! b doc-id (first ops) at)
-        (content/commit-all! b doc-id (rest ops) at)))))
-
-;; ── read the raw log / op stream ──
-(define
-  content/log
-  (fn (b doc-id) (persist/read b (content/-stream doc-id))))
-
-(define
-  content/ops
-  (fn
-    (b doc-id)
-    (map (fn (ev) (persist/event-data ev)) (content/log b doc-id))))
-
-;; logical version count (highest seq assigned, survives compaction)
-(define
-  content/version-count
-  (fn (b doc-id) (persist/last-seq b (content/-stream doc-id))))
-
-;; ── replay ──
-;; head — materialise the latest document by folding all ops.
-(define
-  content/head
-  (fn (b doc-id) (doc-apply-all (doc-empty doc-id) (content/ops b doc-id))))
-
-;; at — materialise the document as of sequence `seq` (a version).
-(define
-  content/at
-  (fn
-    (b doc-id seq)
-    (let
-      ((evs (filter (fn (ev) (<= (persist/event-seq ev) seq)) (content/log b doc-id))))
-      (doc-apply-all
-        (doc-empty doc-id)
-        (map (fn (ev) (persist/event-data ev)) evs)))))
-
-;; ── history: per-version metadata, oldest-first ──
-(define
-  content/history
-  (fn (b doc-id) (map (fn (ev) {:type (persist/event-type ev) :at (persist/event-at ev) :seq (persist/event-seq ev)}) (content/log b doc-id))))
-
-;; ── diff between two materialised document versions ──
-;; Returns {:added (ids) :removed (ids) :changed (ids)} where changed = ids
-;; present in both whose block content differs.
-(define
-  content/-missing?
-  (fn (doc id) (= (ct-index-of (doc-blocks doc) id) -1)))
-
-(define
-  content/-changed
-  (fn
-    (old new)
-    (filter
-      (fn
-        (id)
-        (let
-          ((bo (doc-find old id)) (bn (doc-find new id)))
-          (cond
-            ((= bo nil) false)
-            ((= bn nil) false)
-            ((= bo bn) false)
-            (else true))))
-      (doc-ids old))))
-
-(define content/diff (fn (old new) {:changed (content/-changed old new) :removed (filter (fn (id) (content/-missing? new id)) (doc-ids old)) :added (filter (fn (id) (content/-missing? old id)) (doc-ids new))}))
-
-;; convenience: diff two persisted versions by seq.
-(define
-  content/diff-versions
-  (fn
-    (b doc-id seq-a seq-b)
-    (content/diff (content/at b doc-id seq-a) (content/at b doc-id seq-b))))

lib/content/summary.sx

@@ -1,26 +0,0 @@
-;; content-on-sx — list-card summary projection.
-;;
-;; content/summary returns a one-call projection for index/listing cards:
-;;   {:id :title :excerpt :words :reading-minutes :cover}
-;; composing the metadata, text, stats and query layers. `cover` is the first
-;; image's src (or nil).
-;;
-;; Requires (loaded by harness): doc.sx, meta.sx (doc-title), text.sx
-;; (content/excerpt), stats.sx (word-count/reading), query.sx (select-type).
-
-(define
-  content/summary-title
-  (fn (doc) (let ((t (doc-title doc))) (if (= t nil) (doc-id doc) t))))
-
-(define
-  content/cover
-  (fn
-    (doc)
-    (let
-      ((imgs (content/select-type doc "image")))
-      (if
-        (= (len imgs) 0)
-        nil
-        (str (blk-get (first imgs) "src"))))))
-
-(define content/summary (fn (doc) {:id (doc-id doc) :reading-minutes (content/reading-minutes doc) :words (content/word-count doc) :title (content/summary-title doc) :excerpt (content/excerpt doc 160) :cover (content/cover doc)}))

lib/content/sync.sx

@@ -1,74 +0,0 @@
-;; content-on-sx — external CMS sync via an injected adapter.
-;;
-;; Sync is a peripheral, not a feature. The core defines a SHAPE — an adapter is
-;; a dict {:import (fn external doc-id -> doc) :export (fn doc -> external)} — and
-;; delegates to it. The core knows nothing about Ghost's data model; all
-;; translation lives in the adapter. Swap the adapter and the core is unchanged;
-;; if Ghost goes away, nothing here does.
-;;
-;; Requires (loaded by harness): block.sx, doc.sx.
-
-;; ── generic boundary: pure delegation ──
-(define
-  content/import
-  (fn (adapter external doc-id) ((get adapter :import) external doc-id)))
-
-(define content/export (fn (adapter doc) ((get adapter :export) doc)))
-
-;; round-trip a document through an adapter (export then import).
-(define
-  content/round-trip
-  (fn
-    (adapter doc)
-    (content/import adapter (content/export adapter doc) (doc-id doc))))
-
-;; ── a Ghost-flavoured adapter (the peripheral). Ghost knowledge is confined
-;; here: a post is {:title :sections (list section)}; a section is a tagged dict
-;; {:kind ...} that this adapter maps to/from content blocks. ──
-(define
-  ghost-section->block
-  (fn
-    (sec)
-    (let
-      ((kind (get sec :kind)) (id (get sec :id)))
-      (cond
-        ((= kind "heading")
-          (mk-heading id (get sec :level) (get sec :text)))
-        ((= kind "paragraph") (mk-text id (get sec :text)))
-        ((= kind "image") (mk-image id (get sec :src) (get sec :alt)))
-        ((= kind "code") (mk-code id (get sec :language) (get sec :text)))
-        ((= kind "quote") (mk-quote id (get sec :cite) (get sec :text)))
-        ((= kind "hr") (mk-divider id))
-        ((= kind "list") (mk-list id (get sec :ordered) (get sec :items)))
-        ((= kind "embed") (mk-embed id (get sec :url) (get sec :provider)))
-        (else (mk-text id (get sec :text)))))))
-
-(define
-  block->ghost-section
-  (fn
-    (b)
-    (let
-      ((t (blk-type b)) (id (blk-id b)))
-      (cond
-        ((= t "heading") {:id id :text (str (blk-send b "text")) :kind "heading" :level (blk-send b "level")})
-        ((= t "text") {:id id :text (str (blk-send b "text")) :kind "paragraph"})
-        ((= t "image") {:id id :src (str (blk-send b "src")) :alt (str (blk-send b "alt")) :kind "image"})
-        ((= t "code") {:id id :text (str (blk-send b "text")) :kind "code" :language (str (blk-send b "language"))})
-        ((= t "quote") {:cite (str (blk-send b "cite")) :id id :text (str (blk-send b "text")) :kind "quote"})
-        ((= t "divider") {:id id :kind "hr"})
-        ((= t "list") {:items (blk-send b "items") :id id :kind "list" :ordered (blk-send b "ordered")})
-        ((= t "embed") {:id id :provider (str (blk-send b "provider")) :kind "embed" :url (str (blk-send b "url"))})
-        (else {:id id :text "" :kind "paragraph"})))))
-
-(define
-  ghost-import
-  (fn
-    (post doc-id)
-    (st-iv-set!
-      (doc-new doc-id (map ghost-section->block (get post :sections)))
-      "title"
-      (get post :title))))
-
-(define ghost-export (fn (doc) {:sections (map block->ghost-section (doc-blocks doc)) :title (st-send doc "title" (list))}))
-
-(define ghost-adapter {:export ghost-export :import ghost-import})

lib/content/table.sx

@@ -1,54 +0,0 @@
-;; content-on-sx — table block.
-;;
-;; CtTable holds `headers` (list of strings) and `rows` (list of string lists).
-;; Self-contained: it answers asHTML/asSx/asText/asMarkdown: by folding rows and
-;; cells, so it composes with the render boundary with no changes elsewhere. HTML
-;; cells are htmlEscaped, SX cells sxEscaped (render.sx must be loaded).
-;;
-;; Requires (loaded by harness): block.sx, doc.sx, render.sx (escapers);
-;; markdown.sx / text.sx for those formats.
-
-(define
-  content-bootstrap-table!
-  (fn
-    ()
-    (begin
-      (st-class-define! "CtTable" "CtBlock" (list "headers" "rows"))
-      (ct-def-method! "CtTable" "headers" "headers ^ headers")
-      (ct-def-method! "CtTable" "rows" "rows ^ rows")
-      (ct-def-method! "CtTable" "type" "type ^ #table")
-      (ct-def-method!
-        "CtTable"
-        "asHTML"
-        "asHTML | thead tbody | thead := '<thead><tr>' , (headers inject: '' into: [:a :h | a , '<th>' , h htmlEscaped , '</th>']) , '</tr></thead>'. tbody := '<tbody>' , (rows inject: '' into: [:a :r | a , '<tr>' , (r inject: '' into: [:b :c | b , '<td>' , c htmlEscaped , '</td>']) , '</tr>']) , '</tbody>'. ^ '<table>' , thead , tbody , '</table>'")
-      (ct-def-method!
-        "CtTable"
-        "asSx"
-        "asSx ^ '(table (thead (tr ' , (headers inject: '' into: [:a :h | a , '(th \"' , h sxEscaped , '\")']) , ')) (tbody ' , (rows inject: '' into: [:a :r | a , '(tr ' , (r inject: '' into: [:b :c | b , '(td \"' , c sxEscaped , '\")']) , ')']) , '))'")
-      (ct-def-method!
-        "CtTable"
-        "asText"
-        "asText ^ (rows inject: (headers inject: '' into: [:a :h | (a = '' ifTrue: [h] ifFalse: [a , ' ' , h])]) into: [:acc :r | acc , ' ' , (r inject: '' into: [:b :c | (b = '' ifTrue: [c] ifFalse: [b , ' ' , c])])])")
-      (ct-def-method!
-        "CtTable"
-        "asMarkdown:"
-        "asMarkdown: nl | head sep body | head := '|' , (headers inject: '' into: [:a :h | a , ' ' , h , ' |']). sep := '|' , (headers inject: '' into: [:a :h | a , ' --- |']). body := (rows inject: '' into: [:acc :r | acc , nl , '|' , (r inject: '' into: [:a :c | a , ' ' , c , ' |'])]). ^ head , nl , sep , body")
-      true)))
-
-(define
-  mk-table
-  (fn
-    (id headers rows)
-    (st-iv-set!
-      (st-iv-set!
-        (st-iv-set! (st-make-instance "CtTable") "id" id)
-        "headers"
-        headers)
-      "rows"
-      rows)))
-
-(define
-  table?
-  (fn (b) (and (st-instance? b) (= (get b :class) "CtTable"))))
-(define table-headers (fn (tb) (st-send tb "headers" (list))))
-(define table-rows (fn (tb) (st-send tb "rows" (list))))

lib/content/tests/anchor.sx

@@ -1,58 +0,0 @@
-;; Extension — anchored-heading HTML render (functional TOC links).
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-(content-bootstrap-section!)
-
-(define
-  d
-  (doc-append
-    (doc-append
-      (doc-append (doc-empty "d") (mk-heading "intro" 1 "Intro"))
-      (mk-text "p" "Body"))
-    (mk-section
-      "s"
-      (list (mk-heading "sub" 2 "Sub") (mk-text "n" "nested")))))
-
-;; ── headings get id anchors; other blocks unchanged ──
-(content-test
-  "anchored html"
-  (content/html-anchored d)
-  "<h1 id=\"intro\">Intro</h1><p>Body</p><section><h2 id=\"sub\">Sub</h2><p>nested</p></section>")
-
-;; ── heading text escaped ──
-(content-test
-  "anchored escapes text"
-  (content/html-anchored
-    (doc-append (doc-empty "d") (mk-heading "h" 2 "A < B")))
-  "<h2 id=\"h\">A &lt; B</h2>")
-
-;; ── non-heading-only doc identical to asHTML ──
-(define
-  np
-  (doc-append
-    (doc-append (doc-empty "d") (mk-text "p" "x"))
-    (mk-image "i" "/a.png" "alt")))
-(content-test "no headings == asHTML" (content/html-anchored np) (asHTML np))
-
-;; ── empty doc ──
-(content-test "anchored empty" (content/html-anchored (doc-empty "e")) "")
-
-;; ── anchors match TOC ids (end-to-end) ──
-(content-test
-  "anchor ids match toc"
-  (map (fn (h) (get h :id)) (content/headings d))
-  (list "intro" "sub"))
-
-;; ── deep nesting ──
-(define
-  deep
-  (doc-append
-    (doc-empty "d")
-    (mk-section
-      "o"
-      (list (mk-section "i" (list (mk-heading "deep" 3 "Deep")))))))
-(content-test
-  "deep anchored"
-  (content/html-anchored deep)
-  "<section><section><h3 id=\"deep\">Deep</h3></section></section>")

lib/content/tests/api.sx

@@ -1,99 +0,0 @@
-;; Phase 1 — public API facade. End-to-end through content/*.
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-
-;; ── build a document via the facade ──
-(define d0 (content/empty "post"))
-(define
-  h
-  (content/block
-    "heading"
-    "h"
-    (list (list "level" 1) (list "text" "Hi"))))
-(define p (content/block "text" "p" (list (list "text" "World"))))
-(define d1 (content/append (content/append d0 h) p))
-
-(content/op? (content/insert h nil))
-(content-test "count" (content/count d1) 2)
-(content-test "ids" (content/ids d1) (list "h" "p"))
-(content-test "types" (content/types d1) (list "heading" "text"))
-(content-test "find" (blk-id (content/find d1 "p")) "p")
-(content-test "has? yes" (content/has? d1 "h") true)
-(content-test "has? no" (content/has? d1 "x") false)
-
-;; ── content/op? distinguishes a single op from a list / a block ──
-(content-test "op? on insert" (content/op? (content/insert h nil)) true)
-(content-test
-  "op? on update"
-  (content/op? (content/update "p" "text" "z"))
-  true)
-(content-test "op? on list" (content/op? (list (content/delete "h"))) false)
-(content-test "op? on block" (content/op? h) false)
-(content-test "op? on doc" (content/op? d1) false)
-
-;; ── edit with a single op ──
-(define
-  img
-  (content/block
-    "image"
-    "img"
-    (list (list "src" "/c.png") (list "alt" "cat"))))
-(define d2 (content/edit d1 (content/insert img "h")))
-(content-test "edit single op order" (content/ids d2) (list "h" "img" "p"))
-(content-test "edit single immutable" (content/ids d1) (list "h" "p"))
-(content-test
-  "edit update"
-  (str
-    (blk-send
-      (content/find
-        (content/edit d1 (content/update "p" "text" "Edited"))
-        "p")
-      "text"))
-  "Edited")
-(content-test
-  "edit delete"
-  (content/ids (content/edit d1 (content/delete "h")))
-  (list "p"))
-(content-test
-  "edit move"
-  (content/ids (content/edit d1 (content/move "p" 0)))
-  (list "p" "h"))
-
-;; ── edit with a stream of ops ──
-(define ops (list (content/insert img "h") (content/delete "p")))
-(content-test
-  "edit op stream"
-  (content/ids (content/edit d1 ops))
-  (list "h" "img"))
-(content-test "edit op stream immutable" (content/ids d1) (list "h" "p"))
-
-;; ── render via facade ──
-(content-test
-  "render html"
-  (content/render d1 "html")
-  "<h1>Hi</h1><p>World</p>")
-(content-test
-  "render sx"
-  (content/render d1 "sx")
-  "(article (h1 \"Hi\")(p \"World\"))")
-(content-test
-  "render html keyword"
-  (content/render d1 :html)
-  "<h1>Hi</h1><p>World</p>")
-(content-test
-  "render sx keyword"
-  (content/render d1 :sx)
-  "(article (h1 \"Hi\")(p \"World\"))")
-(content-test "content/html" (content/html d1) "<h1>Hi</h1><p>World</p>")
-(content-test "content/sx" (content/sx d1) "(article (h1 \"Hi\")(p \"World\"))")
-
-;; ── render reflects each version ──
-(content-test
-  "render edited version"
-  (content/render (content/edit d1 (content/update "h" "text" "Hey")) "html")
-  "<h1>Hey</h1><p>World</p>")
-(content-test
-  "render original unchanged"
-  (content/render d1 "html")
-  "<h1>Hi</h1><p>World</p>")

lib/content/tests/block.sx

@@ -1,75 +0,0 @@
-;; Phase 1 — typed block objects. Behaviour via message dispatch; fields
-;; immutable (copy-on-write).
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-
-;; ── construction + polymorphic type dispatch ──
-(define h (mk-heading "b1" 2 "Title"))
-(define t (mk-text "b2" "Body text"))
-(define img (mk-image "b3" "/cat.png" "a cat"))
-(define code (mk-code "b4" "sx" "(+ 1 2)"))
-(define q (mk-quote "b5" "Ada" "to err"))
-(define em (mk-embed "b6" "https://v/1" "vimeo"))
-(define dv (mk-divider "b7"))
-(define ls (mk-list "b8" true (list "one" "two")))
-
-(content-test "heading type" (blk-type h) "heading")
-(content-test "text type" (blk-type t) "text")
-(content-test "image type" (blk-type img) "image")
-(content-test "code type" (blk-type code) "code")
-(content-test "quote type" (blk-type q) "quote")
-(content-test "embed type" (blk-type em) "embed")
-(content-test "divider type" (blk-type dv) "divider")
-(content-test "list type" (blk-type ls) "list")
-
-;; ── id via message dispatch ──
-(content-test "heading id" (blk-id h) "b1")
-(content-test "image id" (blk-id img) "b3")
-(content-test "divider id" (blk-id dv) "b7")
-
-;; ── field reads via messages (incl. inherited text) ──
-(content-test "heading text inherited" (str (blk-send h "text")) "Title")
-(content-test "heading level" (blk-send h "level") 2)
-(content-test "text body" (str (blk-send t "text")) "Body text")
-(content-test "image src" (str (blk-send img "src")) "/cat.png")
-(content-test "image alt" (str (blk-send img "alt")) "a cat")
-(content-test "code language" (str (blk-send code "language")) "sx")
-(content-test "code text inherited" (str (blk-send code "text")) "(+ 1 2)")
-(content-test "quote cite" (str (blk-send q "cite")) "Ada")
-(content-test "embed url" (str (blk-send em "url")) "https://v/1")
-(content-test "embed provider" (str (blk-send em "provider")) "vimeo")
-(content-test "list ordered" (blk-send ls "ordered") true)
-(content-test "list items" (blk-send ls "items") (list "one" "two"))
-
-;; ── blk-get reads ivars directly ──
-(content-test "blk-get level" (blk-get h "level") 2)
-(content-test "blk-get missing nil" (blk-get h "nope") nil)
-
-;; ── copy-on-write: blk-set returns a new block, original untouched ──
-(define h2 (blk-set h "level" 1))
-(content-test "blk-set new value" (blk-send h2 "level") 1)
-(content-test "blk-set original unchanged" (blk-send h "level") 2)
-(content-test "blk-set keeps id" (blk-id h2) "b1")
-(content-test "blk-set keeps text" (str (blk-send h2 "text")) "Title")
-
-;; ── predicate ──
-(content-test "block? on heading" (block? h) true)
-(content-test "block? on divider" (block? dv) true)
-(content-test "block? on number" (block? 5) false)
-(content-test "block? on string" (block? "x") false)
-
-;; ── isBlock message inherited by all ──
-(content-test "isBlock heading" (blk-send h "isBlock") true)
-(content-test "isBlock list" (blk-send ls "isBlock") true)
-
-;; ── generic mk-block via wire tag ──
-(define
-  g
-  (mk-block
-    "heading"
-    "g1"
-    (list (list "level" 3) (list "text" "Gen"))))
-(content-test "mk-block type" (blk-type g) "heading")
-(content-test "mk-block level" (blk-send g "level") 3)
-(content-test "mk-block text" (str (blk-send g "text")) "Gen")

lib/content/tests/callout.sx

@@ -1,55 +0,0 @@
-;; Extension — callout / admonition block.
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-(content-bootstrap-markdown!)
-(content-bootstrap-text!)
-(content-bootstrap-callout!)
-
-(define c (mk-callout "c" "warning" "Be careful"))
-
-;; ── identity ──
-(content-test "callout is block" (block? c) true)
-(content-test "callout? yes" (callout? c) true)
-(content-test "callout type" (blk-type c) "callout")
-(content-test "callout kind" (callout-kind c) "warning")
-
-;; ── render ──
-(content-test
-  "callout html"
-  (asHTML c)
-  "<aside class=\"callout callout-warning\">Be careful</aside>")
-(content-test
-  "callout sx"
-  (asSx c)
-  "(aside :class \"callout callout-warning\" \"Be careful\")")
-(content-test "callout text" (asText c) "Be careful")
-(content-test "callout markdown" (asMarkdown c) "> **warning:** Be careful")
-
-;; ── html escapes text ──
-(content-test
-  "callout html escapes"
-  (asHTML (mk-callout "c" "note" "a < b"))
-  "<aside class=\"callout callout-note\">a &lt; b</aside>")
-
-;; ── in a document ──
-(define
-  d
-  (doc-append
-    (doc-append (doc-empty "d") (mk-heading "h" 1 "T"))
-    c))
-(content-test
-  "doc with callout html"
-  (asHTML d)
-  "<h1>T</h1><aside class=\"callout callout-warning\">Be careful</aside>")
-
-;; ── validation ──
-(content-test
-  "valid callout"
-  (content/valid? (doc-append (doc-empty "d") c))
-  true)
-(content-test
-  "bad callout kind flagged"
-  (content/issue-kinds
-    (doc-append (doc-empty "d") (mk-callout "c" 5 "x")))
-  (list "field"))

lib/content/tests/clone.sx

@@ -1,55 +0,0 @@
-;; Extension — block id remapping / clone.
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-(content-bootstrap-section!)
-
-(define
-  d
-  (doc-append
-    (doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
-    (mk-section "s" (list (mk-text "a" "A") (mk-text "b" "B")))))
-
-;; ── prefix-ids rewrites every id in the tree ──
-(define p (content/prefix-ids d "x-"))
-(content-test "prefix top-level ids" (doc-ids p) (list "x-h" "x-s"))
-(content-test
-  "prefix tree-ids"
-  (doc-tree-ids p)
-  (list "x-h" "x-s" "x-a" "x-b"))
-(content-test "prefix immutable" (doc-tree-ids d) (list "h" "s" "a" "b"))
-(content-test "prefix preserves content" (asHTML p) (asHTML d))
-(content-test
-  "prefix preserves nested content"
-  (str (blk-send (doc-deep-find p "x-a") "text"))
-  "A")
-
-;; ── custom remap fn ──
-(define u (content/remap-ids d (fn (id) (str id "!"))))
-(content-test "remap suffix" (doc-tree-ids u) (list "h!" "s!" "a!" "b!"))
-
-;; ── collision-free composition ──
-(define
-  d2
-  (doc-append (doc-empty "d2") (mk-heading "h" 2 "Other")))
-(define
-  combined
-  (content/concat
-    (content/prefix-ids d "left-")
-    (content/prefix-ids d2 "right-")))
-(content-test
-  "combined ids unique"
-  (doc-tree-ids combined)
-  (list "left-h" "left-s" "left-a" "left-b" "right-h"))
-(content-test "combined validates" (content/valid? combined) true)
-;; without prefixing, the shared id "h" collides
-(content-test
-  "unprefixed collides"
-  (content/valid? (content/concat d d2))
-  false)
-
-;; ── render of combined ──
-(content-test
-  "combined render"
-  (asHTML combined)
-  "<h1>Title</h1><section><p>A</p><p>B</p></section><h2>Other</h2>")

lib/content/tests/compose.sx

@@ -1,76 +0,0 @@
-;; Extension — document composition.
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-(content-bootstrap-section!)
-
-(define
-  a
-  (doc-with-title
-    (doc-append (doc-empty "a") (mk-heading "h" 1 "A"))
-    "Doc A"))
-(define
-  b
-  (doc-append
-    (doc-append (doc-empty "b") (mk-text "p" "B1"))
-    (mk-text "q" "B2")))
-
-;; ── concat ──
-(define ab (content/concat a b))
-(content-test "concat ids" (doc-ids ab) (list "h" "p" "q"))
-(content-test "concat keeps first id" (doc-id ab) "a")
-(content-test "concat keeps first title" (doc-title ab) "Doc A")
-(content-test "concat immutable a" (doc-ids a) (list "h"))
-(content-test "concat immutable b" (doc-ids b) (list "p" "q"))
-
-;; ── prepend ──
-(define ba (content/prepend a b))
-(content-test "prepend ids" (doc-ids ba) (list "p" "q" "h"))
-(content-test "prepend keeps a id" (doc-id ba) "a")
-
-;; ── concat with empty ──
-(content-test
-  "concat empty right"
-  (doc-ids (content/concat a (doc-empty "e")))
-  (list "h"))
-(content-test
-  "concat empty left"
-  (doc-ids (content/concat (doc-empty "e") b))
-  (list "p" "q"))
-
-;; ── concat-all ──
-(define c (doc-append (doc-empty "c") (mk-divider "d")))
-(content-test
-  "concat-all order"
-  (doc-ids (content/concat-all (list a b c)))
-  (list "h" "p" "q" "d"))
-(content-test
-  "concat-all keeps first id"
-  (doc-id (content/concat-all (list a b c)))
-  "a")
-(content-test
-  "concat-all single"
-  (doc-ids (content/concat-all (list a)))
-  (list "h"))
-(content-test
-  "concat-all empty"
-  (doc-ids (content/concat-all (list)))
-  (list))
-
-;; ── render of composed doc ──
-(content-test
-  "composed renders"
-  (asHTML (content/concat a b))
-  "<h1>A</h1><p>B1</p><p>B2</p>")
-
-;; ── wrap-section collapses blocks into a subtree ──
-(define w (content/wrap-section ab "sec"))
-(content-test "wrap top-level is one section" (doc-ids w) (list "sec"))
-(content-test
-  "wrap children preserved"
-  (doc-tree-ids w)
-  (list "sec" "h" "p" "q"))
-(content-test
-  "wrap renders nested"
-  (asHTML w)
-  "<section><h1>A</h1><p>B1</p><p>B2</p></section>")

lib/content/tests/crdt-blocks.sx

@@ -1,136 +0,0 @@
-;; Hardening — non-core block types (callout/table/media/section) survive the
-;; flat and tree CvRDT materialise paths (regression for the ct-class-for-type
-;; fix: these route through crdt-element->block -> mk-block).
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-(content-bootstrap-doc!)
-(content-bootstrap-render!)
-(content-bootstrap-section!)
-(content-bootstrap-callout!)
-(content-bootstrap-table!)
-(content-bootstrap-media!)
-
-;; ── flat CRDT: callout / table / media leaves ──
-(define
-  s
-  (crdt-apply-all
-    (crdt-empty)
-    (list
-      (crdt-op-insert
-        "co"
-        "callout"
-        (crdt-pos 1 0)
-        (list (list "kind" "note") (list "text" "hi"))
-        1
-        0)
-      (crdt-op-insert
-        "tb"
-        "table"
-        (crdt-pos 2 0)
-        (list (list "headers" (list "A")) (list "rows" (list (list "1"))))
-        1
-        0)
-      (crdt-op-insert
-        "vid"
-        "media"
-        (crdt-pos 3 0)
-        (list (list "kind" "video") (list "src" "/v.mp4"))
-        1
-        0))))
-(content-test
-  "flat crdt callout render"
-  (asHTML (crdt-materialize "d" s))
-  "<aside class=\"callout callout-note\">hi</aside><table><thead><tr><th>A</th></tr></thead><tbody><tr><td>1</td></tr></tbody></table><video src=\"/v.mp4\" controls></video>")
-(content-test "flat crdt order" (crdt-order s) (list "co" "tb" "vid"))
-
-;; ── flat CRDT: callout field via LWW update ──
-(define s2 (crdt-update s "co" "text" "edited" 5 1))
-(content-test
-  "flat crdt callout update"
-  (str (blk-send (doc-find (crdt-materialize "d" s2) "co") "text"))
-  "edited")
-
-;; ── tree CRDT: callout/table inside a section ──
-(define
-  t
-  (crdt-tree-apply-all
-    (crdt-empty)
-    (list
-      (crdt-tree-op-insert
-        "sec"
-        "section"
-        (crdt-pos 1 0)
-        ""
-        (list)
-        1
-        0)
-      (crdt-tree-op-insert
-        "co"
-        "callout"
-        (crdt-pos 1 0)
-        "sec"
-        (list (list "kind" "tip") (list "text" "T"))
-        1
-        0)
-      (crdt-tree-op-insert
-        "tb"
-        "table"
-        (crdt-pos 2 0)
-        "sec"
-        (list (list "headers" (list "H")) (list "rows" (list)))
-        1
-        0))))
-(content-test
-  "tree crdt nested blocks"
-  (doc-tree-ids (crdt-tree-materialize "d" t))
-  (list "sec" "co" "tb"))
-(content-test
-  "tree crdt nested render"
-  (asHTML (crdt-tree-materialize "d" t))
-  "<section><aside class=\"callout callout-tip\">T</aside><table><thead><tr><th>H</th></tr></thead><tbody></tbody></table></section>")
-
-;; ── tree CRDT: concurrent callout inserts into a section converge ──
-(define
-  base
-  (crdt-tree-insert
-    (crdt-empty)
-    "sec"
-    "section"
-    (crdt-pos 1 0)
-    ""
-    (list)
-    1
-    0))
-(define
-  rA
-  (crdt-tree-insert
-    base
-    "x"
-    "callout"
-    (crdt-pos 5 1)
-    "sec"
-    (list (list "kind" "note") (list "text" "A"))
-    2
-    1))
-(define
-  rB
-  (crdt-tree-insert
-    base
-    "y"
-    "media"
-    (crdt-pos 5 2)
-    "sec"
-    (list (list "kind" "audio") (list "src" "/a.mp3"))
-    2
-    2))
-(content-test
-  "tree crdt mixed converge"
-  (=
-    (get (crdt-tree-merge rA rB) :elements)
-    (get (crdt-tree-merge rB rA) :elements))
-  true)
-(content-test
-  "tree crdt mixed ids"
-  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
-  (list "sec" "x" "y"))

lib/content/tests/crdt-store.sx

@@ -1,139 +0,0 @@
-;; Extension — durable collaborative replication (CRDT ops on persist).
-;; Replicas log independently; converge merges the logs deterministically.
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-(content-bootstrap-doc!)
-(content-bootstrap-render!)
-
-(define same? (fn (a b) (= (get a :elements) (get b :elements))))
-(define B (persist/open))
-
-;; replica "a" (origin): inserts h, p
-(crdt/commit!
-  B
-  "doc"
-  "a"
-  (crdt-op-insert
-    "h"
-    "heading"
-    (crdt-pos 1 0)
-    (list (list "level" 1) (list "text" "T"))
-    1
-    1)
-  1)
-(crdt/commit!
-  B
-  "doc"
-  "a"
-  (crdt-op-insert
-    "p"
-    "text"
-    (crdt-pos 2 0)
-    (list (list "text" "Body"))
-    1
-    1)
-  1)
-
-;; replica "b" (concurrent): edits p, inserts x
-(crdt/commit-all!
-  B
-  "doc"
-  "b"
-  (list
-    (crdt-op-update "p" "text" "Edited" 5 2)
-    (crdt-op-insert
-      "x"
-      "text"
-      (crdt-pos 3 0)
-      (list (list "text" "X"))
-      6
-      2))
-  5)
-
-;; ── durability ──
-(content-test
-  "replica a version"
-  (crdt/replica-version B "doc" "a")
-  2)
-(content-test
-  "replica b version"
-  (crdt/replica-version B "doc" "b")
-  2)
-(content-test
-  "replica a ops len"
-  (len (crdt/replica-ops B "doc" "a"))
-  2)
-
-;; ── single-replica replay ──
-(content-test
-  "replay a order"
-  (crdt-order (crdt/replay B "doc" "a"))
-  (list "h" "p"))
-(content-test
-  "replay a == apply-all"
-  (same?
-    (crdt/replay B "doc" "a")
-    (crdt-apply-all (crdt-empty) (crdt/replica-ops B "doc" "a")))
-  true)
-
-;; ── converge ──
-(content-test
-  "converge order"
-  (crdt/order B "doc" (list "a" "b"))
-  (list "h" "p" "x"))
-(content-test
-  "converge replica-order-independent"
-  (same?
-    (crdt/converge B "doc" (list "a" "b"))
-    (crdt/converge B "doc" (list "b" "a")))
-  true)
-(content-test
-  "converge LWW p edited"
-  (str
-    (blk-send (doc-find (crdt/document B "doc" (list "a" "b")) "p") "text"))
-  "Edited")
-(content-test
-  "converged document render"
-  (asHTML (crdt/document B "doc" (list "a" "b")))
-  "<h1>T</h1><p>Edited</p><p>X</p>")
-
-;; ── duplicate delivery is idempotent ──
-(crdt/commit!
-  B
-  "doc"
-  "a"
-  (crdt-op-insert
-    "p"
-    "text"
-    (crdt-pos 2 0)
-    (list (list "text" "Body"))
-    1
-    1)
-  1)
-(content-test
-  "duplicate op no effect on converge"
-  (crdt/order B "doc" (list "a" "b"))
-  (list "h" "p" "x"))
-(content-test
-  "duplicate keeps LWW value"
-  (str
-    (blk-send (doc-find (crdt/document B "doc" (list "a" "b")) "p") "text"))
-  "Edited")
-
-;; ── new op on a replica is reflected after re-converge ──
-(crdt/commit! B "doc" "b" (crdt-op-delete "h") 9)
-(content-test
-  "delete reflected after reconverge"
-  (crdt/order B "doc" (list "a" "b"))
-  (list "p" "x"))
-
-;; ── isolation: unknown doc converges to empty ──
-(content-test
-  "unknown doc empty"
-  (crdt/order B "other" (list "a" "b"))
-  (list))
-(content-test
-  "unknown replica empty ops"
-  (len (crdt/replica-ops B "doc" "zzz"))
-  0)

lib/content/tests/crdt-tree.sx

@@ -1,289 +0,0 @@
-;; Extension — nested-tree CvRDT. Sections nest and merge collaboratively;
-;; convergence is order/replica/duplicate-insensitive like the flat layer.
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-(content-bootstrap-doc!)
-(content-bootstrap-render!)
-(content-bootstrap-section!)
-
-(define same? (fn (a b) (= (get a :elements) (get b :elements))))
-
-;; base: a section "s" at root, with one child heading.
-(define
-  base
-  (crdt-tree-insert
-    (crdt-tree-insert
-      (crdt-empty)
-      "s"
-      "section"
-      (crdt-pos 1 0)
-      ""
-      (list)
-      1
-      0)
-    "h"
-    "heading"
-    (crdt-pos 1 0)
-    "s"
-    (list (list "level" 2) (list "text" "Sub"))
-    1
-    0))
-
-;; ── materialise rebuilds the tree ──
-(content-test "tree order root" (crdt-tree-order base) (list "s"))
-(content-test
-  "tree materialize ids"
-  (doc-tree-ids (crdt-tree-materialize "d" base))
-  (list "s" "h"))
-(content-test
-  "tree render"
-  (asHTML (crdt-tree-materialize "d" base))
-  "<section><h2>Sub</h2></section>")
-
-;; ── concurrent inserts into the SAME section converge + order by pos ──
-(define
-  rA
-  (crdt-tree-insert
-    base
-    "a"
-    "text"
-    (crdt-pos 5 1)
-    "s"
-    (list (list "text" "A"))
-    2
-    1))
-(define
-  rB
-  (crdt-tree-insert
-    base
-    "b"
-    "text"
-    (crdt-pos 5 2)
-    "s"
-    (list (list "text" "B"))
-    2
-    2))
-(content-test
-  "same-parent merge commutes"
-  (same? (crdt-tree-merge rA rB) (crdt-tree-merge rB rA))
-  true)
-(content-test
-  "same-parent order deterministic"
-  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
-  (list "s" "h" "a" "b"))
-
-;; ── concurrent inserts into DIFFERENT parents converge ──
-(define
-  base2
-  (crdt-tree-insert
-    (crdt-tree-insert
-      (crdt-empty)
-      "s1"
-      "section"
-      (crdt-pos 1 0)
-      ""
-      (list)
-      1
-      0)
-    "s2"
-    "section"
-    (crdt-pos 2 0)
-    ""
-    (list)
-    1
-    0))
-(define
-  x
-  (crdt-tree-insert
-    base2
-    "x"
-    "text"
-    (crdt-pos 1 0)
-    "s1"
-    (list (list "text" "X"))
-    2
-    1))
-(define
-  y
-  (crdt-tree-insert
-    base2
-    "y"
-    "text"
-    (crdt-pos 1 0)
-    "s2"
-    (list (list "text" "Y"))
-    2
-    2))
-(define m (crdt-tree-merge x y))
-(content-test
-  "different-parent commutes"
-  (same? m (crdt-tree-merge y x))
-  true)
-(content-test
-  "different-parent tree"
-  (doc-tree-ids (crdt-tree-materialize "d" m))
-  (list "s1" "x" "s2" "y"))
-(content-test
-  "different-parent render"
-  (asHTML (crdt-tree-materialize "d" m))
-  "<section><p>X</p></section><section><p>Y</p></section>")
-
-;; ── nested sections (section inside section) ──
-(define
-  nested
-  (crdt-tree-apply-all
-    (crdt-empty)
-    (list
-      (crdt-tree-op-insert
-        "outer"
-        "section"
-        (crdt-pos 1 0)
-        ""
-        (list)
-        1
-        0)
-      (crdt-tree-op-insert
-        "inner"
-        "section"
-        (crdt-pos 1 0)
-        "outer"
-        (list)
-        1
-        0)
-      (crdt-tree-op-insert
-        "leaf"
-        "text"
-        (crdt-pos 1 0)
-        "inner"
-        (list (list "text" "deep"))
-        1
-        0))))
-(content-test
-  "nested tree ids"
-  (doc-tree-ids (crdt-tree-materialize "d" nested))
-  (list "outer" "inner" "leaf"))
-(content-test
-  "nested render"
-  (asHTML (crdt-tree-materialize "d" nested))
-  "<section><section><p>deep</p></section></section>")
-
-;; ── ops in any order converge (commutative) ──
-(define
-  opA
-  (crdt-tree-op-insert
-    "p"
-    "text"
-    (crdt-pos 6 0)
-    "s"
-    (list (list "text" "P"))
-    3
-    1))
-(define opB (crdt-tree-op-update "h" "text" "Edited" 5 1))
-(define opC (crdt-tree-op-delete "h"))
-(content-test
-  "ops commute"
-  (same?
-    (crdt-tree-apply-all base (list opA opB opC))
-    (crdt-tree-apply-all base (list opC opB opA)))
-  true)
-(content-test
-  "ops idempotent"
-  (same?
-    (crdt-tree-apply-all base (list opA opB))
-    (crdt-tree-apply-all
-      (crdt-tree-apply-all base (list opA opB))
-      (list opA opB)))
-  true)
-
-;; ── update into a section + LWW ──
-(define u1 (crdt-tree-update base "h" "text" "v5" 5 1))
-(define u2 (crdt-tree-update base "h" "text" "v7" 7 2))
-(content-test
-  "tree LWW higher ts"
-  (str
-    (blk-send
-      (doc-deep-find (crdt-tree-materialize "d" (crdt-tree-merge u1 u2)) "h")
-      "text"))
-  "v7")
-
-;; ── delete inside a section ──
-(content-test
-  "delete in section"
-  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-delete base "h")))
-  (list "s"))
-
-;; ── merge idempotence ──
-(content-test "merge idempotent self" (same? (crdt-tree-merge m m) m) true)
-
-;; ── full convergence: two replicas, divergent edits in different sections ──
-(define
-  repl1
-  (crdt-tree-apply-all
-    base2
-    (list
-      (crdt-tree-op-insert
-        "p1"
-        "text"
-        (crdt-pos 1 0)
-        "s1"
-        (list (list "text" "from1"))
-        5
-        1))))
-(define
-  repl2
-  (crdt-tree-apply-all
-    base2
-    (list
-      (crdt-tree-op-insert
-        "p2"
-        "text"
-        (crdt-pos 1 0)
-        "s2"
-        (list (list "text" "from2"))
-        6
-        2))))
-(content-test
-  "two-replica tree converges"
-  (same? (crdt-tree-merge repl1 repl2) (crdt-tree-merge repl2 repl1))
-  true)
-(content-test
-  "two-replica tree ids"
-  (doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge repl1 repl2)))
-  (list "s1" "p1" "s2" "p2"))
-
-;; ── orphan reparenting: concurrent delete-section + insert-child ──
-;; A deletes section s; B inserts a child into s. After merge, s is gone but the
-;; child must survive (reparented to root), not silently vanish.
-(define delA (crdt-tree-delete base "s"))
-(define
-  insB
-  (crdt-tree-insert
-    base
-    "c"
-    "text"
-    (crdt-pos 9 0)
-    "s"
-    (list (list "text" "kept"))
-    5
-    2))
-(define orphan-merge (crdt-tree-merge delA insB))
-(content-test
-  "orphan survives delete-section"
-  (doc-tree-ids (crdt-tree-materialize "d" orphan-merge))
-  (list "h" "c"))
-(content-test
-  "orphan reparent commutes"
-  (same? orphan-merge (crdt-tree-merge insB delA))
-  true)
-(content-test
-  "orphan content preserved"
-  (str
-    (blk-send
-      (doc-deep-find (crdt-tree-materialize "d" orphan-merge) "c")
-      "text"))
-  "kept")
-(content-test
-  "orphan render at root"
-  (asHTML (crdt-tree-materialize "d" orphan-merge))
-  "<h2>Sub</h2><p>kept</p>")

lib/content/tests/crdt.sx

@@ -1,315 +0,0 @@
-;; Phase 3 — collaborative merge (CvRDT). The merge is a join: commutative,
-;; associative, idempotent. Tests apply ops in any order, twice, and merge
-;; replicas both ways — all must converge to identical state.
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-(content-bootstrap-doc!)
-(content-bootstrap-render!)
-
-(define same? (fn (a b) (= (get a :elements) (get b :elements))))
-
-;; ── position order (Logoot) ──
-(content-test
-  "pos lt"
-  (crdt-pos-compare
-    (crdt-pos 1 0)
-    (crdt-pos 2 0))
-  -1)
-(content-test
-  "pos gt"
-  (crdt-pos-compare
-    (crdt-pos 2 0)
-    (crdt-pos 1 0))
-  1)
-(content-test
-  "pos eq"
-  (crdt-pos-compare
-    (crdt-pos 1 0)
-    (crdt-pos 1 0))
-  0)
-(content-test
-  "pos actor tiebreak"
-  (crdt-pos-compare
-    (crdt-pos 1 1)
-    (crdt-pos 1 2))
-  -1)
-(content-test
-  "between > left"
-  (<
-    (crdt-pos-compare
-      (crdt-pos 1 0)
-      (crdt-pos-between
-        (crdt-pos 1 0)
-        (crdt-pos 2 0)
-        9))
-    0)
-  true)
-(content-test
-  "between < right"
-  (<
-    (crdt-pos-compare
-      (crdt-pos-between
-        (crdt-pos 1 0)
-        (crdt-pos 2 0)
-        9)
-      (crdt-pos 2 0))
-    0)
-  true)
-(content-test
-  "between start < right"
-  (<
-    (crdt-pos-compare
-      (crdt-pos-between nil (crdt-pos 5 0) 9)
-      (crdt-pos 5 0))
-    0)
-  true)
-(content-test
-  "between end > left"
-  (<
-    (crdt-pos-compare
-      (crdt-pos 5 0)
-      (crdt-pos-between (crdt-pos 5 0) nil 9))
-    0)
-  true)
-
-;; ── build + materialise ──
-(define
-  base
-  (crdt-insert
-    (crdt-insert
-      (crdt-empty)
-      "h"
-      "heading"
-      (crdt-pos 1 0)
-      (list (list "level" 1) (list "text" "Title"))
-      1
-      0)
-    "p"
-    "text"
-    (crdt-pos 2 0)
-    (list (list "text" "Body"))
-    1
-    0))
-
-(content-test "order" (crdt-order base) (list "h" "p"))
-(content-test
-  "materialize ids"
-  (doc-ids (crdt-materialize "d" base))
-  (list "h" "p"))
-(content-test
-  "materialize render"
-  (asHTML (crdt-materialize "d" base))
-  "<h1>Title</h1><p>Body</p>")
-
-;; ── commutativity: ops in any order converge ──
-(define
-  opA
-  (crdt-op-insert
-    "x"
-    "text"
-    (crdt-pos 3 0)
-    (list (list "text" "X"))
-    2
-    1))
-(define opB (crdt-op-update "p" "text" "Edited" 5 1))
-(define opC (crdt-op-delete "h"))
-(define s-abc (crdt-apply-all base (list opA opB opC)))
-(define s-cba (crdt-apply-all base (list opC opB opA)))
-(define s-bca (crdt-apply-all base (list opB opC opA)))
-(content-test "commutative abc=cba" (same? s-abc s-cba) true)
-(content-test "commutative abc=bca" (same? s-abc s-bca) true)
-(content-test "commutative result order" (crdt-order s-abc) (list "p" "x"))
-
-;; ── idempotence: applying ops twice changes nothing ──
-(content-test
-  "idempotent ops"
-  (same? s-abc (crdt-apply-all s-abc (list opA opB opC)))
-  true)
-
-;; ── update-before-insert is not lost ──
-(define
-  ub
-  (crdt-apply-all
-    (crdt-empty)
-    (list
-      (crdt-op-update "z" "text" "late" 3 1)
-      (crdt-op-insert
-        "z"
-        "text"
-        (crdt-pos 1 0)
-        (list (list "text" "orig"))
-        1
-        1))))
-(content-test
-  "update before insert kept"
-  (str (blk-send (doc-find (crdt-materialize "d" ub) "z") "text"))
-  "late")
-
-;; ── delete-before-insert: remove-wins ──
-(define
-  db
-  (crdt-apply-all
-    (crdt-empty)
-    (list
-      (crdt-op-delete "k")
-      (crdt-op-insert
-        "k"
-        "text"
-        (crdt-pos 1 0)
-        (list (list "text" "x"))
-        1
-        1))))
-(content-test "delete before insert removes" (crdt-order db) (list))
-
-;; ── concurrent inserts converge + deterministic order ──
-(define
-  rA
-  (crdt-insert
-    base
-    "a1"
-    "text"
-    (crdt-pos 5 1)
-    (list (list "text" "A"))
-    2
-    1))
-(define
-  rB
-  (crdt-insert
-    base
-    "b1"
-    "text"
-    (crdt-pos 5 2)
-    (list (list "text" "B"))
-    2
-    2))
-(content-test
-  "merge commutes"
-  (same? (crdt-merge rA rB) (crdt-merge rB rA))
-  true)
-(content-test
-  "merge order deterministic AB"
-  (crdt-order (crdt-merge rA rB))
-  (list "h" "p" "a1" "b1"))
-(content-test
-  "merge order deterministic BA"
-  (crdt-order (crdt-merge rB rA))
-  (list "h" "p" "a1" "b1"))
-
-;; ── merge idempotence ──
-(define mAB (crdt-merge rA rB))
-(content-test "merge idempotent self" (same? (crdt-merge mAB mAB) mAB) true)
-(content-test
-  "merge idempotent remerge"
-  (same? (crdt-merge mAB rA) mAB)
-  true)
-
-;; ── concurrent same-field update: LWW by (ts, actor) ──
-(define u1 (crdt-update base "p" "text" "v-ts5" 5 1))
-(define u2 (crdt-update base "p" "text" "v-ts7" 7 2))
-(content-test
-  "LWW higher ts wins"
-  (str
-    (blk-send
-      (doc-find (crdt-materialize "d" (crdt-merge u1 u2)) "p")
-      "text"))
-  "v-ts7")
-(content-test
-  "LWW commutes"
-  (same? (crdt-merge u1 u2) (crdt-merge u2 u1))
-  true)
-(define t1 (crdt-update base "p" "text" "actor1" 9 1))
-(define t2 (crdt-update base "p" "text" "actor2" 9 2))
-(content-test
-  "LWW tie -> actor wins"
-  (str
-    (blk-send
-      (doc-find (crdt-materialize "d" (crdt-merge t1 t2)) "p")
-      "text"))
-  "actor2")
-
-;; ── concurrent disjoint-field updates both survive ──
-(define f1 (crdt-update base "h" "text" "NewTitle" 5 1))
-(define f2 (crdt-update base "h" "level" 3 5 2))
-(define fm (crdt-merge f1 f2))
-(content-test
-  "disjoint field text"
-  (str (blk-send (doc-find (crdt-materialize "d" fm) "h") "text"))
-  "NewTitle")
-(content-test
-  "disjoint field level"
-  (blk-send (doc-find (crdt-materialize "d" fm) "h") "level")
-  3)
-(content-test "disjoint commutes" (same? fm (crdt-merge f2 f1)) true)
-
-;; ── associativity ──
-(define c1 (crdt-update base "p" "text" "c1" 4 1))
-(define
-  c2
-  (crdt-insert
-    base
-    "n2"
-    "text"
-    (crdt-pos 6 0)
-    (list (list "text" "N"))
-    2
-    2))
-(define c3 (crdt-delete base "h"))
-(content-test
-  "associative"
-  (same?
-    (crdt-merge (crdt-merge c1 c2) c3)
-    (crdt-merge c1 (crdt-merge c2 c3)))
-  true)
-(content-test
-  "merge-all = fold"
-  (same?
-    (crdt-merge-all (list c1 c2 c3))
-    (crdt-merge c1 (crdt-merge c2 c3)))
-  true)
-
-;; ── full convergence: two replicas, divergent edits, merge both ways ──
-(define
-  repl-1
-  (crdt-apply-all
-    base
-    (list
-      (crdt-op-update "p" "text" "from-1" 5 1)
-      (crdt-op-insert
-        "img"
-        "image"
-        (crdt-pos-between
-          (crdt-pos 1 0)
-          (crdt-pos 2 0)
-          1)
-        (list (list "src" "/a.png") (list "alt" "a"))
-        6
-        1))))
-(define
-  repl-2
-  (crdt-apply-all
-    base
-    (list
-      (crdt-op-delete "h")
-      (crdt-op-update "p" "text" "from-2" 7 2))))
-(content-test
-  "two-replica converges"
-  (same? (crdt-merge repl-1 repl-2) (crdt-merge repl-2 repl-1))
-  true)
-(content-test
-  "two-replica result order"
-  (crdt-order (crdt-merge repl-1 repl-2))
-  (list "img" "p"))
-(content-test
-  "two-replica LWW field"
-  (str
-    (blk-send
-      (doc-find (crdt-materialize "d" (crdt-merge repl-1 repl-2)) "p")
-      "text"))
-  "from-2")
-(content-test
-  "two-replica idempotent"
-  (same?
-    (crdt-merge (crdt-merge repl-1 repl-2) repl-1)
-    (crdt-merge repl-1 repl-2))
-  true)

lib/content/tests/data.sx

@@ -1,116 +0,0 @@
-;; Extension — portable data serialization (to-data / from-data round-trip).
-
-(st-bootstrap-classes!)
-(content/bootstrap!)
-(content-bootstrap-text!)
-(content-bootstrap-markdown!)
-(content-bootstrap-section!)
-(content-bootstrap-table!)
-(content-bootstrap-callout!)
-(content-bootstrap-media!)
-
-;; ── block->data shape ──
-(define h (mk-heading "h" 2 "Hi"))
-(content-test "block->data id" (get (block->data h) :id) "h")
-(content-test "block->data type" (get (block->data h) :type) "heading")
-(content-test "block->data fields" (get (block->data h) :fields) {:text "Hi" :level 2})
-
-;; ── round-trip a mixed document with metadata ──
-(define
-  d
-  (doc-with-meta
-    (doc-append
-      (doc-append
-        (doc-append
-          (doc-append (doc-empty "post") (mk-heading "h" 1 "Title"))
-          (mk-text "p" "Body"))
-        (mk-image "img" "/c.png" "cat"))
-      (mk-list "l" true (list "a" "b")))
-    {:slug "s" :title "T" :tags (list "x" "y")}))
-
-(define rt (content/from-data (content/to-data d)))
-(content-test "rt id" (doc-id rt) "post")
-(content-test "rt title" (doc-title rt) "T")
-(content-test "rt slug" (doc-slug rt) "s")
-(content-test "rt tags" (doc-tags rt) (list "x" "y"))
-(content-test "rt ids" (doc-ids rt) (list "h" "p" "img" "l"))
-(content-test "rt render" (asHTML rt) (asHTML d))
-(content-test
-  "rt heading level"
-  (blk-send (doc-find rt "h") "level")
-  1)
-(content-test
-  "rt list items"
-  (blk-send (doc-find rt "l") "items")
-  (list "a" "b"))
-
-;; ── nested sections round-trip ──
-(define
-  ds
-  (doc-append
-    (doc-empty "d")
-    (mk-section
-      "s"
-      (list
-        (mk-heading "nh" 2 "N")
-        (mk-section "i" (list (mk-text "x" "deep")))))))
-(define rts (content/from-data (content/to-data ds)))
-(content-test "rt nested render" (asHTML rts) (asHTML ds))
-(content-test "rt nested tree-ids" (doc-tree-ids rts) (doc-tree-ids ds))
-(content-test
-  "rt nested deep-find"
-  (str (blk-send (doc-deep-find rts "x") "text"))
-  "deep")
-
-;; ── table round-trip ──
-(define
-  dtb
-  (doc-append
-    (doc-empty "d")
-    (mk-table "t" (list "A" "B") (list (list "1" "2")))))
-(define rtt (content/from-data (content/to-data dtb)))
-(content-test "rt table render" (asHTML rtt) (asHTML dtb))
-(content-test
-  "rt table headers"
-  (table-headers (doc-find rtt "t"))
-  (list "A" "B"))
-
-;; ── callout + media round-trip (regression: ct-class-for-type must know them) ──
-(define
-  dcm
-  (doc-append
-    (doc-append (doc-empty "d") (mk-callout "co" "warning" "careful"))
-    (mk-video "vid" "/clip.mp4")))
-(define rtcm (content/from-data (content/to-data dcm)))
-(content-test "rt callout+media render" (asHTML rtcm) (asHTML dcm))
-(content-test
-  "rt callout kind"
-  (str (blk-send (doc-find rtcm "co") "kind"))
-  "warning")
-(content-test
-  "rt media kind"
-  (str (blk-send (doc-find rtcm "vid") "kind"))
-  "video")
-(content-test
-  "rt callout+media types"
-  (doc-types rtcm)
-  (list "callout" "media"))
-
-;; ── data is plain (no st-instance markers at top level) ──
-(define dat (content/to-data d))
-(content-test "data id field" (get dat :id) "post")
-(content-test "data block count" (len (get dat :blocks)) 4)
-(content-test
-  "data first block type"
-  (get (first (get dat :blocks)) :type)
-  "heading")
-
-;; ── empty doc round-trip ──
-(content-test
-  "rt empty ids"
-  (doc-ids (content/from-data (content/to-data (doc-empty "e"))))
-  (list))
-(content-test
-  "rt no-meta title nil"
-  (doc-title (content/from-data (content/to-data (doc-empty "e"))))
-  nil)

lib/content/tests/doc.sx

@@ -1,132 +0,0 @@
-;; Phase 1 — ordered block document: apply edit ops, structural moves.
-;; Every op returns a NEW document; the input is never mutated.
-
-(st-bootstrap-classes!)
-(content-bootstrap-blocks!)
-(content-bootstrap-doc!)
-
-(define h (mk-heading "h" 1 "Title"))
-(define p1 (mk-text "p1" "First"))
-(define p2 (mk-text "p2" "Second"))
-(define img (mk-image "img" "/c.png" "cat"))
-
-;; ── empty + construction ──
-(define d0 (doc-empty "doc1"))
-(content-test "empty id" (doc-id d0) "doc1")
-(content-test "empty type" (doc-type d0) "document")
-(content-test "empty count" (doc-count d0) 0)
-(content-test "doc? on doc" (doc? d0) true)
-(content-test "doc? on block" (doc? h) false)
-
-;; ── append + order ──
-(define d1 (doc-append (doc-append (doc-append d0 h) p1) p2))
-(content-test "append count" (doc-count d1) 3)
-(content-test "append order" (doc-ids d1) (list "h" "p1" "p2"))
-(content-test "append types" (doc-types d1) (list "heading" "text" "text"))
-(content-test "block-at 0" (blk-id (doc-block-at d1 0)) "h")
-
-;; ── append is immutable ──
-(content-test "append leaves original" (doc-count d0) 0)
-
-;; ── find / index / has ──
-(content-test "find p1" (blk-id (doc-find d1 "p1")) "p1")
-(content-test "find missing" (doc-find d1 "nope") nil)
-(content-test "index-of p2" (doc-index-of d1 "p2") 2)
-(content-test "index-of missing" (doc-index-of d1 "nope") -1)
-(content-test "has? yes" (doc-has? d1 "h") true)
-(content-test "has? no" (doc-has? d1 "x") false)
-
-;; ── insert-after ──
-(define d2 (doc-insert-after d1 img "h"))
-(content-test "insert-after order" (doc-ids d2) (list "h" "img" "p1" "p2"))
-(content-test
-  "insert-after prepend"
-  (doc-ids (doc-insert-after d1 img nil))
-  (list "img" "h" "p1" "p2"))
-(content-test
-  "insert-after missing appends"
-  (doc-ids (doc-insert-after d1 img "zzz"))
-  (list "h" "p1" "p2" "img"))
-(content-test "insert-after immutable" (doc-ids d1) (list "h" "p1" "p2"))
-
-;; ── insert-at ──
-(content-test
-  "insert-at 0"
-  (doc-ids (doc-insert-at d1 img 0))
-  (list "img" "h" "p1" "p2"))
-(content-test
-  "insert-at 1"
-  (doc-ids (doc-insert-at d1 img 1))
-  (list "h" "img" "p1" "p2"))
-
-;; ── update (copy-on-write block) ──
-(define d3 (doc-update d1 "p1" "text" "Edited"))
-(content-test
-  "update value"
-  (str (blk-send (doc-find d3 "p1") "text"))
-  "Edited")
-(content-test "update keeps order" (doc-ids d3) (list "h" "p1" "p2"))
-(content-test
-  "update immutable"
-  (str (blk-send (doc-find d1 "p1") "text"))
-  "First")
-
-;; ── delete ──
-(define d4 (doc-delete d1 "p1"))
-(content-test "delete order" (doc-ids d4) (list "h" "p2"))
-(content-test "delete count" (doc-count d4) 2)
-(content-test "delete immutable" (doc-count d1) 3)
-(content-test
-  "delete missing no-op"
-  (doc-ids (doc-delete d1 "x"))
-  (list "h" "p1" "p2"))
-
-;; ── move ──
-(content-test
-  "move p2 to front"
-  (doc-ids (doc-move d1 "p2" 0))
-  (list "p2" "h" "p1"))
-(content-test
-  "move h to end"
-  (doc-ids (doc-move d1 "h" 2))
-  (list "p1" "p2" "h"))
-(content-test
-  "move missing no-op"
-  (doc-ids (doc-move d1 "x" 0))
-  (list "h" "p1" "p2"))
-(content-test "move immutable" (doc-ids d1) (list "h" "p1" "p2"))
-
-;; ── op constructors + interpreter ──
-(content-test
-  "op-insert apply"
-  (doc-ids (doc-apply d1 (op-insert img "h")))
-  (list "h" "img" "p1" "p2"))
-(content-test
-  "op-delete apply"
-  (doc-ids (doc-apply d1 (op-delete "h")))
-  (list "p1" "p2"))
-(content-test
-  "op-move apply"
-  (doc-ids (doc-apply d1 (op-move "p2" 0)))
-  (list "p2" "h" "p1"))
-(content-test
-  "op-update apply"
-  (str
-    (blk-send
-      (doc-find (doc-apply d1 (op-update "p1" "text" "X")) "p1")
-      "text"))
-  "X")
-
-;; ── apply-all: a stream of ops ──
-(define
-  ops
-  (list (op-insert img "h") (op-delete "p1") (op-move "p2" 0)))
-(content-test
-  "apply-all"
-  (doc-ids (doc-apply-all d1 ops))
-  (list "p2" "h" "img"))
-(content-test "apply-all immutable" (doc-ids d1) (list "h" "p1" "p2"))
-(content-test
-  "apply-all empty"
-  (doc-ids (doc-apply-all d1 (list)))
-  (list "h" "p1" "p2"))