Skip to content

Commit

Permalink
Merge pull request #401 from yamacir-kit/optimizer
Browse files Browse the repository at this point in the history
Optimizer
  • Loading branch information
yamacir-kit authored Jun 15, 2022
2 parents 3d4f5f6 + 9af5e56 commit 59a9f1a
Show file tree
Hide file tree
Showing 8 changed files with 222 additions and 58 deletions.
6 changes: 3 additions & 3 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -103,9 +103,9 @@ sudo rm -rf /usr/local/share/meevax

| Target Name | Description
|:-------------------|:--
| `all` (default) | Build shared-library `libmeevax.0.4.59.so` and executable `meevax`.
| `all` (default) | Build shared-library `libmeevax.0.4.64.so` and executable `meevax`.
| `test` | Test executable `meevax`.
| `package` | Generate debian package `meevax_0.4.59_amd64.deb`.
| `package` | Generate debian package `meevax_0.4.64_amd64.deb`.
| `install` | Copy files into `/usr/local` __(1)__.
| `install.deb` | `all` + `package` + `sudo apt install <meevax>.deb`
| `safe-install.deb` | `all` + `test` + `package` + `sudo apt install <meevax>.deb`
Expand All @@ -120,7 +120,7 @@ __(1)__ Meevax installed by `make install` cannot be uninstalled by the system's
## Usage

```
Meevax Lisp System, version 0.4.59
Meevax Lisp System, version 0.4.64
Usage: meevax [OPTION...] [FILE...]
Expand Down
2 changes: 1 addition & 1 deletion VERSION
Original file line number Diff line number Diff line change
@@ -1 +1 @@
0.4.59
0.4.64
8 changes: 5 additions & 3 deletions include/meevax/kernel/environment.hpp
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@

#include <meevax/kernel/configurator.hpp>
#include <meevax/kernel/machine.hpp>
#include <meevax/kernel/optimizer.hpp>
#include <meevax/kernel/reader.hpp>
#include <meevax/kernel/writer.hpp>

Expand All @@ -28,9 +29,10 @@ inline namespace kernel
{
class environment : public virtual pair
, public configurator<environment>
, public machine <environment>
, public reader <environment>
, public writer <environment>
, public machine<environment>
, public optimizer
, public reader<environment>
, public writer<environment>
{
using pair::pair;

Expand Down
70 changes: 29 additions & 41 deletions include/meevax/kernel/machine.hpp
Original file line number Diff line number Diff line change
Expand Up @@ -471,16 +471,23 @@ inline namespace kernel
* ------------------------------------------------------------------- */
[this]()
{
auto && [current_expression, current_scope] = unpair(cadr(c));
auto [current_expression, current_scope] = unpair(cadr(c));

let const syntactic_environment = fork(cdr(current_scope));

let const c_ = c;

for (let const& keyword_ : car(current_scope))
{
let & binding = keyword_.as<keyword>().load();

binding = make<transformer>(environment(static_cast<environment const&>(*this)).execute(binding),
fork(cdr(current_scope)));
c = binding;

binding = make<transformer>(execute(), syntactic_environment);
}

c = c_;

std::swap(c.as<pair>(),
compile(context(),
static_cast<environment &>(*this),
Expand Down Expand Up @@ -526,77 +533,52 @@ inline namespace kernel
}();
goto decode;

case mnemonic::call:
case mnemonic::tail_call:
if (let const& callee = car(s); callee.is<closure>()) /* ---------------
*
* (<closure> xs . s) e (%call . c) d => () (xs . e') c' (s e c . d)
* (<closure> xs . s) e (%tail-call . c) d => () (xs . e') c' d
*
* where <closure> = (c' . e')
*
* ------------------------------------------------------------------- */
{
d = cons(cddr(s), e, cdr(c), d);
c = callee.as<closure>().c();
e = cons(cadr(s), callee.as<closure>().e());
s = unit;
goto decode;
}
else if (callee.is_also<procedure>()) /* -------------------------------
*
* (<procedure> xs . s) e (%call . c) d => (x . s) e c d
*
* where x = procedure(xs)
*
* ------------------------------------------------------------------- */
{
s = cons(callee.as<procedure>().call(cadr(s)), cddr(s));
c = cdr(c);
}
else if (callee.is<continuation>()) /* ---------------------------------
*
* (<continuation> xs . s) e (%call . c) d => (xs . s') e' c' d'
*
* where <continuation> = (s' e' c' . 'd)
*
* ------------------------------------------------------------------- */
{
s = cons(caadr(s), callee.as<continuation>().s());
e = callee.as<continuation>().e();
c = callee.as<continuation>().c();
d = callee.as<continuation>().d();
}
else
{
throw error(make<string>("not applicable"), callee);
}
goto decode;
[[fallthrough]]; // This is inefficient because the type check occurs twice, but currently the performance difference caused by this is too small.

case mnemonic::tail_call:
case mnemonic::call:
if (let const& callee = car(s); callee.is<closure>()) /* ---------------
*
* (<closure> xs . s) e (%tail-call . c) d => () (xs . e') c' d
* (<closure> xs . s) e (%call . c) d => () (xs . e') c' (s e c . d)
*
* where <closure> = (c' . e')
*
* ------------------------------------------------------------------- */
{
d = cons(cddr(s), e, cdr(c), d);
c = callee.as<closure>().c();
e = cons(cadr(s), callee.as<closure>().e());
s = unit;
goto decode;
}
else if (callee.is_also<procedure>()) /* -------------------------------
*
* (<procedure> xs . s) e (%tail-call . c) d => (x . s) e c d
* (<procedure> xs . s) e (%call . c) d => (x . s) e c d
*
* where x = procedure(xs)
*
* ------------------------------------------------------------------- */
{
s = cons(callee.as<procedure>().call(cadr(s)), cddr(s));
c = cdr(c);
goto decode;
}
else if (callee.is<continuation>()) /* ---------------------------------
*
* (<continuation> xs . s) e (%tail-call . c) d => (xs . s') e' c' d'
* (<continuation> xs . s) e (%call . c) d => (xs . s') e' c' d'
*
* where <continuation> = (s' e' c' . 'd)
*
Expand All @@ -606,12 +588,12 @@ inline namespace kernel
e = callee.as<continuation>().e();
c = callee.as<continuation>().c();
d = callee.as<continuation>().d();
goto decode;
}
else
{
throw error(make<string>("not applicable"), callee);
}
goto decode;

case mnemonic::dummy: /* -------------------------------------------------
*
Expand Down Expand Up @@ -699,8 +681,13 @@ inline namespace kernel
return [this]()
{
assert(cdr(s).template is<null>());
assert(cdr(c).template is<null>());

let const x = car(s);
s = unit;

s = cdr(s);
c = cdr(c);

return x;
}();
}
Expand Down Expand Up @@ -740,6 +727,7 @@ inline namespace kernel
return variable.is<syntactic_closure>() ? variable.as<syntactic_closure>().identify_with_offset(scope) : f;
}

[[deprecated]]
inline auto reset() -> void
{
s = unit;
Expand Down
168 changes: 168 additions & 0 deletions include/meevax/kernel/optimizer.hpp
Original file line number Diff line number Diff line change
@@ -0,0 +1,168 @@
/*
Copyright 2018-2022 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_OPTIMIZER_HPP
#define INCLUDED_MEEVAX_KERNEL_OPTIMIZER_HPP

#include <meevax/kernel/list.hpp>

namespace meevax
{
inline namespace kernel
{
struct optimizer
{
static inline auto fmerge_constants = true;

static auto merge_constants(const_reference c) -> lvalue
{
if (not c.is<pair>())
{
return c;
}
else switch (car(c).template as<mnemonic>())
{
case mnemonic::call:
case mnemonic::cons:
case mnemonic::drop:
case mnemonic::dummy:
case mnemonic::join:
case mnemonic::letrec:
case mnemonic::return_:
case mnemonic::stop:
case mnemonic::tail_call:
return [&]()
{
if (let const& continuation = merge_constants(cdr(c)); continuation == cdr(c))
{
return c;
}
else
{
return cons(car(c), continuation);
}
}();

case mnemonic::define:
case mnemonic::define_syntax:
case mnemonic::let_syntax:
case mnemonic::letrec_syntax:
case mnemonic::load_absolute:
case mnemonic::load_relative:
case mnemonic::load_variadic:
case mnemonic::store_absolute:
case mnemonic::store_relative:
case mnemonic::store_variadic:
return [&]()
{
if (let const& continuation = merge_constants(cddr(c)); continuation == cddr(c))
{
return c;
}
else
{
return cons(car(c), cadr(c), continuation);
}
}();

case mnemonic::load_closure:
case mnemonic::load_continuation:
return [&]()
{
if (let const& branch = merge_constants(cadr(c)),
continuation = merge_constants(cddr(c));
branch == cadr(c) and continuation == cddr(c))
{
return c;
}
else
{
return cons(car(c), branch, continuation);
}
}();

case mnemonic::select:
case mnemonic::tail_select:
return [&]()
{
if (let const& consequent = merge_constants(cadr(c)),
alternate = merge_constants(caddr(c)),
continuation = merge_constants(cdddr(c));
consequent == cadr(c) and alternate == caddr(c) and continuation == cdddr(c))
{
return c;
}
else
{
return cons(car(c), consequent, alternate, continuation);
}
}();


case mnemonic::load_constant: /* -----------------------------------------
*
* (load-constant x
* load-constant y
* cons
* ...)
*
* => (load-constant (x . y)
* ...)
*
* --------------------------------------------------------------------- */
if (5 <= length(c) and
list_ref(c, 0).is<mnemonic>() and
list_ref(c, 0).as<mnemonic>() == mnemonic::load_constant and
list_ref(c, 2).is<mnemonic>() and
list_ref(c, 2).as<mnemonic>() == mnemonic::load_constant and
list_ref(c, 4).is<mnemonic>() and
list_ref(c, 4).as<mnemonic>() == mnemonic::cons)
{
return merge_constants(cons(list_ref(c, 0), cons(list_ref(c, 3),
list_ref(c, 1)),
merge_constants(list_tail(c, 5))));
}
else if (let const& continuation = merge_constants(cddr(c)); continuation == cddr(c))
{
return c;
}
else
{
return cons(car(c), cadr(c), continuation);
}

default:
assert(false);
return c;
}
}

static auto optimize(const_reference c)
{
let code = c;

if (fmerge_constants)
{
code = merge_constants(code);
}

return code;
}
};
} // namespace kernel
} // namespace meevax

#endif // INCLUDED_MEEVAX_KERNEL_OPTIMIZER_HPP
Loading

0 comments on commit 59a9f1a

Please sign in to comment.