From c704ea02dbdd8447573656fc1646e52b591ac640 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 4 Aug 2024 12:32:44 +0900 Subject: [PATCH 1/7] Update `syntactic_closure` to have elements directly as class members Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 89 ++++++++++--------- src/kernel/boot.cpp | 2 +- 4 files changed, 53 insertions(+), 46 deletions(-) diff --git a/README.md b/README.md index b267143db..abb619bf4 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.213_amd64.deb +sudo apt install build/meevax_0.5.214_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.213.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.214.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.213_amd64.deb` +| `package` | Generate debian package `meevax_0.5.214_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 4fca4c220..e371a7695 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.213 +0.5.214 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 52667171b..138be577f 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -30,30 +30,36 @@ inline namespace kernel template struct syntactic_environment : public virtual pair // ( . ) { - struct syntactic_closure : public virtual pair // ( . ) - , public identifier + struct syntactic_closure : public identifier { - template - auto compile(let const& user, Ts&&... xs) + let macro_environment, free_names, expression; + + explicit syntactic_closure(let const& macro_environment, + let const& free_names, + let const& expression) + : macro_environment { macro_environment } + , free_names { free_names } + , expression { expression } { - assert(user.is()); - - let const& maker = car(*this); - - let const& free_variables = cadr(*this); - - let const& expression = cddr(*this); + assert(macro_environment.is()); + } - return maker.as().compile(expression, - unify(car(maker), car(user)), - map([&](let const& free_variable) - { - return cons(free_variable, user); - }, - free_variables, - cdr(user) - ), - std::forward(xs)...); + template + auto compile(let const& use_environment, Ts&&... xs) + { + assert(use_environment.is()); + + return macro_environment.as() + .compile(expression, + unify(car(macro_environment), + car(use_environment)), + map([&](let const& free_name) + { + return cons(free_name, use_environment); + }, + free_names, + cdr(use_environment)), + std::forward(xs)...); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -67,24 +73,21 @@ inline namespace kernel 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()); - - return cddr(x).template is_also() and - cddr(y).template is_also() and - eqv(car(x).template as() - .identify(cddr(x), - caar(x), - nullptr), - car(y).template as() - .identify(cddr(y), - caar(y), - nullptr)); + return x.expression.is_also() and + y.expression.is_also() and + eqv(x.macro_environment.as() + .identify(x.expression, + car(x.macro_environment), + nullptr), + y.macro_environment.as() + .identify(y.expression, + car(y.macro_environment), + nullptr)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & { - return os << underline(cddr(datum)); + return os << underline(datum.expression); } }; @@ -478,7 +481,8 @@ inline namespace kernel static GENERATOR(quote) { - return CONS(make(instruction::load_constant), car(expression).is() ? cddar(expression) : car(expression), + return CONS(make(instruction::load_constant), car(expression).is() ? car(expression).as().expression + : car(expression), continuation); } @@ -981,10 +985,13 @@ inline namespace kernel if (variable.is()) { - return car(variable).as() - .identify(cddr(variable), - unify(caar(variable), bound_variables), - nullptr); + return variable.as() + .macro_environment + .template as() + .identify(variable.as().expression, + unify(car(variable.as().macro_environment), + bound_variables), + nullptr); } else { @@ -1037,7 +1044,7 @@ inline namespace kernel static auto rename(std::string const& variable) { - return make(core(), cons(nullptr, make_symbol(variable))); + return make(core(), unit, make_symbol(variable)); } inline auto sweep(object const& form, diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index c631352d6..6dd967a00 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -1750,7 +1750,7 @@ inline namespace kernel library.define("make-syntactic-closure", [](let const& xs) { - return make(car(xs), cons(cadr(xs), caddr(xs))); + return make(car(xs), cadr(xs), caddr(xs)); }); }); From 463fce950648743136e7f127ebacc015ec356f8f Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 4 Aug 2024 20:09:58 +0900 Subject: [PATCH 2/7] Lipsticks Signed-off-by: yamacir-kit --- README.md | 6 +-- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 37 ++++++++++++------- 3 files changed, 27 insertions(+), 18 deletions(-) diff --git a/README.md b/README.md index abb619bf4..cd7d2e580 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.214_amd64.deb +sudo apt install build/meevax_0.5.215_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.214.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.215.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.214_amd64.deb` +| `package` | Generate debian package `meevax_0.5.215_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index e371a7695..58129bae7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.214 +0.5.215 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 138be577f..5ad23c2b5 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -49,17 +49,24 @@ inline namespace kernel { assert(use_environment.is()); + let const bound_variables = unify(car(macro_environment), + car(use_environment)); + + let const free_variables = map([&](let const& free_name) + { + return cons(free_name, use_environment); + }, + free_names, + cdr(use_environment)); + return macro_environment.as() - .compile(expression, - unify(car(macro_environment), - car(use_environment)), - map([&](let const& free_name) - { - return cons(free_name, use_environment); - }, - free_names, - cdr(use_environment)), - std::forward(xs)...); + .generate(macro_environment.as() + .expand(expression, + bound_variables, + free_variables), + bound_variables, + free_variables, + std::forward(xs)...); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -73,13 +80,13 @@ inline namespace kernel as else in a cond clause. A macro definition for syntax-rules would use free-identifier=? to look for literals in the input. */ - return x.expression.is_also() and - y.expression.is_also() and - eqv(x.macro_environment.as() + return x.expression.template is_also() and + y.expression.template is_also() and + eqv(x.macro_environment.template as() .identify(x.expression, car(x.macro_environment), nullptr), - y.macro_environment.as() + y.macro_environment.template as() .identify(y.expression, car(y.macro_environment), nullptr)); @@ -1029,6 +1036,8 @@ inline namespace kernel whereas it would be an error to perform a set! on an unbound variable. */ + assert(not variable.is()); + return car(second = cons(make(variable, undefined), second)); } } From c6badae3c4ca200601b16758af4d7676f7adde18 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Tue, 6 Aug 2024 01:45:15 +0900 Subject: [PATCH 3/7] Simplify the resolution of free names in `syntactic_closure` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 81 +++++++++---------- 3 files changed, 42 insertions(+), 47 deletions(-) diff --git a/README.md b/README.md index cd7d2e580..a7803b7d5 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.215_amd64.deb +sudo apt install build/meevax_0.5.216_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.215.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.216.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.215_amd64.deb` +| `package` | Generate debian package `meevax_0.5.216_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 58129bae7..2b4c075c5 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.215 +0.5.216 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 5ad23c2b5..262e00e5f 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -32,36 +32,31 @@ inline namespace kernel { struct syntactic_closure : public identifier { - let macro_environment, free_names, expression; + let inner_environment, free_names, expression; - explicit syntactic_closure(let const& macro_environment, + explicit syntactic_closure(let const& inner_environment, let const& free_names, let const& expression) - : macro_environment { macro_environment } + : inner_environment { inner_environment } , free_names { free_names } , expression { expression } { - assert(macro_environment.is()); + assert(inner_environment.is()); } template - auto compile(let const& use_environment, Ts&&... xs) + auto compile(let const& outer_environment, Ts&&... xs) { - assert(use_environment.is()); + assert(outer_environment.is()); - let const bound_variables = unify(car(macro_environment), - car(use_environment)); + let const bound_variables = unify(car(inner_environment), + car(outer_environment)); - let const free_variables = map([&](let const& free_name) - { - return cons(free_name, use_environment); - }, - free_names, - cdr(use_environment)); + let const free_variables = unit; - return macro_environment.as() - .generate(macro_environment.as() - .expand(expression, + return inner_environment.as() + .generate(inner_environment.as() + .expand(inject(outer_environment, free_names, expression), bound_variables, free_variables), bound_variables, @@ -69,6 +64,25 @@ inline namespace kernel std::forward(xs)...); } + static auto inject(let const& outer_environment, + let const& free_names, + let const& form) -> object + { + if (form.is()) + { + return cons(inject(outer_environment, free_names, car(form)), + inject(outer_environment, free_names, cdr(form))); + } + else if (let const& x = memq(form, free_names); x != f) + { + return make(outer_environment, unit, form); + } + else + { + return form; + } + } + friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool { /* @@ -82,13 +96,13 @@ inline namespace kernel */ return x.expression.template is_also() and y.expression.template is_also() and - eqv(x.macro_environment.template as() + eqv(x.inner_environment.template as() .identify(x.expression, - car(x.macro_environment), + car(x.inner_environment), nullptr), - y.macro_environment.template as() + y.inner_environment.template as() .identify(y.expression, - car(y.macro_environment), + car(y.inner_environment), nullptr)); } @@ -952,16 +966,6 @@ inline namespace kernel { return f; } - else if (let const& x = assq(variable, free_variables); x != f) - { - /* - If a macro transformer inserts a free reference to an identifier, - the reference refers to the binding that was visible where the - transformer was specified, regardless of any local bindings that - surround the use of the macro. - */ - return cdr(x).as().inject(car(x), bound_variables); - } else { auto i = 0; @@ -990,13 +994,13 @@ inline namespace kernel } } - if (variable.is()) + if (variable.is()) // Resolve alias { return variable.as() - .macro_environment + .inner_environment .template as() .identify(variable.as().expression, - unify(car(variable.as().macro_environment), + unify(car(variable.as().inner_environment), bound_variables), nullptr); } @@ -1042,15 +1046,6 @@ inline namespace kernel } } - inline auto inject(object const& free_variable, - object const& bound_variables) -> object - { - return identify(free_variable, - unify(first /* bound-variables */, - bound_variables), - second /* free-variables */); - } - static auto rename(std::string const& variable) { return make(core(), unit, make_symbol(variable)); From 1909ca912dc20de76dd3b73f5353c65c427d0caf Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Tue, 6 Aug 2024 01:52:17 +0900 Subject: [PATCH 4/7] Rename `syntactic_closure::expression` to `form` Signed-off-by: yamacir-kit --- README.md | 6 ++--- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 22 +++++++++---------- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index a7803b7d5..c1834f06e 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.216_amd64.deb +sudo apt install build/meevax_0.5.217_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.216.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.217.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.216_amd64.deb` +| `package` | Generate debian package `meevax_0.5.217_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 2b4c075c5..dde70f925 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.216 +0.5.217 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 262e00e5f..0b7c89864 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -32,14 +32,14 @@ inline namespace kernel { struct syntactic_closure : public identifier { - let inner_environment, free_names, expression; + let inner_environment, free_names, form; explicit syntactic_closure(let const& inner_environment, let const& free_names, - let const& expression) + let const& form) : inner_environment { inner_environment } , free_names { free_names } - , expression { expression } + , form { form } { assert(inner_environment.is()); } @@ -56,7 +56,7 @@ inline namespace kernel return inner_environment.as() .generate(inner_environment.as() - .expand(inject(outer_environment, free_names, expression), + .expand(inject(outer_environment, free_names, form), bound_variables, free_variables), bound_variables, @@ -94,21 +94,21 @@ inline namespace kernel as else in a cond clause. A macro definition for syntax-rules would use free-identifier=? to look for literals in the input. */ - return x.expression.template is_also() and - y.expression.template is_also() and + return x.form.template is_also() and + y.form.template is_also() and eqv(x.inner_environment.template as() - .identify(x.expression, + .identify(x.form, car(x.inner_environment), nullptr), y.inner_environment.template as() - .identify(y.expression, + .identify(y.form, car(y.inner_environment), nullptr)); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & { - return os << underline(datum.expression); + return os << underline(datum.form); } }; @@ -502,7 +502,7 @@ inline namespace kernel static GENERATOR(quote) { - return CONS(make(instruction::load_constant), car(expression).is() ? car(expression).as().expression + return CONS(make(instruction::load_constant), car(expression).is() ? car(expression).as().form : car(expression), continuation); } @@ -999,7 +999,7 @@ inline namespace kernel return variable.as() .inner_environment .template as() - .identify(variable.as().expression, + .identify(variable.as().form, unify(car(variable.as().inner_environment), bound_variables), nullptr); From 3b81fd396a6c608b93514f2f68db5134e41a3311 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Tue, 6 Aug 2024 02:35:24 +0900 Subject: [PATCH 5/7] Remove argument `free_variables` from `syntactic_environment` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 208 ++++++------------ src/kernel/environment.cpp | 2 +- src/kernel/library.cpp | 4 +- 5 files changed, 74 insertions(+), 148 deletions(-) diff --git a/README.md b/README.md index c1834f06e..79cfcbc12 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.217_amd64.deb +sudo apt install build/meevax_0.5.218_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.217.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.218.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.217_amd64.deb` +| `package` | Generate debian package `meevax_0.5.218_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index dde70f925..8b9673e5c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.217 +0.5.218 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 0b7c89864..162e74a01 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -52,15 +52,11 @@ inline namespace kernel let const bound_variables = unify(car(inner_environment), car(outer_environment)); - let const free_variables = unit; - return inner_environment.as() .generate(inner_environment.as() .expand(inject(outer_environment, free_names, form), - bound_variables, - free_variables), + bound_variables), bound_variables, - free_variables, std::forward(xs)...); } @@ -98,12 +94,10 @@ inline namespace kernel y.form.template is_also() and eqv(x.inner_environment.template as() .identify(x.form, - car(x.inner_environment), - nullptr), + car(x.inner_environment)), y.inner_environment.template as() .identify(y.form, - car(y.inner_environment), - nullptr)); + car(y.inner_environment))); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -116,13 +110,11 @@ inline namespace kernel { auto (*expand)(syntactic_environment const&, object const& expression, - object const& bound_variables, - object const& free_variables) -> object; + object const& bound_variables) -> object; auto (*generate)(syntactic_environment &, object const& /* expression */, object const& /* bound_variables */, - object const& /* free_variables */, object const& /* continuation */, bool /* tail */) -> object; @@ -165,7 +157,7 @@ inline namespace kernel template auto list(Ts&&... xs) const -> decltype(auto) { - return cons(std::forward(xs)..., nullptr); + return cons(std::forward(xs)..., unit); } }; @@ -184,8 +176,7 @@ inline namespace kernel #define EXPANDER(NAME) \ auto NAME([[maybe_unused]] syntactic_environment const& expander, \ object const& expression, \ - [[maybe_unused]] object const& bound_variables, \ - [[maybe_unused]] object const& free_variables) -> object + [[maybe_unused]] object const& bound_variables) -> object static EXPANDER(quote) { @@ -200,12 +191,10 @@ inline namespace kernel static EXPANDER(call) { return CONS(expander.expand(car(expression), - bound_variables, - free_variables), + bound_variables), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(operand) @@ -213,16 +202,14 @@ inline namespace kernel if (expression.is()) { return CONS(expander.expand(car(expression), - bound_variables, - free_variables), + bound_variables), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } else { - return expander.expand(expression, bound_variables, free_variables); + return expander.expand(expression, bound_variables); } } @@ -232,13 +219,12 @@ inline namespace kernel CONS(cadr(expression) /* formals */, body(expander, cddr(expression), - cons(cadr(expression) /* formals */, bound_variables), - free_variables))); + cons(cadr(expression) /* formals */, bound_variables)))); } static EXPANDER(body) { - if (auto [binding_specs, sequence] = expander.sweep(expression, bound_variables, free_variables); binding_specs) + if (auto [binding_specs, sequence] = expander.sweep(expression, bound_variables); binding_specs) { /* (letrec* ) @@ -249,7 +235,7 @@ inline namespace kernel where = (( ) ... ( )) */ - let formals = nullptr; + let formals = unit; let body = sequence; @@ -280,23 +266,20 @@ inline namespace kernel return expander.expand(LIST(CONS(CONS(rename("lambda"), formals, body), - make_list(length(binding_specs), nullptr))), - bound_variables, - free_variables); + make_list(length(binding_specs), unit))), + bound_variables); } else if (sequence.template is()) { return CONS(expander.expand(car(sequence), - bound_variables, - free_variables), + bound_variables), body(expander, cdr(sequence), - bound_variables, - free_variables)); + bound_variables)); } else { - return expander.expand(sequence, bound_variables, free_variables); + return expander.expand(sequence, bound_variables); } } @@ -305,8 +288,7 @@ inline namespace kernel return CONS(car(expression), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(set) @@ -314,32 +296,28 @@ inline namespace kernel return CONS(car(expression), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(include) { return expander.expand(CONS(rename("begin"), meevax::include(cadr(expression))), - bound_variables, - free_variables); + bound_variables); } static EXPANDER(include_case_insensitive) { return expander.expand(CONS(rename("begin"), meevax::include(cadr(expression), false)), - bound_variables, - free_variables); + bound_variables); } static EXPANDER(conditional_expand) { return expander.expand(CONS(rename("begin"), meevax::conditional_expand(cdr(expression))), - bound_variables, - free_variables); + bound_variables); } static EXPANDER(letrec) @@ -351,14 +329,12 @@ inline namespace kernel { return LIST(car(binding), expander.expand(cadr(binding), - extended_bound_variables, - free_variables)); + extended_bound_variables)); }, cadr(expression)), body(expander, cddr(expression), - extended_bound_variables, - free_variables)); + extended_bound_variables)); } static EXPANDER(sequence) @@ -366,16 +342,14 @@ inline namespace kernel if (expression.is()) { return CONS(expander.expand(car(expression), - bound_variables, - free_variables), + bound_variables), sequence(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } else { - return expander.expand(expression, bound_variables, free_variables); + return expander.expand(expression, bound_variables); } } @@ -395,8 +369,7 @@ inline namespace kernel return expander.expand(LIST(CONS(rename("lambda"), formals, cddr(expression) /* body */)), - bound_variables, - free_variables); + bound_variables); } static EXPANDER(letrec_syntax) @@ -417,8 +390,7 @@ inline namespace kernel return expander.expand(LIST(CONS(rename("lambda"), formals, cddr(expression) /* body */)), - bound_variables, - free_variables); + bound_variables); } static EXPANDER(define) @@ -432,16 +404,14 @@ inline namespace kernel expander.expand(CONS(rename("lambda"), cdadr(expression) /* formals */, cddr(expression) /* body */), - bound_variables, - free_variables)); + bound_variables)); } else // (define ) { return CONS(car(expression), cadr(expression), cddr(expression) ? LIST(expander.expand(caddr(expression), - bound_variables, - free_variables)) + bound_variables)) : unit); } } @@ -456,8 +426,7 @@ inline namespace kernel return LIST(car(expression), cadr(expression), expander.expand(caddr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(call_with_current_continuation) @@ -465,8 +434,7 @@ inline namespace kernel return CONS(car(expression), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(current) @@ -474,8 +442,7 @@ inline namespace kernel return CONS(car(expression), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } static EXPANDER(install) @@ -483,8 +450,7 @@ inline namespace kernel return CONS(car(expression), operand(expander, cdr(expression), - bound_variables, - free_variables)); + bound_variables)); } #undef EXPANDER @@ -496,7 +462,6 @@ inline namespace kernel auto NAME([[maybe_unused]] syntactic_environment & generator, \ [[maybe_unused]] object const& expression, \ [[maybe_unused]] object const& bound_variables, \ - [[maybe_unused]] object const& free_variables, \ [[maybe_unused]] object const& continuation, \ [[maybe_unused]] bool tail = false) -> object @@ -518,10 +483,8 @@ inline namespace kernel return operand(generator, cdr(expression), bound_variables, - free_variables, generator.generate(car(expression), bound_variables, - free_variables, tail ? LIST(make(instruction::tail_call)) : CONS(make(instruction::call), continuation))); } @@ -533,16 +496,14 @@ inline namespace kernel return operand(generator, cdr(expression), bound_variables, - free_variables, generator.generate(car(expression), bound_variables, - free_variables, CONS(make(instruction::cons), continuation))); } else { - return generator.generate(expression, bound_variables, free_variables, continuation); + return generator.generate(expression, bound_variables, continuation); } } @@ -552,7 +513,6 @@ inline namespace kernel body(generator, cdr(expression), cons(car(expression), bound_variables), // Extend scope. - free_variables, LIST(make(instruction::return_))), continuation); } @@ -563,7 +523,6 @@ inline namespace kernel { return generator.generate(car(expression), bound_variables, - free_variables, continuation, true); } @@ -571,12 +530,10 @@ inline namespace kernel { return generator.generate(car(expression), bound_variables, - free_variables, CONS(make(instruction::drop), body(generator, cdr(expression), bound_variables, - free_variables, continuation)), false); } @@ -590,16 +547,13 @@ inline namespace kernel return generator.generate(car(expression), // bound_variables, - free_variables, LIST(make(instruction::tail_select), generator.generate(cadr(expression), bound_variables, - free_variables, continuation, tail), cddr(expression) ? generator.generate(caddr(expression), bound_variables, - 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. @@ -609,15 +563,12 @@ inline namespace kernel { return generator.generate(car(expression), // bound_variables, - free_variables, CONS(make(instruction::select), generator.generate(cadr(expression), bound_variables, - free_variables, LIST(make(instruction::join))), cddr(expression) ? generator.generate(caddr(expression), 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. make(instruction::join)), @@ -627,11 +578,10 @@ inline namespace kernel static GENERATOR(set) { - if (let const& identity = generator.identify(car(expression), bound_variables, free_variables); identity.is()) + if (let const& identity = generator.identify(car(expression), bound_variables); identity.is()) { return generator.generate(cadr(expression), bound_variables, - free_variables, CONS(make(instruction::store_relative), identity, continuation)); } @@ -639,7 +589,6 @@ inline namespace kernel { return generator.generate(cadr(expression), bound_variables, - free_variables, CONS(make(instruction::store_variadic), identity, continuation)); } @@ -649,7 +598,6 @@ inline namespace kernel return generator.generate(cadr(expression), bound_variables, - free_variables, CONS(make(instruction::store_absolute), identity, continuation)); } @@ -671,11 +619,9 @@ inline namespace kernel operand(generator, map(cadr, car(expression)), cons(formals, bound_variables), - free_variables, lambda(generator, cons(formals, cdr(expression)), // ( ) bound_variables, - free_variables, tail ? LIST(make(instruction::tail_letrec)) : CONS(make(instruction::letrec), continuation)))); } @@ -686,7 +632,6 @@ inline namespace kernel { return generator.generate(car(expression), bound_variables, - free_variables, continuation, tail); } @@ -703,14 +648,12 @@ inline namespace kernel */ let const& head = generator.generate(car(expression), // Head expression or definition bound_variables, - free_variables, - nullptr); + unit); return append(head, CONS(make(instruction::drop), // Pop result of head expression sequence(generator, cdr(expression), // Rest expression or definitions bound_variables, - free_variables, continuation, tail))); } @@ -728,14 +671,13 @@ inline namespace kernel return generator.generate(cdr(expression) ? cadr(expression) : unspecified, bound_variables, - free_variables, - CONS(make(instruction::store_absolute), generator.identify(car(expression), bound_variables, free_variables), + CONS(make(instruction::store_absolute), generator.identify(car(expression), bound_variables), continuation)); } static GENERATOR(define_syntax) { - let identity = generator.identify(car(expression), nullptr, nullptr); + let identity = generator.identify(car(expression), unit); cdr(identity) = make(Environment().execute(generator.generate(cadr(expression), bound_variables)), @@ -755,7 +697,6 @@ inline namespace kernel continuation, generator.generate(car(expression), 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)); } @@ -770,7 +711,6 @@ inline namespace kernel { return generator.generate(cadr(expression), bound_variables, - free_variables, CONS(make(instruction::install), car(expression), continuation)); } @@ -782,20 +722,17 @@ inline namespace kernel template inline auto compile(object const& expression, - object const& bound_variables, - object const& free_variables, Ts&&... xs) -> decltype(auto) + object const& bound_variables, Ts&&... xs) -> decltype(auto) { return generate(expand(expression, - bound_variables, - free_variables), + bound_variables), bound_variables, - free_variables, std::forward(xs)...); } inline auto compile(object const& expression) -> decltype(auto) { - return compile(expression, first, nullptr); + return compile(expression, first); } static auto core() -> auto const& @@ -804,7 +741,7 @@ inline namespace kernel make(make_symbol(NAME), make(NAME, expander::SYNTAX, generator::SYNTAX)) let static const core = make( - nullptr, + unit, list(BINDING("begin" , sequence ), BINDING("call-with-current-continuation!", call_with_current_continuation), BINDING("conditional-expand" , conditional_expand ), @@ -830,8 +767,8 @@ inline namespace kernel inline auto define(object const& variable, object const& value = undefined) -> void { - assert(identify(variable, nullptr, nullptr).template is()); - cdr(identify(variable, nullptr, nullptr)) = value; + assert(identify(variable, unit).template is()); + cdr(identify(variable, unit)) = value; } template @@ -854,14 +791,13 @@ inline namespace kernel } inline auto expand(object const& expression, - object const& bound_variables = nullptr, // list of - object const& free_variables = nullptr) const -> object try + object const& bound_variables = unit) const -> object try { if (not expression.is()) { return expression; } - else if (let const& identity = identify(car(expression), bound_variables, free_variables); identity.is()) + else if (let const& identity = identify(car(expression), bound_variables); identity.is()) { if (cdr(identity).is()) { @@ -890,15 +826,15 @@ inline namespace kernel syntax::contexts[transformed.get()] = expression; - return expand(transformed, bound_variables, free_variables); + return expand(transformed, bound_variables); } else if (cdr(identity).is()) { - return cdr(identity).as().expand(*this, expression, bound_variables, free_variables); + return cdr(identity).as().expand(*this, expression, bound_variables); } } - return expander::call(*this, expression, bound_variables, free_variables); + return expander::call(*this, expression, bound_variables); } catch (error & e) { @@ -907,8 +843,7 @@ inline namespace kernel } inline auto generate(object const& expression, - object const& bound_variables = nullptr, // list of - object const& free_variables = nullptr, + object const& bound_variables, object const& continuation = list(make(instruction::stop)), bool tail = false) -> object try { @@ -918,8 +853,8 @@ inline namespace kernel { assert(expression.is() or expression.is()); - if (let const& identity = expression.is() ? identify(expression, bound_variables, free_variables) - : std::as_const(*this).identify(expression, bound_variables, free_variables); + if (let const& identity = expression.is() ? identify(expression, bound_variables) + : std::as_const(*this).identify(expression, bound_variables); identity.is()) { return CONS(make(instruction::load_relative), identity, continuation); @@ -935,7 +870,7 @@ inline namespace kernel else { assert(identity == f); - return expression.as().compile(make(bound_variables, free_variables), continuation); + return expression.as().compile(make(bound_variables), continuation); } } else // is @@ -943,13 +878,13 @@ inline namespace kernel return CONS(make(instruction::load_constant), expression, continuation); } } - else if (let const& identity = std::as_const(*this).identify(car(expression), bound_variables, free_variables); identity.is() and cdr(identity).is()) + else if (let const& identity = std::as_const(*this).identify(car(expression), bound_variables); identity.is() and cdr(identity).is()) { - return cdr(identity).as().generate(*this, cdr(expression), bound_variables, free_variables, continuation, tail); + return cdr(identity).as().generate(*this, cdr(expression), bound_variables, continuation, tail); } else { - return generator::call(*this, expression, bound_variables, free_variables, continuation, tail); + return generator::call(*this, expression, bound_variables, continuation, tail); } } catch (error & e) @@ -959,8 +894,7 @@ inline namespace kernel } inline auto identify(object const& variable, - object const& bound_variables, - object const& free_variables) const -> object + object const& bound_variables) const -> object { if (not variable.is_also()) { @@ -1001,8 +935,7 @@ inline namespace kernel .template as() .identify(variable.as().form, unify(car(variable.as().inner_environment), - bound_variables), - nullptr); + bound_variables)); } else { @@ -1012,14 +945,13 @@ inline namespace kernel } inline auto identify(object const& variable, - object const& bound_variables, - object const& free_variables) + object const& bound_variables) { if (not variable.is_also()) { return f; } - else if (let const& identity = std::as_const(*this).identify(variable, bound_variables, free_variables); identity != f) + else if (let const& identity = std::as_const(*this).identify(variable, bound_variables); identity != f) { return identity; } @@ -1053,12 +985,11 @@ inline namespace kernel inline auto sweep(object const& form, object const& bound_variables, - object const& free_variables, - object const& binding_specs = nullptr) const -> pair + object const& binding_specs = unit) const -> pair { if (form.is() and car(form).is()) { - if (let const& identity = identify(caar(form), bound_variables, free_variables); identity.is()) + if (let const& identity = identify(caar(form), bound_variables); identity.is()) { if (let const& value = cdr(identity); value.is()) { @@ -1068,7 +999,6 @@ inline namespace kernel cddr(identity)), // mac-env cdr(form)), bound_variables, - free_variables, binding_specs); } else if (value.is()) @@ -1077,7 +1007,6 @@ inline namespace kernel { return sweep(append(cdar(form), cdr(form)), bound_variables, - free_variables, binding_specs); } else if (name == "define") //
= ((define ...) *) @@ -1086,7 +1015,6 @@ inline namespace kernel { return sweep(cdr(form), bound_variables, - free_variables, cons(list(caadr(definition), // cons(rename("lambda"), cdadr(definition), // @@ -1097,7 +1025,6 @@ inline namespace kernel { return sweep(cdr(form), bound_variables, - free_variables, cons(cdr(definition), binding_specs)); } } @@ -1105,7 +1032,6 @@ inline namespace kernel { return sweep(cdr(form), bound_variables, - free_variables, cons(list(make(cadar(form), // caddar(form))), // binding_specs)); @@ -1157,7 +1083,7 @@ inline namespace kernel for (auto offset = std::max(length(a), length(b)) - length(xs); 0 < offset; --offset) { - xs = cons(nullptr, xs); + xs = cons(unit, xs); } return xs; diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index 54488e239..4b0fc8227 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -234,7 +234,7 @@ inline namespace kernel { assert(immigrant.is()); - if (let const& inhabitant = std::as_const(*this).identify(car(immigrant), nullptr, nullptr); inhabitant == f or interactive) + if (let const& inhabitant = std::as_const(*this).identify(car(immigrant), unit); inhabitant == f or interactive) { second = cons(immigrant, second); } diff --git a/src/kernel/library.cpp b/src/kernel/library.cpp index 534478b17..7a2e65e59 100644 --- a/src/kernel/library.cpp +++ b/src/kernel/library.cpp @@ -85,12 +85,12 @@ inline namespace kernel assert(cadr(export_spec).is_also()); assert(caddr(export_spec).is_also()); return make(caddr(export_spec), - cdr(identify(cadr(export_spec), nullptr, nullptr))); + cdr(identify(cadr(export_spec), unit))); } else { assert(export_spec.is_also()); - return identify(export_spec, nullptr, nullptr); + return identify(export_spec, unit); } }, export_specs); From b668d6e89998d22ae4fb63a686e729508616aa2d Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Tue, 27 Aug 2024 03:29:54 +0900 Subject: [PATCH 6/7] Move the expansion of syntactic-closure from `generate` to `expand` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 276 +++++++++++------- src/kernel/boot.cpp | 2 +- src/kernel/error.cpp | 3 + test/expand.ss | 58 +++- test/macro-transformers.ss | 10 +- 7 files changed, 224 insertions(+), 133 deletions(-) diff --git a/README.md b/README.md index 79cfcbc12..ccf0e9004 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.218_amd64.deb +sudo apt install build/meevax_0.5.219_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.218.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.219.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.218_amd64.deb` +| `package` | Generate debian package `meevax_0.5.219_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 8b9673e5c..5c22a3a61 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.218 +0.5.219 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 162e74a01..3ad53c8e6 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -30,53 +30,84 @@ inline namespace kernel template struct syntactic_environment : public virtual pair // ( . ) { + struct renamer + { + virtual auto operator ()(let const& form) -> object + { + return form; + } + } static inline default_rename {}; + struct syntactic_closure : public identifier { - let inner_environment, free_names, form; + let environment, free_names, form; - explicit syntactic_closure(let const& inner_environment, + explicit syntactic_closure(let const& environment, let const& free_names, let const& form) - : inner_environment { inner_environment } - , free_names { free_names } - , form { form } + : environment { environment } + , free_names { free_names } + , form { form } { - assert(inner_environment.is()); + assert(environment.is()); } - template - auto compile(let const& outer_environment, Ts&&... xs) + auto expand(let const& bound_variables, renamer & inject) { - assert(outer_environment.is()); + struct sc_renamer : public renamer + { + syntactic_closure const* enclosure; - let const bound_variables = unify(car(inner_environment), - car(outer_environment)); + renamer & inject; - return inner_environment.as() - .generate(inner_environment.as() - .expand(inject(outer_environment, free_names, form), - bound_variables), - bound_variables, - std::forward(xs)...); - } + let renamings; - static auto inject(let const& outer_environment, - let const& free_names, - let const& form) -> object - { - if (form.is()) - { - return cons(inject(outer_environment, free_names, car(form)), - inject(outer_environment, free_names, cdr(form))); - } - else if (let const& x = memq(form, free_names); x != f) - { - return make(outer_environment, unit, form); - } - else - { - return form; - } + explicit sc_renamer(syntactic_closure const* enclosure, renamer & inject) + : enclosure { enclosure } + , inject { inject } + {} + + auto rename(let const& form, let const& free_names) -> object + { + if (form.is()) // is + { + return cons(rename(car(form), unit), + rename(cdr(form), unit)); // Disable injection when renaming formals. + } + else if (form.is()) + { + if (let const& free_name = memq(form, free_names); free_name != f) + { + return inject(form); + } + else if (let const& renaming = assq(form, renamings); renaming != f) + { + return cdr(renaming); + } + else + { + return cdar(renamings = alist_cons(form, + make(enclosure->environment, unit, form), + renamings)); + } + } + else + { + return form; + } + } + + auto operator ()(let const& form) -> object override + { + return rename(form, enclosure->free_names); + } + }; + + auto rename = sc_renamer(this, inject); + + return environment.as().expand(form, + unify(car(environment), bound_variables), + rename); } friend auto operator ==(syntactic_closure const& x, syntactic_closure const& y) -> bool @@ -92,12 +123,8 @@ inline namespace kernel */ return x.form.template is_also() and y.form.template is_also() and - eqv(x.inner_environment.template as() - .identify(x.form, - car(x.inner_environment)), - y.inner_environment.template as() - .identify(y.form, - car(y.inner_environment))); + eqv(x.environment.template as().identify(x.form, car(x.environment)), + y.environment.template as().identify(y.form, car(y.environment))); } friend auto operator <<(std::ostream & os, syntactic_closure const& datum) -> std::ostream & @@ -110,7 +137,8 @@ inline namespace kernel { auto (*expand)(syntactic_environment const&, object const& expression, - object const& bound_variables) -> object; + object const& bound_variables, + renamer &) -> object; auto (*generate)(syntactic_environment &, object const& /* expression */, @@ -176,7 +204,8 @@ inline namespace kernel #define EXPANDER(NAME) \ auto NAME([[maybe_unused]] syntactic_environment const& expander, \ object const& expression, \ - [[maybe_unused]] object const& bound_variables) -> object + [[maybe_unused]] object const& bound_variables, \ + [[maybe_unused]] renamer & rename) -> object static EXPANDER(quote) { @@ -191,10 +220,12 @@ inline namespace kernel static EXPANDER(call) { return CONS(expander.expand(car(expression), - bound_variables), + bound_variables, + rename), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(operand) @@ -202,24 +233,29 @@ inline namespace kernel if (expression.is()) { return CONS(expander.expand(car(expression), - bound_variables), + bound_variables, + rename), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } else { - return expander.expand(expression, bound_variables); + return expander.expand(expression, bound_variables, rename); } } static EXPANDER(lambda) { - return CONS(car(expression) /* lambda */, - CONS(cadr(expression) /* formals */, + let const& formals = rename(cadr(expression)); + + return CONS(rename(car(expression)) /* lambda */, + CONS(formals, body(expander, cddr(expression), - cons(cadr(expression) /* formals */, bound_variables)))); + cons(formals, bound_variables), + rename))); } static EXPANDER(body) @@ -247,7 +283,7 @@ inline namespace kernel if (not variable.is()) // The binding-spec is not an internal syntax definition. { - body = CONS(CONS(rename("set!"), binding_spec), body); + body = CONS(CONS(rename_("set!"), binding_spec), body); } } @@ -263,61 +299,69 @@ inline namespace kernel } } - return expander.expand(LIST(CONS(CONS(rename("lambda"), + return expander.expand(LIST(CONS(CONS(rename_("lambda"), formals, body), make_list(length(binding_specs), unit))), - bound_variables); + bound_variables, + rename); } else if (sequence.template is()) { return CONS(expander.expand(car(sequence), - bound_variables), + bound_variables, + rename), body(expander, cdr(sequence), - bound_variables)); + bound_variables, + rename)); } else { - return expander.expand(sequence, bound_variables); + return expander.expand(sequence, bound_variables, rename); } } static EXPANDER(conditional) { - return CONS(car(expression), + return CONS(rename(car(expression)), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(set) { - return CONS(car(expression), + return CONS(rename(car(expression)), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(include) { - return expander.expand(CONS(rename("begin"), + return expander.expand(CONS(rename_("begin"), meevax::include(cadr(expression))), - bound_variables); + bound_variables, + rename); } static EXPANDER(include_case_insensitive) { - return expander.expand(CONS(rename("begin"), + return expander.expand(CONS(rename_("begin"), meevax::include(cadr(expression), false)), - bound_variables); + bound_variables, + rename); } static EXPANDER(conditional_expand) { - return expander.expand(CONS(rename("begin"), + return expander.expand(CONS(rename_("begin"), meevax::conditional_expand(cdr(expression))), - bound_variables); + bound_variables, + rename); } static EXPANDER(letrec) @@ -329,12 +373,14 @@ inline namespace kernel { return LIST(car(binding), expander.expand(cadr(binding), - extended_bound_variables)); + extended_bound_variables, + rename)); }, cadr(expression)), body(expander, cddr(expression), - extended_bound_variables)); + extended_bound_variables, + rename)); } static EXPANDER(sequence) @@ -342,14 +388,16 @@ inline namespace kernel if (expression.is()) { return CONS(expander.expand(car(expression), - bound_variables), + bound_variables, + rename), sequence(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } else { - return expander.expand(expression, bound_variables); + return expander.expand(expression, bound_variables, rename); } } @@ -366,10 +414,11 @@ inline namespace kernel let const formals = map(formal, cadr(expression)); - return expander.expand(LIST(CONS(rename("lambda"), + return expander.expand(LIST(CONS(rename_("lambda"), formals, cddr(expression) /* body */)), - bound_variables); + bound_variables, + rename); } static EXPANDER(letrec_syntax) @@ -387,10 +436,11 @@ inline namespace kernel car(current_environment) = cons(formals, bound_variables); - return expander.expand(LIST(CONS(rename("lambda"), + return expander.expand(LIST(CONS(rename_("lambda"), formals, cddr(expression) /* body */)), - bound_variables); + bound_variables, + rename); } static EXPANDER(define) @@ -399,19 +449,21 @@ inline namespace kernel { if (cadr(expression).is()) // (define ( . ) ) { - return LIST(car(expression), + return LIST(rename(car(expression)), caadr(expression) /* variable */, - expander.expand(CONS(rename("lambda"), + expander.expand(CONS(rename_("lambda"), cdadr(expression) /* formals */, cddr(expression) /* body */), - bound_variables)); + bound_variables, + rename)); } else // (define ) { - return CONS(car(expression), + return CONS(rename(car(expression)), cadr(expression), cddr(expression) ? LIST(expander.expand(caddr(expression), - bound_variables)) + bound_variables, + rename)) : unit); } } @@ -423,34 +475,38 @@ inline namespace kernel static EXPANDER(define_syntax) { - return LIST(car(expression), + return LIST(rename(car(expression)), cadr(expression), expander.expand(caddr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(call_with_current_continuation) { - return CONS(car(expression), + return CONS(rename(car(expression)), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(current) { - return CONS(car(expression), + return CONS(rename(car(expression)), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } static EXPANDER(install) { - return CONS(car(expression), + return CONS(rename(car(expression)), operand(expander, cdr(expression), - bound_variables)); + bound_variables, + rename)); } #undef EXPANDER @@ -725,7 +781,8 @@ inline namespace kernel object const& bound_variables, Ts&&... xs) -> decltype(auto) { return generate(expand(expression, - bound_variables), + bound_variables, + default_rename), bound_variables, std::forward(xs)...); } @@ -791,11 +848,20 @@ inline namespace kernel } inline auto expand(object const& expression, - object const& bound_variables = unit) const -> object try + object const& bound_variables, + renamer & rename) const -> object try { if (not expression.is()) { - return expression; + if (expression.is()) + { + if (let const& identity = identify(expression, bound_variables); identity == f) + { + return expression.as().expand(bound_variables, rename); + } + } + + return expression.is_also() ? rename(expression) : expression; } else if (let const& identity = identify(car(expression), bound_variables); identity.is()) { @@ -826,15 +892,15 @@ inline namespace kernel syntax::contexts[transformed.get()] = expression; - return expand(transformed, bound_variables); + return expand(transformed, bound_variables, rename); } else if (cdr(identity).is()) { - return cdr(identity).as().expand(*this, expression, bound_variables); + return cdr(identity).as().expand(*this, expression, bound_variables, rename); } } - return expander::call(*this, expression, bound_variables); + return expander::call(*this, expression, bound_variables, rename); } catch (error & e) { @@ -853,9 +919,7 @@ inline namespace kernel { assert(expression.is() or expression.is()); - if (let const& identity = expression.is() ? identify(expression, bound_variables) - : std::as_const(*this).identify(expression, bound_variables); - identity.is()) + if (let const& identity = identify(expression, bound_variables); identity.is()) { return CONS(make(instruction::load_relative), identity, continuation); } @@ -863,14 +927,10 @@ inline namespace kernel { return CONS(make(instruction::load_variadic), identity, continuation); } - else if (identity.is()) - { - return CONS(make(instruction::load_absolute), identity, continuation); - } else { - assert(identity == f); - return expression.as().compile(make(bound_variables), continuation); + assert(identity.is()); + return CONS(make(instruction::load_absolute), identity, continuation); } } else // is @@ -931,10 +991,10 @@ inline namespace kernel if (variable.is()) // Resolve alias { return variable.as() - .inner_environment + .environment .template as() .identify(variable.as().form, - unify(car(variable.as().inner_environment), + unify(car(variable.as().environment), bound_variables)); } else @@ -978,7 +1038,7 @@ inline namespace kernel } } - static auto rename(std::string const& variable) + static auto rename_(std::string const& variable) { return make(core(), unit, make_symbol(variable)); } @@ -1016,7 +1076,7 @@ inline namespace kernel return sweep(cdr(form), bound_variables, cons(list(caadr(definition), // - cons(rename("lambda"), + cons(rename_("lambda"), cdadr(definition), // cddr(definition))), // binding_specs)); diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 6dd967a00..010ab5349 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -355,7 +355,7 @@ inline namespace kernel library.define("expand", [](let const& xs) { - return cadr(xs).as().expand(car(xs)); + return cadr(xs).as().expand(car(xs), unit, environment::default_rename); }); library.define("interaction-environment", []() diff --git a/src/kernel/error.cpp b/src/kernel/error.cpp index af04541ce..ec56ed6b2 100644 --- a/src/kernel/error.cpp +++ b/src/kernel/error.cpp @@ -133,6 +133,9 @@ inline namespace kernel // disassemble(output, car(x)); // Disabled as it is still experimental and does not produce any useful output. [[fallthrough]]; + case in::expanding: + [[fallthrough]]; + case in::evaluating: // x is expression if (auto context = textual_input_port::contexts.find(x.get()); context != textual_input_port::contexts.end()) { diff --git a/test/expand.ss b/test/expand.ss index c9d84ddc9..50639b554 100644 --- a/test/expand.ss +++ b/test/expand.ss @@ -89,20 +89,48 @@ 'inner)))) 'outer)) -; (eval '(define-syntax sc-swap! -; (sc-macro-transformer -; (lambda (form on-use) -; (let ((a (make-syntactic-closure on-use '() (cadr form))) -; (b (make-syntactic-closure on-use '() (caddr form)))) -; `(let ((z ,a)) -; (set! ,a ,b) -; (set! ,b z)))))) -; strip-environment) -; -; (check (strip '(let ((x 1) -; (y 2)) -; (sc-swap! x y))) -; => 'TODO-undefined-variable-z) +(eval '(define-syntax sc-swap! + (sc-macro-transformer + (lambda (form on-use) + (let ((a (make-syntactic-closure on-use '() (cadr form))) + (b (make-syntactic-closure on-use '() (caddr form)))) + `(let ((x ,a)) + (set! ,a ,b) + (set! ,b x)))))) + strip-environment) + +(check (strip '(let ((x 1) + (y 2)) + (sc-swap! x y))) + => '((lambda (x y) + ((lambda (x) + (set! x y) + (set! y x)) + x)) + 1 2)) + +(eval '(define-syntax rsc-swap! + (rsc-macro-transformer + (lambda (form environment) + (let ((a (cadr form)) + (b (caddr form)) + (x (make-syntactic-closure environment '() 'x)) + (let (make-syntactic-closure environment '() 'let)) + (set! (make-syntactic-closure environment '() 'set!))) + `(,let ((,x ,a)) + (,set! ,a ,b) + (,set! ,b ,x)))))) + strip-environment) + +(check (strip '(let ((x 1) + (y 2)) + (rsc-swap! x y))) + => '((lambda (x y) + ((lambda (x) + (set! x y) + (set! y x)) + x)) + 1 2)) (eval '(define-syntax er-swap! (er-macro-transformer @@ -151,4 +179,4 @@ (check-report) -(exit (check-passed? 9)) +(exit (check-passed? 11)) diff --git a/test/macro-transformers.ss b/test/macro-transformers.ss index ea7373a1b..eea8a0060 100644 --- a/test/macro-transformers.ss +++ b/test/macro-transformers.ss @@ -423,19 +423,19 @@ => 'b) (check (aif (memq 'b '(a b c)) - (let ((it 'inner)) + (let ((it '(inner))) (car it))) => 'b) (check (aif (memq 'b '(a b c)) - (let ((it 'inner-1)) - (let ((it 'inner-0)) + (let ((it '(inner-1))) + (let ((it '(inner-0))) (car it)))) => 'b) -(check (let ((it 'outer)) +(check (let ((it '(outer))) (aif (memq 'b '(a b c)) - (let ((it 'inner)) + (let ((it '(inner))) (car it)))) => 'b) From e7f1f84d9b317ab09735943e7c18fafdc9c2ccbb Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 28 Aug 2024 23:09:24 +0900 Subject: [PATCH 7/7] Rename function `rename_` to `corename` Signed-off-by: yamacir-kit --- README.md | 6 +- VERSION | 2 +- .../meevax/kernel/syntactic_environment.hpp | 77 ++++++++++--------- 3 files changed, 43 insertions(+), 42 deletions(-) diff --git a/README.md b/README.md index ccf0e9004..f1d5b251b 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.219_amd64.deb +sudo apt install build/meevax_0.5.220_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.219.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.220.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.219_amd64.deb` +| `package` | Generate debian package `meevax_0.5.220_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 5c22a3a61..7531d2de7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.219 +0.5.220 diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index 3ad53c8e6..33391711b 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -36,7 +36,8 @@ inline namespace kernel { return form; } - } static inline default_rename {}; + } + static inline default_rename {}; struct syntactic_closure : public identifier { @@ -54,7 +55,7 @@ inline namespace kernel auto expand(let const& bound_variables, renamer & inject) { - struct sc_renamer : public renamer + struct local_renamer : public renamer { syntactic_closure const* enclosure; @@ -62,7 +63,7 @@ inline namespace kernel let renamings; - explicit sc_renamer(syntactic_closure const* enclosure, renamer & inject) + explicit local_renamer(syntactic_closure const* enclosure, renamer & inject) : enclosure { enclosure } , inject { inject } {} @@ -103,7 +104,7 @@ inline namespace kernel } }; - auto rename = sc_renamer(this, inject); + auto rename = local_renamer(this, inject); return environment.as().expand(form, unify(car(environment), bound_variables), @@ -283,7 +284,7 @@ inline namespace kernel if (not variable.is()) // The binding-spec is not an internal syntax definition. { - body = CONS(CONS(rename_("set!"), binding_spec), body); + body = CONS(CONS(corename("set!"), binding_spec), body); } } @@ -299,7 +300,7 @@ inline namespace kernel } } - return expander.expand(LIST(CONS(CONS(rename_("lambda"), + return expander.expand(LIST(CONS(CONS(corename("lambda"), formals, body), make_list(length(binding_specs), unit))), @@ -342,7 +343,7 @@ inline namespace kernel static EXPANDER(include) { - return expander.expand(CONS(rename_("begin"), + return expander.expand(CONS(corename("begin"), meevax::include(cadr(expression))), bound_variables, rename); @@ -350,7 +351,7 @@ inline namespace kernel static EXPANDER(include_case_insensitive) { - return expander.expand(CONS(rename_("begin"), + return expander.expand(CONS(corename("begin"), meevax::include(cadr(expression), false)), bound_variables, rename); @@ -358,7 +359,7 @@ inline namespace kernel static EXPANDER(conditional_expand) { - return expander.expand(CONS(rename_("begin"), + return expander.expand(CONS(corename("begin"), meevax::conditional_expand(cdr(expression))), bound_variables, rename); @@ -414,7 +415,7 @@ inline namespace kernel let const formals = map(formal, cadr(expression)); - return expander.expand(LIST(CONS(rename_("lambda"), + return expander.expand(LIST(CONS(corename("lambda"), formals, cddr(expression) /* body */)), bound_variables, @@ -436,7 +437,7 @@ inline namespace kernel car(current_environment) = cons(formals, bound_variables); - return expander.expand(LIST(CONS(rename_("lambda"), + return expander.expand(LIST(CONS(corename("lambda"), formals, cddr(expression) /* body */)), bound_variables, @@ -451,7 +452,7 @@ inline namespace kernel { return LIST(rename(car(expression)), caadr(expression) /* variable */, - expander.expand(CONS(rename_("lambda"), + expander.expand(CONS(corename("lambda"), cdadr(expression) /* formals */, cddr(expression) /* body */), bound_variables, @@ -794,34 +795,39 @@ inline namespace kernel static auto core() -> auto const& { - #define BINDING(NAME, SYNTAX) \ + #define BIND(NAME, SYNTAX) \ make(make_symbol(NAME), make(NAME, expander::SYNTAX, generator::SYNTAX)) let static const core = make( unit, - list(BINDING("begin" , sequence ), - BINDING("call-with-current-continuation!", call_with_current_continuation), - BINDING("conditional-expand" , conditional_expand ), - BINDING("current" , current ), - BINDING("define" , define ), - BINDING("define-syntax" , define_syntax ), - BINDING("if" , conditional ), - BINDING("include" , include ), - BINDING("include-case-insensitive" , include_case_insensitive ), - BINDING("install" , install ), - BINDING("lambda" , lambda ), - BINDING("let-syntax" , let_syntax ), - BINDING("letrec" , letrec ), - BINDING("letrec-syntax" , letrec_syntax ), - BINDING("quote" , quote ), - BINDING("quote-syntax" , quote_syntax ), - BINDING("set!" , set ))); - - #undef BINDING + list(BIND("begin" , sequence ), + BIND("call-with-current-continuation!", call_with_current_continuation), + BIND("conditional-expand" , conditional_expand ), + BIND("current" , current ), + BIND("define" , define ), + BIND("define-syntax" , define_syntax ), + BIND("if" , conditional ), + BIND("include" , include ), + BIND("include-case-insensitive" , include_case_insensitive ), + BIND("install" , install ), + BIND("lambda" , lambda ), + BIND("let-syntax" , let_syntax ), + BIND("letrec" , letrec ), + BIND("letrec-syntax" , letrec_syntax ), + BIND("quote" , quote ), + BIND("quote-syntax" , quote_syntax ), + BIND("set!" , set ))); + + #undef BIND return core; } + static auto corename(std::string const& variable) + { + return make(core(), unit, make_symbol(variable)); + } + inline auto define(object const& variable, object const& value = undefined) -> void { assert(identify(variable, unit).template is()); @@ -1038,11 +1044,6 @@ inline namespace kernel } } - static auto rename_(std::string const& variable) - { - return make(core(), unit, make_symbol(variable)); - } - inline auto sweep(object const& form, object const& bound_variables, object const& binding_specs = unit) const -> pair @@ -1076,7 +1077,7 @@ inline namespace kernel return sweep(cdr(form), bound_variables, cons(list(caadr(definition), // - cons(rename_("lambda"), + cons(corename("lambda"), cdadr(definition), // cddr(definition))), // binding_specs));