From 788ac9dd05fe600622d909f696397edc30121966 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 14:13:12 +0000 Subject: [PATCH] predsort/3, term_variables/2, arith: floor/ceiling/truncate/round/sign/sqrt/pow MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - pl-eval-arith: add floor, ceiling, truncate, round, sqrt, sign, pow, integer, float, float_integer_part, float_fractional_part, **, ^ operators - pl-collect-vars: helper that extracts unbound variables from a term (left-to-right, deduplicated by var id) - term_variables/2: dispatches via pl-collect-vars, unifies second arg with var list - pl-predsort-insert!: inserts one element into a sorted list using a 3-arg comparator predicate; deduplicates elements where comparator returns '=' - pl-predsort-build!: builds sorted list via fold over pl-predsort-insert! - predsort/3: full ISO predsort — sorts and deduplicates a list using a caller-supplied predicate - lib/prolog/tests/advanced.sx: 21 tests (12 arith, 5 term_variables, 4 predsort) - conformance.sh: add advanced suite - scoreboard: 517/517 (was 496/496) Co-Authored-By: Claude Sonnet 4.6 --- lib/prolog/conformance.sh | 1 + lib/prolog/runtime.sx | 201 +++++++++++++++++++++------ lib/prolog/scoreboard.json | 8 +- lib/prolog/scoreboard.md | 5 +- lib/prolog/tests/advanced.sx | 254 +++++++++++++++++++++++++++++++++++ 5 files changed, 424 insertions(+), 45 deletions(-) create mode 100644 lib/prolog/tests/advanced.sx diff --git a/lib/prolog/conformance.sh b/lib/prolog/conformance.sh index 0a963778..4f840cf9 100755 --- a/lib/prolog/conformance.sh +++ b/lib/prolog/conformance.sh @@ -40,6 +40,7 @@ SUITES=( "io_predicates:lib/prolog/tests/io_predicates.sx:pl-io-predicates-tests-run!" "assert_rules:lib/prolog/tests/assert_rules.sx:pl-assert-rules-tests-run!" "string_agg:lib/prolog/tests/string_agg.sx:pl-string-agg-tests-run!" + "advanced:lib/prolog/tests/advanced.sx:pl-advanced-tests-run!" ) SCRIPT='(epoch 1) diff --git a/lib/prolog/runtime.sx b/lib/prolog/runtime.sx index 74581361..f9a1342f 100644 --- a/lib/prolog/runtime.sx +++ b/lib/prolog/runtime.sx @@ -410,6 +410,72 @@ ((sorted-keys (sort (keys kv)))) (map (fn (k) (dict-get kv k)) sorted-keys)))))) +(define + pl-collect-vars + (fn + (term seen-ids) + (let + ((walked (pl-walk term))) + (cond + ((pl-var? walked) + (let + ((id (pl-var-id walked))) + (if + (some (fn (s) (= s id)) seen-ids) + (list seen-ids (list)) + (list (cons id seen-ids) (list walked))))) + ((pl-compound? walked) + (reduce + (fn + (acc arg) + (let + ((result (pl-collect-vars arg (first acc)))) + (list (first result) (append (nth acc 1) (nth result 1))))) + (list seen-ids (list)) + (pl-args walked))) + (true (list seen-ids (list))))))) + +(define + pl-predsort-insert! + (fn + (db pred elem sorted trail) + (if + (empty? sorted) + (list elem) + (let + ((head (first sorted)) (order-var (pl-mk-rt-var "_PO"))) + (let + ((call-goal (pl-apply-goal pred (list order-var elem head))) + (mark (pl-trail-mark trail))) + (let + ((ok (pl-solve-once! db call-goal trail))) + (if + ok + (let + ((order (pl-atom-name (pl-walk-deep order-var)))) + (do + (pl-trail-undo-to! trail mark) + (cond + ((= order "<") (cons elem sorted)) + ((= order "=") sorted) + ((= order ">") + (let + ((rest-sorted (pl-predsort-insert! db pred elem (rest sorted) trail))) + (if rest-sorted (cons head rest-sorted) false))) + (true false)))) + (begin (pl-trail-undo-to! trail mark) false)))))))) + +(define + pl-predsort-build! + (fn + (db pred items trail) + (reduce + (fn + (sorted elem) + (if sorted (pl-predsort-insert! db pred elem sorted trail) false)) + (list) + items))) + (define pl-collect-solutions (fn @@ -782,6 +848,7 @@ false))) (true false))))) +;; ── Structural equality helper (for ==/2, \==/2, delete/3) ──────── (define pl-solve-atom-chars! (fn @@ -820,6 +887,7 @@ false)) (true false))))) +;; ── Flatten helper: collect all non-list leaves into SX list ─────── (define pl-solve-atom-codes! (fn @@ -864,6 +932,7 @@ false)) (true false))))) +;; ── numlist helper: build SX list of ("num" i) for i in [lo..hi] ── (define pl-solve-char-code! (fn @@ -886,7 +955,7 @@ k)) (true false))))) -;; ── Structural equality helper (for ==/2, \==/2, delete/3) ──────── +;; ── atomic_list_concat helper: collect atom names / num vals ─────── (define pl-struct-eq? (fn @@ -896,19 +965,18 @@ (= (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-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)) + ((all-eq true) (i 0)) (begin (for-each - (fn (ai) + (fn + (ai) (begin (if (not (pl-struct-eq? ai (nth (pl-args b) i))) @@ -920,7 +988,7 @@ false)) (true false)))) -;; ── Flatten helper: collect all non-list leaves into SX list ─────── +;; ── sum_list helper ──────────────────────────────────────────────── (define pl-flatten-prolog (fn @@ -941,7 +1009,7 @@ (cons h (pl-flatten-prolog tl))))) (true (list w)))))) -;; ── numlist helper: build SX list of ("num" i) for i in [lo..hi] ── +;; ── max_list / min_list helpers ──────────────────────────────────── (define pl-numlist-build (fn @@ -951,7 +1019,6 @@ (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 @@ -959,7 +1026,8 @@ (let ((items (pl-prolog-list-to-sx prolog-list))) (map - (fn (item) + (fn + (item) (let ((w (pl-walk-deep item))) (cond @@ -968,7 +1036,7 @@ (true "")))) items)))) -;; ── sum_list helper ──────────────────────────────────────────────── +;; ── delete/3 helper: remove elements struct-equal to elem ────────── (define pl-sum-list-sx (fn @@ -976,12 +1044,11 @@ (let ((items (pl-prolog-list-to-sx prolog-list))) (reduce - (fn (acc item) - (+ acc (pl-num-val (pl-walk-deep item)))) + (fn (acc item) (+ acc (pl-num-val (pl-walk-deep item)))) 0 items)))) -;; ── max_list / min_list helpers ──────────────────────────────────── +;; ── join string list with separator ──────────────────────────────── (define pl-max-list-sx (fn @@ -989,8 +1056,10 @@ (let ((items (pl-prolog-list-to-sx prolog-list))) (reduce - (fn (acc item) - (let ((v (pl-num-val (pl-walk-deep item)))) + (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))))) @@ -1002,26 +1071,24 @@ (let ((items (pl-prolog-list-to-sx prolog-list))) (reduce - (fn (acc item) - (let ((v (pl-num-val (pl-walk-deep item)))) + (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))) + ((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))) + (fn (item) (not (pl-struct-eq? (pl-walk-deep item) ew))) items)))) -;; ── join string list with separator ──────────────────────────────── (define pl-join-strings (fn @@ -1029,10 +1096,7 @@ (if (empty? strs) "" - (reduce - (fn (acc s) (str acc sep s)) - (first strs) - (rest strs))))) + (reduce (fn (acc s) (str acc sep s)) (first strs) (rest strs))))) (define pl-apply-goal @@ -1433,14 +1497,7 @@ (let ((clause (first parsed))) (let - ((actual-term - (if - (and - (list? clause) - (= (len clause) 3) - (= (nth clause 0) "clause")) - (nth clause 1) - clause))) + ((actual-term (if (and (list? clause) (= (len clause) 3) (= (nth clause 0) "clause")) (nth clause 1) clause))) (let ((fresh (pl-instantiate actual-term {}))) (if (pl-unify! term-arg fresh trail) (k) false)))) @@ -1473,10 +1530,14 @@ (set! pl-output-buffer saved-buffer) (if result - (if (pl-unify! var (list "atom" captured) trail) (k) false) + (if + (pl-unify! var (list "atom" captured) trail) + (k) + false) false)))))) false)))) + (define pl-solve-writeln! (fn @@ -1495,7 +1556,8 @@ (if (pl-atom? fmt-walked) (do - (pl-output-write! (pl-format-process (pl-atom-name fmt-walked) (list))) + (pl-output-write! + (pl-format-process (pl-atom-name fmt-walked) (list))) (k)) false)))) @@ -1516,7 +1578,6 @@ (k))) false)))) - (define pl-substring (fn (s start sublen) (substring s start (+ start sublen)))) @@ -2407,6 +2468,32 @@ (pl-walk (nth (pl-args g) 2)) trail k)) + ((and (pl-compound? g) (= (pl-fun g) "term_variables") (= (len (pl-args g)) 2)) + (let + ((term (pl-walk (nth (pl-args g) 0))) + (vars-arg (pl-walk (nth (pl-args g) 1)))) + (let + ((result (pl-collect-vars term (list)))) + (let + ((var-list (nth result 1))) + (let + ((prolog-vars (pl-list-to-prolog var-list))) + (if (pl-unify! vars-arg prolog-vars trail) (k) false)))))) + ((and (pl-compound? g) (= (pl-fun g) "predsort") (= (len (pl-args g)) 3)) + (let + ((pred (pl-walk (nth (pl-args g) 0))) + (list-arg (pl-walk (nth (pl-args g) 1))) + (result-arg (pl-walk (nth (pl-args g) 2)))) + (let + ((items (pl-prolog-list-to-sx (pl-walk-deep list-arg)))) + (let + ((sorted (pl-predsort-build! db pred items trail))) + (if + sorted + (let + ((prolog-sorted (pl-list-to-prolog sorted))) + (if (pl-unify! result-arg prolog-sorted trail) (k) false)) + false))))) (true (pl-solve-user! db g trail cut-box k)))))) (define @@ -2543,6 +2630,42 @@ ((va (pl-eval-arith (first args))) (vb (pl-eval-arith (nth args 1)))) (cond ((< va vb) va) (true vb)))) + ((and (= f "floor") (= (len args) 1)) + (floor (pl-eval-arith (first args)))) + ((and (= f "ceiling") (= (len args) 1)) + (ceil (pl-eval-arith (first args)))) + ((and (= f "truncate") (= (len args) 1)) + (truncate (pl-eval-arith (first args)))) + ((and (= f "round") (= (len args) 1)) + (round (pl-eval-arith (first args)))) + ((and (= f "sqrt") (= (len args) 1)) + (sqrt (pl-eval-arith (first args)))) + ((and (= f "sign") (= (len args) 1)) + (let + ((v (pl-eval-arith (first args)))) + (cond ((< v 0) -1) ((> v 0) 1) (true 0)))) + ((and (= f "integer") (= (len args) 1)) + (truncate (pl-eval-arith (first args)))) + ((and (= f "float") (= (len args) 1)) + (pl-eval-arith (first args))) + ((and (= f "float_integer_part") (= (len args) 1)) + (truncate (pl-eval-arith (first args)))) + ((and (= f "float_fractional_part") (= (len args) 1)) + (let + ((v (pl-eval-arith (first args)))) + (- v (truncate v)))) + ((and (= f "**") (= (len args) 2)) + (pow + (pl-eval-arith (first args)) + (pl-eval-arith (nth args 1)))) + ((and (= f "^") (= (len args) 2)) + (pow + (pl-eval-arith (first args)) + (pl-eval-arith (nth args 1)))) + ((and (= f "pow") (= (len args) 2)) + (pow + (pl-eval-arith (first args)) + (pl-eval-arith (nth args 1)))) (true 0)))) (true 0))))) diff --git a/lib/prolog/scoreboard.json b/lib/prolog/scoreboard.json index d8032461..49c6c7c4 100644 --- a/lib/prolog/scoreboard.json +++ b/lib/prolog/scoreboard.json @@ -1,7 +1,7 @@ { - "total_passed": 496, + "total_passed": 517, "total_failed": 0, - "total": 496, - "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},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0},"string_agg":{"passed":25,"total":25,"failed":0}}, - "generated": "2026-04-25T13:49:43+00:00" + "total": 517, + "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},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0},"string_agg":{"passed":25,"total":25,"failed":0},"advanced":{"passed":21,"total":21,"failed":0}}, + "generated": "2026-04-25T14:12:52+00:00" } diff --git a/lib/prolog/scoreboard.md b/lib/prolog/scoreboard.md index 4f2ad17d..e0570b16 100644 --- a/lib/prolog/scoreboard.md +++ b/lib/prolog/scoreboard.md @@ -1,7 +1,7 @@ # Prolog scoreboard -**496 / 496 passing** (0 failure(s)). -Generated 2026-04-25T13:49:43+00:00. +**517 / 517 passing** (0 failure(s)). +Generated 2026-04-25T14:12:52+00:00. | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -29,6 +29,7 @@ Generated 2026-04-25T13:49:43+00:00. | io_predicates | 24 | 24 | ok | | assert_rules | 15 | 15 | ok | | string_agg | 25 | 25 | ok | +| advanced | 21 | 21 | ok | Run `bash lib/prolog/conformance.sh` to refresh. Override the binary with `SX_SERVER=path/to/sx_server.exe bash …`. diff --git a/lib/prolog/tests/advanced.sx b/lib/prolog/tests/advanced.sx new file mode 100644 index 00000000..3b5afb4d --- /dev/null +++ b/lib/prolog/tests/advanced.sx @@ -0,0 +1,254 @@ +;; lib/prolog/tests/advanced.sx — predsort/3, term_variables/2, arith extensions + +(define pl-adv-test-count 0) +(define pl-adv-test-pass 0) +(define pl-adv-test-fail 0) +(define pl-adv-test-failures (list)) + +(define + pl-adv-test! + (fn + (name got expected) + (begin + (set! pl-adv-test-count (+ pl-adv-test-count 1)) + (if + (= got expected) + (set! pl-adv-test-pass (+ pl-adv-test-pass 1)) + (begin + (set! pl-adv-test-fail (+ pl-adv-test-fail 1)) + (append! + pl-adv-test-failures + (str name "\n expected: " expected "\n got: " got))))))) + +(define + pl-adv-goal + (fn + (src env) + (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env))) + +(define pl-adv-db (pl-mk-db)) +;; Load a numeric comparator for predsort tests +(pl-db-load! + pl-adv-db + (pl-parse + "cmp_num(Order, X, Y) :- (X < Y -> Order = '<' ; (X > Y -> Order = '>' ; Order = '=')).")) + +;; ── Arithmetic extensions ────────────────────────────────────────── + +(define pl-adv-arith-env-1 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is floor(3.7)" pl-adv-arith-env-1) + (pl-mk-trail)) +(pl-adv-test! + "floor(3.7) = 3" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-1 "X"))) + 3) + +(define pl-adv-arith-env-2 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is ceiling(3.2)" pl-adv-arith-env-2) + (pl-mk-trail)) +(pl-adv-test! + "ceiling(3.2) = 4" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-2 "X"))) + 4) + +(define pl-adv-arith-env-3 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is truncate(3.9)" pl-adv-arith-env-3) + (pl-mk-trail)) +(pl-adv-test! + "truncate(3.9) = 3" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-3 "X"))) + 3) + +(define pl-adv-arith-env-4 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is truncate(0 - 3.9)" pl-adv-arith-env-4) + (pl-mk-trail)) +(pl-adv-test! + "truncate(0-3.9) = -3" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-4 "X"))) + -3) + +(define pl-adv-arith-env-5 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is round(3.5)" pl-adv-arith-env-5) + (pl-mk-trail)) +(pl-adv-test! + "round(3.5) = 4" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-5 "X"))) + 4) + +(define pl-adv-arith-env-6 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is sqrt(4.0)" pl-adv-arith-env-6) + (pl-mk-trail)) +(pl-adv-test! + "sqrt(4.0) = 2" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-6 "X"))) + 2) + +(define pl-adv-arith-env-7 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is sign(0 - 5)" pl-adv-arith-env-7) + (pl-mk-trail)) +(pl-adv-test! + "sign(0-5) = -1" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-7 "X"))) + -1) + +(define pl-adv-arith-env-8 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is sign(0)" pl-adv-arith-env-8) + (pl-mk-trail)) +(pl-adv-test! + "sign(0) = 0" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-8 "X"))) + 0) + +(define pl-adv-arith-env-9 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is sign(3)" pl-adv-arith-env-9) + (pl-mk-trail)) +(pl-adv-test! + "sign(3) = 1" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-9 "X"))) + 1) + +(define pl-adv-arith-env-10 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is pow(2, 3)" pl-adv-arith-env-10) + (pl-mk-trail)) +(pl-adv-test! + "pow(2,3) = 8" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-10 "X"))) + 8) + +(define pl-adv-arith-env-11 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is floor(0 - 3.7)" pl-adv-arith-env-11) + (pl-mk-trail)) +(pl-adv-test! + "floor(0-3.7) = -4" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-11 "X"))) + -4) + +(define pl-adv-arith-env-12 {:X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "X is ceiling(0 - 3.2)" pl-adv-arith-env-12) + (pl-mk-trail)) +(pl-adv-test! + "ceiling(0-3.2) = -3" + (pl-num-val (pl-walk-deep (dict-get pl-adv-arith-env-12 "X"))) + -3) + +;; ── term_variables/2 ────────────────────────────────────────────── + +(define pl-adv-tv-env-1 {:Vs (pl-mk-rt-var "Vs")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "term_variables(hello, Vs)" pl-adv-tv-env-1) + (pl-mk-trail)) +(pl-adv-test! + "term_variables(hello,Vs) -> []" + (pl-format-term (pl-walk-deep (dict-get pl-adv-tv-env-1 "Vs"))) + "[]") + +(define pl-adv-tv-env-2 {:Vs (pl-mk-rt-var "Vs")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "term_variables(f(a, g(b)), Vs)" pl-adv-tv-env-2) + (pl-mk-trail)) +(pl-adv-test! + "term_variables(f(a,g(b)),Vs) -> []" + (pl-format-term (pl-walk-deep (dict-get pl-adv-tv-env-2 "Vs"))) + "[]") + +(define pl-adv-tv-env-3 {:Y (pl-mk-rt-var "Y") :Vs (pl-mk-rt-var "Vs") :X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "term_variables(f(X, Y), Vs)" pl-adv-tv-env-3) + (pl-mk-trail)) +(pl-adv-test! + "term_variables(f(X,Y),Vs) has 2 vars" + (pl-list-length (pl-walk-deep (dict-get pl-adv-tv-env-3 "Vs"))) + 2) + +(define pl-adv-tv-env-4 {:Vs (pl-mk-rt-var "Vs") :X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "term_variables(X, Vs)" pl-adv-tv-env-4) + (pl-mk-trail)) +(pl-adv-test! + "term_variables(X,Vs) has 1 var" + (pl-list-length (pl-walk-deep (dict-get pl-adv-tv-env-4 "Vs"))) + 1) + +(define pl-adv-tv-env-5 {:Y (pl-mk-rt-var "Y") :Vs (pl-mk-rt-var "Vs") :X (pl-mk-rt-var "X")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "term_variables(foo(X, Y, X), Vs)" pl-adv-tv-env-5) + (pl-mk-trail)) +(pl-adv-test! + "term_variables(foo(X,Y,X),Vs) deduplicates X -> 2 vars" + (pl-list-length (pl-walk-deep (dict-get pl-adv-tv-env-5 "Vs"))) + 2) + +;; ── predsort/3 ──────────────────────────────────────────────────── + +(define pl-adv-ps-env-1 {:R (pl-mk-rt-var "R")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "predsort(cmp_num, [], R)" pl-adv-ps-env-1) + (pl-mk-trail)) +(pl-adv-test! + "predsort([]) -> []" + (pl-format-term (pl-walk-deep (dict-get pl-adv-ps-env-1 "R"))) + "[]") + +(define pl-adv-ps-env-2 {:R (pl-mk-rt-var "R")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "predsort(cmp_num, [1], R)" pl-adv-ps-env-2) + (pl-mk-trail)) +(pl-adv-test! + "predsort([1]) -> [1]" + (pl-format-term (pl-walk-deep (dict-get pl-adv-ps-env-2 "R"))) + ".(1, [])") + +(define pl-adv-ps-env-3 {:R (pl-mk-rt-var "R")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "predsort(cmp_num, [3,1,2], R)" pl-adv-ps-env-3) + (pl-mk-trail)) +(pl-adv-test! + "predsort([3,1,2]) -> [1,2,3]" + (pl-format-term (pl-walk-deep (dict-get pl-adv-ps-env-3 "R"))) + ".(1, .(2, .(3, [])))") + +(define pl-adv-ps-env-4 {:R (pl-mk-rt-var "R")}) +(pl-solve-once! + pl-adv-db + (pl-adv-goal "predsort(cmp_num, [3,1,2,1,3], R)" pl-adv-ps-env-4) + (pl-mk-trail)) +(pl-adv-test! + "predsort([3,1,2,1,3]) dedup -> [1,2,3]" + (pl-format-term (pl-walk-deep (dict-get pl-adv-ps-env-4 "R"))) + ".(1, .(2, .(3, [])))") + +;; ── Runner ───────────────────────────────────────────────────────── + +(define pl-advanced-tests-run! (fn () {:failed pl-adv-test-fail :passed pl-adv-test-pass :total pl-adv-test-count :failures pl-adv-test-failures}))