add inline expansion optimization

This commit is contained in:
Yuichi Nishiwaki 2015-07-22 16:09:31 +09:00
parent 5f9a6880e2
commit ee9ee2f03e
1 changed files with 73 additions and 0 deletions

View File

@ -295,6 +295,68 @@ pic_expand(pic_state *pic, pic_value expr, struct pic_env *env)
return v;
}
static pic_value
optimize_beta(pic_state *pic, pic_value expr)
{
size_t ai = pic_gc_arena_preserve(pic);
pic_value functor, formals, args, tmp, val, it, defs;
if (! pic_list_p(expr))
return expr;
if (pic_nil_p(expr))
return expr;
if (pic_sym_p(pic_list_ref(pic, expr, 0))) {
pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0));
if (sym == pic->uQUOTE) {
return expr;
} else if (sym == pic->uLAMBDA) {
return pic_list3(pic, pic_list_ref(pic, expr, 0), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
}
}
tmp = pic_nil_value();
pic_for_each (val, expr, it) {
pic_push(pic, optimize_beta(pic, val), tmp);
}
expr = pic_reverse(pic, tmp);
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, expr);
functor = pic_list_ref(pic, expr, 0);
if (pic_pair_p(functor) && pic_eq_p(pic_car(pic, functor), pic_obj_value(pic->uLAMBDA))) {
formals = pic_list_ref(pic, functor, 1);
if (! pic_list_p(formals))
goto exit; /* TODO: support ((lambda args x) 1 2) */
args = pic_cdr(pic, expr);
if (pic_length(pic, formals) != pic_length(pic, args))
goto exit;
defs = pic_nil_value();
pic_for_each (val, args, it) {
pic_push(pic, pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_car(pic, formals), val), defs);
formals = pic_cdr(pic, formals);
}
expr = pic_list_ref(pic, functor, 2);
pic_for_each (val, defs, it) {
expr = pic_list3(pic, pic_obj_value(pic->uBEGIN), val, expr);
}
}
exit:
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, expr);
return expr;
}
pic_value
pic_optimize(pic_state *pic, pic_value expr)
{
return optimize_beta(pic, expr);
}
KHASH_DECLARE(a, pic_sym *, int)
KHASH_DEFINE2(a, pic_sym *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
@ -1055,6 +1117,17 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env)
SAVE(pic, ai, obj);
/* optimize */
obj = pic_optimize(pic, obj);
#if DEBUG
fprintf(stdout, "## optimize completed\n");
pic_write(pic, obj);
fprintf(stdout, "\n");
fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic));
#endif
SAVE(pic, ai, obj);
/* analyze */
obj = pic_analyze(pic, obj);
#if DEBUG