From b8080451058e4b44af4ea2714298b15b13f68ce0 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 16 Jun 2023 21:26:13 +0900 Subject: [PATCH 01/28] Remove library `(meevax library)` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- src/kernel/library.cpp | 15 --------------- 3 files changed, 4 insertions(+), 19 deletions(-) diff --git a/README.md b/README.md index 4fbbf8d42..ccd28653e 100644 --- a/README.md +++ b/README.md @@ -122,16 +122,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.724.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.725.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.724_amd64.deb` +| `package` | Generate debian package `meevax_0.4.725_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.724 +Meevax Lisp 0.4.725 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 1c4ceb38d..cfc5d2420 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.724 +0.4.725 diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index d37ab07ec..17d7b5726 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -465,21 +465,6 @@ inline namespace kernel }); }); - define("(meevax library)", [](library & library) - { - library.define("libraries", [](let const&) - { - let xs = unit; - - for (auto&& [name, library] : libraries()) - { - xs = cons(input_string_port(name).read(), xs); - } - - return xs; - }); - }); - define("(meevax list)", [](library & library) { library.define("null?", [](let const& xs) From 121ba966b3d99b81279d1e7e7dd9388d76e465d8 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 16 Jun 2023 21:34:47 +0900 Subject: [PATCH 02/28] Rename library `(meevax macro)` to `(meevax syntactic-closure)` Signed-off-by: yamacir-kit --- README.md | 6 ++--- VERSION | 2 +- basis/meevax.ss | 4 ++-- src/kernel/library.cpp | 50 +++++++++++++++++++++--------------------- test/identifier.ss | 2 +- 5 files changed, 32 insertions(+), 32 deletions(-) diff --git a/README.md b/README.md index ccd28653e..d3516b729 100644 --- a/README.md +++ b/README.md @@ -122,16 +122,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.725.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.726.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.725_amd64.deb` +| `package` | Generate debian package `meevax_0.4.726_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.725 +Meevax Lisp 0.4.726 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index cfc5d2420..2a1e7b65b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.725 +0.4.726 diff --git a/basis/meevax.ss b/basis/meevax.ss index d883dff98..46dd21ad8 100644 --- a/basis/meevax.ss +++ b/basis/meevax.ss @@ -2,8 +2,8 @@ (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)) + (only (meevax pair) cons car cdr caar cdar) + (only (meevax syntactic-closure) identifier? syntactic-closure? make-syntactic-closure)) (export make-syntactic-closure identifier? diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 17d7b5726..cc147c28d 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -513,31 +513,6 @@ inline namespace kernel }); }); - define("(meevax macro)", [](library & library) - { - using syntactic_closure = environment::syntactic_closure; - - library.define("identifier?", [](let const& xs) - { - return xs[0].is_also(); - }); - - library.define("transformer?", [](let const& xs) - { - return xs[0].is(); - }); - - library.define("syntactic-closure?", [](let const& xs) - { - return xs[0].is(); - }); - - library.define("make-syntactic-closure", [](let const& xs) - { - return make(xs[0], xs[1], xs[2]); - }); - }); - define("(meevax number)", [](library & library) { library.define("number?", [](let const& xs) @@ -1172,6 +1147,31 @@ inline namespace kernel }); }); + define("(meevax syntactic-closure)", [](library & library) + { + using syntactic_closure = environment::syntactic_closure; + + library.define("identifier?", [](let const& xs) + { + return xs[0].is_also(); + }); + + library.define("transformer?", [](let const& xs) + { + return xs[0].is(); + }); + + library.define("syntactic-closure?", [](let const& xs) + { + return xs[0].is(); + }); + + library.define("make-syntactic-closure", [](let const& xs) + { + return make(xs[0], xs[1], xs[2]); + }); + }); + define("(meevax system)", [](library & library) { library.define("get-environment-variable", [](let const& xs) diff --git a/test/identifier.ss b/test/identifier.ss index 0a1bb8a3f..fa2a82641 100644 --- a/test/identifier.ss +++ b/test/identifier.ss @@ -1,4 +1,4 @@ -(import (only (meevax macro) syntactic-closure?) +(import (only (meevax syntactic-closure) syntactic-closure?) (meevax macro-transformer) (scheme base) (scheme process-context) From d38a7f8222d9dd3fce3bf28842108bb318c15231 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Mon, 19 Jun 2023 02:05:10 +0900 Subject: [PATCH 03/28] Add C memory model flag to `features` Signed-off-by: yamacir-kit --- CMakeLists.txt | 6 ++-- README.md | 8 ++--- VERSION | 2 +- configure/README.md | 4 +-- configure/version.cpp | 13 ++++---- include/meevax/memory/model.hpp | 41 +++++++++++++++++++++++++ src/memory/model.cpp | 54 +++++++++++++++++++++++++++++++++ 7 files changed, 113 insertions(+), 15 deletions(-) create mode 100644 include/meevax/memory/model.hpp create mode 100644 src/memory/model.cpp diff --git a/CMakeLists.txt b/CMakeLists.txt index 9323d8cbf..78fb4655c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -49,9 +49,11 @@ else() set(${PROJECT_NAME}_BYTE_ORDER "little-endian") endif() -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/configure/help.txt ${CMAKE_CURRENT_BINARY_DIR}/help.txt) +file(READ ${CMAKE_CURRENT_SOURCE_DIR}/configure/help.txt ${PROJECT_NAME}_HELP_UNCONFIGURED) -file(READ ${CMAKE_CURRENT_BINARY_DIR}/help.txt ${PROJECT_NAME}_HELP_TEXT) +string(CONFIGURE ${${PROJECT_NAME}_HELP_UNCONFIGURED} ${PROJECT_NAME}_HELP) + +string(TOLOWER ${CMAKE_SYSTEM_NAME} ${PROJECT_NAME}_SYSTEM_NAME) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/configure/version.cpp ${CMAKE_CURRENT_SOURCE_DIR}/src/kernel/version.cpp) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/configure/README.md ${CMAKE_CURRENT_SOURCE_DIR}/README.md) diff --git a/README.md b/README.md index d3516b729..29947f55f 100644 --- a/README.md +++ b/README.md @@ -56,8 +56,8 @@ Subset of R7RS-small. |--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------|:------------------| | [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | | [ 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 | +| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | | [ 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 | | | @@ -122,16 +122,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.726.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.727.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.726_amd64.deb` +| `package` | Generate debian package `meevax_0.4.727_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.726 +Meevax Lisp 0.4.727 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 2a1e7b65b..6492994e7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.726 +0.4.727 diff --git a/configure/README.md b/configure/README.md index e74cc7036..cc7d691ea 100644 --- a/configure/README.md +++ b/configure/README.md @@ -56,8 +56,8 @@ Subset of R7RS-small. |--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------|:------------------| | [ 0](https://srfi.schemers.org/srfi-0/srfi-0.html) | Feature-based conditional expansion construct | [`(srfi 0)`](./basis/srfi-0.ss) | R7RS 4.2.1 | | [ 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 | +| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 | | [ 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 | | | @@ -131,7 +131,7 @@ sudo rm -rf ${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_DATADIR}/${PROJECT_NAME} ## Usage ``` -${${PROJECT_NAME}_HELP_TEXT} +${${PROJECT_NAME}_HELP} ``` ## License diff --git a/configure/version.cpp b/configure/version.cpp index 7e6bd27ca..e97a55a13 100644 --- a/configure/version.cpp +++ b/configure/version.cpp @@ -15,6 +15,7 @@ */ #include +#include namespace meevax { @@ -22,7 +23,7 @@ inline namespace kernel { auto help() noexcept -> std::string_view { - return R"(${${PROJECT_NAME}_HELP_TEXT})"; + return R"(${${PROJECT_NAME}_HELP})"; } auto features() -> object const& @@ -32,15 +33,15 @@ inline namespace kernel make_symbol("exact-closed"), make_symbol("exact-complex"), make_symbol("ieee-float"), + make_symbol("full-unicode"), make_symbol("ratios"), make_symbol("posix"), - make_symbol("${CMAKE_SYSTEM_NAME}"), + make_symbol("${${PROJECT_NAME}_SYSTEM_NAME}"), make_symbol("${CMAKE_SYSTEM_PROCESSOR}"), - // TODO C memory model flags. + make_symbol(memory::model::name()), make_symbol("${${PROJECT_NAME}_BYTE_ORDER}"), - make_symbol("${PROJECT_NAME}"), // The name of this implementation. - make_symbol("${PROJECT_NAME}-${PROJECT_VERSION}") // The name and version of this implementation. - ); + make_symbol("${PROJECT_NAME}"), + make_symbol("${PROJECT_NAME}-${PROJECT_VERSION}")); return features; } diff --git a/include/meevax/memory/model.hpp b/include/meevax/memory/model.hpp new file mode 100644 index 000000000..cb4228dff --- /dev/null +++ b/include/meevax/memory/model.hpp @@ -0,0 +1,41 @@ +/* + Copyright 2018-2023 Tatsuya Yamasaki. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*/ + +#ifndef INCLUDED_MEEVAX_MEMORY_MODEL_HPP +#define INCLUDED_MEEVAX_MEMORY_MODEL_HPP + +namespace meevax +{ +inline namespace memory +{ + struct model + { + static constexpr char lp32[] { 1, 2, 2, 4, 4, 0 }; + static constexpr char ilp32[] { 1, 2, 4, 4, 4, 0 }; + static constexpr char llp64[] { 1, 2, 4, 4, 8, 0 }; + static constexpr char lp64[] { 1, 2, 4, 8, 8, 0 }; + static constexpr char ilp64[] { 1, 2, 8, 8, 8, 0 }; + + static constexpr char value[] { + sizeof(char), sizeof(short), sizeof(int), sizeof(long), sizeof(void *), 0 + }; + + static auto name() -> char const*; + }; +} // namespace memory +} // namespace meevax + +#endif // INCLUDED_MEEVAX_MEMORY_MODEL_HPP diff --git a/src/memory/model.cpp b/src/memory/model.cpp new file mode 100644 index 000000000..68629b50f --- /dev/null +++ b/src/memory/model.cpp @@ -0,0 +1,54 @@ +/* + Copyright 2018-2023 Tatsuya Yamasaki. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*/ + +#include +#include + +#include + +namespace meevax +{ +inline namespace memory +{ + auto model::name() -> char const* + { + if (std::strcmp(value, lp32) == 0) + { + return "lp32"; + } + else if (std::strcmp(value, ilp32) == 0) + { + return "ilp32"; + } + else if (std::strcmp(value, llp64) == 0) + { + return "llp64"; + } + else if (std::strcmp(value, lp64) == 0) + { + return "lp64"; + } + else if (std::strcmp(value, ilp64) == 0) + { + return "ilp64"; + } + else + { + throw std::logic_error("unknown C data model"); + } + } +} // namespace memory +} // namespace meevax From fa21c17b6e1445255be0a4000f3a404c6ecd5ae5 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 21 Jun 2023 04:43:16 +0900 Subject: [PATCH 04/28] Fix `identify` to handle syntactic closure represents variadic arguments Signed-off-by: yamacir-kit --- CMakeLists.txt | 9 ++--- README.md | 6 +-- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 10 ++--- test/macro-transformers.ss | 39 ++++++++++++++++++- 5 files changed, 50 insertions(+), 16 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 78fb4655c..d6134594e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -17,8 +17,6 @@ set(CMAKE_POSITION_INDEPENDENT_CODE ON) set(CMAKE_VERBOSE_MAKEFILE OFF) string(JOIN " " AGGRESSIVE_OPTIMIZATION_OPTIONS - # "-fdata-sections" - # "-ffunction-sections" # "-flto" # This optimization causes a SEGV when compiling with Clang 10. # "-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. @@ -134,15 +132,14 @@ install(FILES ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake # ---- Target package ---------------------------------------------------------- +set(CPACK_DEBIAN_FILE_NAME DEB-DEFAULT) +set(CPACK_DEBIAN_PACKAGE_MAINTAINER "Tatsuya Yamasaki") +set(CPACK_DEBIAN_PACKAGE_SHLIBDEPS ON) set(CPACK_GENERATOR DEB) set(CPACK_RESOURCE_FILE_LICENSE ${CMAKE_CURRENT_SOURCE_DIR}/LICENSE) set(CPACK_RESOURCE_FILE_README ${CMAKE_CURRENT_SOURCE_DIR}/README.md) set(CPACK_THREADS 0) -set(CPACK_DEBIAN_FILE_NAME DEB-DEFAULT) -set(CPACK_DEBIAN_PACKAGE_MAINTAINER "Tatsuya Yamasaki") -set(CPACK_DEBIAN_PACKAGE_SHLIBDEPS ON) - include(CPack) # ---- Target test ------------------------------------------------------------- diff --git a/README.md b/README.md index 29947f55f..309a1ce96 100644 --- a/README.md +++ b/README.md @@ -122,16 +122,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.727.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.728.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.727_amd64.deb` +| `package` | Generate debian package `meevax_0.4.728_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.727 +Meevax Lisp 0.4.728 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 6492994e7..c5222c87f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.727 +0.4.728 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 1f6e93500..72749840c 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -46,7 +46,7 @@ inline namespace kernel , expression { expression } {} - auto align(let const& local) const + auto align_with(let const& local) const { return append(make_list(length(local) - length(environment.as().local())), @@ -57,13 +57,13 @@ inline namespace kernel object const& continuation) const { assert(environment.is()); - return environment.as().compile(expression, align(local), continuation); + return environment.as().compile(expression, align_with(local), continuation); } auto identify(object const& local) const { assert(environment.is()); - return environment.as().identify(expression, align(local)); + return environment.as().identify(expression, align_with(local)); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -1155,7 +1155,7 @@ inline namespace kernel { auto i = identity::index(0); - for (auto outer = local; not outer.is(); ++i, outer = cdr(outer)) + for (auto outer = local; outer.is(); ++i, outer = cdr(outer)) { auto j = identity::index(0); @@ -1169,7 +1169,7 @@ inline namespace kernel { return make(make(i), make(j)); } - else if (inner.is() and eq(inner, variable)) + else if (inner.is_also() and eq(inner, variable)) { return make(make(i), make(j)); } diff --git a/test/macro-transformers.ss b/test/macro-transformers.ss index 00f121d69..6689b3abd 100644 --- a/test/macro-transformers.ss +++ b/test/macro-transformers.ss @@ -368,8 +368,45 @@ (let ((x 'inner-3)) (m)))))) => 'outer) +(check ((lambda xs + (letrec-syntax ((m (syntax-rules () + ((m) xs)))) + (let ((x 'inner)) + (m)))) + 'outer) + => '(outer)) + +(check ((lambda xs + (let ((x 'x)) + (letrec-syntax ((m (syntax-rules () + ((m) xs)))) + (let ((x 'inner)) + (m))))) + 'outer) + => '(outer)) + +; ------------------------------------------------------------------------------ + +(define f + (lambda xs + (letrec-syntax ((m (syntax-rules () + ((m) xs)))) + (m)))) + +(check (f 1 2 3) => '(1 2 3)) + +(define-syntax macro + (syntax-rules () + ((macro) + (lambda xs + (letrec-syntax ((inner-macro (syntax-rules () + ((inner-macro) xs)))) + (inner-macro)))))) + +(check ((macro) 1 2 3) => '(1 2 3)) + ; ------------------------------------------------------------------------------ (check-report) -(exit (check-passed? 44)) +(exit (check-passed? 48)) From 9150caab8737339d3c6ab7b30a8abc262b8d5acc Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 21 Jun 2023 23:53:55 +0900 Subject: [PATCH 05/28] Support R7RS-small syntax `case-lambda` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- src/main.cpp | 1 + test/r7rs.ss | 18 +++++++++--------- 4 files changed, 14 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index 309a1ce96..2f9b7eb59 100644 --- a/README.md +++ b/README.md @@ -122,16 +122,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.728.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.729.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.728_amd64.deb` +| `package` | Generate debian package `meevax_0.4.729_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.728 +Meevax Lisp 0.4.729 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index c5222c87f..c80e20000 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.728 +0.4.729 diff --git a/src/main.cpp b/src/main.cpp index 626274213..da68c9328 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -29,6 +29,7 @@ auto main(int const argc, char const* const* const argv) -> int auto&& main = interaction_environment().as(); main.declare("(scheme base)"); + main.declare("(scheme case-lambda)"); main.declare("(scheme char)"); main.declare("(scheme complex)"); main.declare("(scheme cxr)"); diff --git a/test/r7rs.ss b/test/r7rs.ss index 8110d43b1..188a46d69 100644 --- a/test/r7rs.ss +++ b/test/r7rs.ss @@ -455,16 +455,16 @@ ; ---- 4.2.9. ------------------------------------------------------------------ -; (define range -; (case-lambda -; ((e) (range 0 e)) -; ((b e) (do ((r '() (cons e r)) -; (e (- e 1) (- e 1))) -; ((< e b) r))))) +(define range + (case-lambda + ((e) (range 0 e)) + ((b e) (do ((r '() (cons e r)) + (e (- e 1) (- e 1))) + ((< e b) r))))) -; (check (range 3) => (0 1 2)) +(check (range 3) => '(0 1 2)) -; (check (range 3 5) => (3 4)) +(check (range 3 5) => '(3 4)) ; ---- 4.3.1. ------------------------------------------------------------------ @@ -1609,4 +1609,4 @@ (check-report) -(exit (check-passed? 427)) +(exit (check-passed? 429)) From faef1281de360cdaca35d83a4d3bf348e1126c79 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 22 Jun 2023 01:35:36 +0900 Subject: [PATCH 06/28] Cleanup libraries Signed-off-by: yamacir-kit --- README.md | 37 +++--------- VERSION | 2 +- basis/r7rs.ss | 144 +++++++++++++++++--------------------------- basis/srfi-38.ss | 14 +++-- configure/README.md | 31 ++-------- 5 files changed, 76 insertions(+), 152 deletions(-) diff --git a/README.md b/README.md index 2f9b7eb59..71e641e8a 100644 --- a/README.md +++ b/README.md @@ -1,34 +1,8 @@

- Meevax Lisp System + Meevax Lisp System
A programmable programming lanugage.

-
-

- - -

-

- - Overview - -  |  - - Installation - -  |  - - Usage - -  |  - - License - -  |  - - References - -

## Overview @@ -41,6 +15,9 @@ Meevax is an implementation of Lisp-1 programming language, supporting subset of Latest release is [here](https://github.com/yamacir-kit/meevax/releases). + + + ### Features - Architecture - SECD machine. @@ -122,16 +99,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.729.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.730.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.729_amd64.deb` +| `package` | Generate debian package `meevax_0.4.730_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.729 +Meevax Lisp 0.4.730 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index c80e20000..64438e266 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.729 +0.4.730 diff --git a/basis/r7rs.ss b/basis/r7rs.ss index fefa151c7..5e64f45dd 100644 --- a/basis/r7rs.ss +++ b/basis/r7rs.ss @@ -394,10 +394,6 @@ (car xs) (current-output-port)))))) -(define-library (scheme lazy) - (import (srfi 45)) - (export delay (rename lazy delay-force) force promise? (rename eager make-promise))) - (define-library (scheme case-lambda) (import (scheme base)) (export case-lambda) @@ -420,10 +416,27 @@ (cl . rest)))))) (cl (params body0 ...) ...))))))))) -(define-library (scheme inexact) - (import (only (meevax inexact) finite? infinite? nan?) - (only (scheme r5rs) exp log sin cos tan asin acos atan sqrt)) - (export finite? infinite? nan? exp log sin cos tan asin acos atan sqrt)) +(define-library (scheme char) + (import (only (meevax character) digit-value) + (only (scheme r5rs) char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case? char-upcase char-downcase string-ci=? string-ci? string-ci<=? string-ci>=?) + (only (scheme base) define string-map)) + + (export char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? + char-numeric? char-whitespace? char-upper-case? char-lower-case? + digit-value char-upcase char-downcase char-foldcase string-ci=? + string-ci? string-ci<=? string-ci>=? string-upcase + string-downcase string-foldcase) + + (begin (define char-foldcase char-downcase) + + (define (string-upcase x) + (string-map char-upcase x)) + + (define (string-downcase x) + (string-map char-downcase x)) + + (define (string-foldcase x) + (string-map char-foldcase x)))) (define-library (scheme complex) (import (meevax complex) @@ -457,60 +470,6 @@ cddar caddar cdddar cdddr cadddr cddddr)) -(define-library (scheme char) - (import (only (meevax character) digit-value) - (only (scheme r5rs) - char-ci=? - char-ci? - char-ci<=? - char-ci>=? - char-alphabetic? - char-numeric? - char-whitespace? - char-upper-case? - char-lower-case? - char-upcase - char-downcase - string-ci=? - string-ci? - string-ci<=? - string-ci>=?) - (only (scheme base) define string-map)) - - (export char-ci=? - char-ci? - char-ci<=? - char-ci>=? - char-alphabetic? - char-numeric? - char-whitespace? - char-upper-case? - char-lower-case? - digit-value - char-upcase - char-downcase - (rename char-downcase char-foldcase) - string-ci=? - string-ci? - string-ci<=? - string-ci>=? - string-upcase - string-downcase - string-foldcase) - - (begin (define (string-upcase x) - (string-map char-upcase x)) - - (define (string-downcase x) - (string-map char-downcase x)) - - (define (string-foldcase x) - (string-map char-foldcase x)))) - (define-library (scheme eval) (import (only (meevax environment) environment eval)) (export environment eval)) @@ -535,6 +494,29 @@ (thunk) (close-output-port (current-output-port)))))) +(define-library (scheme inexact) + (import (only (meevax inexact) finite? infinite? nan?) + (only (scheme r5rs) exp log sin cos tan asin acos atan sqrt)) + (export finite? infinite? nan? exp log sin cos tan asin acos atan sqrt)) + +(define-library (scheme lazy) + (import (srfi 45)) + (export delay (rename lazy delay-force) force promise? (rename eager make-promise))) + +(define-library (scheme load) + (import (only (scheme r5rs) load)) + (export load)) + +(define-library (scheme process-context) + (import (only (meevax context) command-line emergency-exit) + (only (meevax continuation) exit) + (srfi 98)) + (export command-line + exit + emergency-exit + get-environment-variable + get-environment-variables)) + (define-library (scheme read) (import (prefix (meevax read) %) (scheme base)) @@ -548,10 +530,20 @@ (import (only (meevax environment) interaction-environment)) (export interaction-environment)) +(define-library (scheme time) + (import (only (meevax time) current-jiffy jiffies-per-second) + (only (scheme base) / define inexact)) + (export current-second current-jiffy jiffies-per-second) + (begin (define (current-second) + (inexact (/ (current-jiffy) + (jiffies-per-second)))))) + (define-library (scheme write) (import (prefix (meevax write) %) (scheme base) - (srfi 38)) + (only (srfi 38) write-with-shared-structure)) + + (export write write-shared write-simple display) (begin (define (write x . port) (%write x (if (pair? port) @@ -573,28 +565,4 @@ (apply write-char x xs)) ((string? x) (apply write-string x xs)) - (else (apply write x xs))))) - - (export write write-shared write-simple display)) - -(define-library (scheme load) - (import (only (scheme r5rs) load)) - (export load)) - -(define-library (scheme process-context) - (import (only (meevax context) command-line emergency-exit) - (only (meevax continuation) exit) - (srfi 98)) - (export command-line - exit - emergency-exit - get-environment-variable - get-environment-variables)) - -(define-library (scheme time) - (import (only (meevax time) current-jiffy jiffies-per-second) - (only (scheme base) / define inexact)) - (export current-second current-jiffy jiffies-per-second) - (begin (define (current-second) - (inexact (/ (current-jiffy) - (jiffies-per-second)))))) + (else (apply write x xs)))))) diff --git a/basis/srfi-38.ss b/basis/srfi-38.ss index 9edbe2397..6e2c4bca9 100644 --- a/basis/srfi-38.ss +++ b/basis/srfi-38.ss @@ -24,6 +24,11 @@ (import (scheme r5rs) (srfi 23)) + (export write-with-shared-structure + (rename write-with-shared-structure write/ss) + read-with-shared-structure + (rename read-with-shared-structure read/ss)) + ;;; A printer that shows all sharing of substructures. Uses the Common ;;; Lisp print-circle notation: #n# refers to a previous substructure ;;; labeled with #n=. Takes O(n^2) time. @@ -115,6 +120,7 @@ (alist alist (scan (vector-ref obj i) alist))) ((= i len) alist)))) (else alist)))))) + (write-obj obj (acons 'dummy 0 (scan obj '()))) ;; We don't want to return the big alist that write-obj just returned. @@ -125,6 +131,7 @@ (if (null? optional-port) (current-input-port) (car optional-port))) (define (read-char*) (read-char port)) + (define (peek-char*) (peek-char port)) (define (looking-at? c) @@ -342,9 +349,4 @@ (if (procedure? elt) (vector-set! obj i (unthunk elt)) (fill-in-parts elt)))))))) - obj))) - - (export write-with-shared-structure - (rename write-with-shared-structure write/ss) - read-with-shared-structure - (rename read-with-shared-structure read/ss))) + obj)))) diff --git a/configure/README.md b/configure/README.md index cc7d691ea..2de5f98eb 100644 --- a/configure/README.md +++ b/configure/README.md @@ -1,34 +1,8 @@

- Meevax Lisp System + Meevax Lisp System
A programmable programming lanugage.

-
-

- - -

-

- - Overview - -  |  - - Installation - -  |  - - Usage - -  |  - - License - -  |  - - References - -

## Overview @@ -41,6 +15,9 @@ Meevax is an implementation of Lisp-1 programming language, supporting subset of Latest release is [here](https://github.com/yamacir-kit/meevax/releases). + + + ### Features - Architecture - SECD machine. From 875251c956dc111275f39b62b355d04d38f32f9a Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 22 Jun 2023 02:06:24 +0900 Subject: [PATCH 07/28] Cleanup class `collector::registration` Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- include/meevax/memory/collector.hpp | 57 +++++++++------------------- include/meevax/memory/gc_pointer.hpp | 11 ++---- 4 files changed, 24 insertions(+), 52 deletions(-) diff --git a/README.md b/README.md index 71e641e8a..6854e1ee5 100644 --- a/README.md +++ b/README.md @@ -99,16 +99,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.730.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.731.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.730_amd64.deb` +| `package` | Generate debian package `meevax_0.4.731_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.730 +Meevax Lisp 0.4.731 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 64438e266..384038890 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.730 +0.4.731 diff --git a/include/meevax/memory/collector.hpp b/include/meevax/memory/collector.hpp index d51a68b67..23b7b74ff 100644 --- a/include/meevax/memory/collector.hpp +++ b/include/meevax/memory/collector.hpp @@ -41,8 +41,11 @@ inline namespace memory { friend class collector; + protected: memory::header * header = nullptr; + explicit constexpr registration() = default; + explicit registration(memory::header * header) noexcept : header { header } { @@ -52,7 +55,15 @@ inline namespace memory } } - auto reset(memory::header * after) noexcept -> void + ~registration() noexcept + { + if (header) + { + registry.erase(this); + } + } + + auto reset(memory::header * after = nullptr) noexcept -> void { if (auto before = std::exchange(header, after); not before and after) { @@ -66,9 +77,11 @@ inline namespace memory static auto locate(void * const data) noexcept -> memory::header * { - assert(data); - - if (cache->contains(data)) // Heuristic-based optimization. + if (not data) + { + return nullptr; + } + else if (cache->contains(data)) // Heuristic-based optimization. { return cache; } @@ -81,42 +94,6 @@ inline namespace memory return nullptr; } } - - protected: - explicit constexpr registration() = default; - - explicit registration(registration const& other) noexcept - : registration { other.header } - {} - - template - explicit registration(Pointer const p) noexcept - : registration { p ? locate(p) : nullptr } - {} - - ~registration() noexcept - { - if (header) - { - registry.erase(this); - } - } - - auto reset() noexcept - { - reset(nullptr); - } - - template - auto reset(Pointer const p) noexcept -> void - { - reset(p != nullptr ? locate(p) : nullptr); - } - - auto reset(registration const& other) noexcept -> void - { - reset(other.header); - } }; protected: diff --git a/include/meevax/memory/gc_pointer.hpp b/include/meevax/memory/gc_pointer.hpp index 50feb6f61..f377615d2 100644 --- a/include/meevax/memory/gc_pointer.hpp +++ b/include/meevax/memory/gc_pointer.hpp @@ -34,17 +34,12 @@ inline namespace memory template )> explicit gc_pointer(T const& datum) : nan_boxing_pointer { datum } - , collector::registration { nan_boxing_pointer::get() } - {} - - explicit gc_pointer(nan_boxing_pointer const& datum) - : nan_boxing_pointer { datum } - , collector::registration { nan_boxing_pointer::get() } + , collector::registration { locate(nan_boxing_pointer::get()) } {} explicit gc_pointer(gc_pointer const& gcp) : nan_boxing_pointer { gcp } - , collector::registration { static_cast(gcp) } + , collector::registration { gcp.header } {} auto operator =(gc_pointer const& gcp) -> auto & @@ -56,7 +51,7 @@ inline namespace memory auto reset(gc_pointer const& gcp) -> void { nan_boxing_pointer::reset(gcp); - collector::registration::reset(static_cast(gcp)); + collector::registration::reset(gcp.header); } auto reset(std::nullptr_t = nullptr) -> void From 08e45f3ff6c4e1b056be082ab0628d5c7be7ccb2 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 22 Jun 2023 02:28:21 +0900 Subject: [PATCH 08/28] Support SRFI 16 Signed-off-by: yamacir-kit --- README.md | 7 ++++--- VERSION | 2 +- basis/r4rs.ss | 6 +++--- basis/r7rs.ss | 48 ++++++++++++++------------------------------- basis/srfi-16.ss | 22 +++++++++++++++++++++ configure/README.md | 1 + configure/basis.cpp | 5 +++-- 7 files changed, 49 insertions(+), 42 deletions(-) create mode 100644 basis/srfi-16.ss diff --git a/README.md b/README.md index 6854e1ee5..349f13e18 100644 --- a/README.md +++ b/README.md @@ -39,6 +39,7 @@ Subset of R7RS-small. | [ 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 | +| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | | [ 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) | | @@ -99,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.731.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.732.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.731_amd64.deb` +| `package` | Generate debian package `meevax_0.4.732_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.731 +Meevax Lisp 0.4.732 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 384038890..e9cd335e3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.731 +0.4.732 diff --git a/basis/r4rs.ss b/basis/r4rs.ss index 36449b5e8..a255f082b 100644 --- a/basis/r4rs.ss +++ b/basis/r4rs.ss @@ -159,7 +159,7 @@ (thunk) (set! %current-output-port previous-output-port))) - (define (char-ready? . port) - (%get-char-ready? (if (pair? port) - (car port) + (define (char-ready? . xs) + (%get-char-ready? (if (pair? xs) + (car xs) (current-input-port)))))) diff --git a/basis/r7rs.ss b/basis/r7rs.ss index 5e64f45dd..2986fe2ac 100644 --- a/basis/r7rs.ss +++ b/basis/r7rs.ss @@ -395,26 +395,8 @@ (current-output-port)))))) (define-library (scheme case-lambda) - (import (scheme base)) - (export case-lambda) - (begin (define-syntax case-lambda - (syntax-rules () - ((case-lambda (params body0 ...) ...) - (lambda args - (let ((len (length args))) - (letrec-syntax - ((cl (syntax-rules ::: () - ((cl) - (error "no matching clause")) - ((cl ((p :::) . body) . rest) - (if (= len (length '(p :::))) - (apply (lambda (p :::) . body) args) - (cl . rest))) - ((cl ((p ::: . tail) . body) . rest) - (if (>= len (length '(p :::))) - (apply (lambda (p ::: . tail) . body) args) - (cl . rest)))))) - (cl (params body0 ...) ...))))))))) + (import (srfi 16)) + (export case-lambda)) (define-library (scheme char) (import (only (meevax character) digit-value) @@ -519,11 +501,11 @@ (define-library (scheme read) (import (prefix (meevax read) %) - (scheme base)) + (only (scheme base) define if pair? car current-input-port)) (export read) - (begin (define (read . x) - (%read (if (pair? x) - (car x) + (begin (define (read . xs) + (%read (if (pair? xs) + (car xs) (current-input-port)))))) (define-library (scheme repl) @@ -545,19 +527,19 @@ (export write write-shared write-simple display) - (begin (define (write x . port) - (%write x (if (pair? port) - (car port) + (begin (define (write x . xs) + (%write x (if (pair? xs) + (car xs) (current-output-port)))) - (define (write-shared x . port) - (write-with-shared-structure x (if (pair? port) - (car port) + (define (write-shared x . xs) + (write-with-shared-structure x (if (pair? xs) + (car xs) (current-output-port)))) - (define (write-simple x . port) - (%write-simple x (if (pair? port) - (car port) + (define (write-simple x . xs) + (%write-simple x (if (pair? xs) + (car xs) (current-output-port)))) (define (display x . xs) diff --git a/basis/srfi-16.ss b/basis/srfi-16.ss new file mode 100644 index 000000000..4ffb2291c --- /dev/null +++ b/basis/srfi-16.ss @@ -0,0 +1,22 @@ +(define-library (srfi 16) + (import (only (scheme r5rs) = >= apply define-syntax error if lambda length let letrec-syntax quote syntax-rules) + (only (srfi 23) error)) + (export case-lambda) + (begin (define-syntax case-lambda + (syntax-rules () + ((case-lambda (params body0 ...) ...) + (lambda args + (let ((len (length args))) + (letrec-syntax + ((cl (syntax-rules ::: () + ((cl) + (error "no matching clause")) + ((cl ((p :::) . body) . rest) + (if (= len (length '(p :::))) + (apply (lambda (p :::) . body) args) + (cl . rest))) + ((cl ((p ::: . tail) . body) . rest) + (if (>= len (length '(p :::))) + (apply (lambda (p ::: . tail) . body) args) + (cl . rest)))))) + (cl (params body0 ...) ...))))))))) diff --git a/configure/README.md b/configure/README.md index 2de5f98eb..23cf67992 100644 --- a/configure/README.md +++ b/configure/README.md @@ -39,6 +39,7 @@ Subset of R7RS-small. | [ 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 | +| [ 16](https://srfi.schemers.org/srfi-16/srfi-16.html) | Syntax for procedures of variable arity | [`(srfi 16)`](./basis/srfi-16.ss) | R7RS 4.2.9 | | [ 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) | | diff --git a/configure/basis.cpp b/configure/basis.cpp index 0b6ce5f7c..5a83fecf3 100644 --- a/configure/basis.cpp +++ b/configure/basis.cpp @@ -35,6 +35,7 @@ inline namespace kernel R"##(${${PROJECT_NAME}_BASIS_srfi-8.ss})##", R"##(${${PROJECT_NAME}_BASIS_srfi-9.ss})##", R"##(${${PROJECT_NAME}_BASIS_srfi-11.ss})##", + R"##(${${PROJECT_NAME}_BASIS_srfi-16.ss})##", R"##(${${PROJECT_NAME}_BASIS_srfi-23.ss})##", R"##(${${PROJECT_NAME}_BASIS_srfi-31.ss})##", R"##(${${PROJECT_NAME}_BASIS_srfi-34.ss})##", @@ -46,5 +47,5 @@ inline namespace kernel R"##(${${PROJECT_NAME}_BASIS_srfi-149.ss})##", }; } -} -} +} // namespace kernel +} // namespace meevax From d0f129b78cac65465b8b5a94711cc822b8dc068b Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 24 Jun 2023 19:22:28 +0900 Subject: [PATCH 09/28] Speed up access to types derived from `pair` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- basis/srfi-16.ss | 2 +- include/meevax/kernel/closure.hpp | 4 - include/meevax/kernel/complex.hpp | 2 +- include/meevax/kernel/continuation.hpp | 8 -- include/meevax/kernel/dynamic_environment.hpp | 114 ++++++++++++++---- include/meevax/kernel/error.hpp | 2 +- include/meevax/kernel/heterogeneous.hpp | 6 +- include/meevax/kernel/identity.hpp | 8 -- .../meevax/kernel/syntactic_environment.hpp | 24 ++-- include/meevax/kernel/transformer.hpp | 4 - src/kernel/closure.cpp | 10 -- src/kernel/continuation.cpp | 5 - src/kernel/identity.cpp | 32 ----- src/kernel/library.cpp | 4 +- src/kernel/transformer.cpp | 10 -- src/memory/collector.cpp | 10 +- 18 files changed, 120 insertions(+), 133 deletions(-) diff --git a/README.md b/README.md index 349f13e18..b37bbff42 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.732.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.733.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.732_amd64.deb` +| `package` | Generate debian package `meevax_0.4.733_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.732 +Meevax Lisp 0.4.733 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index e9cd335e3..98d854412 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.732 +0.4.733 diff --git a/basis/srfi-16.ss b/basis/srfi-16.ss index 4ffb2291c..6afc35799 100644 --- a/basis/srfi-16.ss +++ b/basis/srfi-16.ss @@ -1,5 +1,5 @@ (define-library (srfi 16) - (import (only (scheme r5rs) = >= apply define-syntax error if lambda length let letrec-syntax quote syntax-rules) + (import (only (scheme r5rs) define-syntax syntax-rules lambda let length letrec-syntax error if = quote >= apply) (only (srfi 23) error)) (export case-lambda) (begin (define-syntax case-lambda diff --git a/include/meevax/kernel/closure.hpp b/include/meevax/kernel/closure.hpp index bf806d3c6..7e0c2ffa7 100644 --- a/include/meevax/kernel/closure.hpp +++ b/include/meevax/kernel/closure.hpp @@ -26,10 +26,6 @@ inline namespace kernel struct closure : public virtual pair { using pair::pair; - - auto c() const -> object const&; - - auto e() const -> object const&; }; auto operator <<(std::ostream &, closure const&) -> std::ostream &; diff --git a/include/meevax/kernel/complex.hpp b/include/meevax/kernel/complex.hpp index 0c6a29618..3b0a64a91 100644 --- a/include/meevax/kernel/complex.hpp +++ b/include/meevax/kernel/complex.hpp @@ -25,7 +25,7 @@ namespace meevax { inline namespace kernel { - struct complex : public virtual pair + struct complex : public virtual pair // ( . ) { using pair::pair; diff --git a/include/meevax/kernel/continuation.hpp b/include/meevax/kernel/continuation.hpp index 8655e7429..bfedb7fb5 100644 --- a/include/meevax/kernel/continuation.hpp +++ b/include/meevax/kernel/continuation.hpp @@ -26,14 +26,6 @@ inline namespace kernel struct continuation : public virtual pair { using pair::pair; - - auto s() const -> object const&; - - auto e() const -> object const&; - - auto c() const -> object const&; - - auto d() const -> object const&; }; auto operator <<(std::ostream &, continuation const&) -> std::ostream &; diff --git a/include/meevax/kernel/dynamic_environment.hpp b/include/meevax/kernel/dynamic_environment.hpp index ce773cf4a..a3e3c6813 100644 --- a/include/meevax/kernel/dynamic_environment.hpp +++ b/include/meevax/kernel/dynamic_environment.hpp @@ -149,28 +149,58 @@ inline namespace kernel * * s e (%load-relative . c) d => (x . s) e c d * - * where = ( i . j) + * where = (i . j) * * x = (list-ref (list-ref e i) j) * * ----------------------------------------------------------------- */ - assert(cadr(c).template is()); - s = cons(cadr(c).template as().load(e), s); - c = cddr(c); + { + let const& operand = cadr(c); + + assert(operand.is()); + + using index = relative::index; + + assert(car(operand).is()); + assert(cdr(operand).is()); + + auto i = car(operand).as(); + auto j = cdr(operand).as(); + + assert(i < length(e)); + + s = cons(head(head(e, i), j), s); + c = cddr(c); + } goto fetch; case instruction::load_variadic: /* ------------------------------------ * * s e (%load-variadic . c) d => (x . s) e c d * - * where = ( i . j) + * where = (i . j) * * x = (list-tail (list-ref e i) j) * * ----------------------------------------------------------------- */ - assert(cadr(c).template is()); - s = cons(cadr(c).template as().load(e), s); - c = cddr(c); + { + let const& operand = cadr(c); + + assert(operand.is()); + + using index = variadic::index; + + assert(car(operand).is()); + assert(cdr(operand).is()); + + auto i = car(operand).as(); + auto j = cdr(operand).as(); + + assert(i < length(e)); + + s = cons(tail(head(e, i), j), s); + c = cddr(c); + } goto fetch; case instruction::load_constant: /* ------------------------------------ @@ -256,8 +286,8 @@ inline namespace kernel { assert(tail(c, 1).template is()); d = cons(cddr(s), e, cdr(c), d); - c = callee.as().c(); - e = cons(cadr(s), callee.as().e()); + c = car(callee); + e = cons(cadr(s), cdr(callee)); s = unit; goto fetch; } @@ -284,10 +314,10 @@ inline namespace kernel { assert(tail(s, 2).template is()); assert(tail(c, 1).template is()); - s = cons(caadr(s), callee.as().s()); - e = callee.as().e(); - c = callee.as().c(); - d = callee.as().d(); + s = cons(caadr(s), car(callee)); + e = cadr(callee); + c = caddr(callee); + d = cdddr(callee); goto fetch; } else @@ -306,8 +336,8 @@ inline namespace kernel { assert(tail(s, 2).template is()); assert(tail(c, 1).template is()); - c = callee.as().c(); - e = cons(cadr(s), callee.as().e()); + c = car(callee); + e = cons(cadr(s), cdr(callee)); s = unit; goto fetch; } @@ -337,10 +367,10 @@ inline namespace kernel { assert(tail(s, 2).template is()); assert(tail(c, 1).template is()); - s = cons(caadr(s), callee.as().s()); - e = callee.as().e(); - c = callee.as().c(); - d = callee.as().d(); + s = cons(caadr(s), car(callee)); + e = cadr(callee); + c = caddr(callee); + d = cdddr(callee); goto fetch; } else @@ -435,9 +465,25 @@ inline namespace kernel * (x . s) e (%store-relative . c) d => (x . s) e c d * * ----------------------------------------------------------------- */ - assert(cadr(c).template is()); - cadr(c).template as().store(car(s), e); - c = cddr(c); + { + let const& operand = cadr(c); + + assert(operand.is()); + + using index = relative::index; + + assert(car(operand).is()); + assert(cdr(operand).is()); + + auto i = car(operand).as(); + auto j = cdr(operand).as(); + + assert(i < length(e)); + + head(head(e, i), j) = car(s); + + c = cddr(c); + } goto fetch; case instruction::store_variadic: /* ----------------------------------- @@ -445,9 +491,25 @@ inline namespace kernel * (x . s) e (%store-variadic . c) d => (x . s) e c d * * ----------------------------------------------------------------- */ - assert(cadr(c).template is()); - cadr(c).template as().store(car(s), e); - c = cddr(c); + { + let const& operand = cadr(c); + + assert(operand.is()); + + using index = variadic::index; + + assert(car(operand).is()); + assert(cdr(operand).is()); + + auto i = car(operand).as(); + auto j = cdr(operand).as(); + + assert(i < length(e)); + + tail(head(e, i), j) = car(s); + + c = cddr(c); + } goto fetch; case instruction::install: /* ------------------------------------------ diff --git a/include/meevax/kernel/error.hpp b/include/meevax/kernel/error.hpp index b9bc749a1..69e69861e 100644 --- a/include/meevax/kernel/error.hpp +++ b/include/meevax/kernel/error.hpp @@ -26,7 +26,7 @@ inline namespace kernel constexpr auto success = EXIT_SUCCESS; constexpr auto failure = EXIT_FAILURE; - struct error : public virtual pair + struct error : public virtual pair // ( . ) { using pair::pair; diff --git a/include/meevax/kernel/heterogeneous.hpp b/include/meevax/kernel/heterogeneous.hpp index bc71836d2..92297e4f3 100644 --- a/include/meevax/kernel/heterogeneous.hpp +++ b/include/meevax/kernel/heterogeneous.hpp @@ -130,7 +130,11 @@ inline namespace kernel template inline auto as() const -> decltype(auto) { - if constexpr (std::is_class_v>) + if constexpr (std::is_same_v, Top>) + { + return Pointer::operator *(); + } + else if constexpr (std::is_class_v>) { if (auto data = dynamic_cast>>(get()); data) { diff --git a/include/meevax/kernel/identity.hpp b/include/meevax/kernel/identity.hpp index cf75476c1..efedc452b 100644 --- a/include/meevax/kernel/identity.hpp +++ b/include/meevax/kernel/identity.hpp @@ -52,10 +52,6 @@ inline namespace kernel , public virtual pair // de Bruijn index { using pair::pair; - - auto load(object const&) const -> object const&; - - auto store(object const&, object &) const -> void; }; constexpr auto operator ==(relative const&, relative const&) -> bool @@ -67,10 +63,6 @@ inline namespace kernel , public virtual pair // de Bruijn index { using pair::pair; - - auto load(object const&) const -> object const&; - - auto store(object const&, object &) const -> void; }; constexpr auto operator ==(variadic const&, variadic const&) -> bool diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 72749840c..46ebc911b 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -48,9 +48,11 @@ inline namespace kernel auto align_with(let const& local) const { + assert(environment.is()); + return append(make_list(length(local) - - length(environment.as().local())), - environment.as().local()); + length(car(environment))), + car(environment)); } auto compile(object const& local, @@ -82,8 +84,8 @@ inline namespace kernel return x.expression.template is_also() and y.expression.template is_also() and - eqv(x.environment.template as().identify(x.expression, x.environment.template as().local()), - y.environment.template as().identify(y.expression, y.environment.template as().local())); + eqv(x.environment.template as().identify(x.expression, car(x.environment)), + y.environment.template as().identify(y.expression, car(y.environment))); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -360,10 +362,10 @@ inline namespace kernel { return sweep(compile, binding_specs, - cons(Environment().apply(identity.as().load().closure(), + cons(Environment().apply(car(identity.as().load()), car(form), make(local, compile.global()), - identity.as().load().syntactic_environment()), + cdr(identity.as().load())), cdr(form)), local); } @@ -874,7 +876,7 @@ inline namespace kernel let const formals = map(formal, car(expression)); - environment.as().local() = cons(formals, local); + car(environment) = cons(formals, local); return compile(cons(cons(rename("lambda"), formals, @@ -1085,13 +1087,13 @@ inline namespace kernel rules that specifies how a use of a macro is transcribed into a more primitive expression is called the transformer of the macro. */ - assert(identity.as().load().closure().is()); - assert(identity.as().load().syntactic_environment().is()); + assert(car(identity.as().load()).is()); + assert(cdr(identity.as().load()).is()); - return compile(Environment().apply(identity.as().load().closure(), + return compile(Environment().apply(car(identity.as().load()), expression, make(local, global()), - identity.as().load().syntactic_environment()), + cdr(identity.as().load())), local, continuation, ellipsis); diff --git a/include/meevax/kernel/transformer.hpp b/include/meevax/kernel/transformer.hpp index fba8328e6..47e2fea30 100644 --- a/include/meevax/kernel/transformer.hpp +++ b/include/meevax/kernel/transformer.hpp @@ -26,10 +26,6 @@ inline namespace kernel struct transformer : public virtual pair // ( . ) { using pair::pair; - - auto closure() const -> object const&; - - auto syntactic_environment() const -> object const&; }; auto operator <<(std::ostream &, transformer const&) -> std::ostream &; diff --git a/src/kernel/closure.cpp b/src/kernel/closure.cpp index 7fd39fba8..e7005ed8f 100644 --- a/src/kernel/closure.cpp +++ b/src/kernel/closure.cpp @@ -20,16 +20,6 @@ namespace meevax { inline namespace kernel { - auto closure::c() const -> object const& - { - return first; - } - - auto closure::e() const -> object const& - { - return second; - } - auto operator <<(std::ostream & os, closure const& datum) -> std::ostream & { return os << magenta("#,(") << green("closure ") << faint("#;", &datum) << magenta(")"); diff --git a/src/kernel/continuation.cpp b/src/kernel/continuation.cpp index 9f0f2fc47..af565863d 100644 --- a/src/kernel/continuation.cpp +++ b/src/kernel/continuation.cpp @@ -20,11 +20,6 @@ namespace meevax { inline namespace kernel { - auto continuation::s() const -> object const& { return car(*this); } - auto continuation::e() const -> object const& { return cadr(*this); } - auto continuation::c() const -> object const& { return caddr(*this); } - auto continuation::d() const -> object const& { return cdddr(*this); } - auto operator <<(std::ostream & os, continuation const& datum) -> std::ostream & { return os << magenta("#,(") << green("continuation ") << faint(";#", std::addressof(datum)) << magenta(")"); diff --git a/src/kernel/identity.cpp b/src/kernel/identity.cpp index 4f2f6332b..f84b6e9d3 100644 --- a/src/kernel/identity.cpp +++ b/src/kernel/identity.cpp @@ -58,37 +58,5 @@ inline namespace kernel return os << blue(datum.symbol()); } } - - auto relative::load(object const& e) const -> object const& - { - assert(first.is()); - assert(first.as() < length(e)); - assert(second.is()); - return head(head(e, first.as()), second.as()); - } - - auto relative::store(object const& x, object & e) const -> void - { - assert(first.is()); - assert(first.as() < length(e)); - assert(second.is()); - head(head(e, first.as()), second.as()) = x; - } - - auto variadic::load(object const& e) const -> object const& - { - assert(first.is()); - assert(first.as() < length(e)); - assert(second.is()); - return tail(head(e, first.as()), second.as()); - } - - auto variadic::store(object const& x, object & e) const -> void - { - assert(first.is()); - assert(first.as() < length(e)); - assert(second.is()); - tail(head(e, first.as()), second.as()) = x; - } } // namespace kernel } // namespace meevax diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index cc147c28d..e3be8b98f 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -148,12 +148,12 @@ inline namespace kernel library.define("real-part", [](let const& xs) { - return xs[0].as().real(); + return car(xs[0]); }); library.define("imag-part", [](let const& xs) { - return xs[0].as().imag(); + return cdr(xs[0]); }); }); diff --git a/src/kernel/transformer.cpp b/src/kernel/transformer.cpp index 621987c64..293435886 100644 --- a/src/kernel/transformer.cpp +++ b/src/kernel/transformer.cpp @@ -20,16 +20,6 @@ namespace meevax { inline namespace kernel { - auto transformer::closure() const -> object const& - { - return first; - } - - auto transformer::syntactic_environment() const -> object const& - { - return second; - } - auto operator <<(std::ostream & os, transformer const& datum) -> std::ostream & { return os << magenta("#,(") << green("transformer ") << faint("#;", &datum) << magenta(")"); diff --git a/src/memory/collector.cpp b/src/memory/collector.cpp index f335ac368..eec4cb395 100644 --- a/src/memory/collector.cpp +++ b/src/memory/collector.cpp @@ -69,13 +69,13 @@ inline namespace memory auto is_root_object = [begin = std::begin(headers)](registration * given) { /* - If the given `registration` is a non-root object, then an object - containing this `registration` as a data member exists somewhere in + If the given registration is a non-root object, then an object + containing this registration as a data member exists somewhere in memory. - Containing the `registration` as a data member means that the address - of the `registration` is contained in the interval of the object's - base-address ~ base-address + object-size. The `header` is present to + Containing the registration as a data member means that the address of + the registration is contained in the interval of the object's + base-address ~ base-address + object-size. The header is present to keep track of the base-address and size of the object needed here. */ auto iter = headers.lower_bound(reinterpret_cast
(given)); From 30c665c9d52e5c9f5c618f51d00c8d2b7f87561e Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 25 Jun 2023 14:03:30 +0900 Subject: [PATCH 10/28] Update `syntactic_closure::operator ==` to use its own `identify` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- basis/r4rs.ss | 16 +++++++++------- include/meevax/kernel/syntactic_environment.hpp | 6 +++--- 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/README.md b/README.md index b37bbff42..5358c7028 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.733.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.734.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.733_amd64.deb` +| `package` | Generate debian package `meevax_0.4.734_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.733 +Meevax Lisp 0.4.734 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 98d854412..4c9c35a30 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.733 +0.4.734 diff --git a/basis/r4rs.ss b/basis/r4rs.ss index a255f082b..b5ffba899 100644 --- a/basis/r4rs.ss +++ b/basis/r4rs.ss @@ -84,14 +84,16 @@ (else (inexact (denominator (exact x)))))) (define (rationalize x e) ; from Chibi-Scheme lib/scheme/extras.scm (https://ml.cddddr.org/scheme/msg01498.html) - (define (sr x y return) + (define (simplest-rational x y return) (let ((fx (floor x)) (fy (floor y))) - (cond ((>= fx x) (return fx 1)) - ((= fx fy) (sr (/ (- y fy)) - (/ (- x fx)) - (lambda (n d) - (return (+ d (* fx n)) n)))) + (cond ((>= fx x) + (return fx 1)) + ((= fx fy) + (simplest-rational (/ (- y fy)) + (/ (- x fx)) + (lambda (n d) + (return (+ d (* fx n)) n)))) (else (return (+ fx 1) 1))))) (let ((return (if (negative? x) (lambda (num den) @@ -99,7 +101,7 @@ /)) (x (abs x)) (e (abs e))) - (sr (- x e) (+ x e) return))) + (simplest-rational (- x e) (+ x e) return))) (define (make-rectangular x y) (+ x (* y (sqrt -1)))) diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 46ebc911b..fb2fa57cc 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -84,8 +84,8 @@ inline namespace kernel return x.expression.template is_also() and y.expression.template is_also() and - eqv(x.environment.template as().identify(x.expression, car(x.environment)), - y.environment.template as().identify(y.expression, car(y.environment))); + eqv(x.identify(car(x.environment)), + y.identify(car(y.environment))); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -1054,7 +1054,7 @@ inline namespace kernel } else if (expression.is()) { - if (let const& identity = std::as_const(*this).identify(expression, local); is_truthy(identity)) // The syntactic-closure is a variable + if (let const& identity = std::as_const(*this).identify(expression, local); is_truthy(identity)) // The syntactic-closure is an alias { return syntax::reference(*this, expression, local, continuation, ellipsis); } From 4879cdea43b2126f13a5dbbec19c0aea62d93b3e Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 25 Jun 2023 14:57:01 +0900 Subject: [PATCH 11/28] Change 4th argument of `compile` to a bool value of tail context or not Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 50 +++++++++---------- 3 files changed, 29 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index 5358c7028..63ff48f58 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.734.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.735.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.734_amd64.deb` +| `package` | Generate debian package `meevax_0.4.735_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.734 +Meevax Lisp 0.4.735 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 4c9c35a30..498bb1ce3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.734 +0.4.735 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index fb2fa57cc..d450f49db 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -134,7 +134,7 @@ inline namespace kernel object const& /* expression */, object const& /* local */, object const& /* continuation */, - object const& /* ellipsis */) -> object>; + bool /* tail */) -> object>; std::string const name; @@ -155,7 +155,7 @@ inline namespace kernel object const& expression, \ [[maybe_unused]] object const& local, \ object const& continuation, \ - [[maybe_unused]] object const& ellipsis = unspecified) -> object + [[maybe_unused]] bool tail = false) -> object static COMPILER(reference) /* -------------------------------------------- * @@ -266,8 +266,8 @@ inline namespace kernel local, compile(car(expression), local, - ellipsis.is() ? list(make(instruction::tail_call)) - : cons(make(instruction::call), continuation))); + tail ? list(make(instruction::tail_call)) + : cons(make(instruction::call), continuation))); } static COMPILER(operand) @@ -473,7 +473,7 @@ inline namespace kernel make_list(length(binding_specs), unit)), local, continuation, - unit); + true); } else { @@ -485,7 +485,7 @@ inline namespace kernel cdr(sequence), local, continuation)), - cdr(sequence)); + cdr(sequence).template is()); } } @@ -507,7 +507,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (ellipsis.is()) + if (tail) { assert(lexical_cast(continuation) == "(return)"); @@ -517,11 +517,11 @@ inline namespace kernel compile(cadr(expression), local, continuation, - ellipsis), + tail), cddr(expression) ? compile(caddr(expression), local, continuation, - ellipsis) + tail) : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. make(instruction::return_)))); } @@ -606,7 +606,7 @@ inline namespace kernel meevax::include(expression), local, continuation, - ellipsis); + tail); } static COMPILER(include_case_insensitive) @@ -615,7 +615,7 @@ inline namespace kernel meevax::include(expression, false), local, continuation, - ellipsis); + tail); } static COMPILER(implementation_dependent) /* ----------------------------- @@ -667,7 +667,7 @@ inline namespace kernel meevax::implementation_dependent(expression), local, continuation, - ellipsis); + tail); } static COMPILER(letrec) /* ----------------------------------------------- @@ -704,7 +704,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - assert(not ellipsis.is() or lexical_cast(continuation) == "(return)"); + assert(not tail or lexical_cast(continuation) == "(return)"); let const formals = map(car, car(expression)); @@ -715,8 +715,8 @@ inline namespace kernel lambda(compile, cons(formals, cdr(expression)), // ( ) local, - ellipsis.is() ? list(make(instruction::tail_letrec)) - : cons(make(instruction::letrec), continuation)))); + tail ? list(make(instruction::tail_letrec)) + : cons(make(instruction::letrec), continuation)))); } // NOTE: Binding constructs other than letrec are implemented as macros. @@ -767,7 +767,7 @@ inline namespace kernel return compile(car(expression), local, continuation, - ellipsis); + tail); } else if (let const head = compile(car(expression), // Head expression or definition local, @@ -778,7 +778,7 @@ inline namespace kernel cdr(expression), // rest expressions local, continuation, - ellipsis); + tail); } else { @@ -788,7 +788,7 @@ inline namespace kernel cdr(expression), // Rest expression or definitions local, continuation, - ellipsis))); + tail))); } } @@ -991,7 +991,7 @@ inline namespace kernel compile(car(expression), local, list(make(instruction::tail_call)), // The first argument passed to call-with-current-continuation must be called via a tail call. - ellipsis)); + tail)); } static COMPILER(current) /* ---------------------------------------------- @@ -1022,7 +1022,7 @@ inline namespace kernel auto operator ()(object const& expression, object const& local, object const& continuation = list(make(instruction::stop)), - object const& ellipsis = unspecified) -> object + bool tail = false) -> object { if (expression.is()) /* -------------------------------------------- * @@ -1050,13 +1050,13 @@ inline namespace kernel { if (expression.is()) { - return syntax::reference(*this, expression, local, continuation, ellipsis); + return syntax::reference(*this, expression, local, continuation, tail); } else if (expression.is()) { if (let const& identity = std::as_const(*this).identify(expression, local); is_truthy(identity)) // The syntactic-closure is an alias { - return syntax::reference(*this, expression, local, continuation, ellipsis); + return syntax::reference(*this, expression, local, continuation, tail); } else // The syntactic-closure is a syntactic-keyword. { @@ -1096,16 +1096,16 @@ inline namespace kernel cdr(identity.as().load())), local, continuation, - ellipsis); + tail); } else if (identity.is() and identity.as().load().is()) { - return identity.as().load().compile(*this, cdr(expression), local, continuation, ellipsis); + return identity.as().load().compile(*this, cdr(expression), local, continuation, tail); } else { - return syntax::call(*this, expression, local, continuation, ellipsis); + return syntax::call(*this, expression, local, continuation, tail); } } From 9308e4468c11db47725143f9ee83694a21e47c7d Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 28 Jun 2023 23:32:27 +0900 Subject: [PATCH 12/28] Update compiler to receive free-names of syntactic-closure as argument Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 123 +++++++++++++----- src/kernel/environment.cpp | 4 +- src/kernel/export_spec.cpp | 4 +- src/kernel/import_set.cpp | 2 +- 6 files changed, 97 insertions(+), 44 deletions(-) diff --git a/README.md b/README.md index 63ff48f58..74b6974ed 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.735.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.736.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.735_amd64.deb` +| `package` | Generate debian package `meevax_0.4.736_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.735 +Meevax Lisp 0.4.736 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 498bb1ce3..7258d3c9b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.735 +0.4.736 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index d450f49db..0072acc3e 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -56,16 +56,23 @@ inline namespace kernel } auto compile(object const& local, + object const& free_variables, object const& continuation) const { assert(environment.is()); - return environment.as().compile(expression, align_with(local), continuation); + return environment.as().compile(expression, + align_with(local), + append(this->free_variables, free_variables), + continuation); } - auto identify(object const& local) const + auto identify(object const& local, + object const& free_variables) const { assert(environment.is()); - return environment.as().identify(expression, align_with(local)); + return environment.as().identify(expression, + align_with(local), + append(this->free_variables, free_variables)); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -84,8 +91,8 @@ inline namespace kernel return x.expression.template is_also() and y.expression.template is_also() and - eqv(x.identify(car(x.environment)), - y.identify(car(y.environment))); + eqv(x.identify(car(x.environment), x.free_variables), + y.identify(car(y.environment), y.free_variables)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -131,10 +138,11 @@ inline namespace kernel struct syntax { using compiler = std::function object>; + object const& /* expression */, + object const& /* local */, + object const& /* free_variables */, + object const& /* continuation */, + bool /* tail */) -> object>; std::string const name; @@ -154,6 +162,7 @@ inline namespace kernel auto NAME([[maybe_unused]] syntactic_environment & compile, \ object const& expression, \ [[maybe_unused]] object const& local, \ + [[maybe_unused]] object const& free_variables, \ object const& continuation, \ [[maybe_unused]] bool tail = false) -> object @@ -170,7 +179,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (let const& identity = compile.identify(expression, local); identity.is()) + if (let const& identity = compile.identify(expression, local, free_variables); identity.is()) { return cons(make(instruction::load_relative), identity, continuation); @@ -264,8 +273,10 @@ inline namespace kernel return operand(compile, cdr(expression), local, + free_variables, compile(car(expression), local, + free_variables, tail ? list(make(instruction::tail_call)) : cons(make(instruction::call), continuation))); } @@ -277,14 +288,16 @@ inline namespace kernel return operand(compile, cdr(expression), local, + free_variables, compile(car(expression), local, + free_variables, cons(make(instruction::cons), continuation))); } else { - return compile(expression, local, continuation); + return compile(expression, local, free_variables, continuation); } } @@ -343,6 +356,7 @@ inline namespace kernel body(compile, cdr(expression), cons(car(expression), local), // Extend scope. + free_variables, list(make(instruction::return_))), continuation); } @@ -350,13 +364,14 @@ inline namespace kernel static auto sweep(syntactic_environment const& compile, // This function must not call compile. object const& binding_specs, object const& form, - object const& local) -> pair + object const& local, + object const& free_variables) -> pair { if (not form.is() or not car(form).is()) { return pair(reverse(binding_specs), form); // Finish. } - else if (let const& identity = compile.identify(caar(form), local); + else if (let const& identity = compile.identify(caar(form), local, free_variables); identity.is() and identity.as().load().is()) { @@ -367,7 +382,8 @@ inline namespace kernel make(local, compile.global()), cdr(identity.as().load())), cdr(form)), - local); + local, + free_variables); } else if (identity.is() and identity.as().load().is() and @@ -382,14 +398,16 @@ inline namespace kernel cddr(definition))), // binding_specs), cdr(form), - local); + local, + free_variables); } else //
= ((define ) *) { return sweep(compile, cons(cdr(definition), binding_specs), cdr(form), - local); + local, + free_variables); } } else if (identity.is() and @@ -399,7 +417,8 @@ inline namespace kernel return sweep(compile, binding_specs, append(cdar(form), cdr(form)), - local); + local, + free_variables); } else { @@ -450,7 +469,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (auto const& [binding_specs, sequence] = sweep(compile, unit, expression, local); binding_specs) + if (auto const& [binding_specs, sequence] = sweep(compile, unit, expression, local, free_variables); binding_specs) { /* (letrec* ) @@ -472,6 +491,7 @@ inline namespace kernel sequence)), make_list(length(binding_specs), unit)), local, + free_variables, continuation, true); } @@ -479,11 +499,13 @@ inline namespace kernel { return compile(car(sequence), local, + free_variables, cdr(sequence).template is() ? continuation : cons(make(instruction::drop), body(compile, cdr(sequence), local, + free_variables, continuation)), cdr(sequence).template is()); } @@ -513,13 +535,16 @@ inline namespace kernel return compile(car(expression), // local, + free_variables, list(make(instruction::tail_select), compile(cadr(expression), local, + free_variables, continuation, tail), cddr(expression) ? compile(caddr(expression), local, + free_variables, continuation, tail) : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. @@ -529,12 +554,15 @@ inline namespace kernel { return compile(car(expression), // local, + free_variables, cons(make(instruction::select), compile(cadr(expression), local, + free_variables, list(make(instruction::join))), cddr(expression) ? compile(caddr(expression), local, + free_variables, list(make(instruction::join))) : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. make(instruction::join)), @@ -556,10 +584,11 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (let const& identity = compile.identify(car(expression), local); identity.is()) + if (let const& identity = compile.identify(car(expression), local, free_variables); identity.is()) { return compile(cadr(expression), local, + free_variables, cons(make(instruction::store_relative), identity, continuation)); } @@ -567,14 +596,17 @@ inline namespace kernel { return compile(cadr(expression), local, + free_variables, cons(make(instruction::store_variadic), identity, continuation)); } else { assert(identity.is()); + return compile(cadr(expression), local, + free_variables, cons(make(instruction::store_absolute), identity, continuation)); } @@ -605,6 +637,7 @@ inline namespace kernel return sequence(compile, meevax::include(expression), local, + free_variables, continuation, tail); } @@ -614,6 +647,7 @@ inline namespace kernel return sequence(compile, meevax::include(expression, false), local, + free_variables, continuation, tail); } @@ -666,6 +700,7 @@ inline namespace kernel return sequence(compile, meevax::implementation_dependent(expression), local, + free_variables, continuation, tail); } @@ -712,9 +747,11 @@ inline namespace kernel operand(compile, map(cadr, car(expression)), cons(formals, local), + free_variables, lambda(compile, cons(formals, cdr(expression)), // ( ) local, + free_variables, tail ? list(make(instruction::tail_letrec)) : cons(make(instruction::letrec), continuation)))); } @@ -766,17 +803,20 @@ inline namespace kernel { return compile(car(expression), local, + free_variables, continuation, tail); } else if (let const head = compile(car(expression), // Head expression or definition local, + free_variables, unit); head.is()) // The syntax define-syntax creates a transformer from transformer-spec at compile time and registers it in the global environment. The syntax define-syntax is effectively a compile-time side-effect of the syntax environment and does nothing at run-time. { return sequence(compile, cdr(expression), // rest expressions local, + free_variables, continuation, tail); } @@ -787,6 +827,7 @@ inline namespace kernel sequence(compile, cdr(expression), // Rest expression or definitions local, + free_variables, continuation, tail))); } @@ -843,6 +884,7 @@ inline namespace kernel cdr(expression)), // unit), // dummy local, + free_variables, continuation); } @@ -883,6 +925,7 @@ inline namespace kernel cdr(expression)), // unit), // dummy local, + free_variables, continuation); } @@ -915,14 +958,16 @@ inline namespace kernel { return compile(cons(rename("lambda"), cdar(expression), cdr(expression)), local, - cons(make(instruction::store_absolute), compile.identify(caar(expression), local), + free_variables, + cons(make(instruction::store_absolute), compile.identify(caar(expression), local, free_variables), continuation)); } else // (define ) { return compile(cdr(expression) ? cadr(expression) : unspecified, local, - cons(make(instruction::store_absolute), compile.identify(car(expression), local), + free_variables, + cons(make(instruction::store_absolute), compile.identify(car(expression), local, free_variables), continuation)); } } @@ -965,7 +1010,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - compile.identify(car(expression), unit) + compile.identify(car(expression), unit, unit) .template as() .store(make(Environment().execute(compile(cadr(expression), local)), make(local, compile.global()))); @@ -990,6 +1035,7 @@ inline namespace kernel continuation, compile(car(expression), local, + free_variables, list(make(instruction::tail_call)), // The first argument passed to call-with-current-continuation must be called via a tail call. tail)); } @@ -1012,6 +1058,7 @@ inline namespace kernel { return compile(cadr(expression), local, + free_variables, cons(make(instruction::install), car(expression), continuation)); } @@ -1021,6 +1068,7 @@ inline namespace kernel auto operator ()(object const& expression, object const& local, + object const& free_variables = unit, object const& continuation = list(make(instruction::stop)), bool tail = false) -> object { @@ -1050,17 +1098,17 @@ inline namespace kernel { if (expression.is()) { - return syntax::reference(*this, expression, local, continuation, tail); + return syntax::reference(*this, expression, local, free_variables, continuation, tail); } else if (expression.is()) { - if (let const& identity = std::as_const(*this).identify(expression, local); is_truthy(identity)) // The syntactic-closure is an alias + if (let const& identity = std::as_const(*this).identify(expression, local, free_variables); is_truthy(identity)) // The syntactic-closure is an alias { - return syntax::reference(*this, expression, local, continuation, tail); + return syntax::reference(*this, expression, local, free_variables, continuation, tail); } else // The syntactic-closure is a syntactic-keyword. { - return expression.as().compile(local, continuation); + return expression.as().compile(local, free_variables, continuation); } } else // is @@ -1068,7 +1116,7 @@ inline namespace kernel return cons(make(instruction::load_constant), expression, continuation); } } - else if (let const& identity = std::as_const(*this).identify(car(expression), local); + else if (let const& identity = std::as_const(*this).identify(car(expression), local, free_variables); identity.is() and identity.as().load().is()) { @@ -1095,17 +1143,18 @@ inline namespace kernel make(local, global()), cdr(identity.as().load())), local, + free_variables, continuation, tail); } else if (identity.is() and identity.as().load().is()) { - return identity.as().load().compile(*this, cdr(expression), local, continuation, tail); + return identity.as().load().compile(*this, cdr(expression), local, free_variables, continuation, tail); } else { - return syntax::call(*this, expression, local, continuation, tail); + return syntax::call(*this, expression, local, free_variables, continuation, tail); } } @@ -1120,8 +1169,8 @@ inline namespace kernel auto define(object const& variable, object const& value = undefined) -> void { assert(local().template is()); - assert(identify(variable, unit).template is()); - return identify(variable, unit).template as().store(value); + assert(identify(variable, unit, unit).template is()); + return identify(variable, unit, unit).template as().store(value); } template @@ -1147,7 +1196,9 @@ inline namespace kernel return second; } - auto identify(object const& variable, object const& local) const -> object + auto identify(object const& variable, + object const& local, + object const& free_variables) const -> object { if (not variable.is_also()) { @@ -1180,7 +1231,7 @@ inline namespace kernel if (variable.is()) { - return variable.as().identify(local); + return variable.as().identify(local, free_variables); } else { @@ -1189,13 +1240,15 @@ inline namespace kernel } } - auto identify(object const& variable, object const& local) + auto identify(object const& variable, + object const& local, + object const& free_variables) { if (not variable.is_also()) { return f; } - else if (let const& identity = std::as_const(*this).identify(variable, local); is_truthy(identity)) + else if (let const& identity = std::as_const(*this).identify(variable, local, free_variables); is_truthy(identity)) { return identity; } diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 45e991470..74b473f7f 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -128,8 +128,8 @@ inline namespace kernel { assert(local().is()); assert(e.is()); - assert(identify(variable, unit).is()); - return identify(variable, unit).as().load(); + assert(identify(variable, unit, unit).is()); + return identify(variable, unit, unit).as().load(); } auto environment::operator [](std::string const& variable) -> object const& diff --git a/src/kernel/export_spec.cpp b/src/kernel/export_spec.cpp index 0ffbfa202..155217a98 100644 --- a/src/kernel/export_spec.cpp +++ b/src/kernel/export_spec.cpp @@ -36,12 +36,12 @@ inline namespace kernel assert(form[0].as() == "rename"); assert(form[1].is_also()); assert(form[2].is_also()); - return make(form[2], library.identify(form[1], unit)); + return make(form[2], library.identify(form[1], unit, unit)); } else { assert(form.is_also()); - return library.identify(form, unit); + return library.identify(form, unit, unit); } }; diff --git a/src/kernel/import_set.cpp b/src/kernel/import_set.cpp index 92da9ddb2..b08face05 100644 --- a/src/kernel/import_set.cpp +++ b/src/kernel/import_set.cpp @@ -144,7 +144,7 @@ inline namespace kernel { assert(identity.is()); - if (let const& variable = identity.as().symbol(); eq(std::as_const(e).identify(variable, e.local()), f) or redefinable) + if (let const& variable = identity.as().symbol(); eq(std::as_const(e).identify(variable, e.local(), unit), f) or redefinable) { e.define(identity.as().symbol(), identity.as().load()); } From 662bb7db825be507e8fcb92f4e21539e95fa401a Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 00:28:04 +0900 Subject: [PATCH 13/28] Rename compiler's argument `local` to `bound_variables` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 158 +++++++++--------- 3 files changed, 83 insertions(+), 83 deletions(-) diff --git a/README.md b/README.md index 74b6974ed..f76e8b1f8 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.736.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.737.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.736_amd64.deb` +| `package` | Generate debian package `meevax_0.4.737_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.736 +Meevax Lisp 0.4.737 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 7258d3c9b..fd99ec14d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.736 +0.4.737 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 0072acc3e..e82cb6c2f 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -46,32 +46,32 @@ inline namespace kernel , expression { expression } {} - auto align_with(let const& local) const + auto align_with(let const& bound_variables) const { assert(environment.is()); - return append(make_list(length(local) - + return append(make_list(length(bound_variables) - length(car(environment))), car(environment)); } - auto compile(object const& local, + auto compile(object const& bound_variables, object const& free_variables, object const& continuation) const { assert(environment.is()); return environment.as().compile(expression, - align_with(local), + align_with(bound_variables), append(this->free_variables, free_variables), continuation); } - auto identify(object const& local, + auto identify(object const& bound_variables, object const& free_variables) const { assert(environment.is()); return environment.as().identify(expression, - align_with(local), + align_with(bound_variables), append(this->free_variables, free_variables)); } @@ -138,11 +138,11 @@ inline namespace kernel struct syntax { using compiler = std::function object>; + object const& /* expression */, + object const& /* bound_variables */, + object const& /* free_variables */, + object const& /* continuation */, + bool /* tail */) -> object>; std::string const name; @@ -161,7 +161,7 @@ inline namespace kernel #define COMPILER(NAME) \ auto NAME([[maybe_unused]] syntactic_environment & compile, \ object const& expression, \ - [[maybe_unused]] object const& local, \ + [[maybe_unused]] object const& bound_variables, \ [[maybe_unused]] object const& free_variables, \ object const& continuation, \ [[maybe_unused]] bool tail = false) -> object @@ -179,7 +179,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (let const& identity = compile.identify(expression, local, free_variables); identity.is()) + if (let const& identity = compile.identify(expression, bound_variables, free_variables); identity.is()) { return cons(make(instruction::load_relative), identity, continuation); @@ -272,10 +272,10 @@ inline namespace kernel { return operand(compile, cdr(expression), - local, + bound_variables, free_variables, compile(car(expression), - local, + bound_variables, free_variables, tail ? list(make(instruction::tail_call)) : cons(make(instruction::call), continuation))); @@ -287,17 +287,17 @@ inline namespace kernel { return operand(compile, cdr(expression), - local, + bound_variables, free_variables, compile(car(expression), - local, + bound_variables, free_variables, cons(make(instruction::cons), continuation))); } else { - return compile(expression, local, free_variables, continuation); + return compile(expression, bound_variables, free_variables, continuation); } } @@ -355,7 +355,7 @@ inline namespace kernel return cons(make(instruction::load_closure), body(compile, cdr(expression), - cons(car(expression), local), // Extend scope. + cons(car(expression), bound_variables), // Extend scope. free_variables, list(make(instruction::return_))), continuation); @@ -364,14 +364,14 @@ inline namespace kernel static auto sweep(syntactic_environment const& compile, // This function must not call compile. object const& binding_specs, object const& form, - object const& local, + object const& bound_variables, object const& free_variables) -> pair { if (not form.is() or not car(form).is()) { return pair(reverse(binding_specs), form); // Finish. } - else if (let const& identity = compile.identify(caar(form), local, free_variables); + else if (let const& identity = compile.identify(caar(form), bound_variables, free_variables); identity.is() and identity.as().load().is()) { @@ -379,10 +379,10 @@ inline namespace kernel binding_specs, cons(Environment().apply(car(identity.as().load()), car(form), - make(local, compile.global()), + make(bound_variables, compile.global()), cdr(identity.as().load())), cdr(form)), - local, + bound_variables, free_variables); } else if (identity.is() and @@ -398,7 +398,7 @@ inline namespace kernel cddr(definition))), // binding_specs), cdr(form), - local, + bound_variables, free_variables); } else // = ((define ) *) @@ -406,7 +406,7 @@ inline namespace kernel return sweep(compile, cons(cdr(definition), binding_specs), cdr(form), - local, + bound_variables, free_variables); } } @@ -417,7 +417,7 @@ inline namespace kernel return sweep(compile, binding_specs, append(cdar(form), cdr(form)), - local, + bound_variables, free_variables); } else @@ -469,7 +469,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (auto const& [binding_specs, sequence] = sweep(compile, unit, expression, local, free_variables); binding_specs) + if (auto const& [binding_specs, sequence] = sweep(compile, unit, expression, bound_variables, free_variables); binding_specs) { /* (letrec* ) @@ -490,7 +490,7 @@ inline namespace kernel append(map(assignment, binding_specs), sequence)), make_list(length(binding_specs), unit)), - local, + bound_variables, free_variables, continuation, true); @@ -498,13 +498,13 @@ inline namespace kernel else { return compile(car(sequence), - local, + bound_variables, free_variables, cdr(sequence).template is() ? continuation : cons(make(instruction::drop), body(compile, cdr(sequence), - local, + bound_variables, free_variables, continuation)), cdr(sequence).template is()); @@ -534,16 +534,16 @@ inline namespace kernel assert(lexical_cast(continuation) == "(return)"); return compile(car(expression), // - local, + bound_variables, free_variables, list(make(instruction::tail_select), compile(cadr(expression), - local, + bound_variables, free_variables, continuation, tail), cddr(expression) ? compile(caddr(expression), - local, + bound_variables, free_variables, continuation, tail) @@ -553,15 +553,15 @@ inline namespace kernel else { return compile(car(expression), // - local, + bound_variables, free_variables, cons(make(instruction::select), compile(cadr(expression), - local, + bound_variables, free_variables, list(make(instruction::join))), cddr(expression) ? compile(caddr(expression), - local, + bound_variables, free_variables, list(make(instruction::join))) : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. @@ -584,10 +584,10 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (let const& identity = compile.identify(car(expression), local, free_variables); identity.is()) + if (let const& identity = compile.identify(car(expression), bound_variables, free_variables); identity.is()) { return compile(cadr(expression), - local, + bound_variables, free_variables, cons(make(instruction::store_relative), identity, continuation)); @@ -595,7 +595,7 @@ inline namespace kernel else if (identity.is()) { return compile(cadr(expression), - local, + bound_variables, free_variables, cons(make(instruction::store_variadic), identity, continuation)); @@ -605,7 +605,7 @@ inline namespace kernel assert(identity.is()); return compile(cadr(expression), - local, + bound_variables, free_variables, cons(make(instruction::store_absolute), identity, continuation)); @@ -636,7 +636,7 @@ inline namespace kernel { return sequence(compile, meevax::include(expression), - local, + bound_variables, free_variables, continuation, tail); @@ -646,7 +646,7 @@ inline namespace kernel { return sequence(compile, meevax::include(expression, false), - local, + bound_variables, free_variables, continuation, tail); @@ -699,7 +699,7 @@ inline namespace kernel { return sequence(compile, meevax::implementation_dependent(expression), - local, + bound_variables, free_variables, continuation, tail); @@ -746,11 +746,11 @@ inline namespace kernel return cons(make(instruction::dummy), operand(compile, map(cadr, car(expression)), - cons(formals, local), + cons(formals, bound_variables), free_variables, lambda(compile, cons(formals, cdr(expression)), // ( ) - local, + bound_variables, free_variables, tail ? list(make(instruction::tail_letrec)) : cons(make(instruction::letrec), continuation)))); @@ -802,20 +802,20 @@ inline namespace kernel if (cdr(expression).is()) // is tail sequence { return compile(car(expression), - local, + bound_variables, free_variables, continuation, tail); } else if (let const head = compile(car(expression), // Head expression or definition - local, + bound_variables, free_variables, unit); head.is()) // The syntax define-syntax creates a transformer from transformer-spec at compile time and registers it in the global environment. The syntax define-syntax is effectively a compile-time side-effect of the syntax environment and does nothing at run-time. { return sequence(compile, cdr(expression), // rest expressions - local, + bound_variables, free_variables, continuation, tail); @@ -826,7 +826,7 @@ inline namespace kernel cons(make(instruction::drop), // Pop result of head expression sequence(compile, cdr(expression), // Rest expression or definitions - local, + bound_variables, free_variables, continuation, tail))); @@ -869,13 +869,13 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - let const environment = make(local, compile.global()); + let const environment = make(bound_variables, compile.global()); auto formal = [&](let const& syntax_spec) { return make(car(syntax_spec), // make(Environment().execute(compile(cadr(syntax_spec), // - local)), + bound_variables)), environment)); }; @@ -883,7 +883,7 @@ inline namespace kernel map(formal, car(expression)), // cdr(expression)), // unit), // dummy - local, + bound_variables, free_variables, continuation); } @@ -912,19 +912,19 @@ inline namespace kernel { return make(car(syntax_spec), // make(Environment().execute(compile(cadr(syntax_spec), // - local)), + bound_variables)), environment)); }; let const formals = map(formal, car(expression)); - car(environment) = cons(formals, local); + car(environment) = cons(formals, bound_variables); return compile(cons(cons(rename("lambda"), formals, cdr(expression)), // unit), // dummy - local, + bound_variables, free_variables, continuation); } @@ -952,22 +952,22 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - if (local.is()) + if (bound_variables.is()) { if (car(expression).is()) // (define ( . ) ) { return compile(cons(rename("lambda"), cdar(expression), cdr(expression)), - local, + bound_variables, free_variables, - cons(make(instruction::store_absolute), compile.identify(caar(expression), local, free_variables), + cons(make(instruction::store_absolute), compile.identify(caar(expression), bound_variables, free_variables), continuation)); } else // (define ) { return compile(cdr(expression) ? cadr(expression) : unspecified, - local, + bound_variables, free_variables, - cons(make(instruction::store_absolute), compile.identify(car(expression), local, free_variables), + cons(make(instruction::store_absolute), compile.identify(car(expression), bound_variables, free_variables), continuation)); } } @@ -1012,8 +1012,8 @@ inline namespace kernel { compile.identify(car(expression), unit, unit) .template as() - .store(make(Environment().execute(compile(cadr(expression), local)), - make(local, compile.global()))); + .store(make(Environment().execute(compile(cadr(expression), bound_variables)), + make(bound_variables, compile.global()))); return cons(make(instruction::load_constant), unspecified, continuation); @@ -1034,7 +1034,7 @@ inline namespace kernel return cons(make(instruction::load_continuation), continuation, compile(car(expression), - local, + bound_variables, free_variables, list(make(instruction::tail_call)), // The first argument passed to call-with-current-continuation must be called via a tail call. tail)); @@ -1057,7 +1057,7 @@ inline namespace kernel * --------------------------------------------------------------------- */ { return compile(cadr(expression), - local, + bound_variables, free_variables, cons(make(instruction::install), car(expression), continuation)); @@ -1067,7 +1067,7 @@ inline namespace kernel }; auto operator ()(object const& expression, - object const& local, + object const& bound_variables, object const& free_variables = unit, object const& continuation = list(make(instruction::stop)), bool tail = false) -> object @@ -1098,17 +1098,17 @@ inline namespace kernel { if (expression.is()) { - return syntax::reference(*this, expression, local, free_variables, continuation, tail); + return syntax::reference(*this, expression, bound_variables, free_variables, continuation, tail); } else if (expression.is()) { - if (let const& identity = std::as_const(*this).identify(expression, local, free_variables); is_truthy(identity)) // The syntactic-closure is an alias + if (let const& identity = std::as_const(*this).identify(expression, bound_variables, free_variables); is_truthy(identity)) // The syntactic-closure is an alias { - return syntax::reference(*this, expression, local, free_variables, continuation, tail); + return syntax::reference(*this, expression, bound_variables, free_variables, continuation, tail); } else // The syntactic-closure is a syntactic-keyword. { - return expression.as().compile(local, free_variables, continuation); + return expression.as().compile(bound_variables, free_variables, continuation); } } else // is @@ -1116,7 +1116,7 @@ inline namespace kernel return cons(make(instruction::load_constant), expression, continuation); } } - else if (let const& identity = std::as_const(*this).identify(car(expression), local, free_variables); + else if (let const& identity = std::as_const(*this).identify(car(expression), bound_variables, free_variables); identity.is() and identity.as().load().is()) { @@ -1140,9 +1140,9 @@ inline namespace kernel return compile(Environment().apply(car(identity.as().load()), expression, - make(local, global()), + make(bound_variables, global()), cdr(identity.as().load())), - local, + bound_variables, free_variables, continuation, tail); @@ -1150,11 +1150,11 @@ inline namespace kernel else if (identity.is() and identity.as().load().is()) { - return identity.as().load().compile(*this, cdr(expression), local, free_variables, continuation, tail); + return identity.as().load().compile(*this, cdr(expression), bound_variables, free_variables, continuation, tail); } else { - return syntax::call(*this, expression, local, free_variables, continuation, tail); + return syntax::call(*this, expression, bound_variables, free_variables, continuation, tail); } } @@ -1197,7 +1197,7 @@ inline namespace kernel } auto identify(object const& variable, - object const& local, + object const& bound_variables, object const& free_variables) const -> object { if (not variable.is_also()) @@ -1208,7 +1208,7 @@ inline namespace kernel { auto i = identity::index(0); - for (auto outer = local; outer.is(); ++i, outer = cdr(outer)) + for (auto outer = bound_variables; outer.is(); ++i, outer = cdr(outer)) { auto j = identity::index(0); @@ -1231,7 +1231,7 @@ inline namespace kernel if (variable.is()) { - return variable.as().identify(local, free_variables); + return variable.as().identify(bound_variables, free_variables); } else { @@ -1241,14 +1241,14 @@ inline namespace kernel } auto identify(object const& variable, - object const& local, + object const& bound_variables, object const& free_variables) { if (not variable.is_also()) { return f; } - else if (let const& identity = std::as_const(*this).identify(variable, local, free_variables); is_truthy(identity)) + else if (let const& identity = std::as_const(*this).identify(variable, bound_variables, free_variables); is_truthy(identity)) { return identity; } From 1009a18e5e58a1e7e717eb81909bad1b872d3ccf Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 02:41:02 +0900 Subject: [PATCH 14/28] Rename member function `local` and `global` to `(bound|free)_variables` Signed-off-by: yamacir-kit --- README.md | 6 ++--- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 26 +++++++++---------- src/kernel/environment.cpp | 4 +-- src/kernel/export_spec.cpp | 2 +- src/kernel/import_set.cpp | 2 +- src/kernel/library.cpp | 2 +- 7 files changed, 22 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index f76e8b1f8..ee084c9e3 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.737.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.738.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.737_amd64.deb` +| `package` | Generate debian package `meevax_0.4.738_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.737 +Meevax Lisp 0.4.738 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index fd99ec14d..d224fd75b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.737 +0.4.738 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index e82cb6c2f..8d3bea206 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -28,7 +28,7 @@ namespace meevax inline namespace kernel { template - struct syntactic_environment : public virtual pair // ( . ) + struct syntactic_environment : public virtual pair // ( . ) { struct syntactic_closure : public identifier { @@ -379,7 +379,7 @@ inline namespace kernel binding_specs, cons(Environment().apply(car(identity.as().load()), car(form), - make(bound_variables, compile.global()), + make(bound_variables, compile.free_variables()), cdr(identity.as().load())), cdr(form)), bound_variables, @@ -869,7 +869,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - let const environment = make(bound_variables, compile.global()); + let const environment = make(bound_variables, compile.free_variables()); auto formal = [&](let const& syntax_spec) { @@ -906,7 +906,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - let const environment = make(unit, compile.global()); + let const environment = make(unit, compile.free_variables()); auto formal = [&](let const& syntax_spec) { @@ -1013,7 +1013,7 @@ inline namespace kernel compile.identify(car(expression), unit, unit) .template as() .store(make(Environment().execute(compile(cadr(expression), bound_variables)), - make(bound_variables, compile.global()))); + make(bound_variables, compile.free_variables()))); return cons(make(instruction::load_constant), unspecified, continuation); @@ -1140,7 +1140,7 @@ inline namespace kernel return compile(Environment().apply(car(identity.as().load()), expression, - make(bound_variables, global()), + make(bound_variables, this->free_variables()), cdr(identity.as().load())), bound_variables, free_variables, @@ -1168,7 +1168,7 @@ inline namespace kernel auto define(object const& variable, object const& value = undefined) -> void { - assert(local().template is()); + assert(bound_variables().template is()); assert(identify(variable, unit, unit).template is()); return identify(variable, unit, unit).template as().store(value); } @@ -1186,12 +1186,12 @@ inline namespace kernel } } - auto global() const noexcept -> object const& + auto free_variables() const noexcept -> object const& { return second; } - auto global() noexcept -> object & + auto free_variables() noexcept -> object & { return second; } @@ -1235,7 +1235,7 @@ inline namespace kernel } else { - return assq(variable, global()); + return assq(variable, this->free_variables()); } } } @@ -1269,16 +1269,16 @@ inline namespace kernel whereas it would be an error to perform a set! on an unbound variable. */ - return car(global() = cons(make(variable, undefined), global())); + return car(this->free_variables() = cons(make(variable, undefined), this->free_variables())); } } - auto local() const noexcept -> object const& + auto bound_variables() const noexcept -> object const& { return first; } - auto local() noexcept -> object & + auto bound_variables() noexcept -> object & { return first; } diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 74b473f7f..3b10685e5 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -82,7 +82,7 @@ inline namespace kernel std::exchange(c, unit), d); } - let const result = execute(optimize(compile(expression, local()))); + let const result = execute(optimize(compile(expression, bound_variables()))); if (d) { @@ -126,7 +126,7 @@ inline namespace kernel auto environment::operator [](object const& variable) -> object const& { - assert(local().is()); + assert(bound_variables().is()); assert(e.is()); assert(identify(variable, unit, unit).is()); return identify(variable, unit, unit).as().load(); diff --git a/src/kernel/export_spec.cpp b/src/kernel/export_spec.cpp index 155217a98..222926ce0 100644 --- a/src/kernel/export_spec.cpp +++ b/src/kernel/export_spec.cpp @@ -28,7 +28,7 @@ inline namespace kernel { auto identity = [&]() { - assert(library.local().is()); + assert(library.bound_variables().is()); if (form.is()) { diff --git a/src/kernel/import_set.cpp b/src/kernel/import_set.cpp index b08face05..930e6a029 100644 --- a/src/kernel/import_set.cpp +++ b/src/kernel/import_set.cpp @@ -144,7 +144,7 @@ inline namespace kernel { assert(identity.is()); - if (let const& variable = identity.as().symbol(); eq(std::as_const(e).identify(variable, e.local(), unit), f) or redefinable) + if (let const& variable = identity.as().symbol(); eq(std::as_const(e).identify(variable, e.bound_variables(), unit), f) or redefinable) { e.define(identity.as().symbol(), identity.as().load()); } diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index e3be8b98f..1211b52f2 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -100,7 +100,7 @@ inline namespace kernel auto operator <<(std::ostream & os, library const& library) -> std::ostream & { - return os << library.global(); + return os << library.free_variables(); } auto libraries() -> std::map & From 5cc7689e453ed8643cf64635799afdc98d1eb448 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 03:30:30 +0900 Subject: [PATCH 15/28] Update `library::resolve` to resolve export-specs by itself Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- include/meevax/kernel/export_spec.hpp | 2 +- include/meevax/kernel/identity.hpp | 12 +++++------ include/meevax/kernel/library.hpp | 6 ++++-- src/kernel/export_spec.cpp | 2 -- src/kernel/library.cpp | 29 +++++++++++++++++++++------ 7 files changed, 38 insertions(+), 21 deletions(-) diff --git a/README.md b/README.md index ee084c9e3..463ad3adc 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.738.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.739.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.738_amd64.deb` +| `package` | Generate debian package `meevax_0.4.739_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.738 +Meevax Lisp 0.4.739 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index d224fd75b..40733191a 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.738 +0.4.739 diff --git a/include/meevax/kernel/export_spec.hpp b/include/meevax/kernel/export_spec.hpp index fe240f0e7..8e4bd4057 100644 --- a/include/meevax/kernel/export_spec.hpp +++ b/include/meevax/kernel/export_spec.hpp @@ -25,7 +25,7 @@ inline namespace kernel { struct library; - struct export_spec + struct [[deprecated]] export_spec { let const form; diff --git a/include/meevax/kernel/identity.hpp b/include/meevax/kernel/identity.hpp index efedc452b..85930f97a 100644 --- a/include/meevax/kernel/identity.hpp +++ b/include/meevax/kernel/identity.hpp @@ -28,8 +28,8 @@ inline namespace kernel using index = std::uint32_t; }; - struct absolute : public identity - , public virtual pair // ( . ) + struct absolute : public virtual pair // ( . ) + , public identity { using pair::pair; @@ -48,8 +48,8 @@ inline namespace kernel auto operator <<(std::ostream &, absolute const&) -> std::ostream &; - struct relative : public identity - , public virtual pair // de Bruijn index + struct relative : public virtual pair // de Bruijn index + , public identity { using pair::pair; }; @@ -59,8 +59,8 @@ inline namespace kernel return false; // for free-identifier=? } - struct variadic : public identity - , public virtual pair // de Bruijn index + struct variadic : public virtual pair // de Bruijn index + , public identity { using pair::pair; }; diff --git a/include/meevax/kernel/library.hpp b/include/meevax/kernel/library.hpp index 18a0d823c..09ab05007 100644 --- a/include/meevax/kernel/library.hpp +++ b/include/meevax/kernel/library.hpp @@ -31,6 +31,8 @@ inline namespace kernel let subset = unit; + let export_specs = unit; + template )> explicit library(F declare) { @@ -58,12 +60,12 @@ inline namespace kernel auto define(std::string const& name, Ts&&... xs) -> void { environment::define(name, std::forward(xs)...); - declare(input_string_port(name).read()); + export_specs = cons(input_string_port(name).read(), export_specs); } auto evaluate(object const&) -> void; - auto resolve() -> object const&; + auto resolve() -> object; }; auto operator <<(std::ostream &, library const&) -> std::ostream &; diff --git a/src/kernel/export_spec.cpp b/src/kernel/export_spec.cpp index 222926ce0..f0c577c4f 100644 --- a/src/kernel/export_spec.cpp +++ b/src/kernel/export_spec.cpp @@ -49,5 +49,3 @@ inline namespace kernel } } // namespace kernel } // namespace meevax - - diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 1211b52f2..faba21abb 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -51,10 +51,7 @@ inline namespace kernel if (is("export")) { - for (let const& form : cdr(declaration)) - { - declare(form); - } + export_specs = append(cdr(declaration), export_specs); } else if (is("begin")) { @@ -83,7 +80,7 @@ inline namespace kernel } } - auto library::resolve() -> object const& + auto library::resolve() -> object { if (not declarations.is()) { @@ -95,7 +92,27 @@ inline namespace kernel declarations = unit; } - return subset; + assert(bound_variables().is()); + + return map([this](let const& export_spec) + { + if (export_spec.is()) + { + assert(car(export_spec).is()); + assert(car(export_spec).as() == "rename"); + assert(cadr(export_spec).is_also()); + assert(caddr(export_spec).is_also()); + return make(caddr(export_spec), + identify(cadr(export_spec), unit, unit) + ); + } + else + { + assert(export_spec.is_also()); + return identify(export_spec, unit, unit); + } + }, + export_specs); } auto operator <<(std::ostream & os, library const& library) -> std::ostream & From b3f8ba2a93bb97c9dc16b8eb5365b7215a61b797 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 03:42:21 +0900 Subject: [PATCH 16/28] Remove struct `export_spec` Signed-off-by: yamacir-kit --- README.md | 6 ++-- VERSION | 2 +- include/meevax/kernel/export_spec.hpp | 39 -------------------- include/meevax/kernel/library.hpp | 3 -- src/kernel/export_spec.cpp | 51 --------------------------- 5 files changed, 4 insertions(+), 97 deletions(-) delete mode 100644 include/meevax/kernel/export_spec.hpp delete mode 100644 src/kernel/export_spec.cpp diff --git a/README.md b/README.md index 463ad3adc..6cfa968ca 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.739.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.740.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.739_amd64.deb` +| `package` | Generate debian package `meevax_0.4.740_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.739 +Meevax Lisp 0.4.740 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 40733191a..ad4145d9e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.739 +0.4.740 diff --git a/include/meevax/kernel/export_spec.hpp b/include/meevax/kernel/export_spec.hpp deleted file mode 100644 index 8e4bd4057..000000000 --- a/include/meevax/kernel/export_spec.hpp +++ /dev/null @@ -1,39 +0,0 @@ -/* - Copyright 2018-2023 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#ifndef INCLUDED_MEEVAX_KERNEL_EXPORT_SPEC_HPP -#define INCLUDED_MEEVAX_KERNEL_EXPORT_SPEC_HPP - -#include - -namespace meevax -{ -inline namespace kernel -{ - struct library; - - struct [[deprecated]] export_spec - { - let const form; - - explicit export_spec(object const&); - - auto operator ()(library &) const -> void; - }; -} // namespace kernel -} // namespace meevax - -#endif // INCLUDED_MEEVAX_KERNEL_EXPORT_SPEC_HPP diff --git a/include/meevax/kernel/library.hpp b/include/meevax/kernel/library.hpp index 09ab05007..a4c216ca9 100644 --- a/include/meevax/kernel/library.hpp +++ b/include/meevax/kernel/library.hpp @@ -18,7 +18,6 @@ #define INCLUDED_MEEVAX_KERNEL_LIBRARY_HPP #include -#include #include namespace meevax @@ -29,8 +28,6 @@ inline namespace kernel { let declarations = unit; - let subset = unit; - let export_specs = unit; template )> diff --git a/src/kernel/export_spec.cpp b/src/kernel/export_spec.cpp deleted file mode 100644 index f0c577c4f..000000000 --- a/src/kernel/export_spec.cpp +++ /dev/null @@ -1,51 +0,0 @@ -/* - Copyright 2018-2023 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#include - -namespace meevax -{ -inline namespace kernel -{ - export_spec::export_spec(object const& form) - : form { form } - {} - - auto export_spec::operator ()(library & library) const -> void - { - auto identity = [&]() - { - assert(library.bound_variables().is()); - - if (form.is()) - { - assert(form[0].is()); - assert(form[0].as() == "rename"); - assert(form[1].is_also()); - assert(form[2].is_also()); - return make(form[2], library.identify(form[1], unit, unit)); - } - else - { - assert(form.is_also()); - return library.identify(form, unit, unit); - } - }; - - library.subset = cons(identity(), library.subset); - } -} // namespace kernel -} // namespace meevax From 6a289cb82d8dfacb16a6f0047aa476776c07d4e4 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 03:50:16 +0900 Subject: [PATCH 17/28] Remove member template function `library::declare` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- include/meevax/kernel/library.hpp | 13 ------------- src/kernel/library.cpp | 8 +++----- 4 files changed, 7 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index 6cfa968ca..f97b53044 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.740.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.741.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.740_amd64.deb` +| `package` | Generate debian package `meevax_0.4.741_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.740 +Meevax Lisp 0.4.741 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index ad4145d9e..8c7fa71a1 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.740 +0.4.741 diff --git a/include/meevax/kernel/library.hpp b/include/meevax/kernel/library.hpp index a4c216ca9..aae6090e4 100644 --- a/include/meevax/kernel/library.hpp +++ b/include/meevax/kernel/library.hpp @@ -40,19 +40,6 @@ inline namespace kernel friend auto boot() -> void; - template - auto declare(Ts&&... xs) -> decltype(auto) - { - if constexpr (std::is_invocable_v) - { - return std::invoke(std::decay_t(std::forward(xs)...), *this); - } - else - { - return environment::declare(std::forward(xs)...); - } - } - template auto define(std::string const& name, Ts&&... xs) -> void { diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index faba21abb..8bc2122ea 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -82,14 +82,12 @@ inline namespace kernel auto library::resolve() -> object { - if (not declarations.is()) + if (let const unresolved_declarations = std::exchange(declarations, unit); unresolved_declarations.is()) { - for (let const& declaration : declarations) + for (let const& unresolved_declaration : unresolved_declarations) { - evaluate(declaration); + evaluate(unresolved_declaration); } - - declarations = unit; } assert(bound_variables().is()); From 52777c639cda8ac37ff6905789b1266055ec2dfc Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 03:56:49 +0900 Subject: [PATCH 18/28] Update `library::resolve` to not to make nested absolute identity Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- src/kernel/identity.cpp | 11 ++--------- src/kernel/library.cpp | 3 +-- 4 files changed, 7 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index f97b53044..a0ea69ce5 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.741.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.742.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.741_amd64.deb` +| `package` | Generate debian package `meevax_0.4.742_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.741 +Meevax Lisp 0.4.742 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 8c7fa71a1..39a57927c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.741 +0.4.742 diff --git a/src/kernel/identity.cpp b/src/kernel/identity.cpp index f84b6e9d3..a13a4fcf9 100644 --- a/src/kernel/identity.cpp +++ b/src/kernel/identity.cpp @@ -25,15 +25,8 @@ inline namespace kernel { auto absolute::load() const -> object const& { - if (second.is()) // Only the (export (rename ...)) form makes an identity whose value is identity. - { - assert(second.is()); - return second.as().load(); - } - else - { - return second; - } + assert(not second.is()); + return second; } auto absolute::store(object const& x) -> void diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 8bc2122ea..a8c6e96fc 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -101,8 +101,7 @@ inline namespace kernel assert(cadr(export_spec).is_also()); assert(caddr(export_spec).is_also()); return make(caddr(export_spec), - identify(cadr(export_spec), unit, unit) - ); + identify(cadr(export_spec), unit, unit).as().load()); } else { From 67ef21a4b4eb50a6a8f015eb447fc443626ed9d6 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 29 Jun 2023 18:44:37 +0900 Subject: [PATCH 19/28] Remove all member functions from struct `absolute` Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- include/meevax/kernel/dynamic_environment.hpp | 8 ++-- include/meevax/kernel/identity.hpp | 14 +----- .../meevax/kernel/syntactic_environment.hpp | 44 +++++++++---------- src/kernel/environment.cpp | 2 +- src/kernel/identity.cpp | 25 ++--------- src/kernel/import_set.cpp | 23 ++++++---- src/kernel/library.cpp | 2 +- 9 files changed, 51 insertions(+), 75 deletions(-) diff --git a/README.md b/README.md index a0ea69ce5..3834911c0 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.742.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.743.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.742_amd64.deb` +| `package` | Generate debian package `meevax_0.4.743_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.742 +Meevax Lisp 0.4.743 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 39a57927c..3970d9f51 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.742 +0.4.743 diff --git a/include/meevax/kernel/dynamic_environment.hpp b/include/meevax/kernel/dynamic_environment.hpp index a3e3c6813..da8b0970c 100644 --- a/include/meevax/kernel/dynamic_environment.hpp +++ b/include/meevax/kernel/dynamic_environment.hpp @@ -134,13 +134,13 @@ inline namespace kernel * ----------------------------------------------------------------- */ assert(cadr(c).template is()); - if (let const& value = cadr(c).template as().load(); value == undefined) + if (let const& x = cdadr(c); x == undefined) { - throw error(make("undefined variable"), cadr(c).template as().symbol()); + throw error(make("undefined variable"), caadr(c)); } else { - s = cons(cadr(c).template as().load(), s); + s = cons(x, s); c = cddr(c); goto fetch; } @@ -456,7 +456,7 @@ inline namespace kernel * * ----------------------------------------------------------------- */ assert(cadr(c).template is()); - cadr(c).template as().store(car(s)); + cdadr(c) = car(s); c = cddr(c); goto fetch; diff --git a/include/meevax/kernel/identity.hpp b/include/meevax/kernel/identity.hpp index 85930f97a..4b128e6ff 100644 --- a/include/meevax/kernel/identity.hpp +++ b/include/meevax/kernel/identity.hpp @@ -28,22 +28,10 @@ inline namespace kernel using index = std::uint32_t; }; - struct absolute : public virtual pair // ( . ) + struct absolute : public virtual pair // ( . ) , public identity { using pair::pair; - - auto load() const -> object const&; - - template - auto load() const -> decltype(auto) - { - return load().as(); - } - - auto store(object const&) -> void; - - auto symbol() const -> object const&; }; auto operator <<(std::ostream &, absolute const&) -> std::ostream &; diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 8d3bea206..9b8684fc6 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -373,21 +373,21 @@ inline namespace kernel } else if (let const& identity = compile.identify(caar(form), bound_variables, free_variables); identity.is() and - identity.as().load().is()) + cdr(identity).is()) { return sweep(compile, binding_specs, - cons(Environment().apply(car(identity.as().load()), + cons(Environment().apply(cadr(identity), car(form), make(bound_variables, compile.free_variables()), - cdr(identity.as().load())), + cddr(identity)), cdr(form)), bound_variables, free_variables); } else if (identity.is() and - identity.as().load().is() and - identity.as().load().name == "define") // = ((define ...) *) + cdr(identity).is() and + cdr(identity).as().name == "define") // = ((define ...) *) { if (let const& definition = car(form); cadr(definition).is()) // = ((define ( . ) ) *) { @@ -411,8 +411,8 @@ inline namespace kernel } } else if (identity.is() and - identity.as().load().is() and - identity.as().load().name == "begin") + cdr(identity).is() and + cdr(identity).as().name == "begin") { return sweep(compile, binding_specs, @@ -1010,10 +1010,12 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - compile.identify(car(expression), unit, unit) - .template as() - .store(make(Environment().execute(compile(cadr(expression), bound_variables)), - make(bound_variables, compile.free_variables()))); + let const identity = compile.identify(car(expression), unit, unit); + + cdr(identity) = make(Environment().execute(compile(cadr(expression), + bound_variables)), + make(bound_variables, + compile.free_variables())); return cons(make(instruction::load_constant), unspecified, continuation); @@ -1117,8 +1119,7 @@ inline namespace kernel } } else if (let const& identity = std::as_const(*this).identify(car(expression), bound_variables, free_variables); - identity.is() and - identity.as().load().is()) + identity.is() and cdr(identity).is()) { /* Scheme programs can define and use new derived expression types, @@ -1135,22 +1136,21 @@ inline namespace kernel rules that specifies how a use of a macro is transcribed into a more primitive expression is called the transformer of the macro. */ - assert(car(identity.as().load()).is()); - assert(cdr(identity.as().load()).is()); + assert(cadr(identity).is()); + assert(cddr(identity).is()); - return compile(Environment().apply(car(identity.as().load()), + return compile(Environment().apply(cadr(identity), expression, make(bound_variables, this->free_variables()), - cdr(identity.as().load())), + cddr(identity)), bound_variables, free_variables, continuation, tail); } - else if (identity.is() and - identity.as().load().is()) + else if (identity.is() and cdr(identity).is()) { - return identity.as().load().compile(*this, cdr(expression), bound_variables, free_variables, continuation, tail); + return cdr(identity).as().compile(*this, cdr(expression), bound_variables, free_variables, continuation, tail); } else { @@ -1170,7 +1170,7 @@ inline namespace kernel { assert(bound_variables().template is()); assert(identify(variable, unit, unit).template is()); - return identify(variable, unit, unit).template as().store(value); + cdr(identify(variable, unit, unit)) = value; } template @@ -1214,7 +1214,7 @@ inline namespace kernel for (auto inner = outer.is() ? car(outer) : unit; not inner.is(); ++j, inner = inner.is() ? cdr(inner) : unit) { - if (inner.is() and car(inner).is() and eq(car(inner).as().symbol(), variable)) + if (inner.is() and car(inner).is() and eq(caar(inner), variable)) { return car(inner); } diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 3b10685e5..ed9b4e8cb 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -129,7 +129,7 @@ inline namespace kernel assert(bound_variables().is()); assert(e.is()); assert(identify(variable, unit, unit).is()); - return identify(variable, unit, unit).as().load(); + return cdr(identify(variable, unit, unit)); } auto environment::operator [](std::string const& variable) -> object const& diff --git a/src/kernel/identity.cpp b/src/kernel/identity.cpp index a13a4fcf9..1f35a3efb 100644 --- a/src/kernel/identity.cpp +++ b/src/kernel/identity.cpp @@ -16,39 +16,20 @@ #include #include -#include -#include namespace meevax { inline namespace kernel { - auto absolute::load() const -> object const& - { - assert(not second.is()); - return second; - } - - auto absolute::store(object const& x) -> void - { - second = x; - } - - auto absolute::symbol() const -> object const& - { - assert(first.is_also()); - return first; - } - auto operator <<(std::ostream & os, absolute const& datum) -> std::ostream & { - if (datum.load() == undefined) + if (datum.second == undefined) { - return os << faint(datum.symbol()); + return os << faint(datum.first); } else { - return os << blue(datum.symbol()); + return os << blue(datum.first); } } } // namespace kernel diff --git a/src/kernel/import_set.cpp b/src/kernel/import_set.cpp index 930e6a029..dce4ffccd 100644 --- a/src/kernel/import_set.cpp +++ b/src/kernel/import_set.cpp @@ -36,7 +36,8 @@ inline namespace kernel { return filter([&](let const& identity) { - return is_truthy(memq(identity.as().symbol(), identities)); + assert(identity.is()); + return is_truthy(memq(car(identity), identities)); }, resolve(import_set)); }; @@ -57,7 +58,8 @@ inline namespace kernel { return filter([&](let const& identity) { - return not is_truthy(memq(identity.as().symbol(), identities)); + assert(identity.is()); + return not is_truthy(memq(car(identity), identities)); }, resolve(import_set)); }; @@ -78,8 +80,9 @@ inline namespace kernel { return map([&](let const& identity) { - return make(make_symbol(car(prefixes).as() + identity.as().symbol().as()), - identity.as().load()); + assert(identity.is()); + return make(make_symbol(lexical_cast(car(prefixes)) + lexical_cast(car(identity))), + cdr(identity)); }, resolve(import_set)); }; @@ -101,10 +104,13 @@ inline namespace kernel { return map([&](let const& identity) { - if (let const& renaming = assq(identity.as().symbol(), renamings); is_truthy(renaming)) + assert(identity.is()); + assert(car(identity).is_also()); + + if (let const& renaming = assq(car(identity), renamings); is_truthy(renaming)) { assert(cadr(renaming).is()); - return make(cadr(renaming), identity.as().load()); + return make(cadr(renaming), cdr(identity)); } else { @@ -144,9 +150,10 @@ inline namespace kernel { assert(identity.is()); - if (let const& variable = identity.as().symbol(); eq(std::as_const(e).identify(variable, e.bound_variables(), unit), f) or redefinable) + if (let const& variable = car(identity); eq(std::as_const(e).identify(variable, e.bound_variables(), unit), f) or redefinable) { - e.define(identity.as().symbol(), identity.as().load()); + e.define(car(identity), + cdr(identity)); } else { diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index a8c6e96fc..9b6787b6b 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -101,7 +101,7 @@ inline namespace kernel assert(cadr(export_spec).is_also()); assert(caddr(export_spec).is_also()); return make(caddr(export_spec), - identify(cadr(export_spec), unit, unit).as().load()); + cdr(identify(cadr(export_spec), unit, unit))); } else { From 12474ae6acce8814c72d9cb0be65c6771e3e5092 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 30 Jun 2023 00:14:23 +0900 Subject: [PATCH 20/28] Remove struct `import_set` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- include/meevax/kernel/environment.hpp | 10 +- include/meevax/kernel/import_set.hpp | 41 ------- src/kernel/environment.cpp | 144 +++++++++++++++++++++- src/kernel/import_set.cpp | 165 -------------------------- src/kernel/library.cpp | 7 +- src/main.cpp | 35 +++--- 8 files changed, 166 insertions(+), 244 deletions(-) delete mode 100644 include/meevax/kernel/import_set.hpp delete mode 100644 src/kernel/import_set.cpp diff --git a/README.md b/README.md index 3834911c0..064f30810 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.743.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.744.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.743_amd64.deb` +| `package` | Generate debian package `meevax_0.4.744_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.743 +Meevax Lisp 0.4.744 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 3970d9f51..3648d03da 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.743 +0.4.744 diff --git a/include/meevax/kernel/environment.hpp b/include/meevax/kernel/environment.hpp index 91fa9a553..8862c92c2 100644 --- a/include/meevax/kernel/environment.hpp +++ b/include/meevax/kernel/environment.hpp @@ -33,14 +33,12 @@ inline namespace kernel { using syntactic_environment::syntactic_environment; - template - auto declare(Ts&&... xs) -> decltype(auto) - { - return std::invoke(std::decay_t(std::forward(xs)...), *this); - } - auto evaluate(object const&) -> object; + auto import(object const&) -> void; + + auto import(std::string const&) -> void; + auto load(std::string const&) -> void; auto operator [](object const&) -> object const&; diff --git a/include/meevax/kernel/import_set.hpp b/include/meevax/kernel/import_set.hpp deleted file mode 100644 index 9c86e3ec0..000000000 --- a/include/meevax/kernel/import_set.hpp +++ /dev/null @@ -1,41 +0,0 @@ -/* - Copyright 2018-2023 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#ifndef INCLUDED_MEEVAX_KERNEL_IMPORT_SET_HPP -#define INCLUDED_MEEVAX_KERNEL_IMPORT_SET_HPP - -#include - -namespace meevax -{ -inline namespace kernel -{ - struct environment; - - struct import_set - { - let const identities; - - explicit import_set(object const&); - - explicit import_set(std::string const&); - - auto operator ()(environment &) const -> void; - }; -} // namespace kernel -} // namespace meevax - -#endif // INCLUDED_MEEVAX_KERNEL_IMPORT_SET_HPP diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index ed9b4e8cb..8fba717e8 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -14,10 +14,7 @@ limitations under the License. */ -#include - #include -#include #include #include @@ -29,7 +26,7 @@ inline namespace kernel { auto is = [&](auto name) { - return expression.is() and expression[0].is() and expression[0].as() == name; + return expression.is() and car(expression).is() and car(expression).as() == name; }; if (is("define-library")) @@ -39,9 +36,9 @@ inline namespace kernel } else if (is("import")) { - for (let const& form : cdr(expression)) + for (let const& import_set : cdr(expression)) { - declare(form); + import(import_set); } return unspecified; @@ -108,6 +105,141 @@ inline namespace kernel } } + auto resolve(object const& form) -> object + { + if (form[0].as() == "only") /* ------------------------------------- + * + * = (only ...) + * + * ----------------------------------------------------------------------- */ + { + auto only = [](let const& import_set) + { + return [=](let const& identities) + { + return filter([&](let const& identity) + { + assert(identity.is()); + return is_truthy(memq(car(identity), identities)); + }, + resolve(import_set)); + }; + }; + + return only(cadr(form)) + (cddr(form)); + } + else if (form[0].as() == "except") /* ------------------------------ + * + * = (except ...) + * + * ----------------------------------------------------------------------- */ + { + auto except = [](let const& import_set) + { + return [=](let const& identities) + { + return filter([&](let const& identity) + { + assert(identity.is()); + return not is_truthy(memq(car(identity), identities)); + }, + resolve(import_set)); + }; + }; + + return except(cadr(form)) + (cddr(form)); + } + else if (form[0].as() == "prefix") /* ------------------------------ + * + * = (prefix ) + * + * ----------------------------------------------------------------------- */ + { + auto prefix = [](let const& import_set) + { + return [=](let const& prefixes) + { + return map([&](let const& identity) + { + assert(identity.is()); + return make(make_symbol(lexical_cast(car(prefixes)) + lexical_cast(car(identity))), + cdr(identity)); + }, + resolve(import_set)); + }; + }; + + return prefix(cadr(form)) + (cddr(form)); + } + else if (form[0].as() == "rename") /* ------------------------------ + * + * = (rename + * ( ) ...) + * + * ----------------------------------------------------------------------- */ + { + auto rename = [](let const& import_set) + { + return [=](let const& renamings) + { + return map([&](let const& identity) + { + assert(identity.is()); + assert(car(identity).is_also()); + + if (let const& renaming = assq(car(identity), renamings); is_truthy(renaming)) + { + assert(cadr(renaming).is()); + return make(cadr(renaming), cdr(identity)); + } + else + { + return identity; + } + }, + resolve(import_set)); + }; + }; + + return rename(cadr(form)) + (cddr(form)); + } + else if (auto iter = libraries().find(lexical_cast(form)); iter != std::end(libraries())) + { + return std::get<1>(*iter).resolve(); + } + else + { + throw error(make("No such library"), form); + } + } + + auto environment::import(object const& import_set) -> void + { + for (let const& identity : resolve(import_set)) + { + assert(identity.is()); + + if (not is_truthy(std::as_const(*this).identify(car(identity), bound_variables(), unit)) or interactive) + { + define(car(identity), + cdr(identity)); + } + else + { + throw error(make("in a program or library declaration, it is an error to import the same identifier more than once with different bindings"), identity); + } + } + } + + auto environment::import(std::string const& import_set) -> void + { + import(input_string_port(import_set).read()); + } + auto environment::load(std::string const& s) -> void { if (auto input = input_file_port(s); input.is_open() and input.get_ready()) diff --git a/src/kernel/import_set.cpp b/src/kernel/import_set.cpp deleted file mode 100644 index dce4ffccd..000000000 --- a/src/kernel/import_set.cpp +++ /dev/null @@ -1,165 +0,0 @@ -/* - Copyright 2018-2023 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#include -#include -#include - -namespace meevax -{ -inline namespace kernel -{ - auto resolve(object const& form) -> object - { - if (form[0].as() == "only") /* ------------------------------------- - * - * = (only ...) - * - * ----------------------------------------------------------------------- */ - { - auto only = [](let const& import_set) - { - return [=](let const& identities) - { - return filter([&](let const& identity) - { - assert(identity.is()); - return is_truthy(memq(car(identity), identities)); - }, - resolve(import_set)); - }; - }; - - return only(cadr(form)) - (cddr(form)); - } - else if (form[0].as() == "except") /* ------------------------------ - * - * = (except ...) - * - * ----------------------------------------------------------------------- */ - { - auto except = [](let const& import_set) - { - return [=](let const& identities) - { - return filter([&](let const& identity) - { - assert(identity.is()); - return not is_truthy(memq(car(identity), identities)); - }, - resolve(import_set)); - }; - }; - - return except(cadr(form)) - (cddr(form)); - } - else if (form[0].as() == "prefix") /* ------------------------------ - * - * = (prefix ) - * - * ----------------------------------------------------------------------- */ - { - auto prefix = [](let const& import_set) - { - return [=](let const& prefixes) - { - return map([&](let const& identity) - { - assert(identity.is()); - return make(make_symbol(lexical_cast(car(prefixes)) + lexical_cast(car(identity))), - cdr(identity)); - }, - resolve(import_set)); - }; - }; - - return prefix(cadr(form)) - (cddr(form)); - } - else if (form[0].as() == "rename") /* ------------------------------ - * - * = (rename - * ( ) ...) - * - * ----------------------------------------------------------------------- */ - { - auto rename = [](let const& import_set) - { - return [=](let const& renamings) - { - return map([&](let const& identity) - { - assert(identity.is()); - assert(car(identity).is_also()); - - if (let const& renaming = assq(car(identity), renamings); is_truthy(renaming)) - { - assert(cadr(renaming).is()); - return make(cadr(renaming), cdr(identity)); - } - else - { - return identity; - } - }, - resolve(import_set)); - }; - }; - - return rename(cadr(form)) - (cddr(form)); - } - else if (auto iter = libraries().find(lexical_cast(form)); iter != std::end(libraries())) - { - return std::get<1>(*iter).resolve(); - } - else - { - throw error(make("No such library"), form); - } - } - - import_set::import_set(object const& form) - : identities { resolve(form) } - {} - - import_set::import_set(std::string const& library_name) - : import_set { input_string_port(library_name).read() } - {} - - auto import_set::operator ()(environment & e) const -> void - { - auto const redefinable = e.interactive or e == interaction_environment().as(); - - for (let const& identity : identities) - { - assert(identity.is()); - - if (let const& variable = car(identity); eq(std::as_const(e).identify(variable, e.bound_variables(), unit), f) or redefinable) - { - e.define(car(identity), - cdr(identity)); - } - else - { - throw error(make("In a program or library declaration, it is an error to import the same identifier more than once with different bindings"), variable); - } - } - } -} // namespace kernel -} // namespace meevax diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 9b6787b6b..072a6f410 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -22,7 +22,6 @@ #include #include #include -#include #include #include #include @@ -242,14 +241,14 @@ inline namespace kernel { library.define("environment", [](let const& xs) { - let const e = make(); + auto e = environment(); for (let const& x : xs) { - e.as().declare(x); + e.import(x); } - return e; + return make(e); }); library.define("eval", [](let const& xs) diff --git a/src/main.cpp b/src/main.cpp index da68c9328..c05ac88e7 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -14,7 +14,6 @@ limitations under the License. */ -#include #include #include @@ -26,23 +25,23 @@ auto main(int const argc, char const* const* const argv) -> int { boot(); - auto&& main = interaction_environment().as(); - - main.declare("(scheme base)"); - main.declare("(scheme case-lambda)"); - main.declare("(scheme char)"); - main.declare("(scheme complex)"); - main.declare("(scheme cxr)"); - main.declare("(scheme eval)"); - main.declare("(scheme file)"); - main.declare("(scheme inexact)"); - main.declare("(scheme lazy)"); - main.declare("(scheme load)"); - main.declare("(scheme process-context)"); - main.declare("(scheme read)"); - main.declare("(scheme repl)"); - main.declare("(scheme time)"); - main.declare("(scheme write)"); + auto & main = interaction_environment().as(); + + main.import("(scheme base)"); + main.import("(scheme case-lambda)"); + main.import("(scheme char)"); + main.import("(scheme complex)"); + main.import("(scheme cxr)"); + main.import("(scheme eval)"); + main.import("(scheme file)"); + main.import("(scheme inexact)"); + main.import("(scheme lazy)"); + main.import("(scheme load)"); + main.import("(scheme process-context)"); + main.import("(scheme read)"); + main.import("(scheme repl)"); + main.import("(scheme time)"); + main.import("(scheme write)"); main.configure(argc, argv); From ecae5fb4bf944f9a34d310caa3f393d0106a0449 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 30 Jun 2023 01:08:50 +0900 Subject: [PATCH 21/28] Add user-defined literal `operator ""_read` Signed-off-by: yamacir-kit --- README.md | 6 ++-- VERSION | 2 +- include/meevax/kernel/environment.hpp | 2 -- include/meevax/kernel/input_string_port.hpp | 5 ++++ src/kernel/environment.cpp | 5 ---- src/kernel/input_string_port.cpp | 8 ++++++ src/main.cpp | 31 +++++++++++---------- 7 files changed, 33 insertions(+), 26 deletions(-) diff --git a/README.md b/README.md index 064f30810..342b4b2a7 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.744.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.745.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.744_amd64.deb` +| `package` | Generate debian package `meevax_0.4.745_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.744 +Meevax Lisp 0.4.745 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 3648d03da..d380f4dc0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.744 +0.4.745 diff --git a/include/meevax/kernel/environment.hpp b/include/meevax/kernel/environment.hpp index 8862c92c2..a8c8ff959 100644 --- a/include/meevax/kernel/environment.hpp +++ b/include/meevax/kernel/environment.hpp @@ -37,8 +37,6 @@ inline namespace kernel auto import(object const&) -> void; - auto import(std::string const&) -> void; - auto load(std::string const&) -> void; auto operator [](object const&) -> object const&; diff --git a/include/meevax/kernel/input_string_port.hpp b/include/meevax/kernel/input_string_port.hpp index 281c3cd94..068187703 100644 --- a/include/meevax/kernel/input_string_port.hpp +++ b/include/meevax/kernel/input_string_port.hpp @@ -47,6 +47,11 @@ inline namespace kernel }; auto operator <<(std::ostream &, input_string_port const&) -> std::ostream &; + +namespace literals +{ + auto operator ""_read(char const*, std::size_t) -> object; +} // namespace literals } // namespace kernel } // namespace meevax diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 8fba717e8..2accada70 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -235,11 +235,6 @@ inline namespace kernel } } - auto environment::import(std::string const& import_set) -> void - { - import(input_string_port(import_set).read()); - } - auto environment::load(std::string const& s) -> void { if (auto input = input_file_port(s); input.is_open() and input.get_ready()) diff --git a/src/kernel/input_string_port.cpp b/src/kernel/input_string_port.cpp index bc146b323..6b6bad0cb 100644 --- a/src/kernel/input_string_port.cpp +++ b/src/kernel/input_string_port.cpp @@ -43,5 +43,13 @@ inline namespace kernel { return output << magenta("#,(") << blue("open-input-string ") << string(datum.stringstream.str()) << magenta(")"); } + +namespace literals +{ + auto operator ""_read(char const* s, std::size_t) -> object + { + return input_string_port(s).read(); + } +} // namespace literals } // namespace kernel } // namespace meevax diff --git a/src/main.cpp b/src/main.cpp index c05ac88e7..8d0c14a25 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -20,6 +20,7 @@ auto main(int const argc, char const* const* const argv) -> int { using namespace meevax; + using namespace meevax::literals; return with_exception_handler([&]() { @@ -27,21 +28,21 @@ auto main(int const argc, char const* const* const argv) -> int auto & main = interaction_environment().as(); - main.import("(scheme base)"); - main.import("(scheme case-lambda)"); - main.import("(scheme char)"); - main.import("(scheme complex)"); - main.import("(scheme cxr)"); - main.import("(scheme eval)"); - main.import("(scheme file)"); - main.import("(scheme inexact)"); - main.import("(scheme lazy)"); - main.import("(scheme load)"); - main.import("(scheme process-context)"); - main.import("(scheme read)"); - main.import("(scheme repl)"); - main.import("(scheme time)"); - main.import("(scheme write)"); + main.import("(scheme base)"_read); + main.import("(scheme case-lambda)"_read); + main.import("(scheme char)"_read); + main.import("(scheme complex)"_read); + main.import("(scheme cxr)"_read); + main.import("(scheme eval)"_read); + main.import("(scheme file)"_read); + main.import("(scheme inexact)"_read); + main.import("(scheme lazy)"_read); + main.import("(scheme load)"_read); + main.import("(scheme process-context)"_read); + main.import("(scheme read)"_read); + main.import("(scheme repl)"_read); + main.import("(scheme time)"_read); + main.import("(scheme write)"_read); main.configure(argc, argv); From 70e134c50bd841c2eb927b0569cf39626a8e4861 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 30 Jun 2023 01:11:52 +0900 Subject: [PATCH 22/28] Remove operator `environment::operator []` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- include/meevax/kernel/environment.hpp | 4 ---- src/kernel/environment.cpp | 13 ------------- 4 files changed, 4 insertions(+), 21 deletions(-) diff --git a/README.md b/README.md index 342b4b2a7..0553a9dc5 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.745.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.746.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.745_amd64.deb` +| `package` | Generate debian package `meevax_0.4.746_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.745 +Meevax Lisp 0.4.746 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index d380f4dc0..4aa8838ad 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.745 +0.4.746 diff --git a/include/meevax/kernel/environment.hpp b/include/meevax/kernel/environment.hpp index a8c8ff959..07c62cb80 100644 --- a/include/meevax/kernel/environment.hpp +++ b/include/meevax/kernel/environment.hpp @@ -38,10 +38,6 @@ inline namespace kernel auto import(object const&) -> void; auto load(std::string const&) -> void; - - auto operator [](object const&) -> object const&; - - auto operator [](std::string const&) -> object const&; }; auto operator <<(std::ostream &, environment const&) -> std::ostream &; diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 2accada70..7f8ecfbbd 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -251,19 +251,6 @@ inline namespace kernel } } - auto environment::operator [](object const& variable) -> object const& - { - assert(bound_variables().is()); - assert(e.is()); - assert(identify(variable, unit, unit).is()); - return cdr(identify(variable, unit, unit)); - } - - auto environment::operator [](std::string const& variable) -> object const& - { - return (*this)[make_symbol(variable)]; - } - auto operator <<(std::ostream & os, environment const& datum) -> std::ostream & { return os << magenta("#,(") << green("environment ") << faint("#;", &datum) << magenta(")"); From 2f34f2b4c73ea121ab04ec0e495b353ee14e6683 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Fri, 30 Jun 2023 19:07:49 +0900 Subject: [PATCH 23/28] Rename data member `syntactic_closure::free_variables` to `free_names` Signed-off-by: yamacir-kit --- README.md | 6 +++--- VERSION | 2 +- include/meevax/kernel/syntactic_environment.hpp | 16 ++++++++-------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 0553a9dc5..d05f3af5a 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.746.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.747.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.746_amd64.deb` +| `package` | Generate debian package `meevax_0.4.747_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.746 +Meevax Lisp 0.4.747 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 4aa8838ad..b4eb454b9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.746 +0.4.747 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 9b8684fc6..4ec3c698f 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -34,15 +34,15 @@ inline namespace kernel { let const environment; - let const free_variables; // Currently ignored. + let const free_names; // Currently ignored. let const expression; explicit syntactic_closure(let const& environment, - let const& free_variables, + let const& free_names, let const& expression) : environment { environment } - , free_variables { free_variables } + , free_names { free_names } , expression { expression } {} @@ -62,7 +62,7 @@ inline namespace kernel assert(environment.is()); return environment.as().compile(expression, align_with(bound_variables), - append(this->free_variables, free_variables), + append(this->free_names, free_variables), continuation); } @@ -72,7 +72,7 @@ inline namespace kernel assert(environment.is()); return environment.as().identify(expression, align_with(bound_variables), - append(this->free_variables, free_variables)); + append(this->free_names, free_variables)); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -91,8 +91,8 @@ inline namespace kernel return x.expression.template is_also() and y.expression.template is_also() and - eqv(x.identify(car(x.environment), x.free_variables), - y.identify(car(y.environment), y.free_variables)); + eqv(x.identify(car(x.environment), x.free_names), + y.identify(car(y.environment), y.free_names)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -103,7 +103,7 @@ inline namespace kernel } else { - return os << magenta("#,(") << blue("make-syntactic-closure ") << faint("#;", &datum.environment) << magenta(" '") << datum.free_variables << magenta(" '") << datum.expression << magenta(")"); + return os << magenta("#,(") << blue("make-syntactic-closure ") << faint("#;", &datum.environment) << magenta(" '") << datum.free_names << magenta(" '") << datum.expression << magenta(")"); } } }; From 72a269d131265fbdfb16b70bdf59bfcc3df5cf5a Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 1 Jul 2023 23:11:04 +0900 Subject: [PATCH 24/28] Update `syntactic_closure` to be derived from `pair` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 64 ++++++++----------- src/kernel/library.cpp | 2 +- 4 files changed, 31 insertions(+), 43 deletions(-) diff --git a/README.md b/README.md index d05f3af5a..32d020449 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.747.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.748.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.747_amd64.deb` +| `package` | Generate debian package `meevax_0.4.748_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.747 +Meevax Lisp 0.4.748 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index b4eb454b9..7c99d50cb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.747 +0.4.748 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 4ec3c698f..493a28fd1 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -30,49 +30,38 @@ inline namespace kernel template struct syntactic_environment : public virtual pair // ( . ) { - struct syntactic_closure : public identifier + struct syntactic_closure : public virtual pair // ( . ) + , public identifier { - let const environment; - - let const free_names; // Currently ignored. - - let const expression; - - explicit syntactic_closure(let const& environment, - let const& free_names, - let const& expression) - : environment { environment } - , free_names { free_names } - , expression { expression } - {} - auto align_with(let const& bound_variables) const { - assert(environment.is()); + assert(length(caar(*this)) <= length(bound_variables)); return append(make_list(length(bound_variables) - - length(car(environment))), - car(environment)); + length(caar(*this))), + caar(*this)); } auto compile(object const& bound_variables, object const& free_variables, object const& continuation) const { - assert(environment.is()); - return environment.as().compile(expression, - align_with(bound_variables), - append(this->free_names, free_variables), - continuation); + assert(car(*this).template is()); + + return car(*this).template as().compile(cddr(*this), + align_with(bound_variables), + append(cadr(*this), free_variables), + continuation); } auto identify(object const& bound_variables, object const& free_variables) const { - assert(environment.is()); - return environment.as().identify(expression, - align_with(bound_variables), - append(this->free_names, free_variables)); + assert(car(*this).template is()); + + return car(*this).template as().identify(cddr(*this), + align_with(bound_variables), + append(cadr(*this), free_variables)); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -86,24 +75,24 @@ inline namespace kernel in a cond clause. A macro definition for syntax-rules would use free-identifier=? to look for literals in the input. */ - assert(x.environment.template is()); - assert(y.environment.template is()); + assert(car(x).template is()); + assert(car(y).template is()); - return x.expression.template is_also() and - y.expression.template is_also() and - eqv(x.identify(car(x.environment), x.free_names), - y.identify(car(y.environment), y.free_names)); + return cddr(x).template is_also() and + cddr(y).template is_also() and + eqv(x.identify(caar(x), unit), + y.identify(caar(y), unit)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & { - if (datum.expression.template is()) + if (cddr(datum).template is_also()) { - return os << underline(datum.expression); + return os << underline(cddr(datum)); } else { - return os << magenta("#,(") << blue("make-syntactic-closure ") << faint("#;", &datum.environment) << magenta(" '") << datum.free_names << magenta(" '") << datum.expression << magenta(")"); + return os << magenta("#,(") << blue("make-syntactic-closure ") << faint("#;", car(datum).get()) << magenta(" '") << cadr(datum) << magenta(" '") << cddr(datum) << magenta(")"); } } }; @@ -220,8 +209,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - return cons(make(instruction::load_constant), car(expression).is() ? car(expression).as().expression - : car(expression), + return cons(make(instruction::load_constant), car(expression).is() ? cddar(expression) : car(expression), continuation); } diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 072a6f410..bb513fad8 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -1151,7 +1151,7 @@ inline namespace kernel { if (let const& x = xs[0]; x.is()) { - return x.as().expression; + return cddr(x); } else { From 1da64146eb55518d660768798d4f28448c514dc7 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 2 Jul 2023 20:10:10 +0900 Subject: [PATCH 25/28] Lipsticks Signed-off-by: yamacir-kit --- README.md | 6 ++--- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 24 ++++++++++++------- src/kernel/environment.cpp | 4 ++-- src/kernel/library.cpp | 4 +--- 5 files changed, 22 insertions(+), 18 deletions(-) diff --git a/README.md b/README.md index 32d020449..33e7e73c4 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.748.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.749.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.748_amd64.deb` +| `package` | Generate debian package `meevax_0.4.749_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.748 +Meevax Lisp 0.4.749 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 7c99d50cb..b63514ac3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.748 +0.4.749 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 493a28fd1..6259f4aed 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -30,6 +30,13 @@ inline namespace kernel template struct syntactic_environment : public virtual pair // ( . ) { + /* + A Syntactic Closures Macro Facility + + by Chris Hanson + + 9 November 1991 + */ struct syntactic_closure : public virtual pair // ( . ) , public identifier { @@ -67,13 +74,13 @@ inline namespace kernel friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool { /* - (free-identifier=? id-1 id-2) procedure + (free-identifier=? id-1 id-2) procedure - Returns #t if the original occurrences of id-1 and id-2 have the same - binding, otherwise returns #f. free-identifier=? is used to look for - a literal identifier in the argument to a transformer, such as else - in a cond clause. A macro definition for syntax-rules would use - free-identifier=? to look for literals in the input. + Returns #t if the original occurrences of id-1 and id-2 have the + same binding, otherwise returns #f. free-identifier=? is used to + look for a literal identifier in the argument to a transformer, such + as else in a cond clause. A macro definition for syntax-rules would + use free-identifier=? to look for literals in the input. */ assert(car(x).template is()); assert(car(y).template is()); @@ -894,7 +901,7 @@ inline namespace kernel * * --------------------------------------------------------------------- */ { - let const environment = make(unit, compile.free_variables()); + let const environment = make(bound_variables, compile.free_variables()); auto formal = [&](let const& syntax_spec) { @@ -1057,7 +1064,7 @@ inline namespace kernel }; auto operator ()(object const& expression, - object const& bound_variables, + object const& bound_variables = unit, // list of object const& free_variables = unit, object const& continuation = list(make(instruction::stop)), bool tail = false) -> object @@ -1156,7 +1163,6 @@ inline namespace kernel auto define(object const& variable, object const& value = undefined) -> void { - assert(bound_variables().template is()); assert(identify(variable, unit, unit).template is()); cdr(identify(variable, unit, unit)) = value; } diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 7f8ecfbbd..8ed899936 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -79,7 +79,7 @@ inline namespace kernel std::exchange(c, unit), d); } - let const result = execute(optimize(compile(expression, bound_variables()))); + let const result = execute(optimize(compile(expression))); if (d) { @@ -223,7 +223,7 @@ inline namespace kernel { assert(identity.is()); - if (not is_truthy(std::as_const(*this).identify(car(identity), bound_variables(), unit)) or interactive) + if (not is_truthy(std::as_const(*this).identify(car(identity), unit, unit)) or interactive) { define(car(identity), cdr(identity)); diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index bb513fad8..4c1c9397a 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -45,7 +45,7 @@ inline namespace kernel { auto is = [&](auto name) { - return declaration.is() and declaration[0].is() and declaration[0].as() == name; + return declaration.is() and car(declaration).is() and car(declaration).as() == name; }; if (is("export")) @@ -89,8 +89,6 @@ inline namespace kernel } } - assert(bound_variables().is()); - return map([this](let const& export_spec) { if (export_spec.is()) From 5a256f610a08cae1a36deebfbbc7194478606c81 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 13 Jul 2023 21:11:40 +0900 Subject: [PATCH 26/28] Remove `syntactic_closure`'s member function `compile` and `identify` Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 54 +++++++------------ 3 files changed, 24 insertions(+), 38 deletions(-) diff --git a/README.md b/README.md index 33e7e73c4..5052841a8 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.749.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.750.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.749_amd64.deb` +| `package` | Generate debian package `meevax_0.4.750_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.749 +Meevax Lisp 0.4.750 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index b63514ac3..21ecce00c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.749 +0.4.750 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 6259f4aed..122cc42b6 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -30,13 +30,6 @@ inline namespace kernel template struct syntactic_environment : public virtual pair // ( . ) { - /* - A Syntactic Closures Macro Facility - - by Chris Hanson - - 9 November 1991 - */ struct syntactic_closure : public virtual pair // ( . ) , public identifier { @@ -49,28 +42,6 @@ inline namespace kernel caar(*this)); } - auto compile(object const& bound_variables, - object const& free_variables, - object const& continuation) const - { - assert(car(*this).template is()); - - return car(*this).template as().compile(cddr(*this), - align_with(bound_variables), - append(cadr(*this), free_variables), - continuation); - } - - auto identify(object const& bound_variables, - object const& free_variables) const - { - assert(car(*this).template is()); - - return car(*this).template as().identify(cddr(*this), - align_with(bound_variables), - append(cadr(*this), free_variables)); - } - friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool { /* @@ -87,8 +58,14 @@ inline namespace kernel return cddr(x).template is_also() and cddr(y).template is_also() and - eqv(x.identify(caar(x), unit), - y.identify(caar(y), unit)); + eqv(car(x).template as() + .identify(cddr(x), + caar(x), + unit), + car(y).template as() + .identify(cddr(y), + caar(y), + unit)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -1103,9 +1080,14 @@ inline namespace kernel { return syntax::reference(*this, expression, bound_variables, free_variables, continuation, tail); } - else // The syntactic-closure is a syntactic-keyword. + else { - return expression.as().compile(bound_variables, free_variables, continuation); + return car(expression).as() + .compile(cddr(expression), + expression.as() + .align_with(bound_variables), + unit, + continuation); } } else // is @@ -1225,7 +1207,11 @@ inline namespace kernel if (variable.is()) { - return variable.as().identify(bound_variables, free_variables); + return car(variable).as() + .identify(cddr(variable), + variable.as() + .align_with(bound_variables), + unit); } else { From f0a5125a7e9d9b41568e07a7af1ccda8dc599574 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 15 Jul 2023 05:44:41 +0900 Subject: [PATCH 27/28] Remove member function `syntactic_closure::align_with` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- include/meevax/kernel/list.hpp | 2 + .../meevax/kernel/syntactic_environment.hpp | 151 +++++++++++------- src/kernel/list.cpp | 14 ++ 5 files changed, 116 insertions(+), 59 deletions(-) diff --git a/README.md b/README.md index 5052841a8..443a5c700 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.750.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.751.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.750_amd64.deb` +| `package` | Generate debian package `meevax_0.4.751_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.750 +Meevax Lisp 0.4.751 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 21ecce00c..067948d99 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.750 +0.4.751 diff --git a/include/meevax/kernel/list.hpp b/include/meevax/kernel/list.hpp index 9e5abd5c1..8b369407f 100644 --- a/include/meevax/kernel/list.hpp +++ b/include/meevax/kernel/list.hpp @@ -164,6 +164,8 @@ inline namespace kernel return unit; } } + + auto longest_common_tail(let const&, let const&) -> object const&; } // namespace kernel } // namespace meevax diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 122cc42b6..59c8f7005 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -33,15 +33,6 @@ inline namespace kernel struct syntactic_closure : public virtual pair // ( . ) , public identifier { - auto align_with(let const& bound_variables) const - { - assert(length(caar(*this)) <= length(bound_variables)); - - return append(make_list(length(bound_variables) - - length(caar(*this))), - caar(*this)); - } - friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool { /* @@ -81,33 +72,6 @@ inline namespace kernel } }; - static auto rename(std::string const& variable) - { - auto bind = [](auto&& name, auto&& compiler) - { - return make(make_symbol(name), make(name, compiler)); - }; - - let static const core_syntactic_environment = make( - list(), - list(bind("begin" , syntax::sequence ), - bind("call-with-current-continuation!", syntax::call_with_current_continuation), - bind("current" , syntax::current ), - bind("define" , syntax::define ), - bind("define-syntax" , syntax::define_syntax ), - bind("if" , syntax::conditional ), - bind("install" , syntax::install ), - bind("lambda" , syntax::lambda ), - bind("let-syntax" , syntax::let_syntax ), - bind("letrec" , syntax::letrec ), - bind("letrec-syntax" , syntax::letrec_syntax ), - bind("quote" , syntax::quote ), - bind("quote-syntax" , syntax::quote_syntax ), - bind("set!" , syntax::set ))); - - return make(core_syntactic_environment, unit, make_symbol(variable)); - } - struct syntax { using compiler = std::function() .compile(cddr(expression), - expression.as() - .align_with(bound_variables), + unify(caar(expression), bound_variables), unit, continuation); } @@ -1137,20 +1100,30 @@ inline namespace kernel using pair::pair; + inline auto bound_variables() const noexcept -> object const& + { + return first; + } + + inline auto bound_variables() noexcept -> object & + { + return first; + } + template - auto compile(Ts&&... xs) -> decltype(auto) + inline auto compile(Ts&&... xs) -> decltype(auto) { return operator ()(std::forward(xs)...); } - auto define(object const& variable, object const& value = undefined) -> void + inline auto define(object const& variable, object const& value = undefined) -> void { assert(identify(variable, unit, unit).template is()); cdr(identify(variable, unit, unit)) = value; } template - auto define(std::string const& name, Ts&&... xs) -> void + inline auto define(std::string const& name, Ts&&... xs) -> void { if constexpr (std::is_constructible_v) { @@ -1162,19 +1135,19 @@ inline namespace kernel } } - auto free_variables() const noexcept -> object const& + inline auto free_variables() const noexcept -> object const& { return second; } - auto free_variables() noexcept -> object & + inline auto free_variables() noexcept -> object & { return second; } - auto identify(object const& variable, - object const& bound_variables, - object const& free_variables) const -> object + inline auto identify(object const& variable, + object const& bound_variables, + object const& free_variables) const -> object { if (not variable.is_also()) { @@ -1209,8 +1182,7 @@ inline namespace kernel { return car(variable).as() .identify(cddr(variable), - variable.as() - .align_with(bound_variables), + unify(caar(variable), bound_variables), unit); } else @@ -1220,9 +1192,9 @@ inline namespace kernel } } - auto identify(object const& variable, - object const& bound_variables, - object const& free_variables) + inline auto identify(object const& variable, + object const& bound_variables, + object const& free_variables) { if (not variable.is_also()) { @@ -1253,14 +1225,83 @@ inline namespace kernel } } - auto bound_variables() const noexcept -> object const& + static auto rename(std::string const& variable) { - return first; + auto bind = [](auto&& name, auto&& compiler) + { + return make(make_symbol(name), make(name, compiler)); + }; + + let static const core_syntactic_environment = make( + list(), + list(bind("begin" , syntax::sequence ), + bind("call-with-current-continuation!", syntax::call_with_current_continuation), + bind("current" , syntax::current ), + bind("define" , syntax::define ), + bind("define-syntax" , syntax::define_syntax ), + bind("if" , syntax::conditional ), + bind("install" , syntax::install ), + bind("lambda" , syntax::lambda ), + bind("let-syntax" , syntax::let_syntax ), + bind("letrec" , syntax::letrec ), + bind("letrec-syntax" , syntax::letrec_syntax ), + bind("quote" , syntax::quote ), + bind("quote-syntax" , syntax::quote_syntax ), + bind("set!" , syntax::set ))); + + return make(core_syntactic_environment, unit, make_symbol(variable)); } - auto bound_variables() noexcept -> object & + static auto unify(object const& a, object const& b) -> object { - return first; + /* + Consider the following case where an expression that uses a local + macro is given: + + (let ((x 'outer)) + (let-syntax ((m (sc-macro-transformer + (lambda (form environment) + 'x)))) + (let ((x 'inner)) + (m)))) + + Where, the bound variables that the syntactic closure returned by + sc-macro-transformer encloses are ((x)), and the bound variables when + using the local macro m are ((x) (m) (x)). + + The result of the expansion of local macro m must be a reference to + the local variable x that binds the symbol "outer" and not the one + that binds the symbol "inner". That is, the operand of the relative + loading instruction resulting from the expansion of the local macro m + must be de Bruijn index (2 . 0). + + However, since syntactic_closure::identify searches bound variables + from inside to outside to create de Bruijn index, it straightforwardly + uses bound variables ((x) (m) (x)) when using local macro m would + result in index (0 . 0). + + This problem is specific to cases where the syntactic closure encloses + an expression that refers to a local variable. Such a synthetic + closure can only be created by a local macro, and its use is limited + to the environment inside the local macro definition. Therefore, there + is a common tail between the bound variables that the + syntactic-closure inserted by the local macro encloses and the bound + variables when the local macro is used. + + By searching for the common tail of the two bound variables and cons a + dummy environment in front of the list to match the length of the + longer bound variables, we can create bound variables that lead to an + appropriate de Bruijn index. In the example above, this is (() () + (x)). + */ + let xs = longest_common_tail(a, b); + + for (auto offset = std::max(length(a), length(b)) - length(xs); 0 < offset; --offset) + { + xs = cons(unit, xs); + } + + return xs; } }; } // namespace kernel diff --git a/src/kernel/list.cpp b/src/kernel/list.cpp index 3cf1117c0..a404cb098 100644 --- a/src/kernel/list.cpp +++ b/src/kernel/list.cpp @@ -102,5 +102,19 @@ inline namespace kernel return f; } } + + auto longest_common_tail(let const& a, let const& b) -> object const& + { + if (a.is() or b.is() or eq(a, b)) + { + return a; + } + else + { + let const& x = longest_common_tail(a, cdr(b)); + let const& y = longest_common_tail(cdr(a), b); + return length(x) < length(y) ? y : x; + } + } } // namespace kernel } // namespace meevax From f2f5d83bb674371ff509c7e9f03e72813f05bb4e Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 20 Jul 2023 00:54:27 +0900 Subject: [PATCH 28/28] Update to compile with the free-names in `syntactic_closure` respected Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 43 +++++++++++++------ test/macro-transformers.ss | 36 +++++++++++++++- 4 files changed, 69 insertions(+), 18 deletions(-) diff --git a/README.md b/README.md index 443a5c700..86d58c9af 100644 --- a/README.md +++ b/README.md @@ -100,16 +100,16 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |--------------------|--- -| `all` (default) | Build shared-library `libmeevax.0.4.751.so` and executable `meevax` +| `all` (default) | Build shared-library `libmeevax.0.4.752.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.4.751_amd64.deb` +| `package` | Generate debian package `meevax_0.4.752_amd64.deb` | `install` | Copy files into `/usr/local` | `install.deb` | `all` + `package` + `sudo apt install .deb` ## Usage ``` -Meevax Lisp 0.4.751 +Meevax Lisp 0.4.752 Usage: meevax [option...] [file...] diff --git a/VERSION b/VERSION index 067948d99..ab799db22 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.4.751 +0.4.752 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 59c8f7005..95ac8c762 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -1046,10 +1046,29 @@ inline namespace kernel } else { + auto extend = [=](let const& free_variables) + { + let xs = free_variables; + + for (let const& free_variable : cadr(expression)) + { + let const inject = make("inject", [=](let const& xs) + { + return identify(free_variable, + unify(bound_variables, xs), + free_variables); + }); + + xs = cons(cons(free_variable, inject), xs); + } + + return xs; + }; + return car(expression).as() .compile(cddr(expression), unify(caar(expression), bound_variables), - unit, + extend(free_variables), continuation); } } @@ -1153,6 +1172,10 @@ inline namespace kernel { return f; } + else if (let const& x = assq(variable, free_variables); is_truthy(x)) + { + return cdr(x).as().call(bound_variables); + } else { auto i = identity::index(0); @@ -1275,18 +1298,10 @@ inline namespace kernel loading instruction resulting from the expansion of the local macro m must be de Bruijn index (2 . 0). - However, since syntactic_closure::identify searches bound variables - from inside to outside to create de Bruijn index, it straightforwardly - uses bound variables ((x) (m) (x)) when using local macro m would - result in index (0 . 0). - - This problem is specific to cases where the syntactic closure encloses - an expression that refers to a local variable. Such a synthetic - closure can only be created by a local macro, and its use is limited - to the environment inside the local macro definition. Therefore, there - is a common tail between the bound variables that the - syntactic-closure inserted by the local macro encloses and the bound - variables when the local macro is used. + However, since syntactic_environment::identify searches bound + variables from inside to outside to create de Bruijn index, it + straightforwardly uses bound variables ((x) (m) (x)) when using local + macro m would result in index (0 . 0). By searching for the common tail of the two bound variables and cons a dummy environment in front of the list to match the length of the @@ -1296,6 +1311,8 @@ inline namespace kernel */ let xs = longest_common_tail(a, b); + assert(length(xs) <= std::min(length(a), length(b))); + for (auto offset = std::max(length(a), length(b)) - length(xs); 0 < offset; --offset) { xs = cons(unit, xs); diff --git a/test/macro-transformers.ss b/test/macro-transformers.ss index 6689b3abd..ea7373a1b 100644 --- a/test/macro-transformers.ss +++ b/test/macro-transformers.ss @@ -407,6 +407,40 @@ ; ------------------------------------------------------------------------------ +(define-syntax aif + (sc-macro-transformer + (lambda (form at-use) + (let ((test (make-syntactic-closure at-use '() (cadr form))) + (consequent (make-syntactic-closure at-use '(it) (caddr form))) + (alternative (if (null? (cdddr form)) + (if #f #f) + (make-syntactic-closure at-use '() (cadddr form))))) + `(let ((it ,test)) + (if it ,consequent ,alternative)))))) + +(check (aif (memq 'b '(a b c)) + (car it)) + => 'b) + +(check (aif (memq 'b '(a b c)) + (let ((it 'inner)) + (car it))) + => 'b) + +(check (aif (memq 'b '(a b c)) + (let ((it 'inner-1)) + (let ((it 'inner-0)) + (car it)))) + => 'b) + +(check (let ((it 'outer)) + (aif (memq 'b '(a b c)) + (let ((it 'inner)) + (car it)))) + => 'b) + +; ------------------------------------------------------------------------------ + (check-report) -(exit (check-passed? 48)) +(exit (check-passed? 52))