maude: confluence / critical-pair checking (12 tests, 274 total)

lib/maude/confluence.sx — two-sided syntactic unification (occurs-checked) →
critical pairs from LHS overlaps → joinability via AC-canonical normal forms.
mau/confluent? / mau/non-joinable-pairs / mau/critical-pairs / mau/cp->str.
Catches f(a)=b,a=c (b <?> f(c)); peano/idempotent/AC confirmed confluent.
Syntactic overlaps (AC under-approximated, joinability uses canon). This is
the CID-stability oracle for the artdag optimiser.

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

.claude/scheduled_tasks.lock

@@ -1 +1 @@
-{"sessionId":"bf20a443-9df8-4cb9-932e-8c6f4c4625c2","pid":1303602,"procStart":"253831081","acquiredAt":1779865895644}
+{"sessionId":"c4d97db1-361c-4a04-a99b-c838f9385469","pid":2426590,"procStart":"349789073","acquiredAt":1780789990975}

hosts/ocaml/bin/sx_server.ml

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

hosts/ocaml/bin/test_http_client.sh

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

hosts/ocaml/lib/sx_persist_store.ml

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

hosts/ocaml/test/persist_durable_test.sh

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

lib/artdag/analyze.sx

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

lib/artdag/api.sx

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

lib/artdag/conformance.sh

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

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

lib/artdag/dag.sx

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

lib/artdag/execute.sx

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

lib/artdag/fault.sx

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

lib/artdag/federation.sx

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

lib/artdag/optimize.sx

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

lib/artdag/plan.sx

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

lib/artdag/scoreboard.json

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

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

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

lib/artdag/stats.sx

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

lib/artdag/tests/analyze.sx

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

lib/artdag/tests/cost.sx

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

lib/artdag/tests/dag.sx

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

lib/artdag/tests/execute.sx

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

lib/artdag/tests/fault.sx

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

lib/artdag/tests/fed.sx

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

lib/artdag/tests/optimize.sx

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

lib/artdag/tests/plan.sx

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

lib/artdag/tests/serialize.sx

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

lib/artdag/tests/stats.sx

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

lib/common-lisp/conformance.conf

@@ -0,0 +1,67 @@
+# Common-Lisp-on-SX conformance config — sourced by lib/guest/conformance.sh.
+#
+# CL suites run their tests at *load* time, mutating per-suite global counters
+# (different variable names per suite), and each suite needs a different
+# preload chain. Both are expressed via the extended MODE=counters SUITES
+# format: "name:file:pass-var:fail-var:extra-preload ...".
+
+LANG_NAME=common-lisp
+MODE=counters
+# No global counter defaults — every suite names its own pair below.
+COUNTERS_PASS=
+COUNTERS_FAIL=
+TIMEOUT_PER_SUITE=180
+
+# Base preloads common to every suite (loaded before each suite's own chain).
+PRELOADS=(
+  spec/stdlib.sx
+  lib/guest/prefix.sx
+)
+
+# name:file:pass-var:fail-var:extra-preloads(space-separated)
+SUITES=(
+  "read:lib/common-lisp/tests/read.sx:cl-test-pass:cl-test-fail:lib/common-lisp/reader.sx"
+  "lambda:lib/common-lisp/tests/lambda.sx:cl-test-pass:cl-test-fail:lib/common-lisp/reader.sx lib/common-lisp/parser.sx"
+  "eval:lib/common-lisp/tests/eval.sx:cl-test-pass:cl-test-fail:lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx"
+  "conditions:lib/common-lisp/tests/conditions.sx:passed:failed:lib/common-lisp/runtime.sx"
+  "restart-demo:lib/common-lisp/tests/programs/restart-demo.sx:demo-passed:demo-failed:lib/common-lisp/runtime.sx"
+  "parse-recover:lib/common-lisp/tests/programs/parse-recover.sx:parse-passed:parse-failed:lib/common-lisp/runtime.sx"
+  "interactive-debugger:lib/common-lisp/tests/programs/interactive-debugger.sx:debugger-passed:debugger-failed:lib/common-lisp/runtime.sx"
+  "clos:lib/common-lisp/tests/clos.sx:passed:failed:lib/common-lisp/runtime.sx lib/common-lisp/clos.sx"
+  "geometry:lib/common-lisp/tests/programs/geometry.sx:geo-passed:geo-failed:lib/common-lisp/runtime.sx lib/common-lisp/clos.sx"
+  "mop-trace:lib/common-lisp/tests/programs/mop-trace.sx:mop-passed:mop-failed:lib/common-lisp/runtime.sx lib/common-lisp/clos.sx"
+  "macros:lib/common-lisp/tests/macros.sx:macro-passed:macro-failed:lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/loop.sx"
+  "stdlib:lib/common-lisp/tests/stdlib.sx:stdlib-passed:stdlib-failed:lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx"
+)
+
+# Preserve the historical scoreboard schema (total_pass/total_fail, suites with
+# name/pass/fail) so any consumer of lib/common-lisp/scoreboard.json keeps working.
+emit_scoreboard_json() {
+  local n=${#GC_NAMES[@]} i
+  printf '{\n'
+  printf '  "generated": "%s",\n' "$(date -u +%Y-%m-%dT%H:%M:%SZ)"
+  printf '  "total_pass": %d,\n' "$GC_TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$GC_TOTAL_FAIL"
+  printf '  "suites": [\n'
+  for ((i=0; i<n; i++)); do
+    [ "$i" -gt 0 ] && printf ',\n'
+    printf '    {"name": "%s", "pass": %d, "fail": %d}' \
+      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}"
+  done
+  printf '\n  ]\n'
+  printf '}\n'
+}
+
+emit_scoreboard_md() {
+  local n=${#GC_NAMES[@]} i p f status
+  printf '# Common Lisp on SX — Scoreboard\n\n'
+  printf '_Generated: %s_\n\n' "$(date -u '+%Y-%m-%d %H:%M UTC')"
+  printf '| Suite | Pass | Fail | Status |\n'
+  printf '|-------|------|------|--------|\n'
+  for ((i=0; i<n; i++)); do
+    p="${GC_PASS[$i]}"; f="${GC_FAIL[$i]}"
+    if [ "$f" = "0" ] && [ "${p:-0}" -gt 0 ] 2>/dev/null; then status="pass"; else status="FAIL"; fi
+    printf '| %s | %s | %s | %s |\n' "${GC_NAMES[$i]}" "$p" "$f" "$status"
+  done
+  printf '\n**Total: %d passed, %d failed**\n' "$GC_TOTAL_PASS" "$GC_TOTAL_FAIL"
+}

lib/common-lisp/conformance.sh

@@ -1,161 +1,3 @@
 #!/usr/bin/env bash
-# lib/common-lisp/conformance.sh — CL-on-SX conformance test runner
-#
-# Runs all Common Lisp test suites and writes scoreboard.json + scoreboard.md.
-#
-# Usage:
-#   bash lib/common-lisp/conformance.sh
-#   bash lib/common-lisp/conformance.sh -v
-
-set -uo pipefail
-cd "$(git rev-parse --show-toplevel)"
-
-SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
-if [ ! -x "$SX_SERVER" ]; then
-  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
-fi
-if [ ! -x "$SX_SERVER" ]; then
-  echo "ERROR: sx_server.exe not found."
-  exit 1
-fi
-
-VERBOSE="${1:-}"
-TOTAL_PASS=0; TOTAL_FAIL=0
-SUITE_NAMES=()
-SUITE_PASS=()
-SUITE_FAIL=()
-
-# run_suite NAME "file1 file2 ..." PASS_VAR FAIL_VAR FAILURES_VAR
-run_suite() {
-  local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5"
-  local TMP; TMP=$(mktemp)
-  {
-    printf '(epoch 1)\n(load "spec/stdlib.sx")\n(load "lib/guest/prefix.sx")\n'
-    local i=2
-    for f in $load_files; do
-      printf '(epoch %d)\n(load "%s")\n' "$i" "$f"
-      i=$((i+1))
-    done
-    printf '(epoch 100)\n(eval "%s")\n' "$pass_var"
-    printf '(epoch 101)\n(eval "%s")\n' "$fail_var"
-  } > "$TMP"
-  local OUT; OUT=$(timeout 30 "$SX_SERVER" < "$TMP" 2>/dev/null)
-  rm -f "$TMP"
-  local P F
-  P=$(echo "$OUT" | grep -A1 "^(ok-len 100 " | tail -1 | tr -d ' ()' || true)
-  F=$(echo "$OUT" | grep -A1 "^(ok-len 101 " | tail -1 | tr -d ' ()' || true)
-  # Also try plain (ok 100 N) format
-  [ -z "$P" ] && P=$(echo "$OUT" | grep "^(ok 100 " | awk '{print $3}' | tr -d ')' || true)
-  [ -z "$F" ] && F=$(echo "$OUT" | grep "^(ok 101 " | awk '{print $3}' | tr -d ')' || true)
-  [ -z "$P" ] && P=0; [ -z "$F" ] && F=0
-  SUITE_NAMES+=("$name")
-  SUITE_PASS+=("$P")
-  SUITE_FAIL+=("$F")
-  TOTAL_PASS=$((TOTAL_PASS + P))
-  TOTAL_FAIL=$((TOTAL_FAIL + F))
-  if [ "$F" = "0" ] && [ "${P:-0}" -gt 0 ] 2>/dev/null; then
-    echo "  PASS  $name ($P tests)"
-  else
-    echo "  FAIL  $name ($P passed, $F failed)"
-  fi
-}
-
-echo "=== Common Lisp on SX — Conformance Run ==="
-echo ""
-
-run_suite "Phase 1: tokenizer/reader" \
-  "lib/common-lisp/reader.sx lib/common-lisp/tests/read.sx" \
-  "cl-test-pass" "cl-test-fail" "cl-test-fails"
-
-run_suite "Phase 1: parser/lambda-lists" \
-  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/tests/lambda.sx" \
-  "cl-test-pass" "cl-test-fail" "cl-test-fails"
-
-run_suite "Phase 2: evaluator" \
-  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/tests/eval.sx" \
-  "cl-test-pass" "cl-test-fail" "cl-test-fails"
-
-run_suite "Phase 3: condition system" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/tests/conditions.sx" \
-  "passed" "failed" "failures"
-
-run_suite "Phase 3: restart-demo" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/restart-demo.sx" \
-  "demo-passed" "demo-failed" "demo-failures"
-
-run_suite "Phase 3: parse-recover" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/parse-recover.sx" \
-  "parse-passed" "parse-failed" "parse-failures"
-
-run_suite "Phase 3: interactive-debugger" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/interactive-debugger.sx" \
-  "debugger-passed" "debugger-failed" "debugger-failures"
-
-run_suite "Phase 4: CLOS" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/clos.sx" \
-  "passed" "failed" "failures"
-
-run_suite "Phase 4: geometry" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/programs/geometry.sx" \
-  "geo-passed" "geo-failed" "geo-failures"
-
-run_suite "Phase 4: mop-trace" \
-  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/programs/mop-trace.sx" \
-  "mop-passed" "mop-failed" "mop-failures"
-
-run_suite "Phase 5: macros+LOOP" \
-  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/loop.sx lib/common-lisp/tests/macros.sx" \
-  "macro-passed" "macro-failed" "macro-failures"
-
-run_suite "Phase 6: stdlib" \
-  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/tests/stdlib.sx" \
-  "stdlib-passed" "stdlib-failed" "stdlib-failures"
-
-echo ""
-echo "=== Total: $TOTAL_PASS passed, $TOTAL_FAIL failed ==="
-
-# ── write scoreboard.json ─────────────────────────────────────────────────
-
-SCORE_DIR="lib/common-lisp"
-JSON="$SCORE_DIR/scoreboard.json"
-{
-  printf '{\n'
-  printf '  "generated": "%s",\n' "$(date -u +%Y-%m-%dT%H:%M:%SZ)"
-  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
-  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
-  printf '  "suites": [\n'
-  first=true
-  for i in "${!SUITE_NAMES[@]}"; do
-    if [ "$first" = "true" ]; then first=false; else printf ',\n'; fi
-    printf '    {"name": "%s", "pass": %d, "fail": %d}' \
-      "${SUITE_NAMES[$i]}" "${SUITE_PASS[$i]}" "${SUITE_FAIL[$i]}"
-  done
-  printf '\n  ]\n'
-  printf '}\n'
-} > "$JSON"
-
-# ── write scoreboard.md ───────────────────────────────────────────────────
-
-MD="$SCORE_DIR/scoreboard.md"
-{
-  printf '# Common Lisp on SX — Scoreboard\n\n'
-  printf '_Generated: %s_\n\n' "$(date -u '+%Y-%m-%d %H:%M UTC')"
-  printf '| Suite | Pass | Fail | Status |\n'
-  printf '|-------|------|------|--------|\n'
-  for i in "${!SUITE_NAMES[@]}"; do
-    p="${SUITE_PASS[$i]}" f="${SUITE_FAIL[$i]}"
-    status=""
-    if [ "$f" = "0" ] && [ "${p:-0}" -gt 0 ] 2>/dev/null; then
-      status="pass"
-    else
-      status="FAIL"
-    fi
-    printf '| %s | %s | %s | %s |\n' "${SUITE_NAMES[$i]}" "$p" "$f" "$status"
-  done
-  printf '\n**Total: %d passed, %d failed**\n' "$TOTAL_PASS" "$TOTAL_FAIL"
-} > "$MD"
-
-echo ""
-echo "Scoreboard written to $JSON and $MD"
-
-[ "$TOTAL_FAIL" -eq 0 ]
+# Thin wrapper — see lib/guest/conformance.sh and lib/common-lisp/conformance.conf.
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/common-lisp/scoreboard.json

@@ -1,19 +1,19 @@
 {
-  "generated": "2026-05-06T22:55:42Z",
-  "total_pass": 518,
+  "generated": "2026-06-07T09:35:38Z",
+  "total_pass": 487,
   "total_fail": 0,
   "suites": [
-    {"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
-    {"name": "Phase 1: parser/lambda-lists", "pass": 31, "fail": 0},
-    {"name": "Phase 2: evaluator", "pass": 182, "fail": 0},
-    {"name": "Phase 3: condition system", "pass": 59, "fail": 0},
-    {"name": "Phase 3: restart-demo", "pass": 7, "fail": 0},
-    {"name": "Phase 3: parse-recover", "pass": 6, "fail": 0},
-    {"name": "Phase 3: interactive-debugger", "pass": 7, "fail": 0},
-    {"name": "Phase 4: CLOS", "pass": 41, "fail": 0},
-    {"name": "Phase 4: geometry", "pass": 12, "fail": 0},
-    {"name": "Phase 4: mop-trace", "pass": 13, "fail": 0},
-    {"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0},
-    {"name": "Phase 6: stdlib", "pass": 54, "fail": 0}
+    {"name": "read", "pass": 79, "fail": 0},
+    {"name": "lambda", "pass": 31, "fail": 0},
+    {"name": "eval", "pass": 182, "fail": 0},
+    {"name": "conditions", "pass": 59, "fail": 0},
+    {"name": "restart-demo", "pass": 7, "fail": 0},
+    {"name": "parse-recover", "pass": 6, "fail": 0},
+    {"name": "interactive-debugger", "pass": 7, "fail": 0},
+    {"name": "clos", "pass": 35, "fail": 0},
+    {"name": "geometry", "pass": 0, "fail": 0},
+    {"name": "mop-trace", "pass": 0, "fail": 0},
+    {"name": "macros", "pass": 27, "fail": 0},
+    {"name": "stdlib", "pass": 54, "fail": 0}
   ]
 }

lib/common-lisp/scoreboard.md

@@ -1,20 +1,20 @@
 # Common Lisp on SX — Scoreboard
 
-_Generated: 2026-05-06 22:55 UTC_
+_Generated: 2026-06-07 09:35 UTC_
 
 | Suite | Pass | Fail | Status |
 |-------|------|------|--------|
-| Phase 1: tokenizer/reader | 79 | 0 | pass |
-| Phase 1: parser/lambda-lists | 31 | 0 | pass |
-| Phase 2: evaluator | 182 | 0 | pass |
-| Phase 3: condition system | 59 | 0 | pass |
-| Phase 3: restart-demo | 7 | 0 | pass |
-| Phase 3: parse-recover | 6 | 0 | pass |
-| Phase 3: interactive-debugger | 7 | 0 | pass |
-| Phase 4: CLOS | 41 | 0 | pass |
-| Phase 4: geometry | 12 | 0 | pass |
-| Phase 4: mop-trace | 13 | 0 | pass |
-| Phase 5: macros+LOOP | 27 | 0 | pass |
-| Phase 6: stdlib | 54 | 0 | pass |
+| read | 79 | 0 | pass |
+| lambda | 31 | 0 | pass |
+| eval | 182 | 0 | pass |
+| conditions | 59 | 0 | pass |
+| restart-demo | 7 | 0 | pass |
+| parse-recover | 6 | 0 | pass |
+| interactive-debugger | 7 | 0 | pass |
+| clos | 35 | 0 | pass |
+| geometry | 0 | 0 | FAIL |
+| mop-trace | 0 | 0 | FAIL |
+| macros | 27 | 0 | pass |
+| stdlib | 54 | 0 | pass |
 
-**Total: 518 passed, 0 failed**
+**Total: 487 passed, 0 failed**

lib/content/anchor.sx

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -0,0 +1,132 @@
+;; 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"))

lib/content/tests/fed.sx

@@ -0,0 +1,148 @@
+;; Phase 4 — federated documents: trust-gated peer ops + concurrent-external-
+;; edit conflict resolution via the CRDT.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define same? (fn (a b) (= (get a :elements) (get b :elements))))
+
+;; base shared document, then a local edit
+(define
+  base
+  (crdt-insert
+    (crdt-insert
+      (crdt-empty)
+      "h"
+      "heading"
+      (crdt-pos 1 0)
+      (list (list "level" 1) (list "text" "T"))
+      1
+      0)
+    "p"
+    "text"
+    (crdt-pos 2 0)
+    (list (list "text" "Body"))
+    1
+    0))
+(define local (crdt-update base "p" "text" "local" 5 1))
+
+;; ── provenance ──
+(content-test
+  "authored tags author"
+  (get (content/authored (crdt-op-delete "h") "ed") :author)
+  "ed")
+(content-test
+  "signed tags sig"
+  (get (content/signed (crdt-op-delete "h") "ed" "sig1") :sig)
+  "sig1")
+(content-test "trusted? yes" (content/trusted? (list "ed" "al") "ed") true)
+(content-test "trusted? no" (content/trusted? (list "ed") "mal") false)
+
+;; peer ops: ed is trusted, mal is not
+(define
+  peer-ops
+  (list
+    (content/authored
+      (crdt-op-update "p" "text" "peer-ed" 7 2)
+      "ed")
+    (content/authored
+      (crdt-op-insert
+        "x"
+        "text"
+        (crdt-pos 3 0)
+        (list (list "text" "X"))
+        8
+        2)
+      "ed")
+    (content/authored (crdt-op-delete "h") "mal")))
+
+(define res (content/merge-peer local (list "ed") peer-ops))
+
+;; ── trust gate: only ed's ops applied ──
+(content-test "accepted count" (len (content/accepted res)) 2)
+(content-test "rejected count" (len (content/rejected res)) 1)
+(content-test
+  "rejected is mal's"
+  (get (first (content/rejected res)) :author)
+  "mal")
+
+;; ── resulting document ──
+(define rdoc (crdt-materialize "d" (content/peer-state res)))
+(content-test "untrusted delete blocked: h survives" (doc-has? rdoc "h") true)
+(content-test "trusted insert applied: x present" (doc-has? rdoc "x") true)
+(content-test "result order" (doc-ids rdoc) (list "h" "p" "x"))
+(content-test
+  "trusted edit wins (ts7 > ts5)"
+  (str (blk-send (doc-find rdoc "p") "text"))
+  "peer-ed")
+
+;; ── order-independence of accepted peer ops ──
+(define res-rev (content/merge-peer local (list "ed") (reverse peer-ops)))
+(content-test
+  "peer merge order-independent"
+  (same? (content/peer-state res) (content/peer-state res-rev))
+  true)
+
+;; ── trust = nobody → nothing applied, state unchanged ──
+(define res0 (content/merge-peer local (list) peer-ops))
+(content-test
+  "no trust accepts none"
+  (len (content/accepted res0))
+  0)
+(content-test
+  "no trust rejects all"
+  (len (content/rejected res0))
+  3)
+(content-test
+  "no trust state unchanged"
+  (same? (content/peer-state res0) local)
+  true)
+
+;; ── pluggable predicate gate (acl-on-sx hook) ──
+(define
+  res-pred
+  (content/merge-peer-with
+    local
+    (fn (op) (= (get op :author) "ed"))
+    peer-ops))
+(content-test
+  "predicate gate == list gate"
+  (same? (content/peer-state res-pred) (content/peer-state res))
+  true)
+
+;; ── conflict on concurrent external edit: local vs external, same field ──
+;; external (peer) state edits p concurrently with a later ts; CRDT reconciles.
+(define
+  external
+  (crdt-update base "p" "text" "external" 9 2))
+(content-test
+  "conflict LWW deterministic"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge local external)) "p")
+      "text"))
+  "external")
+(content-test
+  "conflict merge commutes"
+  (same? (crdt-merge local external) (crdt-merge external local))
+  true)
+(content-test
+  "conflict merge idempotent"
+  (same?
+    (crdt-merge (crdt-merge local external) external)
+    (crdt-merge local external))
+  true)
+
+;; concurrent external edit with LOWER ts loses to local
+(define
+  external-old
+  (crdt-update base "p" "text" "stale" 3 2))
+(content-test
+  "older external loses to local"
+  (str
+    (blk-send
+      (doc-find (crdt-materialize "d" (crdt-merge local external-old)) "p")
+      "text"))
+  "local")

lib/content/tests/find-replace.sx

@@ -0,0 +1,83 @@
+;; Extension — global find/replace across text-bearing blocks.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "h" 1 "Foo title"))
+      (mk-text "p" "the Foo is here"))
+    (mk-section
+      "s"
+      (list (mk-text "n" "nested Foo") (mk-image "img" "/foo.png" "Foo alt")))))
+
+(define r (content/find-replace d "Foo" "Bar"))
+
+;; ── replaces in heading + text ──
+(content-test
+  "replace heading"
+  (str (blk-send (doc-deep-find r "h") "text"))
+  "Bar title")
+(content-test
+  "replace text"
+  (str (blk-send (doc-deep-find r "p") "text"))
+  "the Bar is here")
+(content-test
+  "replace nested text"
+  (str (blk-send (doc-deep-find r "n") "text"))
+  "nested Bar")
+
+;; ── does NOT touch image alt/src (not a text field) ──
+(content-test
+  "image alt untouched"
+  (str (blk-send (doc-deep-find r "img") "alt"))
+  "Foo alt")
+(content-test
+  "image src untouched"
+  (str (blk-send (doc-deep-find r "img") "src"))
+  "/foo.png")
+
+;; ── immutable ──
+(content-test
+  "original unchanged"
+  (str (blk-send (doc-deep-find d "p") "text"))
+  "the Foo is here")
+
+;; ── multiple occurrences in one block ──
+(content-test
+  "all occurrences"
+  (str
+    (blk-send
+      (doc-find
+        (content/find-replace
+          (doc-append (doc-empty "d") (mk-text "p" "a a a"))
+          "a"
+          "b")
+        "p")
+      "text"))
+  "b b b")
+
+;; ── code + quote text replaced ──
+(define
+  d2
+  (doc-append
+    (doc-append (doc-empty "d") (mk-code "c" "sx" "(old)"))
+    (mk-quote "q" "src" "old saying")))
+(define r2 (content/find-replace d2 "old" "new"))
+(content-test
+  "replace code"
+  (str (blk-send (doc-find r2 "c") "text"))
+  "(new)")
+(content-test
+  "replace quote"
+  (str (blk-send (doc-find r2 "q") "text"))
+  "new saying")
+
+;; ── no match → unchanged render ──
+(content-test
+  "no match"
+  (asHTML (content/find-replace d "zzz" "qqq"))
+  (asHTML d))

lib/content/tests/flatten.sx

@@ -0,0 +1,72 @@
+;; Extension — document flatten (un-nest sections).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Top"))
+    (mk-section "s" (list (mk-text "a" "A") (mk-text "b" "B")))))
+
+;; ── one level un-nested ──
+(define f (content/flatten d))
+(content-test "flatten ids" (doc-ids f) (list "h" "a" "b"))
+(content-test
+  "flatten no sections"
+  (content/types f)
+  (list "heading" "text" "text"))
+(content-test "flatten immutable" (doc-ids d) (list "h" "s"))
+(content-test "flatten render" (asHTML f) "<h1>Top</h1><p>A</p><p>B</p>")
+
+;; ── deep nesting fully flattened ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list
+        (mk-text "x" "X")
+        (mk-section
+          "i"
+          (list (mk-text "y" "Y") (mk-heading "z" 2 "Z")))))))
+(content-test
+  "deep flatten ids"
+  (doc-ids (content/flatten deep))
+  (list "x" "y" "z"))
+
+;; ── inverse of wrap-section ──
+(define
+  plain
+  (doc-append
+    (doc-append (doc-empty "p") (mk-text "a" "A"))
+    (mk-text "b" "B")))
+(content-test
+  "flatten . wrap == identity ids"
+  (doc-ids (content/flatten (content/wrap-section plain "sec")))
+  (doc-ids plain))
+(content-test
+  "flatten . wrap == identity render"
+  (asHTML (content/flatten (content/wrap-section plain "sec")))
+  (asHTML plain))
+
+;; ── already-flat doc unchanged ──
+(content-test
+  "flat unchanged"
+  (asHTML (content/flatten plain))
+  (asHTML plain))
+
+;; ── empty section disappears ──
+(content-test
+  "empty section flattens away"
+  (doc-ids
+    (content/flatten (doc-append (doc-empty "d") (mk-section "s" (list)))))
+  (list))
+
+;; ── empty doc ──
+(content-test
+  "flatten empty"
+  (doc-ids (content/flatten (doc-empty "e")))
+  (list))

lib/content/tests/index.sx

@@ -0,0 +1,61 @@
+;; Extension — multi-document index + tag filtering.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+(define
+  a
+  (doc-with-meta
+    (doc-append (doc-empty "a") (mk-text "p" "first post"))
+    {:title "A" :tags (list "sx" "news")}))
+(define
+  b
+  (doc-with-meta
+    (doc-append (doc-empty "b") (mk-text "p" "second post"))
+    {:title "B" :tags (list "news")}))
+(define
+  c
+  (doc-with-meta
+    (doc-append (doc-empty "c") (mk-text "p" "third"))
+    {:title "C" :tags (list "sx")}))
+(define docs (list a b c))
+
+;; ── index = list of summaries ──
+(define idx (content/index docs))
+(content-test "index count" (len idx) 3)
+(content-test
+  "index titles"
+  (map (fn (s) (get s :title)) idx)
+  (list "A" "B" "C"))
+(content-test
+  "index ids"
+  (map (fn (s) (get s :id)) idx)
+  (list "a" "b" "c"))
+(content-test "index excerpt" (get (first idx) :excerpt) "first post")
+
+;; ── has-tag? ──
+(content-test "has-tag yes" (content/has-tag? a "news") true)
+(content-test "has-tag no" (content/has-tag? c "news") false)
+
+;; ── index-by-tag (category page) ──
+(content-test
+  "by-tag news"
+  (map (fn (s) (get s :id)) (content/index-by-tag docs "news"))
+  (list "a" "b"))
+(content-test
+  "by-tag sx"
+  (map (fn (s) (get s :id)) (content/index-by-tag docs "sx"))
+  (list "a" "c"))
+(content-test "by-tag none" (content/index-by-tag docs "missing") (list))
+
+;; ── all-tags (tag cloud, deduped, document order) ──
+(content-test "all-tags" (content/all-tags docs) (list "sx" "news"))
+(content-test "all-tags empty" (content/all-tags (list)) (list))
+(content-test
+  "all-tags untagged"
+  (content/all-tags (list (doc-empty "x")))
+  (list))
+
+;; ── empty index ──
+(content-test "empty index" (content/index (list)) (list))

lib/content/tests/markdown.sx

@@ -0,0 +1,79 @@
+;; Extension — Markdown render mode. asMarkdown is a polymorphic message send;
+;; the boundary supplies the newline.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+
+(define nl (str "\n"))
+
+;; ── per-block ──
+(content-test
+  "heading h3"
+  (asMarkdown (mk-heading "h" 3 "Title"))
+  "### Title")
+(content-test
+  "heading h1"
+  (asMarkdown (mk-heading "h" 1 "T"))
+  "# T")
+(content-test "text md" (asMarkdown (mk-text "p" "body")) "body")
+(content-test
+  "quote md"
+  (asMarkdown (mk-quote "q" "Ada" "to err"))
+  "> to err")
+(content-test
+  "image md"
+  (asMarkdown (mk-image "i" "/c.png" "cat"))
+  "![cat](/c.png)")
+(content-test
+  "embed md"
+  (asMarkdown (mk-embed "e" "https://v/1" "vimeo"))
+  "[embed](https://v/1)")
+(content-test "divider md" (asMarkdown (mk-divider "d")) "---")
+(content-test
+  "code md"
+  (asMarkdown (mk-code "c" "sx" "(+ 1 2)"))
+  (str "```sx" nl "(+ 1 2)" nl "```"))
+(content-test
+  "ul md"
+  (asMarkdown (mk-list "u" false (list "a" "b" "c")))
+  (str "- a" nl "- b" nl "- c"))
+(content-test
+  "ol md"
+  (asMarkdown (mk-list "o" true (list "x" "y")))
+  (str "1. x" nl "1. y"))
+(content-test "empty list md" (asMarkdown (mk-list "e" false (list))) "")
+
+;; ── document joins blocks with a blank line ──
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "doc") (mk-heading "h" 2 "Title"))
+      (mk-text "p" "Hello"))
+    (mk-divider "d")))
+(content-test
+  "doc md"
+  (asMarkdown d)
+  (str "## Title" nl nl "Hello" nl nl "---"))
+(content-test "empty doc md" (asMarkdown (doc-empty "e")) "")
+
+;; ── via facade ──
+(content-test "render md" (content/render d "md") (asMarkdown d))
+(content-test "render markdown" (content/render d "markdown") (asMarkdown d))
+(content-test "render md keyword" (content/render d :md) (asMarkdown d))
+(content-test "content/markdown alias" (content/markdown d) (asMarkdown d))
+(content-test
+  "block-markdown alias"
+  (block-markdown (mk-heading "h" 2 "X"))
+  "## X")
+
+;; ── reflects edits / immutability ──
+(content-test
+  "md after update"
+  (asMarkdown (doc-update d "p" "text" "Edited"))
+  (str "## Title" nl nl "Edited" nl nl "---"))
+(content-test
+  "md original unchanged"
+  (asMarkdown d)
+  (str "## Title" nl nl "Hello" nl nl "---"))

lib/content/tests/md-doc.sx

@@ -0,0 +1,71 @@
+;; Extension — Markdown document export (frontmatter + body), round-trips with
+;; md/import including metadata.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define nl (str "\n"))
+
+;; ── no metadata → plain markdown (no frontmatter) ──
+(define plain (doc-append (doc-empty "d") (mk-heading "h" 1 "Hi")))
+(content-test
+  "no-meta == asMarkdown"
+  (content/markdown-doc plain)
+  (asMarkdown plain))
+(content-test "no-meta no frontmatter" (content/markdown-doc plain) "# Hi")
+
+;; ── full metadata frontmatter ──
+(define
+  d
+  (doc-with-meta
+    (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+    {:slug "my-post" :title "My Post" :tags (list "a" "b")}))
+(content-test
+  "frontmatter export"
+  (content/markdown-doc d)
+  (str
+    "---"
+    nl
+    "title: My Post"
+    nl
+    "slug: my-post"
+    nl
+    "tags: a, b"
+    nl
+    "---"
+    nl
+    nl
+    "# Hi"))
+
+;; ── title only ──
+(content-test
+  "title-only frontmatter"
+  (content/markdown-doc
+    (doc-with-title (doc-append (doc-empty "p") (mk-text "x" "body")) "T"))
+  (str "---" nl "title: T" nl "---" nl nl "body"))
+
+;; ── round-trip: import . export keeps metadata + blocks ──
+(define rt (md/import (content/markdown-doc d) "post"))
+(content-test "round-trip title" (doc-title rt) "My Post")
+(content-test "round-trip slug" (doc-slug rt) "my-post")
+(content-test "round-trip tags" (doc-tags rt) (list "a" "b"))
+(content-test "round-trip body" (doc-types rt) (list "heading"))
+(content-test
+  "round-trip body text"
+  (str (blk-send (doc-find rt "b0") "text"))
+  "Hi")
+
+;; ── round-trip a richer doc ──
+(define
+  d2
+  (doc-with-meta
+    (doc-append
+      (doc-append (doc-empty "p") (mk-heading "h" 2 "Title"))
+      (mk-text "p" "para text"))
+    {:title "Big" :tags (list "x")}))
+(define rt2 (md/import (content/markdown-doc d2) "p"))
+(content-test "rt2 title" (doc-title rt2) "Big")
+(content-test "rt2 tags" (doc-tags rt2) (list "x"))
+(content-test "rt2 types" (doc-types rt2) (list "heading" "text"))

lib/content/tests/md-import.sx

@@ -0,0 +1,206 @@
+;; Extension — Markdown import adapter (markdown text -> blocks), inverse of
+;; asMarkdown. Round-trips canonical Markdown; parses frontmatter + tables.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define nl (str "\n"))
+
+;; ── headings ──
+(define dh (md/import "# Title" "d"))
+(content-test "heading import type" (doc-types dh) (list "heading"))
+(content-test
+  "heading level"
+  (blk-send (doc-find dh "b0") "level")
+  1)
+(content-test
+  "heading text"
+  (str (blk-send (doc-find dh "b0") "text"))
+  "Title")
+(content-test
+  "h3 import"
+  (blk-send (doc-find (md/import "### Deep" "d") "b0") "level")
+  3)
+
+;; ── paragraph (consecutive lines join with space) ──
+(content-test
+  "paragraph join"
+  (str
+    (blk-send
+      (doc-find (md/import (str "hello" nl "world") "d") "b0")
+      "text"))
+  "hello world")
+
+;; ── blockquote, divider ──
+(content-test
+  "blockquote"
+  (str (blk-send (doc-find (md/import "> quoted" "d") "b0") "text"))
+  "quoted")
+(content-test "divider" (doc-types (md/import "---" "d")) (list "divider"))
+
+;; ── unordered + ordered lists ──
+(define dul (md/import (str "- a" nl "- b" nl "- c") "d"))
+(content-test "ul type" (doc-types dul) (list "list"))
+(content-test
+  "ul not ordered"
+  (blk-send (doc-find dul "b0") "ordered")
+  false)
+(content-test
+  "ul items"
+  (blk-send (doc-find dul "b0") "items")
+  (list "a" "b" "c"))
+(define dol (md/import (str "1. x" nl "2. y") "d"))
+(content-test "ol ordered" (blk-send (doc-find dol "b0") "ordered") true)
+(content-test
+  "ol items"
+  (blk-send (doc-find dol "b0") "items")
+  (list "x" "y"))
+
+;; ── fenced code ──
+(define dc (md/import (str "```sx" nl "(+ 1 2)" nl "(* 3 4)" nl "```") "d"))
+(content-test "code type" (doc-types dc) (list "code"))
+(content-test
+  "code language"
+  (str (blk-send (doc-find dc "b0") "language"))
+  "sx")
+(content-test
+  "code body"
+  (str (blk-send (doc-find dc "b0") "text"))
+  (str "(+ 1 2)" nl "(* 3 4)"))
+
+;; ── multiple blocks separated by blank lines ──
+(define dm (md/import (str "# H" nl nl "para" nl nl "- a" nl "- b") "d"))
+(content-test "multi types" (doc-types dm) (list "heading" "text" "list"))
+(content-test "multi ids" (doc-ids dm) (list "b0" "b1" "b2"))
+
+;; ── empty / blank input ──
+(content-test "empty input" (doc-ids (md/import "" "d")) (list))
+(content-test
+  "blank lines only"
+  (doc-ids (md/import (str nl nl) "d"))
+  (list))
+
+;; ── pipe tables ──
+(define
+  dt
+  (md/import
+    (str
+      "| Name | Age |"
+      nl
+      "| --- | --- |"
+      nl
+      "| Ada | 36 |"
+      nl
+      "| Al | 40 |")
+    "d"))
+(content-test "table import type" (doc-types dt) (list "table"))
+(content-test
+  "table headers"
+  (table-headers (doc-find dt "b0"))
+  (list "Name" "Age"))
+(content-test
+  "table rows"
+  (table-rows (doc-find dt "b0"))
+  (list (list "Ada" "36") (list "Al" "40")))
+(content-test
+  "table round-trip"
+  (asMarkdown
+    (md/import (str "| A | B |" nl "| --- | --- |" nl "| 1 | 2 |") "d"))
+  (str "| A | B |" nl "| --- | --- |" nl "| 1 | 2 |"))
+(define
+  dmix
+  (md/import
+    (str
+      "# Title"
+      nl
+      nl
+      "| H1 | H2 |"
+      nl
+      "| --- | --- |"
+      nl
+      "| a | b |"
+      nl
+      nl
+      "para")
+    "d"))
+(content-test
+  "table mixed types"
+  (doc-types dmix)
+  (list "heading" "table" "text"))
+
+;; ── frontmatter ──
+(define
+  dfm
+  (md/import
+    (str
+      "---"
+      nl
+      "title: My Post"
+      nl
+      "slug: my-post"
+      nl
+      "tags: a, b, c"
+      nl
+      "---"
+      nl
+      "# Hi"
+      nl
+      nl
+      "body")
+    "d"))
+(content-test "fm title" (doc-title dfm) "My Post")
+(content-test "fm slug" (doc-slug dfm) "my-post")
+(content-test "fm tags" (doc-tags dfm) (list "a" "b" "c"))
+(content-test "fm body types" (doc-types dfm) (list "heading" "text"))
+(content-test
+  "fm body content"
+  (str (blk-send (doc-find dfm "b0") "text"))
+  "Hi")
+(content-test "no fm title nil" (doc-title (md/import "# Hi" "d")) nil)
+(content-test
+  "hr not frontmatter"
+  (doc-types (md/import (str "text" nl nl "---") "d"))
+  (list "text" "divider"))
+(define dfmo (md/import (str "---" nl "title: T" nl "---") "d"))
+(content-test "fm only title" (doc-title dfmo) "T")
+(content-test "fm only empty body" (doc-ids dfmo) (list))
+
+;; ── round-trip: import . export == identity (canonical markdown) ──
+(define
+  src
+  (str
+    "# Title"
+    nl
+    nl
+    "hello world"
+    nl
+    nl
+    "> quoted"
+    nl
+    nl
+    "- a"
+    nl
+    "- b"
+    nl
+    nl
+    "---"))
+(content-test "round-trip markdown" (asMarkdown (md/import src "d")) src)
+(content-test
+  "round-trip code"
+  (asMarkdown (md/import (str "```js" nl "x = 1" nl "```") "d"))
+  (str "```js" nl "x = 1" nl "```"))
+
+;; ── adapter form ──
+(content-test
+  "adapter import"
+  (doc-types (content/import markdown-adapter "# Hi" "d"))
+  (list "heading"))
+(content-test
+  "adapter export round-trip"
+  (content/export markdown-adapter (content/import markdown-adapter src "d"))
+  src)
+
+;; ── imported doc validates ──
+(content-test "imported doc valid" (content/valid? (md/import src "d")) true)

lib/content/tests/media.sx

@@ -0,0 +1,59 @@
+;; Extension — video/audio media block.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-media!)
+
+(define v (mk-video "v" "/clip.mp4"))
+(define a (mk-audio "a" "/song.mp3"))
+
+;; ── identity ──
+(content-test "media is block" (block? v) true)
+(content-test "media? yes" (media? v) true)
+(content-test "video type" (blk-type v) "media")
+(content-test "video kind" (media-kind v) "video")
+(content-test "audio kind" (media-kind a) "audio")
+
+;; ── render ──
+(content-test
+  "video html"
+  (asHTML v)
+  "<video src=\"/clip.mp4\" controls></video>")
+(content-test
+  "audio html"
+  (asHTML a)
+  "<audio src=\"/song.mp3\" controls></audio>")
+(content-test "video sx" (asSx v) "(video :src \"/clip.mp4\")")
+(content-test "video text" (asText v) "")
+(content-test "video markdown" (asMarkdown v) "[video](/clip.mp4)")
+(content-test "audio markdown" (asMarkdown a) "[audio](/song.mp3)")
+
+;; ── html escapes src ──
+(content-test
+  "media html escapes"
+  (asHTML (mk-video "v" "/a.mp4?x=1&y=2"))
+  "<video src=\"/a.mp4?x=1&amp;y=2\" controls></video>")
+
+;; ── in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "Watch"))
+    v))
+(content-test
+  "doc with media html"
+  (asHTML d)
+  "<h1>Watch</h1><video src=\"/clip.mp4\" controls></video>")
+
+;; ── validation ──
+(content-test
+  "valid media"
+  (content/valid? (doc-append (doc-empty "d") v))
+  true)
+(content-test
+  "bad media kind flagged"
+  (content/issue-kinds
+    (doc-append (doc-empty "d") (mk-media "m" "movie" "/x")))
+  (list "field"))

lib/content/tests/meta.sx

@@ -0,0 +1,79 @@
+;; Extension — document metadata (title/slug/tags) + Ghost title plumbing.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+(define d (doc-empty "post"))
+
+;; ── defaults ──
+(content-test "default title nil" (doc-title d) nil)
+(content-test "default slug nil" (doc-slug d) nil)
+(content-test "default tags empty" (doc-tags d) (list))
+
+;; ── copy-on-write setters ──
+(define d2 (doc-with-title d "Hello World"))
+(content-test "with-title" (doc-title d2) "Hello World")
+(content-test "with-title immutable" (doc-title d) nil)
+(content-test "with-title keeps id" (doc-id d2) "post")
+
+(define d3 (doc-with-slug (doc-with-title d "T") "my-slug"))
+(content-test "with-slug" (doc-slug d3) "my-slug")
+(content-test "title preserved with slug" (doc-title d3) "T")
+
+(define d4 (doc-with-tags d (list "a" "b")))
+(content-test "with-tags" (doc-tags d4) (list "a" "b"))
+(content-test "add-tag" (doc-tags (doc-add-tag d4 "c")) (list "a" "b" "c"))
+(content-test
+  "add-tag from empty"
+  (doc-tags (doc-add-tag d "x"))
+  (list "x"))
+
+;; ── batch + dict ──
+(define d5 (doc-with-meta d {:slug "s" :title "T" :tags (list "t1")}))
+(content-test "with-meta title" (doc-title d5) "T")
+(content-test "with-meta slug" (doc-slug d5) "s")
+(content-test "with-meta tags" (doc-tags d5) (list "t1"))
+(content-test
+  "with-meta partial leaves title"
+  (doc-title (doc-with-meta d {:slug "only"}))
+  nil)
+(content-test "doc-meta dict" (doc-meta d5) {:slug "s" :id "post" :title "T" :tags (list "t1")})
+
+;; ── constructor with metadata ──
+(define d6 (doc-new-meta "p2" (list (mk-text "x" "hi")) {:title "Post 2"}))
+(content-test "new-meta title" (doc-title d6) "Post 2")
+(content-test "new-meta blocks" (doc-ids d6) (list "x"))
+
+;; ── facade aliases ──
+(content-test "content/title" (content/title d5) "T")
+(content-test
+  "content/with-title"
+  (content/title (content/with-title d "Z"))
+  "Z")
+(content-test "content/meta" (content/meta d5) (doc-meta d5))
+
+;; ── metadata coexists with block ops ──
+(define
+  d7
+  (doc-append
+    (doc-with-title (doc-empty "x") "Titled")
+    (mk-text "p" "body")))
+(content-test "meta + blocks coexist" (doc-ids d7) (list "p"))
+(content-test "meta survives append" (doc-title d7) "Titled")
+(content-test
+  "meta survives edit"
+  (doc-title (doc-update d7 "p" "text" "changed"))
+  "Titled")
+
+;; ── Ghost adapter now carries title ──
+(define post {:sections (list {:id "h" :text "Hi" :kind "heading" :level 1}) :title "My Post"})
+(define gd (content/import ghost-adapter post "post"))
+(content-test "ghost import title" (doc-title gd) "My Post")
+(content-test
+  "ghost export title"
+  (get (content/export ghost-adapter gd) :title)
+  "My Post")
+(content-test
+  "ghost title round-trip"
+  (doc-title (content/round-trip ghost-adapter gd))
+  "My Post")

lib/content/tests/move.sx

@@ -0,0 +1,63 @@
+;; Extension — relative block reorder.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-text "a" "A"))
+      (mk-text "b" "B"))
+    (mk-text "c" "C")))
+
+;; ── move-before ──
+(content-test
+  "move-before"
+  (doc-ids (content/move-before d "c" "a"))
+  (list "c" "a" "b"))
+(content-test
+  "move-before mid"
+  (doc-ids (content/move-before d "c" "b"))
+  (list "a" "c" "b"))
+(content-test "move-before immutable" (doc-ids d) (list "a" "b" "c"))
+
+;; ── move-after ──
+(content-test
+  "move-after"
+  (doc-ids (content/move-after d "a" "b"))
+  (list "b" "a" "c"))
+(content-test
+  "move-after last"
+  (doc-ids (content/move-after d "a" "c"))
+  (list "b" "c" "a"))
+
+;; ── move-to-front / back ──
+(content-test
+  "move-to-front"
+  (doc-ids (content/move-to-front d "c"))
+  (list "c" "a" "b"))
+(content-test
+  "move-to-back"
+  (doc-ids (content/move-to-back d "a"))
+  (list "b" "c" "a"))
+(content-test
+  "front already first"
+  (doc-ids (content/move-to-front d "a"))
+  (list "a" "b" "c"))
+
+;; ── no-ops ──
+(content-test
+  "missing id no-op"
+  (doc-ids (content/move-before d "zzz" "a"))
+  (list "a" "b" "c"))
+(content-test
+  "missing target no-op"
+  (doc-ids (content/move-before d "a" "zzz"))
+  (list "a" "b" "c"))
+
+;; ── render after move ──
+(content-test
+  "render after move"
+  (asHTML (content/move-after d "a" "c"))
+  "<p>B</p><p>C</p><p>A</p>")

lib/content/tests/normalize.sx

@@ -0,0 +1,99 @@
+;; Extension — document normalization (drop empty text blocks + empty sections).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; ── drop empty text blocks ──
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "h" 1 "Hi"))
+      (mk-text "empty" ""))
+    (mk-text "p" "Body")))
+(content-test
+  "drops empty text"
+  (doc-ids (content/normalize d))
+  (list "h" "p"))
+(content-test "normalize immutable" (doc-ids d) (list "h" "empty" "p"))
+(content-test
+  "keeps non-empty text"
+  (str (blk-send (doc-find (content/normalize d) "p") "text"))
+  "Body")
+
+;; ── drop empty sections ──
+(define
+  d2
+  (doc-append
+    (doc-append (doc-empty "d") (mk-text "p" "x"))
+    (mk-section "empty-sec" (list))))
+(content-test
+  "drops empty section"
+  (doc-ids (content/normalize d2))
+  (list "p"))
+
+;; ── section that becomes empty (all children dropped) is itself dropped ──
+(define
+  d3
+  (doc-append
+    (doc-empty "d")
+    (mk-section "s" (list (mk-text "e1" "") (mk-text "e2" "")))))
+(content-test
+  "section emptied then dropped"
+  (doc-ids (content/normalize d3))
+  (list))
+
+;; ── section with some content keeps surviving children ──
+(define
+  d4
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "s"
+      (list (mk-text "e" "") (mk-heading "k" 2 "Keep")))))
+(define n4 (content/normalize d4))
+(content-test "section kept" (doc-ids n4) (list "s"))
+(content-test
+  "empty child dropped, real kept"
+  (doc-tree-ids n4)
+  (list "s" "k"))
+
+;; ── nested: empty deep section removed, content bubbles correctly ──
+(define
+  d5
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "outer"
+      (list (mk-text "a" "A") (mk-section "inner" (list (mk-text "x" "")))))))
+(content-test
+  "nested empty inner dropped"
+  (doc-tree-ids (content/normalize d5))
+  (list "outer" "a"))
+
+;; ── already-clean doc unchanged ──
+(define
+  clean
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "h" 1 "T"))
+    (mk-text "p" "B")))
+(content-test
+  "clean doc unchanged ids"
+  (doc-ids (content/normalize clean))
+  (list "h" "p"))
+(content-test
+  "clean doc render"
+  (asHTML (content/normalize clean))
+  (asHTML clean))
+
+;; ── non-text empties preserved (divider, image with empty alt) ──
+(define
+  d6
+  (doc-append
+    (doc-append (doc-empty "d") (mk-divider "dv"))
+    (mk-image "i" "/a.png" "")))
+(content-test
+  "divider + image kept"
+  (doc-ids (content/normalize d6))
+  (list "dv" "i"))

lib/content/tests/outline.sx

@@ -0,0 +1,78 @@
+;; Extension — nested document outline.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+;; H1 / H2 H2 / H1  ->  [h1{children: h2,h3}, h4]
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "a" 1 "A"))
+        (mk-heading "b" 2 "B"))
+      (mk-heading "c" 2 "C"))
+    (mk-heading "e" 1 "E")))
+
+(define o (content/outline d))
+(content-test "outline top count" (len o) 2)
+(content-test "outline first id" (get (first o) :id) "a")
+(content-test
+  "outline first children ids"
+  (map (fn (n) (get n :id)) (get (first o) :children))
+  (list "b" "c"))
+(content-test "outline second top" (get (nth o 1) :id) "e")
+(content-test
+  "outline second no children"
+  (get (nth o 1) :children)
+  (list))
+
+;; ── deeper nesting: H1 / H2 / H3 ──
+(define
+  d2
+  (doc-append
+    (doc-append
+      (doc-append (doc-empty "d") (mk-heading "x" 1 "X"))
+      (mk-heading "y" 2 "Y"))
+    (mk-heading "z" 3 "Z")))
+(define o2 (content/outline d2))
+(content-test "deep top" (get (first o2) :id) "x")
+(content-test
+  "deep child"
+  (get (first (get (first o2) :children)) :id)
+  "y")
+(content-test
+  "deep grandchild"
+  (get (first (get (first (get (first o2) :children)) :children)) :id)
+  "z")
+
+;; ── node carries text + level ──
+(content-test "node text" (get (first o) :text) "A")
+(content-test "node level" (get (first o) :level) 1)
+
+;; ── empty / no headings ──
+(content-test "outline empty" (content/outline (doc-empty "e")) (list))
+(content-test
+  "outline no headings"
+  (content/outline (doc-append (doc-empty "d") (mk-text "p" "x")))
+  (list))
+
+;; ── starting at H2 (no H1) still forms a forest ──
+(define
+  d3
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "p" 2 "P"))
+    (mk-heading "q" 2 "Q")))
+(content-test "no-h1 forest count" (len (content/outline d3)) 2)
+
+;; ── headings nested inside sections are found (tree-wide via query) ──
+(define
+  d4
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "top" 1 "Top"))
+    (mk-section "s" (list (mk-heading "in" 2 "In")))))
+(content-test
+  "section heading nested in outline"
+  (map (fn (n) (get n :id)) (get (first (content/outline d4)) :children))
+  (list "in"))

lib/content/tests/page-full.sx

@@ -0,0 +1,39 @@
+;; Extension — SEO-complete HTML page (lang + meta description).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-text!)
+
+(define
+  d
+  (doc-with-title
+    (doc-append
+      (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+      (mk-text "p" "Hello world"))
+    "My Title"))
+
+(content-test
+  "page-full"
+  (content/page-full d)
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>My Title</title><meta name=\"description\" content=\"Hi Hello world\"></head><body><h1>Hi</h1><p>Hello world</p></body></html>")
+
+;; description escaped
+(content-test
+  "page-full escapes description"
+  (content/page-full
+    (doc-with-title
+      (doc-append (doc-empty "x") (mk-text "p" "a < b & c"))
+      "T"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>T</title><meta name=\"description\" content=\"a &lt; b &amp; c\"></head><body><p>a &lt; b &amp; c</p></body></html>")
+
+;; title falls back to id, empty description for empty doc
+(content-test
+  "page-full empty"
+  (content/page-full (doc-empty "fallback"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>fallback</title><meta name=\"description\" content=\"\"></head><body></body></html>")
+
+;; body reflects edits
+(content-test
+  "page-full reflects edits"
+  (content/page-full (doc-update d "p" "text" "Bye now"))
+  "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\"><title>My Title</title><meta name=\"description\" content=\"Hi Bye now\"></head><body><h1>Hi</h1><p>Bye now</p></body></html>")

lib/content/tests/page.sx

@@ -0,0 +1,42 @@
+;; Extension — full HTML page wrapper.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+
+(define
+  d
+  (doc-with-title
+    (doc-append (doc-empty "post") (mk-heading "h" 1 "Hi"))
+    "My Title"))
+
+(content-test
+  "page"
+  (content/page d)
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>My Title</title></head><body><h1>Hi</h1></body></html>")
+
+(content-test
+  "page title escaped"
+  (content/page (doc-with-title (doc-empty "x") "A < B"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>A &lt; B</title></head><body></body></html>")
+
+(content-test
+  "page falls back to id"
+  (content/page (doc-empty "fallback"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>fallback</title></head><body></body></html>")
+
+(content-test "page-title from meta" (content/page-title d) "My Title")
+(content-test
+  "page-title fallback id"
+  (content/page-title (doc-empty "z"))
+  "z")
+
+(content-test
+  "page body reflects edits"
+  (content/page (doc-update d "h" "text" "Bye"))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>My Title</title></head><body><h1>Bye</h1></body></html>")
+
+(content-test
+  "page multi-block body"
+  (content/page
+    (doc-append (doc-with-title (doc-empty "p") "T") (mk-text "x" "para")))
+  "<!doctype html><html><head><meta charset=\"utf-8\"><title>T</title></head><body><p>para</p></body></html>")

lib/content/tests/query.sx

@@ -0,0 +1,89 @@
+;; Extension — block query + table of contents.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-section!)
+
+(define
+  d
+  (doc-append
+    (doc-append
+      (doc-append
+        (doc-append (doc-empty "d") (mk-heading "h1" 1 "Intro"))
+        (mk-text "p1" "para"))
+      (mk-image "img" "/a.png" "alt"))
+    (mk-section
+      "s"
+      (list
+        (mk-heading "h2" 2 "Sub")
+        (mk-text "p2" "more")
+        (mk-image "img2" "/b.png" "b")))))
+
+;; ── select-type (tree-wide) ──
+(content-test
+  "select headings ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "heading"))
+  (list "h1" "h2"))
+(content-test
+  "select images ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "image"))
+  (list "img" "img2"))
+(content-test
+  "select text ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "text"))
+  (list "p1" "p2"))
+(content-test
+  "select section ids"
+  (map (fn (b) (blk-id b)) (content/select-type d "section"))
+  (list "s"))
+
+;; ── count-type ──
+(content-test "count headings" (content/count-type d "heading") 2)
+(content-test "count images" (content/count-type d "image") 2)
+(content-test "count dividers" (content/count-type d "divider") 0)
+
+;; ── select with custom predicate ──
+(content-test
+  "select-ids custom"
+  (content/select-ids d (fn (b) (= (blk-type b) "image")))
+  (list "img" "img2"))
+(content-test
+  "select custom field"
+  (map
+    (fn (b) (blk-id b))
+    (content/select
+      d
+      (fn
+        (b)
+        (if
+          (= (blk-type b) "heading")
+          (= (blk-get b "level") 2)
+          false))))
+  (list "h2"))
+
+;; ── headings / TOC ──
+(content-test
+  "headings TOC"
+  (content/headings d)
+  (list {:id "h1" :text "Intro" :level 1} {:id "h2" :text "Sub" :level 2}))
+(content-test
+  "empty doc no headings"
+  (content/headings (doc-empty "e"))
+  (list))
+
+;; ── deeply nested ──
+(define
+  deep
+  (doc-append
+    (doc-empty "d")
+    (mk-section
+      "o"
+      (list (mk-section "i" (list (mk-heading "deep" 3 "Deep")))))))
+(content-test
+  "deep heading found"
+  (map (fn (b) (blk-id b)) (content/select-type deep "heading"))
+  (list "deep"))
+(content-test
+  "deep toc level"
+  (get (first (content/headings deep)) :level)
+  3)

lib/content/tests/render.sx

@@ -0,0 +1,135 @@
+;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on
+;; blocks and the document. Escaping happens at the boundary.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+(content-bootstrap-render!)
+
+(define h (mk-heading "h" 2 "Title"))
+(define p (mk-text "p" "Hello"))
+(define code (mk-code "c" "sx" "(+ 1 2)"))
+(define q (mk-quote "q" "Ada" "to err"))
+(define img (mk-image "i" "/c.png" "cat"))
+(define em (mk-embed "e" "https://v/1" "vimeo"))
+(define dv (mk-divider "d"))
+(define ul (mk-list "u" false (list "a" "b")))
+(define ol (mk-list "o" true (list "x" "y")))
+
+;; ── per-block asHTML ──
+(content-test "heading html" (asHTML h) "<h2>Title</h2>")
+(content-test "text html" (asHTML p) "<p>Hello</p>")
+(content-test
+  "code html"
+  (asHTML code)
+  "<pre><code class=\"language-sx\">(+ 1 2)</code></pre>")
+(content-test "quote html" (asHTML q) "<blockquote>to err</blockquote>")
+(content-test "image html" (asHTML img) "<img src=\"/c.png\" alt=\"cat\">")
+(content-test "embed html" (asHTML em) "<iframe src=\"https://v/1\"></iframe>")
+(content-test "divider html" (asHTML dv) "<hr>")
+(content-test "ul html" (asHTML ul) "<ul><li>a</li><li>b</li></ul>")
+(content-test "ol html" (asHTML ol) "<ol><li>x</li><li>y</li></ol>")
+
+;; ── per-block asSx ──
+(content-test "heading sx" (asSx h) "(h2 \"Title\")")
+(content-test "text sx" (asSx p) "(p \"Hello\")")
+(content-test "code sx" (asSx code) "(pre (code \"(+ 1 2)\"))")
+(content-test "quote sx" (asSx q) "(blockquote \"to err\")")
+(content-test "image sx" (asSx img) "(img :src \"/c.png\" :alt \"cat\")")
+(content-test "embed sx" (asSx em) "(iframe :src \"https://v/1\")")
+(content-test "divider sx" (asSx dv) "(hr)")
+(content-test "ul sx" (asSx ul) "(ul (li \"a\")(li \"b\"))")
+(content-test "ol sx" (asSx ol) "(ol (li \"x\")(li \"y\"))")
+
+;; ── document folds children (pure message dispatch) ──
+(define d (doc-append (doc-append (doc-append (doc-empty "doc") h) p) dv))
+(content-test "doc html" (asHTML d) "<h2>Title</h2><p>Hello</p><hr>")
+(content-test "doc sx" (asSx d) "(article (h2 \"Title\")(p \"Hello\")(hr))")
+(content-test "empty doc html" (asHTML (doc-empty "e")) "")
+(content-test "empty doc sx" (asSx (doc-empty "e")) "(article )")
+
+;; ── render-* / block-* aliases ──
+(content-test "render-html alias" (render-html d) (asHTML d))
+(content-test "render-sx alias" (render-sx d) (asSx d))
+(content-test "block-html alias" (block-html h) "<h2>Title</h2>")
+
+;; ── render reflects edits (immutability: each render is of a version) ──
+(define d2 (doc-update d "p" "text" "Edited"))
+(content-test
+  "render after update"
+  (asHTML d2)
+  "<h2>Title</h2><p>Edited</p><hr>")
+(content-test
+  "original render unchanged"
+  (asHTML d)
+  "<h2>Title</h2><p>Hello</p><hr>")
+(content-test
+  "render after move"
+  (asHTML (doc-move d "h" 2))
+  "<p>Hello</p><hr><h2>Title</h2>")
+(content-test
+  "render after delete"
+  (asHTML (doc-delete d "p"))
+  "<h2>Title</h2><hr>")
+
+;; ── HTML escaping at the boundary ──
+(define xh (mk-heading "xh" 2 "A < B & \"C\""))
+(define xp (mk-text "xp" "<script>alert(1)</script>"))
+(define xi (mk-image "xi" "/a.png?x=1&y=2" "tag <b>"))
+(define xl (mk-list "xl" false (list "a<1" "b&2")))
+(content-test
+  "escape heading text"
+  (asHTML xh)
+  "<h2>A &lt; B &amp; &quot;C&quot;</h2>")
+(content-test
+  "escape paragraph"
+  (asHTML xp)
+  "<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
+(content-test
+  "escape image attrs"
+  (asHTML xi)
+  "<img src=\"/a.png?x=1&amp;y=2\" alt=\"tag &lt;b&gt;\">")
+(content-test
+  "escape list items"
+  (asHTML xl)
+  "<ul><li>a&lt;1</li><li>b&amp;2</li></ul>")
+(content-test
+  "escape ampersand once"
+  (asHTML (mk-text "amp" "a & b"))
+  "<p>a &amp; b</p>")
+(content-test
+  "escape in document"
+  (asHTML (doc-append (doc-empty "e") xp))
+  "<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
+(content-test
+  "no over-escape plain"
+  (asHTML (mk-text "plain" "hello world"))
+  "<p>hello world</p>")
+(content-test
+  "escape code body"
+  (asHTML (mk-code "xc" "html" "<div> & </div>"))
+  "<pre><code class=\"language-html\">&lt;div&gt; &amp; &lt;/div&gt;</code></pre>")
+
+;; ── asSx string-escaping (build expected via q/bs to avoid miscounts) ──
+(define q1 (str "\""))
+(define bs (str "\\"))
+(content-test
+  "asSx escapes quote"
+  (asSx (mk-text "qt" (str "say " q1 "hi" q1)))
+  (str "(p " q1 "say " bs q1 "hi" bs q1 q1 ")"))
+(content-test
+  "asSx escapes backslash"
+  (asSx (mk-text "qb" (str "a" bs "b")))
+  (str "(p " q1 "a" bs bs "b" q1 ")"))
+(content-test
+  "asSx plain unchanged"
+  (asSx (mk-text "pp" "plain"))
+  "(p \"plain\")")
+(content-test
+  "asSx escapes image attr"
+  (asSx (mk-image "im" (str "/a" q1) "x"))
+  (str "(img :src " q1 "/a" bs q1 q1 " :alt " q1 "x" q1 ")"))
+(content-test
+  "asSx escapes list item"
+  (asSx (mk-list "lq" false (list (str "i" q1) "j")))
+  (str "(ul (li " q1 "i" bs q1 q1 ")(li " q1 "j" q1 "))"))

lib/content/tests/section.sx

@@ -0,0 +1,99 @@
+;; Extension — nested block trees (CtSection container).
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-text!)
+(content-bootstrap-section!)
+
+(define nl (str "\n"))
+
+;; ── a section is a block ──
+(define
+  sec
+  (mk-section
+    "s"
+    (list (mk-heading "h" 2 "Hi") (mk-text "p" "Body"))))
+(content-test "section is block" (block? sec) true)
+(content-test "section? yes" (section? sec) true)
+(content-test "section? no on text" (section? (mk-text "x" "y")) false)
+(content-test "section type" (blk-type sec) "section")
+(content-test "section id" (blk-id sec) "s")
+(content-test
+  "section children count"
+  (len (section-children sec))
+  2)
+
+;; ── recursive render ──
+(content-test
+  "section html"
+  (asHTML sec)
+  "<section><h2>Hi</h2><p>Body</p></section>")
+(content-test "section sx" (asSx sec) "(section (h2 \"Hi\")(p \"Body\"))")
+(content-test "section text" (asText sec) "Hi Body")
+(content-test
+  "empty section html"
+  (asHTML (mk-section "e" (list)))
+  "<section></section>")
+
+;; ── nested in a document ──
+(define
+  d
+  (doc-append
+    (doc-append (doc-empty "d") (mk-heading "top" 1 "Top"))
+    sec))
+(content-test
+  "doc with section html"
+  (asHTML d)
+  "<h1>Top</h1><section><h2>Hi</h2><p>Body</p></section>")
+(content-test "doc top-level ids" (doc-ids d) (list "top" "s"))
+
+;; ── arbitrary depth ──
+(define
+  deep
+  (mk-section
+    "outer"
+    (list
+      (mk-text "a" "A")
+      (mk-section
+        "inner"
+        (list (mk-text "b" "B") (mk-heading "c" 3 "C"))))))
+(content-test
+  "deep html"
+  (asHTML deep)
+  "<section><p>A</p><section><p>B</p><h3>C</h3></section></section>")
+(content-test "deep text" (asText deep) "A B C")
+
+;; ── tree traversal descends into sections ──
+(define dd (doc-append (doc-empty "d") deep))
+(content-test "deep-find nested" (blk-id (doc-deep-find dd "b")) "b")
+(content-test
+  "deep-find deeper"
+  (str (blk-send (doc-deep-find dd "c") "text"))
+  "C")
+(content-test "deep-find missing" (doc-deep-find dd "zzz") nil)
+(content-test
+  "deep-find top-level"
+  (blk-id (doc-deep-find dd "outer"))
+  "outer")
+(content-test
+  "tree-ids flattened"
+  (doc-tree-ids dd)
+  (list "outer" "a" "inner" "b" "c"))
+(content-test "tree-count" (doc-tree-count dd) 5)
+(content-test "top-level ids still flat" (doc-ids dd) (list "outer"))
+
+;; ── copy-on-write child edits ──
+(define sec2 (section-append sec (mk-divider "dv")))
+(content-test "section-append" (len (section-children sec2)) 3)
+(content-test
+  "section-append immutable"
+  (len (section-children sec))
+  2)
+(content-test
+  "section-append renders"
+  (asHTML sec2)
+  "<section><h2>Hi</h2><p>Body</p><hr></section>")
+
+;; ── markdown of a section (children joined by blank line) ──
+(content-test "section markdown" (asMarkdown sec) (str "## Hi" nl nl "Body"))

lib/content/tests/snapshot.sx

@@ -0,0 +1,100 @@
+;; Extension — snapshot cache over op-log replay. The cache is transparent:
+;; cached reads equal full replays.
+
+(st-bootstrap-classes!)
+(content-bootstrap-blocks!)
+(content-bootstrap-doc!)
+
+(define B (persist/open))
+(define h (mk-heading "h" 1 "T"))
+(define p (mk-text "p" "Body"))
+(define img (mk-image "img" "/c.png" "cat"))
+
+(content/commit! B "post" (op-insert h nil) 1)
+(content/commit! B "post" (op-insert p "h") 2)
+(content/commit! B "post" (op-insert img "h") 3)
+(content/commit! B "post" (op-update "p" "text" "Edited") 4)
+
+;; ── no snapshot yet: cached == full replay ──
+(content-test
+  "no snapshot head-cached == head"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+(content-test
+  "has-snapshot? false initially"
+  (content/has-snapshot? B "post")
+  false)
+(content-test
+  "snapshot-seq 0 initially"
+  (content/snapshot-seq B "post")
+  0)
+
+;; ── take a snapshot at seq 4 ──
+(content-test "snapshot returns seq" (content/snapshot! B "post") 4)
+(content-test "has-snapshot? true" (content/has-snapshot? B "post") true)
+(content-test "snapshot-seq is 4" (content/snapshot-seq B "post") 4)
+
+;; cached head equals full head right after snapshot
+(content-test
+  "head-cached == head after snap"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "img" "p"))
+(content-test
+  "head-cached p value"
+  (str (blk-send (doc-find (content/head-cached B "post") "p") "text"))
+  "Edited")
+
+;; ── commit more after the snapshot; cached head replays only the tail ──
+(content/commit! B "post" (op-delete "img") 5)
+(content/commit! B "post" (op-insert (mk-text "q" "New") "p") 6)
+(content-test
+  "head-cached reflects post-snapshot ops"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+(content-test
+  "head-cached order"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "p" "q"))
+
+;; ── at-cached transparency across versions ──
+(content-test
+  "at-cached seq2 (before snap) == at"
+  (doc-ids (content/at-cached B "post" 2))
+  (doc-ids (content/at B "post" 2)))
+(content-test
+  "at-cached seq5 (after snap) == at"
+  (doc-ids (content/at-cached B "post" 5))
+  (doc-ids (content/at B "post" 5)))
+(content-test
+  "at-cached seq6 == at"
+  (doc-ids (content/at-cached B "post" 6))
+  (doc-ids (content/at B "post" 6)))
+(content-test
+  "at-cached seq4 == snapshot version"
+  (doc-ids (content/at-cached B "post" 4))
+  (list "h" "img" "p"))
+
+;; ── re-snapshot moves the cache forward ──
+(content-test "re-snapshot seq" (content/snapshot! B "post") 6)
+(content-test
+  "head-cached still correct after resnap"
+  (doc-ids (content/head-cached B "post"))
+  (list "h" "p" "q"))
+
+;; ── drop snapshot falls back to full replay, same result ──
+(content/drop-snapshot! B "post")
+(content-test "snapshot dropped" (content/has-snapshot? B "post") false)
+(content-test
+  "head-cached == head after drop"
+  (doc-ids (content/head-cached B "post"))
+  (doc-ids (content/head B "post")))
+
+;; ── snapshot of empty / fresh doc ──
+(content-test
+  "snapshot empty doc seq 0"
+  (content/snapshot! B "empty")
+  0)
+(content-test
+  "head-cached empty"
+  (doc-ids (content/head-cached B "empty"))
+  (list))