giles
7ce723f732
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
New lib/datalog/builtins.sx: (< <= > >= = !=) and (is X expr) with + - * /. dl-eval-arith recursively evaluates nested compounds. Safety analysis now walks body left-to-right tracking the bound set: comparisons require all args bound, is RHS vars must be bound (LHS becomes bound), = special-cases the var/non-var combos. db.sx keeps the simple safety check as a forward-reference fallback; builtins.sx redefines dl-rule-check-safety to the comprehensive version. eval.sx dispatches built-ins through dl-eval-builtin instead of erroring. 19 new tests.
229 lines
6.6 KiB
Plaintext
229 lines
6.6 KiB
Plaintext
;; lib/datalog/tests/builtins.sx — comparison + arithmetic body literals.
|
|
|
|
(define dl-bt-pass 0)
|
|
(define dl-bt-fail 0)
|
|
(define dl-bt-failures (list))
|
|
|
|
(define
|
|
dl-bt-deep=?
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((and (list? a) (list? b))
|
|
(and (= (len a) (len b)) (dl-bt-deq-l? a b 0)))
|
|
((and (dict? a) (dict? b))
|
|
(let
|
|
((ka (keys a)) (kb (keys b)))
|
|
(and (= (len ka) (len kb)) (dl-bt-deq-d? a b ka 0))))
|
|
((and (number? a) (number? b)) (= a b))
|
|
(else (equal? a b)))))
|
|
|
|
(define
|
|
dl-bt-deq-l?
|
|
(fn
|
|
(a b i)
|
|
(cond
|
|
((>= i (len a)) true)
|
|
((not (dl-bt-deep=? (nth a i) (nth b i))) false)
|
|
(else (dl-bt-deq-l? a b (+ i 1))))))
|
|
|
|
(define
|
|
dl-bt-deq-d?
|
|
(fn
|
|
(a b ka i)
|
|
(cond
|
|
((>= i (len ka)) true)
|
|
((let ((k (nth ka i))) (not (dl-bt-deep=? (get a k) (get b k))))
|
|
false)
|
|
(else (dl-bt-deq-d? a b ka (+ i 1))))))
|
|
|
|
(define
|
|
dl-bt-set=?
|
|
(fn
|
|
(a b)
|
|
(and (= (len a) (len b)) (dl-bt-subset? a b) (dl-bt-subset? b a))))
|
|
|
|
(define
|
|
dl-bt-subset?
|
|
(fn
|
|
(xs ys)
|
|
(cond
|
|
((= (len xs) 0) true)
|
|
((not (dl-bt-contains? ys (first xs))) false)
|
|
(else (dl-bt-subset? (rest xs) ys)))))
|
|
|
|
(define
|
|
dl-bt-contains?
|
|
(fn
|
|
(xs target)
|
|
(cond
|
|
((= (len xs) 0) false)
|
|
((dl-bt-deep=? (first xs) target) true)
|
|
(else (dl-bt-contains? (rest xs) target)))))
|
|
|
|
(define
|
|
dl-bt-test-set!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(dl-bt-set=? got expected)
|
|
(set! dl-bt-pass (+ dl-bt-pass 1))
|
|
(do
|
|
(set! dl-bt-fail (+ dl-bt-fail 1))
|
|
(append!
|
|
dl-bt-failures
|
|
(str
|
|
name
|
|
"\n expected (set): "
|
|
expected
|
|
"\n got: "
|
|
got))))))
|
|
|
|
(define
|
|
dl-bt-test!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(dl-bt-deep=? got expected)
|
|
(set! dl-bt-pass (+ dl-bt-pass 1))
|
|
(do
|
|
(set! dl-bt-fail (+ dl-bt-fail 1))
|
|
(append!
|
|
dl-bt-failures
|
|
(str name "\n expected: " expected "\n got: " got))))))
|
|
|
|
(define
|
|
dl-bt-throws?
|
|
(fn
|
|
(thunk)
|
|
(let
|
|
((threw false))
|
|
(do (guard (e (#t (set! threw true))) (thunk)) threw))))
|
|
|
|
(define
|
|
dl-bt-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
(dl-bt-test-set!
|
|
"less than filter"
|
|
(dl-query
|
|
(dl-program
|
|
"age(alice, 30). age(bob, 17). age(carol, 22).\n adult(X) :- age(X, A), >=(A, 18).")
|
|
(list (quote adult) (quote X)))
|
|
(list {:X (quote alice)} {:X (quote carol)}))
|
|
(dl-bt-test-set!
|
|
"less-equal filter"
|
|
(dl-query
|
|
(dl-program
|
|
"n(1). n(2). n(3). n(4). n(5).\n small(X) :- n(X), <=(X, 3).")
|
|
(list (quote small) (quote X)))
|
|
(list {:X 1} {:X 2} {:X 3}))
|
|
(dl-bt-test-set!
|
|
"not-equal filter"
|
|
(dl-query
|
|
(dl-program
|
|
"p(1, 2). p(2, 2). p(3, 4).\n diff(X, Y) :- p(X, Y), !=(X, Y).")
|
|
(list (quote diff) (quote X) (quote Y)))
|
|
(list {:X 1 :Y 2} {:X 3 :Y 4}))
|
|
(dl-bt-test-set!
|
|
"is plus"
|
|
(dl-query
|
|
(dl-program
|
|
"n(1). n(2). n(3).\n succ(X, Y) :- n(X), is(Y, +(X, 1)).")
|
|
(list (quote succ) (quote X) (quote Y)))
|
|
(list {:X 1 :Y 2} {:X 2 :Y 3} {:X 3 :Y 4}))
|
|
(dl-bt-test-set!
|
|
"is multiply"
|
|
(dl-query
|
|
(dl-program
|
|
"n(2). n(3). n(4).\n square(X, Y) :- n(X), is(Y, *(X, X)).")
|
|
(list (quote square) (quote X) (quote Y)))
|
|
(list {:X 2 :Y 4} {:X 3 :Y 9} {:X 4 :Y 16}))
|
|
(dl-bt-test-set!
|
|
"is nested expr"
|
|
(dl-query
|
|
(dl-program
|
|
"n(1). n(2). n(3).\n f(X, Y) :- n(X), is(Y, *(+(X, 1), 2)).")
|
|
(list (quote f) (quote X) (quote Y)))
|
|
(list {:X 1 :Y 4} {:X 2 :Y 6} {:X 3 :Y 8}))
|
|
(dl-bt-test-set!
|
|
"is bound LHS — equality"
|
|
(dl-query
|
|
(dl-program
|
|
"n(1, 2). n(2, 5). n(3, 4).\n succ(X, Y) :- n(X, Y), is(Y, +(X, 1)).")
|
|
(list (quote succ) (quote X) (quote Y)))
|
|
(list {:X 1 :Y 2} {:X 3 :Y 4}))
|
|
(dl-bt-test-set!
|
|
"triple via is"
|
|
(dl-query
|
|
(dl-program
|
|
"n(1). n(2). n(3).\n triple(X, Y) :- n(X), is(Y, *(X, 3)).")
|
|
(list (quote triple) (quote X) (quote Y)))
|
|
(list {:X 1 :Y 3} {:X 2 :Y 6} {:X 3 :Y 9}))
|
|
(dl-bt-test-set!
|
|
"= unifies var with constant"
|
|
(dl-query
|
|
(dl-program "p(a). p(b).\n qual(X) :- p(X), =(X, a).")
|
|
(list (quote qual) (quote X)))
|
|
(list {:X (quote a)}))
|
|
(dl-bt-test-set!
|
|
"= unifies two vars (one bound)"
|
|
(dl-query
|
|
(dl-program "p(a). p(b).\n twin(X, Y) :- p(X), =(Y, X).")
|
|
(list (quote twin) (quote X) (quote Y)))
|
|
(list {:X (quote a) :Y (quote a)} {:X (quote b) :Y (quote b)}))
|
|
(dl-bt-test!
|
|
"big count"
|
|
(let
|
|
((db (dl-program "n(0). n(1). n(2). n(3). n(4). n(5). n(6). n(7). n(8). n(9).\n big(X) :- n(X), >=(X, 5).")))
|
|
(do (dl-saturate! db) (len (dl-relation db "big"))))
|
|
5)
|
|
(dl-bt-test!
|
|
"unsafe — comparison without binder"
|
|
(dl-bt-throws? (fn () (dl-program "p(X) :- <(X, 5).")))
|
|
true)
|
|
(dl-bt-test!
|
|
"unsafe — comparison both unbound"
|
|
(dl-bt-throws? (fn () (dl-program "p(X, Y) :- <(X, Y), q(X).")))
|
|
true)
|
|
(dl-bt-test!
|
|
"unsafe — is uses unbound RHS var"
|
|
(dl-bt-throws?
|
|
(fn () (dl-program "p(X, Y) :- q(X), is(Y, +(X, Z)).")))
|
|
true)
|
|
(dl-bt-test!
|
|
"unsafe — is on its own"
|
|
(dl-bt-throws? (fn () (dl-program "p(Y) :- is(Y, +(X, 1)).")))
|
|
true)
|
|
(dl-bt-test!
|
|
"unsafe — = between two unbound"
|
|
(dl-bt-throws? (fn () (dl-program "p(X, Y) :- =(X, Y).")))
|
|
true)
|
|
(dl-bt-test!
|
|
"safe — is binds head var"
|
|
(dl-bt-throws?
|
|
(fn () (dl-program "n(1). p(Y) :- n(X), is(Y, +(X, 1)).")))
|
|
false)
|
|
(dl-bt-test!
|
|
"safe — comparison after binder"
|
|
(dl-bt-throws?
|
|
(fn () (dl-program "n(1). big(X) :- n(X), >=(X, 0).")))
|
|
false)
|
|
(dl-bt-test!
|
|
"safe — = binds head var"
|
|
(dl-bt-throws?
|
|
(fn () (dl-program "p(a). p(b). x(Y) :- p(X), =(Y, X).")))
|
|
false))))
|
|
|
|
(define
|
|
dl-builtins-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! dl-bt-pass 0)
|
|
(set! dl-bt-fail 0)
|
|
(set! dl-bt-failures (list))
|
|
(dl-bt-run-all!)
|
|
{:failures dl-bt-failures :total (+ dl-bt-pass dl-bt-fail) :passed dl-bt-pass :failed dl-bt-fail})))
|