From e701c63762ef9497cfcd5255d568787f3004758f Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Wed, 26 Dec 2012 23:58:08 +0900
Subject: [PATCH] =?UTF-8?q?string[-ci]<>=3D=3F=20are=20also=20n-ary?=

---
 lib/init-7.scm           | 26 ++++++++++++++++----------
 lib/scheme/char/full.scm | 17 ++++++++++++-----
 tests/r7rs-tests.scm     | 12 ++++++------
 3 files changed, 34 insertions(+), 21 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index 311f46e7..5dca6575 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -419,17 +419,23 @@
 (define (string . args) (list->string args))
 (define (string-append . args) (string-concatenate args))
 
-(define (string=? s1 s2) (eq? (string-cmp s1 s2 #f) 0))
-(define (string<? s1 s2) (< (string-cmp s1 s2 #f) 0))
-(define (string<=? s1 s2) (<= (string-cmp s1 s2 #f) 0))
-(define (string>? s1 s2) (> (string-cmp s1 s2 #f) 0))
-(define (string>=? s1 s2) (>= (string-cmp s1 s2 #f) 0))
+(define (string-cmp-ls op ci? s ls)
+  (if (null? ls)
+      #t
+      (and (op (string-cmp s (car ls) ci?) 0)
+           (string-cmp-ls op ci? (car ls) (cdr ls)))))
 
-(define (string-ci=? s1 s2) (eq? (string-cmp s1 s2 #t) 0))
-(define (string-ci<? s1 s2) (< (string-cmp s1 s2 #t) 0))
-(define (string-ci<=? s1 s2) (<= (string-cmp s1 s2 #t) 0))
-(define (string-ci>? s1 s2) (> (string-cmp s1 s2 #t) 0))
-(define (string-ci>=? s1 s2) (>= (string-cmp s1 s2 #t) 0))
+(define (string=? s . ls) (string-cmp-ls eq? #f s ls))
+(define (string<? s . ls) (string-cmp-ls < #f s ls))
+(define (string>? s . ls) (string-cmp-ls > #f s ls))
+(define (string<=? s . ls) (string-cmp-ls <= #f s ls))
+(define (string>=? s . ls) (string-cmp-ls >= #f s ls))
+
+(define (string-ci=? s . ls) (string-cmp-ls eq? #t s ls))
+(define (string-ci<? s . ls) (string-cmp-ls < #t s ls))
+(define (string-ci>? s . ls) (string-cmp-ls > #t s ls))
+(define (string-ci<=? s . ls) (string-cmp-ls <= #t s ls))
+(define (string-ci>=? s . ls) (string-cmp-ls >= #t s ls))
 
 ;; list utils
 
diff --git a/lib/scheme/char/full.scm b/lib/scheme/char/full.scm
index a748c56b..9a663b37 100644
--- a/lib/scheme/char/full.scm
+++ b/lib/scheme/char/full.scm
@@ -71,8 +71,15 @@
 (define (string-foldcase str)
   (string-map char-foldcase str))
 
-(define (string-ci<=? a b) (string<=? (string-foldcase a) (string-foldcase b)))
-(define (string-ci<? a b) (string<? (string-foldcase a) (string-foldcase b)))
-(define (string-ci=? a b) (string=? (string-foldcase a) (string-foldcase b)))
-(define (string-ci>=? a b) (string>=? (string-foldcase a) (string-foldcase b)))
-(define (string-ci>? a b) (string>? (string-foldcase a) (string-foldcase b)))
+(define (string-cmp-ci op a ls)
+  (let lp ((op op) (a (string-foldcase a)) (ls ls))
+    (if (null? ls)
+        #t
+        (let ((b (string-foldcase (car ls))))
+          (and (op a b) (lp op b (cdr ls)))))))
+
+(define (string-ci=? a . ls) (string-cmp-ci string=? a ls))
+(define (string-ci<? a . ls) (string-cmp-ci string<? a ls))
+(define (string-ci>? a . ls) (string-cmp-ci string>? a ls))
+(define (string-ci<=? a . ls) (string-cmp-ci string<=? a ls))
+(define (string-ci>=? a . ls) (string-cmp-ci string>=? a ls))
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index a2e4282c..e3c29be1 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -980,32 +980,32 @@
 (test "a-c" (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str))
 
 (test #t (string=? "" ""))
-(test #t (string=? "abc" "abc"))
+(test #t (string=? "abc" "abc" "abc"))
 (test #f (string=? "" "abc"))
 (test #f (string=? "abc" "aBc"))
 
 (test #f (string<? "" ""))
 (test #f (string<? "abc" "abc"))
-(test #t (string<? "abc" "abcd"))
+(test #t (string<? "abc" "abcd" "acd"))
 (test #f (string<? "abcd" "abc"))
 (test #t (string<? "abc" "bbc"))
 
 (test #f (string>? "" ""))
 (test #f (string>? "abc" "abc"))
 (test #f (string>? "abc" "abcd"))
-(test #t (string>? "abcd" "abc"))
+(test #t (string>? "acd" "abcd" "abc"))
 (test #f (string>? "abc" "bbc"))
 
 (test #t (string<=? "" ""))
 (test #t (string<=? "abc" "abc"))
-(test #t (string<=? "abc" "abcd"))
+(test #t (string<=? "abc" "abcd" "abcd"))
 (test #f (string<=? "abcd" "abc"))
 (test #t (string<=? "abc" "bbc"))
 
 (test #t (string>=? "" ""))
 (test #t (string>=? "abc" "abc"))
 (test #f (string>=? "abc" "abcd"))
-(test #t (string>=? "abcd" "abc"))
+(test #t (string>=? "abcd" "abcd" "abc"))
 (test #f (string>=? "abc" "bbc"))
 
 (test #t (string-ci=? "" ""))
@@ -1030,7 +1030,7 @@
 (test #f (string-ci>=? "abc" "aBcD"))
 (test #t (string-ci>=? "ABCd" "aBc"))
 
-(test #t (string-ci=? "ΑΒΓ" "αβγ"))
+(test #t (string-ci=? "ΑΒΓ" "αβγ" "αβγ"))
 (test #f (string-ci<? "ΑΒΓ" "αβγ"))
 (test #f (string-ci>? "ΑΒΓ" "αβγ"))
 (test #t (string-ci<=? "ΑΒΓ" "αβγ"))