mes: Add char-downcase, char-upcase.
[mes.git] / mes / module / srfi / srfi-14.mes
index a16d16ce57525fe905fa3072075250df598c76cb..2e925ec58a7563a0d51efe1807f758e6f055892c 100644 (file)
        (equal? a b)))
 
 (define char-set:whitespace (char-set #\tab #\page #\return #\vtab #\newline #\space))
+(define char-set:digit (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\0))) (iota 10)))))
+
+(define char-set:lower-case (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\a))) (iota 26)))))
+
+(define char-set:upper-case (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\A))) (iota 26)))))
 
 (define (list->char-set lst)
   (apply char-set lst))
   (set-cdr! (last-pair base) (string->list x))
   base)
 
+(define (char-set-adjoin cs . chars)
+  (append cs chars))
+
 (define (char-set-contains? cs x)
   (and (memq x cs) #t))
 
+(define (char-set-complement cs)
+  (let ((ascii (map integer->char (iota 128))))
+    (list->char-set (filter (lambda (c) (not (char-set-contains? cs c))) ascii))))
+
 (define (char-whitespace? c)
   (char-set-contains? char-set:whitespace c))
 
 (define (char-set-copy cs)
   (map identity cs))
+
+(define (char-upcase c)
+  (if (char-set-contains? char-set:lower-case c) (integer->char (- (char->integer c)
+                                                                   (- (char->integer #\a)
+                                                                      (char->integer #\A))))
+      c))
+
+(define (char-downcase c)
+  (if (char-set-contains? char-set:upper-case c) (integer->char (+ (char->integer c)
+                                                                   (- (char->integer #\a)
+                                                                      (char->integer #\A))))
+      c))