giles
8f0af85d01
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Adds pl-apply-goal helper for safe call/N goal construction (atom or compound), five solver helpers (pl-solve-forall!, pl-solve-maplist2!, pl-solve-maplist3!, pl-solve-include!, pl-solve-exclude!), five cond clauses in pl-solve!, and a new test suite (15/15 passing). Total conformance: 390/390. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
197 lines
4.5 KiB
Plaintext
197 lines
4.5 KiB
Plaintext
;; lib/prolog/tests/meta_call.sx — forall/2, maplist/2, maplist/3, include/3, exclude/3
|
|
(define pl-mc-test-count 0)
|
|
(define pl-mc-test-pass 0)
|
|
(define pl-mc-test-fail 0)
|
|
(define pl-mc-test-failures (list))
|
|
|
|
(define
|
|
pl-mc-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-mc-test-count (+ pl-mc-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-mc-test-pass (+ pl-mc-test-pass 1))
|
|
(begin
|
|
(set! pl-mc-test-fail (+ pl-mc-test-fail 1))
|
|
(append!
|
|
pl-mc-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-mc-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define
|
|
pl-mc-term-to-sx
|
|
(fn
|
|
(t)
|
|
(cond
|
|
((pl-num? t) (pl-num-val t))
|
|
((pl-atom? t) (pl-atom-name t))
|
|
(else t))))
|
|
|
|
(define
|
|
pl-mc-list-sx
|
|
(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) "."))
|
|
(cons
|
|
(pl-mc-term-to-sx (first (pl-args w)))
|
|
(pl-mc-list-sx (nth (pl-args w) 1))))
|
|
(else (list :not-list))))))
|
|
|
|
(define pl-mc-db (pl-mk-db))
|
|
|
|
(pl-db-load!
|
|
pl-mc-db
|
|
(pl-parse "member(X, [X|_]). member(X, [_|T]) :- member(X, T)."))
|
|
|
|
(pl-db-load! pl-mc-db (pl-parse "double(X, Y) :- Y is X * 2."))
|
|
|
|
(pl-db-load! pl-mc-db (pl-parse "even(X) :- 0 is X mod 2."))
|
|
|
|
;; -- forall/2 --
|
|
|
|
(pl-mc-test!
|
|
"forall(member(X,[2,4,6]), 0 is X mod 2) — all even"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "forall(member(X,[2,4,6]), 0 is X mod 2)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mc-test!
|
|
"forall(member(X,[2,3,6]), 0 is X mod 2) — 3 is odd, fails"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "forall(member(X,[2,3,6]), 0 is X mod 2)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-mc-test!
|
|
"forall(member(_,[]), true) — vacuously true"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "forall(member(_,[]), true)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; -- maplist/2 --
|
|
|
|
(pl-mc-test!
|
|
"maplist(atom, [a,b,c]) — all atoms"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(atom, [a,b,c])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mc-test!
|
|
"maplist(atom, [a,1,c]) — 1 is not atom, fails"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(atom, [a,1,c])" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-mc-test!
|
|
"maplist(atom, []) — vacuously true"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(atom, [])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; -- maplist/3 --
|
|
|
|
(pl-mc-test!
|
|
"maplist(double, [1,2,3], [2,4,6]) — deterministic check"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(double, [1,2,3], [2,4,6])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mc-test!
|
|
"maplist(double, [1,2,3], [2,4,7]) — wrong result fails"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(double, [1,2,3], [2,4,7])" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(define pl-mc-env-ml3 {:L (pl-mk-rt-var "L")})
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "maplist(double, [1,2,3], L)" pl-mc-env-ml3)
|
|
(pl-mk-trail))
|
|
(pl-mc-test!
|
|
"maplist(double, [1,2,3], L) — L bound to [2,4,6]"
|
|
(pl-mc-list-sx (dict-get pl-mc-env-ml3 "L"))
|
|
(list 2 4 6))
|
|
|
|
;; -- include/3 --
|
|
|
|
(pl-mc-test!
|
|
"include(even, [1,2,3,4,5,6], [2,4,6])"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "include(even, [1,2,3,4,5,6], [2,4,6])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mc-test!
|
|
"include(even, [], [])"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "include(even, [], [])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(define pl-mc-env-inc {:R (pl-mk-rt-var "R")})
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "include(even, [1,2,3,4,5,6], R)" pl-mc-env-inc)
|
|
(pl-mk-trail))
|
|
(pl-mc-test!
|
|
"include(even, [1,2,3,4,5,6], R) — R bound to [2,4,6]"
|
|
(pl-mc-list-sx (dict-get pl-mc-env-inc "R"))
|
|
(list 2 4 6))
|
|
|
|
;; -- exclude/3 --
|
|
|
|
(pl-mc-test!
|
|
"exclude(even, [1,2,3,4,5,6], [1,3,5])"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "exclude(even, [1,2,3,4,5,6], [1,3,5])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mc-test!
|
|
"exclude(even, [], [])"
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "exclude(even, [], [])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(define pl-mc-env-exc {:R (pl-mk-rt-var "R")})
|
|
(pl-solve-once!
|
|
pl-mc-db
|
|
(pl-mc-goal "exclude(even, [1,2,3,4,5,6], R)" pl-mc-env-exc)
|
|
(pl-mk-trail))
|
|
(pl-mc-test!
|
|
"exclude(even, [1,2,3,4,5,6], R) — R bound to [1,3,5]"
|
|
(pl-mc-list-sx (dict-get pl-mc-env-exc "R"))
|
|
(list 1 3 5))
|
|
|
|
(define pl-meta-call-tests-run! (fn () {:failed pl-mc-test-fail :passed pl-mc-test-pass :total pl-mc-test-count :failures pl-mc-test-failures})) |