prolog: family.pl + family.sx, 10 tests; 5/5 classic programs done
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
24
lib/prolog/tests/programs/family.pl
Normal file
24
lib/prolog/tests/programs/family.pl
Normal file
@@ -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).
|
||||
116
lib/prolog/tests/programs/family.sx
Normal file
116
lib/prolog/tests/programs/family.sx
Normal file
@@ -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}))
|
||||
@@ -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).
|
||||
|
||||
Reference in New Issue
Block a user