sub_atom/5 (non-det substring) + aggregate_all/3 (count/bag/sum/max/min/set)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

Adds two new builtins to lib/prolog/runtime.sx:

- sub_atom/5: non-deterministic substring enumeration. Iterates all
  (start, length) pairs over the atom string, tries to unify Before,
  Length, After, SubAtom for each candidate. Uses CPS loop helpers
  pl-substring, pl-sub-atom-try-one!, pl-sub-atom-loop!. Fixed trail
  undo semantics: only undo on backtrack (k returns false), not on success.

- aggregate_all/3: collects all solutions via pl-collect-solutions then
  reduces. Templates: count, bag(T), sum(E), max(E), min(E), set(T).
  max/min fail on empty; count/bag/sum/set always succeed.

New test suite lib/prolog/tests/string_agg.sx: 25 tests, all passing.
Total conformance: 496/496.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-25 13:50:13 +00:00
parent 0a8b30b7b8
commit 537e2cdb5a
5 changed files with 448 additions and 7 deletions

View File

@@ -39,6 +39,7 @@ SUITES=(
"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!"
"string_agg:lib/prolog/tests/string_agg.sx:pl-string-agg-tests-run!"
)
SCRIPT='(epoch 1)

View File

@@ -1517,6 +1517,139 @@
false))))
(define
pl-substring
(fn (s start sublen) (substring s start (+ start sublen))))
(define
pl-sub-atom-try-one!
(fn
(s start sublen total-len before-arg len-arg after-arg sub-arg trail k)
(let
((mark (pl-trail-mark trail))
(after-val (- total-len (+ start sublen)))
(sub (pl-substring s start sublen)))
(if
(and
(pl-unify! before-arg (list "num" start) trail)
(pl-unify! len-arg (list "num" sublen) trail)
(pl-unify! after-arg (list "num" after-val) trail)
(pl-unify! sub-arg (list "atom" sub) trail))
(let
((kresult (k)))
(if kresult kresult (begin (pl-trail-undo-to! trail mark) false)))
(begin (pl-trail-undo-to! trail mark) false)))))
(define
pl-sub-atom-loop!
(fn
(s total-len start sublen before-arg len-arg after-arg sub-arg trail k)
(cond
((> start total-len) false)
((> sublen (- total-len start))
(pl-sub-atom-loop!
s
total-len
(+ start 1)
0
before-arg
len-arg
after-arg
sub-arg
trail
k))
(true
(let
((one-result (pl-sub-atom-try-one! s start sublen total-len before-arg len-arg after-arg sub-arg trail k)))
(if
one-result
one-result
(pl-sub-atom-loop!
s
total-len
start
(+ sublen 1)
before-arg
len-arg
after-arg
sub-arg
trail
k)))))))
(define
pl-solve-aggregate-all!
(fn
(db tmpl goal result trail k)
(let
((tmpl-walked (pl-walk-deep tmpl)))
(cond
((and (pl-atom? tmpl-walked) (= (pl-atom-name tmpl-walked) "count"))
(let
((solutions (pl-collect-solutions db (list "atom" "true") goal trail)))
(if
(pl-unify! result (list "num" (len solutions)) trail)
(k)
false)))
((and (pl-compound? tmpl-walked) (= (pl-fun tmpl-walked) "bag") (= (len (pl-args tmpl-walked)) 1))
(let
((template (nth (pl-args tmpl-walked) 0)))
(let
((solutions (pl-collect-solutions db template goal trail)))
(let
((prolog-list (pl-mk-list-term solutions (pl-nil-term))))
(if (pl-unify! result prolog-list trail) (k) false)))))
((and (pl-compound? tmpl-walked) (= (pl-fun tmpl-walked) "sum") (= (len (pl-args tmpl-walked)) 1))
(let
((template (nth (pl-args tmpl-walked) 0)))
(let
((solutions (pl-collect-solutions db template goal trail)))
(let
((total (reduce (fn (acc sol) (+ acc (pl-eval-arith sol))) 0 solutions)))
(if (pl-unify! result (list "num" total) trail) (k) false)))))
((and (pl-compound? tmpl-walked) (= (pl-fun tmpl-walked) "max") (= (len (pl-args tmpl-walked)) 1))
(let
((template (nth (pl-args tmpl-walked) 0)))
(let
((solutions (pl-collect-solutions db template goal trail)))
(if
(empty? solutions)
false
(let
((vals (map pl-eval-arith solutions)))
(let
((mx (reduce (fn (a b) (if (> a b) a b)) (first vals) (rest vals))))
(if (pl-unify! result (list "num" mx) trail) (k) false)))))))
((and (pl-compound? tmpl-walked) (= (pl-fun tmpl-walked) "min") (= (len (pl-args tmpl-walked)) 1))
(let
((template (nth (pl-args tmpl-walked) 0)))
(let
((solutions (pl-collect-solutions db template goal trail)))
(if
(empty? solutions)
false
(let
((vals (map pl-eval-arith solutions)))
(let
((mn (reduce (fn (a b) (if (< a b) a b)) (first vals) (rest vals))))
(if (pl-unify! result (list "num" mn) trail) (k) false)))))))
((and (pl-compound? tmpl-walked) (= (pl-fun tmpl-walked) "set") (= (len (pl-args tmpl-walked)) 1))
(let
((template (nth (pl-args tmpl-walked) 0)))
(let
((solutions (pl-collect-solutions db template goal trail)))
(let
((deduped (pl-list-to-set-sx solutions (list))))
(let
((keyed (map (fn (t) (list (pl-format-term t) t)) deduped)))
(let
((sorted (sort keyed)))
(let
((sorted-terms (map (fn (pair) (nth pair 1)) sorted)))
(let
((prolog-list (pl-mk-list-term sorted-terms (pl-nil-term))))
(if (pl-unify! result prolog-list trail) (k) false)))))))))
(true false)))))
(define
pl-solve!
(fn
@@ -2240,7 +2373,40 @@
((and (pl-compound? g) (= (pl-fun g) "format") (= (len (pl-args g)) 1))
(pl-solve-format-1! (nth (pl-args g) 0) k))
((and (pl-compound? g) (= (pl-fun g) "format") (= (len (pl-args g)) 2))
(pl-solve-format-2! db (nth (pl-args g) 0) (nth (pl-args g) 1) trail k))
(pl-solve-format-2!
db
(nth (pl-args g) 0)
(nth (pl-args g) 1)
trail
k))
((and (pl-compound? g) (= (pl-fun g) "sub_atom") (= (len (pl-args g)) 5))
(let
((atom-term (pl-walk-deep (nth (pl-args g) 0))))
(if
(pl-atom? atom-term)
(let
((s (pl-atom-name atom-term))
(total-len (len (pl-atom-name atom-term))))
(pl-sub-atom-loop!
s
total-len
0
0
(pl-walk (nth (pl-args g) 1))
(pl-walk (nth (pl-args g) 2))
(pl-walk (nth (pl-args g) 3))
(pl-walk (nth (pl-args g) 4))
trail
k))
false)))
((and (pl-compound? g) (= (pl-fun g) "aggregate_all") (= (len (pl-args g)) 3))
(pl-solve-aggregate-all!
db
(pl-walk (nth (pl-args g) 0))
(pl-walk (nth (pl-args g) 1))
(pl-walk (nth (pl-args g) 2))
trail
k))
(true (pl-solve-user! db g trail cut-box k))))))
(define

View File

@@ -1,7 +1,7 @@
{
"total_passed": 471,
"total_passed": 496,
"total_failed": 0,
"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"
"total": 496,
"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},"string_agg":{"passed":25,"total":25,"failed":0}},
"generated": "2026-04-25T13:49:43+00:00"
}

View File

@@ -1,7 +1,7 @@
# Prolog scoreboard
**471 / 471 passing** (0 failure(s)).
Generated 2026-04-25T13:21:37+00:00.
**496 / 496 passing** (0 failure(s)).
Generated 2026-04-25T13:49:43+00:00.
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
@@ -28,6 +28,7 @@ Generated 2026-04-25T13:21:37+00:00.
| char_predicates | 27 | 27 | ok |
| io_predicates | 24 | 24 | ok |
| assert_rules | 15 | 15 | ok |
| string_agg | 25 | 25 | 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,273 @@
;; lib/prolog/tests/string_agg.sx -- sub_atom/5 + aggregate_all/3
(define pl-sa-test-count 0)
(define pl-sa-test-pass 0)
(define pl-sa-test-fail 0)
(define pl-sa-test-failures (list))
(define
pl-sa-test!
(fn
(name got expected)
(begin
(set! pl-sa-test-count (+ pl-sa-test-count 1))
(if
(= got expected)
(set! pl-sa-test-pass (+ pl-sa-test-pass 1))
(begin
(set! pl-sa-test-fail (+ pl-sa-test-fail 1))
(append!
pl-sa-test-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
pl-sa-goal
(fn
(src env)
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
(define pl-sa-db (pl-mk-db))
(define
pl-sa-num-val
(fn (env key) (pl-num-val (pl-walk-deep (dict-get env key)))))
(define
pl-sa-list-to-atoms
(fn
(t)
(let
((w (pl-walk-deep 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-atom-name (first (pl-args w)))
(pl-sa-list-to-atoms (nth (pl-args w) 1))))
(true (list))))))
(define pl-sa-prog-src "member(X, [X|_]). member(X, [_|T]) :- member(X, T).")
(pl-db-load! pl-sa-db (pl-parse pl-sa-prog-src))
;; -- sub_atom/5 --
(pl-sa-test!
"sub_atom ground: sub_atom(abcde,0,3,2,abc)"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(abcde, 0, 3, 2, abc)" {})
(pl-mk-trail))
true)
(pl-sa-test!
"sub_atom ground: sub_atom(abcde,2,2,1,cd)"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(abcde, 2, 2, 1, cd)" {})
(pl-mk-trail))
true)
(pl-sa-test!
"sub_atom ground mismatch fails"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(abcde, 0, 2, 3, cd)" {})
(pl-mk-trail))
false)
(pl-sa-test!
"sub_atom empty sub at start"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(abcde, 0, 0, 5, '')" {})
(pl-mk-trail))
true)
(pl-sa-test!
"sub_atom whole string"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(hello, 0, 5, 0, hello)" {})
(pl-mk-trail))
true)
(define pl-sa-env-b1 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(abcde, B, 2, A, cd)" pl-sa-env-b1)
(pl-mk-trail))
(pl-sa-test!
"sub_atom bound SubAtom gives B=2"
(pl-sa-num-val pl-sa-env-b1 "B")
2)
(pl-sa-test!
"sub_atom bound SubAtom gives A=1"
(pl-sa-num-val pl-sa-env-b1 "A")
1)
(define pl-sa-env-b2 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal "sub_atom(hello, B, L, A, ello)" pl-sa-env-b2)
(pl-mk-trail))
(pl-sa-test! "sub_atom ello: B=1" (pl-sa-num-val pl-sa-env-b2 "B") 1)
(pl-sa-test! "sub_atom ello: L=4" (pl-sa-num-val pl-sa-env-b2 "L") 4)
(pl-sa-test! "sub_atom ello: A=0" (pl-sa-num-val pl-sa-env-b2 "A") 0)
(pl-sa-test!
"sub_atom ab: 6 total solutions"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(count, sub_atom(ab, _, _, _, _), N)" env)
(pl-mk-trail))
(pl-sa-num-val env "N"))
6)
(pl-sa-test!
"sub_atom a: 3 total solutions"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(count, sub_atom(a, _, _, _, _), N)" env)
(pl-mk-trail))
(pl-sa-num-val env "N"))
3)
;; -- aggregate_all/3 --
(pl-sa-test!
"aggregate_all count member [a,b,c] = 3"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(count, member(_, [a,b,c]), N)" env)
(pl-mk-trail))
(pl-sa-num-val env "N"))
3)
(pl-sa-test!
"aggregate_all count fail = 0"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(count, fail, N)" env)
(pl-mk-trail))
(pl-sa-num-val env "N"))
0)
(pl-sa-test!
"aggregate_all count always succeeds"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(count, fail, _)" {})
(pl-mk-trail))
true)
(define pl-sa-env-bag1 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(bag(X), member(X, [a,b,c]), L)" pl-sa-env-bag1)
(pl-mk-trail))
(pl-sa-test!
"aggregate_all bag [a,b,c]"
(pl-sa-list-to-atoms (dict-get pl-sa-env-bag1 "L"))
(list "a" "b" "c"))
(define pl-sa-env-bag2 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(bag(X), member(X, []), L)" pl-sa-env-bag2)
(pl-mk-trail))
(pl-sa-test!
"aggregate_all bag empty goal = []"
(pl-sa-list-to-atoms (dict-get pl-sa-env-bag2 "L"))
(list))
(pl-sa-test!
"aggregate_all sum [1,2,3,4] = 10"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(sum(X), member(X, [1,2,3,4]), S)" env)
(pl-mk-trail))
(pl-sa-num-val env "S"))
10)
(pl-sa-test!
"aggregate_all max [3,1,4,1,5,9,2,6] = 9"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(max(X), member(X, [3,1,4,1,5,9,2,6]), M)" env)
(pl-mk-trail))
(pl-sa-num-val env "M"))
9)
(pl-sa-test!
"aggregate_all max empty fails"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(max(X), member(X, []), M)" {})
(pl-mk-trail))
false)
(pl-sa-test!
"aggregate_all min [3,1,4,1,5,9,2,6] = 1"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(min(X), member(X, [3,1,4,1,5,9,2,6]), M)" env)
(pl-mk-trail))
(pl-sa-num-val env "M"))
1)
(pl-sa-test!
"aggregate_all min empty fails"
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(min(X), member(X, []), M)" {})
(pl-mk-trail))
false)
(define pl-sa-env-set1 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal
"aggregate_all(set(X), member(X, [b,a,c,a,b]), S)"
pl-sa-env-set1)
(pl-mk-trail))
(pl-sa-test!
"aggregate_all set [b,a,c,a,b] = [a,b,c]"
(pl-sa-list-to-atoms (dict-get pl-sa-env-set1 "S"))
(list "a" "b" "c"))
(define pl-sa-env-set2 {})
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(set(X), fail, S)" pl-sa-env-set2)
(pl-mk-trail))
(pl-sa-test!
"aggregate_all set fail = []"
(pl-sa-list-to-atoms (dict-get pl-sa-env-set2 "S"))
(list))
(pl-sa-test!
"aggregate_all sum empty = 0"
(let
((env {}))
(pl-solve-once!
pl-sa-db
(pl-sa-goal "aggregate_all(sum(X), fail, S)" env)
(pl-mk-trail))
(pl-sa-num-val env "S"))
0)
(define pl-string-agg-tests-run! (fn () {:failed pl-sa-test-fail :passed pl-sa-test-pass :total pl-sa-test-count :failures pl-sa-test-failures}))