Add :- to op table (prec 1200 xfx); enable assert/asserta/assertz with rule terms
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

- 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 <noreply@anthropic.com>
This commit is contained in:
2026-04-25 13:22:09 +00:00
parent 1aca2c7bc5
commit 2075db62ba
6 changed files with 241 additions and 18 deletions

View File

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

View File

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

View File

@@ -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"
}

View File

@@ -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 …`.

View File

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

View File

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