String/atom predicates: var/nonvar/atom/number/compound/callable/atomic/is_list + atom_length/atom_concat/atom_chars/atom_codes/char_code/number_codes/number_chars
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:
@@ -29,6 +29,7 @@ SUITES=(
|
||||
"member:lib/prolog/tests/programs/member.sx:pl-member-tests-run!"
|
||||
"nqueens:lib/prolog/tests/programs/nqueens.sx:pl-nqueens-tests-run!"
|
||||
"family:lib/prolog/tests/programs/family.sx:pl-family-tests-run!"
|
||||
"atoms:lib/prolog/tests/atoms.sx:pl-atom-tests-run!"
|
||||
)
|
||||
|
||||
SCRIPT='(epoch 1)
|
||||
|
||||
@@ -595,6 +595,182 @@
|
||||
pl-cut?
|
||||
(fn (t) (and (list? t) (not (empty? t)) (= (first t) "cut"))))
|
||||
|
||||
(define
|
||||
pl-list-to-prolog
|
||||
(fn
|
||||
(xs)
|
||||
(if
|
||||
(empty? xs)
|
||||
(list "atom" "[]")
|
||||
(list "compound" "." (list (first xs) (pl-list-to-prolog (rest xs)))))))
|
||||
|
||||
(define
|
||||
pl-proper-list?
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((w (pl-walk t)))
|
||||
(cond
|
||||
((and (pl-atom? w) (= (pl-atom-name w) "[]")) true)
|
||||
((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
|
||||
(pl-proper-list? (nth (pl-args w) 1)))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-prolog-list-to-sx
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((w (pl-walk t)))
|
||||
(cond
|
||||
((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list))
|
||||
((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
|
||||
(cons
|
||||
(pl-walk (first (pl-args w)))
|
||||
(pl-prolog-list-to-sx (nth (pl-args w) 1))))
|
||||
(true (list))))))
|
||||
|
||||
(define
|
||||
pl-solve-atom-concat!
|
||||
(fn
|
||||
(a1-rt a2-rt a3-rt trail k)
|
||||
(let
|
||||
((a1 (pl-walk a1-rt)) (a2 (pl-walk a2-rt)) (a3 (pl-walk a3-rt)))
|
||||
(cond
|
||||
((and (pl-atom? a1) (pl-atom? a2))
|
||||
(pl-solve-eq!
|
||||
a3-rt
|
||||
(list "atom" (str (pl-atom-name a1) (pl-atom-name a2)))
|
||||
trail
|
||||
k))
|
||||
((and (pl-atom? a3) (pl-atom? a1))
|
||||
(let
|
||||
((s3 (pl-atom-name a3)) (s1 (pl-atom-name a1)))
|
||||
(if
|
||||
(starts-with? s3 s1)
|
||||
(pl-solve-eq!
|
||||
a2-rt
|
||||
(list "atom" (substring s3 (len s1) (len s3)))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
((and (pl-atom? a3) (pl-atom? a2))
|
||||
(let
|
||||
((s3 (pl-atom-name a3)) (s2 (pl-atom-name a2)))
|
||||
(if
|
||||
(ends-with? s3 s2)
|
||||
(pl-solve-eq!
|
||||
a1-rt
|
||||
(list "atom" (substring s3 0 (- (len s3) (len s2))))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-solve-atom-chars!
|
||||
(fn
|
||||
(atom-rt chars-rt trail k)
|
||||
(let
|
||||
((a (pl-walk atom-rt)))
|
||||
(cond
|
||||
((pl-atom? a)
|
||||
(pl-solve-eq!
|
||||
chars-rt
|
||||
(pl-list-to-prolog
|
||||
(map (fn (c) (list "atom" c)) (split (pl-atom-name a) "")))
|
||||
trail
|
||||
k))
|
||||
((pl-num? a)
|
||||
(pl-solve-eq!
|
||||
chars-rt
|
||||
(pl-list-to-prolog
|
||||
(map
|
||||
(fn (c) (list "atom" c))
|
||||
(split (str (pl-num-val a)) "")))
|
||||
trail
|
||||
k))
|
||||
((pl-var? a)
|
||||
(if
|
||||
(pl-proper-list? chars-rt)
|
||||
(let
|
||||
((char-terms (pl-prolog-list-to-sx chars-rt)))
|
||||
(pl-solve-eq!
|
||||
atom-rt
|
||||
(list
|
||||
"atom"
|
||||
(join "" (map (fn (t) (pl-atom-name t)) char-terms)))
|
||||
trail
|
||||
k))
|
||||
false))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-solve-atom-codes!
|
||||
(fn
|
||||
(atom-rt codes-rt trail k)
|
||||
(let
|
||||
((a (pl-walk atom-rt)))
|
||||
(cond
|
||||
((pl-atom? a)
|
||||
(pl-solve-eq!
|
||||
codes-rt
|
||||
(pl-list-to-prolog
|
||||
(map
|
||||
(fn (c) (list "num" (char-code c)))
|
||||
(split (pl-atom-name a) "")))
|
||||
trail
|
||||
k))
|
||||
((pl-num? a)
|
||||
(pl-solve-eq!
|
||||
codes-rt
|
||||
(pl-list-to-prolog
|
||||
(map
|
||||
(fn (c) (list "num" (char-code c)))
|
||||
(split (str (pl-num-val a)) "")))
|
||||
trail
|
||||
k))
|
||||
((pl-var? a)
|
||||
(if
|
||||
(pl-proper-list? codes-rt)
|
||||
(let
|
||||
((code-terms (pl-prolog-list-to-sx codes-rt)))
|
||||
(pl-solve-eq!
|
||||
atom-rt
|
||||
(list
|
||||
"atom"
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (t) (char-from-code (pl-num-val t)))
|
||||
code-terms)))
|
||||
trail
|
||||
k))
|
||||
false))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-solve-char-code!
|
||||
(fn
|
||||
(char-rt code-rt trail k)
|
||||
(let
|
||||
((c (pl-walk char-rt)) (n (pl-walk code-rt)))
|
||||
(cond
|
||||
((pl-atom? c)
|
||||
(let
|
||||
((s (pl-atom-name c)))
|
||||
(if
|
||||
(= (len s) 1)
|
||||
(pl-solve-eq! code-rt (list "num" (char-code s)) trail k)
|
||||
false)))
|
||||
((pl-num? n)
|
||||
(pl-solve-eq!
|
||||
char-rt
|
||||
(list "atom" (char-from-code (pl-num-val n)))
|
||||
trail
|
||||
k))
|
||||
(true false)))))
|
||||
|
||||
(define
|
||||
pl-solve!
|
||||
(fn
|
||||
@@ -726,6 +902,106 @@
|
||||
(nth (pl-args g) 2)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "var") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (pl-var? a) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "nonvar") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (not (pl-var? a)) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (pl-atom? a) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "number") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (pl-num? a) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "integer") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (pl-num? a) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "float") (= (len (pl-args g)) 1))
|
||||
false)
|
||||
((and (pl-compound? g) (= (pl-fun g) "compound") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (pl-compound? a) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "callable") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (or (pl-atom? a) (pl-compound? a)) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atomic") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if (or (pl-atom? a) (or (pl-num? a) (pl-str? a))) (k) false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "is_list") (= (len (pl-args g)) 1))
|
||||
(if (pl-proper-list? (first (pl-args g))) (k) false))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom_length") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-atom? a)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (len (pl-atom-name a)))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom_concat") (= (len (pl-args g)) 3))
|
||||
(pl-solve-atom-concat!
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
(nth (pl-args g) 2)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom_chars") (= (len (pl-args g)) 2))
|
||||
(pl-solve-atom-chars!
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "atom_codes") (= (len (pl-args g)) 2))
|
||||
(pl-solve-atom-codes!
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "char_code") (= (len (pl-args g)) 2))
|
||||
(pl-solve-char-code!
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "number_codes") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-num? a)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog
|
||||
(map
|
||||
(fn (c) (list "num" (char-code c)))
|
||||
(split (str (pl-num-val a)) "")))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
((and (pl-compound? g) (= (pl-fun g) "number_chars") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-num? a)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog
|
||||
(map
|
||||
(fn (c) (list "atom" c))
|
||||
(split (str (pl-num-val a)) "")))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
(true (pl-solve-user! db g trail cut-box k))))))
|
||||
|
||||
(define
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{
|
||||
"total_passed": 238,
|
||||
"total_passed": 272,
|
||||
"total_failed": 0,
|
||||
"total": 238,
|
||||
"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}},
|
||||
"generated": "2026-04-25T08:39:07+00:00"
|
||||
"total": 272,
|
||||
"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}},
|
||||
"generated": "2026-04-25T09:26:33+00:00"
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Prolog scoreboard
|
||||
|
||||
**238 / 238 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T08:39:07+00:00.
|
||||
**272 / 272 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T09:26:33+00:00.
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -18,6 +18,7 @@ Generated 2026-04-25T08:39:07+00:00.
|
||||
| member | 7 | 7 | ok |
|
||||
| nqueens | 6 | 6 | ok |
|
||||
| family | 10 | 10 | ok |
|
||||
| atoms | 34 | 34 | ok |
|
||||
|
||||
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
|
||||
with `SX_SERVER=path/to/sx_server.exe bash …`.
|
||||
|
||||
305
lib/prolog/tests/atoms.sx
Normal file
305
lib/prolog/tests/atoms.sx
Normal file
@@ -0,0 +1,305 @@
|
||||
;; lib/prolog/tests/atoms.sx — type predicates + string/atom built-ins
|
||||
|
||||
(define pl-at-test-count 0)
|
||||
(define pl-at-test-pass 0)
|
||||
(define pl-at-test-fail 0)
|
||||
(define pl-at-test-failures (list))
|
||||
|
||||
(define
|
||||
pl-at-test!
|
||||
(fn
|
||||
(name got expected)
|
||||
(begin
|
||||
(set! pl-at-test-count (+ pl-at-test-count 1))
|
||||
(if
|
||||
(= got expected)
|
||||
(set! pl-at-test-pass (+ pl-at-test-pass 1))
|
||||
(begin
|
||||
(set! pl-at-test-fail (+ pl-at-test-fail 1))
|
||||
(append!
|
||||
pl-at-test-failures
|
||||
(str name "\n expected: " expected "\n got: " got)))))))
|
||||
|
||||
(define
|
||||
pl-at-goal
|
||||
(fn
|
||||
(src env)
|
||||
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
||||
|
||||
(define pl-at-db (pl-mk-db))
|
||||
|
||||
;; ── var/1 + nonvar/1 ──
|
||||
|
||||
(pl-at-test!
|
||||
"var(X) for unbound var"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "var(X)" {}) (pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"var(foo) fails"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "var(foo)" {}) (pl-mk-trail))
|
||||
false)
|
||||
(pl-at-test!
|
||||
"nonvar(foo) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "nonvar(foo)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"nonvar(X) for unbound var fails"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "nonvar(X)" {}) (pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; ── atom/1 ──
|
||||
|
||||
(pl-at-test!
|
||||
"atom(foo) succeeds"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "atom(foo)" {}) (pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"atom([]) succeeds"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "atom([])" {}) (pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"atom(42) fails"
|
||||
(pl-solve-once! pl-at-db (pl-at-goal "atom(42)" {}) (pl-mk-trail))
|
||||
false)
|
||||
(pl-at-test!
|
||||
"atom(f(x)) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom(f(x))" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; ── number/1 + integer/1 ──
|
||||
|
||||
(pl-at-test!
|
||||
"number(42) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "number(42)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"number(foo) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "number(foo)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
(pl-at-test!
|
||||
"integer(7) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "integer(7)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; ── compound/1 + callable/1 + atomic/1 ──
|
||||
|
||||
(pl-at-test!
|
||||
"compound(f(x)) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "compound(f(x))" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"compound(foo) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "compound(foo)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
(pl-at-test!
|
||||
"callable(foo) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "callable(foo)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"callable(f(x)) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "callable(f(x))" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"callable(42) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "callable(42)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
(pl-at-test!
|
||||
"atomic(foo) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atomic(foo)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"atomic(42) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atomic(42)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"atomic(f(x)) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atomic(f(x))" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; ── is_list/1 ──
|
||||
|
||||
(pl-at-test!
|
||||
"is_list([]) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "is_list([])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"is_list([1,2,3]) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "is_list([1,2,3])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"is_list(foo) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "is_list(foo)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
;; ── atom_length/2 ──
|
||||
|
||||
(define pl-at-env-al {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_length(hello, N)" pl-at-env-al)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"atom_length(hello, N) -> N=5"
|
||||
(pl-num-val (pl-walk-deep (dict-get pl-at-env-al "N")))
|
||||
5)
|
||||
(pl-at-test!
|
||||
"atom_length empty atom"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_length('', 0)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; ── atom_concat/3 ──
|
||||
|
||||
(define pl-at-env-ac {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_concat(foo, bar, X)" pl-at-env-ac)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"atom_concat(foo, bar, X) -> X=foobar"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ac "X")))
|
||||
"foobar")
|
||||
|
||||
(pl-at-test!
|
||||
"atom_concat(foo, bar, foobar) check"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_concat(foo, bar, foobar)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
(pl-at-test!
|
||||
"atom_concat(foo, bar, foobaz) fails"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_concat(foo, bar, foobaz)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(define pl-at-env-ac2 {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_concat(foo, Y, foobar)" pl-at-env-ac2)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"atom_concat(foo, Y, foobar) -> Y=bar"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ac2 "Y")))
|
||||
"bar")
|
||||
|
||||
;; ── atom_chars/2 ──
|
||||
|
||||
(define pl-at-env-ach {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_chars(cat, Cs)" pl-at-env-ach)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"atom_chars(cat, Cs) -> Cs=[c,a,t]"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_chars(cat, [c,a,t])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(define pl-at-env-ach2 {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "atom_chars(A, [h,i])" pl-at-env-ach2)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"atom_chars(A, [h,i]) -> A=hi"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-ach2 "A")))
|
||||
"hi")
|
||||
|
||||
;; ── char_code/2 ──
|
||||
|
||||
(define pl-at-env-cc {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "char_code(a, N)" pl-at-env-cc)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"char_code(a, N) -> N=97"
|
||||
(pl-num-val (pl-walk-deep (dict-get pl-at-env-cc "N")))
|
||||
97)
|
||||
|
||||
(define pl-at-env-cc2 {})
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "char_code(C, 65)" pl-at-env-cc2)
|
||||
(pl-mk-trail))
|
||||
(pl-at-test!
|
||||
"char_code(C, 65) -> C='A'"
|
||||
(pl-atom-name (pl-walk-deep (dict-get pl-at-env-cc2 "C")))
|
||||
"A")
|
||||
|
||||
;; ── number_codes/2 ──
|
||||
|
||||
(pl-at-test!
|
||||
"number_codes(42, [52,50])"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "number_codes(42, [52,50])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
;; ── number_chars/2 ──
|
||||
|
||||
(pl-at-test!
|
||||
"number_chars(42, ['4','2'])"
|
||||
(pl-solve-once!
|
||||
pl-at-db
|
||||
(pl-at-goal "number_chars(42, ['4','2'])" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(define pl-atom-tests-run! (fn () {:failed pl-at-test-fail :passed pl-at-test-pass :total pl-at-test-count :failures pl-at-test-failures}))
|
||||
@@ -69,7 +69,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
- [x] `assert/1`, `asserta/1`, `assertz/1`, `retract/1` — `assert` aliases `assertz`. Helpers `pl-rt-to-ast` (deep-walk + replace runtime vars with `_G<id>` parse markers) + `pl-build-clause` (detect `:-` head). `assertz` uses `pl-db-add!`; `asserta` uses new `pl-db-prepend!`. `retract` walks goal, looks up by functor/arity, tries each clause via unification, removes first match by index (`pl-list-without`). 11 tests in `tests/dynamic.sx`. Rule-asserts deferred — `:-` not in op table yet, so only fact-shaped clauses for now.
|
||||
- [x] `findall/3`, `bagof/3`, `setof/3` — shared `pl-collect-solutions` runs the goal in a fresh cut-box, deep-copies the template (via `pl-deep-copy` with var-map for shared-var preservation) on each success, returns false to backtrack, then restores trail. `findall` always succeeds with a (possibly empty) list. `bagof` fails on empty. `setof` builds a string-keyed dict via `pl-format-term` for sort+dedupe (via `keys` + `sort`), fails on empty. Existential `^` deferred (operator). 11 tests in `tests/findall.sx`.
|
||||
- [x] `copy_term/2`, `functor/3`, `arg/3`, `=../2` — `copy_term/2` reuses `pl-deep-copy` with a fresh var-map (preserves source aliasing). `functor/3` handles 4 modes: compound→{name, arity}, atom→{atom, 0}, num→{num, 0}, var with ground name+arity→constructed term (`pl-make-fresh-args` for compound case). `arg/3` extracts 1-indexed arg from compound. **`=../2` deferred** — the tokenizer treats `.` as the clause terminator unconditionally, so `=..` lexes as `=` + `.` + `.`; needs special-case lex (or surface syntax via a different name). 14 tests in `tests/term_inspect.sx`.
|
||||
- [ ] String/atom predicates
|
||||
- [x] String/atom predicates
|
||||
|
||||
### Phase 5 — Hyperscript integration
|
||||
- [ ] `prolog-query` primitive callable from SX/Hyperscript
|
||||
@@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
|
||||
_Newest first. Agent appends on every commit._
|
||||
|
||||
- 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).
|
||||
- 2026-04-25 — `copy_term/2` + `functor/3` + `arg/3` (term inspection). `copy_term` is a one-line dispatch to existing `pl-deep-copy`. `functor/3` is bidirectional — decomposes a bound compound/atom/num into name+arity OR constructs from ground name+arity (atom+positive-arity → compound with N anonymous fresh args via `pl-make-fresh-args`; arity 0 → atom/num). `arg/3` extracts 1-indexed arg with bounds-fail. New helper `pl-solve-eq2!` for paired-unification with shared trail-undo. 14 tests in `tests/term_inspect.sx`. Total **238** (+14). `=..` deferred — `.` always tokenizes as clause terminator; needs special lexer case.
|
||||
- 2026-04-25 — `findall/3` + `bagof/3` + `setof/3`. Shared collector `pl-collect-solutions` runs the goal in a fresh cut-box, deep-copies the template per success (`pl-deep-copy` walks term, allocates fresh runtime vars via shared var-map so co-occurrences keep aliasing), returns false to keep backtracking, then `pl-trail-undo-to!` to clean up. `findall` always builds a list. `bagof` fails on empty. `setof` uses a `pl-format-term`-keyed dict + SX `sort` for dedupe + ordering. New `tests/findall.sx` 11 tests. Total **224** (+11). Existential `^` deferred — needs operator.
|
||||
- 2026-04-25 — Dynamic clauses: `assert/1`, `assertz/1`, `asserta/1`, `retract/1`. New helpers `pl-rt-to-ast` (deep-walk runtime term → parse-AST, mapping unbound runtime vars to `_G<id>` markers so `pl-instantiate-fresh` produces fresh vars per call) + `pl-build-clause` + `pl-db-prepend!` + `pl-list-without`. `retract` keeps runtime vars (so the caller's vars get bound), walks head for the functor/arity key, tries each stored clause via `pl-unify!`, removes the first match by index. 11 tests in `tests/dynamic.sx`; conformance script gained dynamic row. Total **213** (+11). Rule-form asserts (`(H :- B)`) deferred until `:-` is in the op table.
|
||||
|
||||
Reference in New Issue
Block a user