diff --git a/lib/prolog/tests/programs/member.pl b/lib/prolog/tests/programs/member.pl new file mode 100644 index 00000000..ca078b78 --- /dev/null +++ b/lib/prolog/tests/programs/member.pl @@ -0,0 +1,4 @@ +%% member/2 — list membership. +%% Generates all solutions on backtracking when the element is unbound. +member(X, [X|_]). +member(X, [_|T]) :- member(X, T). diff --git a/lib/prolog/tests/programs/member.sx b/lib/prolog/tests/programs/member.sx new file mode 100644 index 00000000..51e7846f --- /dev/null +++ b/lib/prolog/tests/programs/member.sx @@ -0,0 +1,91 @@ +;; lib/prolog/tests/programs/member.sx — member/2 generator. + +(define pl-mb-test-count 0) +(define pl-mb-test-pass 0) +(define pl-mb-test-fail 0) +(define pl-mb-test-failures (list)) + +(define + pl-mb-test! + (fn + (name got expected) + (begin + (set! pl-mb-test-count (+ pl-mb-test-count 1)) + (if + (= got expected) + (set! pl-mb-test-pass (+ pl-mb-test-pass 1)) + (begin + (set! pl-mb-test-fail (+ pl-mb-test-fail 1)) + (append! + pl-mb-test-failures + (str name "\n expected: " expected "\n got: " got))))))) + +(define + pl-mb-goal + (fn + (src env) + (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env))) + +(define pl-mb-prog-src "member(X, [X|_]). member(X, [_|T]) :- member(X, T).") + +(define pl-mb-db (pl-mk-db)) +(pl-db-load! pl-mb-db (pl-parse pl-mb-prog-src)) + +(pl-mb-test! + "member(2, [1, 2, 3]) succeeds" + (pl-solve-once! + pl-mb-db + (pl-mb-goal "member(2, [1, 2, 3])" {}) + (pl-mk-trail)) + true) + +(pl-mb-test! + "member(4, [1, 2, 3]) fails" + (pl-solve-once! + pl-mb-db + (pl-mb-goal "member(4, [1, 2, 3])" {}) + (pl-mk-trail)) + false) + +(pl-mb-test! + "member(X, []) fails" + (pl-solve-once! + pl-mb-db + (pl-mb-goal "member(X, [])" {}) + (pl-mk-trail)) + false) + +(pl-mb-test! + "member(X, [a, b, c]) generates 3 solutions" + (pl-solve-count! + pl-mb-db + (pl-mb-goal "member(X, [a, b, c])" {}) + (pl-mk-trail)) + 3) + +(define pl-mb-env-1 {}) +(define pl-mb-goal-1 (pl-mb-goal "member(X, [11, 22, 33])" pl-mb-env-1)) +(pl-solve-once! pl-mb-db pl-mb-goal-1 (pl-mk-trail)) + +(pl-mb-test! + "member(X, [11, 22, 33]) first solution X = 11" + (pl-num-val (pl-walk-deep (dict-get pl-mb-env-1 "X"))) + 11) + +(pl-mb-test! + "member(2, [1, 2, 3, 2, 1]) matches twice on backtrack" + (pl-solve-count! + pl-mb-db + (pl-mb-goal "member(2, [1, 2, 3, 2, 1])" {}) + (pl-mk-trail)) + 2) + +(pl-mb-test! + "member with unbound list cell unifies" + (pl-solve-once! + pl-mb-db + (pl-mb-goal "member(a, [X, b, c])" {}) + (pl-mk-trail)) + true) + +(define pl-member-tests-run! (fn () {:failed pl-mb-test-fail :passed pl-mb-test-pass :total pl-mb-test-count :failures pl-mb-test-failures})) diff --git a/plans/prolog-on-sx.md b/plans/prolog-on-sx.md index edf2b979..a4dcf3cb 100644 --- a/plans/prolog-on-sx.md +++ b/plans/prolog-on-sx.md @@ -58,7 +58,7 @@ Representation choices (finalise in phase 1, document here): - [ ] Classic programs in `lib/prolog/tests/programs/`: - [x] `append.pl` — list append (with backtracking) — `lib/prolog/tests/programs/append.{pl,sx}`. 6 tests cover: build (`append([], L, X)`, `append([1,2], [3,4], X)`), check ground match/mismatch, full split-backtracking (`append(X, Y, [1,2,3])` → 4 solutions), single-deduce (`append(X, [3], [1,2,3])` → X=[1,2]). - [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. - - [ ] `member.pl` — generate all solutions via backtracking + - [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. - [ ] `nqueens.pl` — 8-queens - [ ] `family.pl` — facts + rules (parent/ancestor) - [ ] `lib/prolog/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` @@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here): _Newest first. Agent appends on every commit._ +- 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). - 2026-04-25 — `append.pl` first classic program. `lib/prolog/tests/programs/append.pl` is the canonical 2-clause source; `append.sx` embeds the source as a string (no file-read primitive in SX yet) and runs 6 tests covering build, check, full split-backtrack (4 solutions), and deduction modes. Helpers `pl-ap-list-to-sx` / `pl-ap-term-to-sx` convert deep-walked Prolog lists (`("compound" "." (h t))` / `("atom" "[]")`) to SX lists for structural assertion. Total 154 (+6). - 2026-04-25 — `is/2` arithmetic landed. `pl-eval-arith` recursively evaluates ground RHS expressions (binary `+ - * /`, `mod`; binary+unary `-`; unary `abs`); `is/2` wraps the value as `("num" v)` and unifies via `pl-solve-eq!`, so it works in all three modes — bind unbound LHS, check ground LHS for equality, propagate from earlier var bindings on RHS. 11 tests, total 148 (+11). Without operator support, expressions must be written prefix: `is(X, +(2, *(3, 4)))`.