diff --git a/lib/relations/conformance.conf b/lib/relations/conformance.conf index a2a88c9a..85d32f80 100644 --- a/lib/relations/conformance.conf +++ b/lib/relations/conformance.conf @@ -29,4 +29,5 @@ SUITES=( "fed:lib/relations/tests/fed.sx:(relations-fed-tests-run!)" "shape:lib/relations/tests/shape.sx:(relations-shape-tests-run!)" "tree:lib/relations/tests/tree.sx:(relations-tree-tests-run!)" + "routes:lib/relations/tests/routes.sx:(relations-routes-tests-run!)" ) diff --git a/lib/relations/explain.sx b/lib/relations/explain.sx index 09369f8c..e7548f8c 100644 --- a/lib/relations/explain.sx +++ b/lib/relations/explain.sx @@ -69,6 +69,28 @@ ;; --- current-db convenience layer --- +(define + relations-ap-dfs + (fn + (db b kind path node) + (if + (= node b) + (list path) + (relations-concat-map + (fn + (nbr) + (if + (relations-eng-member? nbr path) + (list) + (relations-ap-dfs db b kind (append path (list nbr)) nbr))) + (relations-children-of db node kind))))) + +(define + relations-all-paths + (fn + (db a b kind) + (if (= a b) (list (list a)) (relations-ap-dfs db b kind (list a) a)))) + (define relations/path (fn (a b kind) (relations-path (relations-ensure-db!) a b kind))) @@ -84,3 +106,7 @@ (define relations/reachable-any? (fn (a b) (relations-reachable-any? (relations-ensure-db!) a b))) + +(define + relations/all-paths + (fn (a b kind) (relations-all-paths (relations-ensure-db!) a b kind))) diff --git a/lib/relations/scoreboard.json b/lib/relations/scoreboard.json index 08613c5b..413b177d 100644 --- a/lib/relations/scoreboard.json +++ b/lib/relations/scoreboard.json @@ -1,15 +1,16 @@ { "lang": "relations", - "total_passed": 126, + "total_passed": 135, "total_failed": 0, - "total": 126, + "total": 135, "suites": [ {"name":"direct","passed":22,"failed":0,"total":22}, {"name":"reach","passed":24,"failed":0,"total":24}, {"name":"path","passed":24,"failed":0,"total":24}, {"name":"fed","passed":22,"failed":0,"total":22}, {"name":"shape","passed":18,"failed":0,"total":18}, - {"name":"tree","passed":16,"failed":0,"total":16} + {"name":"tree","passed":16,"failed":0,"total":16}, + {"name":"routes","passed":9,"failed":0,"total":9} ], - "generated": "2026-06-07T13:07:14+00:00" + "generated": "2026-06-07T13:18:20+00:00" } diff --git a/lib/relations/scoreboard.md b/lib/relations/scoreboard.md index 8974ab10..44d75fd7 100644 --- a/lib/relations/scoreboard.md +++ b/lib/relations/scoreboard.md @@ -1,6 +1,6 @@ # relations scoreboard -**126 / 126 passing** (0 failure(s)). +**135 / 135 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -10,3 +10,4 @@ | fed | 22 | 22 | ok | | shape | 18 | 18 | ok | | tree | 16 | 16 | ok | +| routes | 9 | 9 | ok | diff --git a/lib/relations/tests/routes.sx b/lib/relations/tests/routes.sx new file mode 100644 index 00000000..47b31381 --- /dev/null +++ b/lib/relations/tests/routes.sx @@ -0,0 +1,130 @@ +;; lib/relations/tests/routes.sx — extension: all simple paths (route enumeration). + +(define relations-ro-pass 0) +(define relations-ro-fail 0) +(define relations-ro-failures (list)) + +(define + relations-ro-check! + (fn + (name got expected) + (if + (= got expected) + (set! relations-ro-pass (+ relations-ro-pass 1)) + (do + (set! relations-ro-fail (+ relations-ro-fail 1)) + (append! + relations-ro-failures + (str name "\n expected: " expected "\n got: " got)))))) + +(define + relations-ro-subset? + (fn + (xs ys) + (cond + ((= (len xs) 0) true) + ((relations-member? (first xs) ys) + (relations-ro-subset? (rest xs) ys)) + (else false)))) + +;; Order-insensitive set equality; elements compared structurally (works for +;; lists-of-paths since `=` is structural). +(define + relations-ro-set=? + (fn + (xs ys) + (and + (= (len xs) (len ys)) + (relations-ro-subset? xs ys) + (relations-ro-subset? ys xs)))) + +;; Diamond + branch + a cycle with an exit. +;; parent: a->b, a->c, b->d, c->d, b->e +;; member: a->z (a different kind, to test isolation) +;; parent cycle: g->h, h->g, h->out +(define + relations-ro-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 b) (quote e) (quote parent)) + (relations-rel (quote a) (quote z) (quote member)) + (relations-rel (quote g) (quote h) (quote parent)) + (relations-rel (quote h) (quote g) (quote parent)) + (relations-rel (quote h) (quote out) (quote parent)))))) + +(define + relations-ro-run-all! + (fn + () + (let + ((db (relations-ro-fixture))) + (do + (relations-ro-check! + "two routes a->d" + (relations-ro-set=? + (relations-all-paths db (quote a) (quote d) (quote parent)) + (list + (list (quote a) (quote b) (quote d)) + (list (quote a) (quote c) (quote d)))) + true) + (relations-ro-check! + "single route a->e" + (relations-all-paths db (quote a) (quote e) (quote parent)) + (list (list (quote a) (quote b) (quote e)))) + (relations-ro-check! + "no route -> empty" + (relations-all-paths db (quote a) (quote zzz) (quote parent)) + (list)) + (relations-ro-check! + "self route is the singleton path" + (relations-all-paths db (quote a) (quote a) (quote parent)) + (list (list (quote a)))) + (relations-ro-check! + "route through a cycle terminates" + (relations-all-paths db (quote g) (quote out) (quote parent)) + (list (list (quote g) (quote h) (quote out)))) + (relations-ro-check! + "route count a->d is 2" + (len (relations-all-paths db (quote a) (quote d) (quote parent))) + 2) + (relations-ro-check! + "kind isolation: no parent route to member target" + (relations-all-paths db (quote a) (quote z) (quote parent)) + (list)) + (relations-ro-check! + "member route a->z" + (relations-all-paths db (quote a) (quote z) (quote member)) + (list (list (quote a) (quote z)))) + (do + (relations/load! + (list + (relations-rel (quote p) (quote q) (quote parent)) + (relations-rel (quote p) (quote r) (quote parent)) + (relations-rel (quote q) (quote s) (quote parent)) + (relations-rel (quote r) (quote s) (quote parent)))) + (relations-ro-check! + "api all-paths two routes p->s" + (relations-ro-set=? + (relations/all-paths (quote p) (quote s) (quote parent)) + (list + (list (quote p) (quote q) (quote s)) + (list (quote p) (quote r) (quote s)))) + true) + (relations/load! (list))))))) + +(define + relations-routes-tests-run! + (fn + () + (do + (set! relations-ro-pass 0) + (set! relations-ro-fail 0) + (set! relations-ro-failures (list)) + (relations-ro-run-all!) + {:failures relations-ro-failures :total (+ relations-ro-pass relations-ro-fail) :passed relations-ro-pass :failed relations-ro-fail}))) diff --git a/plans/relations-on-sx.md b/plans/relations-on-sx.md index 768a69bc..c73e2363 100644 --- a/plans/relations-on-sx.md +++ b/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` → **126/126** (Phases 1–4 complete + extensions) +`bash lib/relations/conformance.sh` → **135/135** (Phases 1–4 complete + extensions) ## Ground rules @@ -108,9 +108,18 @@ lib/relations/federation.sx (lowest common ancestors — a set; tree → singleton, DAG → may be several), `topo-order` (Kahn-style; nil for cyclic kinds). New `lib/relations/tree.sx`, computed in SX over `reach`/`ancestors`/`rnode`. `lib/relations/tests/tree.sx`. +- [x] **route enumeration** — `all-paths` (all simple directed paths a→b, not just + the shortest; cycle-safe DFS) in explain.sx. `lib/relations/tests/routes.sx`. ## Progress log +- **Extension: route enumeration** (135/135). `relations-all-paths(db,a,b,kind)` + in explain.sx — every simple (no repeated node) directed path a→b, not just the + shortest one `relations-path` returns; DFS that skips nodes already on the + current path so cyclic data terminates; a=b → `((a))`, no route → `()`. Reuses + engine's `relations-concat-map`/`-eng-member?`/`children-of`. + `relations/all-paths` + wrapper, `lib/relations/tests/routes.sx` (9 tests: two-route diamond, single + route, no route, self, route-through-cycle, route count, kind isolation). - **Extension: tree/DAG queries** (126/126). New `lib/relations/tree.sx`: `relations-common-ancestors` (intersection of the two ancestor sets), `relations-lca` (common ancestors with no other common ancestor reachable below