;; 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}))