relations: shape queries (siblings, in/out-degree, undirected connected?) computed in SX + 18 tests

Keep the Datalog ruleset minimal — every dl-query re-saturates, so shape
queries are SX BFS over erel, not extra closures. 110/110.

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

lib/relations/tests/shape.sx

@@ -0,0 +1,161 @@
+;; lib/relations/tests/shape.sx — extension: siblings, degree, undirected
+;; connectivity.
+
+(define relations-st-pass 0)
+(define relations-st-fail 0)
+(define relations-st-failures (list))
+
+(define
+  relations-st-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! relations-st-pass (+ relations-st-pass 1))
+      (do
+        (set! relations-st-fail (+ relations-st-fail 1))
+        (append!
+          relations-st-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define
+  relations-st-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-member? (first xs) ys)
+        (relations-st-subset? (rest xs) ys))
+      (else false))))
+
+(define
+  relations-st-set=?
+  (fn
+    (xs ys)
+    (and
+      (= (len xs) (len ys))
+      (relations-st-subset? xs ys)
+      (relations-st-subset? ys xs))))
+
+;; A small tree plus a disconnected pair.
+;;   parent: p->a, p->b, p->c, a->d ; q->r (disconnected)
+;;   member: m->x, m->y (a different kind, same db)
+(define
+  relations-st-fixture
+  (fn
+    ()
+    (relations-build-db
+      (list
+        (relations-rel (quote p) (quote a) (quote parent))
+        (relations-rel (quote p) (quote b) (quote parent))
+        (relations-rel (quote p) (quote c) (quote parent))
+        (relations-rel (quote a) (quote d) (quote parent))
+        (relations-rel (quote q) (quote r) (quote parent))
+        (relations-rel (quote m) (quote x) (quote member))
+        (relations-rel (quote m) (quote y) (quote member))))))
+
+(define
+  relations-st-run-all!
+  (fn
+    ()
+    (let
+      ((db (relations-st-fixture)))
+      (do
+        (relations-st-check!
+          "siblings of a"
+          (relations-st-set=?
+            (relations-siblings db (quote a) (quote parent))
+            (list (quote b) (quote c)))
+          true)
+        (relations-st-check!
+          "only child has no siblings"
+          (relations-siblings db (quote d) (quote parent))
+          (list))
+        (relations-st-check!
+          "siblings respect kind"
+          (relations-st-set=?
+            (relations-siblings db (quote x) (quote member))
+            (list (quote y)))
+          true)
+        (relations-st-check!
+          "no cross-kind siblings"
+          (relations-siblings db (quote a) (quote member))
+          (list))
+        (relations-st-check!
+          "out-degree of p"
+          (relations-out-degree db (quote p) (quote parent))
+          3)
+        (relations-st-check!
+          "out-degree of a"
+          (relations-out-degree db (quote a) (quote parent))
+          1)
+        (relations-st-check!
+          "out-degree of leaf"
+          (relations-out-degree db (quote d) (quote parent))
+          0)
+        (relations-st-check!
+          "in-degree of a"
+          (relations-in-degree db (quote a) (quote parent))
+          1)
+        (relations-st-check!
+          "in-degree of root"
+          (relations-in-degree db (quote p) (quote parent))
+          0)
+        (relations-st-check!
+          "siblings are connected"
+          (relations-connected? db (quote b) (quote c) (quote parent))
+          true)
+        (relations-st-check!
+          "cousin connected (b <-> d)"
+          (relations-connected? db (quote b) (quote d) (quote parent))
+          true)
+        (relations-st-check!
+          "self connected"
+          (relations-connected? db (quote a) (quote a) (quote parent))
+          true)
+        (relations-st-check!
+          "disconnected components not connected"
+          (relations-connected? db (quote a) (quote q) (quote parent))
+          false)
+        (relations-st-check!
+          "directed-unreachable but undirected-connected"
+          (and
+            (not
+              (relations-reachable? db (quote b) (quote c) (quote parent)))
+            (relations-connected? db (quote b) (quote c) (quote parent)))
+          true)
+        (relations-st-check!
+          "connectivity respects kind"
+          (relations-connected? db (quote a) (quote x) (quote member))
+          false)
+        (do
+          (relations/load!
+            (list
+              (relations-rel (quote g) (quote h) (quote parent))
+              (relations-rel (quote g) (quote i) (quote parent))))
+          (relations-st-check!
+            "api siblings"
+            (relations-st-set=?
+              (relations/siblings (quote h) (quote parent))
+              (list (quote i)))
+            true)
+          (relations-st-check!
+            "api out-degree"
+            (relations/out-degree (quote g) (quote parent))
+            2)
+          (relations-st-check!
+            "api connected"
+            (relations/connected? (quote h) (quote i) (quote parent))
+            true)
+          (relations/load! (list)))))))
+
+(define
+  relations-shape-tests-run!
+  (fn
+    ()
+    (do
+      (set! relations-st-pass 0)
+      (set! relations-st-fail 0)
+      (set! relations-st-failures (list))
+      (relations-st-run-all!)
+      {:failures relations-st-failures :total (+ relations-st-pass relations-st-fail) :passed relations-st-pass :failed relations-st-fail})))