Ticket #1853: utf8.scm.diff

utf8.scm

@@ -215 +115 @@
   ;; R5RS
   string-length string-ref string-set! make-string string substring
   string->list list->string string-fill! write-char read-char display
+  char-alphabetic? char-whitespace? char-upper-case? char-lower-case?
   ;; library
   reverse-list->string print print*
   ;; extras
@@ -237 +138 @@
 
 (import (rename (except scheme
                         string string->list list->string string-fill!
-                        string-ref string-set! write-char read-char)
+                        string-ref string-set! write-char read-char
+                        char-alphabetic? char-whitespace?
+                        char-upper-case? char-lower-case?
+                        char-numeric?)
                 (make-string make-byte-string)
                 (substring byte-substring)
                 (string-length byte-string-length)
@@ -266 +170 @@
                 (string-split-fields byte-string-split-fields))
         (rename utf8-lolevel
                 (utf8-string? valid-string?))
+        (only utf8-srfi-14 char-set-contains?)
+        (unicode-char-sets alphabetic)
+        (unicode-char-sets white-space)
+        (unicode-char-sets uppercase)
+        (unicode-char-sets lowercase)
+        (unicode-char-sets numeric)
         (chicken port))
 
 
@@ -344 +254 @@
     (string-set-at-byte s size byte c-len val)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Character predicates
+
+(define-syntax define-char-predicate
+  (syntax-rules ()
+    ((define-char-predicate proc-name char-set)
+     (define (proc-name char)
+       (unless (char? char)
+         (error 'proc-name "invalid argument" char? char))
+       (char-set-contains? char-set char)))))
+
+(define-char-predicate char-alphabetic? char-set:alphabetic)
+(define-char-predicate char-whitespace? char-set:white-space)
+(define-char-predicate char-upper-case? char-set:uppercase)
+(define-char-predicate char-lower-case? char-set:lowercase)
+(define-char-predicate char-numeric? char-set:numeric)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Basic I/O
 
 (define write-char write-utf8-char)