giles
ce603e9879
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
New lib/datalog/api.sx: dl-program-data facts rules takes SX data lists. Rules accept either dict form or list form using <- as the rule arrow (since SX parses :- as a keyword). dl-rule constructor for the dict shape. dl-assert! adds a fact and re-saturates; dl-retract! drops EDB matches, wipes all rule-headed IDB relations, and re-saturates from scratch — simplest correct semantics until provenance tracking arrives. 9 API tests cover ancestor closure via data, dict-rule form, dl-rule constructor, incremental assert/retract, cyclic-graph reach, assert into empty, fact-style rule (no arrow), dict passthrough.
210 lines
5.8 KiB
Plaintext
210 lines
5.8 KiB
Plaintext
;; lib/datalog/tests/api.sx — SX-data embedding API.
|
|
|
|
(define dl-api-pass 0)
|
|
(define dl-api-fail 0)
|
|
(define dl-api-failures (list))
|
|
|
|
(define
|
|
dl-api-deep=?
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((and (list? a) (list? b))
|
|
(and (= (len a) (len b)) (dl-api-deq-l? a b 0)))
|
|
((and (dict? a) (dict? b))
|
|
(let ((ka (keys a)) (kb (keys b)))
|
|
(and (= (len ka) (len kb)) (dl-api-deq-d? a b ka 0))))
|
|
((and (number? a) (number? b)) (= a b))
|
|
(else (equal? a b)))))
|
|
|
|
(define
|
|
dl-api-deq-l?
|
|
(fn
|
|
(a b i)
|
|
(cond
|
|
((>= i (len a)) true)
|
|
((not (dl-api-deep=? (nth a i) (nth b i))) false)
|
|
(else (dl-api-deq-l? a b (+ i 1))))))
|
|
|
|
(define
|
|
dl-api-deq-d?
|
|
(fn
|
|
(a b ka i)
|
|
(cond
|
|
((>= i (len ka)) true)
|
|
((let ((k (nth ka i)))
|
|
(not (dl-api-deep=? (get a k) (get b k))))
|
|
false)
|
|
(else (dl-api-deq-d? a b ka (+ i 1))))))
|
|
|
|
(define
|
|
dl-api-set=?
|
|
(fn
|
|
(a b)
|
|
(and
|
|
(= (len a) (len b))
|
|
(dl-api-subset? a b)
|
|
(dl-api-subset? b a))))
|
|
|
|
(define
|
|
dl-api-subset?
|
|
(fn
|
|
(xs ys)
|
|
(cond
|
|
((= (len xs) 0) true)
|
|
((not (dl-api-contains? ys (first xs))) false)
|
|
(else (dl-api-subset? (rest xs) ys)))))
|
|
|
|
(define
|
|
dl-api-contains?
|
|
(fn
|
|
(xs target)
|
|
(cond
|
|
((= (len xs) 0) false)
|
|
((dl-api-deep=? (first xs) target) true)
|
|
(else (dl-api-contains? (rest xs) target)))))
|
|
|
|
(define
|
|
dl-api-test!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(dl-api-deep=? got expected)
|
|
(set! dl-api-pass (+ dl-api-pass 1))
|
|
(do
|
|
(set! dl-api-fail (+ dl-api-fail 1))
|
|
(append!
|
|
dl-api-failures
|
|
(str
|
|
name
|
|
"\n expected: " expected
|
|
"\n got: " got))))))
|
|
|
|
(define
|
|
dl-api-test-set!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(dl-api-set=? got expected)
|
|
(set! dl-api-pass (+ dl-api-pass 1))
|
|
(do
|
|
(set! dl-api-fail (+ dl-api-fail 1))
|
|
(append!
|
|
dl-api-failures
|
|
(str
|
|
name
|
|
"\n expected (set): " expected
|
|
"\n got: " got))))))
|
|
|
|
(define
|
|
dl-api-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
;; dl-program-data with arrow form.
|
|
(dl-api-test-set! "data API ancestor closure"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((parent tom bob) (parent bob ann) (parent ann pat)))
|
|
(quote
|
|
((ancestor X Y <- (parent X Y))
|
|
(ancestor X Z <- (parent X Y) (ancestor Y Z)))))
|
|
(quote (ancestor tom X)))
|
|
(list {:X (quote bob)} {:X (quote ann)} {:X (quote pat)}))
|
|
|
|
;; dl-program-data with dict rules.
|
|
(dl-api-test-set! "data API with dict rules"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((p a) (p b) (p c)))
|
|
(list
|
|
{:head (quote (q X)) :body (quote ((p X)))}))
|
|
(quote (q X)))
|
|
(list {:X (quote a)} {:X (quote b)} {:X (quote c)}))
|
|
|
|
;; dl-rule helper.
|
|
(dl-api-test-set! "dl-rule constructor"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((p 1) (p 2)))
|
|
(list (dl-rule (quote (q X)) (quote ((p X))))))
|
|
(quote (q X)))
|
|
(list {:X 1} {:X 2}))
|
|
|
|
;; dl-assert! adds and re-derives.
|
|
(dl-api-test-set! "dl-assert! incremental"
|
|
(let
|
|
((db (dl-program-data
|
|
(quote ((parent tom bob) (parent bob ann)))
|
|
(quote
|
|
((ancestor X Y <- (parent X Y))
|
|
(ancestor X Z <- (parent X Y) (ancestor Y Z)))))))
|
|
(do
|
|
(dl-saturate! db)
|
|
(dl-assert! db (quote (parent ann pat)))
|
|
(dl-query db (quote (ancestor tom X)))))
|
|
(list {:X (quote bob)} {:X (quote ann)} {:X (quote pat)}))
|
|
|
|
;; dl-retract! removes a fact and recomputes IDB.
|
|
(dl-api-test-set! "dl-retract! removes derived"
|
|
(let
|
|
((db (dl-program-data
|
|
(quote ((parent tom bob) (parent bob ann) (parent ann pat)))
|
|
(quote
|
|
((ancestor X Y <- (parent X Y))
|
|
(ancestor X Z <- (parent X Y) (ancestor Y Z)))))))
|
|
(do
|
|
(dl-saturate! db)
|
|
(dl-retract! db (quote (parent bob ann)))
|
|
(dl-query db (quote (ancestor tom X)))))
|
|
(list {:X (quote bob)}))
|
|
|
|
;; dl-program-data + dl-query with constants in head.
|
|
(dl-api-test-set! "constant-in-head data"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((edge a b) (edge b c) (edge c a)))
|
|
(quote
|
|
((reach X Y <- (edge X Y))
|
|
(reach X Z <- (edge X Y) (reach Y Z)))))
|
|
(quote (reach a X)))
|
|
(list {:X (quote a)} {:X (quote b)} {:X (quote c)}))
|
|
|
|
;; Assert into empty db.
|
|
(dl-api-test-set! "assert into empty"
|
|
(let
|
|
((db (dl-program-data (list) (list))))
|
|
(do
|
|
(dl-assert! db (quote (p 1)))
|
|
(dl-assert! db (quote (p 2)))
|
|
(dl-query db (quote (p X)))))
|
|
(list {:X 1} {:X 2}))
|
|
|
|
;; dl-rule-from-list with no arrow → fact-style.
|
|
(dl-api-test-set! "no arrow → fact-like rule"
|
|
(let
|
|
((rule (dl-rule-from-list (quote (foo X Y)))))
|
|
(list rule))
|
|
(list {:head (quote (foo X Y)) :body (list)}))
|
|
|
|
;; dl-coerce-rule on dict passes through.
|
|
(dl-api-test-set! "coerce dict rule"
|
|
(let
|
|
((d {:head (quote (h X)) :body (quote ((b X)))}))
|
|
(list (dl-coerce-rule d)))
|
|
(list {:head (quote (h X)) :body (quote ((b X)))})))))
|
|
|
|
(define
|
|
dl-api-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! dl-api-pass 0)
|
|
(set! dl-api-fail 0)
|
|
(set! dl-api-failures (list))
|
|
(dl-api-run-all!)
|
|
{:passed dl-api-pass
|
|
:failed dl-api-fail
|
|
:total (+ dl-api-pass dl-api-fail)
|
|
:failures dl-api-failures})))
|