Skip to content

Commit

Permalink
Remove member function syntactic_closure::align_with
Browse files Browse the repository at this point in the history 
Signed-off-by: yamacir-kit <[email protected]>
  • Loading branch information
@yamacir-kit
yamacir-kit committed Jul 14, 2023
1 parent 5a256f6 commit f0a5125
Show file tree
Hide file tree
Showing 5 changed files with 116 additions and 59 deletions.
6 changes: 3 additions & 3 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 <meevax>.deb`

## Usage

```
Meevax Lisp 0.4.750
Meevax Lisp 0.4.751
Usage:
meevax [option...] [file...]
Expand Down
2 changes: 1 addition & 1 deletion VERSION
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
0.4.750
0.4.751
2 changes: 2 additions & 0 deletions include/meevax/kernel/list.hpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,8 @@ inline namespace kernel
return unit;
}
}

auto longest_common_tail(let const&, let const&) -> object const&;
} // namespace kernel
} // namespace meevax

Expand Down
151 changes: 96 additions & 55 deletions include/meevax/kernel/syntactic_environment.hpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,15 +33,6 @@ inline namespace kernel
struct syntactic_closure : public virtual pair // (<syntactic-environment> <free-names> . <expression>)
, 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
{
/*
Expand Down Expand Up @@ -81,33 +72,6 @@ inline namespace kernel
}
};

static auto rename(std::string const& variable)
{
auto bind = [](auto&& name, auto&& compiler)
{
return make<absolute>(make_symbol(name), make<syntax>(name, compiler));
};

let static const core_syntactic_environment = make<syntactic_environment>(
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<syntactic_closure>(core_syntactic_environment, unit, make_symbol(variable));
}

struct syntax
{
using compiler = std::function<auto (syntactic_environment &,
Expand Down Expand Up @@ -1084,8 +1048,7 @@ inline namespace kernel
{
return car(expression).as<syntactic_environment>()
.compile(cddr(expression),
expression.as<syntactic_closure>()
.align_with(bound_variables),
unify(caar(expression), bound_variables),
unit,
continuation);
}
Expand Down Expand Up @@ -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 <typename... Ts>
auto compile(Ts&&... xs) -> decltype(auto)
inline auto compile(Ts&&... xs) -> decltype(auto)
{
return operator ()(std::forward<decltype(xs)>(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<absolute>());
cdr(identify(variable, unit, unit)) = value;
}

template <typename T, typename... Ts>
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<T, std::string const&, Ts...>)
{
Expand All @@ -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<identifier>())
{
Expand Down Expand Up @@ -1209,8 +1182,7 @@ inline namespace kernel
{
return car(variable).as<syntactic_environment>()
.identify(cddr(variable),
variable.as<syntactic_closure>()
.align_with(bound_variables),
unify(caar(variable), bound_variables),
unit);
}
else
Expand All @@ -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<identifier>())
{
Expand Down Expand Up @@ -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<absolute>(make_symbol(name), make<syntax>(name, compiler));
};

let static const core_syntactic_environment = make<syntactic_environment>(
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<syntactic_closure>(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
Expand Down
14 changes: 14 additions & 0 deletions src/kernel/list.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -102,5 +102,19 @@ inline namespace kernel
return f;
}
}

auto longest_common_tail(let const& a, let const& b) -> object const&
{
if (a.is<null>() or b.is<null>() 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

0 comments on commit f0a5125

Please sign in to comment.