prolog: findall/3 + bagof/3 + setof/3, 11 tests

lib/prolog/conformance.sh

@@ -22,6 +22,7 @@ SUITES=(
   "solve:lib/prolog/tests/solve.sx:pl-solve-tests-run!"
   "operators:lib/prolog/tests/operators.sx:pl-operators-tests-run!"
   "dynamic:lib/prolog/tests/dynamic.sx:pl-dynamic-tests-run!"
+  "findall:lib/prolog/tests/findall.sx:pl-findall-tests-run!"
   "append:lib/prolog/tests/programs/append.sx:pl-append-tests-run!"
   "reverse:lib/prolog/tests/programs/reverse.sx:pl-reverse-tests-run!"
   "member:lib/prolog/tests/programs/member.sx:pl-member-tests-run!"

lib/prolog/runtime.sx

@@ -364,6 +364,112 @@
                 trail
                 k))))))))
 
+(define
+  pl-deep-copy
+  (fn
+    (t var-map)
+    (let
+      ((w (pl-walk t)))
+      (cond
+        ((pl-var? w)
+          (let
+            ((id-key (str (pl-var-id w))))
+            (cond
+              ((dict-has? var-map id-key) (dict-get var-map id-key))
+              (true
+                (let
+                  ((nv (pl-mk-rt-var (dict-get w :name))))
+                  (begin (dict-set! var-map id-key nv) nv))))))
+        ((pl-compound? w)
+          (list
+            "compound"
+            (pl-fun w)
+            (map (fn (a) (pl-deep-copy a var-map)) (pl-args w))))
+        (true w)))))
+
+(define
+  pl-each-into-dict!
+  (fn
+    (terms d)
+    (cond
+      ((empty? terms) nil)
+      (true
+        (begin
+          (dict-set! d (pl-format-term (first terms)) (first terms))
+          (pl-each-into-dict! (rest terms) d))))))
+
+(define
+  pl-sort-uniq-terms
+  (fn
+    (terms)
+    (let
+      ((kv {}))
+      (begin
+        (pl-each-into-dict! terms kv)
+        (let
+          ((sorted-keys (sort (keys kv))))
+          (map (fn (k) (dict-get kv k)) sorted-keys))))))
+
+(define
+  pl-collect-solutions
+  (fn
+    (db template-rt goal-rt trail)
+    (let
+      ((box {:results (list)}) (mark (pl-trail-mark trail)))
+      (begin
+        (pl-solve!
+          db
+          goal-rt
+          trail
+          {:cut false}
+          (fn
+            ()
+            (begin
+              (append!
+                (dict-get box :results)
+                (pl-deep-copy template-rt {}))
+              false)))
+        (pl-trail-undo-to! trail mark)
+        (dict-get box :results)))))
+
+(define
+  pl-solve-findall!
+  (fn
+    (db template-rt goal-rt third-rt trail k)
+    (let
+      ((items (pl-collect-solutions db template-rt goal-rt trail)))
+      (let
+        ((rl (pl-mk-list-term items (pl-nil-term))))
+        (pl-solve-eq! third-rt rl trail k)))))
+
+(define
+  pl-solve-bagof!
+  (fn
+    (db template-rt goal-rt third-rt trail k)
+    (let
+      ((items (pl-collect-solutions db template-rt goal-rt trail)))
+      (cond
+        ((empty? items) false)
+        (true
+          (let
+            ((rl (pl-mk-list-term items (pl-nil-term))))
+            (pl-solve-eq! third-rt rl trail k)))))))
+
+(define
+  pl-solve-setof!
+  (fn
+    (db template-rt goal-rt third-rt trail k)
+    (let
+      ((items (pl-collect-solutions db template-rt goal-rt trail)))
+      (cond
+        ((empty? items) false)
+        (true
+          (let
+            ((sorted (pl-sort-uniq-terms items)))
+            (let
+              ((rl (pl-mk-list-term sorted (pl-nil-term))))
+              (pl-solve-eq! third-rt rl trail k))))))))
+
 (define
   pl-retract-try-each
   (fn
@@ -492,6 +598,30 @@
           (pl-solve-asserta! db (first (pl-args g)) k))
         ((and (pl-compound? g) (= (pl-fun g) "retract") (= (len (pl-args g)) 1))
           (pl-solve-retract! db (first (pl-args g)) trail k))
+        ((and (pl-compound? g) (= (pl-fun g) "findall") (= (len (pl-args g)) 3))
+          (pl-solve-findall!
+            db
+            (first (pl-args g))
+            (nth (pl-args g) 1)
+            (nth (pl-args g) 2)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "bagof") (= (len (pl-args g)) 3))
+          (pl-solve-bagof!
+            db
+            (first (pl-args g))
+            (nth (pl-args g) 1)
+            (nth (pl-args g) 2)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "setof") (= (len (pl-args g)) 3))
+          (pl-solve-setof!
+            db
+            (first (pl-args g))
+            (nth (pl-args g) 1)
+            (nth (pl-args g) 2)
+            trail
+            k))
         (true (pl-solve-user! db g trail cut-box k))))))
 
 (define

lib/prolog/scoreboard.json

@@ -1,7 +1,7 @@
 {
-  "total_passed": 213,
+  "total_passed": 224,
   "total_failed": 0,
-  "total": 213,
-  "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},"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-25T07:31:46+00:00"
+  "total": 224,
+  "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},"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:06:14+00:00"
 }

lib/prolog/scoreboard.md

@@ -1,7 +1,7 @@
 # Prolog scoreboard
 
-**213 / 213 passing** (0 failure(s)).
-Generated 2026-04-25T07:31:46+00:00.
+**224 / 224 passing** (0 failure(s)).
+Generated 2026-04-25T08:06:14+00:00.
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
@@ -11,6 +11,7 @@ Generated 2026-04-25T07:31:46+00:00.
 | solve | 62 | 62 | ok |
 | operators | 19 | 19 | ok |
 | dynamic | 11 | 11 | ok |
+| findall | 11 | 11 | ok |
 | append | 6 | 6 | ok |
 | reverse | 6 | 6 | ok |
 | member | 7 | 7 | ok |

lib/prolog/tests/findall.sx

@@ -0,0 +1,167 @@
+;; lib/prolog/tests/findall.sx — findall/3, bagof/3, setof/3.
+
+(define pl-fb-test-count 0)
+(define pl-fb-test-pass 0)
+(define pl-fb-test-fail 0)
+(define pl-fb-test-failures (list))
+
+(define
+  pl-fb-test!
+  (fn
+    (name got expected)
+    (begin
+      (set! pl-fb-test-count (+ pl-fb-test-count 1))
+      (if
+        (= got expected)
+        (set! pl-fb-test-pass (+ pl-fb-test-pass 1))
+        (begin
+          (set! pl-fb-test-fail (+ pl-fb-test-fail 1))
+          (append!
+            pl-fb-test-failures
+            (str name "\n    expected: " expected "\n    got:      " got)))))))
+
+(define
+  pl-fb-term-to-sx
+  (fn
+    (t)
+    (cond
+      ((pl-num? t) (pl-num-val t))
+      ((pl-atom? t) (pl-atom-name t))
+      (true (list :complex)))))
+
+(define
+  pl-fb-list-walked
+  (fn
+    (w)
+    (cond
+      ((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list))
+      ((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
+        (cons
+          (pl-fb-term-to-sx (first (pl-args w)))
+          (pl-fb-list-walked (nth (pl-args w) 1))))
+      (true (list :not-list)))))
+
+(define pl-fb-list-to-sx (fn (t) (pl-fb-list-walked (pl-walk-deep t))))
+
+(define
+  pl-fb-goal
+  (fn
+    (src env)
+    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
+
+(define pl-fb-prog-src "member(X, [X|_]). member(X, [_|T]) :- member(X, T).")
+
+(define pl-fb-db (pl-mk-db))
+(pl-db-load! pl-fb-db (pl-parse pl-fb-prog-src))
+
+;; ── findall ──
+
+(define pl-fb-env-1 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "findall(X, member(X, [a, b, c]), L)" pl-fb-env-1)
+  (pl-mk-trail))
+(pl-fb-test!
+  "findall member [a, b, c]"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-1 "L"))
+  (list "a" "b" "c"))
+
+(define pl-fb-env-2 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "findall(X, (member(X, [1, 2, 3]), X >= 2), L)" pl-fb-env-2)
+  (pl-mk-trail))
+(pl-fb-test!
+  "findall with comparison filter"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-2 "L"))
+  (list 2 3))
+
+(define pl-fb-env-3 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "findall(X, fail, L)" pl-fb-env-3)
+  (pl-mk-trail))
+(pl-fb-test!
+  "findall on fail succeeds with empty list"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-3 "L"))
+  (list))
+
+(pl-fb-test!
+  "findall(X, fail, L) the goal succeeds"
+  (pl-solve-once!
+    pl-fb-db
+    (pl-fb-goal "findall(X, fail, L)" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-fb-env-4 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal
+    "findall(p(X, Y), (member(X, [1, 2]), member(Y, [a, b])), L)"
+    pl-fb-env-4)
+  (pl-mk-trail))
+(pl-fb-test!
+  "findall over compound template — count = 4"
+  (len (pl-fb-list-to-sx (dict-get pl-fb-env-4 "L")))
+  4)
+
+;; ── bagof ──
+
+(pl-fb-test!
+  "bagof succeeds when results exist"
+  (pl-solve-once!
+    pl-fb-db
+    (pl-fb-goal "bagof(X, member(X, [1, 2, 3]), L)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-fb-test!
+  "bagof fails on empty"
+  (pl-solve-once!
+    pl-fb-db
+    (pl-fb-goal "bagof(X, fail, L)" {})
+    (pl-mk-trail))
+  false)
+
+(define pl-fb-env-5 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "bagof(X, member(X, [c, a, b]), L)" pl-fb-env-5)
+  (pl-mk-trail))
+(pl-fb-test!
+  "bagof preserves order"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-5 "L"))
+  (list "c" "a" "b"))
+
+;; ── setof ──
+
+(define pl-fb-env-6 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "setof(X, member(X, [c, a, b, a, c]), L)" pl-fb-env-6)
+  (pl-mk-trail))
+(pl-fb-test!
+  "setof sorts + dedupes atoms"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-6 "L"))
+  (list "a" "b" "c"))
+
+(pl-fb-test!
+  "setof fails on empty"
+  (pl-solve-once!
+    pl-fb-db
+    (pl-fb-goal "setof(X, fail, L)" {})
+    (pl-mk-trail))
+  false)
+
+(define pl-fb-env-7 {})
+(pl-solve-once!
+  pl-fb-db
+  (pl-fb-goal "setof(X, member(X, [3, 1, 2, 1, 3]), L)" pl-fb-env-7)
+  (pl-mk-trail))
+(pl-fb-test!
+  "setof sorts + dedupes nums"
+  (pl-fb-list-to-sx (dict-get pl-fb-env-7 "L"))
+  (list 1 2 3))
+
+(define pl-findall-tests-run! (fn () {:failed pl-fb-test-fail :passed pl-fb-test-pass :total pl-fb-test-count :failures pl-fb-test-failures}))