Char predicates: char_type/2, upcase_atom/2, downcase_atom/2, string_upper/2, string_lower/2

27 new tests, 432/432 total. char_type/2 supports alpha, alnum, digit,
digit(Weight), space/white, upper(Lower), lower(Upper), ascii(Code), punct.

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

lib/prolog/conformance.sh

@@ -36,6 +36,7 @@ SUITES=(
   "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!"
+  "char_predicates:lib/prolog/tests/char_predicates.sx:pl-char-predicates-tests-run!"
 )
 
 SCRIPT='(epoch 1)

lib/prolog/runtime.sx

@@ -1213,6 +1213,152 @@
       ((sx-lst (pl-prolog-list-to-sx (pl-walk-deep pl-lst))))
       (some (fn (x) (pl-struct-eq? elem x)) sx-lst))))
 
+(define pl-char-code (fn (atom-term) (char-code (pl-atom-name atom-term))))
+
+(define
+  pl-char-alpha?
+  (fn
+    (code)
+    (or (and (>= code 65) (<= code 90)) (and (>= code 97) (<= code 122)))))
+
+(define pl-char-digit? (fn (code) (and (>= code 48) (<= code 57))))
+
+(define
+  pl-char-space?
+  (fn (code) (or (= code 32) (= code 9) (= code 10) (= code 13))))
+
+(define pl-char-upper? (fn (code) (and (>= code 65) (<= code 90))))
+
+(define pl-char-lower? (fn (code) (and (>= code 97) (<= code 122))))
+
+(define
+  pl-upcase-char
+  (fn
+    (c)
+    (let
+      ((code (char-code c)))
+      (if (pl-char-lower? code) (char-from-code (- code 32)) c))))
+
+(define
+  pl-downcase-char
+  (fn
+    (c)
+    (let
+      ((code (char-code c)))
+      (if (pl-char-upper? code) (char-from-code (+ code 32)) c))))
+
+(define
+  pl-upcase-string
+  (fn (s) (join "" (map pl-upcase-char (split s "")))))
+
+(define
+  pl-downcase-string
+  (fn (s) (join "" (map pl-downcase-char (split s "")))))
+
+(define
+  pl-solve-char-type!
+  (fn
+    (db char type-term trail k)
+    (let
+      ((ch (pl-walk-deep char)) (tp (pl-walk-deep type-term)))
+      (if
+        (not (pl-atom? ch))
+        false
+        (let
+          ((code (pl-char-code ch)))
+          (cond
+            ((and (pl-atom? tp) (= (pl-atom-name tp) "alpha"))
+              (if (pl-char-alpha? code) (k) false))
+            ((and (pl-atom? tp) (= (pl-atom-name tp) "alnum"))
+              (if
+                (or (pl-char-alpha? code) (pl-char-digit? code))
+                (k)
+                false))
+            ((and (pl-atom? tp) (= (pl-atom-name tp) "digit"))
+              (if (pl-char-digit? code) (k) false))
+            ((and (pl-compound? tp) (= (pl-fun tp) "digit") (= (len (pl-args tp)) 1))
+              (if
+                (pl-char-digit? code)
+                (let
+                  ((weight (list "num" (- code 48))))
+                  (if
+                    (pl-unify! (nth (pl-args tp) 0) weight trail)
+                    (k)
+                    false))
+                false))
+            ((and (pl-atom? tp) (or (= (pl-atom-name tp) "space") (= (pl-atom-name tp) "white")))
+              (if (pl-char-space? code) (k) false))
+            ((and (pl-compound? tp) (= (pl-fun tp) "upper") (= (len (pl-args tp)) 1))
+              (if
+                (pl-char-upper? code)
+                (let
+                  ((lower-atom (list "atom" (char-from-code (+ code 32)))))
+                  (if
+                    (pl-unify! (nth (pl-args tp) 0) lower-atom trail)
+                    (k)
+                    false))
+                false))
+            ((and (pl-compound? tp) (= (pl-fun tp) "lower") (= (len (pl-args tp)) 1))
+              (if
+                (pl-char-lower? code)
+                (let
+                  ((upper-atom (list "atom" (char-from-code (- code 32)))))
+                  (if
+                    (pl-unify! (nth (pl-args tp) 0) upper-atom trail)
+                    (k)
+                    false))
+                false))
+            ((and (pl-compound? tp) (= (pl-fun tp) "ascii") (= (len (pl-args tp)) 1))
+              (if
+                (< code 128)
+                (let
+                  ((code-term (list "num" code)))
+                  (if
+                    (pl-unify! (nth (pl-args tp) 0) code-term trail)
+                    (k)
+                    false))
+                false))
+            ((and (pl-atom? tp) (= (pl-atom-name tp) "punct"))
+              (if
+                (and
+                  (not (pl-char-alpha? code))
+                  (not (pl-char-digit? code))
+                  (not (pl-char-space? code))
+                  (< code 128))
+                (k)
+                false))
+            (else false)))))))
+
+(define
+  pl-solve-upcase-atom!
+  (fn
+    (atom-rt result-rt trail k)
+    (let
+      ((a (pl-walk atom-rt)))
+      (if
+        (pl-atom? a)
+        (pl-solve-eq!
+          result-rt
+          (list "atom" (pl-upcase-string (pl-atom-name a)))
+          trail
+          k)
+        false))))
+
+(define
+  pl-solve-downcase-atom!
+  (fn
+    (atom-rt result-rt trail k)
+    (let
+      ((a (pl-walk atom-rt)))
+      (if
+        (pl-atom? a)
+        (pl-solve-eq!
+          result-rt
+          (list "atom" (pl-downcase-string (pl-atom-name a)))
+          trail
+          k)
+        false))))
+
 (define
   pl-solve!
   (fn
@@ -1880,6 +2026,37 @@
                       trail
                       k))))
               false)))
+        ((and (pl-compound? g) (= (pl-fun g) "char_type") (= (len (pl-args g)) 2))
+          (pl-solve-char-type!
+            db
+            (pl-walk (nth (pl-args g) 0))
+            (pl-walk (nth (pl-args g) 1))
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "upcase_atom") (= (len (pl-args g)) 2))
+          (pl-solve-upcase-atom!
+            (nth (pl-args g) 0)
+            (nth (pl-args g) 1)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "downcase_atom") (= (len (pl-args g)) 2))
+          (pl-solve-downcase-atom!
+            (nth (pl-args g) 0)
+            (nth (pl-args g) 1)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "string_upper") (= (len (pl-args g)) 2))
+          (pl-solve-upcase-atom!
+            (nth (pl-args g) 0)
+            (nth (pl-args g) 1)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "string_lower") (= (len (pl-args g)) 2))
+          (pl-solve-downcase-atom!
+            (nth (pl-args g) 0)
+            (nth (pl-args g) 1)
+            trail
+            k))
         (true (pl-solve-user! db g trail cut-box k))))))
 
 (define

lib/prolog/scoreboard.json

@@ -1,7 +1,7 @@
 {
-  "total_passed": 405,
+  "total_passed": 432,
   "total_failed": 0,
-  "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"
+  "total": 432,
+  "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}},
+  "generated": "2026-04-25T12:40:55+00:00"
 }

lib/prolog/scoreboard.md

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

lib/prolog/tests/char_predicates.sx

@@ -0,0 +1,290 @@
+;; lib/prolog/tests/char_predicates.sx — char_type/2, upcase_atom/2, downcase_atom/2,
+;;   string_upper/2, string_lower/2
+
+(define pl-cp-test-count 0)
+(define pl-cp-test-pass 0)
+(define pl-cp-test-fail 0)
+(define pl-cp-test-failures (list))
+
+(define
+  pl-cp-test!
+  (fn
+    (name got expected)
+    (begin
+      (set! pl-cp-test-count (+ pl-cp-test-count 1))
+      (if
+        (= got expected)
+        (set! pl-cp-test-pass (+ pl-cp-test-pass 1))
+        (begin
+          (set! pl-cp-test-fail (+ pl-cp-test-fail 1))
+          (append!
+            pl-cp-test-failures
+            (str name "\n    expected: " expected "\n    got:      " got)))))))
+
+(define
+  pl-cp-goal
+  (fn
+    (src env)
+    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
+
+(define pl-cp-db (pl-mk-db))
+
+;; ─── char_type/2 — alpha ──────────────────────────────────────────
+
+(pl-cp-test!
+  "char_type(a, alpha) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, alpha)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type('1', alpha) fails"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type('1', alpha)" {})
+    (pl-mk-trail))
+  false)
+
+(pl-cp-test!
+  "char_type('A', alpha) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type('A', alpha)" {})
+    (pl-mk-trail))
+  true)
+
+;; ─── char_type/2 — alnum ─────────────────────────────────────────
+
+(pl-cp-test!
+  "char_type('5', alnum) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type('5', alnum)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type(a, alnum) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, alnum)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type(' ', alnum) fails"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(' ', alnum)" {})
+    (pl-mk-trail))
+  false)
+
+;; ─── char_type/2 — digit ─────────────────────────────────────────
+
+(pl-cp-test!
+  "char_type('5', digit) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type('5', digit)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type(a, digit) fails"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, digit)" {})
+    (pl-mk-trail))
+  false)
+
+;; ─── char_type/2 — digit(Weight) ─────────────────────────────────
+
+(define pl-cp-env-dw {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "char_type('5', digit(N))" pl-cp-env-dw)
+  (pl-mk-trail))
+(pl-cp-test!
+  "char_type('5', digit(N)) -> N=5"
+  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw "N")))
+  5)
+
+(define pl-cp-env-dw0 {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "char_type('0', digit(N))" pl-cp-env-dw0)
+  (pl-mk-trail))
+(pl-cp-test!
+  "char_type('0', digit(N)) -> N=0"
+  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw0 "N")))
+  0)
+
+;; ─── char_type/2 — space/white ───────────────────────────────────
+
+(pl-cp-test!
+  "char_type(' ', space) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(' ', space)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type(a, space) fails"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, space)" {})
+    (pl-mk-trail))
+  false)
+
+;; ─── char_type/2 — upper(Lower) ──────────────────────────────────
+
+(define pl-cp-env-ul {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "char_type('A', upper(L))" pl-cp-env-ul)
+  (pl-mk-trail))
+(pl-cp-test!
+  "char_type('A', upper(L)) -> L=a"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ul "L")))
+  "a")
+
+(pl-cp-test!
+  "char_type(a, upper(L)) fails — not uppercase"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, upper(_))" {})
+    (pl-mk-trail))
+  false)
+
+;; ─── char_type/2 — lower(Upper) ──────────────────────────────────
+
+(define pl-cp-env-lu {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "char_type(a, lower(U))" pl-cp-env-lu)
+  (pl-mk-trail))
+(pl-cp-test!
+  "char_type(a, lower(U)) -> U='A'"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-lu "U")))
+  "A")
+
+;; ─── char_type/2 — ascii(Code) ───────────────────────────────────
+
+(define pl-cp-env-as {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "char_type(a, ascii(C))" pl-cp-env-as)
+  (pl-mk-trail))
+(pl-cp-test!
+  "char_type(a, ascii(C)) -> C=97"
+  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-as "C")))
+  97)
+
+;; ─── char_type/2 — punct ─────────────────────────────────────────
+
+(pl-cp-test!
+  "char_type('.', punct) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type('.', punct)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "char_type(a, punct) fails"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "char_type(a, punct)" {})
+    (pl-mk-trail))
+  false)
+
+;; ─── upcase_atom/2 ───────────────────────────────────────────────
+
+(define pl-cp-env-ua {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "upcase_atom(hello, X)" pl-cp-env-ua)
+  (pl-mk-trail))
+(pl-cp-test!
+  "upcase_atom(hello, X) -> X='HELLO'"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ua "X")))
+  "HELLO")
+
+(pl-cp-test!
+  "upcase_atom(hello, 'HELLO') succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "upcase_atom(hello, 'HELLO')" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "upcase_atom('Hello World', 'HELLO WORLD') succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "upcase_atom('Hello World', 'HELLO WORLD')" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "upcase_atom('', '') succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "upcase_atom('', '')" {})
+    (pl-mk-trail))
+  true)
+
+;; ─── downcase_atom/2 ─────────────────────────────────────────────
+
+(define pl-cp-env-da {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "downcase_atom('HELLO', X)" pl-cp-env-da)
+  (pl-mk-trail))
+(pl-cp-test!
+  "downcase_atom('HELLO', X) -> X=hello"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-da "X")))
+  "hello")
+
+(pl-cp-test!
+  "downcase_atom('HELLO', hello) succeeds"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "downcase_atom('HELLO', hello)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-cp-test!
+  "downcase_atom(hello, hello) succeeds — already lowercase"
+  (pl-solve-once!
+    pl-cp-db
+    (pl-cp-goal "downcase_atom(hello, hello)" {})
+    (pl-mk-trail))
+  true)
+
+;; ─── string_upper/2 + string_lower/2 (aliases) ───────────────────
+
+(define pl-cp-env-su {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "string_upper(hello, X)" pl-cp-env-su)
+  (pl-mk-trail))
+(pl-cp-test!
+  "string_upper(hello, X) -> X='HELLO'"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-su "X")))
+  "HELLO")
+
+(define pl-cp-env-sl {})
+(pl-solve-once!
+  pl-cp-db
+  (pl-cp-goal "string_lower('WORLD', X)" pl-cp-env-sl)
+  (pl-mk-trail))
+(pl-cp-test!
+  "string_lower('WORLD', X) -> X=world"
+  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-sl "X")))
+  "world")
+
+(define pl-char-predicates-tests-run! (fn () {:failed pl-cp-test-fail :passed pl-cp-test-pass :total pl-cp-test-count :failures pl-cp-test-failures}))