relations: Phase 2 reachability + roots/leaves + cycles (engine.sx, kind-parameterized closure) + 24 tests

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

lib/relations/api.sx

@@ -1,25 +1,18 @@
-;; lib/relations/api.sx — relationship lifecycle + direct queries over lib/datalog/.
+;; lib/relations/api.sx — relationship lifecycle + queries over lib/datalog/.
 ;;
-;; A relations db is a live Datalog db holding rel(Src,Dst,Kind) facts. Phase 1
+;; A relations db is a live Datalog db holding rel(Src,Dst,Kind) facts under the
-;; uses no rules — direct children/parents are plain queries on the rel
+;; engine ruleset (lib/relations/engine.sx). Direct children/parents are plain
-;; relation. Phase 2's engine.sx adds recursive reachability rules; build-db
+;; queries on the rel relation; transitive reachability/roots/leaves/cycles come
-;; will fold them in then.
+;; from the engine's recursive rules.
 ;;
 ;; Two surfaces: db-threading core fns (relations-children-of db ...) and a
 ;; current-db convenience layer (relations/relate ...) for callers that load a
 ;; fact base once and query without passing the db around. This mirrors lib/acl.
 
-(define relations-rules (list))
-
 (define
   relations-build-db
   (fn (facts) (dl-program-data facts relations-rules)))
 
-;; Pull one column (by keyword key) out of a list of substitution dicts.
-(define
-  relations-pluck
-  (fn (substs key) (map (fn (s) (get s key)) substs)))
-
 ;; Direct children: every Dst with rel(node, Dst, kind).
 (define
   relations-children-of
@@ -94,3 +87,31 @@
 (define
   relations/related
   (fn (node kind) (relations-related (relations-ensure-db!) node kind)))
+
+(define
+  relations/descendants
+  (fn (node kind) (relations-descendants (relations-ensure-db!) node kind)))
+
+(define
+  relations/ancestors
+  (fn (node kind) (relations-ancestors (relations-ensure-db!) node kind)))
+
+(define
+  relations/reachable?
+  (fn (a b kind) (relations-reachable? (relations-ensure-db!) a b kind)))
+
+(define
+  relations/roots
+  (fn (kind) (relations-roots (relations-ensure-db!) kind)))
+
+(define
+  relations/leaves
+  (fn (kind) (relations-leaves (relations-ensure-db!) kind)))
+
+(define
+  relations/cycle?
+  (fn (node kind) (relations-cycle? (relations-ensure-db!) node kind)))
+
+(define
+  relations/acyclic?
+  (fn (kind) (relations-acyclic? (relations-ensure-db!) kind)))

lib/relations/conformance.conf

@@ -15,9 +15,11 @@ PRELOADS=(
   lib/datalog/api.sx
   lib/datalog/magic.sx
   lib/relations/schema.sx
+  lib/relations/engine.sx
   lib/relations/api.sx
 )
 
 SUITES=(
   "direct:lib/relations/tests/direct.sx:(relations-direct-tests-run!)"
+  "reach:lib/relations/tests/reach.sx:(relations-reach-tests-run!)"
 )

lib/relations/engine.sx

@@ -0,0 +1,86 @@
+;; lib/relations/engine.sx — recursive reachability + roots/leaves + cycles.
+;;
+;; The whole engine is one Datalog ruleset. Reachability is the bottom-up
+;; transitive closure acl-on-sx uses for inheritance, but parameterised by Kind
+;; so closures never leak across kinds: `reach` carries the kind as its first
+;; argument, so a `parent` walk can never cross a `reply` edge.
+;;
+;;   reach(K,X,Y) :- rel(X,Y,K).                  ; one hop
+;;   reach(K,X,Y) :- rel(X,Z,K), reach(K,Z,Y).    ; transitive
+;;
+;; rnode collects the nodes touched by a kind; root/leaf are those with no
+;; incoming / no outgoing edge (stratified negation over has_parent/has_child).
+;; Cycles are ordinary data: `reach(K,X,X)` simply holds for nodes on a cycle —
+;; cycle?/acyclic? are queries, not errors. Do not assume a DAG.
+
+(define
+  relations-rules
+  (quote
+    ((reach K X Y <- (rel X Y K))
+      (reach K X Y <- (rel X Z K) (reach K Z Y))
+      (rnode K X <- (rel X Y K))
+      (rnode K Y <- (rel X Y K))
+      (has_parent K Y <- (rel X Y K))
+      (has_child K X <- (rel X Y K))
+      (root K X <- (rnode K X) {:neg (has_parent K X)})
+      (leaf K X <- (rnode K X) {:neg (has_child K X)}))))
+
+;; Pull one column (by keyword key) out of a list of substitution dicts.
+(define
+  relations-pluck
+  (fn (substs key) (map (fn (s) (get s key)) substs)))
+
+;; Transitive descendants of node under kind (everything reachable forward).
+(define
+  relations-descendants
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote reach) kind node (quote Y)))
+      :Y)))
+
+;; Transitive ancestors of node under kind (everything that reaches node).
+(define
+  relations-ancestors
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote reach) kind (quote X) node))
+      :X)))
+
+;; Is b reachable from a under kind (transitive)?
+(define
+  relations-reachable?
+  (fn
+    (db a b kind)
+    (> (len (dl-query db (list (quote reach) kind a b))) 0)))
+
+;; Roots: nodes touched by kind with no incoming edge.
+(define
+  relations-roots
+  (fn
+    (db kind)
+    (relations-pluck (dl-query db (list (quote root) kind (quote X))) :X)))
+
+;; Leaves: nodes touched by kind with no outgoing edge.
+(define
+  relations-leaves
+  (fn
+    (db kind)
+    (relations-pluck (dl-query db (list (quote leaf) kind (quote X))) :X)))
+
+;; Is node on a cycle under kind (reachable from itself)?
+(define
+  relations-cycle?
+  (fn
+    (db node kind)
+    (> (len (dl-query db (list (quote reach) kind node node))) 0)))
+
+;; Has the kind any cycle at all? (no node reaches itself)
+(define
+  relations-acyclic?
+  (fn
+    (db kind)
+    (=
+      (len (dl-query db (list (quote reach) kind (quote X) (quote X))))
+      0)))

lib/relations/scoreboard.json

@@ -1,10 +1,11 @@
 {
   "lang": "relations",
-  "total_passed": 22,
+  "total_passed": 46,
   "total_failed": 0,
-  "total": 22,
+  "total": 46,
   "suites": [
-    {"name":"direct","passed":22,"failed":0,"total":22}
+    {"name":"direct","passed":22,"failed":0,"total":22},
+    {"name":"reach","passed":24,"failed":0,"total":24}
   ],
-  "generated": "2026-06-07T11:41:50+00:00"
+  "generated": "2026-06-07T11:51:39+00:00"
 }

lib/relations/scoreboard.md

@@ -1,7 +1,8 @@
 # relations scoreboard
 
-**22 / 22 passing** (0 failure(s)).
+**46 / 46 passing** (0 failure(s)).
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
 | direct | 22 | 22 | ok |
+| reach | 24 | 24 | ok |

lib/relations/tests/reach.sx

@@ -0,0 +1,204 @@
+;; lib/relations/tests/reach.sx — Phase 2: reachability, roots/leaves, cycles.
+
+(define relations-rt-pass 0)
+(define relations-rt-fail 0)
+(define relations-rt-failures (list))
+
+(define
+  relations-rt-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! relations-rt-pass (+ relations-rt-pass 1))
+      (do
+        (set! relations-rt-fail (+ relations-rt-fail 1))
+        (append!
+          relations-rt-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define
+  relations-rt-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-member? (first xs) ys)
+        (relations-rt-subset? (rest xs) ys))
+      (else false))))
+
+(define
+  relations-rt-set=?
+  (fn
+    (xs ys)
+    (and
+      (= (len xs) (len ys))
+      (relations-rt-subset? xs ys)
+      (relations-rt-subset? ys xs))))
+
+;; Diamond + a disconnected pair under parent, plus a reply cross-edge.
+;;   parent: a->b, a->c, b->d, c->d ; e->f
+;;   reply:  b->z
+(define
+  relations-rt-fixture
+  (fn
+    ()
+    (relations-build-db
+      (list
+        (relations-rel (quote a) (quote b) (quote parent))
+        (relations-rel (quote a) (quote c) (quote parent))
+        (relations-rel (quote b) (quote d) (quote parent))
+        (relations-rel (quote c) (quote d) (quote parent))
+        (relations-rel (quote e) (quote f) (quote parent))
+        (relations-rel (quote b) (quote z) (quote reply))))))
+
+;; Cycles: c1<->c2, self-loop s->s, plus acyclic t->u, all under parent.
+(define
+  relations-rt-cyc-fixture
+  (fn
+    ()
+    (relations-build-db
+      (list
+        (relations-rel (quote c1) (quote c2) (quote parent))
+        (relations-rel (quote c2) (quote c1) (quote parent))
+        (relations-rel (quote s) (quote s) (quote parent))
+        (relations-rel (quote t) (quote u) (quote parent))))))
+
+(define
+  relations-rt-run-all!
+  (fn
+    ()
+    (let
+      ((db (relations-rt-fixture)) (cyc (relations-rt-cyc-fixture)))
+      (do
+        (relations-rt-check!
+          "descendants of a (diamond)"
+          (relations-rt-set=?
+            (relations-descendants db (quote a) (quote parent))
+            (list (quote b) (quote c) (quote d)))
+          true)
+        (relations-rt-check!
+          "ancestors of d (diamond)"
+          (relations-rt-set=?
+            (relations-ancestors db (quote d) (quote parent))
+            (list (quote a) (quote b) (quote c)))
+          true)
+        (relations-rt-check!
+          "reachable a->d"
+          (relations-reachable? db (quote a) (quote d) (quote parent))
+          true)
+        (relations-rt-check!
+          "not reachable d->a"
+          (relations-reachable? db (quote d) (quote a) (quote parent))
+          false)
+        (relations-rt-check!
+          "disconnected components"
+          (relations-reachable? db (quote a) (quote f) (quote parent))
+          false)
+        (relations-rt-check!
+          "leaf has no descendants"
+          (relations-descendants db (quote d) (quote parent))
+          (list))
+        (relations-rt-check!
+          "root has no ancestors"
+          (relations-ancestors db (quote a) (quote parent))
+          (list))
+        (relations-rt-check!
+          "roots under parent"
+          (relations-rt-set=?
+            (relations-roots db (quote parent))
+            (list (quote a) (quote e)))
+          true)
+        (relations-rt-check!
+          "leaves under parent"
+          (relations-rt-set=?
+            (relations-leaves db (quote parent))
+            (list (quote d) (quote f)))
+          true)
+        (relations-rt-check!
+          "parent descendants exclude reply target"
+          (relations-member?
+            (quote z)
+            (relations-descendants db (quote a) (quote parent)))
+          false)
+        (relations-rt-check!
+          "reply reachable b->z"
+          (relations-reachable? db (quote b) (quote z) (quote reply))
+          true)
+        (relations-rt-check!
+          "parent unreachable a->z"
+          (relations-reachable? db (quote a) (quote z) (quote parent))
+          false)
+        (relations-rt-check!
+          "diamond is acyclic"
+          (relations-acyclic? db (quote parent))
+          true)
+        (relations-rt-check!
+          "no node cycles in diamond"
+          (relations-cycle? db (quote a) (quote parent))
+          false)
+        (relations-rt-check!
+          "c1 is on a cycle"
+          (relations-cycle? cyc (quote c1) (quote parent))
+          true)
+        (relations-rt-check!
+          "self-loop counts as cycle"
+          (relations-cycle? cyc (quote s) (quote parent))
+          true)
+        (relations-rt-check!
+          "acyclic node t not on cycle"
+          (relations-cycle? cyc (quote t) (quote parent))
+          false)
+        (relations-rt-check!
+          "kind with a cycle is not acyclic"
+          (relations-acyclic? cyc (quote parent))
+          false)
+        (relations-rt-check!
+          "cycle reachable both ways"
+          (and
+            (relations-reachable? cyc (quote c1) (quote c2) (quote parent))
+            (relations-reachable? cyc (quote c2) (quote c1) (quote parent)))
+          true)
+        (relations-rt-check!
+          "node in cycle reaches itself"
+          (relations-member?
+            (quote c1)
+            (relations-descendants cyc (quote c1) (quote parent)))
+          true)
+        (do
+          (relations/load!
+            (list
+              (relations-rel (quote r) (quote m) (quote parent))
+              (relations-rel (quote m) (quote n) (quote parent))))
+          (relations-rt-check!
+            "api descendants"
+            (relations-rt-set=?
+              (relations/descendants (quote r) (quote parent))
+              (list (quote m) (quote n)))
+            true)
+          (relations-rt-check!
+            "api reachable"
+            (relations/reachable? (quote r) (quote n) (quote parent))
+            true)
+          (relations-rt-check!
+            "api roots"
+            (relations-rt-set=?
+              (relations/roots (quote parent))
+              (list (quote r)))
+            true)
+          (relations-rt-check!
+            "api acyclic"
+            (relations/acyclic? (quote parent))
+            true)
+          (relations/load! (list)))))))
+
+(define
+  relations-reach-tests-run!
+  (fn
+    ()
+    (do
+      (set! relations-rt-pass 0)
+      (set! relations-rt-fail 0)
+      (set! relations-rt-failures (list))
+      (relations-rt-run-all!)
+      {:failures relations-rt-failures :total (+ relations-rt-pass relations-rt-fail) :passed relations-rt-pass :failed relations-rt-fail})))

plans/relations-on-sx.md

@@ -18,7 +18,7 @@ links. Reuses `lib/datalog/` — does not reimplement the engine.
 
 ## Status (rolling)
 
-`bash lib/relations/conformance.sh` → **22/22** (Phase 1 complete)
+`bash lib/relations/conformance.sh` → **46/46** (Phases 1–2 complete)
 
 ## Ground rules
 
@@ -72,11 +72,11 @@ lib/relations/federation.sx
 
 ## Phase 2 — Reachability + cycles
 
-- [ ] recursive reachability rules: `ancestors`, `descendants`, `reachable?(A,B)`
+- [x] recursive reachability rules: `ancestors`, `descendants`, `reachable?(A,B)`
   (transitive closure over a kind, the acl inheritance shape)
-- [ ] `roots` / `leaves` (no parents / no children) for a kind
+- [x] `roots` / `leaves` (no parents / no children) for a kind
-- [ ] cycle detection: `cycle?(X)` ⇔ `reachable(X, X)`; `acyclic?(db, kind)`
+- [x] cycle detection: `cycle?(X)` ⇔ `reachable(X, X)`; `acyclic?(db, kind)`
-- [ ] `lib/relations/tests/reach.sx` — deep chains, diamonds, disconnected nodes,
+- [x] `lib/relations/tests/reach.sx` — deep chains, diamonds, disconnected nodes,
   self-loops, multi-kind isolation
 
 ## Phase 3 — Typed relations + path explanation
@@ -100,6 +100,21 @@ lib/relations/federation.sx
 
 ## Progress log
 
+- **Phase 2 — reachability + cycles** (46/46). New `engine.sx` is one Datalog
+  ruleset. Reachability is kind-parameterised — `reach(K,X,Y)` carries the kind as
+  its first arg so a transitive walk over `parent` never leaks through `reply`
+  edges (the acl inheritance shape, but closures can't cross kinds). `rnode`
+  collects touched nodes; `root`/`leaf` use stratified negation over
+  `has_parent`/`has_child`. Cycles are data, not errors: `cycle?(node,kind)` ⇔
+  `reach(K,node,node)` holds, `acyclic?(kind)` ⇔ no `reach(K,X,X)`. Engine fns:
+  `relations-descendants/-ancestors/-reachable?/-roots/-leaves/-cycle?/-acyclic?`;
+  api.sx grew matching `relations/...` current-db wrappers. `relations-rules` and
+  `relations-pluck` moved from api.sx into engine.sx (engine now loads before api
+  in conformance.conf). reach.sx covers diamonds, deep chains, disconnected
+  components, self-loops, c1<->c2 cycles, and multi-kind isolation. acl
+  convergence: the `reach(X,Y):-edge(X,Y)` / `reach(X,Y):-edge(X,Z),reach(Z,Y)`
+  closure shape is shared with acl's eff_grant/eff_deny inheritance — flagged, not
+  extracted (per ground rules).
 - **Phase 1 — schema + direct relations** (22/22). `schema.sx`: `rel(Src,Dst,Kind)`
   fact constructor + accessors, open kind vocabulary (`parent member reply variant
   origin link`), `relations-fact-valid?`/`relations-known-kind?`. `api.sx`: db built