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

;; lib/prolog/tests/set_predicates.sx — foldl/4, list_to_set/2, intersection/3, subtract/3, union/3

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

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

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

;; DB with add/3 for foldl tests
(define pl-sp-db (pl-mk-db))
(pl-db-load! pl-sp-db (pl-parse "add(X, Acc, NAcc) :- NAcc is Acc + X."))

;; ── foldl/4 ────────────────────────────────────────────────────────

(define pl-sp-env-fl1 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "foldl(add, [1,2,3,4], 0, S)" pl-sp-env-fl1)
  (pl-mk-trail))
(pl-sp-test!
  "foldl(add,[1,2,3,4],0,S) -> S=10"
  (pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl1 "S")))
  10)

(define pl-sp-env-fl2 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "foldl(add, [], 5, S)" pl-sp-env-fl2)
  (pl-mk-trail))
(pl-sp-test!
  "foldl(add,[],5,S) -> S=5"
  (pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl2 "S")))
  5)

(define pl-sp-env-fl3 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "foldl(add, [1,2,3], 0, S)" pl-sp-env-fl3)
  (pl-mk-trail))
(pl-sp-test!
  "foldl(add,[1,2,3],0,S) -> S=6"
  (pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl3 "S")))
  6)

;; ── list_to_set/2 ──────────────────────────────────────────────────

(define pl-sp-env-lts1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "list_to_set([1,2,3,2,1], R)" pl-sp-env-lts1)
  (pl-mk-trail))
(pl-sp-test!
  "list_to_set([1,2,3,2,1],R) -> [1,2,3]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts1 "R")))
  ".(1, .(2, .(3, [])))")

(define pl-sp-env-lts2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "list_to_set([], R)" pl-sp-env-lts2)
  (pl-mk-trail))
(pl-sp-test!
  "list_to_set([],R) -> []"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts2 "R")))
  "[]")

(define pl-sp-env-lts3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "list_to_set([a,b,a,c], R)" pl-sp-env-lts3)
  (pl-mk-trail))
(pl-sp-test!
  "list_to_set([a,b,a,c],R) -> [a,b,c]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts3 "R")))
  ".(a, .(b, .(c, [])))")

;; ── intersection/3 ─────────────────────────────────────────────────

(define pl-sp-env-int1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "intersection([1,2,3,4], [2,4,6], R)" pl-sp-env-int1)
  (pl-mk-trail))
(pl-sp-test!
  "intersection([1,2,3,4],[2,4,6],R) -> [2,4]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-int1 "R")))
  ".(2, .(4, []))")

(define pl-sp-env-int2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "intersection([1,2,3], [4,5,6], R)" pl-sp-env-int2)
  (pl-mk-trail))
(pl-sp-test!
  "intersection([1,2,3],[4,5,6],R) -> []"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-int2 "R")))
  "[]")

(define pl-sp-env-int3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "intersection([], [1,2,3], R)" pl-sp-env-int3)
  (pl-mk-trail))
(pl-sp-test!
  "intersection([],[1,2,3],R) -> []"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-int3 "R")))
  "[]")

;; ── subtract/3 ─────────────────────────────────────────────────────

(define pl-sp-env-sub1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "subtract([1,2,3,4], [2,4], R)" pl-sp-env-sub1)
  (pl-mk-trail))
(pl-sp-test!
  "subtract([1,2,3,4],[2,4],R) -> [1,3]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub1 "R")))
  ".(1, .(3, []))")

(define pl-sp-env-sub2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "subtract([1,2,3], [], R)" pl-sp-env-sub2)
  (pl-mk-trail))
(pl-sp-test!
  "subtract([1,2,3],[],R) -> [1,2,3]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub2 "R")))
  ".(1, .(2, .(3, [])))")

(define pl-sp-env-sub3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "subtract([], [1,2], R)" pl-sp-env-sub3)
  (pl-mk-trail))
(pl-sp-test!
  "subtract([],[1,2],R) -> []"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub3 "R")))
  "[]")

;; ── union/3 ────────────────────────────────────────────────────────

(define pl-sp-env-uni1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "union([1,2,3], [2,3,4], R)" pl-sp-env-uni1)
  (pl-mk-trail))
(pl-sp-test!
  "union([1,2,3],[2,3,4],R) -> [1,2,3,4]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni1 "R")))
  ".(1, .(2, .(3, .(4, []))))")

(define pl-sp-env-uni2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "union([], [1,2], R)" pl-sp-env-uni2)
  (pl-mk-trail))
(pl-sp-test!
  "union([],[1,2],R) -> [1,2]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni2 "R")))
  ".(1, .(2, []))")

(define pl-sp-env-uni3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
  pl-sp-db
  (pl-sp-goal "union([1,2], [], R)" pl-sp-env-uni3)
  (pl-mk-trail))
(pl-sp-test!
  "union([1,2],[],R) -> [1,2]"
  (pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni3 "R")))
  ".(1, .(2, []))")

;; ── Runner ─────────────────────────────────────────────────────────

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