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

lib/prolog/conformance.sh

@@ -21,6 +21,7 @@ SUITES=(
   "clausedb:lib/prolog/tests/clausedb.sx:pl-clausedb-tests-run!"
   "solve:lib/prolog/tests/solve.sx:pl-solve-tests-run!"
   "operators:lib/prolog/tests/operators.sx:pl-operators-tests-run!"
+  "dynamic:lib/prolog/tests/dynamic.sx:pl-dynamic-tests-run!"
   "append:lib/prolog/tests/programs/append.sx:pl-append-tests-run!"
   "reverse:lib/prolog/tests/programs/reverse.sx:pl-reverse-tests-run!"
   "member:lib/prolog/tests/programs/member.sx:pl-member-tests-run!"

lib/prolog/runtime.sx

@@ -284,6 +284,123 @@
   pl-db-lookup-goal
   (fn (db goal) (pl-db-lookup db (pl-goal-key goal))))
 
+(define
+  pl-rt-walk-to-ast
+  (fn
+    (w)
+    (cond
+      ((pl-var? w) (list "var" (str "_G" (pl-var-id w))))
+      ((and (list? w) (not (empty? w)) (= (first w) "compound"))
+        (list "compound" (nth w 1) (map pl-rt-walk-to-ast (nth w 2))))
+      (true w))))
+
+(define pl-rt-to-ast (fn (t) (pl-rt-walk-to-ast (pl-walk-deep t))))
+
+(define
+  pl-build-clause
+  (fn
+    (ast)
+    (cond
+      ((and (list? ast) (= (first ast) "compound") (= (nth ast 1) ":-") (= (len (nth ast 2)) 2))
+        (list "clause" (first (nth ast 2)) (nth (nth ast 2) 1)))
+      (true (list "clause" ast (list "atom" "true"))))))
+
+(define
+  pl-db-prepend!
+  (fn
+    (db clause)
+    (let
+      ((key (pl-clause-key clause)) (table (dict-get db :clauses)))
+      (cond
+        ((nil? (dict-get table key)) (dict-set! table key (list clause)))
+        (true (dict-set! table key (cons clause (dict-get table key))))))))
+
+(define
+  pl-list-without
+  (fn
+    (lst i)
+    (cond
+      ((empty? lst) (list))
+      ((= i 0) (rest lst))
+      (true (cons (first lst) (pl-list-without (rest lst) (- i 1)))))))
+
+(define
+  pl-solve-assertz!
+  (fn
+    (db term k)
+    (begin (pl-db-add! db (pl-build-clause (pl-rt-to-ast term))) (k))))
+
+(define
+  pl-solve-asserta!
+  (fn
+    (db term k)
+    (begin (pl-db-prepend! db (pl-build-clause (pl-rt-to-ast term))) (k))))
+
+(define
+  pl-solve-retract!
+  (fn
+    (db term trail k)
+    (let
+      ((head-runtime (cond ((and (pl-compound? term) (= (pl-fun term) ":-") (= (len (pl-args term)) 2)) (first (pl-args term))) (true term)))
+        (body-runtime
+          (cond
+            ((and (pl-compound? term) (= (pl-fun term) ":-") (= (len (pl-args term)) 2))
+              (nth (pl-args term) 1))
+            (true (list "atom" "true")))))
+      (let
+        ((wh (pl-walk head-runtime)))
+        (cond
+          ((pl-var? wh) false)
+          (true
+            (let
+              ((key (pl-head-key wh)))
+              (pl-retract-try-each
+                db
+                key
+                (pl-db-lookup db key)
+                head-runtime
+                body-runtime
+                0
+                trail
+                k))))))))
+
+(define
+  pl-retract-try-each
+  (fn
+    (db key remaining head-rt body-rt idx trail k)
+    (cond
+      ((empty? remaining) false)
+      (true
+        (let
+          ((mark (pl-trail-mark trail))
+            (cl (pl-instantiate-fresh (first remaining))))
+          (cond
+            ((and (pl-unify! head-rt (nth cl 1) trail) (pl-unify! body-rt (nth cl 2) trail))
+              (begin
+                (let
+                  ((all (pl-db-lookup db key)))
+                  (dict-set!
+                    (dict-get db :clauses)
+                    key
+                    (pl-list-without all idx)))
+                (let
+                  ((r (k)))
+                  (cond
+                    (r true)
+                    (true (begin (pl-trail-undo-to! trail mark) false))))))
+            (true
+              (begin
+                (pl-trail-undo-to! trail mark)
+                (pl-retract-try-each
+                  db
+                  key
+                  (rest remaining)
+                  head-rt
+                  body-rt
+                  (+ idx 1)
+                  trail
+                  k)))))))))
+
 (define
   pl-cut?
   (fn (t) (and (list? t) (not (empty? t)) (= (first t) "cut"))))
@@ -367,6 +484,14 @@
           (begin
             (pl-output-write! (pl-format-term (first (pl-args g))))
             (k)))
+        ((and (pl-compound? g) (= (pl-fun g) "assertz") (= (len (pl-args g)) 1))
+          (pl-solve-assertz! db (first (pl-args g)) k))
+        ((and (pl-compound? g) (= (pl-fun g) "assert") (= (len (pl-args g)) 1))
+          (pl-solve-assertz! db (first (pl-args g)) k))
+        ((and (pl-compound? g) (= (pl-fun g) "asserta") (= (len (pl-args g)) 1))
+          (pl-solve-asserta! db (first (pl-args g)) k))
+        ((and (pl-compound? g) (= (pl-fun g) "retract") (= (len (pl-args g)) 1))
+          (pl-solve-retract! db (first (pl-args g)) trail k))
         (true (pl-solve-user! db g trail cut-box k))))))
 
 (define

lib/prolog/scoreboard.json

@@ -1,7 +1,7 @@
 {
-  "total_passed": 202,
+  "total_passed": 213,
   "total_failed": 0,
-  "total": 202,
-  "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0}},
-  "generated": "2026-04-25T06:57:26+00:00"
+  "total": 213,
+  "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0}},
+  "generated": "2026-04-25T07:31:46+00:00"
 }

lib/prolog/scoreboard.md

@@ -1,7 +1,7 @@
 # Prolog scoreboard
 
-**202 / 202 passing** (0 failure(s)).
-Generated 2026-04-25T06:57:26+00:00.
+**213 / 213 passing** (0 failure(s)).
+Generated 2026-04-25T07:31:46+00:00.
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
@@ -10,6 +10,7 @@ Generated 2026-04-25T06:57:26+00:00.
 | clausedb | 14 | 14 | ok |
 | solve | 62 | 62 | ok |
 | operators | 19 | 19 | ok |
+| dynamic | 11 | 11 | ok |
 | append | 6 | 6 | ok |
 | reverse | 6 | 6 | ok |
 | member | 7 | 7 | ok |

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}))