From 09683b8a1883c7354c3c42f825b7290d7669c1dd Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 05:52:28 +0000 Subject: [PATCH] prolog: family.pl + family.sx, 10 tests; 5/5 classic programs done --- lib/prolog/tests/programs/family.pl | 24 ++++++ lib/prolog/tests/programs/family.sx | 116 ++++++++++++++++++++++++++++ plans/prolog-on-sx.md | 5 +- 3 files changed, 143 insertions(+), 2 deletions(-) create mode 100644 lib/prolog/tests/programs/family.pl create mode 100644 lib/prolog/tests/programs/family.sx diff --git a/lib/prolog/tests/programs/family.pl b/lib/prolog/tests/programs/family.pl new file mode 100644 index 00000000..cb24a9c3 --- /dev/null +++ b/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). diff --git a/lib/prolog/tests/programs/family.sx b/lib/prolog/tests/programs/family.sx new file mode 100644 index 00000000..0c139499 --- /dev/null +++ b/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})) diff --git a/plans/prolog-on-sx.md b/plans/prolog-on-sx.md index d6ef2e05..faadb9e0 100644 --- a/plans/prolog-on-sx.md +++ b/plans/prolog-on-sx.md @@ -60,9 +60,9 @@ Representation choices (finalise in phase 1, document here): - [x] `reverse.pl` — naive reverse — `lib/prolog/tests/programs/reverse.{pl,sx}`. Naive reverse via append: `reverse([H|T], R) :- reverse(T, RT), append(RT, [H], R)`. 6 tests cover empty, singleton, 3-list, 4-atom-list, ground match, ground mismatch. - [x] `member.pl` — generate all solutions via backtracking — `lib/prolog/tests/programs/member.{pl,sx}`. Classic 2-clause `member(X, [X|_])` + `member(X, [_|T]) :- member(X, T)`. 7 tests cover bound-element hit/miss, empty list, generator (count = list length), first-solution binding, duplicate matches counted twice, anonymous head-cell unification. - [x] `nqueens.pl` — 8-queens — `lib/prolog/tests/programs/nqueens.{pl,sx}`. Permute-and-test formulation: `queens(L, Qs) :- permute(L, Qs), safe(Qs)` + `select` + `safe` + `no_attack`. Tested at N=1 (1), N=2 (0), N=3 (0), N=4 (2), N=5 (10) plus first-solution check at N=4 = `[2, 4, 1, 3]`. N=8 omitted — interpreter is too slow (40320 perms); add once compiled clauses or constraint-style placement land. `range/3` skipped pending arithmetic-comparison built-ins (`>/2` etc.). - - [ ] `family.pl` — facts + rules (parent/ancestor) + - [x] `family.pl` — facts + rules (parent/ancestor) — `lib/prolog/tests/programs/family.{pl,sx}`. 5 parent facts + male/female + derived `father`/`mother`/`ancestor`/`sibling`. 10 tests cover direct facts, fact count, transitive ancestor through 3 generations, descendant counting, gender-restricted father/mother, sibling via shared parent + `\=`. - [ ] `lib/prolog/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` -- [ ] Target: all 5 classic programs passing +- [x] Target: all 5 classic programs passing — append (6) + reverse (6) + member (7) + nqueens (6) + family (10) = 35 program tests, all green. Phase 3 architecturally complete bar the conformance harness/scoreboard. ### Phase 4 — operator table + more built-ins (next run) - [ ] Operator table parsing (prefix/infix/postfix, precedence, assoc) @@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here): _Newest first. Agent appends on every commit._ +- 2026-04-25 — `family.pl` fifth classic program — completes the 5-program target. 5-fact pedigree + male/female + derived father/mother/ancestor/sibling. 10 tests cover fact lookup + count, transitive ancestor through 3 generations, descendant counting (5), gender-restricted derivations, sibling via shared parent guarded by `\=`. Total 183 (+10). All 5 classic programs ticked; Phase 3 needs only conformance harness + scoreboard left. - 2026-04-25 — `nqueens.pl` fourth classic program. Permute-and-test variant exercises every Phase-3 feature: lists with `[H|T]` cons sugar, multi-clause backtracking, recursive `permute`/`select`/`safe`/`no_attack`, `is/2` arithmetic on diagonals, `\=/2` for diagonal-conflict check. 6 tests at N ∈ {1,2,3,4,5} with expected counts {1,0,0,2,10} + first-solution `[2,4,1,3]`. N=5 takes ~30s (120 perms × safe-check); N=8 omitted as it would be ~thousands of seconds. Total 173 (+6). - 2026-04-25 — `member.pl` third classic program. Standard 2-clause definition; 7 tests cover bound-element hit/miss, empty-list fail, generator-count = list length, first-solution binding (X=11), duplicate elements matched twice on backtrack, anonymous-head unification (`member(a, [X, b, c])` binds X=a). Total 167 (+7). - 2026-04-25 — `reverse.pl` second classic program. Naive reverse defined via append. 6 tests (empty/singleton/3-list/4-atom-list/ground match/ground mismatch). Confirms the solver handles non-trivial recursive composition: `reverse([1,2,3], R)` recurses to depth 3 then unwinds via 3 nested `append`s. Total 160 (+6).