Update string case-insensitive comparison procedures to built-in

Signed-off-by: yamacir-kit <[email protected]>

README.md

@@ -99,7 +99,7 @@ Procedures for each standard are provided by the following R7RS-style libraries:
 cmake -B build -DCMAKE_BUILD_TYPE=Release
 cd build
 make package
-sudo apt install build/meevax_0.5.22_amd64.deb
+sudo apt install build/meevax_0.5.23_amd64.deb
 ```
 
 or
@@ -131,9 +131,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.22.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.23.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.22_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.23_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

VERSION

@@ -1 +1 @@
-0.5.22
+0.5.23

basis/r4rs.ss

@@ -48,20 +48,7 @@
           (only (meevax number) number? complex? real? rational? integer? exact? inexact? = < > <= >= zero? positive? negative? odd? even? max min + * - / abs quotient remainder modulo gcd lcm numerator denominator floor ceiling truncate round expt exact inexact number->string string->number)
           (only (meevax pair) pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
           (meevax port)
-          (only (meevax string)
-                string?
-                make-string string
-                string-length string-ref string-set!
-                string=? string<? string>? string<=? string>=?
-                ; string-ci=?
-                ; string-ci<?
-                ; string-ci>?
-                ; string-ci<=?
-                ; string-ci>=?
-                string-append
-                string->list list->string
-                string-copy string-fill!
-                )
+          (only (meevax string) string? make-string string string-length string-ref string-set! string=? string<? string>? string<=? string>=? string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=? string-append string->list list->string string-copy string-fill!)
           (only (meevax symbol) symbol? symbol->string string->symbol)
           (meevax vector)
           (prefix (only (meevax environment) load) %)
@@ -337,29 +324,6 @@
            (simplest-rational (- x e)
                               (+ x e)))
 
-         (define (string-map f x . xs) ; R7RS
-           (if (null? xs)
-               (list->string (map f (string->list x)))
-               (list->string (apply map f (map string->list (cons x xs))))))
-
-         (define (string-foldcase s) ; R7RS
-           (string-map char-downcase s))
-
-         (define (string-ci=? . xs)
-           (apply string=? (map string-foldcase xs)))
-
-         (define (string-ci<? . xs)
-           (apply string<? (map string-foldcase xs)))
-
-         (define (string-ci>? . xs)
-           (apply string>? (map string-foldcase xs)))
-
-         (define (string-ci<=? . xs)
-           (apply string<=? (map string-foldcase xs)))
-
-         (define (string-ci>=? . xs)
-           (apply string>=? (map string-foldcase xs)))
-
          (define (for-each f x . xs) ; Chibi-Scheme
            (if (null? xs)
                (letrec ((for-each (lambda (f x)

src/kernel/boot.cpp

@@ -1233,6 +1233,86 @@ inline namespace kernel
         return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
       });
 
+      library.define<predicate>("string-ci=?", [](let const& xs)
+      {
+        auto compare = [](let const& s1, let const& s2)
+        {
+          auto compare = [](auto const& c1, auto const& c2)
+          {
+            return c1.downcase() == c2.downcase();
+          };
+
+          return not std::lexicographical_compare(s1.as<string>().vector.begin(), s1.as<string>().vector.end(),
+                                                  s2.as<string>().vector.begin(), s2.as<string>().vector.end(), compare);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("string-ci<?", [](let const& xs)
+      {
+        auto compare = [](let const& s1, let const& s2)
+        {
+          auto compare = [](auto const& c1, auto const& c2)
+          {
+            return c1.downcase() < c2.downcase();
+          };
+
+          return not std::lexicographical_compare(s1.as<string>().vector.begin(), s1.as<string>().vector.end(),
+                                                  s2.as<string>().vector.begin(), s2.as<string>().vector.end(), compare);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("string-ci>?", [](let const& xs)
+      {
+        auto compare = [](let const& s1, let const& s2)
+        {
+          auto compare = [](auto const& c1, auto const& c2)
+          {
+            return c1.downcase() > c2.downcase();
+          };
+
+          return not std::lexicographical_compare(s1.as<string>().vector.begin(), s1.as<string>().vector.end(),
+                                                  s2.as<string>().vector.begin(), s2.as<string>().vector.end(), compare);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("string-ci<=?", [](let const& xs)
+      {
+        auto compare = [](let const& s1, let const& s2)
+        {
+          auto compare = [](auto const& c1, auto const& c2)
+          {
+            return c1.downcase() <= c2.downcase();
+          };
+
+          return not std::lexicographical_compare(s1.as<string>().vector.begin(), s1.as<string>().vector.end(),
+                                                  s2.as<string>().vector.begin(), s2.as<string>().vector.end(), compare);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("string-ci>=?", [](let const& xs)
+      {
+        auto compare = [](let const& s1, let const& s2)
+        {
+          auto compare = [](auto const& c1, auto const& c2)
+          {
+            return c1.downcase() >= c2.downcase();
+          };
+
+          return not std::lexicographical_compare(s1.as<string>().vector.begin(), s1.as<string>().vector.end(),
+                                                  s2.as<string>().vector.begin(), s2.as<string>().vector.end(), compare);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
       library.define<function>("string-append", [](let const& xs)
       {
         let s = make<string>();