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

Release candidate
yamacir-kit · Mar 26, 2024 · 0ea87fe · 0ea87fe
2 parents 5e27098 + fe177f4
commit 0ea87fe
Show file tree

Hide file tree

Showing 159 changed files with 1,406 additions and 1,582 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -1,8 +1,7 @@
 cmake_minimum_required(VERSION 3.16.3) # Ubuntu 20.04 LTS default
 
 execute_process(
-  COMMAND cat ${CMAKE_CURRENT_SOURCE_DIR}/VERSION
-  COMMAND tr -d "\n"
+  COMMAND head -c -1 ${CMAKE_CURRENT_SOURCE_DIR}/VERSION
   OUTPUT_VARIABLE CURRENT_VERSION)
 
 project(meevax
@@ -13,8 +12,7 @@ project(meevax
 
 include(GNUInstallDirs)
 
-string(JOIN " " AGGRESSIVE_OPTIMIZATION_OPTIONS
-  # "-flto" # This optimization causes a SEGV when compiling with Clang 10.
+string(JOIN " " ${PROJECT_NAME}_RELEASE_PLUS
   # "-fmerge-all-constants" # This optimization is very effective in reducing binary size, but non-standard to the C++ standard.
   # "-march=native" # This optimization causes "Illegal instruction" error (is Valgrind's bug) on CI.
   # "-mtune=native"
@@ -23,8 +21,8 @@ string(JOIN " " AGGRESSIVE_OPTIMIZATION_OPTIONS
 set(CMAKE_CXX_EXTENSIONS OFF)
 set(CMAKE_CXX_FLAGS_DEBUG "-Og -gdwarf-4") # NOTE: The `-gdwarf-4` option is set due to the following issues with Clang 14 and Valgrind versions below 3.20: https://bugzilla.mozilla.org/show_bug.cgi?id=1758782
 set(CMAKE_CXX_FLAGS_MINSIZEREL "-Os -DNDEBUG")
-set(CMAKE_CXX_FLAGS_RELEASE "-O2 -DNDEBUG ${AGGRESSIVE_OPTIMIZATION_OPTIONS}")
-set(CMAKE_CXX_FLAGS_RELWITHDEBINFO "-O2 -gdwarf-4 -DNDEBUG")
+set(CMAKE_CXX_FLAGS_RELEASE "-O3 -flto -DNDEBUG ${${PROJECT_NAME}_RELEASE_PLUS}")
+set(CMAKE_CXX_FLAGS_RELWITHDEBINFO "${CMAKE_CXX_FLAGS_RELEASE} -gdwarf-4")
 set(CMAKE_CXX_FLAGS "-Wall -Wextra -Wpedantic -pipe")
 set(CMAKE_CXX_STANDARD 17)
 set(CMAKE_CXX_STANDARD_REQUIRED ON)

diff --git a/README.md b/README.md
@@ -91,7 +91,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.119_amd64.deb
+sudo apt install build/meevax_0.5.159_amd64.deb
 ```
 
 or
@@ -123,9 +123,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name | Description
 |-------------|-------------
-| `all`       | Build shared-library `libmeevax.0.5.119.so` and executable `meevax`
+| `all`       | Build shared-library `libmeevax.0.5.159.so` and executable `meevax`
 | `test`      | Test executable `meevax`
-| `package`   | Generate debian package `meevax_0.5.119_amd64.deb`
+| `package`   | Generate debian package `meevax_0.5.159_amd64.deb`
 | `install`   | Copy files into `/usr/local` directly
 
 ## Usage

diff --git a/VERSION b/VERSION
@@ -1 +1 @@
-0.5.119
+0.5.159
diff --git a/basis/include/meevax/basis.hpp b/basis/include/meevax/basis.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/basis/meevax.ss b/basis/meevax.ss
@@ -98,3 +98,45 @@
                          ((cdr before/after)))
                        (current-dynamic-extents))
              (emergency-exit . xs)))))
+
+(define-library (meevax apply)
+  (import (only (meevax core) define if lambda)
+          (only (meevax list) append null? reverse)
+          (only (meevax pair) car cdr cons))
+
+  (export apply)
+
+  (begin (define (apply f x . xs)
+           (if (null? xs)
+               (f . x)
+               ((lambda (xs)
+                  ((lambda (x)
+                     (f . x))
+                   (append (reverse (cdr xs))
+                           (car xs))))
+                (reverse (cons x xs)))))))
+
+(define-library (meevax map)
+  (import (only (meevax apply) apply)
+          (only (meevax core) define if quote)
+          (only (meevax list) memq null? reverse)
+          (only (meevax pair) car cdr cons))
+
+  (export map)
+
+  (begin (define (map f . xs)
+           (define (map f x a)
+             (if (null? x)
+                 (reverse a)
+                 (map f
+                      (cdr x)
+                      (cons (f (car x)) a))))
+           (define (map* f xs a)
+             (if (memq '() xs)
+                 (reverse a)
+                 (map* f
+                       (map cdr xs '())
+                       (cons (apply f (map car xs '())) a))))
+           (if (null? (cdr xs))
+               (map f (car xs) '())
+               (map* f xs '())))))
diff --git a/basis/r4rs.ss b/basis/r4rs.ss
@@ -35,7 +35,8 @@
 |#
 
 (define-library (scheme r4rs)
-  (import (only (meevax boolean) boolean? not)
+  (import (only (meevax apply) apply)
+          (only (meevax boolean) boolean? not)
           (only (meevax character) char? char=? char<? char>? char<=? char>=? char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case? char->integer integer->char char-upcase char-downcase)
           (only (meevax comparator) eq? eqv? equal?)
           (only (meevax complex) make-rectangular make-polar real-part imag-part magnitude angle)
@@ -44,16 +45,18 @@
           (only (meevax inexact) exp log sqrt sin cos tan asin acos atan)
           (only (meevax list) null? list? list length append reverse list-tail list-ref memq memv assq assv)
           (only (meevax macro-transformer) er-macro-transformer identifier?)
+          (only (meevax map) map)
           (only (meevax number) number? complex? real? rational? integer? exact? inexact? = < > <= >= zero? positive? negative? odd? even? max min + * - / abs quotient remainder modulo gcd lcm numerator denominator floor ceiling truncate round expt exact inexact number->string string->number)
           (only (meevax pair) pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
           (only (meevax port) input-port? output-port? standard-input-port standard-output-port open-input-file open-output-file close eof-object?)
           (only (meevax procedure) procedure?)
           (only (meevax string) string? make-string string string-length string-ref string-set! string=? string<? string>? string<=? string>=? string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=? string-append string->list list->string string-copy string-fill!)
           (only (meevax symbol) symbol? symbol->string string->symbol)
           (only (meevax vector) vector? make-vector vector vector-length vector-ref vector-set! vector->list list->vector vector-fill!)
-          (prefix (only (meevax environment) load) %)
           (prefix (meevax read) %)
           (prefix (meevax write) %)
+          (prefix (only (meevax environment) load) %)
+          (only (srfi 39) make-parameter parameterize)
           (only (srfi 45) delay force))
 
   (export quote lambda if set! cond case and or let let* letrec begin do delay
@@ -183,39 +186,6 @@
                        (else x)))
                (expand (cadr form) 0))))
 
-         (define (every f xs)
-           (if (pair? xs)
-               (and (f (car xs))
-                    (every f (cdr xs)))
-               #t))
-
-         (define (map f x . xs) ; Chibi-Scheme
-           (define (map f x a)
-             (if (pair? x)
-                 (map f
-                      (cdr x)
-                      (cons (f (car x)) a))
-                 (reverse a)))
-           (define (map* f xs a)
-             (if (every pair? xs)
-                 (map* f
-                       (map cdr xs '())
-                       (cons (apply f (map car xs '())) a))
-                 (reverse a)))
-           (if (null? xs)
-               (map f x '())
-               (map* f (cons x xs) '())))
-
-         (define (apply f x . xs) ; Chibi-Scheme
-           (letrec ((apply (lambda (f xs)
-                             (f . xs))))
-             (if (null? xs)
-                 (apply f x)
-                 ((lambda (xs)
-                    (apply f (append (reverse (cdr xs))
-                                     (car xs))))
-                  (reverse (cons x xs))))))
-
          (define-syntax let ; Chibi-Scheme
            (er-macro-transformer
              (lambda (form rename compare)
@@ -310,8 +280,7 @@
                        (else (+ 1 fx)))))
              (cond ((< y x)
                     (simplest-rational y x))
-                   ((not (< x y))
-                    (if (rational? x) x (error x)))
+                   ((not (< x y)) x)
                    ((positive? x)
                     (simplest-rational-internal x y))
                    ((negative? x)
@@ -348,25 +317,23 @@
                result))
            (call-with-output-port (open-output-file path) f))
 
-         (define %current-input-port (standard-input-port))
-
-         (define (current-input-port) %current-input-port)
-
-         (define %current-output-port (standard-output-port))
+         (define current-input-port
+           (make-parameter (standard-input-port)))
 
-         (define (current-output-port) %current-output-port)
+         (define current-output-port
+           (make-parameter (standard-output-port)))
 
          (define (with-input-from-file path thunk)
-           (let ((previous-input-port (current-input-port)))
-             (set! %current-input-port (open-input-file path))
-             (thunk)
-             (set! %current-input-port previous-input-port)))
+           (parameterize ((current-input-port (open-input-file path)))
+             (let ((result (thunk)))
+               (close-input-port (current-input-port))
+               result)))
 
          (define (with-output-to-file path thunk)
-           (let ((previous-output-port (current-output-port)))
-             (set! %current-output-port (open-output-file path))
-             (thunk)
-             (set! %current-output-port previous-output-port)))
+           (parameterize ((current-output-port (open-output-file path)))
+             (let ((result (thunk)))
+               (close-output-port (current-output-port))
+               result)))
 
          (define close-input-port close)
 

diff --git a/basis/r7rs.ss b/basis/r7rs.ss
@@ -1,15 +1,15 @@
 (define-library (scheme base)
   (import (only (meevax core) include include-case-insensitive)
           (only (meevax error) error-object? read-error? file-error?)
-          (only (meevax macro-transformer) er-macro-transformer)
           (only (meevax list) make-list list-copy)
+          (only (meevax macro-transformer) er-macro-transformer)
           (only (meevax number) exact-integer? exact-integer-square-root)
           (only (meevax port) binary-port? eof-object flush get-output-u8vector open-input-u8vector open-output-u8vector open? port? standard-error-port standard-input-port standard-output-port textual-port?)
-          (prefix (meevax read) %)
           (only (meevax string) string-copy!)
           (only (meevax vector homogeneous) u8vector? make-u8vector u8vector u8vector-length u8vector-ref u8vector-set! u8vector-copy u8vector-copy! u8vector-append u8vector->string string->u8vector)
           (only (meevax vector) vector-append vector-copy vector-copy! vector->string string->vector)
           (only (meevax version) features)
+          (prefix (meevax read) %)
           (prefix (meevax write) %)
           (scheme r5rs)
           (srfi 0)
@@ -250,32 +250,8 @@
 
          (define output-port-open? open?)
 
-         (define current-input-port
-           (make-parameter (standard-input-port)
-             (lambda (x)
-               (cond ((not (input-port? x))
-                      (error "not an input-port" x))
-                     ((not (input-port-open? x))
-                      (error "not an opened input-port" x))
-                     (else x)))))
-
-         (define current-output-port
-           (make-parameter (standard-output-port)
-             (lambda (x)
-               (cond ((not (output-port? x))
-                      (error "not an output-port" x))
-                     ((not (output-port-open? x))
-                      (error "not an opened output-port" x))
-                     (else x)))))
-
          (define current-error-port
-           (make-parameter (standard-error-port)
-             (lambda (x)
-               (cond ((not (output-port? x))
-                      (error "not an output-port" x))
-                     ((not (output-port-open? x))
-                      (error "not an opened output-port" x))
-                     (else x)))))
+           (make-parameter (standard-error-port)))
 
          (define (close-port x)
            (cond ((input-port? x) (close-input-port x))
@@ -440,21 +416,10 @@
   (import (only (meevax file) delete-file file-exists?)
           (only (meevax port) open-binary-input-file open-binary-output-file)
           (only (scheme base) close-input-port close-output-port current-input-port current-output-port define parameterize)
-          (only (scheme r5rs) call-with-input-file call-with-output-file open-input-file open-output-file))
-
+          (only (scheme r5rs) call-with-input-file call-with-output-file open-input-file open-output-file with-input-from-file with-output-to-file))
   (export call-with-input-file call-with-output-file delete-file file-exists?
           open-binary-input-file open-binary-output-file open-input-file
-          open-output-file with-input-from-file with-output-to-file)
-
-  (begin (define (with-input-from-file path thunk)
-           (parameterize ((current-input-port (open-input-file path)))
-             (thunk)
-             (close-input-port (current-input-port))))
-
-         (define (with-output-to-file path thunk)
-           (parameterize ((current-output-port (open-output-file path)))
-             (thunk)
-             (close-output-port (current-output-port))))))
+          open-output-file with-input-from-file with-output-to-file))
 
 (define-library (scheme inexact)
   (import (only (meevax inexact) finite? infinite? nan?)

diff --git a/basis/srfi-39.ss b/basis/srfi-39.ss
@@ -26,9 +26,8 @@
           (only (meevax core) define define-syntax if lambda letrec quote)
           (only (meevax list) null? list append assq)
           (only (meevax macro-transformer) er-macro-transformer)
-          (only (meevax pair) cons car cdr cadr cddr set-car! set-cdr!)
-          (only (scheme r5rs) map)
-          )
+          (only (meevax map) map)
+          (only (meevax pair) cons car cdr cadr cddr set-car! set-cdr!))
 
   (export make-parameter parameterize)
 

diff --git a/configure/basis.cpp b/configure/basis.cpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/configure/version.cpp b/configure/version.cpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/bit/bit_cast.hpp b/include/meevax/bit/bit_cast.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/bit/log2.hpp b/include/meevax/bit/log2.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/bitset/simple_bitset.hpp b/include/meevax/bitset/simple_bitset.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/chrono/duration.hpp b/include/meevax/chrono/duration.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/functional/combinator.hpp b/include/meevax/functional/combinator.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/functional/compose.hpp b/include/meevax/functional/compose.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/functional/curry.hpp b/include/meevax/functional/curry.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/iostream/escape_sequence.hpp b/include/meevax/iostream/escape_sequence.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/iostream/is_console.hpp b/include/meevax/iostream/is_console.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.

diff --git a/include/meevax/iostream/lexical_cast.hpp b/include/meevax/iostream/lexical_cast.hpp
@@ -1,5 +1,5 @@
 /*
-   Copyright 2018-2023 Tatsuya Yamasaki.
+   Copyright 2018-2024 Tatsuya Yamasaki.
 
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.