From f2f5d83bb674371ff509c7e9f03e72813f05bb4e Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 20 Jul 2023 00:54:27 +0900 Subject: [PATCH] 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))