From 5609bc41a97409356e3f25743e80f918bd79e558 Mon Sep 17 00:00:00 2001
From: yamacir-kit <httperror@404-notfound.jp>
Date: Tue, 3 Oct 2023 23:07:04 +0900
Subject: [PATCH] Update character comparison procedures to built-in

Signed-off-by: yamacir-kit <httperror@404-notfound.jp>
---
 README.md           |  6 +++---
 VERSION             |  2 +-
 basis/r4rs.ss       | 32 +++++++----------------------
 src/kernel/boot.cpp | 50 +++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 61 insertions(+), 29 deletions(-)

diff --git a/README.md b/README.md
index 11ad3e5a4..cb441be31 100644
--- a/README.md
+++ b/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.18_amd64.deb
+sudo apt install build/meevax_0.5.19_amd64.deb
 ```
 
 or
@@ -131,9 +131,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.18.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.19.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.18_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.19_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage
diff --git a/VERSION b/VERSION
index b7a8bdf37..5ca9ac67b 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-0.5.18
+0.5.19
diff --git a/basis/r4rs.ss b/basis/r4rs.ss
index 18064403f..e26868255 100644
--- a/basis/r4rs.ss
+++ b/basis/r4rs.ss
@@ -36,7 +36,13 @@
 
 (define-library (scheme r4rs)
   (import (only (meevax boolean) boolean? not)
-          (meevax character)
+          (only (meevax character)
+                char?
+                char=? char<? char>? char<=? char>=?
+                char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case?
+                char->integer integer->char
+                char-upcase char-downcase
+                )
           (only (meevax core) begin define define-syntax if lambda letrec quote set!)
           (only (meevax comparator) eq? eqv? equal?)
           (only (meevax complex) make-rectangular make-polar real-part imag-part magnitude angle)
@@ -336,30 +342,6 @@
            (simplest-rational (- x e)
                               (+ x e)))
 
-         (define (char-compare x xs compare) ; Chibi-Scheme
-           (let rec ((compare compare)
-                     (lhs (char->integer x))
-                     (xs xs))
-             (if (null? xs) #t
-                 (let ((rhs (char->integer (car xs))))
-                   (and (compare lhs rhs)
-                        (rec compare rhs (cdr xs)))))))
-
-         (define (char=? x . xs) ; Chibi-Scheme
-           (char-compare x xs =))
-
-         (define (char<? x . xs) ; Chibi-Scheme
-           (char-compare x xs <))
-
-         (define (char>? x . xs) ; Chibi-Scheme
-           (char-compare x xs >))
-
-         (define (char<=? x . xs) ; Chibi-Scheme
-           (char-compare x xs <=))
-
-         (define (char>=? x . xs) ; Chibi-Scheme
-           (char-compare x xs >=))
-
          (define (char-ci-compare x xs compare) ; Chibi-Scheme
            (let rec ((compare compare)
                      (lhs (char->integer (char-downcase x)))
diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp
index d10eb9550..8e84c8b9c 100644
--- a/src/kernel/boot.cpp
+++ b/src/kernel/boot.cpp
@@ -82,6 +82,56 @@ inline namespace kernel
         return xs[0].is<character>();
       });
 
+      library.define<predicate>("char=?", [](let const& xs)
+      {
+        auto compare = [](let const& a, let const& b)
+        {
+          return not (a.as<character>().codepoint == b.as<character>().codepoint);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("char<?", [](let const& xs)
+      {
+        auto compare = [](let const& a, let const& b)
+        {
+          return not (a.as<character>().codepoint < b.as<character>().codepoint);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("char>?", [](let const& xs)
+      {
+        auto compare = [](let const& a, let const& b)
+        {
+          return not (a.as<character>().codepoint > b.as<character>().codepoint);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("char<=?", [](let const& xs)
+      {
+        auto compare = [](let const& a, let const& b)
+        {
+          return not (a.as<character>().codepoint <= b.as<character>().codepoint);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
+      library.define<predicate>("char>=?", [](let const& xs)
+      {
+        auto compare = [](let const& a, let const& b)
+        {
+          return not (a.as<character>().codepoint >= b.as<character>().codepoint);
+        };
+
+        return std::adjacent_find(xs.begin(), xs.end(), compare) == xs.end();
+      });
+
       library.define<predicate>("char-alphabetic?", [](let const& xs)
       {
         return xs[0].as<character>().property().is_letter();