;; lib/prolog/tests/programs/family.sx — facts + ancestor + sibling relations.

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

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

(define
  pl-fa-goal
  (fn
    (src env)
    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))

(define
  pl-fa-prog-src
  "parent(tom, bob). parent(tom, liz). parent(bob, ann). parent(bob, pat). parent(pat, jim). male(tom). male(bob). male(jim). male(pat). female(liz). female(ann). father(F, C) :- parent(F, C), male(F). mother(M, C) :- parent(M, C), female(M). ancestor(X, Y) :- parent(X, Y). ancestor(X, Y) :- parent(X, Z), ancestor(Z, Y). sibling(X, Y) :- parent(P, X), parent(P, Y), \\=(X, Y).")

(define pl-fa-db (pl-mk-db))
(pl-db-load! pl-fa-db (pl-parse pl-fa-prog-src))

(pl-fa-test!
  "parent(tom, bob) is a fact"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "parent(tom, bob)" {})
    (pl-mk-trail))
  true)

(pl-fa-test!
  "parent(tom, ann) — not a direct parent"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "parent(tom, ann)" {})
    (pl-mk-trail))
  false)

(pl-fa-test!
  "5 parent/2 facts in total"
  (pl-solve-count!
    pl-fa-db
    (pl-fa-goal "parent(X, Y)" {})
    (pl-mk-trail))
  5)

(pl-fa-test!
  "ancestor(tom, jim) — three-step transitive"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "ancestor(tom, jim)" {})
    (pl-mk-trail))
  true)

(pl-fa-test!
  "tom has 5 ancestors-of: bob, liz, ann, pat, jim"
  (pl-solve-count!
    pl-fa-db
    (pl-fa-goal "ancestor(tom, X)" {})
    (pl-mk-trail))
  5)

(pl-fa-test!
  "father(bob, ann) succeeds"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "father(bob, ann)" {})
    (pl-mk-trail))
  true)

(pl-fa-test!
  "father(liz, ann) fails (liz is female)"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "father(liz, ann)" {})
    (pl-mk-trail))
  false)

(pl-fa-test!
  "mother(liz, X) fails (liz has no children)"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "mother(liz, X)" {})
    (pl-mk-trail))
  false)

(pl-fa-test!
  "sibling(ann, pat) succeeds"
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "sibling(ann, pat)" {})
    (pl-mk-trail))
  true)

(pl-fa-test!
  "sibling(ann, ann) fails by \\="
  (pl-solve-once!
    pl-fa-db
    (pl-fa-goal "sibling(ann, ann)" {})
    (pl-mk-trail))
  false)

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