giles
f33a8d69f5
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Single-call entry: dl-eval source-string query-string parses both, builds a db via dl-program, saturates implicitly, runs the query (extracted from the parsed `?- ...` clause), and returns the substitution list. Most user-friendly path: (dl-eval "parent(a, b). ..." "?- ancestor(a, X).") 2 new api tests cover ancestor and multi-goal usage.
243 lines
6.8 KiB
Plaintext
243 lines
6.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}))
|
|
|
|
;; Multi-goal query: pass list of literals.
|
|
(dl-api-test-set! "multi-goal query"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((p 1) (p 2) (p 3) (q 2) (q 3)))
|
|
(list))
|
|
(list (quote (p X)) (quote (q X))))
|
|
(list {:X 2} {:X 3}))
|
|
|
|
;; Multi-goal with comparison.
|
|
(dl-api-test-set! "multi-goal with comparison"
|
|
(dl-query
|
|
(dl-program-data
|
|
(quote ((n 1) (n 2) (n 3) (n 4) (n 5)))
|
|
(list))
|
|
(list (quote (n X)) (list (string->symbol ">") (quote X) 2)))
|
|
(list {:X 3} {:X 4} {:X 5}))
|
|
|
|
;; dl-eval: single-call source + query.
|
|
(dl-api-test-set! "dl-eval ancestor"
|
|
(dl-eval
|
|
"parent(a, b). parent(b, c).
|
|
ancestor(X, Y) :- parent(X, Y).
|
|
ancestor(X, Z) :- parent(X, Y), ancestor(Y, Z)."
|
|
"?- ancestor(a, X).")
|
|
(list {:X (quote b)} {:X (quote c)}))
|
|
|
|
(dl-api-test-set! "dl-eval multi-goal"
|
|
(dl-eval
|
|
"p(1). p(2). p(3). q(2). q(3)."
|
|
"?- p(X), q(X).")
|
|
(list {:X 2} {:X 3}))
|
|
|
|
;; 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})))
|