artdag: Phase 5 optimization — DCE + CSE + adjacent-op fusion + 18 tests

optimize.sx adds three result-preserving passes: dce (keep outputs + ancestors,
preserve ids), cse (==build; structural sharing is free from content addressing),
and fuse (collapse 1-to-1 fusible unary chains into an artdag/pipeline node fed by
the chain head's input; leaves/fan-out/non-fusible ops never fuse). fusing-runner
replays pipeline stages, output-equivalent to the unfused dag. optimize 18/18,
total 87/87.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/artdag/optimize.sx

@@ -0,0 +1,190 @@
+; lib/artdag/optimize.sx — Phase 5: result-preserving DAG rewrites.
+;   DCE    — drop nodes not reachable upstream from the requested outputs.
+;   CSE    — free from content addressing: structurally identical subexpressions
+;            already collapse to one node at build time (artdag/cse == build).
+;   Fusion — collapse a maximal 1-to-1 chain of fusible unary ops into a single
+;            "artdag/pipeline" node that replays the stages; output-equivalent.
+; Depends on dag.sx and analyze.sx.
+
+; ---- dict helper ----
+
+(define
+  artdag/-dict-filter
+  (fn
+    (d keep?)
+    (reduce
+      (fn (acc k) (if (keep? k (get d k)) (assoc acc k (get d k)) acc))
+      {}
+      (keys d))))
+
+(define
+  artdag/-union
+  (fn
+    (a b)
+    (reduce (fn (acc x) (if (artdag/member? x acc) acc (cons x acc))) a b)))
+
+; ---- dead-node elimination ----
+; keep only the outputs and their transitive dependencies; ids are preserved.
+(define
+  artdag/dce
+  (fn
+    (dag outputs)
+    (let
+      ((db (artdag/analyze dag)))
+      (let
+        ((live (reduce (fn (acc out) (artdag/-union (artdag/-union acc (list out)) (artdag/ancestors-of db out))) (list) outputs)))
+        {:names (artdag/-dict-filter (artdag/dag-names dag) (fn (k v) (artdag/member? v live))) :order (filter (fn (id) (artdag/member? id live)) (artdag/dag-order dag)) :ok true :nodes (artdag/-dict-filter (artdag/dag-nodes dag) (fn (k v) (artdag/member? k live)))}))))
+
+; ---- common-subexpression elimination ----
+; structural sharing is inherent to content addressing: build already maps
+; structurally identical specs to a single node/id.
+(define artdag/cse artdag/build)
+
+; ---- adjacent-op fusion (entry-level rewrite) ----
+
+(define artdag/pipeline-op "artdag/pipeline")
+
+(define
+  artdag/-name->entry
+  (fn
+    (entries)
+    (reduce
+      (fn (m e) (assoc m (artdag/entry-name e) e))
+      {}
+      entries)))
+
+; name -> list of dependent names
+(define
+  artdag/-deps-map
+  (fn
+    (entries)
+    (reduce
+      (fn
+        (m e)
+        (reduce
+          (fn
+            (mm i)
+            (assoc
+              mm
+              i
+              (cons
+                (artdag/entry-name e)
+                (if (has-key? mm i) (get mm i) (list)))))
+          m
+          (artdag/entry-inputs e)))
+      {}
+      entries)))
+
+(define artdag/-stage (fn (e) {:op (artdag/entry-op e) :params (artdag/entry-params e)}))
+
+; the single predecessor that `name` may absorb, or nil. Requires: name is a
+; fusible unary op; its one input is a locally-defined fusible node whose ONLY
+; dependent is name (so fusing cannot break sharing).
+(define
+  artdag/-absorbs
+  (fn
+    (n->e deps fusible? name)
+    (let
+      ((e (get n->e name)))
+      (let
+        ((ins (artdag/entry-inputs e)))
+        (if
+          (= (len ins) 1)
+          (let
+            ((x (first ins)))
+            (if
+              (and
+                (has-key? n->e x)
+                (fusible? (artdag/entry-op e))
+                (fusible? (artdag/entry-op (get n->e x)))
+                (= (get deps x) (list name)))
+              x
+              nil))
+          nil)))))
+
+(define
+  artdag/-absorbed-set
+  (fn
+    (n->e deps fusible? names)
+    (reduce
+      (fn
+        (acc y)
+        (let
+          ((p (artdag/-absorbs n->e deps fusible? y)))
+          (if (nil? p) acc (cons p acc))))
+      (list)
+      names)))
+
+; walk predecessors from a tail, building stages head->tail.
+(define
+  artdag/-fuse-chain
+  (fn
+    (n->e deps fusible? cur stages)
+    (let
+      ((p (artdag/-absorbs n->e deps fusible? cur)))
+      (if
+        (nil? p)
+        {:stages (cons (artdag/-stage (get n->e cur)) stages) :head cur}
+        (artdag/-fuse-chain
+          n->e
+          deps
+          fusible?
+          p
+          (cons (artdag/-stage (get n->e cur)) stages))))))
+
+(define
+  artdag/fuse-entries
+  (fn
+    (entries fusible?)
+    (let
+      ((n->e (artdag/-name->entry entries))
+        (deps (artdag/-deps-map entries))
+        (names (map artdag/entry-name entries)))
+      (let
+        ((absorbed (artdag/-absorbed-set n->e deps fusible? names)))
+        (map
+          (fn
+            (name)
+            (let
+              ((c (artdag/-fuse-chain n->e deps fusible? name (list))))
+              (if
+                (> (len (get c :stages)) 1)
+                (list
+                  name
+                  artdag/pipeline-op
+                  (artdag/entry-inputs (get n->e (get c :head)))
+                  {:stages (get c :stages)})
+                (get n->e name))))
+          (filter (fn (name) (not (artdag/member? name absorbed))) names))))))
+
+(define
+  artdag/fuse
+  (fn
+    (entries fusible?)
+    (artdag/build (artdag/fuse-entries entries fusible?))))
+
+; runner that replays a fused pipeline over its single input, delegating each
+; stage to a base runner; non-pipeline ops fall through unchanged.
+(define
+  artdag/pipeline-run
+  (fn
+    (base-runner)
+    (fn
+      (params inputs)
+      (reduce
+        (fn
+          (val stage)
+          (base-runner (get stage :op) (get stage :params) (list val)))
+        (first inputs)
+        (get params :stages)))))
+
+(define
+  artdag/fusing-runner
+  (fn
+    (base-runner)
+    (fn
+      (op params inputs)
+      (if
+        (= op artdag/pipeline-op)
+        ((artdag/pipeline-run base-runner) params inputs)
+        (base-runner op params inputs)))))