coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 15 Packages Projects Releases Wiki Activity

Set predicates: foldl/4, list_to_set/2, intersection/3, subtract/3, union/3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source 
Adds 5 new built-in predicates to the Prolog runtime with 15 tests.
390 → 405 tests across 20 suites (all passing).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-25 12:22:03 +00:00
parent 73080bb7de
commit 5a83f4ef51
5 changed files with 325 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
lib/prolog/conformance.sh
View File

@@ -35,6 +35,7 @@ SUITES=(
"meta_predicates:lib/prolog/tests/meta_predicates.sx:pl-meta-predicates-tests-run!"
"list_predicates:lib/prolog/tests/list_predicates.sx:pl-list-predicates-tests-run!"
"meta_call:lib/prolog/tests/meta_call.sx:pl-meta-call-tests-run!"
"set_predicates:lib/prolog/tests/set_predicates.sx:pl-set-predicates-tests-run!"
)
SCRIPT='(epoch 1)

122
lib/prolog/runtime.sx
View File

@@ -1169,6 +1169,50 @@
false))))))))
(else false)))))
(define
pl-solve-foldl!
(fn
(db goal lst vin vout trail k)
(let
((l (pl-walk-deep lst)) (v0 (pl-walk vin)))
(cond
((and (pl-atom? l) (= (pl-atom-name l) "[]"))
(if (pl-unify! vout v0 trail) (k) false))
((and (pl-compound? l) (= (pl-fun l) "."))
(let
((head (first (pl-args l))) (tail (nth (pl-args l) 1)))
(let
((v1-var (pl-mk-rt-var "_FV")))
(let
((call-goal (pl-apply-goal goal (list head v0 v1-var))))
(if
(pl-solve-once! db call-goal trail)
(pl-solve-foldl! db goal tail v1-var vout trail k)
false)))))
(else false)))))
(define
pl-list-to-set-sx
(fn
(lst seen)
(if
(empty? lst)
(list)
(let
((head (first lst)) (tail (rest lst)))
(if
(some (fn (s) (pl-struct-eq? head s)) seen)
(pl-list-to-set-sx tail seen)
(cons head (pl-list-to-set-sx tail (cons head seen))))))))
(define
pl-pl-list-contains?
(fn
(pl-lst elem)
(let
((sx-lst (pl-prolog-list-to-sx (pl-walk-deep pl-lst))))
(some (fn (x) (pl-struct-eq? elem x)) sx-lst))))
(define
pl-solve!
(fn
@@ -1758,6 +1802,84 @@
((cond-g (pl-walk (first (pl-args g))))
(action-g (pl-walk (nth (pl-args g) 1))))
(pl-solve-forall! db cond-g action-g trail cut-box k)))
((and (pl-compound? g) (= (pl-fun g) "foldl") (= (len (pl-args g)) 4))
(pl-solve-foldl!
db
(pl-walk (first (pl-args g)))
(pl-walk (nth (pl-args g) 1))
(pl-walk (nth (pl-args g) 2))
(pl-walk (nth (pl-args g) 3))
trail
k))
((and (pl-compound? g) (= (pl-fun g) "list_to_set") (= (len (pl-args g)) 2))
(let
((lst-rt (pl-walk (first (pl-args g))))
(res-rt (pl-walk (nth (pl-args g) 1))))
(if
(pl-proper-list? lst-rt)
(let
((sx-lst (map (fn (x) (pl-walk-deep x)) (pl-prolog-list-to-sx lst-rt))))
(let
((unique-lst (pl-list-to-set-sx sx-lst (list))))
(pl-solve-eq! res-rt (pl-list-to-prolog unique-lst) trail k)))
false)))
((and (pl-compound? g) (= (pl-fun g) "intersection") (= (len (pl-args g)) 3))
(let
((s1-rt (pl-walk (first (pl-args g))))
(s2-rt (pl-walk (nth (pl-args g) 1)))
(res-rt (pl-walk (nth (pl-args g) 2))))
(if
(and (pl-proper-list? s1-rt) (pl-proper-list? s2-rt))
(let
((s1-sx (map (fn (x) (pl-walk-deep x)) (pl-prolog-list-to-sx s1-rt)))
(s2-sx
(map
(fn (x) (pl-walk-deep x))
(pl-prolog-list-to-sx s2-rt))))
(let
((inter (filter (fn (x) (some (fn (y) (pl-struct-eq? x y)) s2-sx)) s1-sx)))
(pl-solve-eq! res-rt (pl-list-to-prolog inter) trail k)))
false)))
((and (pl-compound? g) (= (pl-fun g) "subtract") (= (len (pl-args g)) 3))
(let
((s1-rt (pl-walk (first (pl-args g))))
(s2-rt (pl-walk (nth (pl-args g) 1)))
(res-rt (pl-walk (nth (pl-args g) 2))))
(if
(and (pl-proper-list? s1-rt) (pl-proper-list? s2-rt))
(let
((s1-sx (map (fn (x) (pl-walk-deep x)) (pl-prolog-list-to-sx s1-rt)))
(s2-sx
(map
(fn (x) (pl-walk-deep x))
(pl-prolog-list-to-sx s2-rt))))
(let
((diff (filter (fn (x) (not (some (fn (y) (pl-struct-eq? x y)) s2-sx))) s1-sx)))
(pl-solve-eq! res-rt (pl-list-to-prolog diff) trail k)))
false)))
((and (pl-compound? g) (= (pl-fun g) "union") (= (len (pl-args g)) 3))
(let
((s1-rt (pl-walk (first (pl-args g))))
(s2-rt (pl-walk (nth (pl-args g) 1)))
(res-rt (pl-walk (nth (pl-args g) 2))))
(if
(and (pl-proper-list? s1-rt) (pl-proper-list? s2-rt))
(let
((s1-sx (map (fn (x) (pl-walk-deep x)) (pl-prolog-list-to-sx s1-rt)))
(s2-sx
(map
(fn (x) (pl-walk-deep x))
(pl-prolog-list-to-sx s2-rt))))
(let
((s2-only (filter (fn (x) (not (some (fn (y) (pl-struct-eq? x y)) s1-sx))) s2-sx)))
(let
((union-lst (append s1-sx s2-only)))
(pl-solve-eq!
res-rt
(pl-list-to-prolog union-lst)
trail
k))))
false)))
(true (pl-solve-user! db g trail cut-box k))))))
(define

8
lib/prolog/scoreboard.json
View File

@@ -1,7 +1,7 @@
{
"total_passed": 390,
"total_passed": 405,
"total_failed": 0,
"total": 390,
"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}},
"generated": "2026-04-25T11:59:16+00:00"
"total": 405,
"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}},
"generated": "2026-04-25T12:21:38+00:00"
}

5
lib/prolog/scoreboard.md
View File

@@ -1,7 +1,7 @@
# Prolog scoreboard
**390 / 390 passing** (0 failure(s)).
Generated 2026-04-25T11:59:16+00:00.
**405 / 405 passing** (0 failure(s)).
Generated 2026-04-25T12:21:38+00:00.
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
@@ -24,6 +24,7 @@ Generated 2026-04-25T11:59:16+00:00.
| meta_predicates | 25 | 25 | ok |
| list_predicates | 33 | 33 | ok |
| meta_call | 15 | 15 | ok |
| set_predicates | 15 | 15 | ok |
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
with `SX_SERVER=path/to/sx_server.exe bash …`.

195
lib/prolog/tests/set_predicates.sx Normal file
View File

@@ -0,0 +1,195 @@
;; lib/prolog/tests/set_predicates.sx — foldl/4, list_to_set/2, intersection/3, subtract/3, union/3
(define pl-sp-test-count 0)
(define pl-sp-test-pass 0)
(define pl-sp-test-fail 0)
(define pl-sp-test-failures (list))
(define
pl-sp-test!
(fn
(name got expected)
(begin
(set! pl-sp-test-count (+ pl-sp-test-count 1))
(if
(= got expected)
(set! pl-sp-test-pass (+ pl-sp-test-pass 1))
(begin
(set! pl-sp-test-fail (+ pl-sp-test-fail 1))
(append!
pl-sp-test-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
pl-sp-goal
(fn
(src env)
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
;; DB with add/3 for foldl tests
(define pl-sp-db (pl-mk-db))
(pl-db-load! pl-sp-db (pl-parse "add(X, Acc, NAcc) :- NAcc is Acc + X."))
;; ── foldl/4 ────────────────────────────────────────────────────────
(define pl-sp-env-fl1 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "foldl(add, [1,2,3,4], 0, S)" pl-sp-env-fl1)
(pl-mk-trail))
(pl-sp-test!
"foldl(add,[1,2,3,4],0,S) -> S=10"
(pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl1 "S")))
10)
(define pl-sp-env-fl2 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "foldl(add, [], 5, S)" pl-sp-env-fl2)
(pl-mk-trail))
(pl-sp-test!
"foldl(add,[],5,S) -> S=5"
(pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl2 "S")))
5)
(define pl-sp-env-fl3 {:S (pl-mk-rt-var "S")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "foldl(add, [1,2,3], 0, S)" pl-sp-env-fl3)
(pl-mk-trail))
(pl-sp-test!
"foldl(add,[1,2,3],0,S) -> S=6"
(pl-num-val (pl-walk-deep (dict-get pl-sp-env-fl3 "S")))
6)
;; ── list_to_set/2 ──────────────────────────────────────────────────
(define pl-sp-env-lts1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "list_to_set([1,2,3,2,1], R)" pl-sp-env-lts1)
(pl-mk-trail))
(pl-sp-test!
"list_to_set([1,2,3,2,1],R) -> [1,2,3]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts1 "R")))
".(1, .(2, .(3, [])))")
(define pl-sp-env-lts2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "list_to_set([], R)" pl-sp-env-lts2)
(pl-mk-trail))
(pl-sp-test!
"list_to_set([],R) -> []"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts2 "R")))
"[]")
(define pl-sp-env-lts3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "list_to_set([a,b,a,c], R)" pl-sp-env-lts3)
(pl-mk-trail))
(pl-sp-test!
"list_to_set([a,b,a,c],R) -> [a,b,c]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-lts3 "R")))
".(a, .(b, .(c, [])))")
;; ── intersection/3 ─────────────────────────────────────────────────
(define pl-sp-env-int1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "intersection([1,2,3,4], [2,4,6], R)" pl-sp-env-int1)
(pl-mk-trail))
(pl-sp-test!
"intersection([1,2,3,4],[2,4,6],R) -> [2,4]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-int1 "R")))
".(2, .(4, []))")
(define pl-sp-env-int2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "intersection([1,2,3], [4,5,6], R)" pl-sp-env-int2)
(pl-mk-trail))
(pl-sp-test!
"intersection([1,2,3],[4,5,6],R) -> []"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-int2 "R")))
"[]")
(define pl-sp-env-int3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "intersection([], [1,2,3], R)" pl-sp-env-int3)
(pl-mk-trail))
(pl-sp-test!
"intersection([],[1,2,3],R) -> []"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-int3 "R")))
"[]")
;; ── subtract/3 ─────────────────────────────────────────────────────
(define pl-sp-env-sub1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "subtract([1,2,3,4], [2,4], R)" pl-sp-env-sub1)
(pl-mk-trail))
(pl-sp-test!
"subtract([1,2,3,4],[2,4],R) -> [1,3]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub1 "R")))
".(1, .(3, []))")
(define pl-sp-env-sub2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "subtract([1,2,3], [], R)" pl-sp-env-sub2)
(pl-mk-trail))
(pl-sp-test!
"subtract([1,2,3],[],R) -> [1,2,3]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub2 "R")))
".(1, .(2, .(3, [])))")
(define pl-sp-env-sub3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "subtract([], [1,2], R)" pl-sp-env-sub3)
(pl-mk-trail))
(pl-sp-test!
"subtract([],[1,2],R) -> []"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-sub3 "R")))
"[]")
;; ── union/3 ────────────────────────────────────────────────────────
(define pl-sp-env-uni1 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "union([1,2,3], [2,3,4], R)" pl-sp-env-uni1)
(pl-mk-trail))
(pl-sp-test!
"union([1,2,3],[2,3,4],R) -> [1,2,3,4]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni1 "R")))
".(1, .(2, .(3, .(4, []))))")
(define pl-sp-env-uni2 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "union([], [1,2], R)" pl-sp-env-uni2)
(pl-mk-trail))
(pl-sp-test!
"union([],[1,2],R) -> [1,2]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni2 "R")))
".(1, .(2, []))")
(define pl-sp-env-uni3 {:R (pl-mk-rt-var "R")})
(pl-solve-once!
pl-sp-db
(pl-sp-goal "union([1,2], [], R)" pl-sp-env-uni3)
(pl-mk-trail))
(pl-sp-test!
"union([1,2],[],R) -> [1,2]"
(pl-format-term (pl-walk-deep (dict-get pl-sp-env-uni3 "R")))
".(1, .(2, []))")
;; ── Runner ─────────────────────────────────────────────────────────
(define pl-set-predicates-tests-run! (fn () {:failed pl-sp-test-fail :passed pl-sp-test-pass :total pl-sp-test-count :failures pl-sp-test-failures}))