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
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:
@@ -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)
|
||||
|
||||
@@ -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))))
|
||||
|
||||
@@ -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"
|
||||
}
|
||||
|
||||
@@ -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 …`.
|
||||
|
||||
215
lib/prolog/tests/assert_rules.sx
Normal file
215
lib/prolog/tests/assert_rules.sx
Normal 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}))
|
||||
@@ -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}))
|
||||
|
||||
Reference in New Issue
Block a user