giles
788ac9dd05
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
- 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 <noreply@anthropic.com>
255 lines
7.4 KiB
Plaintext
255 lines
7.4 KiB
Plaintext
;; 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}))
|