Meta/logic predicates: \\+/not/once/ignore/ground/sort/msort/atom_number/number_string (+25 tests, 342 total)
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
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -32,6 +32,7 @@ SUITES=(
|
||||
"atoms:lib/prolog/tests/atoms.sx:pl-atom-tests-run!"
|
||||
"query_api:lib/prolog/tests/query_api.sx:pl-query-api-tests-run!"
|
||||
"iso_predicates:lib/prolog/tests/iso_predicates.sx:pl-iso-predicates-tests-run!"
|
||||
"meta_predicates:lib/prolog/tests/meta_predicates.sx:pl-meta-predicates-tests-run!"
|
||||
)
|
||||
|
||||
SCRIPT='(epoch 1)
|
||||
|
||||
@@ -684,6 +684,32 @@
|
||||
(pl-solve-nth0! (- n 1) (nth (pl-args w) 1) elem-rt trail k))))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-ground?
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((w (pl-walk t)))
|
||||
(cond
|
||||
((pl-var? w) false)
|
||||
((pl-atom? w) true)
|
||||
((pl-num? w) true)
|
||||
((pl-str? w) true)
|
||||
((pl-compound? w)
|
||||
(reduce (fn (acc a) (and acc (pl-ground? a))) true (pl-args w)))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-sort-pairs-dedup
|
||||
(fn
|
||||
(pairs)
|
||||
(cond
|
||||
((empty? pairs) (list))
|
||||
((= (len pairs) 1) pairs)
|
||||
((= (first (first pairs)) (first (nth pairs 1)))
|
||||
(pl-sort-pairs-dedup (cons (first pairs) (rest (rest pairs)))))
|
||||
(true (cons (first pairs) (pl-sort-pairs-dedup (rest pairs)))))))
|
||||
|
||||
(define
|
||||
pl-list-to-prolog
|
||||
(fn
|
||||
@@ -1191,6 +1217,115 @@
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "\\+") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((mark (pl-trail-mark trail)))
|
||||
(let
|
||||
((r (pl-solve! db (first (pl-args g)) trail {:cut false} (fn () true))))
|
||||
(pl-trail-undo-to! trail mark)
|
||||
(if r false (k)))))
|
||||
((and (pl-compound? g) (= (pl-fun g) "not") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((mark (pl-trail-mark trail)))
|
||||
(let
|
||||
((r (pl-solve! db (first (pl-args g)) trail {:cut false} (fn () true))))
|
||||
(pl-trail-undo-to! trail mark)
|
||||
(if r false (k)))))
|
||||
((and (pl-compound? g) (= (pl-fun g) "once") (= (len (pl-args g)) 1))
|
||||
(pl-solve-if-then-else!
|
||||
db
|
||||
(first (pl-args g))
|
||||
(list "atom" "true")
|
||||
(list "atom" "fail")
|
||||
trail
|
||||
cut-box
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "ignore") (= (len (pl-args g)) 1))
|
||||
(pl-solve-if-then-else!
|
||||
db
|
||||
(first (pl-args g))
|
||||
(list "atom" "true")
|
||||
(list "atom" "true")
|
||||
trail
|
||||
cut-box
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "ground") (= (len (pl-args g)) 1))
|
||||
(if (pl-ground? (first (pl-args g))) (k) false))
|
||||
((and (pl-compound? g) (= (pl-fun g) "sort") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((elems (pl-prolog-list-to-sx (first (pl-args g)))))
|
||||
(let
|
||||
((keyed (map (fn (e) (list (pl-format-term e) e)) elems)))
|
||||
(let
|
||||
((sorted (sort keyed)))
|
||||
(let
|
||||
((deduped (pl-sort-pairs-dedup sorted)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog (map (fn (p) (nth p 1)) deduped))
|
||||
trail
|
||||
k))))))
|
||||
((and (pl-compound? g) (= (pl-fun g) "msort") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((elems (pl-prolog-list-to-sx (first (pl-args g)))))
|
||||
(let
|
||||
((keyed (map (fn (e) (list (pl-format-term e) e)) elems)))
|
||||
(let
|
||||
((sorted (sort keyed)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog (map (fn (p) (nth p 1)) sorted))
|
||||
trail
|
||||
k)))))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom_number") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((wa (pl-walk (first (pl-args g))))
|
||||
(wb (pl-walk (nth (pl-args g) 1))))
|
||||
(cond
|
||||
((pl-atom? wa)
|
||||
(let
|
||||
((n (parse-number (pl-atom-name wa))))
|
||||
(if
|
||||
(nil? n)
|
||||
false
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" n)
|
||||
trail
|
||||
k))))
|
||||
((pl-num? wb)
|
||||
(pl-solve-eq!
|
||||
(first (pl-args g))
|
||||
(list "atom" (str (pl-num-val wb)))
|
||||
trail
|
||||
k))
|
||||
(true false))))
|
||||
((and (pl-compound? g) (= (pl-fun g) "number_string") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((wa (pl-walk (first (pl-args g))))
|
||||
(wb (pl-walk (nth (pl-args g) 1))))
|
||||
(cond
|
||||
((pl-num? wa)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "atom" (str (pl-num-val wa)))
|
||||
trail
|
||||
k))
|
||||
((pl-var? wa)
|
||||
(if
|
||||
(pl-atom? wb)
|
||||
(let
|
||||
((n (parse-number (pl-atom-name wb))))
|
||||
(if
|
||||
(nil? n)
|
||||
false
|
||||
(pl-solve-eq!
|
||||
(first (pl-args g))
|
||||
(list "num" n)
|
||||
trail
|
||||
k)))
|
||||
false))
|
||||
(true false))))
|
||||
(true (pl-solve-user! db g trail cut-box k))))))
|
||||
|
||||
(define
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{
|
||||
"total_passed": 317,
|
||||
"total_passed": 342,
|
||||
"total_failed": 0,
|
||||
"total": 317,
|
||||
"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}},
|
||||
"generated": "2026-04-25T10:30:55+00:00"
|
||||
"total": 342,
|
||||
"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}},
|
||||
"generated": "2026-04-25T11:05:56+00:00"
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Prolog scoreboard
|
||||
|
||||
**317 / 317 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T10:30:55+00:00.
|
||||
**342 / 342 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T11:05:56+00:00.
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -21,6 +21,7 @@ Generated 2026-04-25T10:30:55+00:00.
|
||||
| atoms | 34 | 34 | ok |
|
||||
| query_api | 16 | 16 | ok |
|
||||
| iso_predicates | 29 | 29 | ok |
|
||||
| meta_predicates | 25 | 25 | ok |
|
||||
|
||||
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
|
||||
with `SX_SERVER=path/to/sx_server.exe bash …`.
|
||||
|
||||
252
lib/prolog/tests/meta_predicates.sx
Normal file
252
lib/prolog/tests/meta_predicates.sx
Normal file
@@ -0,0 +1,252 @@
|
||||
;; lib/prolog/tests/meta_predicates.sx — \+/1, not/1, once/1, ignore/1, ground/1, sort/2, msort/2, atom_number/2, number_string/2
|
||||
|
||||
(define pl-mp-test-count 0)
|
||||
(define pl-mp-test-pass 0)
|
||||
(define pl-mp-test-fail 0)
|
||||
(define pl-mp-test-failures (list))
|
||||
|
||||
(define
|
||||
pl-mp-test!
|
||||
(fn
|
||||
(name got expected)
|
||||
(begin
|
||||
(set! pl-mp-test-count (+ pl-mp-test-count 1))
|
||||
(if
|
||||
(= got expected)
|
||||
(set! pl-mp-test-pass (+ pl-mp-test-pass 1))
|
||||
(begin
|
||||
(set! pl-mp-test-fail (+ pl-mp-test-fail 1))
|
||||
(append!
|
||||
pl-mp-test-failures
|
||||
(str name "\n expected: " expected "\n got: " got)))))))
|
||||
|
||||
(define
|
||||
pl-mp-goal
|
||||
(fn
|
||||
(src env)
|
||||
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
||||
|
||||
(define pl-mp-db (pl-mk-db))
|
||||
(pl-db-load!
|
||||
pl-mp-db
|
||||
(pl-parse "member(X, [X|_]). member(X, [_|T]) :- member(X, T)."))
|
||||
|
||||
;; -- \+/1 --
|
||||
|
||||
(pl-mp-test!
|
||||
"\\+(fail) succeeds"
|
||||
(pl-solve-once! pl-mp-db (pl-mp-goal "\\+(fail)" {}) (pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"\\+(true) fails"
|
||||
(pl-solve-once! pl-mp-db (pl-mp-goal "\\+(true)" {}) (pl-mk-trail))
|
||||
false)
|
||||
|
||||
(pl-mp-test!
|
||||
"\\+(member(d, [a,b,c])) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "\\+(member(d, [a,b,c]))" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"\\+(member(a, [a,b,c])) fails"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "\\+(member(a, [a,b,c]))" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(define pl-mp-env-neg {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "\\+(X = 5)" pl-mp-env-neg)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"\\+(X=5) fails, X stays unbound (bindings undone)"
|
||||
(nil? (pl-var-binding (dict-get pl-mp-env-neg "X")))
|
||||
true)
|
||||
|
||||
;; -- not/1 --
|
||||
|
||||
(pl-mp-test!
|
||||
"not(fail) succeeds"
|
||||
(pl-solve-once! pl-mp-db (pl-mp-goal "not(fail)" {}) (pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"not(true) fails"
|
||||
(pl-solve-once! pl-mp-db (pl-mp-goal "not(true)" {}) (pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; -- once/1 --
|
||||
|
||||
(pl-mp-test!
|
||||
"once(member(X,[1,2,3])) succeeds once"
|
||||
(pl-solve-count!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "once(member(X,[1,2,3]))" {})
|
||||
(pl-mk-trail))
|
||||
1)
|
||||
|
||||
(define pl-mp-env-once {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "once(member(X,[1,2,3]))" pl-mp-env-once)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"once(member(X,[1,2,3])): X=1 (first solution)"
|
||||
(pl-num-val (pl-walk-deep (dict-get pl-mp-env-once "X")))
|
||||
1)
|
||||
|
||||
(pl-mp-test!
|
||||
"once(fail) fails"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "once(fail)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; -- ignore/1 --
|
||||
|
||||
(pl-mp-test!
|
||||
"ignore(true) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "ignore(true)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"ignore(fail) still succeeds"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "ignore(fail)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; -- ground/1 --
|
||||
|
||||
(pl-mp-test!
|
||||
"ground(foo(1, a)) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "ground(foo(1, a))" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"ground(foo(X, a)) fails (X unbound)"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "ground(foo(X, a))" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(pl-mp-test!
|
||||
"ground(42) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "ground(42)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; -- sort/2 --
|
||||
|
||||
(pl-mp-test!
|
||||
"sort([b,a,c], [a,b,c])"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "sort([b,a,c], [a,b,c])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"sort([b,a,a,c], [a,b,c]) (removes duplicates)"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "sort([b,a,a,c], [a,b,c])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"sort([], [])"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "sort([], [])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; -- msort/2 --
|
||||
|
||||
(pl-mp-test!
|
||||
"msort([b,a,a,c], [a,a,b,c]) (keeps duplicates)"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "msort([b,a,a,c], [a,a,b,c])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-mp-test!
|
||||
"msort([3,1,2,1], [1,1,2,3])"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "msort([3,1,2,1], [1,1,2,3])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; -- atom_number/2 --
|
||||
|
||||
(define pl-mp-env-an1 {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "atom_number('42', N)" pl-mp-env-an1)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"atom_number('42', N) -> N=42"
|
||||
(pl-num-val (pl-walk-deep (dict-get pl-mp-env-an1 "N")))
|
||||
42)
|
||||
|
||||
(define pl-mp-env-an2 {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "atom_number(A, 7)" pl-mp-env-an2)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"atom_number(A, 7) -> A='7'"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-mp-env-an2 "A")))
|
||||
"7")
|
||||
|
||||
(pl-mp-test!
|
||||
"atom_number(foo, N) fails (not a number)"
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "atom_number(foo, N)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; -- number_string/2 --
|
||||
|
||||
(define pl-mp-env-ns1 {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "number_string(42, S)" pl-mp-env-ns1)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"number_string(42, S) -> S='42'"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-mp-env-ns1 "S")))
|
||||
"42")
|
||||
|
||||
(define pl-mp-env-ns2 {})
|
||||
(pl-solve-once!
|
||||
pl-mp-db
|
||||
(pl-mp-goal "number_string(N, '3.14')" pl-mp-env-ns2)
|
||||
(pl-mk-trail))
|
||||
(pl-mp-test!
|
||||
"number_string(N, '3.14') -> N=3.14"
|
||||
(pl-num-val (pl-walk-deep (dict-get pl-mp-env-ns2 "N")))
|
||||
3.14)
|
||||
|
||||
(define pl-meta-predicates-tests-run! (fn () {:failed pl-mp-test-fail :passed pl-mp-test-pass :total pl-mp-test-count :failures pl-mp-test-failures}))
|
||||
@@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
|
||||
_Newest first. Agent appends on every commit._
|
||||
|
||||
- 2026-04-25 — Meta/logic predicates: `\+/1` (negation-as-failure, trail-undo on success), `not/1` (alias), `once/1` (commit to first solution via if-then-else), `ignore/1` (always succeed), `ground/1` (all vars bound), `sort/2` (sort + dedup by formatted key), `msort/2` (sort, keep dups), `atom_number/2` (bidirectional), `number_string/2` (bidirectional). 2 helpers (`pl-ground?`, `pl-sort-pairs-dedup`). 25 tests in `tests/meta_predicates.sx`. Total **342** (+25).
|
||||
- 2026-04-25 — ISO utility predicates batch: `succ/2` (bidirectional), `plus/3` (3-mode bidirectional), `between/3` (backtracking range generator), `length/2` (bidirectional list length + var-list constructor), `last/2`, `nth0/3`, `nth1/3`, `max/2` + `min/2` in arithmetic eval. 6 new helper functions (`pl-list-length`, `pl-make-list-of-vars`, `pl-between-loop!`, `pl-solve-between!`, `pl-solve-last!`, `pl-solve-nth0!`). 29 tests in `tests/iso_predicates.sx`. Phase 6 complete: scoreboard already at 317, far above 200+ target. Hyperscript DSL blocked (needs `lib/hyperscript/**`). Total **317** (+29).
|
||||
- 2026-04-25 — `prolog-query` SX API (`lib/prolog/query.sx`). New public API layer: `pl-load source-str → db`, `pl-query-all db query-str → list of solution dicts`, `pl-query-one db query-str → dict or nil`, `pl-query src query → list` (convenience). Each solution dict maps variable name strings to their formatted term strings. Var names extracted from pre-instantiation parse AST. Trail is marked before solve and reset after to ensure clean state. 16 tests in `tests/query_api.sx` cover fact lookup, no-solution, boolean queries, multi-var, recursive rules, is/2 built-in, query-one, convenience form. Total **288** (+16).
|
||||
- 2026-04-25 — String/atom predicates. Type-test predicates: `var/1`, `nonvar/1`, `atom/1`, `number/1`, `integer/1`, `float/1` (always-fail), `compound/1`, `callable/1`, `atomic/1`, `is_list/1`. String/atom operations: `atom_length/2`, `atom_concat/3` (3 modes: both-ground, result+first, result+second), `atom_chars/2` (bidirectional), `atom_codes/2` (bidirectional), `char_code/2` (bidirectional), `number_codes/2`, `number_chars/2`. 7 helper functions in runtime.sx (`pl-list-to-prolog`, `pl-proper-list?`, `pl-prolog-list-to-sx`, `pl-solve-atom-concat!`, `pl-solve-atom-chars!`, `pl-solve-atom-codes!`, `pl-solve-char-code!`). 34 tests in `tests/atoms.sx`. Total **272** (+34).
|
||||
|
||||
Reference in New Issue
Block a user