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

;; lib/prolog/tests/assert_rules.sx — assert/assertz/asserta with rule terms (head :- body)
;; Tests that :- is in the op table (prec 1200 xfx) and pl-build-clause handles rule form.

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

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

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

;; ── DB1: assertz a simple rule then query ──────────────────────────
(define pl-ar-db1 (pl-mk-db))

(pl-solve-once!
  pl-ar-db1
  (pl-ar-goal "assertz((double(X, Y) :- Y is X * 2))" {})
  (pl-mk-trail))

(pl-ar-test!
  "assertz rule: double(3, Y) succeeds"
  (pl-solve-once!
    pl-ar-db1
    (pl-ar-goal "double(3, Y)" {})
    (pl-mk-trail))
  true)

(define pl-ar-env1 {})
(pl-solve-once!
  pl-ar-db1
  (pl-ar-goal "double(3, Y)" pl-ar-env1)
  (pl-mk-trail))

(pl-ar-test!
  "assertz rule: double(3, Y) binds Y to 6"
  (pl-num-val (pl-walk-deep (dict-get pl-ar-env1 "Y")))
  6)

(define pl-ar-env1b {})
(pl-solve-once!
  pl-ar-db1
  (pl-ar-goal "double(10, Y)" pl-ar-env1b)
  (pl-mk-trail))

(pl-ar-test!
  "assertz rule: double(10, Y) yields 20"
  (pl-num-val (pl-walk-deep (dict-get pl-ar-env1b "Y")))
  20)

;; ── DB2: assert a rule with multiple facts, count solutions ─────────
(define pl-ar-db2 (pl-mk-db))

(pl-solve-once!
  pl-ar-db2
  (pl-ar-goal "assert(fact(a))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db2
  (pl-ar-goal "assert(fact(b))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db2
  (pl-ar-goal "assertz((copy(X) :- fact(X)))" {})
  (pl-mk-trail))

(pl-ar-test!
  "rule copy/1 using fact/1: 2 solutions"
  (pl-solve-count! pl-ar-db2 (pl-ar-goal "copy(X)" {}) (pl-mk-trail))
  2)

(define pl-ar-env2a {})
(pl-solve-once! pl-ar-db2 (pl-ar-goal "copy(X)" pl-ar-env2a) (pl-mk-trail))

(pl-ar-test!
  "rule copy/1: first solution is a"
  (pl-atom-name (pl-walk-deep (dict-get pl-ar-env2a "X")))
  "a")

;; ── DB3: asserta rule is tried before existing clauses ─────────────
(define pl-ar-db3 (pl-mk-db))

(pl-solve-once!
  pl-ar-db3
  (pl-ar-goal "assert(ord(a))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db3
  (pl-ar-goal "asserta((ord(b) :- true))" {})
  (pl-mk-trail))

(define pl-ar-env3 {})
(pl-solve-once! pl-ar-db3 (pl-ar-goal "ord(X)" pl-ar-env3) (pl-mk-trail))

(pl-ar-test!
  "asserta rule ord(b) is tried before ord(a)"
  (pl-atom-name (pl-walk-deep (dict-get pl-ar-env3 "X")))
  "b")

(pl-ar-test!
  "asserta: total solutions for ord/1 is 2"
  (pl-solve-count! pl-ar-db3 (pl-ar-goal "ord(X)" {}) (pl-mk-trail))
  2)

;; ── DB4: rule with conjunction in body ─────────────────────────────
(define pl-ar-db4 (pl-mk-db))

(pl-solve-once!
  pl-ar-db4
  (pl-ar-goal "assert(num(1))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db4
  (pl-ar-goal "assert(num(2))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db4
  (pl-ar-goal "assertz((big(X) :- num(X), X > 1))" {})
  (pl-mk-trail))

(pl-ar-test!
  "conjunction in rule body: big(1) fails"
  (pl-solve-once! pl-ar-db4 (pl-ar-goal "big(1)" {}) (pl-mk-trail))
  false)

(pl-ar-test!
  "conjunction in rule body: big(2) succeeds"
  (pl-solve-once! pl-ar-db4 (pl-ar-goal "big(2)" {}) (pl-mk-trail))
  true)

;; ── DB5: recursive rule ─────────────────────────────────────────────
(define pl-ar-db5 (pl-mk-db))

(pl-solve-once!
  pl-ar-db5
  (pl-ar-goal "assert((nat(0) :- true))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db5
  (pl-ar-goal "assertz((nat(s(X)) :- nat(X)))" {})
  (pl-mk-trail))

(pl-ar-test!
  "recursive rule: nat(0) succeeds"
  (pl-solve-once! pl-ar-db5 (pl-ar-goal "nat(0)" {}) (pl-mk-trail))
  true)

(pl-ar-test!
  "recursive rule: nat(s(0)) succeeds"
  (pl-solve-once!
    pl-ar-db5
    (pl-ar-goal "nat(s(0))" {})
    (pl-mk-trail))
  true)

(pl-ar-test!
  "recursive rule: nat(s(s(0))) succeeds"
  (pl-solve-once!
    pl-ar-db5
    (pl-ar-goal "nat(s(s(0)))" {})
    (pl-mk-trail))
  true)

(pl-ar-test!
  "recursive rule: nat(bad) fails"
  (pl-solve-once! pl-ar-db5 (pl-ar-goal "nat(bad)" {}) (pl-mk-trail))
  false)

;; ── DB6: rule with true body (explicit) ────────────────────────────
(define pl-ar-db6 (pl-mk-db))

(pl-solve-once!
  pl-ar-db6
  (pl-ar-goal "assertz((always(X) :- true))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-ar-db6
  (pl-ar-goal "assert(always(extra))" {})
  (pl-mk-trail))

(pl-ar-test!
  "rule body=true: always(foo) succeeds"
  (pl-solve-once!
    pl-ar-db6
    (pl-ar-goal "always(foo)" {})
    (pl-mk-trail))
  true)

(pl-ar-test!
  "rule body=true: always/1 has 2 clauses (1 rule + 1 fact)"
  (pl-solve-count!
    pl-ar-db6
    (pl-ar-goal "always(X)" {})
    (pl-mk-trail))
  2)

;; ── Runner ──────────────────────────────────────────────────────────
(define pl-assert-rules-tests-run! (fn () {:failed pl-ar-test-fail :passed pl-ar-test-pass :total pl-ar-test-count :failures pl-ar-test-failures}))