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

;; lib/prolog/tests/dynamic.sx — assert/asserta/assertz/retract.

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

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

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

;; assertz then query
(define pl-dy-db1 (pl-mk-db))
(pl-solve-once!
  pl-dy-db1
  (pl-dy-goal "assertz(foo(1))" {})
  (pl-mk-trail))
(pl-dy-test!
  "assertz(foo(1)) + foo(1)"
  (pl-solve-once! pl-dy-db1 (pl-dy-goal "foo(1)" {}) (pl-mk-trail))
  true)

(pl-dy-test!
  "after one assertz, foo/1 has 1 clause"
  (pl-solve-count! pl-dy-db1 (pl-dy-goal "foo(X)" {}) (pl-mk-trail))
  1)

;; assertz appends — order preserved
(define pl-dy-db2 (pl-mk-db))
(pl-solve-once!
  pl-dy-db2
  (pl-dy-goal "assertz(p(1))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-dy-db2
  (pl-dy-goal "assertz(p(2))" {})
  (pl-mk-trail))
(pl-dy-test!
  "assertz twice — count 2"
  (pl-solve-count! pl-dy-db2 (pl-dy-goal "p(X)" {}) (pl-mk-trail))
  2)

(define pl-dy-env-a {})
(pl-solve-once! pl-dy-db2 (pl-dy-goal "p(X)" pl-dy-env-a) (pl-mk-trail))
(pl-dy-test!
  "assertz: first solution is the first asserted (1)"
  (pl-num-val (pl-walk-deep (dict-get pl-dy-env-a "X")))
  1)

;; asserta prepends
(define pl-dy-db3 (pl-mk-db))
(pl-solve-once!
  pl-dy-db3
  (pl-dy-goal "assertz(p(1))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-dy-db3
  (pl-dy-goal "asserta(p(99))" {})
  (pl-mk-trail))
(define pl-dy-env-b {})
(pl-solve-once! pl-dy-db3 (pl-dy-goal "p(X)" pl-dy-env-b) (pl-mk-trail))
(pl-dy-test!
  "asserta: prepended clause is first solution"
  (pl-num-val (pl-walk-deep (dict-get pl-dy-env-b "X")))
  99)

;; assert/1 = assertz/1
(define pl-dy-db4 (pl-mk-db))
(pl-solve-once!
  pl-dy-db4
  (pl-dy-goal "assert(g(7))" {})
  (pl-mk-trail))
(pl-dy-test!
  "assert/1 alias"
  (pl-solve-once! pl-dy-db4 (pl-dy-goal "g(7)" {}) (pl-mk-trail))
  true)

;; retract removes a fact
(define pl-dy-db5 (pl-mk-db))
(pl-solve-once!
  pl-dy-db5
  (pl-dy-goal "assertz(q(1))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-dy-db5
  (pl-dy-goal "assertz(q(2))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-dy-db5
  (pl-dy-goal "assertz(q(3))" {})
  (pl-mk-trail))
(pl-dy-test!
  "before retract: 3 clauses"
  (pl-solve-count! pl-dy-db5 (pl-dy-goal "q(X)" {}) (pl-mk-trail))
  3)
(pl-solve-once!
  pl-dy-db5
  (pl-dy-goal "retract(q(2))" {})
  (pl-mk-trail))
(pl-dy-test!
  "after retract(q(2)): 2 clauses left"
  (pl-solve-count! pl-dy-db5 (pl-dy-goal "q(X)" {}) (pl-mk-trail))
  2)

(define pl-dy-env-c {})
(pl-solve-once! pl-dy-db5 (pl-dy-goal "q(X)" pl-dy-env-c) (pl-mk-trail))
(pl-dy-test!
  "after retract(q(2)): first remaining is 1"
  (pl-num-val (pl-walk-deep (dict-get pl-dy-env-c "X")))
  1)

;; retract of non-existent
(pl-dy-test!
  "retract(missing(0)) on empty db fails"
  (pl-solve-once!
    (pl-mk-db)
    (pl-dy-goal "retract(missing(0))" {})
    (pl-mk-trail))
  false)

;; retract with unbound var matches first
(define pl-dy-db6 (pl-mk-db))
(pl-solve-once!
  pl-dy-db6
  (pl-dy-goal "assertz(r(11))" {})
  (pl-mk-trail))
(pl-solve-once!
  pl-dy-db6
  (pl-dy-goal "assertz(r(22))" {})
  (pl-mk-trail))
(define pl-dy-env-d {})
(pl-solve-once!
  pl-dy-db6
  (pl-dy-goal "retract(r(X))" pl-dy-env-d)
  (pl-mk-trail))
(pl-dy-test!
  "retract(r(X)) binds X to first match"
  (pl-num-val (pl-walk-deep (dict-get pl-dy-env-d "X")))
  11)

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