Merge pull request #403 from yamacir-kit/library

CMakeLists.txt

@@ -19,11 +19,11 @@ set(CMAKE_CXX_STANDARD_REQUIRED ON)
 set(CMAKE_POSITION_INDEPENDENT_CODE ON)
 set(CMAKE_VERBOSE_MAKEFILE OFF)
 
-set(CMAKE_CXX_FLAGS "-Wall -Wextra -Wpedantic -Wno-parentheses")
+set(CMAKE_CXX_FLAGS "-Wall -Wextra -Wpedantic -Wno-parentheses -pipe")
 set(CMAKE_CXX_FLAGS_DEBUG          "-Og -g")
 set(CMAKE_CXX_FLAGS_MINSIZEREL     "-Os    -DNDEBUG")
 set(CMAKE_CXX_FLAGS_RELWITHDEBINFO "-O2 -g -DNDEBUG")
-set(CMAKE_CXX_FLAGS_RELEASE        "-O3    -DNDEBUG -pipe") # NOTE: -march=native causes "Illegal instruction" error (is Valgrind's bug) on CI.
+set(CMAKE_CXX_FLAGS_RELEASE        "-O3    -DNDEBUG") # NOTE: -march=native causes "Illegal instruction" error (is Valgrind's bug) on CI.
 
 set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR})
 set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_BINDIR})

README.md

@@ -103,9 +103,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name        | Description
 |:-------------------|:--
-| `all` (default)    | Build shared-library `libmeevax.0.4.81.so` and executable `meevax`.
+| `all` (default)    | Build shared-library `libmeevax.0.4.117.so` and executable `meevax`.
 | `test`             | Test executable `meevax`.
-| `package`          | Generate debian package `meevax_0.4.81_amd64.deb`.
+| `package`          | Generate debian package `meevax_0.4.117_amd64.deb`.
 | `install`          | Copy files into `/usr/local` __(1)__.
 | `install.deb`      | `all` + `package` + `sudo apt install <meevax>.deb`
 | `safe-install.deb` | `all` + `test` + `package` + `sudo apt install <meevax>.deb`
@@ -120,20 +120,19 @@ __(1)__ Meevax installed by `make install` cannot be uninstalled by the system's
 ## Usage
 
 ```
-Meevax Lisp System, version 0.4.81
+Meevax Lisp System, version 0.4.117
 
 Usage: meevax [OPTION...] [FILE...]
 
 Options:
   -b, --batch            Suppress any system output.
-  -d, --debug            Display detailed informations for developers.
+  -d, --debug            Deprecated.
   -e, --evaluate=STRING  Read and evaluate given STRING at configuration step.
   -h, --help             Display this help text and exit.
   -i, --interactive      Take over control of root environment.
   -l, --load=FILENAME    Same as -e '(load FILENAME)'
   -t, --trace            Display stacks of virtual machine for each steps.
   -v, --version          Display version information and exit.
-      --verbose          Display detailed informations.
   -w, --write=OBJECT     Same as -e '(write OBJECT)'
 ```
 

VERSION

@@ -1 +1 @@
-0.4.81
+0.4.117

basis/r4rs-essential.ss

@@ -11,7 +11,7 @@
           (meevax read)
           (meevax string)
           (meevax symbol)
-          (meevax syntax)
+          (rename (meevax syntax) (call-with-current-continuation! call-with-current-continuation))
           (meevax vector)
           (meevax write)
           (srfi 211 explicit-renaming))
@@ -34,7 +34,7 @@
           string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
           substring string-append string->list list->string vector? make-vector
           vector vector-length vector-ref vector-set! vector->list list->vector
-          procedure? apply map for-each call-with-current-continuation!
+          procedure? apply map for-each call-with-current-continuation
           call-with-input-file call-with-output-file input-port? output-port?
           current-input-port current-output-port open-input-file
           open-output-file close-input-port close-output-port read read-char
@@ -556,9 +556,9 @@
                result))
            (call-with-output-port (open-output-file path) f))
 
-         (define current-input-port standard-input-port)  ; r7rs incompatible (current-input-port is standard input)
+         (define current-input-port standard-input-port) ; r7rs incompatible (current-input-port is standard input)
 
-         (define current-output-port standard-output-port)  ; r7rs incompatible (current-output-port is standard output)
+         (define current-output-port standard-output-port) ; r7rs incompatible (current-output-port is standard output)
 
          (define (read . port)
            (%read (if (pair? port)

basis/r4rs.ss

@@ -1,10 +1,10 @@
 (define-library (scheme r4rs)
   (import (meevax inexact)
-          (meevax number) ; for exact-integer?
-          (meevax port) ; for read-ready?
-          (meevax string) ; for string-copy
-          (meevax syntax) ; for define-syntax
-          (meevax vector) ; for vector-fill!
+          (only (meevax number) exact-integer? expt exact inexact ratio?)
+          (only (meevax port) read-ready? standard-input-port standard-output-port)
+          (only (meevax string) string-copy)
+          (only (meevax syntax) define-syntax)
+          (only (meevax vector) vector-fill!)
           (scheme r4rs essential)
           (srfi 45)
           (srfi 211 explicit-renaming))
@@ -32,7 +32,7 @@
           string-append string->list list->string string-copy string-fill!
           vector? make-vector vector vector-length vector-ref vector-set!
           vector->list list->vector vector-fill! procedure? apply map for-each
-          force call-with-current-continuation! call-with-input-file
+          force call-with-current-continuation call-with-input-file
           call-with-output-file input-port? output-port? current-input-port
           current-output-port with-input-from-file with-output-to-file
           open-input-file open-output-file close-input-port close-output-port

basis/r5rs.ss

@@ -1,7 +1,7 @@
 (define-library (scheme r5rs continuation)
   (import (meevax context)
-          (meevax syntax)
-          (scheme r4rs essential))
+          (only (meevax syntax) define-syntax)
+          (rename (scheme r4rs) (call-with-current-continuation r4rs:call/cc)))
 
   (export call-with-current-continuation dynamic-wind exit)
 
@@ -25,10 +25,10 @@
                    (else ((cdar from)) (windup! (cdr from) (cdr to)) ((caar to))))
              (set! %current-dynamic-extents to))
            (let ((current-dynamic-extents %current-dynamic-extents))
-             (call-with-current-continuation! (lambda (k1)
-                                                (procedure (lambda (k2)
-                                                             (windup! %current-dynamic-extents current-dynamic-extents)
-                                                             (k1 k2)))))))
+             (r4rs:call/cc (lambda (k1)
+                             (procedure (lambda (k2)
+                                          (windup! %current-dynamic-extents current-dynamic-extents)
+                                          (k1 k2)))))))
 
          (define (exit . normally?)
            (for-each (lambda (before/after)
@@ -39,9 +39,9 @@
 (define-library (scheme r5rs)
   (import (meevax environment)
           (meevax evaluate)
-          (meevax syntax) ; for let-syntax letrec-syntax
-          (scheme r4rs)
-          (scheme r5rs continuation)
+          (only (meevax syntax) define-syntax let-syntax letrec-syntax)
+          (except (scheme r4rs) call-with-current-continuation)
+          (except (scheme r5rs continuation) exit)
           (srfi 149))
 
   (export quote lambda if set! cond case and or let let* letrec begin do delay

basis/srfi-149.ss

@@ -24,8 +24,8 @@
 ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (define-library (srfi 149)
-  (import (meevax macro)
-          (meevax syntax) ; for define-syntax
+  (import (only (meevax macro) identifier->symbol)
+          (only (meevax syntax) define-syntax quote-syntax)
           (scheme r4rs)
           (srfi 211 explicit-renaming)
           )

basis/srfi-45.ss

@@ -1,6 +1,6 @@
 (define-library (srfi 45) ; Based on r7rs reference implementation.
   (import (scheme r4rs essential)
-          (meevax syntax) ; for define-syntax
+          (only (meevax syntax) define-syntax)
           (srfi 211 explicit-renaming))
 
   (export delay eager force lazy promise?)

benchmark/ack.ss

@@ -1,4 +1,4 @@
-(import (scheme r5rs)
+(import (scheme base)
         (scheme process-context))
 
 (define (ack m n)

benchmark/tarai.ss

@@ -1,4 +1,4 @@
-(import (scheme r5rs)
+(import (scheme base)
         (scheme process-context))
 
 (define (tarai x y z)

configure/README.md

@@ -126,14 +126,13 @@ Usage: meevax [OPTION...] [FILE...]
 
 Options:
   -b, --batch            Suppress any system output.
-  -d, --debug            Display detailed informations for developers.
+  -d, --debug            Deprecated.
   -e, --evaluate=STRING  Read and evaluate given STRING at configuration step.
   -h, --help             Display this help text and exit.
   -i, --interactive      Take over control of root environment.
   -l, --load=FILENAME    Same as -e '(load FILENAME)'
   -t, --trace            Display stacks of virtual machine for each steps.
   -v, --version          Display version information and exit.
-      --verbose          Display detailed informations.
   -w, --write=OBJECT     Same as -e '(write OBJECT)'
 ```
 

example/example.cpp

@@ -32,6 +32,31 @@ extern "C"
       }
     }
 
-    return unspecified_object;
+    return unspecified;
+  }
+
+  struct hoge
+  {
+    int value;
+
+    ~hoge()
+    {
+      std::cout << "DESTRUCTOR!" << std::endl;
+    }
+  };
+
+  let make_hoge(let const& xs)
+  {
+    return make<hoge>(car(xs).as<exact_integer>());
+  }
+
+  let is_hoge(let const& xs)
+  {
+    return car(xs).is<hoge>() ? t : f;
+  }
+
+  let hoge_value(let const& xs)
+  {
+    return make<exact_integer>(car(xs).as<hoge>().value);
   }
 }

example/example.ss

@@ -1,16 +1,51 @@
 (import (meevax foreign-function)
         (scheme base)
-        (only (scheme process-context) exit)
+        (scheme process-context)
+        (scheme write)
         (srfi 78))
 
-(define dummy-procedure (foreign-function "build/libexample.so" "dummy_procedure"))
+; ------------------------------------------------------------------------------
+
+(define dummy-procedure
+  (foreign-function "build/libexample.so" "dummy_procedure"))
 
 (check (foreign-function? 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 length-of-arguments
+  (foreign-function "build/libexample.so" "length_of_arguments"))
 
 (check (foreign-function? length-of-arguments) => #t)
+
 (check (length-of-arguments 'hoge 42 #(1 2 3) 3.14) => 4)
 
-(exit (check-passed? 4))
+; ------------------------------------------------------------------------------
+
+(define make-hoge
+  (foreign-function "build/libexample.so" "make_hoge"))
+
+(define hoge?
+  (foreign-function "build/libexample.so" "is_hoge"))
+
+(define hoge-value
+  (foreign-function "build/libexample.so" "hoge_value"))
+
+(check (foreign-function? make-hoge) => #t)
+
+(check (foreign-function? hoge?) => #t)
+
+(check (foreign-function? hoge-value) => #t)
+
+(define h (make-hoge 100))
+
+(display h)
+(newline)
+
+(check (hoge? h) => #t)
+
+(check (hoge-value h) => 100)
+
+(exit (check-passed? 9))

include/meevax/functional/curry.hpp

@@ -17,21 +17,25 @@
 #ifndef INCLUDED_MEEVAX_FUNCTIONAL_CURRY_HPP
 #define INCLUDED_MEEVAX_FUNCTIONAL_CURRY_HPP
 
+#include <tuple>
 #include <utility>
 
 namespace meevax
 {
 inline namespace functional
 {
-  template <typename Function>
-  constexpr auto curry(Function&& function) -> decltype(auto)
+  template <typename F>
+  constexpr auto curry(F&& f) -> decltype(auto)
   {
-    return [&](auto&&... xs)
+    return [f](auto&&... xs)
     {
-      return [&](auto&&... ys) -> decltype(auto)
+      return [f, xs = std::make_tuple(std::forward<decltype(xs)>(xs)...)](auto&&... ys)
       {
-        return function(std::forward<decltype(xs)>(xs)...,
-                        std::forward<decltype(ys)>(ys)...);
+        return std::apply([&](auto&&... xs)
+                          {
+                            return f(std::forward<decltype(xs)>(xs)...,
+                                     std::forward<decltype(ys)>(ys)...);
+                          }, xs);
       };
     };
   }

include/meevax/iostream/escape_sequence.hpp

@@ -19,9 +19,8 @@
 
 #include <tuple>
 
-#include <meevax/functional/curry.hpp>
 #include <meevax/iostream/is_console.hpp>
-#include <meevax/iostream/write.hpp>
+#include <meevax/utility/unwrap_reference_wrapper.hpp>
 
 namespace meevax
 {
@@ -48,15 +47,20 @@ inline namespace iostream
 
     friend auto operator <<(std::ostream & os, escape_sequence const& sequence) -> std::ostream &
     {
+      auto write = [&](auto&&... xs)
+      {
+        (os << ... << unwrap_reference_wrapper(xs));
+      };
+
       if (is_console(os))
       {
         os << "\x1b[" << sequence.command;
-        std::apply(curry(write)(os), sequence.references);
+        std::apply(write, sequence.references);
         return os << "\x1b[0m";
       }
       else
       {
-        std::apply(curry(write)(os), sequence.references);
+        std::apply(write, sequence.references);
         return os;
       }
     }