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