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:
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)))))
|
||||
Reference in New Issue
Block a user