rose-ash/lib/datalog/api.sx

;; lib/datalog/api.sx — SX-data embedding API.
;;
;; Where Phase 1's `dl-program` takes a Datalog source string,
;; this module exposes a parser-free API that consumes SX data
;; directly. Two rule shapes are accepted:
;;
;;   - dict:   {:head <literal> :body (<literal> ...)}
;;   - list:   (<head-elements...> <- <body-literal> ...)
;;             — `<-` is an SX symbol used as the rule arrow.
;;
;; Examples:
;;
;;   (dl-program-data
;;     '((parent tom bob) (parent tom liz) (parent bob ann))
;;     '((ancestor X Y <- (parent X Y))
;;       (ancestor X Z <- (parent X Y) (ancestor Y Z))))
;;
;;   (dl-query db '(ancestor tom X))   ; same query API as before
;;
;; Variables follow the parser convention: SX symbols whose first
;; character is uppercase or `_` are variables.

(define
  dl-rule
  (fn (head body) {:head head :body body}))

(define
  dl-rule-arrow?
  (fn
    (x)
    (and (symbol? x) (= (symbol->string x) "<-"))))

(define
  dl-find-arrow
  (fn
    (rl i n)
    (cond
      ((>= i n) nil)
      ((dl-rule-arrow? (nth rl i)) i)
      (else (dl-find-arrow rl (+ i 1) n)))))

;; Given a list of the form (head-elt ... <- body-lit ...) returns
;; {:head (head-elt ...) :body (body-lit ...)}. If no arrow is
;; present, the whole list is treated as the head and the body is
;; empty (i.e. a fact written rule-style).
(define
  dl-rule-from-list
  (fn
    (rl)
    (let ((n (len rl)))
      (let ((idx (dl-find-arrow rl 0 n)))
        (cond
          ((nil? idx) {:head rl :body (list)})
          (else
            (let
              ((head (slice rl 0 idx))
                (body (slice rl (+ idx 1) n)))
              {:head head :body body})))))))

;; Coerce a rule given as either a dict or a list-with-arrow to a dict.
(define
  dl-coerce-rule
  (fn
    (r)
    (cond
      ((dict? r) r)
      ((list? r) (dl-rule-from-list r))
      (else (error (str "dl-coerce-rule: expected dict or list, got " r))))))

;; Build a db from SX data lists.
(define
  dl-program-data
  (fn
    (facts rules)
    (let ((db (dl-make-db)))
      (do
        (for-each (fn (lit) (dl-add-fact! db lit)) facts)
        (for-each
          (fn (r) (dl-add-rule! db (dl-coerce-rule r)))
          rules)
        db))))

;; Add a single fact at runtime, then re-saturate the db so derived
;; tuples reflect the change. Returns the db.
(define
  dl-assert!
  (fn
    (db lit)
    (do
      (dl-add-fact! db lit)
      (dl-saturate! db)
      db)))

;; Remove a fact: drop matching tuples from EDB AND wipe all derived
;; tuples (any IDB tuple may have transitively depended on the removed
;; fact). Then re-saturate to repopulate IDB. EDB facts that were
;; asserted via dl-add-fact! are preserved unless they match `lit`.
;;
;; To distinguish EDB from IDB, we treat any fact for a relation that
;; has rules as IDB; otherwise EDB. (Phase 9 simplification — Phase 10
;; may track provenance.)
(define
  dl-retract!
  (fn
    (db lit)
    (let
      ((rel-key (dl-rel-name lit)))
      (do
        ;; Drop the matching tuple from its relation list (if EDB-only).
        (when
          (has-key? (get db :facts) rel-key)
          (let
            ((existing (get (get db :facts) rel-key))
              (kept (list)))
            (do
              (for-each
                (fn
                  (t)
                  (when
                    (not (dl-tuple-equal? t lit))
                    (append! kept t)))
                existing)
              (dict-set! (get db :facts) rel-key kept))))
        ;; Wipe all relations that have a rule (these are IDB) so the
        ;; saturator regenerates them from the surviving EDB.
        (let ((rule-heads (dl-rule-head-rels db)))
          (for-each
            (fn (k) (dict-set! (get db :facts) k (list)))
            rule-heads))
        (dl-saturate! db)
        db))))

(define
  dl-rule-head-rels
  (fn
    (db)
    (let ((seen (list)))
      (do
        (for-each
          (fn
            (rule)
            (let ((h (dl-rel-name (get rule :head))))
              (when
                (and (not (nil? h)) (not (dl-member-string? h seen)))
                (append! seen h))))
          (dl-rules db))
        seen))))