From 2075db62ba496e40c4331e7e8a1ca82b24b2ab58 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 13:22:09 +0000 Subject: [PATCH] Add :- to op table (prec 1200 xfx); enable assert/asserta/assertz with rule terms MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - parser.sx: add (":-" 1200 "xfx") to pl-op-table so (head :- body) parses inside paren expressions (parens reset prec to 1200, allowing xfx match) - parser.sx: extend pl-token-op to accept "op" token type, not just "atom", since the tokenizer emits :- as {:type "op" :value ":-"} - tests/assert_rules.sx: 15 new tests covering assertz/asserta with rule terms, conjunction in rule body, recursive rules, and ordering - conformance.sh: wire in assert_rules suite - 456 → 471 tests, all passing Co-Authored-By: Claude Sonnet 4.6 --- lib/prolog/conformance.sh | 1 + lib/prolog/parser.sx | 3 +- lib/prolog/scoreboard.json | 8 +- lib/prolog/scoreboard.md | 5 +- lib/prolog/tests/assert_rules.sx | 215 ++++++++++++++++++++++++++++ lib/prolog/tests/list_predicates.sx | 27 ++-- 6 files changed, 241 insertions(+), 18 deletions(-) create mode 100644 lib/prolog/tests/assert_rules.sx diff --git a/lib/prolog/conformance.sh b/lib/prolog/conformance.sh index d293732b..e30af481 100755 --- a/lib/prolog/conformance.sh +++ b/lib/prolog/conformance.sh @@ -38,6 +38,7 @@ SUITES=( "set_predicates:lib/prolog/tests/set_predicates.sx:pl-set-predicates-tests-run!" "char_predicates:lib/prolog/tests/char_predicates.sx:pl-char-predicates-tests-run!" "io_predicates:lib/prolog/tests/io_predicates.sx:pl-io-predicates-tests-run!" + "assert_rules:lib/prolog/tests/assert_rules.sx:pl-assert-rules-tests-run!" ) SCRIPT='(epoch 1) diff --git a/lib/prolog/parser.sx b/lib/prolog/parser.sx index bb0f0db9..d6ee00b7 100644 --- a/lib/prolog/parser.sx +++ b/lib/prolog/parser.sx @@ -101,6 +101,7 @@ (list "-" 500 "yfx") (list "*" 400 "yfx") (list "/" 400 "yfx") + (list ":-" 1200 "xfx") (list "mod" 400 "yfx"))) (define @@ -126,7 +127,7 @@ (let ((info (pl-op-lookup ","))) (if (nil? info) nil (cons "," info)))) - ((= ty "atom") + ((or (= ty "atom") (= ty "op")) (let ((info (pl-op-lookup vv))) (if (nil? info) nil (cons vv info)))) diff --git a/lib/prolog/scoreboard.json b/lib/prolog/scoreboard.json index 500ad23e..04d96af5 100644 --- a/lib/prolog/scoreboard.json +++ b/lib/prolog/scoreboard.json @@ -1,7 +1,7 @@ { - "total_passed": 456, + "total_passed": 471, "total_failed": 0, - "total": 456, - "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},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"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},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0}}, - "generated": "2026-04-25T13:00:15+00:00" + "total": 471, + "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},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"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},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0}}, + "generated": "2026-04-25T13:21:37+00:00" } diff --git a/lib/prolog/scoreboard.md b/lib/prolog/scoreboard.md index 28979c27..ec0c2b07 100644 --- a/lib/prolog/scoreboard.md +++ b/lib/prolog/scoreboard.md @@ -1,7 +1,7 @@ # Prolog scoreboard -**456 / 456 passing** (0 failure(s)). -Generated 2026-04-25T13:00:15+00:00. +**471 / 471 passing** (0 failure(s)). +Generated 2026-04-25T13:21:37+00:00. | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -27,6 +27,7 @@ Generated 2026-04-25T13:00:15+00:00. | set_predicates | 15 | 15 | ok | | char_predicates | 27 | 27 | ok | | io_predicates | 24 | 24 | ok | +| assert_rules | 15 | 15 | ok | Run `bash lib/prolog/conformance.sh` to refresh. Override the binary with `SX_SERVER=path/to/sx_server.exe bash …`. diff --git a/lib/prolog/tests/assert_rules.sx b/lib/prolog/tests/assert_rules.sx new file mode 100644 index 00000000..f7284268 --- /dev/null +++ b/lib/prolog/tests/assert_rules.sx @@ -0,0 +1,215 @@ +;; 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})) diff --git a/lib/prolog/tests/list_predicates.sx b/lib/prolog/tests/list_predicates.sx index 5b00b90c..5209958d 100644 --- a/lib/prolog/tests/list_predicates.sx +++ b/lib/prolog/tests/list_predicates.sx @@ -53,12 +53,18 @@ (pl-lp-test! "==(f(a,b), f(a,b)) succeeds" - (pl-solve-once! pl-lp-db (pl-lp-goal "==(f(a,b), f(a,b))" {}) (pl-mk-trail)) + (pl-solve-once! + pl-lp-db + (pl-lp-goal "==(f(a,b), f(a,b))" {}) + (pl-mk-trail)) true) (pl-lp-test! "==(f(a,b), f(a,c)) fails" - (pl-solve-once! pl-lp-db (pl-lp-goal "==(f(a,b), f(a,c))" {}) (pl-mk-trail)) + (pl-solve-once! + pl-lp-db + (pl-lp-goal "==(f(a,b), f(a,c))" {}) + (pl-mk-trail)) false) ;; unbound var vs atom: fails (different tags) @@ -74,7 +80,9 @@ "==(X, X) succeeds (same runtime var)" (pl-solve-once! pl-lp-db - (pl-instantiate (nth (first (pl-parse "g :- ==(X, X).")) 2) pl-lp-env-same-var) + (pl-instantiate + (nth (first (pl-parse "g :- ==(X, X).")) 2) + pl-lp-env-same-var) (pl-mk-trail)) true) @@ -166,7 +174,10 @@ (pl-lp-test! "numlist(5, 3, L) fails (Low > High)" - (pl-solve-once! pl-lp-db (pl-lp-goal "numlist(5, 3, L)" {}) (pl-mk-trail)) + (pl-solve-once! + pl-lp-db + (pl-lp-goal "numlist(5, 3, L)" {}) + (pl-mk-trail)) false) ;; ── atomic_list_concat/2 ─────────────────────────────────────────── @@ -321,10 +332,4 @@ (pl-format-term (pl-walk-deep (dict-get pl-lp-env-del3 "R"))) "[]") -(define pl-list-predicates-tests-run! - (fn - () - {:failed pl-lp-test-fail - :passed pl-lp-test-pass - :total pl-lp-test-count - :failures pl-lp-test-failures})) +(define pl-list-predicates-tests-run! (fn () {:failed pl-lp-test-fail :passed pl-lp-test-pass :total pl-lp-test-count :failures pl-lp-test-failures}))