giles
3432a72510
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>
119 lines
3.7 KiB
Plaintext
119 lines
3.7 KiB
Plaintext
; 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))))
|