giles
f72868c445
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
306 lines
6.4 KiB
Plaintext
306 lines
6.4 KiB
Plaintext
;; lib/prolog/tests/atoms.sx — type predicates + string/atom built-ins
|
|
|
|
(define pl-at-test-count 0)
|
|
(define pl-at-test-pass 0)
|
|
(define pl-at-test-fail 0)
|
|
(define pl-at-test-failures (list))
|
|
|
|
(define
|
|
pl-at-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-at-test-count (+ pl-at-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-at-test-pass (+ pl-at-test-pass 1))
|
|
(begin
|
|
(set! pl-at-test-fail (+ pl-at-test-fail 1))
|
|
(append!
|
|
pl-at-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-at-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define pl-at-db (pl-mk-db))
|
|
|
|
;; ── var/1 + nonvar/1 ──
|
|
|
|
(pl-at-test!
|
|
"var(X) for unbound var"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "var(X)" {}) (pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"var(foo) fails"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "var(foo)" {}) (pl-mk-trail))
|
|
false)
|
|
(pl-at-test!
|
|
"nonvar(foo) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "nonvar(foo)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"nonvar(X) for unbound var fails"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "nonvar(X)" {}) (pl-mk-trail))
|
|
false)
|
|
|
|
;; ── atom/1 ──
|
|
|
|
(pl-at-test!
|
|
"atom(foo) succeeds"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "atom(foo)" {}) (pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"atom([]) succeeds"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "atom([])" {}) (pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"atom(42) fails"
|
|
(pl-solve-once! pl-at-db (pl-at-goal "atom(42)" {}) (pl-mk-trail))
|
|
false)
|
|
(pl-at-test!
|
|
"atom(f(x)) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom(f(x))" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ── number/1 + integer/1 ──
|
|
|
|
(pl-at-test!
|
|
"number(42) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "number(42)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"number(foo) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "number(foo)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
(pl-at-test!
|
|
"integer(7) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "integer(7)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ── compound/1 + callable/1 + atomic/1 ──
|
|
|
|
(pl-at-test!
|
|
"compound(f(x)) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "compound(f(x))" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"compound(foo) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "compound(foo)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
(pl-at-test!
|
|
"callable(foo) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "callable(foo)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"callable(f(x)) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "callable(f(x))" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"callable(42) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "callable(42)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
(pl-at-test!
|
|
"atomic(foo) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atomic(foo)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"atomic(42) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atomic(42)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"atomic(f(x)) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atomic(f(x))" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ── is_list/1 ──
|
|
|
|
(pl-at-test!
|
|
"is_list([]) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "is_list([])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"is_list([1,2,3]) succeeds"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "is_list([1,2,3])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"is_list(foo) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "is_list(foo)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ── atom_length/2 ──
|
|
|
|
(define pl-at-env-al {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_length(hello, N)" pl-at-env-al)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"atom_length(hello, N) -> N=5"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-at-env-al "N")))
|
|
5)
|
|
(pl-at-test!
|
|
"atom_length empty atom"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_length('', 0)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ── atom_concat/3 ──
|
|
|
|
(define pl-at-env-ac {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_concat(foo, bar, X)" pl-at-env-ac)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"atom_concat(foo, bar, X) -> X=foobar"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ac "X")))
|
|
"foobar")
|
|
|
|
(pl-at-test!
|
|
"atom_concat(foo, bar, foobar) check"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_concat(foo, bar, foobar)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
(pl-at-test!
|
|
"atom_concat(foo, bar, foobaz) fails"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_concat(foo, bar, foobaz)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(define pl-at-env-ac2 {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_concat(foo, Y, foobar)" pl-at-env-ac2)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"atom_concat(foo, Y, foobar) -> Y=bar"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ac2 "Y")))
|
|
"bar")
|
|
|
|
;; ── atom_chars/2 ──
|
|
|
|
(define pl-at-env-ach {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_chars(cat, Cs)" pl-at-env-ach)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"atom_chars(cat, Cs) -> Cs=[c,a,t]"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_chars(cat, [c,a,t])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(define pl-at-env-ach2 {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "atom_chars(A, [h,i])" pl-at-env-ach2)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"atom_chars(A, [h,i]) -> A=hi"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ach2 "A")))
|
|
"hi")
|
|
|
|
;; ── char_code/2 ──
|
|
|
|
(define pl-at-env-cc {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "char_code(a, N)" pl-at-env-cc)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"char_code(a, N) -> N=97"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-at-env-cc "N")))
|
|
97)
|
|
|
|
(define pl-at-env-cc2 {})
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "char_code(C, 65)" pl-at-env-cc2)
|
|
(pl-mk-trail))
|
|
(pl-at-test!
|
|
"char_code(C, 65) -> C='A'"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-cc2 "C")))
|
|
"A")
|
|
|
|
;; ── number_codes/2 ──
|
|
|
|
(pl-at-test!
|
|
"number_codes(42, [52,50])"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "number_codes(42, [52,50])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ── number_chars/2 ──
|
|
|
|
(pl-at-test!
|
|
"number_chars(42, ['4','2'])"
|
|
(pl-solve-once!
|
|
pl-at-db
|
|
(pl-at-goal "number_chars(42, ['4','2'])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(define pl-atom-tests-run! (fn () {:failed pl-at-test-fail :passed pl-at-test-pass :total pl-at-test-count :failures pl-at-test-failures}))
|