From c31e51363bc0d0d8e671d79cfe4d8ecdfe242da6 Mon Sep 17 00:00:00 2001
From: yamacir-kit <httperror@404-notfound.jp>
Date: Sun, 17 Sep 2023 12:19:38 +0900
Subject: [PATCH] Add new member function `character::upcase`

Signed-off-by: yamacir-kit <httperror@404-notfound.jp>
---
 CMakeLists.txt                      |  5 +++++
 README.md                           |  8 ++++----
 VERSION                             |  2 +-
 basis/r4rs-essential.ss             |  4 ----
 include/meevax/kernel/character.hpp | 21 ++++++++++++++++-----
 script/unicode.sh                   |  6 ++++--
 src/kernel/boot.cpp                 |  5 +++++
 7 files changed, 35 insertions(+), 16 deletions(-)

diff --git a/CMakeLists.txt b/CMakeLists.txt
index 04e6ae11b..ac78b4734 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -55,10 +55,15 @@ execute_process(
   COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/script/unicode.sh --property
   OUTPUT_VARIABLE ${PROJECT_NAME}_UNICODE_PROPERTY)
 
+execute_process(
+  COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/script/unicode.sh --upcase
+  OUTPUT_VARIABLE ${PROJECT_NAME}_UNICODE_UPCASE)
+
 file(GLOB ${PROJECT_NAME}_BASIS_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/basis/*.ss)
 file(READ ${CMAKE_CURRENT_SOURCE_DIR}/configure/help.txt ${PROJECT_NAME}_HELP_UNCONFIGURED)
 file(WRITE ${CMAKE_CURRENT_SOURCE_DIR}/include/${PROJECT_NAME}/unicode/digit_value.hpp "${${PROJECT_NAME}_UNICODE_DIGIT_VALUE}")
 file(WRITE ${CMAKE_CURRENT_SOURCE_DIR}/include/${PROJECT_NAME}/unicode/property.hpp    "${${PROJECT_NAME}_UNICODE_PROPERTY}")
+file(WRITE ${CMAKE_CURRENT_SOURCE_DIR}/include/${PROJECT_NAME}/unicode/upcase.hpp      "${${PROJECT_NAME}_UNICODE_UPCASE}")
 
 string(CONFIGURE ${${PROJECT_NAME}_HELP_UNCONFIGURED} ${PROJECT_NAME}_HELP)
 string(TOLOWER ${CMAKE_SYSTEM_NAME} ${PROJECT_NAME}_SYSTEM_NAME)
diff --git a/README.md b/README.md
index 7e03cd8b7..5d7eabfc2 100644
--- a/README.md
+++ b/README.md
@@ -74,7 +74,7 @@ Subset of R7RS-small.
 cmake -B build -DCMAKE_BUILD_TYPE=Release
 cd build
 make package
-sudo apt install build/meevax_0.4.800_amd64.deb
+sudo apt install build/meevax_0.4.801_amd64.deb
 ```
 
 or
@@ -106,15 +106,15 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.4.800.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.4.801.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.4.800_amd64.deb`
+| `package`   | Generate debian package `meevax_0.4.801_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage
 
 ```
-Meevax Lisp 0.4.800
+Meevax Lisp 0.4.801
 
 Usage:
   meevax [option...] [file...]
diff --git a/VERSION b/VERSION
index 1ffe87fd5..de56dd147 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-0.4.800
+0.4.801
diff --git a/basis/r4rs-essential.ss b/basis/r4rs-essential.ss
index 70f05f28f..d58b6a36c 100644
--- a/basis/r4rs-essential.ss
+++ b/basis/r4rs-essential.ss
@@ -393,10 +393,6 @@
            (if (char-lower-case? c) c
                (integer->char (+ (char->integer c) 32))))
 
-         (define (char-upcase c)
-           (if (char-upper-case? c) c
-               (integer->char (- (char->integer c) 32))))
-
          (define (string . xs)
            (list->string xs))
 
diff --git a/include/meevax/kernel/character.hpp b/include/meevax/kernel/character.hpp
index 11837d68b..a26be485b 100644
--- a/include/meevax/kernel/character.hpp
+++ b/include/meevax/kernel/character.hpp
@@ -137,11 +137,6 @@ inline namespace kernel
 
     auto digit_value() const -> object const&;
 
-    constexpr auto property() const noexcept -> property_code
-    {
-      return property_code::from(codepoint);
-    }
-
     static constexpr auto is_ascii(int_type c)
     {
       return 0x00 <= c and c <= 0x7F;
@@ -152,6 +147,22 @@ inline namespace kernel
       return eq(eof(), c);
     }
 
+    constexpr auto property() const noexcept -> property_code
+    {
+      return property_code::from(codepoint);
+    }
+
+    constexpr auto upcase() const noexcept
+    {
+      switch (codepoint)
+      {
+      #include <meevax/unicode/upcase.hpp>
+
+      default:
+        return codepoint;
+      }
+    }
+
     constexpr operator int_type() const
     {
       return codepoint;
diff --git a/script/unicode.sh b/script/unicode.sh
index a7de14e96..9e54d66ab 100755
--- a/script/unicode.sh
+++ b/script/unicode.sh
@@ -18,11 +18,12 @@
 # \14 = Lowercase mapping
 # \15 = Titlecase mapping
 
-unicode_data='^([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);(.*)$'
+input="$(git rev-parse --show-toplevel)/configure/UnicodeData.txt"
 
 substitute()
 {
-  sed -E "s/$unicode_data/$1/g" "$(git rev-parse --show-toplevel)/configure/UnicodeData.txt"
+  pattern='^([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);(.*)$'
+  sed -E "s/$pattern/$1/g" "$input"
 }
 
 for each in "$@"
@@ -30,5 +31,6 @@ do
   case "$each" in
     --digit-value ) substitute '{ 0x\1, make_number("\9") },' | grep -e '{ .\+, make_number(".\+") },' ;;
     --property    ) substitute 'case 0x\1: return \3;' ;;
+    --upcase      ) sed -E 's/^([^;]*);([^;]*;){11}([^;]*);.*$/case 0x\1: return 0x\3;/g' "$input" | grep -e 'case 0x.\+: return 0x.\+;'
   esac
 done
diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp
index 3ce3e555e..af330099d 100644
--- a/src/kernel/boot.cpp
+++ b/src/kernel/boot.cpp
@@ -104,6 +104,11 @@ inline namespace kernel
       {
         return make<character>(xs[0].as<exact_integer>());
       });
+
+      library.define<function>("char-upcase", [](let const& xs)
+      {
+        return make<character>(xs[0].as<character>().upcase());
+      });
     });
 
     define<library>("(meevax complex)", [](library & library)