rose-ash/lib/artdag/dag.sx

; 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)))))