;; 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
;;
;; `reach_any` is the kind-agnostic closure (any edge, any kind) used for
;; mixed-kind reachability — distinct from single-kind `reach`.
;;
;; 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))
      (reach_any X Y <- (rel X Y K))
      (reach_any X Y <- (rel X Z K) (reach_any 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)))

;; Mixed-kind: descendants reachable from node over edges of ANY kind.
(define
  relations-descendants-any
  (fn
    (db node)
    (relations-pluck
      (dl-query db (list (quote reach_any) node (quote Y)))
      :Y)))

;; Mixed-kind: is b reachable from a over edges of ANY kind?
(define
  relations-reachable-any?
  (fn
    (db a b)
    (> (len (dl-query db (list (quote reach_any) 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)))