List/utility predicates: ==/2, \==/2, flatten/2, numlist/3, atomic_list_concat/2,3, sum_list/2, max_list/2, min_list/2, delete/3
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
33 new tests, all 375/375 conformance tests passing. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -33,6 +33,7 @@ SUITES=(
|
||||
"query_api:lib/prolog/tests/query_api.sx:pl-query-api-tests-run!"
|
||||
"iso_predicates:lib/prolog/tests/iso_predicates.sx:pl-iso-predicates-tests-run!"
|
||||
"meta_predicates:lib/prolog/tests/meta_predicates.sx:pl-meta-predicates-tests-run!"
|
||||
"list_predicates:lib/prolog/tests/list_predicates.sx:pl-list-predicates-tests-run!"
|
||||
)
|
||||
|
||||
SCRIPT='(epoch 1)
|
||||
|
||||
@@ -886,6 +886,154 @@
|
||||
k))
|
||||
(true false)))))
|
||||
|
||||
;; ── Structural equality helper (for ==/2, \==/2, delete/3) ────────
|
||||
(define
|
||||
pl-struct-eq?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((and (pl-var? a) (pl-var? b))
|
||||
(= (dict-get a :id) (dict-get b :id)))
|
||||
((and (pl-atom? a) (pl-atom? b))
|
||||
(= (pl-atom-name a) (pl-atom-name b)))
|
||||
((and (pl-num? a) (pl-num? b))
|
||||
(= (pl-num-val a) (pl-num-val b)))
|
||||
((and (pl-compound? a) (pl-compound? b))
|
||||
(if
|
||||
(and
|
||||
(= (pl-fun a) (pl-fun b))
|
||||
(= (len (pl-args a)) (len (pl-args b))))
|
||||
(let
|
||||
((all-eq true)
|
||||
(i 0))
|
||||
(begin
|
||||
(for-each
|
||||
(fn (ai)
|
||||
(begin
|
||||
(if
|
||||
(not (pl-struct-eq? ai (nth (pl-args b) i)))
|
||||
(set! all-eq false)
|
||||
nil)
|
||||
(set! i (+ i 1))))
|
||||
(pl-args a))
|
||||
all-eq))
|
||||
false))
|
||||
(true false))))
|
||||
|
||||
;; ── Flatten helper: collect all non-list leaves into SX list ───────
|
||||
(define
|
||||
pl-flatten-prolog
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((w (pl-walk-deep t)))
|
||||
(cond
|
||||
((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list))
|
||||
((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
|
||||
(let
|
||||
((h (pl-walk-deep (first (pl-args w))))
|
||||
(tl (nth (pl-args w) 1)))
|
||||
(if
|
||||
(or
|
||||
(and (pl-atom? h) (= (pl-atom-name h) "[]"))
|
||||
(and (pl-compound? h) (= (pl-fun h) ".")))
|
||||
(append (pl-flatten-prolog h) (pl-flatten-prolog tl))
|
||||
(cons h (pl-flatten-prolog tl)))))
|
||||
(true (list w))))))
|
||||
|
||||
;; ── numlist helper: build SX list of ("num" i) for i in [lo..hi] ──
|
||||
(define
|
||||
pl-numlist-build
|
||||
(fn
|
||||
(lo hi)
|
||||
(if
|
||||
(> lo hi)
|
||||
(list)
|
||||
(cons (list "num" lo) (pl-numlist-build (+ lo 1) hi)))))
|
||||
|
||||
;; ── atomic_list_concat helper: collect atom names / num vals ───────
|
||||
(define
|
||||
pl-atomic-list-collect
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(map
|
||||
(fn (item)
|
||||
(let
|
||||
((w (pl-walk-deep item)))
|
||||
(cond
|
||||
((pl-atom? w) (pl-atom-name w))
|
||||
((pl-num? w) (str (pl-num-val w)))
|
||||
(true ""))))
|
||||
items))))
|
||||
|
||||
;; ── sum_list helper ────────────────────────────────────────────────
|
||||
(define
|
||||
pl-sum-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(+ acc (pl-num-val (pl-walk-deep item))))
|
||||
0
|
||||
items))))
|
||||
|
||||
;; ── max_list / min_list helpers ────────────────────────────────────
|
||||
(define
|
||||
pl-max-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(let ((v (pl-num-val (pl-walk-deep item))))
|
||||
(if (> v acc) v acc)))
|
||||
(pl-num-val (pl-walk-deep (first items)))
|
||||
(rest items)))))
|
||||
|
||||
(define
|
||||
pl-min-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(let ((v (pl-num-val (pl-walk-deep item))))
|
||||
(if (< v acc) v acc)))
|
||||
(pl-num-val (pl-walk-deep (first items)))
|
||||
(rest items)))))
|
||||
|
||||
;; ── delete/3 helper: remove elements struct-equal to elem ──────────
|
||||
(define
|
||||
pl-delete-sx
|
||||
(fn
|
||||
(prolog-list elem)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list))
|
||||
(ew (pl-walk-deep elem)))
|
||||
(filter
|
||||
(fn (item)
|
||||
(not (pl-struct-eq? (pl-walk-deep item) ew)))
|
||||
items))))
|
||||
|
||||
;; ── join string list with separator ────────────────────────────────
|
||||
(define
|
||||
pl-join-strings
|
||||
(fn
|
||||
(strs sep)
|
||||
(if
|
||||
(empty? strs)
|
||||
""
|
||||
(reduce
|
||||
(fn (acc s) (str acc sep s))
|
||||
(first strs)
|
||||
(rest strs)))))
|
||||
|
||||
(define
|
||||
pl-solve!
|
||||
(fn
|
||||
@@ -1326,6 +1474,148 @@
|
||||
k)))
|
||||
false))
|
||||
(true false))))
|
||||
|
||||
;; ==/2 — structural equality (no binding)
|
||||
((and (pl-compound? g) (= (pl-fun g) "==") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk-deep (first (pl-args g))))
|
||||
(b (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if (pl-struct-eq? a b) (k) false)))
|
||||
|
||||
;; \==/2 — structural inequality
|
||||
((and (pl-compound? g) (= (pl-fun g) "\\==") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk-deep (first (pl-args g))))
|
||||
(b (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if (pl-struct-eq? a b) false (k))))
|
||||
|
||||
;; flatten/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "flatten") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((flat-sx (pl-flatten-prolog lst-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog flat-sx)
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; numlist/3
|
||||
((and (pl-compound? g) (= (pl-fun g) "numlist") (= (len (pl-args g)) 3))
|
||||
(let
|
||||
((wlo (pl-walk-deep (first (pl-args g))))
|
||||
(whi (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if
|
||||
(and (pl-num? wlo) (pl-num? whi))
|
||||
(let
|
||||
((lo (pl-num-val wlo)) (hi (pl-num-val whi)))
|
||||
(if
|
||||
(> lo hi)
|
||||
false
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(pl-list-to-prolog (pl-numlist-build lo hi))
|
||||
trail
|
||||
k)))
|
||||
false)))
|
||||
|
||||
;; atomic_list_concat/2 — no separator
|
||||
((and
|
||||
(pl-compound? g)
|
||||
(= (pl-fun g) "atomic_list_concat")
|
||||
(= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((strs (pl-atomic-list-collect lst-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "atom" (reduce (fn (a b) (str a b)) "" strs))
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; atomic_list_concat/3 — with separator
|
||||
((and
|
||||
(pl-compound? g)
|
||||
(= (pl-fun g) "atomic_list_concat")
|
||||
(= (len (pl-args g)) 3))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g))))
|
||||
(sep-rt (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (pl-atom? sep-rt))
|
||||
(let
|
||||
((strs (pl-atomic-list-collect lst-rt))
|
||||
(sep (pl-atom-name sep-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(list "atom" (pl-join-strings strs sep))
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; sum_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "sum_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-sum-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; max_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "max_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-max-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; min_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "min_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-min-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; delete/3
|
||||
((and (pl-compound? g) (= (pl-fun g) "delete") (= (len (pl-args g)) 3))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g))))
|
||||
(elem-rt (nth (pl-args g) 1)))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((filtered (pl-delete-sx lst-rt elem-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(pl-list-to-prolog filtered)
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
(true (pl-solve-user! db g trail cut-box k))))))
|
||||
|
||||
(define
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{
|
||||
"total_passed": 342,
|
||||
"total_passed": 375,
|
||||
"total_failed": 0,
|
||||
"total": 342,
|
||||
"suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0}},
|
||||
"generated": "2026-04-25T11:05:56+00:00"
|
||||
"total": 375,
|
||||
"suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0}},
|
||||
"generated": "2026-04-25T11:37:33+00:00"
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Prolog scoreboard
|
||||
|
||||
**342 / 342 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T11:05:56+00:00.
|
||||
**375 / 375 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T11:37:33+00:00.
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -22,6 +22,7 @@ Generated 2026-04-25T11:05:56+00:00.
|
||||
| query_api | 16 | 16 | ok |
|
||||
| iso_predicates | 29 | 29 | ok |
|
||||
| meta_predicates | 25 | 25 | ok |
|
||||
| list_predicates | 33 | 33 | ok |
|
||||
|
||||
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
|
||||
with `SX_SERVER=path/to/sx_server.exe bash …`.
|
||||
|
||||
330
lib/prolog/tests/list_predicates.sx
Normal file
330
lib/prolog/tests/list_predicates.sx
Normal file
@@ -0,0 +1,330 @@
|
||||
;; 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}))
|
||||
Reference in New Issue
Block a user