Unify procedure-related structures into a single template procedure

Signed-off-by: yamacir-kit <[email protected]>
yamacir-kit · Oct 7, 2023 · 3b90940 · 3b90940
1 parent d0132c8
commit 3b90940
Show file tree

Hide file tree

Showing 9 changed files with 237 additions and 281 deletions.
diff --git 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.29_amd64.deb
+sudo apt install build/meevax_0.5.30_amd64.deb
 ```
 
 or
@@ -131,9 +131,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.29.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.30.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.29_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.30_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

diff --git a/VERSION b/VERSION
@@ -1 +1 @@
-0.5.29
+0.5.30
diff --git a/include/meevax/kernel/configurator.hpp b/include/meevax/kernel/configurator.hpp
@@ -66,7 +66,7 @@ inline namespace kernel
       {
         option("(i|interactive)", [this](auto)
         {
-          let const f = make<functor>("", [this](let const&)
+          let const f = make<procedure>("", [this](let const&)
           {
             interactive = true;
             return unspecified;
@@ -82,7 +82,7 @@ inline namespace kernel
 
         option("(h|help)", [](auto)
         {
-          let static const f = make<command>("", [](let const&)
+          let static const f = make<procedure>("", [](let const&)
           {
             std::cout << help() << std::endl;
             throw EXIT_SUCCESS;
@@ -93,7 +93,7 @@ inline namespace kernel
 
         option("(l|load)", [this](auto read)
         {
-          let const f = make<functor>("", [this](let const& xs)
+          let const f = make<procedure>("", [this](let const& xs)
           {
             static_cast<Environment &>(*this).load(xs[0].as<string>());
             return unspecified;
@@ -104,7 +104,7 @@ inline namespace kernel
 
         option("(v|version)", [](auto)
         {
-          let static const f = make<command>("", [](let const&)
+          let static const f = make<procedure>("", [](let const&)
           {
             std::cout << version() << std::endl;
             throw EXIT_SUCCESS;
@@ -115,7 +115,7 @@ inline namespace kernel
 
         option("(w|write)", [](auto read)
         {
-          let static const f = make<command>("", [](let const& xs)
+          let static const f = make<procedure>("", [](let const& xs)
           {
             std::cout << xs[0] << std::endl;
           });
@@ -184,7 +184,7 @@ inline namespace kernel
         }
         else
         {
-          let const f = make<functor>("", [iter](let const&)
+          let const f = make<procedure>("", [iter](let const&)
           {
             Environment().load(*iter);
             return unspecified;

diff --git a/include/meevax/kernel/library.hpp b/include/meevax/kernel/library.hpp
@@ -47,6 +47,12 @@ inline namespace kernel
       export_specs = cons(input_string_port(name).read(), export_specs);
     }
 
+    template <template <typename...> typename Template, typename... Ts>
+    auto define(Ts&&... xs) -> decltype(auto)
+    {
+      return define<Template<Ts...>>(std::forward<decltype(xs)>(xs)...);
+    }
+
     auto evaluate(object const&) -> object;
 
     auto resolve() -> object;

diff --git a/include/meevax/kernel/pair.hpp b/include/meevax/kernel/pair.hpp
@@ -44,6 +44,12 @@ inline namespace kernel
     return object::allocate<std::decay_t<T>>(std::forward<decltype(x)>(x));
   }
 
+  template <template <typename...> typename Template, typename... Ts, REQUIRES(std::is_constructible<Template<Ts...>, Ts...>)>
+  auto make(Ts&&... xs) -> decltype(auto)
+  {
+    return make<Template<Ts...>>(std::forward<decltype(xs)>(xs)...);
+  }
+
   struct pair : public std::pair<object, object>
   {
     template <auto ReadOnly>

diff --git a/include/meevax/kernel/procedure.hpp b/include/meevax/kernel/procedure.hpp
@@ -38,116 +38,58 @@ inline namespace kernel
 
   auto operator <<(std::ostream &, callable const&) -> std::ostream &;
 
+  template <typename, typename Callee>
   struct procedure : public callable
   {
-    auto (*call)(object const&) -> object;
+    Callee call;
 
-    explicit procedure(std::string const& name, auto (*call)(object const&) -> object)
-      : callable { name }
-      , call { call }
-    {}
-
-    explicit procedure(std::string const&, std::string const&);
-
-    auto operator ()(object & xs) const -> object override
-    {
-      return call(xs);
-    }
-  };
-
-  struct functor : public callable
-  {
-    #define FUNCTION(...) auto __VA_ARGS__(meevax::object const& xs) -> meevax::object
-
-    std::function<FUNCTION()> const call;
-
-    explicit functor(std::string const& name, std::function<FUNCTION()> const& call)
-      : callable { name }
-      , call { call }
-    {}
-
-    auto operator ()(object & xs) const -> object override
-    {
-      return call(xs);
-    }
-  };
-
-  struct accessor : public callable
-  {
-    auto (*call)(object const&) -> object const&;
-
-    explicit accessor(std::string const& name, auto (*call)(object const&) -> object const&)
-      : callable { name }
-      , call { call }
-    {}
-
-    auto operator ()(object & xs) const -> object override
-    {
-      return call(xs);
-    }
-  };
-
-  struct predicate : public callable
-  {
-    auto (*call)(object const&) -> bool;
-
-    explicit predicate(std::string const& name, auto (*call)(object const&) -> bool)
-      : callable { name }
-      , call { call }
-    {}
-
-    auto operator ()(object & xs) const -> object override
-    {
-      return call(xs) ? t : f;
-    }
-  };
-
-  struct mutation : public callable
-  {
-    auto (*call)(object &) -> void;
-
-    explicit mutation(std::string const& name, auto (*call)(object &) -> void)
-      : callable { name }
-      , call { call }
-    {}
-
-    auto operator ()(object & xs) const -> object override
-    {
-      call(xs);
-      return unspecified;
-    }
-  };
-
-  struct command : public callable
-  {
-    auto (*call)(object const&) -> void;
-
-    explicit command(std::string const& name, auto (*call)(object const&) -> void)
+    explicit procedure(std::string const& name, Callee call)
       : callable { name }
       , call { call }
     {}
 
     auto operator ()(object & xs) const -> object override
     {
-      call(xs);
-      return unspecified;
+      if constexpr (std::is_invocable_v<Callee>)
+      {
+        if constexpr (std::is_same_v<std::invoke_result_t<Callee>, void>)
+        {
+          call();
+          return unspecified;
+        }
+        else if constexpr (std::is_same_v<std::invoke_result_t<Callee>, bool>)
+        {
+          return call() ? t : f;
+        }
+        else
+        {
+          return call();
+        }
+      }
+      else
+      {
+        if constexpr (std::is_same_v<std::invoke_result_t<Callee, object &>, void>)
+        {
+          call(xs);
+          return unspecified;
+        }
+        else if constexpr (std::is_same_v<std::invoke_result_t<Callee, object &>, bool>)
+        {
+          return call(xs) ? t : f;
+        }
+        else
+        {
+          return call(xs);
+        }
+      }
     }
   };
 
-  struct thunk : public callable
-  {
-    auto (*call)() -> object;
+  using procedure_pointer = auto (*)(object const&) -> object;
 
-    explicit thunk(std::string const& name, auto (*call)() -> object)
-      : callable { name }
-      , call { call }
-    {}
+  auto dlopen(std::string const&) -> void *;
 
-    auto operator ()(object &) const -> object override
-    {
-      return call();
-    }
-  };
+  auto dlsym(std::string const&, void * const) -> procedure_pointer;
 } // namespace kernel
 } // namespace meevax
 

diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp
@@ -1101,6 +1101,12 @@ inline namespace kernel
       }
     }
 
+    template <template <typename...> typename Template, typename... Ts>
+    inline auto define(Ts&&... xs) -> decltype(auto)
+    {
+      return define<Template<Ts...>>(std::forward<decltype(xs)>(xs)...);
+    }
+
     inline auto identify(object const& variable,
                          object const& bound_variables,
                          object const& free_variables) const -> object