giles
2075db62ba
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
- parser.sx: add (":-" 1200 "xfx") to pl-op-table so (head :- body) parses
inside paren expressions (parens reset prec to 1200, allowing xfx match)
- parser.sx: extend pl-token-op to accept "op" token type, not just "atom",
since the tokenizer emits :- as {:type "op" :value ":-"}
- tests/assert_rules.sx: 15 new tests covering assertz/asserta with rule
terms, conjunction in rule body, recursive rules, and ordering
- conformance.sh: wire in assert_rules suite
- 456 → 471 tests, all passing
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
336 lines
9.6 KiB
Plaintext
336 lines
9.6 KiB
Plaintext
;; lib/prolog/tests/list_predicates.sx — ==/2, \==/2, flatten/2, numlist/3,
|
|
;; atomic_list_concat/2,3, sum_list/2, max_list/2, min_list/2, delete/3
|
|
|
|
(define pl-lp-test-count 0)
|
|
(define pl-lp-test-pass 0)
|
|
(define pl-lp-test-fail 0)
|
|
(define pl-lp-test-failures (list))
|
|
|
|
(define
|
|
pl-lp-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-lp-test-count (+ pl-lp-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-lp-test-pass (+ pl-lp-test-pass 1))
|
|
(begin
|
|
(set! pl-lp-test-fail (+ pl-lp-test-fail 1))
|
|
(append!
|
|
pl-lp-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-lp-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define pl-lp-db (pl-mk-db))
|
|
|
|
;; ── ==/2 ───────────────────────────────────────────────────────────
|
|
|
|
(pl-lp-test!
|
|
"==(a, a) succeeds"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "==(a, a)" {}) (pl-mk-trail))
|
|
true)
|
|
|
|
(pl-lp-test!
|
|
"==(a, b) fails"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "==(a, b)" {}) (pl-mk-trail))
|
|
false)
|
|
|
|
(pl-lp-test!
|
|
"==(1, 1) succeeds"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "==(1, 1)" {}) (pl-mk-trail))
|
|
true)
|
|
|
|
(pl-lp-test!
|
|
"==(1, 2) fails"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "==(1, 2)" {}) (pl-mk-trail))
|
|
false)
|
|
|
|
(pl-lp-test!
|
|
"==(f(a,b), f(a,b)) succeeds"
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "==(f(a,b), f(a,b))" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-lp-test!
|
|
"==(f(a,b), f(a,c)) fails"
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "==(f(a,b), f(a,c))" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; unbound var vs atom: fails (different tags)
|
|
(pl-lp-test!
|
|
"==(X, a) fails (unbound var vs atom)"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "==(X, a)" {}) (pl-mk-trail))
|
|
false)
|
|
|
|
;; two unbound vars with SAME name in same env share the same runtime var
|
|
(define pl-lp-env-same-var {})
|
|
(pl-lp-goal "==(X, X)" pl-lp-env-same-var)
|
|
(pl-lp-test!
|
|
"==(X, X) succeeds (same runtime var)"
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-instantiate
|
|
(nth (first (pl-parse "g :- ==(X, X).")) 2)
|
|
pl-lp-env-same-var)
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ── \==/2 ──────────────────────────────────────────────────────────
|
|
|
|
(pl-lp-test!
|
|
"\\==(a, b) succeeds"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "\\==(a, b)" {}) (pl-mk-trail))
|
|
true)
|
|
|
|
(pl-lp-test!
|
|
"\\==(a, a) fails"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "\\==(a, a)" {}) (pl-mk-trail))
|
|
false)
|
|
|
|
(pl-lp-test!
|
|
"\\==(X, a) succeeds (unbound var differs from atom)"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "\\==(X, a)" {}) (pl-mk-trail))
|
|
true)
|
|
|
|
(pl-lp-test!
|
|
"\\==(1, 2) succeeds"
|
|
(pl-solve-once! pl-lp-db (pl-lp-goal "\\==(1, 2)" {}) (pl-mk-trail))
|
|
true)
|
|
|
|
;; ── flatten/2 ──────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-fl1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "flatten([], F)" pl-lp-env-fl1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"flatten([], []) -> empty"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-fl1 "F")))
|
|
"[]")
|
|
|
|
(define pl-lp-env-fl2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "flatten([1,2,3], F)" pl-lp-env-fl2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"flatten([1,2,3], F) -> [1,2,3]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-fl2 "F")))
|
|
".(1, .(2, .(3, [])))")
|
|
|
|
(define pl-lp-env-fl3 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "flatten([1,[2,[3]],4], F)" pl-lp-env-fl3)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"flatten([1,[2,[3]],4], F) -> [1,2,3,4]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-fl3 "F")))
|
|
".(1, .(2, .(3, .(4, []))))")
|
|
|
|
(define pl-lp-env-fl4 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "flatten([[a,b],[c]], F)" pl-lp-env-fl4)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"flatten([[a,b],[c]], F) -> [a,b,c]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-fl4 "F")))
|
|
".(a, .(b, .(c, [])))")
|
|
|
|
;; ── numlist/3 ──────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-nl1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "numlist(1, 5, L)" pl-lp-env-nl1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"numlist(1,5,L) -> [1,2,3,4,5]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-nl1 "L")))
|
|
".(1, .(2, .(3, .(4, .(5, [])))))")
|
|
|
|
(define pl-lp-env-nl2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "numlist(3, 3, L)" pl-lp-env-nl2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"numlist(3,3,L) -> [3]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-nl2 "L")))
|
|
".(3, [])")
|
|
|
|
(pl-lp-test!
|
|
"numlist(5, 3, L) fails (Low > High)"
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "numlist(5, 3, L)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ── atomic_list_concat/2 ───────────────────────────────────────────
|
|
|
|
(define pl-lp-env-alc1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "atomic_list_concat([a, b, c], R)" pl-lp-env-alc1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"atomic_list_concat([a,b,c], R) -> abc"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-lp-env-alc1 "R")))
|
|
"abc")
|
|
|
|
(define pl-lp-env-alc2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "atomic_list_concat([hello, world], R)" pl-lp-env-alc2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"atomic_list_concat([hello,world], R) -> helloworld"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-lp-env-alc2 "R")))
|
|
"helloworld")
|
|
|
|
;; ── atomic_list_concat/3 ───────────────────────────────────────────
|
|
|
|
(define pl-lp-env-alcs1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "atomic_list_concat([a, b, c], '-', R)" pl-lp-env-alcs1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"atomic_list_concat([a,b,c], '-', R) -> a-b-c"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-lp-env-alcs1 "R")))
|
|
"a-b-c")
|
|
|
|
(define pl-lp-env-alcs2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "atomic_list_concat([x], '-', R)" pl-lp-env-alcs2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"atomic_list_concat([x], '-', R) -> x (single element, no sep)"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-lp-env-alcs2 "R")))
|
|
"x")
|
|
|
|
;; ── sum_list/2 ─────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-sl1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "sum_list([1,2,3], S)" pl-lp-env-sl1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"sum_list([1,2,3], S) -> 6"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-sl1 "S")))
|
|
6)
|
|
|
|
(define pl-lp-env-sl2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "sum_list([10], S)" pl-lp-env-sl2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"sum_list([10], S) -> 10"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-sl2 "S")))
|
|
10)
|
|
|
|
(define pl-lp-env-sl3 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "sum_list([], S)" pl-lp-env-sl3)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"sum_list([], S) -> 0"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-sl3 "S")))
|
|
0)
|
|
|
|
;; ── max_list/2 ─────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-mx1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "max_list([3,1,4,1,5,9,2,6], M)" pl-lp-env-mx1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"max_list([3,1,4,1,5,9,2,6], M) -> 9"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-mx1 "M")))
|
|
9)
|
|
|
|
(define pl-lp-env-mx2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "max_list([7], M)" pl-lp-env-mx2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"max_list([7], M) -> 7"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-mx2 "M")))
|
|
7)
|
|
|
|
;; ── min_list/2 ─────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-mn1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "min_list([3,1,4,1,5,9,2,6], M)" pl-lp-env-mn1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"min_list([3,1,4,1,5,9,2,6], M) -> 1"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-mn1 "M")))
|
|
1)
|
|
|
|
(define pl-lp-env-mn2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "min_list([5,2,8], M)" pl-lp-env-mn2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"min_list([5,2,8], M) -> 2"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-lp-env-mn2 "M")))
|
|
2)
|
|
|
|
;; ── delete/3 ───────────────────────────────────────────────────────
|
|
|
|
(define pl-lp-env-del1 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "delete([1,2,3,2,1], 2, R)" pl-lp-env-del1)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"delete([1,2,3,2,1], 2, R) -> [1,3,1]"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-del1 "R")))
|
|
".(1, .(3, .(1, [])))")
|
|
|
|
(define pl-lp-env-del2 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "delete([a,b,c], d, R)" pl-lp-env-del2)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"delete([a,b,c], d, R) -> [a,b,c] (nothing deleted)"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-del2 "R")))
|
|
".(a, .(b, .(c, [])))")
|
|
|
|
(define pl-lp-env-del3 {})
|
|
(pl-solve-once!
|
|
pl-lp-db
|
|
(pl-lp-goal "delete([], x, R)" pl-lp-env-del3)
|
|
(pl-mk-trail))
|
|
(pl-lp-test!
|
|
"delete([], x, R) -> []"
|
|
(pl-format-term (pl-walk-deep (dict-get pl-lp-env-del3 "R")))
|
|
"[]")
|
|
|
|
(define pl-list-predicates-tests-run! (fn () {:failed pl-lp-test-fail :passed pl-lp-test-pass :total pl-lp-test-count :failures pl-lp-test-failures}))
|