diff --git a/lib/prolog/tests/programs/reverse.pl b/lib/prolog/tests/programs/reverse.pl new file mode 100644 index 00000000..2591d43c --- /dev/null +++ b/lib/prolog/tests/programs/reverse.pl @@ -0,0 +1,7 @@ +%% reverse/2 — naive reverse via append/3. +%% Quadratic — accumulates the reversed prefix one append per cons. +reverse([], []). +reverse([H|T], R) :- reverse(T, RT), append(RT, [H], R). + +append([], L, L). +append([H|T], L, [H|R]) :- append(T, L, R). diff --git a/lib/prolog/tests/programs/reverse.sx b/lib/prolog/tests/programs/reverse.sx new file mode 100644 index 00000000..75efbe03 --- /dev/null +++ b/lib/prolog/tests/programs/reverse.sx @@ -0,0 +1,113 @@ +;; lib/prolog/tests/programs/reverse.sx — naive reverse/2 via append/3. +;; +;; Mirrors reverse.pl (embedded as a string here). + +(define pl-rv-test-count 0) +(define pl-rv-test-pass 0) +(define pl-rv-test-fail 0) +(define pl-rv-test-failures (list)) + +(define + pl-rv-test! + (fn + (name got expected) + (begin + (set! pl-rv-test-count (+ pl-rv-test-count 1)) + (if + (= got expected) + (set! pl-rv-test-pass (+ pl-rv-test-pass 1)) + (begin + (set! pl-rv-test-fail (+ pl-rv-test-fail 1)) + (append! + pl-rv-test-failures + (str name "\n expected: " expected "\n got: " got))))))) + +(define + pl-rv-term-to-sx + (fn + (t) + (cond + ((pl-num? t) (pl-num-val t)) + ((pl-atom? t) (pl-atom-name t)) + (true (list :complex))))) + +(define + pl-rv-list-walked + (fn + (w) + (cond + ((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list)) + ((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2)) + (cons + (pl-rv-term-to-sx (first (pl-args w))) + (pl-rv-list-walked (nth (pl-args w) 1)))) + (true (list :not-list))))) + +(define pl-rv-list-to-sx (fn (t) (pl-rv-list-walked (pl-walk-deep t)))) + +(define + pl-rv-goal + (fn + (src env) + (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env))) + +(define + pl-rv-prog-src + "reverse([], []). reverse([H|T], R) :- reverse(T, RT), append(RT, [H], R). append([], L, L). append([H|T], L, [H|R]) :- append(T, L, R).") + +(define pl-rv-db (pl-mk-db)) +(pl-db-load! pl-rv-db (pl-parse pl-rv-prog-src)) + +(define pl-rv-env-1 {}) +(define pl-rv-goal-1 (pl-rv-goal "reverse([], X)" pl-rv-env-1)) +(pl-solve-once! pl-rv-db pl-rv-goal-1 (pl-mk-trail)) + +(pl-rv-test! + "reverse([], X) → X = []" + (pl-rv-list-to-sx (dict-get pl-rv-env-1 "X")) + (list)) + +(define pl-rv-env-2 {}) +(define pl-rv-goal-2 (pl-rv-goal "reverse([1], X)" pl-rv-env-2)) +(pl-solve-once! pl-rv-db pl-rv-goal-2 (pl-mk-trail)) + +(pl-rv-test! + "reverse([1], X) → X = [1]" + (pl-rv-list-to-sx (dict-get pl-rv-env-2 "X")) + (list 1)) + +(define pl-rv-env-3 {}) +(define pl-rv-goal-3 (pl-rv-goal "reverse([1, 2, 3], X)" pl-rv-env-3)) +(pl-solve-once! pl-rv-db pl-rv-goal-3 (pl-mk-trail)) + +(pl-rv-test! + "reverse([1, 2, 3], X) → X = [3, 2, 1]" + (pl-rv-list-to-sx (dict-get pl-rv-env-3 "X")) + (list 3 2 1)) + +(define pl-rv-env-4 {}) +(define pl-rv-goal-4 (pl-rv-goal "reverse([a, b, c, d], X)" pl-rv-env-4)) +(pl-solve-once! pl-rv-db pl-rv-goal-4 (pl-mk-trail)) + +(pl-rv-test! + "reverse([a, b, c, d], X) → X = [d, c, b, a]" + (pl-rv-list-to-sx (dict-get pl-rv-env-4 "X")) + (list "d" "c" "b" "a")) + +(pl-rv-test! + "reverse([1, 2, 3], [3, 2, 1]) succeeds" + (pl-solve-once! + pl-rv-db + (pl-rv-goal "reverse([1, 2, 3], [3, 2, 1])" {}) + (pl-mk-trail)) + true) + +(pl-rv-test! + "reverse([1, 2], [1, 2]) fails" + (pl-solve-once! + pl-rv-db + (pl-rv-goal "reverse([1, 2], [1, 2])" {}) + (pl-mk-trail)) + false) + +(define pl-reverse-tests-run! (fn () {:failed pl-rv-test-fail :passed pl-rv-test-pass :total pl-rv-test-count :failures pl-rv-test-failures})) diff --git a/plans/prolog-on-sx.md b/plans/prolog-on-sx.md index 4ee19ea1..edf2b979 100644 --- a/plans/prolog-on-sx.md +++ b/plans/prolog-on-sx.md @@ -57,7 +57,7 @@ Representation choices (finalise in phase 1, document here): - [x] Arithmetic `is/2` with `+ - * / mod abs` — `pl-eval-arith` walks deep, recurses on compounds, dispatches on functor; binary `+ - * / mod`, binary AND unary `-`, unary `abs`. `is/2` evaluates RHS, wraps as `("num" v)`, unifies via `pl-solve-eq!`. 11 tests cover each op + nested + ground LHS match/mismatch + bound-var-on-RHS chain. - [ ] 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]). - - [ ] `reverse.pl` — naive reverse + - [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 - [ ] `nqueens.pl` — 8-queens - [ ] `family.pl` — facts + rules (parent/ancestor) @@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here): _Newest first. Agent appends on every commit._ +- 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)))`. - 2026-04-25 — `write/1` + `nl/0` landed using global string buffer (`pl-output-buffer` + `pl-output-clear!` + `pl-output-write!`). `pl-format-term` walks deep + dispatches on atom/num/str/compound/var; `pl-format-args` recursively comma-joins. 7 new tests cover atom/num/compound formatting, conjunction order, var-walk, and `nl`. Built-ins box (`=/2`, `\\=/2`, `true/0`, `fail/0`, `!/0`, `,/2`, `;/2`, `->/2`, `call/1`, `write/1`, `nl/0`) now ticked. Total 137 (+7).