2 files changed, 50 insertions(+), 13 deletions(-)

M lib/scheme/base.scm
M spec/lib/char-spec.scm

@@ 24,20 24,12 @@
    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
    case
    cdr
-   char?
-   char=?
-   char<?
-   char<=?
-   char>?
-   char>=?
-   char-ci=?
-   char-ci<?
-   char-ci<=?
-   char-ci>?
-   char-ci>=?
    char->integer
-   char-downcase
-   char-upcase
+   char-alphabetic? char-numeric? char-whitespace?
+   char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>?
+   char-downcase char-upcase
+   char-lower-case? char-upper-case?
+   char<=? char<? char=? char>=? char>? char?
    cond
    cons
    define


@@ 537,6 529,36 @@
     (define (char-ci>=? . chars)
       (apply char>=? (map char-downcase chars)))
 
+    (define (char-upper-case? c)
+      (if (char? c)
+        (let ((i (char->integer c)))
+          (and (>= i 65) (<= i 90)))))
+
+    (define (char-lower-case? c)
+      (if (char? c)
+        (let ((i (char->integer c)))
+          (and (>= i 97) (<= i 122)))))
+
+    (define (char-alphabetic? c)
+      (if (char? c)
+        (let ((i (char->integer c)))
+          (or
+            (and (>= i 65) (<= i 90))
+            (and (>= i 97) (<= i 122))))))
+
+    (define (char-numeric? c)
+      (if (char? c)
+        (let ((i (char->integer c)))
+          (and (>= i 48) (<= i 57)))))
+
+    (define (char-whitespace? c)
+      (if (char? c)
+        (let ((i (char->integer c)))
+          (or
+            (and (>= i 9) (<= i 13))
+            (= i 32)
+            (= i 133)))))
+
     (define (equal? a b)
       (cond
        ((and (boolean? a) (boolean? b)) (eq? a b))

@@ 49,3 49,18 @@
 (assert (char-ci>=? #\b #\A))
 (assert (char-ci>=? #\b #\B))
 (assert (not (char-ci>=? #\a #\B)))
+
+(assert (char-alphabetic? #\a))
+(assert (not (char-alphabetic? #\1)))
+
+(assert (char-numeric? #\1))
+(assert (not (char-numeric? #\a)))
+
+(assert (char-whitespace? #\space))
+(assert (not (char-whitespace? #\a)))
+
+(assert (char-upper-case? #\A))
+(assert (not (char-upper-case? #\a)))
+
+(assert (char-lower-case? #\a))
+(assert (not (char-lower-case? #\A)))