From e4a8dff9ba2c4e807bcc374e9f9d77540b2eb10e Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 11:49:43 +0000 Subject: [PATCH] artdag: Phase 1 DAG model + structural content addressing + 20 tests Content-addressed node = {:op :inputs :params :commutative}; content-id is a deterministic canonical serialization (sorted param keys; commutative ops sort inputs). artdag/build validates dangling/cycles, topo-sorts, dedups identical subgraphs to one id shared across DAGs. conformance.sh + scoreboard (dag 20/20). Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/artdag/conformance.sh | 107 ++++++++++++++++++ lib/artdag/dag.sx | 226 +++++++++++++++++++++++++++++++++++++ lib/artdag/scoreboard.json | 8 ++ lib/artdag/scoreboard.md | 8 ++ lib/artdag/tests/dag.sx | 182 +++++++++++++++++++++++++++++ plans/artdag-on-sx.md | 25 ++-- 6 files changed, 549 insertions(+), 7 deletions(-) create mode 100755 lib/artdag/conformance.sh create mode 100644 lib/artdag/dag.sx create mode 100644 lib/artdag/scoreboard.json create mode 100644 lib/artdag/scoreboard.md create mode 100644 lib/artdag/tests/dag.sx diff --git a/lib/artdag/conformance.sh b/lib/artdag/conformance.sh new file mode 100755 index 00000000..5424ae49 --- /dev/null +++ b/lib/artdag/conformance.sh @@ -0,0 +1,107 @@ +#!/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) + +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/artdag/dag.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 ] diff --git a/lib/artdag/dag.sx b/lib/artdag/dag.sx new file mode 100644 index 00000000..e9e4ba24 --- /dev/null +++ b/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= 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/strstring 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))))) diff --git a/lib/artdag/scoreboard.json b/lib/artdag/scoreboard.json new file mode 100644 index 00000000..1ca0b565 --- /dev/null +++ b/lib/artdag/scoreboard.json @@ -0,0 +1,8 @@ +{ + "suites": { + "dag": {"pass": 20, "fail": 0} + }, + "total_pass": 20, + "total_fail": 0, + "total": 20 +} diff --git a/lib/artdag/scoreboard.md b/lib/artdag/scoreboard.md new file mode 100644 index 00000000..34e8136d --- /dev/null +++ b/lib/artdag/scoreboard.md @@ -0,0 +1,8 @@ +# artdag Conformance Scoreboard + +_Generated by `lib/artdag/conformance.sh`_ + +| Suite | Pass | Fail | Total | +|-------|-----:|-----:|------:| +| dag | 20 | 0 | 20 | +| **Total** | **20** | **0** | **20** | diff --git a/lib/artdag/tests/dag.sx b/lib/artdag/tests/dag.sx new file mode 100644 index 00000000..f92d90ed --- /dev/null +++ b/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")))) diff --git a/plans/artdag-on-sx.md b/plans/artdag-on-sx.md index 6fe7a2ce..bf5aed91 100644 --- a/plans/artdag-on-sx.md +++ b/plans/artdag-on-sx.md @@ -30,7 +30,7 @@ edges. ## Status (rolling) -`bash lib/artdag/conformance.sh` → **0/0** (not yet started) +`bash lib/artdag/conformance.sh` → **20/20** (1 suite: dag) ## Ground rules @@ -78,13 +78,13 @@ lib/artdag/optimize.sx lib/artdag/federation.sx ## Phase 1 — DAG model + content addressing -- [ ] `lib/artdag/dag.sx` — node `{:op :inputs :params}`; structural content-id = +- [x] `lib/artdag/dag.sx` — node `{:op :inputs :params}`; structural content-id = digest of `(op, sorted input-ids, params)`; build/validate a DAG (no dangling inputs, no accidental cycles); topological order -- [ ] identical-subgraph sharing: two structurally-equal nodes get the same id -- [ ] `lib/artdag/tests/dag.sx` — id determinism, subgraph sharing, cycle/dangling +- [x] identical-subgraph sharing: two structurally-equal nodes get the same id +- [x] `lib/artdag/tests/dag.sx` — id determinism, subgraph sharing, cycle/dangling rejection, topo order -- [ ] `lib/artdag/conformance.sh` + scoreboard +- [x] `lib/artdag/conformance.sh` + scoreboard ## Phase 2 — Analyze (Datalog) @@ -136,8 +136,19 @@ lib/artdag/optimize.sx lib/artdag/federation.sx ## Progress log -(loop fills this in) +- **Phase 1 — DAG model + content addressing** (dag suite 20/20). `lib/artdag/dag.sx`: + node `{:op :inputs :params :commutative}`; `artdag/content-id` = `"node:"` + a + deterministic canonical serialization of `(op, inputs, params)` with dict keys + sorted (param order-insensitive) and commutative ops' inputs sorted (input + order-insensitive); non-commutative inputs ordered. `artdag/build` takes named + entries `(name op (input-names) params [commutative?])`, validates (dangling refs, + cycles via fixpoint topo), resolves input-names→content-ids, dedups identical + subgraphs to one node + one id (shared across DAGs), returns `{:ok :nodes :names + :order}`. No host `sort`/`string