;; 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}))