prolog: reverse.pl + reverse.sx (naive via append), 6 tests
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:
7
lib/prolog/tests/programs/reverse.pl
Normal file
7
lib/prolog/tests/programs/reverse.pl
Normal file
@@ -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).
|
||||
113
lib/prolog/tests/programs/reverse.sx
Normal file
113
lib/prolog/tests/programs/reverse.sx
Normal file
@@ -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}))
|
||||
@@ -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).
|
||||
|
||||
Reference in New Issue
Block a user