artdag: maude-bridge dag<->term adapter + 14 round-trip tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
118
lib/artdag/maude-bridge.sx
Normal file
118
lib/artdag/maude-bridge.sx
Normal file
@@ -0,0 +1,118 @@
|
||||
; lib/artdag/maude-bridge.sx — adapter between an artdag effect DAG and maude terms.
|
||||
; A node {:op :inputs :params :commutative} <-> a maude (mau/app op (args...)).
|
||||
; Inputs become argument subterms (recursively from the DAG). A trailing
|
||||
; "artdag:meta" subterm carries the params (a write-to-string token) and the
|
||||
; commutativity flag, so the encoding is lossless and dag->term->dag is the
|
||||
; identity on canonical (content-id) form. Commutative ops map to maude AC
|
||||
; operators in the optimizer module, so input order is irrelevant there —
|
||||
; mirroring the content-id's order-insensitivity for commutative nodes.
|
||||
;
|
||||
; maude (lib/maude) is a READ-ONLY consumed substrate: mau/app, mau/const,
|
||||
; mau/op, mau/args, mau/app? are its term constructors/accessors.
|
||||
|
||||
; ---- list helpers (no host last/but-last) ----
|
||||
|
||||
(define
|
||||
artdag/mb-last
|
||||
(fn
|
||||
(xs)
|
||||
(if (empty? (rest xs)) (first xs) (artdag/mb-last (rest xs)))))
|
||||
|
||||
(define
|
||||
artdag/mb-but-last
|
||||
(fn
|
||||
(xs)
|
||||
(if
|
||||
(empty? (rest xs))
|
||||
(list)
|
||||
(cons (first xs) (artdag/mb-but-last (rest xs))))))
|
||||
|
||||
; ---- params <-> token ----
|
||||
; params are keyword-keyed dicts; write-to-string/read round-trips them
|
||||
; (key order may differ but the dicts compare structurally equal).
|
||||
|
||||
(define artdag/mb-meta-op "artdag:meta")
|
||||
|
||||
(define artdag/params->token (fn (params) (write-to-string params)))
|
||||
|
||||
(define artdag/token->params (fn (token) (read (open-input-string token))))
|
||||
|
||||
(define
|
||||
artdag/mb-meta-term
|
||||
(fn
|
||||
(params commutative)
|
||||
(mau/app
|
||||
artdag/mb-meta-op
|
||||
(list
|
||||
(mau/const (artdag/params->token params))
|
||||
(mau/const (if commutative "c" "n"))))))
|
||||
|
||||
(define
|
||||
artdag/mb-meta-term?
|
||||
(fn (t) (and (mau/app? t) (= (mau/op t) artdag/mb-meta-op))))
|
||||
|
||||
; ---- dag -> term ----
|
||||
|
||||
(define
|
||||
artdag/node->term
|
||||
(fn
|
||||
(node input-terms)
|
||||
(mau/app
|
||||
(artdag/node-op node)
|
||||
(concat
|
||||
input-terms
|
||||
(list
|
||||
(artdag/mb-meta-term
|
||||
(artdag/node-params node)
|
||||
(get node :commutative)))))))
|
||||
|
||||
(define
|
||||
artdag/dag->term
|
||||
(fn
|
||||
(dag id)
|
||||
(let
|
||||
((node (artdag/dag-get dag id)))
|
||||
(artdag/node->term
|
||||
node
|
||||
(map (fn (in) (artdag/dag->term dag in)) (artdag/node-inputs node))))))
|
||||
|
||||
; ---- term -> dag ----
|
||||
; build-entries with synthesized local names; artdag/build recomputes content-ids
|
||||
; (which are name-independent), so the reconstructed dag is identical on canonical
|
||||
; form. Shared subterms re-collapse to one node/id during build's dedup.
|
||||
|
||||
(define artdag/term-meta (fn (t) (artdag/mb-last (mau/args t))))
|
||||
|
||||
(define artdag/term-input-terms (fn (t) (artdag/mb-but-last (mau/args t))))
|
||||
|
||||
(define
|
||||
artdag/term-params
|
||||
(fn
|
||||
(t)
|
||||
(artdag/token->params (mau/op (first (mau/args (artdag/term-meta t)))))))
|
||||
|
||||
(define
|
||||
artdag/term-commutative
|
||||
(fn
|
||||
(t)
|
||||
(= "c" (mau/op (nth (mau/args (artdag/term-meta t)) 1)))))
|
||||
|
||||
(define
|
||||
artdag/term->build
|
||||
(fn
|
||||
(t counter acc)
|
||||
(let
|
||||
((built (reduce (fn (st child) (let ((r (artdag/term->build child (get st :counter) (get st :acc)))) {:counter (get r :counter) :acc (get r :acc) :names (concat (get st :names) (list (get r :name)))})) {:counter counter :acc acc :names (list)} (artdag/term-input-terms t))))
|
||||
(let ((my-name (str "mb" (get built :counter)))) {:name my-name :counter (+ (get built :counter) 1) :acc (concat (get built :acc) (list (list my-name (mau/op t) (get built :names) (artdag/term-params t) (artdag/term-commutative t))))}))))
|
||||
|
||||
(define
|
||||
artdag/term->entries
|
||||
(fn (t) (get (artdag/term->build t 0 (list)) :acc)))
|
||||
|
||||
(define artdag/term->dag (fn (t) (artdag/build (artdag/term->entries t))))
|
||||
|
||||
; ---- round-trip convenience ----
|
||||
|
||||
(define
|
||||
artdag/mb-roundtrip
|
||||
(fn (dag id) (artdag/term->dag (artdag/dag->term dag id))))
|
||||
Reference in New Issue
Block a user