prolog: family.pl + family.sx, 10 tests; 5/5 classic programs done

lib/prolog/tests/programs/family.pl

@@ -0,0 +1,24 @@
+%% family — facts + transitive ancestor + derived relations.
+%% Five-generation tree: tom -> bob -> {ann, pat} -> jim, plus tom's
+%% other child liz.
+
+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).

lib/prolog/tests/programs/family.sx

@@ -0,0 +1,116 @@
+;; 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}))