~ chicken-r7rs (master) 512aecce2618e5c64db80dbcc5ca3c46359b6cf8

commit 512aecce2618e5c64db80dbcc5ca3c46359b6cf8
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Thu Oct 24 22:11:56 2013 +0000
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu Oct 24 22:11:56 2013 +0000

    Stub scheme.char, add char-ci*? & string-ci*? comparators

diff --git a/r7rs.setup b/r7rs.setup
index b152b3d..a8926c3 100644
--- a/r7rs.setup
+++ b/r7rs.setup
@@ -4,7 +4,7 @@
 (use make srfi-1)
 
 (define scheme-modules
-  '("process-context" "eval" "cxr" "complex" "inexact" "load" "file" "read"))	;XXX
+  '("process-context" "eval" "cxr" "complex" "inexact" "load" "file" "read" "char"))	;XXX
 
 (make (("r7rs-compile-time.so" ("r7rs-compile-time.scm" "r7rs-compile-time-module.scm")
 	(compile -s -O3 -d1 r7rs-compile-time-module.scm -J -o r7rs-compile-time.so)
diff --git a/scheme.char.scm b/scheme.char.scm
new file mode 100644
index 0000000..3c1db5d
--- /dev/null
+++ b/scheme.char.scm
@@ -0,0 +1,52 @@
+(module scheme.char (char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
+		     string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
+
+(import
+  (except scheme
+	  char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
+	  string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
+  (prefix
+    (only scheme
+	  char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
+	  string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
+    %))
+
+(import chicken)
+
+;; Copy-pasta from scheme.base.scm.
+(define-syntax define-extended-arity-comparator
+  (syntax-rules ()
+    ((_ name comparator check-type)
+     (define name
+       (let ((c comparator))
+         (lambda (o1 o2 . os)
+           (check-type o1 'name)
+           (let lp ((o1 o1) (o2 o2) (os os) (eq #t))
+             (check-type o2 'name)
+             (if (null? os)
+                 (and eq (c o1 o2))
+                 (lp o2 (car os) (cdr os) (and eq (c o1 o2)))))))))))
+
+(: char-ci=? (char char #!rest char -> boolean))
+(: char-ci<? (char char #!rest char -> boolean))
+(: char-ci>? (char char #!rest char -> boolean))
+(: char-ci<=? (char char #!rest char -> boolean))
+(: char-ci>=? (char char #!rest char -> boolean))
+
+(define-extended-arity-comparator char-ci=? %char-ci=? ##sys#check-char)
+(define-extended-arity-comparator char-ci<? %char-ci<? ##sys#check-char)
+(define-extended-arity-comparator char-ci>? %char-ci>? ##sys#check-char)
+(define-extended-arity-comparator char-ci<=? %char-ci<=? ##sys#check-char)
+(define-extended-arity-comparator char-ci>=? %char-ci>=? ##sys#check-char)
+
+(: string-ci=? (string string #!rest string -> boolean))
+(: string-ci<? (string string #!rest string -> boolean))
+(: string-ci>? (string string #!rest string -> boolean))
+(: string-ci<=? (string string #!rest string -> boolean))
+(: string-ci>=? (string string #!rest string -> boolean))
+
+(define-extended-arity-comparator string-ci=? %string-ci=? ##sys#check-string)
+(define-extended-arity-comparator string-ci<? %string-ci<? ##sys#check-string)
+(define-extended-arity-comparator string-ci>? %string-ci>? ##sys#check-string)
+(define-extended-arity-comparator string-ci<=? %string-ci<=? ##sys#check-string)
+(define-extended-arity-comparator string-ci>=? %string-ci>=? ##sys#check-string))