relations: Phase 1 schema + direct relations (rel facts, relate/unrelate, children/parents/related) + 22 tests

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

lib/relations/api.sx

@@ -0,0 +1,96 @@
+;; lib/relations/api.sx — relationship lifecycle + direct queries over lib/datalog/.
+;;
+;; A relations db is a live Datalog db holding rel(Src,Dst,Kind) facts. Phase 1
+;; uses no rules — direct children/parents are plain queries on the rel
+;; relation. Phase 2's engine.sx adds recursive reachability rules; build-db
+;; will fold them in then.
+;;
+;; 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
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote rel) node (quote Dst) kind))
+      :Dst)))
+
+;; Direct parents: every Src with rel(Src, node, kind).
+(define
+  relations-parents-of
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote rel) (quote Src) node kind))
+      :Src)))
+
+;; Directly related: neighbours in either direction under kind.
+(define
+  relations-related
+  (fn
+    (db node kind)
+    (append
+      (relations-children-of db node kind)
+      (relations-parents-of db node kind))))
+
+;; --- current-db convenience layer ---
+
+(define relations-current-db nil)
+
+(define
+  relations/load!
+  (fn
+    (facts)
+    (do
+      (set! relations-current-db (relations-build-db facts))
+      relations-current-db)))
+
+(define
+  relations-ensure-db!
+  (fn
+    ()
+    (do
+      (when
+        (= relations-current-db nil)
+        (set! relations-current-db (relations-build-db (list))))
+      relations-current-db)))
+
+;; Add a relationship to the current db (re-saturates).
+(define
+  relations/relate
+  (fn
+    (src dst kind)
+    (dl-assert! (relations-ensure-db!) (relations-rel src dst kind))))
+
+;; Remove a relationship from the current db (re-saturates).
+(define
+  relations/unrelate
+  (fn
+    (src dst kind)
+    (dl-retract! (relations-ensure-db!) (relations-rel src dst kind))))
+
+(define
+  relations/children
+  (fn (node kind) (relations-children-of (relations-ensure-db!) node kind)))
+
+(define
+  relations/parents
+  (fn (node kind) (relations-parents-of (relations-ensure-db!) node kind)))
+
+(define
+  relations/related
+  (fn (node kind) (relations-related (relations-ensure-db!) node kind)))

lib/relations/conformance.conf

@@ -0,0 +1,23 @@
+# relations conformance config — sourced by lib/guest/conformance.sh.
+
+LANG_NAME=relations
+MODE=dict
+
+PRELOADS=(
+  lib/datalog/tokenizer.sx
+  lib/datalog/parser.sx
+  lib/datalog/unify.sx
+  lib/datalog/db.sx
+  lib/datalog/builtins.sx
+  lib/datalog/aggregates.sx
+  lib/datalog/strata.sx
+  lib/datalog/eval.sx
+  lib/datalog/api.sx
+  lib/datalog/magic.sx
+  lib/relations/schema.sx
+  lib/relations/api.sx
+)
+
+SUITES=(
+  "direct:lib/relations/tests/direct.sx:(relations-direct-tests-run!)"
+)

lib/relations/conformance.sh

@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+# Thin wrapper — see lib/guest/conformance.sh and lib/relations/conformance.conf.
+exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

lib/relations/schema.sx

@@ -0,0 +1,40 @@
+;; lib/relations/schema.sx — relationship fact vocabulary over lib/datalog/.
+;;
+;; relations is content-agnostic: a node is an opaque id (a symbol or string);
+;; domains own what ids mean. A relationship is a single Datalog fact
+;;
+;;     rel(Src, Dst, Kind)
+;;
+;; meaning "Src is related to Dst under Kind" (read directionally: Src is the
+;; parent/owner/origin, Dst the child/member/reply). Kind is an open vocabulary;
+;; the names below are the platform's well-known kinds but relate accepts any
+;; kind symbol — Datalog is untyped and domains may coin their own.
+
+(define relations-kinds (quote (parent member reply variant origin link)))
+
+(define relations-rel (fn (src dst kind) (list (quote rel) src dst kind)))
+
+(define relations-rel-src (fn (f) (nth f 1)))
+
+(define relations-rel-dst (fn (f) (nth f 2)))
+
+(define relations-rel-kind (fn (f) (nth f 3)))
+
+(define
+  relations-member?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (relations-member? x (rest xs))))))
+
+(define
+  relations-known-kind?
+  (fn (k) (relations-member? k relations-kinds)))
+
+(define
+  relations-fact-valid?
+  (fn
+    (f)
+    (and (list? f) (= (len f) 4) (= (first f) (quote rel)))))

lib/relations/scoreboard.json

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

lib/relations/scoreboard.md

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

lib/relations/tests/direct.sx

@@ -0,0 +1,197 @@
+;; lib/relations/tests/direct.sx — Phase 1: schema + direct relations.
+
+(define relations-dt-pass 0)
+(define relations-dt-fail 0)
+(define relations-dt-failures (list))
+
+(define
+  relations-dt-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! relations-dt-pass (+ relations-dt-pass 1))
+      (do
+        (set! relations-dt-fail (+ relations-dt-fail 1))
+        (append!
+          relations-dt-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+;; Order-insensitive membership: every x in xs is in ys.
+(define
+  relations-dt-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-member? (first xs) ys)
+        (relations-dt-subset? (rest xs) ys))
+      (else false))))
+
+(define
+  relations-dt-set=?
+  (fn
+    (xs ys)
+    (and
+      (= (len xs) (len ys))
+      (relations-dt-subset? xs ys)
+      (relations-dt-subset? ys xs))))
+
+;; Fixture: a small forest with two kinds.
+;;   parent: a -> b, a -> c, b -> d
+;;   reply:  p -> q
+(define
+  relations-dt-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 p) (quote q) (quote reply))))))
+
+(define
+  relations-dt-run-all!
+  (fn
+    ()
+    (let
+      ((db (relations-dt-fixture)))
+      (do
+        (relations-dt-check!
+          "direct children of a"
+          (relations-dt-set=?
+            (relations-children-of db (quote a) (quote parent))
+            (list (quote b) (quote c)))
+          true)
+        (relations-dt-check!
+          "direct children of b"
+          (relations-dt-set=?
+            (relations-children-of db (quote b) (quote parent))
+            (list (quote d)))
+          true)
+        (relations-dt-check!
+          "leaf has no children"
+          (relations-children-of db (quote d) (quote parent))
+          (list))
+        (relations-dt-check!
+          "direct parents of b"
+          (relations-dt-set=?
+            (relations-parents-of db (quote b) (quote parent))
+            (list (quote a)))
+          true)
+        (relations-dt-check!
+          "root has no parents"
+          (relations-parents-of db (quote a) (quote parent))
+          (list))
+        (relations-dt-check!
+          "related is both directions"
+          (relations-dt-set=?
+            (relations-related db (quote b) (quote parent))
+            (list (quote d) (quote a)))
+          true)
+        (relations-dt-check!
+          "kind isolation: parent query skips reply edge"
+          (relations-children-of db (quote p) (quote parent))
+          (list))
+        (relations-dt-check!
+          "reply children of p"
+          (relations-dt-set=?
+            (relations-children-of db (quote p) (quote reply))
+            (list (quote q)))
+          true)
+        (relations-dt-check!
+          "unknown node -> empty"
+          (relations-children-of db (quote zzz) (quote parent))
+          (list))
+        (let
+          ((db2 (relations-build-db (list (relations-rel (quote x) (quote y) (quote parent))))))
+          (do
+            (relations-dt-check!
+              "before retract: y is a child of x"
+              (relations-dt-set=?
+                (relations-children-of db2 (quote x) (quote parent))
+                (list (quote y)))
+              true)
+            (dl-retract!
+              db2
+              (relations-rel (quote x) (quote y) (quote parent)))
+            (relations-dt-check!
+              "after retract: x has no children"
+              (relations-children-of db2 (quote x) (quote parent))
+              (list))))
+        (do
+          (relations/load! (list))
+          (relations/relate (quote o1) (quote li1) (quote member))
+          (relations/relate (quote o1) (quote li2) (quote member))
+          (relations-dt-check!
+            "api relate then children"
+            (relations-dt-set=?
+              (relations/children (quote o1) (quote member))
+              (list (quote li1) (quote li2)))
+            true)
+          (relations-dt-check!
+            "api parents"
+            (relations-dt-set=?
+              (relations/parents (quote li1) (quote member))
+              (list (quote o1)))
+            true)
+          (relations/unrelate (quote o1) (quote li1) (quote member))
+          (relations-dt-check!
+            "api unrelate removes one child"
+            (relations-dt-set=?
+              (relations/children (quote o1) (quote member))
+              (list (quote li2)))
+            true)
+          (relations/load! (list))
+          (relations-dt-check!
+            "api reload clears prior facts"
+            (relations/children (quote o1) (quote member))
+            (list)))
+        (relations-dt-check!
+          "rel constructor shape"
+          (relations-rel (quote s) (quote d) (quote parent))
+          (list (quote rel) (quote s) (quote d) (quote parent)))
+        (relations-dt-check!
+          "fact valid"
+          (relations-fact-valid?
+            (relations-rel (quote s) (quote d) (quote parent)))
+          true)
+        (relations-dt-check!
+          "fact bad arity invalid"
+          (relations-fact-valid? (list (quote rel) (quote s)))
+          false)
+        (relations-dt-check!
+          "fact wrong head invalid"
+          (relations-fact-valid?
+            (list (quote edge) (quote s) (quote d) (quote parent)))
+          false)
+        (relations-dt-check!
+          "known kind"
+          (relations-known-kind? (quote parent))
+          true)
+        (relations-dt-check!
+          "unknown kind"
+          (relations-known-kind? (quote frobnicate))
+          false)
+        (relations-dt-check!
+          "accessors"
+          (list
+            (relations-rel-src
+              (relations-rel (quote s) (quote d) (quote k)))
+            (relations-rel-dst
+              (relations-rel (quote s) (quote d) (quote k)))
+            (relations-rel-kind
+              (relations-rel (quote s) (quote d) (quote k))))
+          (list (quote s) (quote d) (quote k)))))))
+
+(define
+  relations-direct-tests-run!
+  (fn
+    ()
+    (do
+      (set! relations-dt-pass 0)
+      (set! relations-dt-fail 0)
+      (set! relations-dt-failures (list))
+      (relations-dt-run-all!)
+      {:failures relations-dt-failures :total (+ relations-dt-pass relations-dt-fail) :passed relations-dt-pass :failed relations-dt-fail})))