relations: tree/DAG queries (common-ancestors, lca, topo-order) in SX + 16 tests

lib/relations/tree.sx over reach/ancestors/rnode — no new Datalog closures. 126/126.

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

lib/relations/tree.sx

@@ -0,0 +1,118 @@
+;; lib/relations/tree.sx — tree/DAG queries: common ancestors, LCA, topo order.
+;;
+;; All computed in SX over the engine's fast `reach`/`ancestors`/`rnode` queries
+;; — no new Datalog closures (every dl-query re-saturates, so derived graph
+;; algorithms stay in SX). Kind-parameterised throughout, like the rest of the
+;; engine. LCA returns a SET (a DAG may have several lowest common ancestors; a
+;; tree yields exactly one). topo-order returns nil for a cyclic kind.
+
+(define
+  relations-tree-any?
+  (fn
+    (pred xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((pred (first xs)) true)
+      (else (relations-tree-any? pred (rest xs))))))
+
+(define
+  relations-intersect
+  (fn (xs ys) (filter (fn (x) (relations-eng-member? x ys)) xs)))
+
+(define
+  relations-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-eng-member? (first xs) ys)
+        (relations-subset? (rest xs) ys))
+      (else false))))
+
+;; All nodes touched by a kind (the materialised rnode relation — one query).
+(define
+  relations-nodes
+  (fn
+    (db kind)
+    (relations-dedup
+      (relations-pluck
+        (dl-query db (list (quote rnode) kind (quote X)))
+        :X))))
+
+;; Common ancestors of a and b under kind (set intersection of the two
+;; ancestor sets).
+(define
+  relations-common-ancestors
+  (fn
+    (db a b kind)
+    (relations-intersect
+      (relations-ancestors db a kind)
+      (relations-ancestors db b kind))))
+
+;; Lowest common ancestors: common ancestors with no other common ancestor
+;; strictly below them (none reachable from them). A tree gives a singleton; a
+;; DAG may give several. Empty when a and b share no ancestor.
+(define
+  relations-lca
+  (fn
+    (db a b kind)
+    (let
+      ((common (relations-common-ancestors db a b kind)))
+      (filter
+        (fn
+          (x)
+          (not
+            (relations-tree-any?
+              (fn
+                (y)
+                (and (not (= x y)) (relations-reachable? db x y kind)))
+              common)))
+        common))))
+
+;; Kahn-style topological order: repeatedly place every node whose parents are
+;; all already placed. Returns the node list in topological order, or nil if the
+;; kind has a cycle.
+(define
+  relations-topo-kahn
+  (fn
+    (db kind remaining placed)
+    (if
+      (= (len remaining) 0)
+      placed
+      (let
+        ((ready (filter (fn (n) (relations-subset? (relations-parents-of db n kind) placed)) remaining)))
+        (if
+          (= (len ready) 0)
+          placed
+          (relations-topo-kahn
+            db
+            kind
+            (filter
+              (fn (n) (not (relations-eng-member? n ready)))
+              remaining)
+            (append placed ready)))))))
+
+(define
+  relations-topo-order
+  (fn
+    (db kind)
+    (if
+      (relations-acyclic? db kind)
+      (relations-topo-kahn db kind (relations-nodes db kind) (list))
+      nil)))
+
+;; --- current-db convenience layer ---
+
+(define
+  relations/common-ancestors
+  (fn
+    (a b kind)
+    (relations-common-ancestors (relations-ensure-db!) a b kind)))
+
+(define
+  relations/lca
+  (fn (a b kind) (relations-lca (relations-ensure-db!) a b kind)))
+
+(define
+  relations/topo-order
+  (fn (kind) (relations-topo-order (relations-ensure-db!) kind)))