Merge pull request #482 from yamacir-kit/error

Error

CMakeLists.txt

@@ -209,6 +209,18 @@ foreach(EACH IN LISTS ${PROJECT_NAME}_TEST_CPP)
             ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/test_${FILENAME})
 endforeach()
 
+file(GLOB ${PROJECT_NAME}_TEST_SH ${CMAKE_CURRENT_SOURCE_DIR}/test/*.sh)
+
+foreach(EACH IN LISTS ${PROJECT_NAME}_TEST_SH)
+  get_filename_component(FILENAME ${EACH} NAME_WE)
+  add_test(
+    NAME ${FILENAME}
+    COMMAND ${${PROJECT_NAME}_MEMORY_CHECK_COMMAND}
+            ${${PROJECT_NAME}_MEMORY_CHECK_OPTIONS}
+            ${EACH}
+            ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/meevax)
+endforeach()
+
 # ---- Additional Targets ------------------------------------------------------
 
 execute_process(COMMAND nproc OUTPUT_VARIABLE ${PROJECT_NAME}_NPROC)

README.md

@@ -90,7 +90,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.187_amd64.deb
+sudo apt install build/meevax_0.5.212_amd64.deb
 ```
 
 or
@@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.187.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.212.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.187_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.212_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

VERSION

@@ -1 +1 @@
-0.5.187
+0.5.212

configure/Doxyfile

@@ -34,6 +34,8 @@ HTML_DYNAMIC_SECTIONS  = YES
 HTML_INDEX_NUM_ENTRIES = 1000
 SEARCHENGINE           = NO
 
+GENERATE_LATEX         = NO
+
 MACRO_EXPANSION        = YES
 PREDEFINED             = NDEBUG
 

include/meevax/kernel/character.hpp

@@ -17,6 +17,7 @@
 #ifndef INCLUDED_MEEVAX_KERNEL_CHARACTER_HPP
 #define INCLUDED_MEEVAX_KERNEL_CHARACTER_HPP
 
+#include <climits> // CHAR_BIT
 #include <cstdint>
 #include <optional>
 #include <string>
@@ -31,11 +32,9 @@ inline namespace kernel
 
     using int_type = std::char_traits<char_type>::int_type;
 
-    /*
-       21 <= sizeof(int_type) * 8 is a request from the maximum Unicode code
-       point 0x10FFFF. sizeof(int_type) < 6 is a requirement from nan-boxing.
-    */
-    static_assert(21 <= sizeof(int_type) * 8 and sizeof(int_type) <= 6);
+    static_assert(21 <= sizeof(int_type) * CHAR_BIT); // is a requirement from the maximum Unicode code point 0x10FFFF.
+
+    static_assert(sizeof(int_type) <= 6); // is a requirement from nan-boxing.
 
     int_type codepoint;
 
@@ -126,7 +125,7 @@ inline namespace kernel
 
     character() = default;
 
-    explicit constexpr character(int_type const& codepoint)
+    explicit constexpr character(int_type codepoint)
       : codepoint { codepoint }
     {}
 
@@ -181,6 +180,11 @@ inline namespace kernel
       return eq(eof(), c);
     }
 
+    constexpr auto is_eof() const noexcept
+    {
+      return is_eof(codepoint);
+    }
+
     constexpr auto property() const noexcept -> property_code
     {
       return codepoint;

include/meevax/kernel/configurator.hpp

@@ -35,12 +35,12 @@ inline namespace kernel
     {
       std::regex const pattern;
 
-      std::function<object (std::function<object ()> const&)> build;
+      std::function<auto (std::function<auto () -> object> const&) -> void> evaluate;
 
       template <typename S, typename F>
       explicit option(S&& s, F&& f)
-        : pattern { std::forward<decltype(s)>(s) }
-        , build   { std::forward<decltype(f)>(f) }
+        : pattern  { std::forward<decltype(s)>(s) }
+        , evaluate { std::forward<decltype(f)>(f) }
       {}
     };
 
@@ -60,88 +60,59 @@ inline namespace kernel
 
     auto configure(std::vector<std::string> const& args) -> void
     {
-      static auto const pattern = std::regex(R"(--(\w[-\w]+)(=(.*))?|-([\w]+))");
+      auto const static pattern = std::regex(R"(--(\w[-\w]+)(=(.*))?|-([\w]+))");
 
-      auto const options = std::vector<option>
+      auto const options = std::array<option, 6>
       {
         option("(i|interactive)", [this](auto)
         {
-          let const f = make<procedure>(__func__, [this](let const&)
-          {
-            interactive = true;
-            return unspecified;
-          });
-
-          return list(f);
+          interactive = true;
         }),
 
-        option("(e|evaluate)", [](auto read)
+        option("(e|evaluate)", [this](auto read)
         {
-          return read();
+          static_cast<Environment &>(*this).evaluate(read());
         }),
 
         option("(h|help)", [](auto)
         {
-          let static const f = make<procedure>(__func__, [](let const&)
-          {
-            std::cout << help() << std::endl;
-            throw EXIT_SUCCESS;
-          });
-
-          return list(f);
+          std::cout << help() << std::endl;
+          throw EXIT_SUCCESS;
         }),
 
         option("(l|load)", [this](auto read)
         {
-          let const f = make<procedure>(__func__, [this](let const& xs)
-          {
-            static_cast<Environment &>(*this).load(car(xs).as<string>());
-            return unspecified;
-          });
-
-          return list(f, read());
+          static_cast<Environment &>(*this).load(read().template as<string>());
         }),
 
         option("(v|version)", [](auto)
         {
-          let static const f = make<procedure>(__func__, [](let const&)
-          {
-            std::cout << version() << std::endl;
-            throw EXIT_SUCCESS;
-          });
-
-          return list(f);
+          std::cout << version() << std::endl;
+          throw EXIT_SUCCESS;
         }),
 
         option("(w|write)", [](auto read)
         {
-          let static const f = make<procedure>(__func__, [](let const& xs)
-          {
-            std::cout << car(xs) << std::endl;
-          });
-
-          return list(f, read());
+          std::cout << read() << std::endl;
         }),
       };
 
-      auto search = [&](auto&& name) -> decltype(auto)
+      auto evaluator = [&](auto&& name) -> decltype(auto)
       {
         if (auto iter = std::find_if(options.begin(), options.end(), [&](auto&& option)
                         {
                           return std::regex_match(name, option.pattern);
                         });
             iter != options.end())
         {
-          return *iter;
+          return iter->evaluate;
         }
         else
         {
           throw error(make<string>("unknown option"), make<symbol>(name));
         }
       };
 
-      std::vector<object> expressions {};
-
       for (auto iter = std::next(args.begin()); iter != args.end(); ++iter)
       {
         static std::regex const pattern { R"(--(\w[-\w]+)(?:=(.*))?|-([\w]+))" };
@@ -165,39 +136,26 @@ inline namespace kernel
           {
             for (auto str3 = result.str(3); not str3.empty(); str3.erase(0, 1))
             {
-              expressions.push_back(search(str3.substr(0, 1)).build(read));
+              std::invoke(evaluator(str3.substr(0, 1)), read);
             }
           }
           else if (result.length(2))
           {
-            auto read = [result]()
+            std::invoke(evaluator(result.str(1)), [result]()
             {
               return input_string_port(result.str(2)).read();
-            };
-
-            expressions.push_back(search(result.str(1)).build(read));
+            });
           }
           else if (result.length(1))
           {
-            expressions.push_back(search(result.str(1)).build(read));
+            std::invoke(evaluator(result.str(1)), read);
           }
         }
         else
         {
-          let const f = make<procedure>(__func__, [iter](let const&)
-          {
-            Environment().load(*iter);
-            return unspecified;
-          });
-
-          expressions.push_back(list(f));
+          Environment().load(*iter);
         }
       }
-
-      for (let const& expression : expressions)
-      {
-        static_cast<Environment &>(*this).evaluate(expression);
-      }
     }
   };
 } // namespace kernel

include/meevax/kernel/dynamic_environment.hpp

@@ -56,24 +56,24 @@ inline namespace kernel
     std::array<let, 3> a;
 
     /*
-       raise is a one-argument procedure for propagating C++ exceptions thrown
-       in the Meevax kernel to the exception handler of the language running on
-       the Meevax kernel.
+       exception_handler is a one-argument procedure for propagating C++
+       exceptions thrown in the Meevax kernel to the exception handler of the
+       language running on the Meevax kernel.
 
-       raise is set to null by default. In this default state, that is, if raise
-       is null, C++ exceptions thrown in the kernel are rethrown to the outer
-       environment.
+       exception_handler is set to null by default. In this default state, that
+       is, if exception_handler is null, C++ exceptions thrown in the kernel
+       are rethrown to the outer environment.
 
-       Although raise can be set to any one-argument procedure by procedure
-       `kernel-exception-handler-set!`, it is basically assumed to be set to
-       R7RS Scheme's standard procedure `raise`.
+       Although exception_handler can be set to any one-argument procedure by
+       procedure `kernel-exception-handler-set!`, it is basically assumed to be
+       set to R7RS Scheme's standard procedure `raise`.
     */
-    let static inline raise = nullptr;
+    let static inline exception_handler = nullptr;
 
     template <typename... Ts>
-    auto apply(object const& f, Ts&&... xs) -> decltype(auto)
+    auto apply(object const& procedure, Ts&&... xs) -> decltype(auto)
     {
-      s = list(f, list(std::forward<decltype(xs)>(xs)...));
+      s = list(procedure, list(std::forward<decltype(xs)>(xs)...));
       e = nullptr;
       c = list(make(instruction::call),
                make(instruction::stop));
@@ -94,16 +94,13 @@ inline namespace kernel
       return run();
     }
 
-    auto reraise(object const& x) -> decltype(auto)
-    {
-      return raise.is<null>() ? throw x : apply(raise, x);
-    }
-
     auto run() -> object
     {
       assert(last(c).template is<instruction>());
       assert(last(c).template as<instruction>() == instruction::stop);
 
+      let const control = c;
+
       try
       {
       fetch:
@@ -525,13 +522,43 @@ inline namespace kernel
           }();
         }
       }
-      catch (std::exception const& exception)
+      catch (object const& thrown) // by the primitive procedure `throw`.
+      {
+        if (thrown.is_also<error>())
+        {
+          thrown.as<error>().raise();
+          return unspecified;
+        }
+        else
+        {
+          error::contexts.emplace_back(error::in::running, cons(control, c));
+          throw error(make<string>("uncaught exception"), thrown);
+        }
+      }
+      catch (error & thrown) // by any primitive procedure other than `throw`.
       {
-        return reraise(make<error>(make<string>(exception.what())));
+        if (exception_handler)
+        {
+          error::contexts.emplace_back(error::in::running, cons(control, c));
+          return apply(exception_handler, thrown.make());
+        }
+        else // In most cases, this clause will never be called.
+        {
+          thrown.raise();
+          return unspecified;
+        }
       }
-      catch (error const& error)
+      catch (std::exception const& exception) // by the system.
       {
-        return reraise(make(error));
+        if (auto thrown = error(make<string>(exception.what())); exception_handler)
+        {
+          error::contexts.emplace_back(error::in::running, cons(control, c));
+          return apply(exception_handler, thrown.make());
+        }
+        else // In most cases, this clause will never be called.
+        {
+          throw thrown;
+        }
       }
     }
   };