artdag: Phase 7 opt-reduce bridges maude normal form back to a runnable DAG + 8 tests

artdag/opt-reduce: encode a DAG cone -> opt-term, mau/creduce against the
optimisation module, decode the normal form back to build-entries and rebuild.
Result-preserving: a 5-node blur;blur;id;bright0 chain collapses to 2 nodes and an
over(I,I) dedup 3->2, both executing identically to the original; non-optimisable
DAGs round-trip their radius faithfully (unary 1+1+1 -> 3). Completes Phase 7's
bridge-back + equivalence boxes. maude-optimize 33/33, total 191/191.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-19 13:54:06 +00:00
parent 1fd3aea81b
commit 55ce2a86c5
5 changed files with 254 additions and 16 deletions

View File

@@ -7,8 +7,8 @@
; successor rules (s M + N = s(M+N), 0 + N = N) are NOT confluent here (the symbolic
; critical pairs M + 0 and (A+B)+C vs A+(B+C) stick), whereas [assoc comm id: 0]
; joins them via canonical form. maude (lib/maude) is a READ-ONLY consumed substrate:
; mau/parse-module, mau/creduce-term, mau/creduce->str, mau/ccanon, mau/confluent?,
; mau/non-joinable-pairs, mau/cp->str.
; mau/parse-module, mau/creduce, mau/creduce->str, mau/ccanon, mau/confluent?,
; mau/non-joinable-pairs, mau/cp->str, mau/app/const/op/args/app?.
(define
artdag/opt-module-src
@@ -34,7 +34,12 @@
(define artdag/opt-module (mau/parse-module artdag/opt-module-src))
; ---- reduce a surface pipeline to its optimised normal form ----
; ops whose last term arg is the radius (Num); other args are image inputs.
(define artdag/opt-radius-ops (list "blur" "bright"))
; commutative ops (mirror the content-id's order-insensitivity).
(define artdag/opt-comm-ops (list "over"))
; ---- reduce a surface pipeline (source string) to its optimised normal form ----
(define
artdag/opt-reduce-term
@@ -67,3 +72,117 @@
(map
(fn (cp) (mau/cp->str artdag/opt-module cp))
(artdag/opt-non-joinable))))
; ---- radius <-> unary Num term ----
(define
artdag/num->unary
(fn
(n)
(if
(<= n 0)
(mau/const "0")
(reduce
(fn (acc i) (mau/app "_+_" (list acc (mau/const "1"))))
(mau/const "1")
(range 1 n)))))
(define
artdag/unary->num
(fn
(t)
(let
((op (mau/op t)))
(cond
((= op "1") 1)
((= op "_+_")
(reduce
(fn (a x) (+ a (artdag/unary->num x)))
0
(mau/args t)))
(else 0)))))
; ---- dag cone -> opt-term ----
; leaves -> nullary const (op name); a :radius node -> op(inputs..., unary radius);
; any other op -> op(inputs...). over (commutative) maps to the module's comm op.
(define
artdag/dag->opt-term
(fn
(dag id)
(let
((node (artdag/dag-get dag id)))
(let
((op (artdag/node-op node))
(ins
(map
(fn (i) (artdag/dag->opt-term dag i))
(artdag/node-inputs node)))
(params (artdag/node-params node)))
(if
(empty? ins)
(mau/const op)
(if
(artdag/member? op artdag/opt-radius-ops)
(mau/app
op
(concat ins (list (artdag/num->unary (get params :radius)))))
(mau/app op ins)))))))
; ---- opt-term -> build entries (synthesized names; build recomputes content-ids) ----
(define
artdag/opt-last
(fn
(xs)
(if (empty? (rest xs)) (first xs) (artdag/opt-last (rest xs)))))
(define
artdag/opt-but-last
(fn
(xs)
(if
(empty? (rest xs))
(list)
(cons (first xs) (artdag/opt-but-last (rest xs))))))
(define
artdag/opt-term->build
(fn
(t counter acc)
(if
(not (mau/app? t))
(let ((nm (str "ob" counter))) {:name nm :acc (concat acc (list (list nm (mau/op t) (list) {}))) :counter (+ counter 1)})
(let
((op (mau/op t))
(radius? (artdag/member? (mau/op t) artdag/opt-radius-ops)))
(let
((in-terms (if radius? (artdag/opt-but-last (mau/args t)) (mau/args t)))
(params (if radius? {:radius (artdag/unary->num (artdag/opt-last (mau/args t)))} {}))
(comm? (artdag/member? op artdag/opt-comm-ops)))
(let
((built (reduce (fn (st ct) (let ((r (artdag/opt-term->build ct (get st :counter) (get st :acc)))) {:acc (get r :acc) :counter (get r :counter) :names (concat (get st :names) (list (get r :name)))})) {:acc acc :counter counter :names (list)} in-terms)))
(let ((nm (str "ob" (get built :counter)))) {:name nm :acc (concat (get built :acc) (list (list nm op (get built :names) params comm?))) :counter (+ (get built :counter) 1)})))))))
(define
artdag/opt-term->entries
(fn (t) (get (artdag/opt-term->build t 0 (list)) :acc)))
; ---- optimise a DAG via maude: encode -> creduce -> decode -> rebuild ----
; result-preserving: the optimised DAG executes to the same result as the original.
(define
artdag/opt-reduce
(fn
(dag id)
(artdag/build
(artdag/opt-term->entries
(mau/creduce artdag/opt-module (artdag/dag->opt-term dag id))))))
; content-id of the optimised sink (the head of the reduced term's rebuilt DAG).
(define
artdag/opt-reduce-sink
(fn
(dag id)
(let
((o (artdag/opt-reduce dag id)))
(artdag/opt-last (artdag/dag-order o)))))