Add new member function character::upcase

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

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)

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...]

VERSION

@@ -1 +1 @@
-0.4.800
+0.4.801

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))
 

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;

script/unicode.sh

@@ -18,17 +18,19 @@
 # \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 "$@"
 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

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)