;; lib/prolog/tests/clausedb.sx — Clause DB unit tests

(define pl-db-test-count 0)
(define pl-db-test-pass 0)
(define pl-db-test-fail 0)
(define pl-db-test-failures (list))

(define
  pl-db-test!
  (fn
    (name got expected)
    (begin
      (set! pl-db-test-count (+ pl-db-test-count 1))
      (if
        (= got expected)
        (set! pl-db-test-pass (+ pl-db-test-pass 1))
        (begin
          (set! pl-db-test-fail (+ pl-db-test-fail 1))
          (append!
            pl-db-test-failures
            (str name "\n    expected: " expected "\n    got:      " got)))))))

(pl-db-test!
  "head-key atom arity 0"
  (pl-head-key (nth (first (pl-parse "foo.")) 1))
  "foo/0")

(pl-db-test!
  "head-key compound arity 2"
  (pl-head-key (nth (first (pl-parse "bar(a, b).")) 1))
  "bar/2")

(pl-db-test!
  "clause-key of :- clause"
  (pl-clause-key (first (pl-parse "likes(mary, X) :- friendly(X).")))
  "likes/2")

(pl-db-test!
  "empty db lookup returns empty list"
  (len (pl-db-lookup (pl-mk-db) "parent/2"))
  0)

(define pl-db-t1 (pl-mk-db))
(pl-db-load! pl-db-t1 (pl-parse "foo(a). foo(b). foo(c)."))

(pl-db-test!
  "three facts same functor"
  (len (pl-db-lookup pl-db-t1 "foo/1"))
  3)
(pl-db-test!
  "mismatching key returns empty"
  (len (pl-db-lookup pl-db-t1 "foo/2"))
  0)

(pl-db-test!
  "first clause has arg a"
  (pl-atom-name
    (first (pl-args (nth (first (pl-db-lookup pl-db-t1 "foo/1")) 1))))
  "a")

(pl-db-test!
  "third clause has arg c"
  (pl-atom-name
    (first (pl-args (nth (nth (pl-db-lookup pl-db-t1 "foo/1") 2) 1))))
  "c")

(define pl-db-t2 (pl-mk-db))
(pl-db-load! pl-db-t2 (pl-parse "foo. bar. foo. parent(a, b). parent(c, d)."))

(pl-db-test!
  "atom heads keyed as foo/0"
  (len (pl-db-lookup pl-db-t2 "foo/0"))
  2)
(pl-db-test!
  "atom heads keyed as bar/0"
  (len (pl-db-lookup pl-db-t2 "bar/0"))
  1)
(pl-db-test!
  "compound heads keyed as parent/2"
  (len (pl-db-lookup pl-db-t2 "parent/2"))
  2)

(pl-db-test!
  "lookup-goal extracts functor/arity"
  (len
    (pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "parent(X, Y).")) 1)))
  2)

(pl-db-test!
  "lookup-goal on atom goal"
  (len (pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "foo.")) 1)))
  2)

(pl-db-test!
  "stored clause is clause form"
  (first (first (pl-db-lookup pl-db-t2 "parent/2")))
  "clause")

(define pl-clausedb-tests-run! (fn () {:failed pl-db-test-fail :passed pl-db-test-pass :total pl-db-test-count :failures pl-db-test-failures}))