;; lib/prolog/tests/term_inspect.sx — copy_term/2, functor/3, arg/3.

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

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

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

(define pl-tt-db (pl-mk-db))

;; ── copy_term/2 ──

(pl-tt-test!
  "copy_term ground compound succeeds + copy = original"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "copy_term(foo(a, b), X), X = foo(a, b)" {})
    (pl-mk-trail))
  true)

(pl-tt-test!
  "copy_term preserves var aliasing in source"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 5" {})
    (pl-mk-trail))
  true)

(pl-tt-test!
  "copy_term distinct vars stay distinct"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 6" {})
    (pl-mk-trail))
  false)

(define pl-tt-env-1 {})
(pl-solve-once!
  pl-tt-db
  (pl-tt-goal "copy_term(X, Y), Y = 5" pl-tt-env-1)
  (pl-mk-trail))
(pl-tt-test!
  "copy_term: binding the copy doesn't bind the source"
  (pl-var-bound? (dict-get pl-tt-env-1 "X"))
  false)

;; ── functor/3 ──

(define pl-tt-env-2 {})
(pl-solve-once!
  pl-tt-db
  (pl-tt-goal "functor(foo(a, b, c), F, N)" pl-tt-env-2)
  (pl-mk-trail))
(pl-tt-test!
  "functor of compound: F = foo"
  (pl-atom-name (pl-walk-deep (dict-get pl-tt-env-2 "F")))
  "foo")
(pl-tt-test!
  "functor of compound: N = 3"
  (pl-num-val (pl-walk-deep (dict-get pl-tt-env-2 "N")))
  3)

(define pl-tt-env-3 {})
(pl-solve-once!
  pl-tt-db
  (pl-tt-goal "functor(hello, F, N)" pl-tt-env-3)
  (pl-mk-trail))
(pl-tt-test!
  "functor of atom: F = hello"
  (pl-atom-name (pl-walk-deep (dict-get pl-tt-env-3 "F")))
  "hello")
(pl-tt-test!
  "functor of atom: N = 0"
  (pl-num-val (pl-walk-deep (dict-get pl-tt-env-3 "N")))
  0)

(pl-tt-test!
  "functor construct compound: T unifies with foo(a, b)"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "functor(T, foo, 2), T = foo(a, b)" {})
    (pl-mk-trail))
  true)

(pl-tt-test!
  "functor construct atom: T = hello"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "functor(T, hello, 0), T = hello" {})
    (pl-mk-trail))
  true)

;; ── arg/3 ──

(pl-tt-test!
  "arg(1, foo(a, b, c), a)"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "arg(1, foo(a, b, c), a)" {})
    (pl-mk-trail))
  true)

(pl-tt-test!
  "arg(2, foo(a, b, c), X) → X = b"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "arg(2, foo(a, b, c), X), X = b" {})
    (pl-mk-trail))
  true)

(pl-tt-test!
  "arg out-of-range high fails"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "arg(4, foo(a, b, c), X)" {})
    (pl-mk-trail))
  false)

(pl-tt-test!
  "arg(0, ...) fails (1-indexed)"
  (pl-solve-once!
    pl-tt-db
    (pl-tt-goal "arg(0, foo(a), X)" {})
    (pl-mk-trail))
  false)

(define pl-term-inspect-tests-run! (fn () {:failed pl-tt-test-fail :passed pl-tt-test-pass :total pl-tt-test-count :failures pl-tt-test-failures}))