~ chicken-r7rs (master) /scheme.char.scm

 1(module scheme.char (char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
 2		     string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
 3                     char-alphabetic? char-numeric? char-whitespace?
 4                     char-upper-case? char-lower-case?
 5		     char-foldcase string-foldcase
 6                     char-upcase char-downcase
 7		     string-upcase string-downcase
 8		     digit-value)
 9
10(import chicken.base chicken.fixnum chicken.type)
11(import r7rs-support)
12(import
13  (except scheme
14	  char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
15	  string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
16  (prefix
17    (only scheme
18	  char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
19	  string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
20    %))
21
22(import (only srfi-13 string-map string-upcase string-downcase))
23
24(: char-ci=? (char char #!rest char -> boolean))
25(: char-ci<? (char char #!rest char -> boolean))
26(: char-ci>? (char char #!rest char -> boolean))
27(: char-ci<=? (char char #!rest char -> boolean))
28(: char-ci>=? (char char #!rest char -> boolean))
29
30(define-extended-arity-comparator char-ci=? %char-ci=? ##sys#check-char)
31(define-extended-arity-comparator char-ci<? %char-ci<? ##sys#check-char)
32(define-extended-arity-comparator char-ci>? %char-ci>? ##sys#check-char)
33(define-extended-arity-comparator char-ci<=? %char-ci<=? ##sys#check-char)
34(define-extended-arity-comparator char-ci>=? %char-ci>=? ##sys#check-char)
35
36(: string-ci=? (string string #!rest string -> boolean))
37(: string-ci<? (string string #!rest string -> boolean))
38(: string-ci>? (string string #!rest string -> boolean))
39(: string-ci<=? (string string #!rest string -> boolean))
40(: string-ci>=? (string string #!rest string -> boolean))
41
42(define-extended-arity-comparator string-ci=? %string-ci=? ##sys#check-string)
43(define-extended-arity-comparator string-ci<? %string-ci<? ##sys#check-string)
44(define-extended-arity-comparator string-ci>? %string-ci>? ##sys#check-string)
45(define-extended-arity-comparator string-ci<=? %string-ci<=? ##sys#check-string)
46(define-extended-arity-comparator string-ci>=? %string-ci>=? ##sys#check-string)
47
48(: char-foldcase (char -> char))
49(define (char-foldcase c) (char-downcase c))
50
51(: string-foldcase (string -> string))
52(define (string-foldcase s) (string-map char-foldcase s))
53
54(: digit-value (char -> (or fixnum false)))
55(define (digit-value c)
56  (let ((i (char->integer c)))
57    (and (fx>= i 48) (fx<= i 57) (fx- i 48)))))