artdag: Phase 1 DAG model + structural content addressing + 20 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s
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) <noreply@anthropic.com>
This commit is contained in:
107
lib/artdag/conformance.sh
Executable file
107
lib/artdag/conformance.sh
Executable file
@@ -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 ]
|
||||
226
lib/artdag/dag.sx
Normal file
226
lib/artdag/dag.sx
Normal file
@@ -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)))))
|
||||
8
lib/artdag/scoreboard.json
Normal file
8
lib/artdag/scoreboard.json
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
"suites": {
|
||||
"dag": {"pass": 20, "fail": 0}
|
||||
},
|
||||
"total_pass": 20,
|
||||
"total_fail": 0,
|
||||
"total": 20
|
||||
}
|
||||
8
lib/artdag/scoreboard.md
Normal file
8
lib/artdag/scoreboard.md
Normal file
@@ -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** |
|
||||
182
lib/artdag/tests/dag.sx
Normal file
182
lib/artdag/tests/dag.sx
Normal file
@@ -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"))))
|
||||
Reference in New Issue
Block a user