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))
              (kept-keys {})
              (kept-index {}))
            (do
              (for-each
                (fn
                  (t)
                  (when
                    (not (dl-tuple-equal? t lit))
                    (do
                      (append! kept t)
                      (dict-set! kept-keys (dl-tuple-key t) true)
                      (when
                        (>= (len t) 2)
                        (let ((k (dl-arg-key (nth t 1))))
                          (do
                            (when
                              (not (has-key? kept-index k))
                              (dict-set! kept-index k (list)))
                            (append! (get kept-index k) t)))))))
                existing)
              (dict-set! (get db :facts) rel-key kept)
              (dict-set! (get db :facts-keys) rel-key kept-keys)
              (dict-set! (get db :facts-index) rel-key kept-index))))
        ;; 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)
              (do
                (dict-set! (get db :facts) k (list))
                (dict-set! (get db :facts-keys) k {})
                (dict-set! (get db :facts-index) k {})))
            rule-heads))
        (dl-saturate! db)
        db))))

;; ── Convenience: single-call source + query ───────────────────
;; (dl-eval source query-source) parses both, builds a db, saturates,
;; runs the query, returns the substitution list. The query source
;; should be `?- goal[, goal ...].` — the parser produces a clause
;; with :query containing a list of literals which is fed straight
;; to dl-query.
(define
  dl-eval
  (fn
    (source query-source)
    (let
      ((db (dl-program source))
        (queries (dl-parse query-source)))
      (cond
        ((= (len queries) 0) (error "dl-eval: query string is empty"))
        ((not (has-key? (first queries) :query))
          (error "dl-eval: second arg must be a `?- ...` query clause"))
        (else
          (dl-query db (get (first queries) :query)))))))

;; (dl-eval-magic source query-source) — like dl-eval but routes a
;; single-positive-literal query through `dl-magic-query` for goal-
;; directed evaluation. Multi-literal query bodies fall back to the
;; standard dl-query path (magic-sets is currently only wired for
;; single-positive goals). The caller's source is parsed afresh
;; each call so successive invocations are independent.
(define
  dl-eval-magic
  (fn
    (source query-source)
    (let
      ((db (dl-program source))
        (queries (dl-parse query-source)))
      (cond
        ((= (len queries) 0) (error "dl-eval-magic: query string is empty"))
        ((not (has-key? (first queries) :query))
          (error
            "dl-eval-magic: second arg must be a `?- ...` query clause"))
        (else
          (let
            ((qbody (get (first queries) :query)))
            (cond
              ((and (= (len qbody) 1)
                    (list? (first qbody))
                    (> (len (first qbody)) 0)
                    (symbol? (first (first qbody))))
                (dl-magic-query db (first qbody)))
              (else (dl-query db qbody)))))))))

(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))))

;; Wipe every relation that has at least one rule (i.e. every IDB
;; relation) — leaves EDB facts and rule definitions intact. Useful
;; before a follow-up `dl-saturate!` if you want a clean restart, or
;; for inspection of the EDB-only baseline.
(define
  dl-clear-idb!
  (fn
    (db)
    (let ((rule-heads (dl-rule-head-rels db)))
      (do
        (for-each
          (fn
            (k)
            (do
              (dict-set! (get db :facts) k (list))
              (dict-set! (get db :facts-keys) k {})
              (dict-set! (get db :facts-index) k {})))
          rule-heads)
        db))))