Meta-call predicates: forall/2, maplist/2, maplist/3, include/3, exclude/3

Adds pl-apply-goal helper for safe call/N goal construction (atom or compound),
five solver helpers (pl-solve-forall!, pl-solve-maplist2!, pl-solve-maplist3!,
pl-solve-include!, pl-solve-exclude!), five cond clauses in pl-solve!, and a
new test suite (15/15 passing). Total conformance: 390/390.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/prolog/conformance.sh

@@ -34,6 +34,7 @@ SUITES=(
   "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!"
   "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!"
 )
 
 SCRIPT='(epoch 1)

lib/prolog/runtime.sx

@@ -1034,6 +1034,141 @@
         (first strs)
         (rest strs)))))
 
+(define
+  pl-apply-goal
+  (fn
+    (goal args)
+    (let
+      ((w (pl-walk-deep goal)))
+      (cond
+        ((pl-atom? w) (list "compound" (pl-atom-name w) args))
+        ((pl-compound? w)
+          (list "compound" (pl-fun w) (append (pl-args w) args)))
+        (else w)))))
+
+(define
+  pl-solve-forall!
+  (fn
+    (db cond-g action-g trail cut-box k)
+    (let
+      ((mark (pl-trail-mark trail)))
+      (let
+        ((found-counterexample (pl-solve! db cond-g trail {:cut false} (fn () (let ((mark2 (pl-trail-mark trail))) (let ((action-ok (pl-solve-once! db action-g trail))) (pl-trail-undo-to! trail mark2) (if action-ok false true)))))))
+        (pl-trail-undo-to! trail mark)
+        (if found-counterexample false (k))))))
+
+(define
+  pl-solve-maplist2!
+  (fn
+    (db goal lst trail k)
+    (let
+      ((l (pl-walk-deep lst)))
+      (cond
+        ((and (pl-atom? l) (= (pl-atom-name l) "[]")) (k))
+        ((and (pl-compound? l) (= (pl-fun l) "."))
+          (let
+            ((head (first (pl-args l))) (tail (nth (pl-args l) 1)))
+            (let
+              ((call-goal (pl-apply-goal goal (list head))))
+              (if
+                (pl-solve-once! db call-goal trail)
+                (pl-solve-maplist2! db goal tail trail k)
+                false))))
+        (else false)))))
+
+(define
+  pl-solve-maplist3!
+  (fn
+    (db goal list1 list2 trail k)
+    (let
+      ((l1 (pl-walk-deep list1)) (l2 (pl-walk-deep list2)))
+      (cond
+        ((and (pl-atom? l1) (= (pl-atom-name l1) "[]"))
+          (let
+            ((nil-atom (list "atom" "[]")))
+            (if (pl-unify! l2 nil-atom trail) (k) false)))
+        ((and (pl-compound? l1) (= (pl-fun l1) "."))
+          (let
+            ((h1 (first (pl-args l1))) (t1 (nth (pl-args l1) 1)))
+            (let
+              ((h2-var (pl-mk-rt-var "_M")))
+              (let
+                ((call-goal (pl-apply-goal goal (list h1 h2-var))))
+                (if
+                  (pl-solve-once! db call-goal trail)
+                  (let
+                    ((t2-var (pl-mk-rt-var "_MT")))
+                    (let
+                      ((cons2 (list "compound" "." (list h2-var t2-var))))
+                      (if
+                        (pl-unify! l2 cons2 trail)
+                        (pl-solve-maplist3! db goal t1 t2-var trail k)
+                        false)))
+                  false)))))
+        (else false)))))
+
+(define
+  pl-solve-include!
+  (fn
+    (db goal lst result trail k)
+    (let
+      ((l (pl-walk-deep lst)))
+      (cond
+        ((and (pl-atom? l) (= (pl-atom-name l) "[]"))
+          (let
+            ((nil-atom (list "atom" "[]")))
+            (if (pl-unify! result nil-atom trail) (k) false)))
+        ((and (pl-compound? l) (= (pl-fun l) "."))
+          (let
+            ((head (first (pl-args l))) (tail (nth (pl-args l) 1)))
+            (let
+              ((call-goal (pl-apply-goal goal (list head))))
+              (let
+                ((included (pl-solve-once! db call-goal trail)))
+                (if
+                  included
+                  (let
+                    ((rest-var (pl-mk-rt-var "_IR")))
+                    (let
+                      ((cons-res (list "compound" "." (list head rest-var))))
+                      (if
+                        (pl-unify! result cons-res trail)
+                        (pl-solve-include! db goal tail rest-var trail k)
+                        false)))
+                  (pl-solve-include! db goal tail result trail k))))))
+        (else false)))))
+
+(define
+  pl-solve-exclude!
+  (fn
+    (db goal lst result trail k)
+    (let
+      ((l (pl-walk-deep lst)))
+      (cond
+        ((and (pl-atom? l) (= (pl-atom-name l) "[]"))
+          (let
+            ((nil-atom (list "atom" "[]")))
+            (if (pl-unify! result nil-atom trail) (k) false)))
+        ((and (pl-compound? l) (= (pl-fun l) "."))
+          (let
+            ((head (first (pl-args l))) (tail (nth (pl-args l) 1)))
+            (let
+              ((call-goal (pl-apply-goal goal (list head))))
+              (let
+                ((excluded (pl-solve-once! db call-goal trail)))
+                (if
+                  excluded
+                  (pl-solve-exclude! db goal tail result trail k)
+                  (let
+                    ((rest-var (pl-mk-rt-var "_ER")))
+                    (let
+                      ((cons-res (list "compound" "." (list head rest-var))))
+                      (if
+                        (pl-unify! result cons-res trail)
+                        (pl-solve-exclude! db goal tail rest-var trail k)
+                        false))))))))
+        (else false)))))
+
 (define
   pl-solve!
   (fn
@@ -1474,22 +1609,16 @@
                         k)))
                   false))
               (true false))))
-
-        ;; ==/2 — structural equality (no binding)
         ((and (pl-compound? g) (= (pl-fun g) "==") (= (len (pl-args g)) 2))
           (let
             ((a (pl-walk-deep (first (pl-args g))))
               (b (pl-walk-deep (nth (pl-args g) 1))))
             (if (pl-struct-eq? a b) (k) false)))
-
-        ;; \==/2 — structural inequality
         ((and (pl-compound? g) (= (pl-fun g) "\\==") (= (len (pl-args g)) 2))
           (let
             ((a (pl-walk-deep (first (pl-args g))))
               (b (pl-walk-deep (nth (pl-args g) 1))))
             (if (pl-struct-eq? a b) false (k))))
-
-        ;; flatten/2
         ((and (pl-compound? g) (= (pl-fun g) "flatten") (= (len (pl-args g)) 2))
           (let
             ((lst-rt (pl-walk (first (pl-args g)))))
@@ -1503,8 +1632,6 @@
                   trail
                   k))
               false)))
-
-        ;; numlist/3
         ((and (pl-compound? g) (= (pl-fun g) "numlist") (= (len (pl-args g)) 3))
           (let
             ((wlo (pl-walk-deep (first (pl-args g))))
@@ -1522,12 +1649,7 @@
                     trail
                     k)))
               false)))
-
+        ((and (pl-compound? g) (= (pl-fun g) "atomic_list_concat") (= (len (pl-args g)) 2))
-        ;; atomic_list_concat/2 — no separator
-        ((and
-            (pl-compound? g)
-            (= (pl-fun g) "atomic_list_concat")
-            (= (len (pl-args g)) 2))
           (let
             ((lst-rt (pl-walk (first (pl-args g)))))
             (if
@@ -1540,12 +1662,7 @@
                   trail
                   k))
               false)))
-
+        ((and (pl-compound? g) (= (pl-fun g) "atomic_list_concat") (= (len (pl-args g)) 3))
-        ;; atomic_list_concat/3 — with separator
-        ((and
-            (pl-compound? g)
-            (= (pl-fun g) "atomic_list_concat")
-            (= (len (pl-args g)) 3))
           (let
             ((lst-rt (pl-walk (first (pl-args g))))
               (sep-rt (pl-walk-deep (nth (pl-args g) 1))))
@@ -1560,8 +1677,6 @@
                   trail
                   k))
               false)))
-
-        ;; sum_list/2
         ((and (pl-compound? g) (= (pl-fun g) "sum_list") (= (len (pl-args g)) 2))
           (let
             ((lst-rt (pl-walk (first (pl-args g)))))
@@ -1573,34 +1688,34 @@
                 trail
                 k)
               false)))
-
-        ;; max_list/2
         ((and (pl-compound? g) (= (pl-fun g) "max_list") (= (len (pl-args g)) 2))
           (let
             ((lst-rt (pl-walk (first (pl-args g)))))
             (if
-              (and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
+              (and
+                (pl-proper-list? lst-rt)
+                (not
+                  (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
               (pl-solve-eq!
                 (nth (pl-args g) 1)
                 (list "num" (pl-max-list-sx lst-rt))
                 trail
                 k)
               false)))
-
-        ;; min_list/2
         ((and (pl-compound? g) (= (pl-fun g) "min_list") (= (len (pl-args g)) 2))
           (let
             ((lst-rt (pl-walk (first (pl-args g)))))
             (if
-              (and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
+              (and
+                (pl-proper-list? lst-rt)
+                (not
+                  (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
               (pl-solve-eq!
                 (nth (pl-args g) 1)
                 (list "num" (pl-min-list-sx lst-rt))
                 trail
                 k)
               false)))
-
-        ;; delete/3
         ((and (pl-compound? g) (= (pl-fun g) "delete") (= (len (pl-args g)) 3))
           (let
             ((lst-rt (pl-walk (first (pl-args g))))
@@ -1615,7 +1730,34 @@
                   trail
                   k))
               false)))
-
+        ((and (pl-compound? g) (= (pl-fun g) "exclude") (= (len (pl-args g)) 3))
+          (let
+            ((exc-goal (pl-walk (first (pl-args g))))
+              (exc-lst (pl-walk (nth (pl-args g) 1)))
+              (exc-res (pl-walk (nth (pl-args g) 2))))
+            (pl-solve-exclude! db exc-goal exc-lst exc-res trail k)))
+        ((and (pl-compound? g) (= (pl-fun g) "include") (= (len (pl-args g)) 3))
+          (let
+            ((inc-goal (pl-walk (first (pl-args g))))
+              (inc-lst (pl-walk (nth (pl-args g) 1)))
+              (inc-res (pl-walk (nth (pl-args g) 2))))
+            (pl-solve-include! db inc-goal inc-lst inc-res trail k)))
+        ((and (pl-compound? g) (= (pl-fun g) "maplist") (= (len (pl-args g)) 3))
+          (let
+            ((ml-goal (pl-walk (first (pl-args g))))
+              (ml-l1 (pl-walk (nth (pl-args g) 1)))
+              (ml-l2 (pl-walk (nth (pl-args g) 2))))
+            (pl-solve-maplist3! db ml-goal ml-l1 ml-l2 trail k)))
+        ((and (pl-compound? g) (= (pl-fun g) "maplist") (= (len (pl-args g)) 2))
+          (let
+            ((ml-goal (pl-walk (first (pl-args g))))
+              (ml-lst (pl-walk (nth (pl-args g) 1))))
+            (pl-solve-maplist2! db ml-goal ml-lst trail k)))
+        ((and (pl-compound? g) (= (pl-fun g) "forall") (= (len (pl-args g)) 2))
+          (let
+            ((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)))
         (true (pl-solve-user! db g trail cut-box k))))))
 
 (define

lib/prolog/scoreboard.json

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

lib/prolog/scoreboard.md

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

lib/prolog/tests/meta_call.sx

@@ -0,0 +1,197 @@
+;; lib/prolog/tests/meta_call.sx — forall/2, maplist/2, maplist/3, include/3, exclude/3
+(define pl-mc-test-count 0)
+(define pl-mc-test-pass 0)
+(define pl-mc-test-fail 0)
+(define pl-mc-test-failures (list))
+
+(define
+  pl-mc-test!
+  (fn
+    (name got expected)
+    (begin
+      (set! pl-mc-test-count (+ pl-mc-test-count 1))
+      (if
+        (= got expected)
+        (set! pl-mc-test-pass (+ pl-mc-test-pass 1))
+        (begin
+          (set! pl-mc-test-fail (+ pl-mc-test-fail 1))
+          (append!
+            pl-mc-test-failures
+            (str name "\n    expected: " expected "\n    got:      " got)))))))
+
+(define
+  pl-mc-goal
+  (fn
+    (src env)
+    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
+
+(define
+  pl-mc-term-to-sx
+  (fn
+    (t)
+    (cond
+      ((pl-num? t) (pl-num-val t))
+      ((pl-atom? t) (pl-atom-name t))
+      (else t))))
+
+(define
+  pl-mc-list-sx
+  (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) "."))
+          (cons
+            (pl-mc-term-to-sx (first (pl-args w)))
+            (pl-mc-list-sx (nth (pl-args w) 1))))
+        (else (list :not-list))))))
+
+(define pl-mc-db (pl-mk-db))
+
+(pl-db-load!
+  pl-mc-db
+  (pl-parse "member(X, [X|_]). member(X, [_|T]) :- member(X, T)."))
+
+(pl-db-load! pl-mc-db (pl-parse "double(X, Y) :- Y is X * 2."))
+
+(pl-db-load! pl-mc-db (pl-parse "even(X) :- 0 is X mod 2."))
+
+;; -- forall/2 --
+
+(pl-mc-test!
+  "forall(member(X,[2,4,6]), 0 is X mod 2) — all even"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "forall(member(X,[2,4,6]), 0 is X mod 2)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-mc-test!
+  "forall(member(X,[2,3,6]), 0 is X mod 2) — 3 is odd, fails"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "forall(member(X,[2,3,6]), 0 is X mod 2)" {})
+    (pl-mk-trail))
+  false)
+
+(pl-mc-test!
+  "forall(member(_,[]), true) — vacuously true"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "forall(member(_,[]), true)" {})
+    (pl-mk-trail))
+  true)
+
+;; -- maplist/2 --
+
+(pl-mc-test!
+  "maplist(atom, [a,b,c]) — all atoms"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "maplist(atom, [a,b,c])" {})
+    (pl-mk-trail))
+  true)
+
+(pl-mc-test!
+  "maplist(atom, [a,1,c]) — 1 is not atom, fails"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "maplist(atom, [a,1,c])" {})
+    (pl-mk-trail))
+  false)
+
+(pl-mc-test!
+  "maplist(atom, []) — vacuously true"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "maplist(atom, [])" {})
+    (pl-mk-trail))
+  true)
+
+;; -- maplist/3 --
+
+(pl-mc-test!
+  "maplist(double, [1,2,3], [2,4,6]) — deterministic check"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "maplist(double, [1,2,3], [2,4,6])" {})
+    (pl-mk-trail))
+  true)
+
+(pl-mc-test!
+  "maplist(double, [1,2,3], [2,4,7]) — wrong result fails"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "maplist(double, [1,2,3], [2,4,7])" {})
+    (pl-mk-trail))
+  false)
+
+(define pl-mc-env-ml3 {:L (pl-mk-rt-var "L")})
+(pl-solve-once!
+  pl-mc-db
+  (pl-mc-goal "maplist(double, [1,2,3], L)" pl-mc-env-ml3)
+  (pl-mk-trail))
+(pl-mc-test!
+  "maplist(double, [1,2,3], L) — L bound to [2,4,6]"
+  (pl-mc-list-sx (dict-get pl-mc-env-ml3 "L"))
+  (list 2 4 6))
+
+;; -- include/3 --
+
+(pl-mc-test!
+  "include(even, [1,2,3,4,5,6], [2,4,6])"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "include(even, [1,2,3,4,5,6], [2,4,6])" {})
+    (pl-mk-trail))
+  true)
+
+(pl-mc-test!
+  "include(even, [], [])"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "include(even, [], [])" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-mc-env-inc {:R (pl-mk-rt-var "R")})
+(pl-solve-once!
+  pl-mc-db
+  (pl-mc-goal "include(even, [1,2,3,4,5,6], R)" pl-mc-env-inc)
+  (pl-mk-trail))
+(pl-mc-test!
+  "include(even, [1,2,3,4,5,6], R) — R bound to [2,4,6]"
+  (pl-mc-list-sx (dict-get pl-mc-env-inc "R"))
+  (list 2 4 6))
+
+;; -- exclude/3 --
+
+(pl-mc-test!
+  "exclude(even, [1,2,3,4,5,6], [1,3,5])"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "exclude(even, [1,2,3,4,5,6], [1,3,5])" {})
+    (pl-mk-trail))
+  true)
+
+(pl-mc-test!
+  "exclude(even, [], [])"
+  (pl-solve-once!
+    pl-mc-db
+    (pl-mc-goal "exclude(even, [], [])" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-mc-env-exc {:R (pl-mk-rt-var "R")})
+(pl-solve-once!
+  pl-mc-db
+  (pl-mc-goal "exclude(even, [1,2,3,4,5,6], R)" pl-mc-env-exc)
+  (pl-mk-trail))
+(pl-mc-test!
+  "exclude(even, [1,2,3,4,5,6], R) — R bound to [1,3,5]"
+  (pl-mc-list-sx (dict-get pl-mc-env-exc "R"))
+  (list 1 3 5))
+
+(define pl-meta-call-tests-run! (fn () {:failed pl-mc-test-fail :passed pl-mc-test-pass :total pl-mc-test-count :failures pl-mc-test-failures}))