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

Release candidate

Author: yamacir-kit

.github/workflows/build.yaml

@@ -19,6 +19,6 @@ jobs:
       - uses: actions/checkout@v3
       - run: ./script/setup.sh --all
       - run: cmake -B build -DCMAKE_BUILD_TYPE=${{ matrix.configuration }}
-      - run: cmake --build build --target safe-install.deb
+      - run: cmake --build build --target develop
       - run: cmake -B example/build -S example -DCMAKE_BUILD_TYPE=${{ matrix.configuration }}
-      - run: cmake --build example/build --target demo
+      - run: cmake --build example/build --target develop

CMakeLists.txt

@@ -39,14 +39,6 @@ set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_B
 
 # ---- Configure ---------------------------------------------------------------
 
-if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/.git)
-  execute_process(COMMAND git rev-parse HEAD
-                  COMMAND tr -d "\n"
-                  OUTPUT_VARIABLE ${PROJECT_NAME}_VERSION_EXACT)
-else()
-  set(${PROJECT_NAME}_VERSION_EXACT "")
-endif()
-
 include(TestBigEndian)
 
 TEST_BIG_ENDIAN(IS_BIG_ENDIAN) # Use CMAKE_CXX_BYTE_ORDER if CMake >= 3.20
@@ -87,8 +79,7 @@ target_include_directories(kernel PUBLIC
   $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
   $<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}>)
 
-target_link_libraries(kernel PRIVATE stdc++fs
-                             PRIVATE ${CMAKE_DL_LIBS}
+target_link_libraries(kernel PRIVATE ${CMAKE_DL_LIBS}
                              PUBLIC gmp)
 
 set_target_properties(kernel PROPERTIES OUTPUT_NAME ${PROJECT_NAME} # Rename libkernel => libmeevax
@@ -156,15 +147,20 @@ include(CPack)
 
 enable_testing()
 
+find_program(${PROJECT_NAME}_MEMORY_CHECK_COMMAND valgrind)
+
+set(${PROJECT_NAME}_MEMORY_CHECK_COMMAND_OPTIONS --error-exitcode=1 # = EXIT_FAILURE)
+                                                 --leak-check=full
+                                                 --quiet
+                                                 --show-leak-kinds=all)
+
 file(GLOB ${PROJECT_NAME}_TEST_SS ${CMAKE_CURRENT_SOURCE_DIR}/test/*.ss)
 
 foreach(EACH IN LISTS ${PROJECT_NAME}_TEST_SS)
   get_filename_component(FILENAME ${EACH} NAME_WE)
   add_test(NAME ${FILENAME}
-           COMMAND valgrind --error-exitcode=1 # = EXIT_FAILURE
-                            --leak-check=full
-                            --quiet
-                            --show-leak-kinds=all
+           COMMAND ${${PROJECT_NAME}_MEMORY_CHECK_COMMAND}
+                   ${${PROJECT_NAME}_MEMORY_CHECK_COMMAND_OPTIONS}
                    ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/meevax
                    ${EACH})
 endforeach()
@@ -176,24 +172,22 @@ foreach(EACH IN LISTS ${PROJECT_NAME}_TEST_CPP)
   add_executable(assert-${FILENAME} ${EACH})
   target_link_libraries(assert-${FILENAME} PRIVATE kernel)
   add_test(NAME assert-${FILENAME}
-           COMMAND valgrind --error-exitcode=1 # = EXIT_FAILURE
-                            --leak-check=full
-                            --quiet
-                            --show-leak-kinds=all
+           COMMAND ${${PROJECT_NAME}_MEMORY_CHECK_COMMAND}
+                   ${${PROJECT_NAME}_MEMORY_CHECK_COMMAND_OPTIONS}
                    ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/assert-${FILENAME})
 endforeach()
 
 # ---- Additional Targets ------------------------------------------------------
 
-execute_process(COMMAND nproc OUTPUT_VARIABLE NPROC)
+execute_process(COMMAND nproc OUTPUT_VARIABLE ${PROJECT_NAME}_NPROC)
 
 add_custom_target(install.deb
-  COMMAND make -j ${NPROC}
-  COMMAND ${CMAKE_CPACK_COMMAND}
+  COMMAND ${CMAKE_MAKE_PROGRAM} -j${${PROJECT_NAME}_NPROC}
+  COMMAND ${CMAKE_MAKE_PROGRAM} package
   COMMAND sudo apt install ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}_${PROJECT_VERSION}_amd64.deb)
 
-add_custom_target(safe-install.deb
-  COMMAND make -j ${NPROC}
-  COMMAND ${CMAKE_CTEST_COMMAND} -j ${NPROC}
-  COMMAND ${CMAKE_CPACK_COMMAND}
+add_custom_target(develop
+  COMMAND ${CMAKE_MAKE_PROGRAM} -j${${PROJECT_NAME}_NPROC}
+  COMMAND ${CMAKE_MAKE_PROGRAM} test ARGS=-j${${PROJECT_NAME}_NPROC}
+  COMMAND ${CMAKE_MAKE_PROGRAM} package
   COMMAND sudo apt install ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}_${PROJECT_VERSION}_amd64.deb)

README.md

@@ -3,26 +3,37 @@
   <br/>
   <img src="https://github.com/yamacir-kit/meevax/wiki/svg/description.png" alt="A programmable programming lanugage."/>
 </p>
-<hr color=#c1ab05/>
+<hr/>
 <p align="center">
   <img src="https://github.com/yamacir-kit/meevax/actions/workflows/build.yaml/badge.svg"/>
   <img src="https://github.com/yamacir-kit/meevax/actions/workflows/release.yaml/badge.svg"/>
 </p>
 <p align="center">
-  <b><a href="#Overview" >Overview</a></b> &nbsp;|&nbsp;
-  <b><a href="#Requirements">Requirements</a></b> &nbsp;|&nbsp;
-  <b><a href="#Installation">Installation</a></b> &nbsp;|&nbsp;
-  <b><a href="#Usage">Usage</a></b> &nbsp;|&nbsp;
-  <b><a href="#License">License</a></b> &nbsp;|&nbsp;
-  <b><a href="#References">References</a></b>
+  <b>
+    <a href="#Overview">Overview</a>
+  </b>
+  &nbsp;|&nbsp;
+  <b>
+    <a href="#Installation">Installation</a>
+  </b>
+  &nbsp;|&nbsp;
+  <b>
+    <a href="#Usage">Usage</a>
+  </b>
+  &nbsp;|&nbsp;
+  <b>
+    <a href="#License">License</a>
+  </b>
+  &nbsp;|&nbsp;
+  <b>
+    <a href="#References">References</a>
+  </b>
 </p>
 
 ## Overview
 
 > Programming languages should be designed not by piling feature on top of feature, but by removing the weaknesses and restrictions that make additional features appear necessary.
-> <div align="right">
->   Revised<sup>7</sup> Report on the Algorithmic Language Scheme [1]
-> </div>
+> <div align="right">Revised<sup>7</sup> Report on the Algorithmic Language Scheme [1]</div>
 
 Meevax is an implementation of Lisp-1 programming language, supporting subset of the [Scheme](http://www.scheme-reports.org/) (R7RS) and [SRFI](https://srfi.schemers.org/)s.
 
@@ -45,76 +56,81 @@ Subset of R7RS-small.
 |--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------------------------|:------------------|
 | [  1](https://srfi.schemers.org/srfi-1/srfi-1.html)     | List Library                                           | [`(srfi 1)`](./basis/srfi-1.ss)                       |                   |
 | [  6](https://srfi.schemers.org/srfi-6/srfi-6.html)     | Basic String Ports                                     | [`(srfi 6)`](./basis/srfi-6.ss)                       | R7RS 6.13         |
+| [  4](https://srfi.schemers.org/srfi-4/srfi-4.html)     | Homogeneous numeric vector datatypes                   | [`(srfi 4)`](./basis/srfi-4.ss)                       | R7RS 6.9          |
 | [  8](https://srfi.schemers.org/srfi-8/srfi-8.html)     | receive: Binding to multiple values                    | [`(srfi 8)`](./basis/srfi-8.ss)                       |                   |
 | [  9](https://srfi.schemers.org/srfi-9/srfi-9.html)     | Defining Record Types                                  | [`(srfi 9)`](./basis/srfi-9.ss)                       | R7RS 5.5          |
 | [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html)   | #, external form                                       |                                                       |                   |
 | [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html)   | Syntax for receiving multiple values                   | [`(srfi 11)`](./basis/srfi-11.ss)                     | R7RS 4.2.2        |
 | [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html)   | Error reporting mechanism                              | [`(srfi 23)`](./basis/srfi-23.ss)                     | R7RS 6.11         |
 | [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html)   | Nested Multi-line Comments                             |                                                       | R7RS 2.2          |
+| [ 31](https://srfi.schemers.org/srfi-31/srfi-31.html)   | A special form rec for recursive evaluation            | [`(srfi 31)`](./basis/srfi-31.ss)                     |                   |
 | [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html)   | Exception Handling for Programs                        | [`(srfi 34)`](./basis/srfi-34.ss)                     | R7RS 6.11         |
 | [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html)   | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss)                     | R7RS 6.13.3       |
 | [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html)   | Parameter objects                                      | [`(srfi 39)`](./basis/srfi-39.ss)                     | R7RS 4.2.6        |
 | [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html)   | Primitives for Expressing Iterative Lazy Algorithms    | [`(srfi 45)`](./basis/srfi-45.ss)                     | R7RS 4.2.5        |
 | [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html)   | S-expression comments                                  |                                                       | R7RS 2.2          |
 | [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html)   | Lightweight testing                                    | [`(srfi 78)`](./basis/srfi-78.ss)                     | Except `check-ec` |
 | [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html)   | => in case clauses                                     |                                                       | R7RS 4.2.1        |
+| [ 98](https://srfi.schemers.org/srfi-98/srfi-98.html)   | An interface to access environment variables           | [`(srfi 98)`](./basis/srfi-98.ss)                     | R7RS 6.14         |
 | [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions                 | [`(srfi 149)`](./basis/srfi-149.ss)                   | R7RS 4.3.2        |
-| [211](https://srfi.schemers.org/srfi-211/srfi-211.html) | Scheme Macro Libraries                                 | [`(srfi 211 explicit-renaming)`](./basis/srfi-211.ss) |                   |
 
-## Requirements
+## Installation
 
-### Software
+### Requirements
 
 -   [GCC](https://gcc.gnu.org/) (>= 9.4.0) or [Clang](https://clang.llvm.org/) (>= 11.0.0)
 -   [CMake](https://cmake.org/) (>= 3.16.3)
 -   [GNU Make](http://savannah.gnu.org/projects/make)
 -   [GNU Binutils](https://www.gnu.org/software/binutils/)
 -   [GNU Multiple Precision Arithmetic Library (GMP)](https://gmplib.org/)
 
-To install the above software, it is easy to use the following script.
+### Install
 
 ``` bash
-$ ./script/setup.sh
+cmake -B build -DCMAKE_BUILD_TYPE=Release
+cd build
+make install.deb
 ```
 
-## Installation
-
-### Install
+or
 
 ``` bash
-$ cmake -B build -DCMAKE_BUILD_TYPE=Release
-$ cd build
-$ make install.deb
+cmake -B build -DCMAKE_BUILD_TYPE=Release
+cd build
+make install
 ```
 
 ### Uninstall
 
+If you installed with `make install.deb`,
+
 ``` bash
-$ sudo apt remove meevax
+sudo apt remove meevax
+```
+
+or if you installed with `make install`,
+
+``` bash
+sudo rm -rf /usr/local/bin/meevax
+sudo rm -rf /usr/local/include/meevax
+sudo rm -rf /usr/local/lib/libmeevax*
+sudo rm -rf /usr/local/share/meevax
 ```
 
 ### CMake targets
 
 | Target Name        | Description
 |--------------------|---
-| `all` (default)    | Build shared-library `libmeevax.0.4.597.so` and executable `meevax`.
-| `test`             | Test executable `meevax`.
-| `package`          | Generate debian package `meevax_0.4.597_amd64.deb`.
-| `install`          | Copy files into `/usr/local` __(1)__.
+| `all` (default)    | Build shared-library `libmeevax.0.4.653.so` and executable `meevax`
+| `test`             | Test executable `meevax`
+| `package`          | Generate debian package `meevax_0.4.653_amd64.deb`
+| `install`          | Copy files into `/usr/local`
 | `install.deb`      | `all` + `package` + `sudo apt install <meevax>.deb`
-| `safe-install.deb` | `all` + `test` + `package` + `sudo apt install <meevax>.deb`
-
-__(1)__ Meevax installed by `make install` cannot be uninstalled by the system's package manager (for example, `apt remove meevax`). You need to manually delete the following files to uninstall:
-
-- `/usr/local/bin/meevax`
-- `/usr/local/include/meevax`
-- `/usr/local/lib/libmeevax*`
-- `/usr/local/share/meevax`
 
 ## Usage
 
 ```
-Meevax Lisp 0.4.597
+Meevax Lisp 0.4.653
 
 Usage:
   meevax [option...] [file...]
@@ -129,13 +145,6 @@ Options:
 
 ```
 
-| Example                                    | Effects |
-|:-------------------------------------------|:--|
-| `$ meevax -i`                              | Start interactive session. You can exit the session by input `(exit)` or Ctrl+C or Ctrl+D.
-| `$ meevax foo.ss`                          | Evaluate a script `foo.ss`. |
-| `$ meevax -e '(+ 1 2 3)'`                  | Display `6`.
-| `$ meevax -e "(define home \"$HOME\")" -i` | Define value of shell-environment variable `$HOME` as string typed Scheme variable `home`, and then start interactive session on environment includes the variable `home`.
-
 ## License
 
 See [LICENSE](./LICENSE).
@@ -146,5 +155,6 @@ See [LICENSE](./LICENSE).
 
 ### Resources
 
-*   [TinyScheme](http://tinyscheme.sourceforge.net/)
+*   [Chibi-Scheme](https://github.com/ashinn/chibi-scheme)
 *   [SECDR-Scheme](http://www.maroon.dti.ne.jp/nagar17/mulasame/)
+*   [TinyScheme](http://tinyscheme.sourceforge.net/)

VERSION

@@ -1 +1 @@
-0.4.597
+0.4.653

basis/meevax.ss

@@ -0,0 +1,107 @@
+(define-library (meevax macro-transformer)
+  (import (only (meevax comparator) eq? eqv?)
+          (only (meevax core) begin define if lambda quote set!)
+          (only (meevax list) null?)
+          (only (meevax macro) identifier? syntactic-closure? make-syntactic-closure)
+          (only (meevax pair) cons car cdr caar cdar))
+
+  (export make-syntactic-closure
+          identifier?
+          identifier=?
+          sc-macro-transformer
+          rsc-macro-transformer
+          er-macro-transformer)
+
+  (begin (define (sc-macro-transformer f)
+           (lambda (form use-env mac-env)
+             (make-syntactic-closure mac-env '() (f form use-env))))
+
+         (define (rsc-macro-transformer f)
+           (lambda (form use-env mac-env)
+             (make-syntactic-closure use-env '() (f form mac-env))))
+
+         (define (assq x alist)
+           (if (null? alist)
+               #f
+               (if (eq? x (caar alist))
+                   (car alist)
+                   (assq x (cdr alist)))))
+
+         (define (identifier=? environment1 identifier1
+                               environment2 identifier2)
+           (eqv? (if (syntactic-closure? identifier1) identifier1 (make-syntactic-closure environment1 '() identifier1))
+                 (if (syntactic-closure? identifier2) identifier2 (make-syntactic-closure environment2 '() identifier2))))
+
+         (define (er-macro-transformer f)
+           (lambda (form use-env mac-env)
+             (define cache '())
+             (f form
+                (lambda (x)
+                  ((lambda (pare)
+                     (if pare
+                         (cdr pare)
+                         (begin (set! cache (cons (cons x (make-syntactic-closure mac-env '() x))
+                                                  cache))
+                                (cdar cache))))
+                   (assq x cache)))
+                (lambda (x y)
+                  (identifier=? use-env x use-env y)))))))
+
+(define-library (meevax continuation)
+  (import (only (meevax context) emergency-exit)
+          (only (meevax comparator) eq?)
+          (only (meevax core) begin call-with-current-continuation! current define if install lambda)
+          (only (meevax pair) caar car cdar cdr cons pair?)
+          (only (meevax list) null?))
+
+  (export call-with-current-continuation dynamic-wind exit)
+
+  (begin (define (current-dynamic-extents)
+           (current 0))
+
+         (define (install-dynamic-extents! extents)
+           (install 0 extents))
+
+         (define (dynamic-wind before thunk after) ; https://www.cs.hmc.edu/~fleck/envision/scheme48/meeting/node7.html
+           (before)
+           (install-dynamic-extents! (cons (cons before after)
+                                           (current-dynamic-extents)))
+           ((lambda (result) ; TODO let-values
+              (install-dynamic-extents! (cdr (current-dynamic-extents)))
+              (after)
+              result) ; TODO (apply values result)
+            (thunk)))
+
+         (define (call-with-current-continuation procedure)
+           (define (windup! from to)
+             (install-dynamic-extents! from)
+             (if (eq? from to)
+                 #t
+                 (if (null? from)
+                     (begin (windup! from (cdr to))
+                            ((caar to)))
+                     (if (null? to)
+                         (begin ((cdar from))
+                                (windup! (cdr from) to))
+                         (begin ((cdar from))
+                                (windup! (cdr from)
+                                         (cdr to))
+                                ((caar to))))))
+             (install-dynamic-extents! to))
+           ((lambda (dynamic-extents)
+              (call-with-current-continuation!
+                (lambda (continue)
+                  (procedure (lambda (x)
+                               (windup! (current-dynamic-extents) dynamic-extents)
+                               (continue x))))))
+            (current-dynamic-extents)))
+
+         (define (exit . xs)
+           (letrec ((for-each (lambda (f x)
+                                (if (pair? x)
+                                    (begin (f (car x))
+                                           (for-each f (cdr x)))))))
+             (for-each (lambda (before/after)
+                         ((cdr before/after)))
+                       (current-dynamic-extents))
+             (emergency-exit . xs)))))