prolog: assert/asserta/assertz/retract for facts, 11 tests

lib/prolog/tests/dynamic.sx

@@ -0,0 +1,158 @@
+;; 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}))