Merge pull request #464 from yamacir-kit/release-candidate

Release candidate

CMakeLists.txt

@@ -97,7 +97,7 @@ target_link_libraries(format PRIVATE kernel)
 
 add_custom_target(basis
   DEPENDS format
-  COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/basis/configure.cmake)
+  COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/configure/basis.cmake)
 
 # ---- Target shell ------------------------------------------------------------
 

VERSION

@@ -1 +1 @@
-0.5.0
+0.5.32

basis/r7rs.ss

@@ -394,6 +394,10 @@
                       (car xs)
                       (current-output-port))))))
 
+(define-library (scheme box)
+  (import (srfi 111))
+  (export box box? unbox set-box!))
+
 (define-library (scheme case-lambda)
   (import (srfi 16))
   (export case-lambda))
@@ -421,8 +425,7 @@
            (string-map char-foldcase x))))
 
 (define-library (scheme complex)
-  (import (only (meevax complex) make-rectangular real-part imag-part)
-          (only (scheme r5rs) make-polar magnitude angle))
+  (import (only (scheme r5rs) make-rectangular make-polar real-part imag-part magnitude angle))
   (export make-rectangular make-polar real-part imag-part magnitude angle))
 
 (define-library (scheme cxr)

basis/srfi-45.ss

@@ -1,7 +1,10 @@
 (define-library (srfi 45) ; Based on r7rs reference implementation.
-  (import (only (meevax core) define-syntax)
+  (import (only (meevax boolean) not)
+          (only (meevax comparator) eq?)
+          (only (meevax core) define define-syntax if lambda quote)
+          (only (meevax list) list)
           (only (meevax macro-transformer) er-macro-transformer)
-          (scheme r4rs essential))
+          (only (meevax pair) pair? cons car cdr cadr cddr set-car! set-cdr!))
 
   (export delay eager force lazy promise?)
 
@@ -11,8 +14,9 @@
            (cons <promise> (cons done? value)))
 
          (define (promise? x)
-           (and (pair? x)
-                (eq? <promise> (car x))))
+           (if (pair? x)
+               (eq? <promise> (car x))
+               #f))
 
          (define promise-done? cadr)
 

configure/basis.hpp

@@ -33,7 +33,6 @@ inline namespace kernel
   {
     return make_array(
       R"##(${CONFIGURED_meevax.ss})##",
-      R"##(${CONFIGURED_r4rs-essential.ss})##",
       R"##(${CONFIGURED_r4rs.ss})##",
       R"##(${CONFIGURED_r5rs.ss})##",
       R"##(${CONFIGURED_r7rs.ss})##",

example/example.cpp

@@ -1,18 +1,17 @@
-#include <meevax/basis/scheme.hpp>
 #include <meevax/kernel/environment.hpp>
 
 using namespace meevax; // NOTE: DIRTY HACK
 
 extern "C"
 {
-  let length_of_arguments(let const& xs)
+  auto arity(object & xs)
   {
     return make<exact_integer>(length(xs));
   }
 
-  let dummy_procedure(let const& xs)
+  auto dummy_procedure(object & xs)
   {
-    std::cout << "\n; calling C++ function via foreign-function-interface." << std::endl;
+    std::cout << "\n; calling C++ function." << std::endl;
 
     std::size_t count = 0;
 
@@ -46,17 +45,17 @@ extern "C"
     }
   };
 
-  let make_hoge(let const& xs)
+  auto make_hoge(object & xs)
   {
     return make<hoge>(xs[0].as<exact_integer>());
   }
 
-  let is_hoge(let const& xs)
+  auto is_hoge(object & xs)
   {
     return xs[0].is<hoge>() ? t : f;
   }
 
-  let hoge_value(let const& xs)
+  auto hoge_value(object & xs)
   {
     return make<exact_integer>(xs[0].as<hoge>().value);
   }

example/example.ss

@@ -1,4 +1,4 @@
-(import (meevax function)
+(import (only (meevax procedure) procedure)
         (scheme base)
         (scheme process-context)
         (scheme write)
@@ -7,37 +7,37 @@
 ; ------------------------------------------------------------------------------
 
 (define dummy-procedure
-  (foreign-function "build/libexample.so" "dummy_procedure"))
+  (procedure "build/libexample.so" 'dummy_procedure))
 
-(check (foreign-function? dummy-procedure) => #t)
+(check (procedure? dummy-procedure) => #t)
 
 (check (dummy-procedure 'hoge 42 #(1 2 3) 3.14) => 43)
 
 ; ------------------------------------------------------------------------------
 
-(define length-of-arguments
-  (foreign-function "build/libexample.so" "length_of_arguments"))
+(define arity
+  (procedure "build/libexample.so" 'arity))
 
-(check (foreign-function? length-of-arguments) => #t)
+(check (procedure? arity) => #t)
 
-(check (length-of-arguments 'hoge 42 #(1 2 3) 3.14) => 4)
+(check (arity 'hoge 42 #(1 2 3) 3.14) => 4)
 
 ; ------------------------------------------------------------------------------
 
 (define make-hoge
-  (foreign-function "build/libexample.so" "make_hoge"))
+  (procedure "build/libexample.so" 'make_hoge))
 
 (define hoge?
-  (foreign-function "build/libexample.so" "is_hoge"))
+  (procedure "build/libexample.so" 'is_hoge))
 
 (define hoge-value
-  (foreign-function "build/libexample.so" "hoge_value"))
+  (procedure "build/libexample.so" 'hoge_value))
 
-(check (foreign-function? make-hoge) => #t)
+(check (procedure? make-hoge) => #t)
 
-(check (foreign-function? hoge?) => #t)
+(check (procedure? hoge?) => #t)
 
-(check (foreign-function? hoge-value) => #t)
+(check (procedure? hoge-value) => #t)
 
 (define h (make-hoge 100))
 

include/meevax/kernel/complex.hpp

@@ -41,6 +41,14 @@ inline namespace kernel
   };
 
   auto operator <<(std::ostream &, complex const&) -> std::ostream &;
+
+  auto real_part(object const&) -> object const&;
+
+  auto imag_part(object const&) -> object const&;
+
+  auto magnitude(object const&) -> object;
+
+  auto angle(object const&) -> object;
 } // namespace kernel
 } // namespace meevax
 

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;

include/meevax/kernel/dynamic_environment.hpp

@@ -286,16 +286,16 @@ inline namespace kernel
             s = unit;
             goto fetch;
           }
-          else if (callee.is_also<procedure>()) /* -----------------------------
+          else if (callee.is_also<callable>()) /* ------------------------------
           *
-          *  (<procedure> xs . s) e (%call . c) d => (x . s) e c d
+          *  (<callable> xs . s) e (%call . c) d => (x . s) e c d
           *
           *  where x = procedure(xs)
           *
           * ----------------------------------------------------------------- */
           {
             assert(tail(c, 1).template is<pair>());
-            s = cons(callee.as<procedure>()(cadr(s)), cddr(s));
+            s = cons(callee.as<callable>()(cadr(s)), cddr(s));
             c = cdr(c);
             goto fetch;
           }
@@ -336,17 +336,17 @@ inline namespace kernel
             s = unit;
             goto fetch;
           }
-          else if (callee.is_also<procedure>()) /* -----------------------------
+          else if (callee.is_also<callable>()) /* ------------------------------
           *
-          *  (<procedure> xs) e (%tail-call) (s' e' c' . d) => (x . s') e' c' d
+          *  (<callable> xs) e (%tail-call) (s' e' c' . d) => (x . s') e' c' d
           *
           *  where x = procedure(xs)
           *
           * ----------------------------------------------------------------- */
           {
             assert(tail(s, 2).template is<null>());
             assert(tail(c, 1).template is<null>());
-            s = cons(callee.as<procedure>()(cadr(s)), car(d));
+            s = cons(callee.as<callable>()(cadr(s)), car(d));
             e = cadr(d);
             c = caddr(d);
             d = cdddr(d);

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;

include/meevax/kernel/list.hpp

@@ -105,6 +105,8 @@ inline namespace kernel
 
   auto make_list(std::size_t, object const& = unit) -> object;
 
+  auto is_list(object const&) -> bool;
+
   template <typename T>
   auto tail(T&& x, std::size_t size) -> decltype(x)
   {

include/meevax/kernel/number.hpp

@@ -363,18 +363,50 @@ inline namespace number
 
   auto is_integer(object const&) -> bool;
 
+  auto is_exact(object const&) -> bool;
+
+  auto is_inexact(object const&) -> bool;
+
   auto is_finite(object const&) -> bool;
 
   auto is_infinite(object const&) -> bool;
 
   auto is_nan(object const&) -> bool;
 
+  auto is_zero(object const&) -> bool;
+
+  auto is_positive(object const&) -> bool;
+
+  auto is_negative(object const&) -> bool;
+
+  auto is_odd(object const&) -> bool;
+
+  auto is_even(object const&) -> bool;
+
+  auto max(object const&) -> object;
+
+  auto min(object const&) -> object;
+
   auto abs(object const&) -> object;
 
+  auto quotient(object const&, object const&) -> object;
+
+  auto remainder(object const&, object const&) -> object;
+
+  auto modulo(object const&, object const&) -> object;
+
+  auto gcd(object const&, object const&) -> object;
+
+  auto lcm(object const&, object const&) -> object;
+
   auto sqrt(object const&) -> object;
 
   auto pow(object const&, object const&) -> object;
 
+  auto numerator(object const&) -> object;
+
+  auto denominator(object const&) -> object;
+
   auto floor(object const&) -> object;
 
   auto ceil(object const&) -> object;

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>