From 2848e2fe9ecc307550f59a865e3fa548376acc53 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 22 Jul 2015 15:59:04 +0900 Subject: [PATCH 1/4] improve error message --- extlib/benz/include/picrin/pair.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extlib/benz/include/picrin/pair.h b/extlib/benz/include/picrin/pair.h index a05b23b6..44233aa7 100644 --- a/extlib/benz/include/picrin/pair.h +++ b/extlib/benz/include/picrin/pair.h @@ -24,7 +24,7 @@ pic_car(pic_state *pic, pic_value obj) struct pic_pair *pair; if (! pic_pair_p(obj)) { - pic_errorf(pic, "pair required, but got ~s", obj); + pic_errorf(pic, "car: pair required, but got ~s", obj); } pair = pic_pair_ptr(obj); @@ -37,7 +37,7 @@ pic_cdr(pic_state *pic, pic_value obj) struct pic_pair *pair; if (! pic_pair_p(obj)) { - pic_errorf(pic, "pair required, but got ~s", obj); + pic_errorf(pic, "cdr: pair required, but got ~s", obj); } pair = pic_pair_ptr(obj); From a6aa479b611ac5cad82404e232e2209bddd5d9b3 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 22 Jul 2015 16:00:30 +0900 Subject: [PATCH 2/4] refine pic_dump_irep format --- extlib/benz/include/picrin/opcode.h | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extlib/benz/include/picrin/opcode.h b/extlib/benz/include/picrin/opcode.h index e3eb00a7..9bff2cdd 100644 --- a/extlib/benz/include/picrin/opcode.h +++ b/extlib/benz/include/picrin/opcode.h @@ -60,7 +60,6 @@ enum pic_opcode { PIC_INLINE void pic_dump_code(pic_code c) { - printf("[%2d] ", c.insn); switch (c.insn) { case OP_NOP: puts("OP_NOP"); @@ -187,7 +186,7 @@ pic_dump_irep(struct pic_irep *irep) printf("## irep %p\n", (void *)irep); printf("[clen = %zd, argc = %d, localc = %d, capturec = %d]\n", irep->clen, irep->argc, irep->localc, irep->capturec); for (i = 0; i < irep->clen; ++i) { - printf("%02x ", i); + printf("%02x: ", i); pic_dump_code(irep->code[i]); } From 5f9a6880e2d6ac42825c18b75038fb9d4c0d3b93 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 22 Jul 2015 16:08:54 +0900 Subject: [PATCH 3/4] [bugfix] rest argument does not work with local definitions --- extlib/benz/codegen.c | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c index 853bf99f..33b85a05 100644 --- a/extlib/benz/codegen.c +++ b/extlib/benz/codegen.c @@ -298,6 +298,10 @@ pic_expand(pic_state *pic, pic_value expr, struct pic_env *env) KHASH_DECLARE(a, pic_sym *, int) KHASH_DEFINE2(a, pic_sym *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal) +/** + * TODO: don't use khash_t, use kvec_t instead + */ + typedef struct analyze_scope { int depth; pic_sym *rest; /* Nullable */ @@ -456,8 +460,14 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form) } locals = pic_make_vec(pic, kh_size(&scope->locals)); - for (it = kh_begin(&scope->locals), j = 0; it < kh_end(&scope->locals); ++it) { + j = 0; + if (scope->rest != NULL) { + locals->data[j++] = pic_obj_value(scope->rest); + } + for (it = kh_begin(&scope->locals); it < kh_end(&scope->locals); ++it) { if (kh_exist(&scope->locals, it)) { + if (scope->rest != NULL && kh_key(&scope->locals, it) == scope->rest) + continue; locals->data[j++] = pic_obj_value(kh_key(&scope->locals, it)); } } From ee9ee2f03e2ff8f76c387760a89e8be0ef2069be Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 22 Jul 2015 16:09:31 +0900 Subject: [PATCH 4/4] add inline expansion optimization --- extlib/benz/codegen.c | 73 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c index 33b85a05..a14a2886 100644 --- a/extlib/benz/codegen.c +++ b/extlib/benz/codegen.c @@ -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