rose-ash/lib/prolog/tests/meta_predicates.sx

;; lib/prolog/tests/meta_predicates.sx — \+/1, not/1, once/1, ignore/1, ground/1, sort/2, msort/2, atom_number/2, number_string/2

(define pl-mp-test-count 0)
(define pl-mp-test-pass 0)
(define pl-mp-test-fail 0)
(define pl-mp-test-failures (list))

(define
  pl-mp-test!
  (fn
    (name got expected)
    (begin
      (set! pl-mp-test-count (+ pl-mp-test-count 1))
      (if
        (= got expected)
        (set! pl-mp-test-pass (+ pl-mp-test-pass 1))
        (begin
          (set! pl-mp-test-fail (+ pl-mp-test-fail 1))
          (append!
            pl-mp-test-failures
            (str name "\n    expected: " expected "\n    got:      " got)))))))

(define
  pl-mp-goal
  (fn
    (src env)
    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))

(define pl-mp-db (pl-mk-db))
(pl-db-load!
  pl-mp-db
  (pl-parse "member(X, [X|_]). member(X, [_|T]) :- member(X, T)."))

;; -- \+/1 --

(pl-mp-test!
  "\\+(fail) succeeds"
  (pl-solve-once! pl-mp-db (pl-mp-goal "\\+(fail)" {}) (pl-mk-trail))
  true)

(pl-mp-test!
  "\\+(true) fails"
  (pl-solve-once! pl-mp-db (pl-mp-goal "\\+(true)" {}) (pl-mk-trail))
  false)

(pl-mp-test!
  "\\+(member(d, [a,b,c])) succeeds"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "\\+(member(d, [a,b,c]))" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "\\+(member(a, [a,b,c])) fails"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "\\+(member(a, [a,b,c]))" {})
    (pl-mk-trail))
  false)

(define pl-mp-env-neg {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "\\+(X = 5)" pl-mp-env-neg)
  (pl-mk-trail))
(pl-mp-test!
  "\\+(X=5) fails, X stays unbound (bindings undone)"
  (nil? (pl-var-binding (dict-get pl-mp-env-neg "X")))
  true)

;; -- not/1 --

(pl-mp-test!
  "not(fail) succeeds"
  (pl-solve-once! pl-mp-db (pl-mp-goal "not(fail)" {}) (pl-mk-trail))
  true)

(pl-mp-test!
  "not(true) fails"
  (pl-solve-once! pl-mp-db (pl-mp-goal "not(true)" {}) (pl-mk-trail))
  false)

;; -- once/1 --

(pl-mp-test!
  "once(member(X,[1,2,3])) succeeds once"
  (pl-solve-count!
    pl-mp-db
    (pl-mp-goal "once(member(X,[1,2,3]))" {})
    (pl-mk-trail))
  1)

(define pl-mp-env-once {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "once(member(X,[1,2,3]))" pl-mp-env-once)
  (pl-mk-trail))
(pl-mp-test!
  "once(member(X,[1,2,3])): X=1 (first solution)"
  (pl-num-val (pl-walk-deep (dict-get pl-mp-env-once "X")))
  1)

(pl-mp-test!
  "once(fail) fails"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "once(fail)" {})
    (pl-mk-trail))
  false)

;; -- ignore/1 --

(pl-mp-test!
  "ignore(true) succeeds"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "ignore(true)" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "ignore(fail) still succeeds"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "ignore(fail)" {})
    (pl-mk-trail))
  true)

;; -- ground/1 --

(pl-mp-test!
  "ground(foo(1, a)) succeeds"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "ground(foo(1, a))" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "ground(foo(X, a)) fails (X unbound)"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "ground(foo(X, a))" {})
    (pl-mk-trail))
  false)

(pl-mp-test!
  "ground(42) succeeds"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "ground(42)" {})
    (pl-mk-trail))
  true)

;; -- sort/2 --

(pl-mp-test!
  "sort([b,a,c], [a,b,c])"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "sort([b,a,c], [a,b,c])" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "sort([b,a,a,c], [a,b,c]) (removes duplicates)"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "sort([b,a,a,c], [a,b,c])" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "sort([], [])"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "sort([], [])" {})
    (pl-mk-trail))
  true)

;; -- msort/2 --

(pl-mp-test!
  "msort([b,a,a,c], [a,a,b,c]) (keeps duplicates)"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "msort([b,a,a,c], [a,a,b,c])" {})
    (pl-mk-trail))
  true)

(pl-mp-test!
  "msort([3,1,2,1], [1,1,2,3])"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "msort([3,1,2,1], [1,1,2,3])" {})
    (pl-mk-trail))
  true)

;; -- atom_number/2 --

(define pl-mp-env-an1 {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "atom_number('42', N)" pl-mp-env-an1)
  (pl-mk-trail))
(pl-mp-test!
  "atom_number('42', N) -> N=42"
  (pl-num-val (pl-walk-deep (dict-get pl-mp-env-an1 "N")))
  42)

(define pl-mp-env-an2 {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "atom_number(A, 7)" pl-mp-env-an2)
  (pl-mk-trail))
(pl-mp-test!
  "atom_number(A, 7) -> A='7'"
  (pl-atom-name (pl-walk-deep (dict-get pl-mp-env-an2 "A")))
  "7")

(pl-mp-test!
  "atom_number(foo, N) fails (not a number)"
  (pl-solve-once!
    pl-mp-db
    (pl-mp-goal "atom_number(foo, N)" {})
    (pl-mk-trail))
  false)

;; -- number_string/2 --

(define pl-mp-env-ns1 {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "number_string(42, S)" pl-mp-env-ns1)
  (pl-mk-trail))
(pl-mp-test!
  "number_string(42, S) -> S='42'"
  (pl-atom-name (pl-walk-deep (dict-get pl-mp-env-ns1 "S")))
  "42")

(define pl-mp-env-ns2 {})
(pl-solve-once!
  pl-mp-db
  (pl-mp-goal "number_string(N, '3.14')" pl-mp-env-ns2)
  (pl-mk-trail))
(pl-mp-test!
  "number_string(N, '3.14') -> N=3.14"
  (pl-num-val (pl-walk-deep (dict-get pl-mp-env-ns2 "N")))
  3.14)

(define pl-meta-predicates-tests-run! (fn () {:failed pl-mp-test-fail :passed pl-mp-test-pass :total pl-mp-test-count :failures pl-mp-test-failures}))