From 395f48bc813846f32fea67b69c5561def1f2f280 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 18 Jan 2014 11:47:18 -0800 Subject: [PATCH 01/43] move rSYMBOLs from pic_state to codegen_state --- include/picrin.h | 3 --- src/codegen.c | 54 ++++++++++++++++++++++++++++++++++++------------ src/init.c | 22 -------------------- 3 files changed, 41 insertions(+), 38 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index 94fc9648..6a7a946e 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -71,9 +71,6 @@ typedef struct { pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO; pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT; - pic_sym rCONS, rCAR, rCDR, rNILP; - pic_sym rADD, rSUB, rMUL, rDIV; - pic_sym rEQ, rLT, rLE, rGT, rGE; struct xhash *sym_tbl; const char **sym_pool; diff --git a/src/codegen.c b/src/codegen.c index d0bbd6d9..3e27fe6e 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -153,17 +153,45 @@ destroy_scope(pic_state *pic, codegen_scope *scope) typedef struct codegen_state { pic_state *pic; codegen_scope *scope; + pic_sym rCONS, rCAR, rCDR, rNILP; + pic_sym rADD, rSUB, rMUL, rDIV; + pic_sym rEQ, rLT, rLE, rGT, rGE; } codegen_state; +#define register_renamed_symbol(pic, state, slot, lib, name) do { \ + struct xh_entry *e; \ + if (! (e = xh_get(lib->senv->tbl, name))) \ + pic_error(pic, "internal error! native VM procedure not found"); \ + state->slot = e->val; \ + } while (0) + static codegen_state * new_codegen_state(pic_state *pic) { codegen_state *state; + struct pic_lib *stdlib; state = (codegen_state *)pic_alloc(pic, sizeof(codegen_state)); state->pic = pic; state->scope = new_global_scope(pic); + stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)")); + + /* native VM procedures */ + register_renamed_symbol(pic, state, rCONS, stdlib, "cons"); + register_renamed_symbol(pic, state, rCAR, stdlib, "car"); + register_renamed_symbol(pic, state, rCDR, stdlib, "cdr"); + register_renamed_symbol(pic, state, rNILP, stdlib, "null?"); + register_renamed_symbol(pic, state, rADD, stdlib, "+"); + register_renamed_symbol(pic, state, rSUB, stdlib, "-"); + register_renamed_symbol(pic, state, rMUL, stdlib, "*"); + register_renamed_symbol(pic, state, rDIV, stdlib, "/"); + register_renamed_symbol(pic, state, rEQ, stdlib, "="); + register_renamed_symbol(pic, state, rLT, stdlib, "<"); + register_renamed_symbol(pic, state, rLE, stdlib, "<="); + register_renamed_symbol(pic, state, rGT, stdlib, ">"); + register_renamed_symbol(pic, state, rGE, stdlib, ">="); + return state; } @@ -475,7 +503,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } \ } while (0) - else if (sym == pic->rCONS) { + else if (sym == state->rCONS) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); @@ -483,21 +511,21 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; break; } - else if (sym == pic->rCAR) { + else if (sym == state->rCAR) { ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); scope->code[scope->clen].insn = OP_CAR; scope->clen++; break; } - else if (sym == pic->rCDR) { + else if (sym == state->rCDR) { ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); scope->code[scope->clen].insn = OP_CDR; scope->clen++; break; } - else if (sym == pic->rNILP) { + else if (sym == state->rNILP) { ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); scope->code[scope->clen].insn = OP_NILP; @@ -511,7 +539,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } \ } while (0) - else if (sym == pic->rADD) { + else if (sym == state->rADD) { pic_value args; ARGC_ASSERT_GE(0); @@ -537,7 +565,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } break; } - else if (sym == pic->rSUB) { + else if (sym == state->rSUB) { pic_value args; ARGC_ASSERT_GE(1); @@ -560,7 +588,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } break; } - else if (sym == pic->rMUL) { + else if (sym == state->rMUL) { pic_value args; ARGC_ASSERT_GE(0); @@ -586,7 +614,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } break; } - else if (sym == pic->rDIV) { + else if (sym == state->rDIV) { pic_value args; ARGC_ASSERT_GE(1); @@ -612,7 +640,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) } break; } - else if (sym == pic->rEQ) { + else if (sym == state->rEQ) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); @@ -620,7 +648,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; break; } - else if (sym == pic->rLT) { + else if (sym == state->rLT) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); @@ -628,7 +656,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; break; } - else if (sym == pic->rLE) { + else if (sym == state->rLE) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); @@ -636,7 +664,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; break; } - else if (sym == pic->rGT) { + else if (sym == state->rGT) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); @@ -644,7 +672,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; break; } - else if (sym == pic->rGE) { + else if (sym == state->rGE) { ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); diff --git a/src/init.c b/src/init.c index 8576839b..de8c2bb6 100644 --- a/src/init.c +++ b/src/init.c @@ -74,13 +74,6 @@ pic_features(pic_state *pic) return fs; } -#define register_renamed_symbol(pic, slot, name) do { \ - struct xh_entry *e; \ - if (! (e = xh_get(pic->lib->senv->tbl, name))) \ - pic_error(pic, "internal error! native VM procedure not found"); \ - pic->slot = e->val; \ - } while (0) - #define DONE pic_gc_arena_restore(pic, ai); void @@ -122,21 +115,6 @@ pic_init_core(pic_state *pic) pic_init_load(pic); DONE; pic_init_write(pic); DONE; - /* native VM procedures */ - register_renamed_symbol(pic, rCONS, "cons"); - register_renamed_symbol(pic, rCAR, "car"); - register_renamed_symbol(pic, rCDR, "cdr"); - register_renamed_symbol(pic, rNILP, "null?"); - register_renamed_symbol(pic, rADD, "+"); - register_renamed_symbol(pic, rSUB, "-"); - register_renamed_symbol(pic, rMUL, "*"); - register_renamed_symbol(pic, rDIV, "/"); - register_renamed_symbol(pic, rEQ, "="); - register_renamed_symbol(pic, rLT, "<"); - register_renamed_symbol(pic, rLE, "<="); - register_renamed_symbol(pic, rGT, ">"); - register_renamed_symbol(pic, rGE, ">="); - pic_load_stdlib(pic); DONE; pic_defun(pic, "features", pic_features); From 0ceb9c995355aa381429577f85b033e0f0f8f754 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 18 Jan 2014 11:47:32 -0800 Subject: [PATCH 02/43] add sSYMBOLs to pic_state --- include/picrin.h | 3 +++ src/state.c | 13 +++++++++++++ 2 files changed, 16 insertions(+) diff --git a/include/picrin.h b/include/picrin.h index 6a7a946e..f3d54c10 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -71,6 +71,9 @@ typedef struct { pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO; pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT; + pic_sym sCONS, sCAR, sCDR, sNILP; + pic_sym sADD, sSUB, sMUL, sDIV; + pic_sym sEQ, sLT, sLE, sGT, sGE; struct xhash *sym_tbl; const char **sym_pool; diff --git a/src/state.c b/src/state.c index a7b987e8..a312ae2a 100644 --- a/src/state.c +++ b/src/state.c @@ -98,6 +98,19 @@ pic_open(int argc, char *argv[], char **envp) register_core_symbol(pic, sDEFINE_LIBRARY, "define-library"); register_core_symbol(pic, sIMPORT, "import"); register_core_symbol(pic, sEXPORT, "export"); + register_core_symbol(pic, sCONS, "cons"); + register_core_symbol(pic, sCAR, "car"); + register_core_symbol(pic, sCDR, "cdr"); + register_core_symbol(pic, sNILP, "null?"); + register_core_symbol(pic, sADD, "+"); + register_core_symbol(pic, sSUB, "-"); + register_core_symbol(pic, sMUL, "*"); + register_core_symbol(pic, sDIV, "/"); + register_core_symbol(pic, sEQ, "="); + register_core_symbol(pic, sLT, "<"); + register_core_symbol(pic, sLE, "<="); + register_core_symbol(pic, sGT, ">"); + register_core_symbol(pic, sGE, ">="); pic_gc_arena_restore(pic, ai); pic_init_core(pic); From ae933252c9f41c024ad7aa064999c1cbbfe00ba1 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 18 Jan 2014 20:20:28 -0800 Subject: [PATCH 03/43] add analyzer prototype --- include/picrin.h | 2 +- src/codegen.c | 629 +++++++++++++++++++++++++++++++++++++++++++++-- src/state.c | 1 + 3 files changed, 611 insertions(+), 21 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index f3d54c10..7fa5a751 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -72,7 +72,7 @@ typedef struct { pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO; pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT; pic_sym sCONS, sCAR, sCDR, sNILP; - pic_sym sADD, sSUB, sMUL, sDIV; + pic_sym sADD, sSUB, sMUL, sDIV, sMINUS; pic_sym sEQ, sLT, sLE, sGT, sGE; struct xhash *sym_tbl; diff --git a/src/codegen.c b/src/codegen.c index 3e27fe6e..0f58729e 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -37,6 +37,615 @@ new_irep(pic_state *pic) return irep; } +static bool +valid_formal(pic_state *pic, pic_value formal) +{ + if (pic_symbol_p(formal)) + return true; + + while (pic_pair_p(formal)) { + if (! pic_symbol_p(pic_car(pic, formal))) { + return false; + } + formal = pic_cdr(pic, formal); + } + if (pic_nil_p(formal)) + return true; + if (pic_symbol_p(formal)) + return true; + + return false; +} + +typedef struct analyze_scope { + bool varg; + /* rest args variable is counted by localc */ + size_t argc, localc; + /* local variables are 1-indexed, 0 is reserved for the callee */ + struct xhash *local_tbl; + /* if local var i is captured, then dirty_flags[i] == 1 */ + int *dirty_flags; + + struct analyze_scope *up; +} analyze_scope; + +static analyze_scope * +global_scope(pic_state *pic) +{ + analyze_scope *scope; + + scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); + scope->up = NULL; + scope->local_tbl = pic->global_tbl; + scope->argc = -1; + scope->localc = -1; + scope->varg = false; + scope->dirty_flags = NULL; + + return scope; +} + +typedef struct analyze_state { + pic_state *pic; + analyze_scope *scope; + pic_sym rCONS, rCAR, rCDR, rNILP; + pic_sym rADD, rSUB, rMUL, rDIV; + pic_sym rEQ, rLT, rLE, rGT, rGE; + pic_sym sCALL, sTAILCALL; + pic_sym sGREF, sLREF, sCREF; + pic_sym sGSET, sLSET, sCSET; +} analyze_state; + +#define register_symbol(pic, state, slot, name) do { \ + state->slot = pic_intern_cstr(pic, name); \ + } while (0) + +#define register_renamed_symbol(pic, state, slot, lib, name) do { \ + struct xh_entry *e; \ + if (! (e = xh_get(lib->senv->tbl, name))) \ + pic_error(pic, "internal error! native VM procedure not found"); \ + state->slot = e->val; \ + } while (0) + +static analyze_state * +new_analyze_state(pic_state *pic) +{ + analyze_state *state; + struct pic_lib *stdlib; + + state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state)); + state->pic = pic; + state->scope = global_scope(pic); + + stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)")); + + /* native VM procedures */ + register_renamed_symbol(pic, state, rCONS, stdlib, "cons"); + register_renamed_symbol(pic, state, rCAR, stdlib, "car"); + register_renamed_symbol(pic, state, rCDR, stdlib, "cdr"); + register_renamed_symbol(pic, state, rNILP, stdlib, "null?"); + register_renamed_symbol(pic, state, rADD, stdlib, "+"); + register_renamed_symbol(pic, state, rSUB, stdlib, "-"); + register_renamed_symbol(pic, state, rMUL, stdlib, "*"); + register_renamed_symbol(pic, state, rDIV, stdlib, "/"); + register_renamed_symbol(pic, state, rEQ, stdlib, "="); + register_renamed_symbol(pic, state, rLT, stdlib, "<"); + register_renamed_symbol(pic, state, rLE, stdlib, "<="); + register_renamed_symbol(pic, state, rGT, stdlib, ">"); + register_renamed_symbol(pic, state, rGE, stdlib, ">="); + + register_symbol(pic, state, sCALL, "call"); + register_symbol(pic, state, sTAILCALL, "tail-call"); + register_symbol(pic, state, sGREF, "gref"); + register_symbol(pic, state, sLREF, "lref"); + register_symbol(pic, state, sCREF, "cref"); + register_symbol(pic, state, sGREF, "gref"); + register_symbol(pic, state, sLREF, "lref"); + register_symbol(pic, state, sCREF, "cref"); + + return state; +} + +static void +push_scope(analyze_state *state, pic_value args) +{ + pic_state *pic = state->pic; + analyze_scope *scope; + struct xhash *x; + pic_value v; + int i, l; + + scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); + scope->up = state->scope; + scope->local_tbl = x = xh_new(); + scope->varg = false; + + i = 1; l = 0; + for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { + pic_value sym; + + sym = pic_car(pic, v); + xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i++); + } + if (pic_nil_p(v)) { + /* pass */ + } + else if (pic_symbol_p(v)) { + scope->varg = true; + xh_put(x, pic_symbol_name(pic, pic_sym(v)), i + l++); + } + else { + pic_error(pic, "logic flaw"); + } + scope->argc = i; + scope->localc = l; + scope->dirty_flags = (int *)pic_calloc(pic, i + l, sizeof(int)); +} + +static void +pop_scope(analyze_state *state) +{ + analyze_scope *scope; + + scope = state->scope; + xh_destroy(scope->local_tbl); + pic_free(state->pic, scope->dirty_flags); + + scope = scope->up; + pic_free(state->pic, state->scope); + state->scope = scope; +} + +static analyze_scope * +lookup_var(analyze_state *state, const char *key, int *depth, int *idx) +{ + analyze_scope *scope = state->scope; + struct xh_entry *e; + int d = 0; + + enter: + + e = xh_get(scope->local_tbl, key); + if (e && e->val >= 0) { + if (scope->up == NULL) { /* global */ + *depth = -1; + } + else { /* non-global */ + *depth = d; + } + *idx = e->val; + return scope; + } + if (scope->up) { + scope = scope->up; + ++d; + goto enter; + } + return NULL; +} + +static int +define_global_var(pic_state *pic, const char *name) +{ + struct xh_entry *e; + + if ((e = xh_get(pic->global_tbl, name))) { + pic_warn(pic, "redefining global"); + return e->val; + } + e = xh_put(pic->global_tbl, name, pic->glen++); + if (pic->glen >= pic->gcapa) { + pic_error(pic, "global table overflow"); + } + return e->val; +} + +static int +define_local_var(pic_state *pic, const char *name, analyze_scope *scope) +{ + struct xh_entry *e; + + e = xh_put(scope->local_tbl, name, scope->argc + scope->localc++); + scope->dirty_flags = (int *)pic_realloc(pic, scope->dirty_flags, (scope->argc + scope->localc) * sizeof(int)); + scope->dirty_flags[e->val] = 0; + return e->val; +} + +static bool +is_global_scope(analyze_scope *scope) +{ + return scope->up == NULL; +} + +static pic_value +new_gref(analyze_state *state, int idx) +{ + return pic_list(state->pic, 2, pic_symbol_value(state->sGREF), pic_int_value(idx)); +} + +static pic_value +new_gset(analyze_state *state, int idx, pic_value value) +{ + return pic_list(state->pic, 3, pic_symbol_value(state->sGSET), pic_int_value(idx), value); +} + +static pic_value +new_cref(analyze_state *state, int depth, int idx) +{ + return pic_list(state->pic, 3, pic_symbol_value(state->sCREF), pic_int_value(depth), pic_int_value(idx)); +} + +static pic_value +new_cset(analyze_state *state, int depth, int idx, pic_value value) +{ + return pic_list(state->pic, 4, pic_symbol_value(state->sCSET), pic_int_value(depth), pic_int_value(idx), value); +} + +static pic_value analyze_call(analyze_state *, pic_value, bool); +static pic_value analyze_lambda(analyze_state *, pic_value); + +static pic_value +analyze(analyze_state *state, pic_value obj, bool tailpos) +{ + pic_state *pic = state->pic; + analyze_scope *scope = state->scope; + + switch (pic_type(obj)) { + case PIC_TT_SYMBOL: { + analyze_scope *s; + int depth = -1, idx = -1; + const char *name = pic_symbol_name(pic, pic_sym(obj)); + + s = lookup_var(state, name, &depth, &idx); + if (! s) { +#if DEBUG + printf("%s\n", name); +#endif + pic_error(pic, "symbol: unbound variable"); + } + + switch (depth) { + case -1: /* global */ + return new_gref(state, idx); + default: /* nonlocal */ + s->dirty_flags[idx] = 1; + /* at this stage, lref and cref are not distinguished */ + FALLTHROUGH; + case 0: /* local */ + return new_cref(state, depth, idx); + } + } + case PIC_TT_PAIR: { + pic_value proc; + + if (! pic_list_p(pic, obj)) { + pic_error(pic, "invalid expression given"); + } + + proc = pic_car(pic, obj); + if (pic_symbol_p(proc)) { + pic_sym sym = pic_sym(proc); + + if (sym == pic->sDEFINE) { + int idx; + pic_value var, val; + + if (pic_length(pic, obj) < 2) { + pic_error(pic, "syntax error"); + } + + var = pic_car(pic, pic_cdr(pic, obj)); + if (pic_pair_p(var)) { + val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA), + pic_cons(pic, pic_cdr(pic, var), + pic_cdr(pic, pic_cdr(pic, obj)))); + var = pic_car(pic, var); + } + else { + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + } + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } + + if (is_global_scope(scope)) { + idx = define_global_var(pic, pic_symbol_name(pic, pic_sym(var))); + return new_gset(state, idx, analyze(state, val, false)); + } + else { + idx = define_local_var(pic, pic_symbol_name(pic, pic_sym(var)), scope); + return new_cset(state, 0, idx, analyze(state, val, false)); + } + } + else if (sym == pic->sLAMBDA) { + return analyze_lambda(state, obj); + } + else if (sym == pic->sIF) { + pic_value if_true, if_false; + + if_false = pic_none_value(); + switch (pic_length(pic, obj)) { + default: + pic_error(pic, "syntax error"); + break; + case 4: + if_false = pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + FALLTHROUGH; + case 3: + if_true = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + } + + return pic_list(pic, 4, + pic_symbol_value(pic->sIF), + analyze(state, pic_car(pic, pic_cdr(pic, obj)), false), + analyze(state, if_true, tailpos), + analyze(state, if_false, tailpos)); + } + else if (sym == pic->sBEGIN) { + pic_value seq; + bool tail; + + /* TODO: unwrap if the number of objects is 1 or 0 */ + seq = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); + for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { + if (pic_nil_p(pic_cdr(pic, obj))) { + tail = tailpos; + } else { + tail = false; + } + seq = pic_cons(pic, analyze(state, pic_car(pic, obj), tail), seq); + } + return pic_reverse(pic, seq); + } + else if (sym == pic->sSETBANG) { + analyze_scope *s; + pic_value var, val; + int depth = -1, idx = -1; + + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + + var = pic_car(pic, pic_cdr(pic, obj)); + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } + + s = lookup_var(state, pic_symbol_name(pic, pic_sym(var)), &depth, &idx); + if (! s) { + pic_error(pic, "unbound variable"); + } + + val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + + switch (depth) { + case -1: /* global */ + return new_gset(state, idx, val); + default: /* nonlocal */ + s->dirty_flags[idx] = 1; + /* at this stage, lset and cset are not distinguished */ + FALLTHROUGH; + case 0: /* local */ + return new_cset(state, depth, idx, val); + } + } + else if (sym == pic->sQUOTE) { + if (pic_length(pic, obj) != 2) { + pic_error(pic, "syntax error"); + } + return obj; /* TODO: quote only if necessary */ + } + +#define ARGC_ASSERT(n) do { \ + if (pic_length(pic, obj) != (n) + 1) { \ + pic_error(pic, "wrong number of arguments"); \ + } \ + } while (0) + +#define CONSTRUCT_OP1(op) \ + pic_list(pic, 2, \ + pic_symbol_value(op), \ + analyze(state, pic_car(pic, pic_cdr(pic, obj)), false)) + +#define CONSTRUCT_OP2(op) \ + pic_list(pic, 3, \ + pic_symbol_value(op), \ + analyze(state, pic_car(pic, pic_cdr(pic, obj)), false), \ + analyze(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false)) + + else if (sym == state->rCONS) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sCONS); + } + else if (sym == state->rCAR) { + ARGC_ASSERT(1); + return CONSTRUCT_OP1(pic->sCAR); + } + else if (sym == state->rCDR) { + ARGC_ASSERT(1); + return CONSTRUCT_OP1(pic->sCDR); + } + else if (sym == state->rNILP) { + ARGC_ASSERT(1); + return CONSTRUCT_OP1(pic->sNILP); + } + +#define ARGC_ASSERT_GE(n) do { \ + if (pic_length(pic, obj) < (n) + 1) { \ + pic_error(pic, "wrong number of arguments"); \ + } \ + } while (0) + +#define FOLD_ARGS(sym) do { \ + obj = analyze(state, pic_car(pic, args), false); \ + for (args = pic_cdr(pic, obj); ! pic_nil_p(args); args = pic_cdr(pic, args)) { \ + obj = pic_list(pic, 3, pic_symbol_value(sym), obj, \ + analyze(state, pic_car(pic, args), false)); \ + } \ + } while (0) + + else if (sym == state->rADD) { + pic_value args; + + ARGC_ASSERT_GE(0); + switch (pic_length(pic, obj)) { + case 1: + return pic_int_value(0); + case 2: + return analyze(state, pic_car(pic, pic_cdr(pic, obj)), tailpos); + default: + args = pic_cdr(pic, obj); + FOLD_ARGS(pic->sADD); + return obj; + } + } + else if (sym == state->rSUB) { + pic_value args; + + ARGC_ASSERT_GE(1); + switch (pic_length(pic, obj)) { + case 2: + return pic_list(pic, 2, pic_symbol_value(pic->sMINUS), + analyze(state, pic_car(pic, pic_cdr(pic, obj)), false)); + default: + args = pic_cdr(pic, obj); + FOLD_ARGS(pic->sSUB); + return obj; + } + } + else if (sym == state->rMUL) { + pic_value args; + + ARGC_ASSERT_GE(0); + switch (pic_length(pic, obj)) { + case 1: + return pic_int_value(1); + case 2: + return analyze(state, pic_car(pic, pic_cdr(pic, obj)), tailpos); + default: + args = pic_cdr(pic, obj); + FOLD_ARGS(pic->sMUL); + return obj; + } + } + else if (sym == state->rDIV) { + pic_value args; + + ARGC_ASSERT_GE(1); + switch (pic_length(pic, obj)) { + case 2: + args = pic_cdr(pic, obj); + obj = pic_list(pic, 3, proc, pic_float_value(1), pic_car(pic, args)); + return analyze(state, obj, tailpos); + default: + args = pic_cdr(pic, obj); + FOLD_ARGS(pic->sDIV); + return obj; + } + break; + } + else if (sym == state->rEQ) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sEQ); + } + else if (sym == state->rLT) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sLT); + } + else if (sym == state->rLE) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sLE); + } + else if (sym == state->rGT) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sGT); + } + else if (sym == state->rGE) { + ARGC_ASSERT(2); + return CONSTRUCT_OP2(pic->sGE); + } + } + return analyze_call(state, obj, tailpos); + } + case PIC_TT_BOOL: + case PIC_TT_FLOAT: + case PIC_TT_INT: + case PIC_TT_NIL: + case PIC_TT_CHAR: { + return obj; + } + case PIC_TT_STRING: + case PIC_TT_VECTOR: + case PIC_TT_BLOB: { + return pic_list(pic, 2, pic_symbol_value(pic->sQUOTE), obj); + } + case PIC_TT_CONT: + case PIC_TT_ENV: + case PIC_TT_PROC: + case PIC_TT_UNDEF: + case PIC_TT_EOF: + case PIC_TT_PORT: + case PIC_TT_ERROR: + case PIC_TT_SENV: + case PIC_TT_SYNTAX: + case PIC_TT_SC: + case PIC_TT_LIB: + case PIC_TT_VAR: + case PIC_TT_IREP: + pic_error(pic, "invalid expression given"); + } +} + +static pic_value +analyze_call(analyze_state *state, pic_value obj, bool tailpos) +{ + pic_state *pic = state->pic; + pic_value seq; + pic_sym call; + + if (tailpos) { + call = state->sCALL; + } else { + call = state->sTAILCALL; + } + seq = pic_list(pic, 1, pic_symbol_value(call)); + for (; ! pic_nil_p(seq); obj = pic_cdr(pic, obj)) { + seq = pic_cons(pic, analyze(state, pic_car(pic, obj), false), seq); + } + return pic_reverse(pic, seq); +} + +static pic_value +analyze_lambda(analyze_state *state, pic_value obj) +{ + pic_state *pic = state->pic; + pic_value args, body; + + if (pic_length(pic, obj) < 2) { + pic_error(pic, "syntax error"); + } + + /* formal arguments */ + args = pic_car(pic, pic_cdr(pic, obj)); + if (! valid_formal(pic, args)) { + pic_error(pic, "syntax error"); + } + + /* analyze body in inner environment */ + push_scope(state, args); + { + body = pic_cdr(pic, pic_cdr(pic, obj)); + body = pic_cons(pic, pic_symbol_value(pic->sBEGIN), body); + body = analyze(state, body, true); + } + pop_scope(state); + + return pic_list(pic, 3, pic_symbol_value(pic->sLAMBDA), args, body); +} + /** * scope object */ @@ -770,26 +1379,6 @@ codegen_call(codegen_state *state, pic_value obj, bool tailpos) scope->clen++; } -static bool -valid_formal(pic_state *pic, pic_value formal) -{ - if (pic_symbol_p(formal)) - return true; - - while (pic_pair_p(formal)) { - if (! pic_symbol_p(pic_car(pic, formal))) { - return false; - } - formal = pic_cdr(pic, formal); - } - if (pic_nil_p(formal)) - return true; - if (pic_symbol_p(formal)) - return true; - - return false; -} - static void lift_cv(pic_state *pic, struct pic_irep *irep, int d) { diff --git a/src/state.c b/src/state.c index a312ae2a..f9423f05 100644 --- a/src/state.c +++ b/src/state.c @@ -106,6 +106,7 @@ pic_open(int argc, char *argv[], char **envp) register_core_symbol(pic, sSUB, "-"); register_core_symbol(pic, sMUL, "*"); register_core_symbol(pic, sDIV, "/"); + register_core_symbol(pic, sMINUS, "minus"); register_core_symbol(pic, sEQ, "="); register_core_symbol(pic, sLT, "<"); register_core_symbol(pic, sLE, "<="); From 14eb6b334df3e4fd2162da4ac4d8889d100fdbb4 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 18 Jan 2014 22:35:36 -0800 Subject: [PATCH 04/43] arena management --- src/codegen.c | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 0f58729e..4d1ba17d 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -281,11 +281,25 @@ new_cset(analyze_state *state, int depth, int idx, pic_value value) return pic_list(state->pic, 4, pic_symbol_value(state->sCSET), pic_int_value(depth), pic_int_value(idx), value); } +static pic_value analyze_node(analyze_state *, pic_value, bool); static pic_value analyze_call(analyze_state *, pic_value, bool); static pic_value analyze_lambda(analyze_state *, pic_value); static pic_value analyze(analyze_state *state, pic_value obj, bool tailpos) +{ + int ai = pic_gc_arena_preserve(state->pic); + pic_value res; + + res = analyze_node(state, obj, tailpos); + + pic_gc_arena_restore(state->pic, ai); + pic_gc_protect(state->pic, res); + return res; +} + +static pic_value +analyze_node(analyze_state *state, pic_value obj, bool tailpos) { pic_state *pic = state->pic; analyze_scope *scope = state->scope; @@ -603,6 +617,7 @@ static pic_value analyze_call(analyze_state *state, pic_value obj, bool tailpos) { pic_state *pic = state->pic; + int ai = pic_gc_arena_preserve(pic); pic_value seq; pic_sym call; @@ -615,13 +630,18 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos) for (; ! pic_nil_p(seq); obj = pic_cdr(pic, obj)) { seq = pic_cons(pic, analyze(state, pic_car(pic, obj), false), seq); } - return pic_reverse(pic, seq); + seq = pic_reverse(pic, seq); + + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, seq); + return seq; } static pic_value analyze_lambda(analyze_state *state, pic_value obj) { pic_state *pic = state->pic; + int ai = pic_gc_arena_preserve(pic); pic_value args, body; if (pic_length(pic, obj) < 2) { @@ -643,7 +663,10 @@ analyze_lambda(analyze_state *state, pic_value obj) } pop_scope(state); - return pic_list(pic, 3, pic_symbol_value(pic->sLAMBDA), args, body); + obj = pic_list(pic, 3, pic_symbol_value(pic->sLAMBDA), args, body); + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, obj); + return obj; } /** From 6dcf04d50cba5f4a6fb500440b973823c961ce98 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 18 Jan 2014 22:36:02 -0800 Subject: [PATCH 05/43] fix some bugs --- src/codegen.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 4d1ba17d..6d3184fe 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -160,7 +160,8 @@ push_scope(analyze_state *state, pic_value args) scope->local_tbl = x = xh_new(); scope->varg = false; - i = 1; l = 0; + i = 1; + l = 0; for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { pic_value sym; @@ -180,6 +181,8 @@ push_scope(analyze_state *state, pic_value args) scope->argc = i; scope->localc = l; scope->dirty_flags = (int *)pic_calloc(pic, i + l, sizeof(int)); + + state->scope = scope; } static void @@ -627,7 +630,7 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos) call = state->sTAILCALL; } seq = pic_list(pic, 1, pic_symbol_value(call)); - for (; ! pic_nil_p(seq); obj = pic_cdr(pic, obj)) { + for (; ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { seq = pic_cons(pic, analyze(state, pic_car(pic, obj), false), seq); } seq = pic_reverse(pic, seq); From fbeb32ee831c95797740f58fa8dad4517618ce4d Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 11:16:52 +0900 Subject: [PATCH 06/43] typo --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index 6d3184fe..4c2c8f0d 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -191,7 +191,7 @@ pop_scope(analyze_state *state) analyze_scope *scope; scope = state->scope; - xh_destroy(scope->local_tbl); + xh_destory(scope->local_tbl); pic_free(state->pic, scope->dirty_flags); scope = scope->up; From b2c74552f21033bf0a83c6ac45e5df2e243e2c5e Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 13:04:21 +0900 Subject: [PATCH 07/43] change lookup_var API --- src/codegen.c | 174 +++++++++++++++++++++----------------------------- 1 file changed, 73 insertions(+), 101 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 4c2c8f0d..7d318d2e 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -64,7 +64,7 @@ typedef struct analyze_scope { /* local variables are 1-indexed, 0 is reserved for the callee */ struct xhash *local_tbl; /* if local var i is captured, then dirty_flags[i] == 1 */ - int *dirty_flags; + struct xhash *dirty_flags; struct analyze_scope *up; } analyze_scope; @@ -152,12 +152,14 @@ push_scope(analyze_state *state, pic_value args) pic_state *pic = state->pic; analyze_scope *scope; struct xhash *x; + struct xh_iter it; pic_value v; int i, l; scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope->up = state->scope; scope->local_tbl = x = xh_new(); + scope->dirty_flags = xh_new(); scope->varg = false; i = 1; @@ -180,7 +182,11 @@ push_scope(analyze_state *state, pic_value args) } scope->argc = i; scope->localc = l; - scope->dirty_flags = (int *)pic_calloc(pic, i + l, sizeof(int)); + + /* set dirty flags */ + for (it = xh_begin(x); ! xh_isend(&it); xh_next(x, &it)) { + xh_put(scope->dirty_flags, it.e->key, 0); + } state->scope = scope; } @@ -192,66 +198,48 @@ pop_scope(analyze_state *state) scope = state->scope; xh_destory(scope->local_tbl); - pic_free(state->pic, scope->dirty_flags); + xh_destory(scope->dirty_flags); scope = scope->up; pic_free(state->pic, state->scope); state->scope = scope; } -static analyze_scope * -lookup_var(analyze_state *state, const char *key, int *depth, int *idx) +static int +lookup_var(analyze_state *state, const char *key) { analyze_scope *scope = state->scope; struct xh_entry *e; - int d = 0; + int depth = 0; enter: e = xh_get(scope->local_tbl, key); if (e && e->val >= 0) { - if (scope->up == NULL) { /* global */ - *depth = -1; + if (depth > 0) { /* mark dirty */ + xh_put(scope->dirty_flags, key, 1); } - else { /* non-global */ - *depth = d; - } - *idx = e->val; - return scope; + return depth; } if (scope->up) { scope = scope->up; - ++d; + ++depth; goto enter; } - return NULL; + return -1; } -static int -define_global_var(pic_state *pic, const char *name) +static void +define_var(analyze_state *state, const char *name) { struct xh_entry *e; + analyze_scope *scope = state->scope; + int c; - if ((e = xh_get(pic->global_tbl, name))) { - pic_warn(pic, "redefining global"); - return e->val; - } - e = xh_put(pic->global_tbl, name, pic->glen++); - if (pic->glen >= pic->gcapa) { - pic_error(pic, "global table overflow"); - } - return e->val; -} + c = scope->argc + scope->localc++; + e = xh_put(state->scope->local_tbl, name, c); -static int -define_local_var(pic_state *pic, const char *name, analyze_scope *scope) -{ - struct xh_entry *e; - - e = xh_put(scope->local_tbl, name, scope->argc + scope->localc++); - scope->dirty_flags = (int *)pic_realloc(pic, scope->dirty_flags, (scope->argc + scope->localc) * sizeof(int)); - scope->dirty_flags[e->val] = 0; - return e->val; + xh_put(scope->dirty_flags, name, 0); } static bool @@ -261,27 +249,12 @@ is_global_scope(analyze_scope *scope) } static pic_value -new_gref(analyze_state *state, int idx) +new_cref(analyze_state *state, int depth, pic_sym sym) { - return pic_list(state->pic, 2, pic_symbol_value(state->sGREF), pic_int_value(idx)); -} - -static pic_value -new_gset(analyze_state *state, int idx, pic_value value) -{ - return pic_list(state->pic, 3, pic_symbol_value(state->sGSET), pic_int_value(idx), value); -} - -static pic_value -new_cref(analyze_state *state, int depth, int idx) -{ - return pic_list(state->pic, 3, pic_symbol_value(state->sCREF), pic_int_value(depth), pic_int_value(idx)); -} - -static pic_value -new_cset(analyze_state *state, int depth, int idx, pic_value value) -{ - return pic_list(state->pic, 4, pic_symbol_value(state->sCSET), pic_int_value(depth), pic_int_value(idx), value); + return pic_list(state->pic, 3, + pic_symbol_value(state->sCREF), + pic_int_value(depth), + pic_symbol_value(sym)); } static pic_value analyze_node(analyze_state *, pic_value, bool); @@ -305,32 +278,18 @@ static pic_value analyze_node(analyze_state *state, pic_value obj, bool tailpos) { pic_state *pic = state->pic; - analyze_scope *scope = state->scope; switch (pic_type(obj)) { case PIC_TT_SYMBOL: { - analyze_scope *s; - int depth = -1, idx = -1; const char *name = pic_symbol_name(pic, pic_sym(obj)); + int depth; - s = lookup_var(state, name, &depth, &idx); - if (! s) { -#if DEBUG - printf("%s\n", name); -#endif + depth = lookup_var(state, name); + if (depth == -1) { pic_error(pic, "symbol: unbound variable"); } - - switch (depth) { - case -1: /* global */ - return new_gref(state, idx); - default: /* nonlocal */ - s->dirty_flags[idx] = 1; - /* at this stage, lref and cref are not distinguished */ - FALLTHROUGH; - case 0: /* local */ - return new_cref(state, depth, idx); - } + /* at this stage, lref/cref/gref are not distinguished */ + return new_cref(state, depth, pic_sym(obj)); } case PIC_TT_PAIR: { pic_value proc; @@ -344,7 +303,6 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_sym sym = pic_sym(proc); if (sym == pic->sDEFINE) { - int idx; pic_value var, val; if (pic_length(pic, obj) < 2) { @@ -368,14 +326,11 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - if (is_global_scope(scope)) { - idx = define_global_var(pic, pic_symbol_name(pic, pic_sym(var))); - return new_gset(state, idx, analyze(state, val, false)); - } - else { - idx = define_local_var(pic, pic_symbol_name(pic, pic_sym(var)), scope); - return new_cset(state, 0, idx, analyze(state, val, false)); - } + define_var(state, pic_symbol_name(pic, pic_sym(var))); + return pic_list(pic, 3, + pic_symbol_value(pic->sSETBANG), + analyze(state, var, false), + analyze(state, val, false)); } else if (sym == pic->sLAMBDA) { return analyze_lambda(state, obj); @@ -418,9 +373,8 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) return pic_reverse(pic, seq); } else if (sym == pic->sSETBANG) { - analyze_scope *s; pic_value var, val; - int depth = -1, idx = -1; + int depth; if (pic_length(pic, obj) != 3) { pic_error(pic, "syntax error"); @@ -431,23 +385,17 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - s = lookup_var(state, pic_symbol_name(pic, pic_sym(var)), &depth, &idx); - if (! s) { + depth = lookup_var(state, pic_symbol_name(pic, pic_sym(var))); + if (depth == -1) { pic_error(pic, "unbound variable"); } val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); - switch (depth) { - case -1: /* global */ - return new_gset(state, idx, val); - default: /* nonlocal */ - s->dirty_flags[idx] = 1; - /* at this stage, lset and cset are not distinguished */ - FALLTHROUGH; - case 0: /* local */ - return new_cset(state, depth, idx, val); - } + return pic_list(pic, 3, + pic_symbol_value(pic->sSETBANG), + analyze(state, var, false), + analyze(state, val, false)); } else if (sym == pic->sQUOTE) { if (pic_length(pic, obj) != 2) { @@ -645,7 +593,7 @@ analyze_lambda(analyze_state *state, pic_value obj) { pic_state *pic = state->pic; int ai = pic_gc_arena_preserve(pic); - pic_value args, body; + pic_value args, body, defs; if (pic_length(pic, obj) < 2) { pic_error(pic, "syntax error"); @@ -657,12 +605,35 @@ analyze_lambda(analyze_state *state, pic_value obj) pic_error(pic, "syntax error"); } - /* analyze body in inner environment */ push_scope(state, args); { + struct xhash *dirty_flags; + struct xh_iter it; + + /* analyze body in inner environment */ body = pic_cdr(pic, pic_cdr(pic, obj)); body = pic_cons(pic, pic_symbol_value(pic->sBEGIN), body); body = analyze(state, body, true); + + dirty_flags = state->scope->dirty_flags; + + /* declare local variables */ + defs = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); + for (it = xh_begin(dirty_flags); ! xh_isend(&it); xh_next(dirty_flags, &it)) { + pic_value close; + if (it.e->val == 1) { + close = pic_true_value(); + } else { + close = pic_false_value(); + } + defs = pic_cons(pic, + pic_list(pic, 3, + pic_symbol_value(pic->sDEFINE), + pic_symbol_value(pic_intern_cstr(pic, it.e->key)), + close), + defs); + } + defs = pic_reverse(pic, defs); } pop_scope(state); @@ -735,7 +706,8 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope) new_scope->local_tbl = x = xh_new(); new_scope->varg = false; - i = 1; l = 0; + i = 1; + l = 0; for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { pic_value sym; From 35cf4e1fcd2c1f532464c88f4e8fe75b2621bdf3 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 13:15:09 +0900 Subject: [PATCH 08/43] initialize with global scope --- src/codegen.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 7d318d2e..01ba4eb1 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -96,6 +96,9 @@ typedef struct analyze_state { pic_sym sGSET, sLSET, sCSET; } analyze_state; +static void push_scope(analyze_state *, pic_value); +static void pop_scope(analyze_state *); + #define register_symbol(pic, state, slot, name) do { \ state->slot = pic_intern_cstr(pic, name); \ } while (0) @@ -115,7 +118,7 @@ new_analyze_state(pic_state *pic) state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state)); state->pic = pic; - state->scope = global_scope(pic); + state->scope = NULL; stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)")); @@ -143,6 +146,9 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); + /* push initial scope */ + push_scope(state, pic_nil_value()); + return state; } @@ -242,12 +248,6 @@ define_var(analyze_state *state, const char *name) xh_put(scope->dirty_flags, name, 0); } -static bool -is_global_scope(analyze_scope *scope) -{ - return scope->up == NULL; -} - static pic_value new_cref(analyze_state *state, int depth, pic_sym sym) { From 78420ef0429a6c9fe6f05894beafd3b309abd2d8 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 13:22:45 +0900 Subject: [PATCH 09/43] remove unused properties --- src/codegen.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 01ba4eb1..162b3c8c 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -93,7 +93,6 @@ typedef struct analyze_state { pic_sym rEQ, rLT, rLE, rGT, rGE; pic_sym sCALL, sTAILCALL; pic_sym sGREF, sLREF, sCREF; - pic_sym sGSET, sLSET, sCSET; } analyze_state; static void push_scope(analyze_state *, pic_value); @@ -142,9 +141,6 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sGREF, "gref"); register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); - register_symbol(pic, state, sGREF, "gref"); - register_symbol(pic, state, sLREF, "lref"); - register_symbol(pic, state, sCREF, "cref"); /* push initial scope */ push_scope(state, pic_nil_value()); From 293fef52359ed3691dd707392df53359c5969e5f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 16:43:54 +0900 Subject: [PATCH 10/43] add pic_list_ref --- include/picrin/pair.h | 2 ++ src/pair.c | 9 +++++++++ 2 files changed, 11 insertions(+) diff --git a/include/picrin/pair.h b/include/picrin/pair.h index 1aed0d98..e42a041a 100644 --- a/include/picrin/pair.h +++ b/include/picrin/pair.h @@ -29,6 +29,8 @@ pic_value pic_cadr(pic_state *, pic_value); pic_value pic_cdar(pic_state *, pic_value); pic_value pic_cddr(pic_state *, pic_value); +pic_value pic_list_ref(pic_state *, pic_value, int); + #if defined(__cplusplus) } #endif diff --git a/src/pair.c b/src/pair.c index e6762221..b597e64f 100644 --- a/src/pair.c +++ b/src/pair.c @@ -180,6 +180,15 @@ pic_cddr(pic_state *pic, pic_value v) return pic_cdr(pic, pic_cdr(pic, v)); } +pic_value +pic_list_ref(pic_state *pic, pic_value list, int i) +{ + while (i-- > 0) { + list = pic_cdr(pic, list); + } + return pic_car(pic, list); +} + static pic_value pic_pair_pair_p(pic_state *pic) { From 655eb7a3bd69ea5255a42b6d5018286c1203d11b Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 20 Jan 2014 16:57:39 +0900 Subject: [PATCH 11/43] add pic_compile --- include/picrin.h | 2 +- include/picrin/irep.h | 3 + src/codegen.c | 1286 +++++++++++++---------------------------- src/load.c | 2 +- src/macro.c | 6 +- tools/main.c | 6 +- 6 files changed, 421 insertions(+), 884 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index 7fa5a751..7e142f6a 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -152,7 +152,7 @@ pic_value pic_load(pic_state *, const char *); pic_value pic_apply(pic_state *pic, struct pic_proc *, pic_value); pic_value pic_apply_argv(pic_state *pic, struct pic_proc *, size_t, ...); -struct pic_proc *pic_codegen(pic_state *, pic_value); +struct pic_proc *pic_compile(pic_state *, pic_value); pic_value pic_macroexpand(pic_state *, pic_value); void pic_in_library(pic_state *, pic_value); diff --git a/include/picrin/irep.h b/include/picrin/irep.h index 3238694c..302a2442 100644 --- a/include/picrin/irep.h +++ b/include/picrin/irep.h @@ -69,6 +69,9 @@ struct pic_irep { size_t clen, ilen, plen; }; +pic_value pic_analyze(pic_state *, pic_value); +struct pic_irep *pic_codegen(pic_state *pic, pic_value obj); + void pic_dump_irep(pic_state *, struct pic_irep *); #if defined(__cplusplus) diff --git a/src/codegen.c b/src/codegen.c index 162b3c8c..bd597d05 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -37,24 +37,48 @@ new_irep(pic_state *pic) return irep; } +static bool +analyze_args(pic_state *pic, pic_value args, struct xhash *x, bool *varg, size_t *argc, size_t *localc) +{ + size_t i = 1, l = 0; + pic_value v; + + *varg = false; + for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { + pic_value sym; + + sym = pic_car(pic, v); + if (! pic_symbol_p(sym)) + return false; + if (x) + xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i); + i++; + } + if (pic_nil_p(v)) { + /* pass */ + } + else if (pic_symbol_p(v)) { + *varg = true; + if (x) + xh_put(x, pic_symbol_name(pic, pic_sym(v)), i + l); + l++; + } + else { + return false; + } + *argc = i; + *localc = l; + + return true; +} + static bool valid_formal(pic_state *pic, pic_value formal) { - if (pic_symbol_p(formal)) - return true; + bool varg; + size_t argc, localc; - while (pic_pair_p(formal)) { - if (! pic_symbol_p(pic_car(pic, formal))) { - return false; - } - formal = pic_cdr(pic, formal); - } - if (pic_nil_p(formal)) - return true; - if (pic_symbol_p(formal)) - return true; - - return false; + return analyze_args(pic, formal, NULL, &varg, &argc, &localc); } typedef struct analyze_scope { @@ -69,22 +93,6 @@ typedef struct analyze_scope { struct analyze_scope *up; } analyze_scope; -static analyze_scope * -global_scope(pic_state *pic) -{ - analyze_scope *scope; - - scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); - scope->up = NULL; - scope->local_tbl = pic->global_tbl; - scope->argc = -1; - scope->localc = -1; - scope->varg = false; - scope->dirty_flags = NULL; - - return scope; -} - typedef struct analyze_state { pic_state *pic; analyze_scope *scope; @@ -113,6 +121,7 @@ static analyze_state * new_analyze_state(pic_state *pic) { analyze_state *state; + struct xh_iter it; struct pic_lib *stdlib; state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state)); @@ -145,9 +154,20 @@ new_analyze_state(pic_state *pic) /* push initial scope */ push_scope(state, pic_nil_value()); + for (it = xh_begin(pic->global_tbl); ! xh_isend(&it); xh_next(pic->global_tbl, &it)) { + xh_put(state->scope->local_tbl, it.e->key, 0); + } + return state; } +static void +destroy_analyze_state(analyze_state *state) +{ + pop_scope(state); + pic_free(state->pic, state); +} + static void push_scope(analyze_state *state, pic_value args) { @@ -155,8 +175,6 @@ push_scope(analyze_state *state, pic_value args) analyze_scope *scope; struct xhash *x; struct xh_iter it; - pic_value v; - int i, l; scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope->up = state->scope; @@ -164,26 +182,9 @@ push_scope(analyze_state *state, pic_value args) scope->dirty_flags = xh_new(); scope->varg = false; - i = 1; - l = 0; - for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { - pic_value sym; - - sym = pic_car(pic, v); - xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i++); - } - if (pic_nil_p(v)) { - /* pass */ - } - else if (pic_symbol_p(v)) { - scope->varg = true; - xh_put(x, pic_symbol_name(pic, pic_sym(v)), i + l++); - } - else { + if (! analyze_args(pic, args, x, &scope->varg, &scope->argc, &scope->localc)) { pic_error(pic, "logic flaw"); } - scope->argc = i; - scope->localc = l; /* set dirty flags */ for (it = xh_begin(x); ! xh_isend(&it); xh_next(x, &it)) { @@ -616,41 +617,48 @@ analyze_lambda(analyze_state *state, pic_value obj) /* declare local variables */ defs = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); for (it = xh_begin(dirty_flags); ! xh_isend(&it); xh_next(dirty_flags, &it)) { - pic_value close; + pic_value close, def; if (it.e->val == 1) { close = pic_true_value(); } else { close = pic_false_value(); } - defs = pic_cons(pic, - pic_list(pic, 3, - pic_symbol_value(pic->sDEFINE), - pic_symbol_value(pic_intern_cstr(pic, it.e->key)), - close), - defs); + def = pic_list(pic, 3, pic_symbol_value(pic->sDEFINE), + pic_symbol_value(pic_intern_cstr(pic, it.e->key)), + close); + defs = pic_cons(pic, def, defs); } defs = pic_reverse(pic, defs); } pop_scope(state); - obj = pic_list(pic, 3, pic_symbol_value(pic->sLAMBDA), args, body); + obj = pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, defs, body); pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, obj); return obj; } +pic_value +pic_analyze(pic_state *pic, pic_value obj) +{ + analyze_state *state; + + state = new_analyze_state(pic); + + obj = analyze(state, obj, false); + + destroy_analyze_state(state); + return obj; +} + /** * scope object */ -typedef struct codegen_scope { +typedef struct codegen_context { bool varg; - /* local variables are 1-indexed, 0 is reserved for the callee */ - struct xhash *local_tbl; /* rest args variable is counted by localc */ size_t argc, localc; - /* if local var i is captured, then dirty_flags[i] == 1 */ - int *dirty_flags; /* actual bit code sequence */ struct pic_code *code; size_t clen, ccapa; @@ -661,93 +669,8 @@ typedef struct codegen_scope { pic_value *pool; size_t plen, pcapa; - struct codegen_scope *up; -} codegen_scope; - -static codegen_scope * -new_global_scope(pic_state *pic) -{ - codegen_scope *scope; - - scope = (codegen_scope *)pic_alloc(pic, sizeof(codegen_scope)); - scope->up = NULL; - scope->local_tbl = pic->global_tbl; - scope->argc = -1; - scope->localc = -1; - scope->dirty_flags = NULL; - scope->varg = false; - scope->code = (struct pic_code *)pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(struct pic_code)); - scope->clen = 0; - scope->ccapa = PIC_ISEQ_SIZE; - scope->irep = (struct pic_irep **)pic_calloc(pic, PIC_IREP_SIZE, sizeof(struct pic_irep *)); - scope->ilen = 0; - scope->icapa = PIC_IREP_SIZE; - scope->pool = (pic_value *)pic_calloc(pic, PIC_POOL_SIZE, sizeof(pic_value)); - scope->plen = 0; - scope->pcapa = PIC_POOL_SIZE; - - return scope; -} - -static codegen_scope * -new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope) -{ - codegen_scope *new_scope; - pic_value v; - int i, l; - struct xhash *x; - - new_scope = (codegen_scope *)pic_alloc(pic, sizeof(codegen_scope)); - new_scope->up = scope; - new_scope->local_tbl = x = xh_new(); - new_scope->varg = false; - - i = 1; - l = 0; - for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) { - pic_value sym; - - sym = pic_car(pic, v); - xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i++); - } - if (pic_nil_p(v)) { - /* pass */ - } - else if (pic_symbol_p(v)) { - new_scope->varg = true; - xh_put(x, pic_symbol_name(pic, pic_sym(v)), i + l++); - } - else { - pic_error(pic, "logic flaw"); - } - new_scope->argc = i; - new_scope->localc = l; - new_scope->dirty_flags = (int *)pic_calloc(pic, i + l, sizeof(int)); - - new_scope->code = (struct pic_code *)pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(struct pic_code)); - new_scope->clen = 0; - new_scope->ccapa = PIC_ISEQ_SIZE; - - new_scope->irep = (struct pic_irep **)pic_calloc(pic, PIC_IREP_SIZE, sizeof(struct pic_irep *)); - new_scope->ilen = 0; - new_scope->icapa = PIC_IREP_SIZE; - - new_scope->pool = (pic_value *)pic_calloc(pic, PIC_POOL_SIZE, sizeof(pic_value)); - new_scope->plen = 0; - new_scope->pcapa = PIC_POOL_SIZE; - - return new_scope; -} - -static void -destroy_scope(pic_state *pic, codegen_scope *scope) -{ - if (scope->up) { - xh_destory(scope->local_tbl); - pic_free(pic, scope->dirty_flags); - } - pic_free(pic, scope); -} + struct codegen_context *up; +} codegen_context; /** * global codegen state @@ -755,82 +678,100 @@ destroy_scope(pic_state *pic, codegen_scope *scope) typedef struct codegen_state { pic_state *pic; - codegen_scope *scope; - pic_sym rCONS, rCAR, rCDR, rNILP; - pic_sym rADD, rSUB, rMUL, rDIV; - pic_sym rEQ, rLT, rLE, rGT, rGE; + codegen_context *cxt; + pic_sym sGREF, sCREF, sLREF; + pic_sym sCALL, sTAILCALL; } codegen_state; -#define register_renamed_symbol(pic, state, slot, lib, name) do { \ - struct xh_entry *e; \ - if (! (e = xh_get(lib->senv->tbl, name))) \ - pic_error(pic, "internal error! native VM procedure not found"); \ - state->slot = e->val; \ - } while (0) +static void push_codegen_context(codegen_state *, pic_value, pic_value); +static struct pic_irep *pop_codegen_context(codegen_state *); static codegen_state * new_codegen_state(pic_state *pic) { codegen_state *state; - struct pic_lib *stdlib; state = (codegen_state *)pic_alloc(pic, sizeof(codegen_state)); state->pic = pic; - state->scope = new_global_scope(pic); + state->cxt = NULL; - stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)")); + register_symbol(pic, state, sCALL, "call"); + register_symbol(pic, state, sTAILCALL, "tail-call"); + register_symbol(pic, state, sGREF, "gref"); + register_symbol(pic, state, sLREF, "lref"); + register_symbol(pic, state, sCREF, "cref"); - /* native VM procedures */ - register_renamed_symbol(pic, state, rCONS, stdlib, "cons"); - register_renamed_symbol(pic, state, rCAR, stdlib, "car"); - register_renamed_symbol(pic, state, rCDR, stdlib, "cdr"); - register_renamed_symbol(pic, state, rNILP, stdlib, "null?"); - register_renamed_symbol(pic, state, rADD, stdlib, "+"); - register_renamed_symbol(pic, state, rSUB, stdlib, "-"); - register_renamed_symbol(pic, state, rMUL, stdlib, "*"); - register_renamed_symbol(pic, state, rDIV, stdlib, "/"); - register_renamed_symbol(pic, state, rEQ, stdlib, "="); - register_renamed_symbol(pic, state, rLT, stdlib, "<"); - register_renamed_symbol(pic, state, rLE, stdlib, "<="); - register_renamed_symbol(pic, state, rGT, stdlib, ">"); - register_renamed_symbol(pic, state, rGE, stdlib, ">="); + push_codegen_context(state, pic_nil_value(), pic_nil_value()); return state; } -static void -destroy_codegen_state(pic_state *pic, codegen_state *state) +static struct pic_irep * +destroy_codegen_state(codegen_state *state) { - destroy_scope(pic, state->scope); + pic_state *pic = state->pic; + struct pic_irep *irep; + + irep = pop_codegen_context(state); pic_free(pic, state); + + return irep; } -static codegen_scope * -scope_lookup(codegen_state *state, const char *key, int *depth, int *idx) +static void +push_codegen_context(codegen_state *state, pic_value args, pic_value defs) { - codegen_scope *scope = state->scope; - struct xh_entry *e; - int d = 0; + pic_state *pic = state->pic; + codegen_context *cxt; - enter: + cxt = (codegen_context *)pic_alloc(pic, sizeof(codegen_context)); + cxt->up = state->cxt; - e = xh_get(scope->local_tbl, key); - if (e && e->val >= 0) { - if (scope->up == NULL) { /* global */ - *depth = -1; - } - else { /* non-global */ - *depth = d; - } - *idx = e->val; - return scope; + if (! analyze_args(pic, args, NULL, &cxt->varg, &cxt->argc, &cxt->localc)) { + pic_error(pic, "logic flaw"); } - if (scope->up) { - scope = scope->up; - ++d; - goto enter; - } - return NULL; + cxt->localc += pic_length(pic, defs); + + cxt->code = (struct pic_code *)pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(struct pic_code)); + cxt->clen = 0; + cxt->ccapa = PIC_ISEQ_SIZE; + + cxt->irep = (struct pic_irep **)pic_calloc(pic, PIC_IREP_SIZE, sizeof(struct pic_irep *)); + cxt->ilen = 0; + cxt->icapa = PIC_IREP_SIZE; + + cxt->pool = (pic_value *)pic_calloc(pic, PIC_POOL_SIZE, sizeof(pic_value)); + cxt->plen = 0; + cxt->pcapa = PIC_POOL_SIZE; + + state->cxt = cxt; +} + +static struct pic_irep * +pop_codegen_context(codegen_state *state) +{ + pic_state *pic = state->pic; + codegen_context *cxt = state->cxt; + struct pic_irep *irep; + + /* create irep */ + irep = new_irep(pic); + irep->varg = state->cxt->varg; + irep->argc = state->cxt->argc; + irep->localc = state->cxt->localc; + irep->code = pic_realloc(pic, state->cxt->code, sizeof(struct pic_code) * state->cxt->clen); + irep->clen = state->cxt->clen; + irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen); + irep->ilen = state->cxt->ilen; + irep->pool = pic_realloc(pic, state->cxt->pool, sizeof(pic_value) * state->cxt->plen); + irep->plen = state->cxt->plen; + + /* destroy context */ + cxt = cxt->up; + pic_free(pic, state->cxt); + state->cxt = cxt; + + return irep; } static int @@ -849,708 +790,310 @@ scope_global_define(pic_state *pic, const char *name) return e->val; } -static int -scope_local_define(pic_state *pic, const char *name, codegen_scope *scope) -{ - struct xh_entry *e; - - e = xh_put(scope->local_tbl, name, scope->argc + scope->localc++); - scope->dirty_flags = (int *)pic_realloc(pic, scope->dirty_flags, (scope->argc + scope->localc) * sizeof(int)); - scope->dirty_flags[e->val] = 0; - return e->val; -} - -static bool -scope_is_global(codegen_scope *scope) -{ - return scope->up == NULL; -} - -static void codegen_call(codegen_state *, pic_value, bool); static struct pic_irep *codegen_lambda(codegen_state *, pic_value); static void -codegen(codegen_state *state, pic_value obj, bool tailpos) +codegen(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; - codegen_scope *scope = state->scope; + codegen_context *cxt = state->cxt; + pic_value tag; + pic_sym sym; switch (pic_type(obj)) { - case PIC_TT_SYMBOL: { - codegen_scope *s; - int depth = -1, idx = -1; - const char *name; - - name = pic_symbol_name(pic, pic_sym(obj)); - s = scope_lookup(state, name, &depth, &idx); - if (! s) { -#if DEBUG - printf("%s\n", name); -#endif - pic_error(pic, "symbol: unbound variable"); - } - - switch (depth) { - case -1: /* global */ - scope->code[scope->clen].insn = OP_GREF; - scope->code[scope->clen].u.i = idx; - scope->clen++; - break; - default: /* nonlocal */ - s->dirty_flags[idx] = 1; - /* at this stage, lref and cref are not distinguished */ - FALLTHROUGH; - case 0: /* local */ - scope->code[scope->clen].insn = OP_CREF; - scope->code[scope->clen].u.r.depth = depth; - scope->code[scope->clen].u.r.idx = idx; - scope->clen++; - break; - } - break; - } - case PIC_TT_PAIR: { - pic_value proc; - - if (! pic_list_p(pic, obj)) { - pic_error(pic, "invalid expression given"); - } - - proc = pic_car(pic, obj); - if (pic_symbol_p(proc)) { - pic_sym sym = pic_sym(proc); - - if (sym == pic->sDEFINE) { - int idx; - pic_value var, val; - - if (pic_length(pic, obj) < 2) { - pic_error(pic, "syntax error"); - } - - var = pic_car(pic, pic_cdr(pic, obj)); - if (pic_pair_p(var)) { - val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA), - pic_cons(pic, pic_cdr(pic, var), - pic_cdr(pic, pic_cdr(pic, obj)))); - var = pic_car(pic, var); - } - else { - if (pic_length(pic, obj) != 3) { - pic_error(pic, "syntax error"); - } - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); - } - if (! pic_symbol_p(var)) { - pic_error(pic, "syntax error"); - } - - if (scope_is_global(scope)) { - idx = scope_global_define(pic, pic_symbol_name(pic, pic_sym(var))); - codegen(state, val, false); - scope->code[scope->clen].insn = OP_GSET; - scope->code[scope->clen].u.i = idx; - scope->clen++; - scope->code[scope->clen].insn = OP_PUSHNONE; - scope->clen++; - break; - } - else { - idx = scope_local_define(pic, pic_symbol_name(pic, pic_sym(var)), scope); - codegen(state, val, false); - scope->code[scope->clen].insn = OP_CSET; - scope->code[scope->clen].u.r.depth = 0; - scope->code[scope->clen].u.r.idx = idx; - scope->clen++; - scope->code[scope->clen].insn = OP_PUSHNONE; - scope->clen++; - break; - } - } - else if (sym == pic->sLAMBDA) { - int k; - - if (scope->ilen >= scope->icapa) { -#if DEBUG - puts("irep realloced"); -#endif - scope->icapa *= 2; - scope->irep = (struct pic_irep **)pic_realloc(pic, scope->irep, sizeof(struct pic_irep *) * scope->icapa); - } - k = scope->ilen++; - scope->code[scope->clen].insn = OP_LAMBDA; - scope->code[scope->clen].u.i = k; - scope->clen++; - - scope->irep[k] = codegen_lambda(state, obj); - break; - } - else if (sym == pic->sIF) { - int s,t; - pic_value if_true, if_false; - - if_false = pic_none_value(); - switch (pic_length(pic, obj)) { - default: - pic_error(pic, "syntax error"); - break; - case 4: - if_false = pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - FALLTHROUGH; - case 3: - if_true = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); - } - - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - - scope->code[scope->clen].insn = OP_JMPIF; - s = scope->clen++; - - /* if false branch */ - codegen(state, if_false, tailpos); - scope->code[scope->clen].insn = OP_JMP; - t = scope->clen++; - - scope->code[s].u.i = scope->clen - s; - - /* if true branch */ - codegen(state, if_true, tailpos); - scope->code[t].u.i = scope->clen - t; - break; - } - else if (sym == pic->sBEGIN) { - int i, len; - pic_value v, seq; - - seq = pic_cdr(pic, obj); - len = pic_length(pic, seq); - for (i = 0; i < len; ++i) { - v = pic_car(pic, seq); - if (i + 1 >= len) { - codegen(state, v, tailpos); - } - else { - codegen(state, v, false); - scope->code[scope->clen].insn = OP_POP; - scope->clen++; - } - seq = pic_cdr(pic, seq); - } - break; - } - else if (sym == pic->sSETBANG) { - codegen_scope *s; - pic_value var; - int depth = -1, idx = -1; - - if (pic_length(pic, obj) != 3) { - pic_error(pic, "syntax error"); - } - - var = pic_car(pic, pic_cdr(pic, obj)); - if (! pic_symbol_p(var)) { - pic_error(pic, "syntax error"); - } - - s = scope_lookup(state, pic_symbol_name(pic, pic_sym(var)), &depth, &idx); - if (! s) { - pic_error(pic, "unbound variable"); - } - - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - - switch (depth) { - case -1: /* global */ - scope->code[scope->clen].insn = OP_GSET; - scope->code[scope->clen].u.i = idx; - scope->clen++; - break; - default: /* nonlocal */ - s->dirty_flags[idx] = 1; - /* at this stage, lset and cset are not distinguished */ - FALLTHROUGH; - case 0: /* local */ - scope->code[scope->clen].insn = OP_CSET; - scope->code[scope->clen].u.r.depth = depth; - scope->code[scope->clen].u.r.idx = idx; - scope->clen++; - break; - } - - scope->code[scope->clen].insn = OP_PUSHNONE; - scope->clen++; - break; - } - else if (sym == pic->sQUOTE) { - int pidx; - - if (pic_length(pic, obj) != 2) { - pic_error(pic, "syntax error"); - } - - if (scope->plen >= scope->pcapa) { - scope->pcapa *= 2; - scope->pool = (pic_value *)pic_realloc(pic, scope->pool, sizeof(pic_value) * scope->pcapa); - } - pidx = scope->plen++; - scope->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); - scope->code[scope->clen].insn = OP_PUSHCONST; - scope->code[scope->clen].u.i = pidx; - scope->clen++; - break; - } - -#define ARGC_ASSERT(n) do { \ - if (pic_length(pic, obj) != (n) + 1) { \ - pic_error(pic, "wrong number of arguments"); \ - } \ - } while (0) - - else if (sym == state->rCONS) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - scope->code[scope->clen].insn = OP_CONS; - scope->clen++; - break; - } - else if (sym == state->rCAR) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_CAR; - scope->clen++; - break; - } - else if (sym == state->rCDR) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_CDR; - scope->clen++; - break; - } - else if (sym == state->rNILP) { - ARGC_ASSERT(1); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_NILP; - scope->clen++; - break; - } - -#define ARGC_ASSERT_GE(n) do { \ - if (pic_length(pic, obj) < (n) + 1) { \ - pic_error(pic, "wrong number of arguments"); \ - } \ - } while (0) - - else if (sym == state->rADD) { - pic_value args; - - ARGC_ASSERT_GE(0); - switch (pic_length(pic, obj)) { - case 1: - scope->code[scope->clen].insn = OP_PUSHINT; - scope->code[scope->clen].u.i = 0; - scope->clen++; - break; - case 2: - codegen(state, pic_car(pic, pic_cdr(pic, obj)), tailpos); - break; - default: - args = pic_cdr(pic, obj); - codegen(state, pic_car(pic, args), false); - while (pic_length(pic, args) >= 2) { - codegen(state, pic_car(pic, pic_cdr(pic, args)), false); - scope->code[scope->clen].insn = OP_ADD; - scope->clen++; - args = pic_cdr(pic, args); - } - break; - } - break; - } - else if (sym == state->rSUB) { - pic_value args; - - ARGC_ASSERT_GE(1); - switch (pic_length(pic, obj)) { - case 2: - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_MINUS; - scope->clen++; - break; - default: - args = pic_cdr(pic, obj); - codegen(state, pic_car(pic, args), false); - while (pic_length(pic, args) >= 2) { - codegen(state, pic_car(pic, pic_cdr(pic, args)), false); - scope->code[scope->clen].insn = OP_SUB; - scope->clen++; - args = pic_cdr(pic, args); - } - break; - } - break; - } - else if (sym == state->rMUL) { - pic_value args; - - ARGC_ASSERT_GE(0); - switch (pic_length(pic, obj)) { - case 1: - scope->code[scope->clen].insn = OP_PUSHINT; - scope->code[scope->clen].u.i = 1; - scope->clen++; - break; - case 2: - codegen(state, pic_car(pic, pic_cdr(pic, obj)), tailpos); - break; - default: - args = pic_cdr(pic, obj); - codegen(state, pic_car(pic, args), false); - while (pic_length(pic, args) >= 2) { - codegen(state, pic_car(pic, pic_cdr(pic, args)), false); - scope->code[scope->clen].insn = OP_MUL; - scope->clen++; - args = pic_cdr(pic, args); - } - break; - } - break; - } - else if (sym == state->rDIV) { - pic_value args; - - ARGC_ASSERT_GE(1); - switch (pic_length(pic, obj)) { - case 2: - scope->code[scope->clen].insn = OP_PUSHINT; - scope->code[scope->clen].u.i = 1; - scope->clen++; - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_DIV; - scope->clen++; - break; - default: - args = pic_cdr(pic, obj); - codegen(state, pic_car(pic, args), false); - while (pic_length(pic, args) >= 2) { - codegen(state, pic_car(pic, pic_cdr(pic, args)), false); - scope->code[scope->clen].insn = OP_DIV; - scope->clen++; - args = pic_cdr(pic, args); - } - break; - } - break; - } - else if (sym == state->rEQ) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - scope->code[scope->clen].insn = OP_EQ; - scope->clen++; - break; - } - else if (sym == state->rLT) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - scope->code[scope->clen].insn = OP_LT; - scope->clen++; - break; - } - else if (sym == state->rLE) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - scope->code[scope->clen].insn = OP_LE; - scope->clen++; - break; - } - else if (sym == state->rGT) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_LT; - scope->clen++; - break; - } - else if (sym == state->rGE) { - ARGC_ASSERT(2); - codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false); - codegen(state, pic_car(pic, pic_cdr(pic, obj)), false); - scope->code[scope->clen].insn = OP_LE; - scope->clen++; - break; - } - } - - codegen_call(state, obj, tailpos); - break; - } - case PIC_TT_BOOL: { + case PIC_TT_BOOL: if (pic_true_p(obj)) { - scope->code[scope->clen].insn = OP_PUSHTRUE; + cxt->code[cxt->clen].insn = OP_PUSHTRUE; + } else { + cxt->code[cxt->clen].insn = OP_PUSHFALSE; } - else { - scope->code[scope->clen].insn = OP_PUSHFALSE; + cxt->clen++; + return; + case PIC_TT_FLOAT: + cxt->code[cxt->clen].insn = OP_PUSHFLOAT; + cxt->code[cxt->clen].u.f = pic_float(obj); + cxt->clen++; + return; + case PIC_TT_INT: + cxt->code[cxt->clen].insn = OP_PUSHINT; + cxt->code[cxt->clen].u.i = pic_int(obj); + cxt->clen++; + return; + case PIC_TT_NIL: + cxt->code[cxt->clen].insn = OP_PUSHNIL; + cxt->clen++; + return; + case PIC_TT_CHAR: + cxt->code[cxt->clen].insn = OP_PUSHCHAR; + cxt->code[cxt->clen].u.c = pic_char(obj); + cxt->clen++; + return; + default: + break; + } + + if (! pic_list_p(pic, obj)) { + pic_error(pic, "codegen: invalid AST given"); + } + + tag = pic_car(pic, obj); + if (! pic_symbol_p(tag)) { + pic_error(pic, "codegen: broken AST"); + } + + sym = pic_sym(tag); + if (sym == state->sGREF) { + cxt->code[cxt->clen].insn = OP_GREF; + cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, obj, 1)); + cxt->clen++; + return; + } else if (sym == state->sCREF) { + cxt->code[cxt->clen].insn = OP_CREF; + cxt->code[cxt->clen].u.r.depth = pic_int(pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].u.r.idx = pic_int(pic_list_ref(pic, obj, 2)); + cxt->clen++; + return; + } else if (sym == state-> sLREF) { + cxt->code[cxt->clen].insn = OP_LREF; + cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, obj, 1)); + cxt->clen++; + return; + } else if (sym == pic->sSETBANG) { + pic_value var, val; + pic_sym type; + + val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + codegen(state, val); + + var = pic_car(pic, pic_cdr(pic, obj)); + type = pic_sym(var); + if (type == state->sGREF) { + cxt->code[cxt->clen].insn = OP_GSET; + cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, var, 1)); + cxt->clen++; + cxt->code[cxt->clen].insn = OP_PUSHNONE; + cxt->clen++; + return; + } + else if (type == state->sCREF) { + cxt->code[cxt->clen].insn = OP_CSET; + cxt->code[cxt->clen].u.r.depth = pic_int(pic_list_ref(pic, var, 1)); + cxt->code[cxt->clen].u.r.idx = pic_int(pic_list_ref(pic, var, 2)); + cxt->clen++; + cxt->code[cxt->clen].insn = OP_PUSHNONE; + cxt->clen++; + return; + } + else if (type == state->sLREF) { + cxt->code[cxt->clen].insn = OP_CSET; + cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, var, 1)); + cxt->clen++; + cxt->code[cxt->clen].insn = OP_PUSHNONE; + cxt->clen++; + return; } - scope->clen++; - break; } - case PIC_TT_FLOAT: { - scope->code[scope->clen].insn = OP_PUSHFLOAT; - scope->code[scope->clen].u.f = pic_float(obj); - scope->clen++; - break; + else if (sym == pic->sLAMBDA) { + int k; + + if (cxt->ilen >= cxt->icapa) { + cxt->icapa *= 2; + cxt->irep = (struct pic_irep **)pic_realloc(pic, cxt->irep, sizeof(struct pic_irep *) * cxt->icapa); + } + k = cxt->ilen++; + cxt->code[cxt->clen].insn = OP_LAMBDA; + cxt->code[cxt->clen].u.i = k; + cxt->clen++; + + cxt->irep[k] = codegen_lambda(state, obj); + return; } - case PIC_TT_INT: { - scope->code[scope->clen].insn = OP_PUSHINT; - scope->code[scope->clen].u.i = pic_int(obj); - scope->clen++; - break; + else if (sym == pic->sIF) { + int s, t; + + codegen(state, pic_list_ref(pic, obj, 1)); + + cxt->code[cxt->clen].insn = OP_JMPIF; + s = cxt->clen++; + + /* if false branch */ + codegen(state, pic_list_ref(pic, obj, 3)); + cxt->code[cxt->clen].insn = OP_JMP; + t = cxt->clen++; + + cxt->code[s].u.i = cxt->clen - s; + + /* if true branch */ + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[t].u.i = cxt->clen - t; + return; } - case PIC_TT_NIL: { - scope->code[scope->clen].insn = OP_PUSHNIL; - scope->clen++; - break; + else if (sym == pic->sBEGIN) { + for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { + codegen(state, pic_car(pic, obj)); + } + return; } - case PIC_TT_CHAR: { - scope->code[scope->clen].insn = OP_PUSHCHAR; - scope->code[scope->clen].u.c = pic_char(obj); - scope->clen++; - break; - } - case PIC_TT_STRING: - case PIC_TT_VECTOR: - case PIC_TT_BLOB: { + else if (sym == pic->sQUOTE) { int pidx; - if (scope->plen >= scope->pcapa) { - scope->pcapa *= 2; - scope->pool = (pic_value *)pic_realloc(pic, scope->pool, sizeof(pic_value) * scope->pcapa); + + if (cxt->plen >= cxt->pcapa) { + cxt->pcapa *= 2; + cxt->pool = (pic_value *)pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa); } - pidx = scope->plen++; - scope->pool[pidx] = obj; - scope->code[scope->clen].insn = OP_PUSHCONST; - scope->code[scope->clen].u.i = pidx; - scope->clen++; - break; + pidx = cxt->plen++; + cxt->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); + cxt->code[cxt->clen].insn = OP_PUSHCONST; + cxt->code[cxt->clen].u.i = pidx; + cxt->clen++; + return; } - case PIC_TT_CONT: - case PIC_TT_ENV: - case PIC_TT_PROC: - case PIC_TT_UNDEF: - case PIC_TT_EOF: - case PIC_TT_PORT: - case PIC_TT_ERROR: - case PIC_TT_SENV: - case PIC_TT_SYNTAX: - case PIC_TT_SC: - case PIC_TT_LIB: - case PIC_TT_VAR: - case PIC_TT_IREP: - pic_error(pic, "invalid expression given"); + else if (sym == pic->sCONS) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_CONS; + cxt->clen++; + return; } -} - -static void -codegen_call(codegen_state *state, pic_value obj, bool tailpos) -{ - pic_state *pic = state->pic; - codegen_scope *scope = state->scope; - pic_value seq; - int i = 0; - - for (seq = obj; ! pic_nil_p(seq); seq = pic_cdr(pic, seq)) { - pic_value v; - - v = pic_car(pic, seq); - codegen(state, v, false); - ++i; + else if (sym == pic->sCAR) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_CAR; + cxt->clen++; + return; } - scope->code[scope->clen].insn = tailpos ? OP_TAILCALL : OP_CALL; - scope->code[scope->clen].u.i = i; - scope->clen++; -} - -static void -lift_cv(pic_state *pic, struct pic_irep *irep, int d) -{ - int i; - struct pic_code c; - - for (i = 0; i < irep->clen; ++i) { - c = irep->code[i]; - switch (c.insn) { - default: - /* pass */ - break; - case OP_LAMBDA: - if (irep->irep[c.u.i]->cv_num == 0) - lift_cv(pic, irep->irep[c.u.i], d); - else - lift_cv(pic, irep->irep[c.u.i], d + 1); - break; - case OP_CREF: - case OP_CSET: - if (irep->code[i].u.r.depth > d) - irep->code[i].u.r.depth--; - break; - } - } -} - -static void -slide_cv(pic_state *pic, unsigned *cv_tbl, unsigned cv_num, struct pic_irep *irep, int d) -{ - int i, j; - struct pic_code c; - - for (i = 0; i < irep->clen; ++i) { - c = irep->code[i]; - switch (c.insn) { - default: - /* pass */ - break; - case OP_LAMBDA: - if (irep->irep[c.u.i]->cv_num == 0) { - slide_cv(pic, cv_tbl, cv_num, irep->irep[c.u.i], d); - } - else { - slide_cv(pic, cv_tbl, cv_num, irep->irep[c.u.i], d + 1); - } - break; - case OP_CREF: - case OP_CSET: - if (d != c.u.r.depth) - break; - for (j = 0; j < cv_num; ++j) { - if (c.u.r.idx == cv_tbl[j]) { - irep->code[i].u.r.idx = j; - break; - } - } - break; + else if (sym == pic->sCDR) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_CDR; + cxt->clen++; + return; + } + else if (sym == pic->sNILP) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_NILP; + cxt->clen++; + return; + } + else if (sym == pic->sADD) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_ADD; + cxt->clen++; + return; + } + else if (sym == pic->sSUB) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_SUB; + cxt->clen++; + return; + } + else if (sym == pic->sMUL) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_MUL; + cxt->clen++; + return; + } + else if (sym == pic->sDIV) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_DIV; + cxt->clen++; + return; + } + else if (sym == pic->sMINUS) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_MINUS; + cxt->clen++; + return; + } + else if (sym == pic->sEQ) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_EQ; + cxt->clen++; + } + else if (sym == pic->sLT) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_LT; + cxt->clen++; + } + else if (sym == pic->sLE) { + codegen(state, pic_list_ref(pic, obj, 1)); + codegen(state, pic_list_ref(pic, obj, 2)); + cxt->code[cxt->clen].insn = OP_LE; + cxt->clen++; + } + else if (sym == pic->sGT) { + codegen(state, pic_list_ref(pic, obj, 2)); + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_LT; + cxt->clen++; + } + else if (sym == pic->sGE) { + codegen(state, pic_list_ref(pic, obj, 2)); + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_LE; + cxt->clen++; + } + else if (sym == state->sCALL || sym == state->sTAILCALL) { + int len = pic_length(pic, obj); + for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { + codegen(state, pic_car(pic, obj)); } + cxt->code[cxt->clen].insn = (sym == state->sCALL) ? OP_CALL : OP_TAILCALL; + cxt->code[cxt->clen].u.i = len; + cxt->clen++; } + pic_error(pic, "codegen: unknown AST type"); } static struct pic_irep * codegen_lambda(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; - struct pic_irep *irep; - pic_value args, body, v; - int i, c, k; + pic_value args, defs, body; - if (pic_length(pic, obj) < 2) { - pic_error(pic, "syntax error"); - } - - args = pic_car(pic, pic_cdr(pic, obj)); - if (! valid_formal(pic, args)) { - pic_error(pic, "syntax error"); - } + args = pic_list_ref(pic, obj, 1); + defs = pic_cdr(pic, pic_list_ref(pic, obj, 2)); + body = pic_list_ref(pic, obj, 3); /* inner environment */ - state->scope = new_local_scope(pic, args, state->scope); + push_codegen_context(state, args, defs); { /* body */ - body = pic_cdr(pic, pic_cdr(pic, obj)); - for (v = body; ! pic_nil_p(v); v = pic_cdr(pic, v)) { - if (pic_nil_p(pic_cdr(pic, v))) { - codegen(state, pic_car(pic, v), true); - } - else { - codegen(state, pic_car(pic, v), false); - state->scope->code[state->scope->clen].insn = OP_POP; - state->scope->clen++; - } - } - state->scope->code[state->scope->clen].insn = OP_RET; - state->scope->clen++; - - /* create irep */ - irep = new_irep(pic); - irep->varg = state->scope->varg; - irep->argc = state->scope->argc; - irep->localc = state->scope->localc; - irep->code = pic_realloc(pic, state->scope->code, sizeof(struct pic_code) * state->scope->clen); - irep->clen = state->scope->clen; - irep->irep = pic_realloc(pic, state->scope->irep, sizeof(struct pic_irep *) * state->scope->ilen); - irep->ilen = state->scope->ilen; - irep->pool = pic_realloc(pic, state->scope->pool, sizeof(pic_value) * state->scope->plen); - irep->plen = state->scope->plen; - - /* fixup local references */ - for (i = 0; i < irep->clen; ++i) { - struct pic_code c = irep->code[i]; - switch (c.insn) { - default: - /* pass */ - break; - case OP_CREF: - if (c.u.r.depth == 0 && ! state->scope->dirty_flags[c.u.r.idx]) { - irep->code[i].insn = OP_LREF; - irep->code[i].u.i = irep->code[i].u.r.idx; - } - break; - case OP_CSET: - if (c.u.r.depth == 0 && ! state->scope->dirty_flags[c.u.r.idx]) { - irep->code[i].insn = OP_LSET; - irep->code[i].u.i = irep->code[i].u.r.idx; - } - break; - } - } - - /* fixup closed variables */ - c = 0; - for (i = 0; i < irep->argc + irep->localc; ++i) { - if (state->scope->dirty_flags[i]) - ++c; - } - if (c == 0) { - lift_cv(pic, irep, 0); - irep->cv_tbl = NULL; - irep->cv_num = 0; - } - else { - irep->cv_tbl = (unsigned *)pic_calloc(pic, c, sizeof(unsigned)); - k = 0; - for (i = 0; i < irep->argc + irep->localc; ++i) { - if (state->scope->dirty_flags[i]) { - irep->cv_tbl[k] = i; - ++k; - } - } - irep->cv_num = c; - slide_cv(pic, irep->cv_tbl, irep->cv_num, irep, 0); - } + codegen(state, body); + state->cxt->code[state->cxt->clen].insn = OP_RET; + state->cxt->clen++; } - destroy_scope(pic, state->scope); + return pop_codegen_context(state); +} - state->scope = state->scope->up; +pic_value pic_analyze(pic_state *, pic_value); -#if VM_DEBUG - printf("* generated lambda:\n"); - pic_dump_irep(pic, irep); - puts(""); -#endif +struct pic_irep * +pic_codegen(pic_state *pic, pic_value obj) +{ + codegen_state *state; - return irep; + state = new_codegen_state(pic); + + codegen(state, obj); + state->cxt->code[state->cxt->clen].insn = OP_RET; + state->cxt->clen++; + + return destroy_codegen_state(state); } struct pic_proc * -pic_codegen(pic_state *pic, pic_value obj) +pic_compile(pic_state *pic, pic_value obj) { struct pic_proc *proc; - codegen_state *state; struct pic_irep *irep; jmp_buf jmp, *prev_jmp = pic->jmp; int ai = pic_gc_arena_preserve(pic); - state = new_codegen_state(pic); if (setjmp(jmp) == 0) { pic->jmp = &jmp; @@ -1561,27 +1104,18 @@ pic_codegen(pic_state *pic, pic_value obj) goto exit; } - codegen(state, pic_macroexpand(pic, obj), false); - state->scope->code[state->scope->clen].insn = OP_RET; - state->scope->clen++; + /* macroexpand */ + obj = pic_macroexpand(pic, obj); - irep = new_irep(pic); - irep->varg = false; - irep->argc = 1; - irep->localc = 0; - irep->code = pic_realloc(pic, state->scope->code, sizeof(struct pic_code) * state->scope->clen); - irep->clen = state->scope->clen; - irep->irep = pic_realloc(pic, state->scope->irep, sizeof(struct pic_irep *) * state->scope->ilen); - irep->ilen = state->scope->ilen; - irep->pool = pic_realloc(pic, state->scope->pool, sizeof(pic_value) * state->scope->plen); - irep->plen = state->scope->plen; - irep->cv_num = 0; - irep->cv_tbl = NULL; + /* analyze */ + obj = pic_analyze(pic, obj); + pic_debug(pic, obj); + + /* codegen */ + irep = pic_codegen(pic, obj); proc = pic_proc_new_irep(pic, irep, NULL); - destroy_codegen_state(pic, state); - #if VM_DEBUG pic_dump_irep(pic, proc->u.irep); #endif diff --git a/src/load.c b/src/load.c index b8dec291..4ab25277 100644 --- a/src/load.c +++ b/src/load.c @@ -27,7 +27,7 @@ pic_load(pic_state *pic, const char *fn) for (i = 0; i < n; ++i, vs = pic_cdr(pic, vs)) { v = pic_car(pic, vs); - proc = pic_codegen(pic, v); + proc = pic_compile(pic, v); if (proc == NULL) { pic_error(pic, "load: compilation failure"); } diff --git a/src/macro.c b/src/macro.c index 64d606d8..86ba7e07 100644 --- a/src/macro.c +++ b/src/macro.c @@ -317,7 +317,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) for (exprs = pic_cddr(pic, expr); ! pic_nil_p(exprs); exprs = pic_cdr(pic, exprs)) { v = pic_car(pic, exprs); - proc = pic_codegen(pic, v); + proc = pic_compile(pic, v); if (proc == NULL) { abort(); } @@ -364,7 +364,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) } val = pic_cadr(pic, pic_cdr(pic, expr)); - proc = pic_codegen(pic, val); + proc = pic_compile(pic, val); if (pic->errmsg) { printf("macroexpand error: %s\n", pic->errmsg); abort(); @@ -406,7 +406,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) pic_error(pic, "syntax error"); } - proc = pic_codegen(pic, val); + proc = pic_compile(pic, val); if (pic->errmsg) { printf("macroexpand error: %s\n", pic->errmsg); abort(); diff --git a/tools/main.c b/tools/main.c index ff91e3f9..b3e9e350 100644 --- a/tools/main.c +++ b/tools/main.c @@ -122,7 +122,7 @@ repl(pic_state *pic) #endif /* eval */ - proc = pic_codegen(pic, v); + proc = pic_compile(pic, v); if (proc == NULL) { printf("compilation error: %s\n", pic->errmsg); pic->errmsg = NULL; @@ -183,7 +183,7 @@ exec_file(pic_state *pic, const char *fname) v = pic_car(pic, vs); - proc = pic_codegen(pic, v); + proc = pic_compile(pic, v); if (proc == NULL) { fputs(pic->errmsg, stderr); fprintf(stderr, "fatal error: %s compilation failure\n", fname); @@ -223,7 +223,7 @@ exec_string(pic_state *pic, const char *str) for (i = 0; i < n; ++i) { v = pic_car(pic, vs); - proc = pic_codegen(pic, v); + proc = pic_compile(pic, v); if (proc == NULL) { goto abort; } From 3dbafd58be66c5f3b2e96c91f955af8e41b12b68 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 15:03:43 +0900 Subject: [PATCH 12/43] cleanup --- src/codegen.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index bd597d05..2ff76afb 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -82,8 +82,8 @@ valid_formal(pic_state *pic, pic_value formal) } typedef struct analyze_scope { - bool varg; /* rest args variable is counted by localc */ + bool varg; size_t argc, localc; /* local variables are 1-indexed, 0 is reserved for the callee */ struct xhash *local_tbl; @@ -121,6 +121,7 @@ static analyze_state * new_analyze_state(pic_state *pic) { analyze_state *state; + struct xhash *global_tbl; struct xh_iter it; struct pic_lib *stdlib; @@ -154,7 +155,8 @@ new_analyze_state(pic_state *pic) /* push initial scope */ push_scope(state, pic_nil_value()); - for (it = xh_begin(pic->global_tbl); ! xh_isend(&it); xh_next(pic->global_tbl, &it)) { + global_tbl = pic->global_tbl; + for (it = xh_begin(global_tbl); ! xh_isend(&it); xh_next(global_tbl, &it)) { xh_put(state->scope->local_tbl, it.e->key, 0); } @@ -371,7 +373,6 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) } else if (sym == pic->sSETBANG) { pic_value var, val; - int depth; if (pic_length(pic, obj) != 3) { pic_error(pic, "syntax error"); @@ -382,11 +383,6 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - depth = lookup_var(state, pic_symbol_name(pic, pic_sym(var))); - if (depth == -1) { - pic_error(pic, "unbound variable"); - } - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); return pic_list(pic, 3, From 6d346fef874c7feac371f6c9b49ab04e79b14d53 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 15:18:41 +0900 Subject: [PATCH 13/43] unify the names of IR reference nodes to a name 'ref' --- src/codegen.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 2ff76afb..b10798ea 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -99,7 +99,7 @@ typedef struct analyze_state { pic_sym rCONS, rCAR, rCDR, rNILP; pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rEQ, rLT, rLE, rGT, rGE; - pic_sym sCALL, sTAILCALL; + pic_sym sCALL, sTAILCALL, sREF; pic_sym sGREF, sLREF, sCREF; } analyze_state; @@ -148,6 +148,7 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sCALL, "call"); register_symbol(pic, state, sTAILCALL, "tail-call"); + register_symbol(pic, state, sREF, "ref"); register_symbol(pic, state, sGREF, "gref"); register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); @@ -248,10 +249,10 @@ define_var(analyze_state *state, const char *name) } static pic_value -new_cref(analyze_state *state, int depth, pic_sym sym) +new_ref(analyze_state *state, int depth, pic_sym sym) { return pic_list(state->pic, 3, - pic_symbol_value(state->sCREF), + pic_symbol_value(state->sREF), pic_int_value(depth), pic_symbol_value(sym)); } @@ -288,7 +289,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "symbol: unbound variable"); } /* at this stage, lref/cref/gref are not distinguished */ - return new_cref(state, depth, pic_sym(obj)); + return new_ref(state, depth, pic_sym(obj)); } case PIC_TT_PAIR: { pic_value proc; From c7811f0c39c4a0c3df52352cf93100dd832e3ee4 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 16:17:52 +0900 Subject: [PATCH 14/43] add depth property --- src/codegen.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index b10798ea..5612862b 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -82,6 +82,7 @@ valid_formal(pic_state *pic, pic_value formal) } typedef struct analyze_scope { + int depth; /* rest args variable is counted by localc */ bool varg; size_t argc, localc; @@ -181,6 +182,7 @@ push_scope(analyze_state *state, pic_value args) scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope->up = state->scope; + scope->depth = state->scope ? state->scope->depth + 1 : 0; scope->local_tbl = x = xh_new(); scope->dirty_flags = xh_new(); scope->varg = false; From 75167697f051314466d10bc7e8ddd655e779f588 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 16:32:20 +0900 Subject: [PATCH 15/43] start using pic_list_ref and pic_list_tail --- src/codegen.c | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 5612862b..6b5b4225 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -300,7 +300,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "invalid expression given"); } - proc = pic_car(pic, obj); + proc = pic_list_ref(pic, obj, 0); if (pic_symbol_p(proc)) { pic_sym sym = pic_sym(proc); @@ -311,18 +311,18 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - var = pic_car(pic, pic_cdr(pic, obj)); + var = pic_list_ref(pic, obj, 1); if (pic_pair_p(var)) { val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA), - pic_cons(pic, pic_cdr(pic, var), - pic_cdr(pic, pic_cdr(pic, obj)))); - var = pic_car(pic, var); + pic_cons(pic, pic_list_tail(pic, var, 1), + pic_list_tail(pic, obj, 2))); + var = pic_list_ref(pic, var, 0); } else { if (pic_length(pic, obj) != 3) { pic_error(pic, "syntax error"); } - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + val = pic_list_ref(pic, obj, 2); } if (! pic_symbol_p(var)) { pic_error(pic, "syntax error"); @@ -346,15 +346,15 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); break; case 4: - if_false = pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))); + if_false = pic_list_ref(pic, obj, 3); FALLTHROUGH; case 3: - if_true = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + if_true = pic_list_ref(pic, obj, 2); } return pic_list(pic, 4, pic_symbol_value(pic->sIF), - analyze(state, pic_car(pic, pic_cdr(pic, obj)), false), + analyze(state, pic_list_ref(pic, obj, 1), false), analyze(state, if_true, tailpos), analyze(state, if_false, tailpos)); } @@ -381,12 +381,12 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - var = pic_car(pic, pic_cdr(pic, obj)); + var = pic_list_ref(pic, obj, 1); if (! pic_symbol_p(var)) { pic_error(pic, "syntax error"); } - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + val = pic_list_ref(pic, obj, 2); return pic_list(pic, 3, pic_symbol_value(pic->sSETBANG), @@ -409,13 +409,13 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) #define CONSTRUCT_OP1(op) \ pic_list(pic, 2, \ pic_symbol_value(op), \ - analyze(state, pic_car(pic, pic_cdr(pic, obj)), false)) + analyze(state, pic_list_ref(pic, obj, 1), false)) #define CONSTRUCT_OP2(op) \ pic_list(pic, 3, \ pic_symbol_value(op), \ - analyze(state, pic_car(pic, pic_cdr(pic, obj)), false), \ - analyze(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false)) + analyze(state, pic_list_ref(pic, obj, 1), false), \ + analyze(state, pic_list_ref(pic, obj, 2), false)) else if (sym == state->rCONS) { ARGC_ASSERT(2); @@ -861,10 +861,10 @@ codegen(codegen_state *state, pic_value obj) pic_value var, val; pic_sym type; - val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + val = pic_list_ref(pic, obj, 2); codegen(state, val); - var = pic_car(pic, pic_cdr(pic, obj)); + var = pic_list_ref(pic, obj, 1); type = pic_sym(var); if (type == state->sGREF) { cxt->code[cxt->clen].insn = OP_GSET; From 801c04788fec06b685edc9d7fe591355776b3c56 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 18:55:39 +0900 Subject: [PATCH 16/43] add cv_foo properties to codegen_context --- src/codegen.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index 6b5b4225..780ba5e1 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -658,6 +658,8 @@ typedef struct codegen_context { bool varg; /* rest args variable is counted by localc */ size_t argc, localc; + /* closed variable table */ + unsigned *cv_tbl, cv_num; /* actual bit code sequence */ struct pic_code *code; size_t clen, ccapa; @@ -680,6 +682,7 @@ typedef struct codegen_state { codegen_context *cxt; pic_sym sGREF, sCREF, sLREF; pic_sym sCALL, sTAILCALL; + unsigned *cv_tbl, cv_num; } codegen_state; static void push_codegen_context(codegen_state *, pic_value, pic_value); @@ -731,6 +734,9 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value defs) } cxt->localc += pic_length(pic, defs); + cxt->cv_tbl = NULL; + cxt->cv_num = 0; + cxt->code = (struct pic_code *)pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(struct pic_code)); cxt->clen = 0; cxt->ccapa = PIC_ISEQ_SIZE; @@ -758,6 +764,8 @@ pop_codegen_context(codegen_state *state) irep->varg = state->cxt->varg; irep->argc = state->cxt->argc; irep->localc = state->cxt->localc; + irep->cv_tbl = state->cxt->cv_tbl; + irep->cv_num = state->cxt->cv_num; irep->code = pic_realloc(pic, state->cxt->code, sizeof(struct pic_code) * state->cxt->clen); irep->clen = state->cxt->clen; irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen); From 66a7e653ba071d65fff5e7c290be18d2cfa1f94d Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 18:56:42 +0900 Subject: [PATCH 17/43] change analyze_args API --- src/codegen.c | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 780ba5e1..37cfce00 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -37,9 +37,10 @@ new_irep(pic_state *pic) return irep; } -static bool -analyze_args(pic_state *pic, pic_value args, struct xhash *x, bool *varg, size_t *argc, size_t *localc) +static pic_sym * +analyze_args(pic_state *pic, pic_value args, bool *varg, size_t *argc, size_t *localc) { + pic_sym *syms = pic_alloc(pic, sizeof(pic_sym)); size_t i = 1, l = 0; pic_value v; @@ -48,10 +49,12 @@ analyze_args(pic_state *pic, pic_value args, struct xhash *x, bool *varg, size_t pic_value sym; sym = pic_car(pic, v); - if (! pic_symbol_p(sym)) - return false; - if (x) - xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i); + if (! pic_symbol_p(sym)) { + pic_free(pic, syms); + return NULL; + } + syms = pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); + syms[i] = pic_sym(sym); i++; } if (pic_nil_p(v)) { @@ -59,17 +62,18 @@ analyze_args(pic_state *pic, pic_value args, struct xhash *x, bool *varg, size_t } else if (pic_symbol_p(v)) { *varg = true; - if (x) - xh_put(x, pic_symbol_name(pic, pic_sym(v)), i + l); + syms = pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); + syms[i] = pic_sym(v); l++; } else { - return false; + pic_free(pic, syms); + return NULL; } *argc = i; *localc = l; - return true; + return syms; } static bool @@ -77,8 +81,16 @@ valid_formal(pic_state *pic, pic_value formal) { bool varg; size_t argc, localc; + pic_sym *syms; - return analyze_args(pic, formal, NULL, &varg, &argc, &localc); + syms = analyze_args(pic, formal, &varg, &argc, &localc); + if (syms == NULL) { + return false; + } + else { + pic_free(pic, syms); + return true; + } } typedef struct analyze_scope { From b2c5f5cb6db5cc238a7bf873c6ee3d3e81ee19cb Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 18:57:18 +0900 Subject: [PATCH 18/43] change ast format --- src/codegen.c | 107 +++++++++++++++++++++++++++----------------------- 1 file changed, 57 insertions(+), 50 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 37cfce00..24edc109 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -98,10 +98,9 @@ typedef struct analyze_scope { /* rest args variable is counted by localc */ bool varg; size_t argc, localc; - /* local variables are 1-indexed, 0 is reserved for the callee */ - struct xhash *local_tbl; - /* if local var i is captured, then dirty_flags[i] == 1 */ - struct xhash *dirty_flags; + /* if variable v is captured, then xh_get(var_tbl, v) == 1 */ + struct xhash *var_tbl; + pic_sym *vars; struct analyze_scope *up; } analyze_scope; @@ -112,7 +111,8 @@ typedef struct analyze_state { pic_sym rCONS, rCAR, rCDR, rNILP; pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rEQ, rLT, rLE, rGT, rGE; - pic_sym sCALL, sTAILCALL, sREF; + pic_sym sCALL, sTAILCALL; + pic_sym sDECLARE, sCLOSE, sREF; pic_sym sGREF, sLREF, sCREF; } analyze_state; @@ -161,6 +161,8 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sCALL, "call"); register_symbol(pic, state, sTAILCALL, "tail-call"); + register_symbol(pic, state, sDECLARE, "declare"); + register_symbol(pic, state, sCLOSE, "close"); register_symbol(pic, state, sREF, "ref"); register_symbol(pic, state, sGREF, "gref"); register_symbol(pic, state, sLREF, "lref"); @@ -171,7 +173,7 @@ new_analyze_state(pic_state *pic) global_tbl = pic->global_tbl; for (it = xh_begin(global_tbl); ! xh_isend(&it); xh_next(global_tbl, &it)) { - xh_put(state->scope->local_tbl, it.e->key, 0); + xh_put(state->scope->var_tbl, it.e->key, 0); } return state; @@ -189,23 +191,21 @@ push_scope(analyze_state *state, pic_value args) { pic_state *pic = state->pic; analyze_scope *scope; - struct xhash *x; - struct xh_iter it; + int i; scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope->up = state->scope; scope->depth = state->scope ? state->scope->depth + 1 : 0; - scope->local_tbl = x = xh_new(); - scope->dirty_flags = xh_new(); + scope->var_tbl = xh_new(); scope->varg = false; + scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc); - if (! analyze_args(pic, args, x, &scope->varg, &scope->argc, &scope->localc)) { + if (scope->vars == NULL) { pic_error(pic, "logic flaw"); } - /* set dirty flags */ - for (it = xh_begin(x); ! xh_isend(&it); xh_next(x, &it)) { - xh_put(scope->dirty_flags, it.e->key, 0); + for (i = 1; i < scope->argc + scope->localc; ++i) { + xh_put(scope->var_tbl, pic_symbol_name(pic, scope->vars[i]), 0); } state->scope = scope; @@ -217,8 +217,8 @@ pop_scope(analyze_state *state) analyze_scope *scope; scope = state->scope; - xh_destory(scope->local_tbl); - xh_destory(scope->dirty_flags); + xh_destory(scope->var_tbl); + pic_free(state->pic, scope->vars); scope = scope->up; pic_free(state->pic, state->scope); @@ -226,18 +226,19 @@ pop_scope(analyze_state *state) } static int -lookup_var(analyze_state *state, const char *key) +lookup_var(analyze_state *state, pic_sym sym) { analyze_scope *scope = state->scope; struct xh_entry *e; int depth = 0; + const char *key = pic_symbol_name(state->pic, sym); enter: - e = xh_get(scope->local_tbl, key); - if (e && e->val >= 0) { + e = xh_get(scope->var_tbl, key); + if (e) { if (depth > 0) { /* mark dirty */ - xh_put(scope->dirty_flags, key, 1); + xh_put(scope->var_tbl, key, 1); } return depth; } @@ -250,16 +251,17 @@ lookup_var(analyze_state *state, const char *key) } static void -define_var(analyze_state *state, const char *name) +define_var(analyze_state *state, pic_sym sym) { - struct xh_entry *e; + pic_state *pic = state->pic; analyze_scope *scope = state->scope; - int c; + const char *name = pic_symbol_name(pic, sym); - c = scope->argc + scope->localc++; - e = xh_put(state->scope->local_tbl, name, c); + xh_put(state->scope->var_tbl, name, 0); - xh_put(scope->dirty_flags, name, 0); + scope->localc++; + scope->vars = pic_realloc(pic, scope->vars, sizeof(pic_sym) * scope->argc + scope->localc); + scope->vars[scope->argc + scope->localc - 1] = sym; } static pic_value @@ -295,15 +297,15 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) switch (pic_type(obj)) { case PIC_TT_SYMBOL: { - const char *name = pic_symbol_name(pic, pic_sym(obj)); + pic_sym sym = pic_sym(obj); int depth; - depth = lookup_var(state, name); + depth = lookup_var(state, sym); if (depth == -1) { pic_error(pic, "symbol: unbound variable"); } /* at this stage, lref/cref/gref are not distinguished */ - return new_ref(state, depth, pic_sym(obj)); + return new_ref(state, depth, sym); } case PIC_TT_PAIR: { pic_value proc; @@ -340,7 +342,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) pic_error(pic, "syntax error"); } - define_var(state, pic_symbol_name(pic, pic_sym(var))); + define_var(state, pic_sym(var)); return pic_list(pic, 3, pic_symbol_value(pic->sSETBANG), analyze(state, var, false), @@ -601,7 +603,7 @@ analyze_lambda(analyze_state *state, pic_value obj) { pic_state *pic = state->pic; int ai = pic_gc_arena_preserve(pic); - pic_value args, body, defs; + pic_value args, body, decls; if (pic_length(pic, obj) < 2) { pic_error(pic, "syntax error"); @@ -615,35 +617,36 @@ analyze_lambda(analyze_state *state, pic_value obj) push_scope(state, args); { - struct xhash *dirty_flags; - struct xh_iter it; + analyze_scope *scope = state->scope; + int i; /* analyze body in inner environment */ body = pic_cdr(pic, pic_cdr(pic, obj)); body = pic_cons(pic, pic_symbol_value(pic->sBEGIN), body); body = analyze(state, body, true); - dirty_flags = state->scope->dirty_flags; - /* declare local variables */ - defs = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); - for (it = xh_begin(dirty_flags); ! xh_isend(&it); xh_next(dirty_flags, &it)) { - pic_value close, def; - if (it.e->val == 1) { - close = pic_true_value(); - } else { - close = pic_false_value(); - } - def = pic_list(pic, 3, pic_symbol_value(pic->sDEFINE), - pic_symbol_value(pic_intern_cstr(pic, it.e->key)), - close); - defs = pic_cons(pic, def, defs); + decls = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); + for (i = scope->varg ? 1 : 0; i < scope->localc; ++i) { + pic_value decl = pic_list(pic, 2, + pic_symbol_value(state->sDECLARE), + pic_symbol_value(scope->vars[scope->argc + i])); + decls = pic_cons(pic, decl, decls); } - defs = pic_reverse(pic, defs); + for (i = 1; i < scope->argc + scope->localc; ++i) { + pic_sym var = scope->vars[i]; + if (xh_get(scope->var_tbl, pic_symbol_name(pic, var))) { + pic_value close = pic_list(pic, 2, + pic_symbol_value(state->sCLOSE), + pic_symbol_value(var)); + decls = pic_cons(pic, close, decls); + } + } + decls = pic_reverse(pic, decls); } pop_scope(state); - obj = pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, defs, body); + obj = pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, decls, body); pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, obj); return obj; @@ -737,12 +740,16 @@ push_codegen_context(codegen_state *state, pic_value args, pic_value defs) { pic_state *pic = state->pic; codegen_context *cxt; + pic_sym *syms; cxt = (codegen_context *)pic_alloc(pic, sizeof(codegen_context)); cxt->up = state->cxt; - if (! analyze_args(pic, args, NULL, &cxt->varg, &cxt->argc, &cxt->localc)) { + syms = analyze_args(pic, args, &cxt->varg, &cxt->argc, &cxt->localc); + if (! syms) { pic_error(pic, "logic flaw"); + } else { + pic_free(pic, syms); } cxt->localc += pic_length(pic, defs); From 03e21218a54e004c6b4fa91c19e078ba6609422e Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 19:21:17 +0900 Subject: [PATCH 19/43] remove depth property --- src/codegen.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 24edc109..23fecf5a 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -94,7 +94,6 @@ valid_formal(pic_state *pic, pic_value formal) } typedef struct analyze_scope { - int depth; /* rest args variable is counted by localc */ bool varg; size_t argc, localc; @@ -195,7 +194,6 @@ push_scope(analyze_state *state, pic_value args) scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope)); scope->up = state->scope; - scope->depth = state->scope ? state->scope->depth + 1 : 0; scope->var_tbl = xh_new(); scope->varg = false; scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc); From 56e90f564c6788a8a73d14a2d74ac6243676337f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 23 Jan 2014 19:21:37 +0900 Subject: [PATCH 20/43] quote everything --- src/codegen.c | 99 ++++++++++++++++++++++----------------------------- 1 file changed, 43 insertions(+), 56 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 23fecf5a..a3eace6a 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -409,7 +409,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) if (pic_length(pic, obj) != 2) { pic_error(pic, "syntax error"); } - return obj; /* TODO: quote only if necessary */ + return obj; } #define ARGC_ASSERT(n) do { \ @@ -547,9 +547,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) case PIC_TT_FLOAT: case PIC_TT_INT: case PIC_TT_NIL: - case PIC_TT_CHAR: { - return obj; - } + case PIC_TT_CHAR: case PIC_TT_STRING: case PIC_TT_VECTOR: case PIC_TT_BLOB: { @@ -821,51 +819,9 @@ codegen(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; codegen_context *cxt = state->cxt; - pic_value tag; pic_sym sym; - switch (pic_type(obj)) { - case PIC_TT_BOOL: - if (pic_true_p(obj)) { - cxt->code[cxt->clen].insn = OP_PUSHTRUE; - } else { - cxt->code[cxt->clen].insn = OP_PUSHFALSE; - } - cxt->clen++; - return; - case PIC_TT_FLOAT: - cxt->code[cxt->clen].insn = OP_PUSHFLOAT; - cxt->code[cxt->clen].u.f = pic_float(obj); - cxt->clen++; - return; - case PIC_TT_INT: - cxt->code[cxt->clen].insn = OP_PUSHINT; - cxt->code[cxt->clen].u.i = pic_int(obj); - cxt->clen++; - return; - case PIC_TT_NIL: - cxt->code[cxt->clen].insn = OP_PUSHNIL; - cxt->clen++; - return; - case PIC_TT_CHAR: - cxt->code[cxt->clen].insn = OP_PUSHCHAR; - cxt->code[cxt->clen].u.c = pic_char(obj); - cxt->clen++; - return; - default: - break; - } - - if (! pic_list_p(pic, obj)) { - pic_error(pic, "codegen: invalid AST given"); - } - - tag = pic_car(pic, obj); - if (! pic_symbol_p(tag)) { - pic_error(pic, "codegen: broken AST"); - } - - sym = pic_sym(tag); + sym = pic_sym(pic_car(pic, obj)); if (sym == state->sGREF) { cxt->code[cxt->clen].insn = OP_GREF; cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, obj, 1)); @@ -961,16 +917,47 @@ codegen(codegen_state *state, pic_value obj) else if (sym == pic->sQUOTE) { int pidx; - if (cxt->plen >= cxt->pcapa) { - cxt->pcapa *= 2; - cxt->pool = (pic_value *)pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa); + obj = pic_list_ref(pic, obj, 1); + switch (pic_type(obj)) { + case PIC_TT_BOOL: + if (pic_true_p(obj)) { + cxt->code[cxt->clen].insn = OP_PUSHTRUE; + } else { + cxt->code[cxt->clen].insn = OP_PUSHFALSE; + } + cxt->clen++; + return; + case PIC_TT_FLOAT: + cxt->code[cxt->clen].insn = OP_PUSHFLOAT; + cxt->code[cxt->clen].u.f = pic_float(obj); + cxt->clen++; + return; + case PIC_TT_INT: + cxt->code[cxt->clen].insn = OP_PUSHINT; + cxt->code[cxt->clen].u.i = pic_int(obj); + cxt->clen++; + return; + case PIC_TT_NIL: + cxt->code[cxt->clen].insn = OP_PUSHNIL; + cxt->clen++; + return; + case PIC_TT_CHAR: + cxt->code[cxt->clen].insn = OP_PUSHCHAR; + cxt->code[cxt->clen].u.c = pic_char(obj); + cxt->clen++; + return; + default: + if (cxt->plen >= cxt->pcapa) { + cxt->pcapa *= 2; + cxt->pool = (pic_value *)pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa); + } + pidx = cxt->plen++; + cxt->pool[pidx] = obj; + cxt->code[cxt->clen].insn = OP_PUSHCONST; + cxt->code[cxt->clen].u.i = pidx; + cxt->clen++; + return; } - pidx = cxt->plen++; - cxt->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); - cxt->code[cxt->clen].insn = OP_PUSHCONST; - cxt->code[cxt->clen].u.i = pidx; - cxt->clen++; - return; } else if (sym == pic->sCONS) { codegen(state, pic_list_ref(pic, obj, 1)); From cfdf1ceaf812e3bf6efa9d2d15fcf7faec9f1be3 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:08:35 +0900 Subject: [PATCH 21/43] cleaning up --- src/codegen.c | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index a3eace6a..4c9c78b6 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -796,22 +796,6 @@ pop_codegen_context(codegen_state *state) return irep; } -static int -scope_global_define(pic_state *pic, const char *name) -{ - struct xh_entry *e; - - if ((e = xh_get(pic->global_tbl, name))) { - pic_warn(pic, "redefining global"); - return e->val; - } - e = xh_put(pic->global_tbl, name, pic->glen++); - if (pic->glen >= pic->gcapa) { - pic_error(pic, "global table overflow"); - } - return e->val; -} - static struct pic_irep *codegen_lambda(codegen_state *, pic_value); static void @@ -1140,6 +1124,22 @@ pic_compile(pic_state *pic, pic_value obj) return proc; } +static int +scope_global_define(pic_state *pic, const char *name) +{ + struct xh_entry *e; + + if ((e = xh_get(pic->global_tbl, name))) { + pic_warn(pic, "redefining global"); + return e->val; + } + e = xh_put(pic->global_tbl, name, pic->glen++); + if (pic->glen >= pic->gcapa) { + pic_error(pic, "global table overflow"); + } + return e->val; +} + void pic_define(pic_state *pic, const char *name, pic_value val) { From a35606dc166d0b9aa61eb927c1e3d8ecde3fb5f4 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:09:06 +0900 Subject: [PATCH 22/43] gref/cref/lref are not used by analyzer --- src/codegen.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 4c9c78b6..84d2864e 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -112,7 +112,6 @@ typedef struct analyze_state { pic_sym rEQ, rLT, rLE, rGT, rGE; pic_sym sCALL, sTAILCALL; pic_sym sDECLARE, sCLOSE, sREF; - pic_sym sGREF, sLREF, sCREF; } analyze_state; static void push_scope(analyze_state *, pic_value); @@ -163,9 +162,6 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sDECLARE, "declare"); register_symbol(pic, state, sCLOSE, "close"); register_symbol(pic, state, sREF, "ref"); - register_symbol(pic, state, sGREF, "gref"); - register_symbol(pic, state, sLREF, "lref"); - register_symbol(pic, state, sCREF, "cref"); /* push initial scope */ push_scope(state, pic_nil_value()); From f3e232167908317405f8e1f50f31de288a5c9ba1 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:09:51 +0900 Subject: [PATCH 23/43] add missing returns --- src/codegen.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 84d2864e..798ec573 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -813,7 +813,7 @@ codegen(codegen_state *state, pic_value obj) cxt->code[cxt->clen].u.r.idx = pic_int(pic_list_ref(pic, obj, 2)); cxt->clen++; return; - } else if (sym == state-> sLREF) { + } else if (sym == state->sLREF) { cxt->code[cxt->clen].insn = OP_LREF; cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, obj, 1)); cxt->clen++; @@ -1003,30 +1003,35 @@ codegen(codegen_state *state, pic_value obj) codegen(state, pic_list_ref(pic, obj, 2)); cxt->code[cxt->clen].insn = OP_EQ; cxt->clen++; + return; } else if (sym == pic->sLT) { codegen(state, pic_list_ref(pic, obj, 1)); codegen(state, pic_list_ref(pic, obj, 2)); cxt->code[cxt->clen].insn = OP_LT; cxt->clen++; + return; } else if (sym == pic->sLE) { codegen(state, pic_list_ref(pic, obj, 1)); codegen(state, pic_list_ref(pic, obj, 2)); cxt->code[cxt->clen].insn = OP_LE; cxt->clen++; + return; } else if (sym == pic->sGT) { codegen(state, pic_list_ref(pic, obj, 2)); codegen(state, pic_list_ref(pic, obj, 1)); cxt->code[cxt->clen].insn = OP_LT; cxt->clen++; + return; } else if (sym == pic->sGE) { codegen(state, pic_list_ref(pic, obj, 2)); codegen(state, pic_list_ref(pic, obj, 1)); cxt->code[cxt->clen].insn = OP_LE; cxt->clen++; + return; } else if (sym == state->sCALL || sym == state->sTAILCALL) { int len = pic_length(pic, obj); @@ -1036,6 +1041,7 @@ codegen(codegen_state *state, pic_value obj) cxt->code[cxt->clen].insn = (sym == state->sCALL) ? OP_CALL : OP_TAILCALL; cxt->code[cxt->clen].u.i = len; cxt->clen++; + return; } pic_error(pic, "codegen: unknown AST type"); } @@ -1061,8 +1067,6 @@ codegen_lambda(codegen_state *state, pic_value obj) return pop_codegen_context(state); } -pic_value pic_analyze(pic_state *, pic_value); - struct pic_irep * pic_codegen(pic_state *pic, pic_value obj) { From 2126f5b453def7f184e336b84e32ffbd64715480 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:10:19 +0900 Subject: [PATCH 24/43] rename local variables --- src/codegen.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 798ec573..af069c02 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1050,14 +1050,14 @@ static struct pic_irep * codegen_lambda(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; - pic_value args, defs, body; + pic_value args, decls, body; args = pic_list_ref(pic, obj, 1); - defs = pic_cdr(pic, pic_list_ref(pic, obj, 2)); + decls = pic_cdr(pic, pic_list_ref(pic, obj, 2)); body = pic_list_ref(pic, obj, 3); /* inner environment */ - push_codegen_context(state, args, defs); + push_codegen_context(state, args, decls); { /* body */ codegen(state, body); From 237e8c26a63e1d30575a7121cce2a6b0ff86f069 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:10:51 +0900 Subject: [PATCH 25/43] wrong length for call operation --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index af069c02..bba802eb 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1039,7 +1039,7 @@ codegen(codegen_state *state, pic_value obj) codegen(state, pic_car(pic, obj)); } cxt->code[cxt->clen].insn = (sym == state->sCALL) ? OP_CALL : OP_TAILCALL; - cxt->code[cxt->clen].u.i = len; + cxt->code[cxt->clen].u.i = len - 1; cxt->clen++; return; } From 6b20e004e53d12e1c1fd0e419ce9bb1ed688a858 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:11:15 +0900 Subject: [PATCH 26/43] [bugfix] var must be a symbol --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index bba802eb..b92dd138 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -826,7 +826,7 @@ codegen(codegen_state *state, pic_value obj) codegen(state, val); var = pic_list_ref(pic, obj, 1); - type = pic_sym(var); + type = pic_sym(pic_list_ref(pic, var, 0)); if (type == state->sGREF) { cxt->code[cxt->clen].insn = OP_GSET; cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, var, 1)); From 9dd04fd3b308462de4f1d896b301806188736a72 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:11:37 +0900 Subject: [PATCH 27/43] impl resolver --- src/codegen.c | 243 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 243 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index b92dd138..242a9e5a 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -657,6 +657,241 @@ pic_analyze(pic_state *pic, pic_value obj) return obj; } +typedef struct resolver_scope { + int depth; + bool varg; + size_t argc, localc; + struct xhash *cvs, *lvs; + unsigned cv_num; + + struct resolver_scope *up; +} resolver_scope; + +typedef struct resolver_state { + pic_state *pic; + resolver_scope *scope; + pic_sym sREF, sCLOSE; + pic_sym sGREF, sCREF, sLREF; +} resolver_state; + +static void push_resolver_scope(resolver_state *, pic_value, pic_value); +static void pop_resolver_scope(resolver_state *); + +static resolver_state * +new_resolver_state(pic_state *pic) +{ + resolver_state *state; + + state = (resolver_state *)pic_alloc(pic, sizeof(resolver_state)); + state->pic = pic; + state->scope = NULL; + + register_symbol(pic, state, sREF, "ref"); + register_symbol(pic, state, sCLOSE, "close"); + register_symbol(pic, state, sGREF, "gref"); + register_symbol(pic, state, sLREF, "lref"); + register_symbol(pic, state, sCREF, "cref"); + + push_resolver_scope(state, pic_nil_value(), pic_nil_value()); + + return state; +} + +static void +destroy_resolver_state(resolver_state *state) +{ + /* TODO */ +} + +static void +push_resolver_scope(resolver_state *state, pic_value args, pic_value decls) +{ + pic_state *pic = state->pic; + resolver_scope *scope; + pic_sym *vars; + int i; + + scope = (resolver_scope *)pic_alloc(pic, sizeof(resolver_scope)); + scope->up = state->scope; + scope->depth = scope->up ? scope->up->depth + 1 : 0; + scope->lvs = xh_new(); + scope->cvs = xh_new(); + + vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc); + for (; ! pic_nil_p(decls); decls = pic_cdr(pic, decls)) { + pic_value decl = pic_car(pic, decls); + if (pic_sym(pic_car(pic, decl)) == state->sCLOSE) { + break; + } + scope->localc++; + vars = (pic_sym *)pic_realloc(pic, vars, sizeof(pic_sym) * (scope->argc + scope->localc)); + vars[scope->argc + scope->localc - 1] = pic_sym(pic_list_ref(pic, decl, 1)); + } + + /* local variables */ + for (i = 1; i < scope->argc + scope->localc; ++i) { + xh_put(scope->lvs, pic_symbol_name(pic, vars[i]), i); + } + + /* closed variables */ + scope->cv_num = 0; + for (; ! pic_nil_p(decls); decls = pic_cdr(pic, decls)) { + pic_value decl = pic_car(pic, decls); + xh_put(scope->cvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, decl, 1))), scope->cv_num++); + } + + pic_free(pic, vars); + + state->scope = scope; +} + +static void +pop_resolver_scope(resolver_state *state) +{ + /* FIXME */ + state->scope = state->scope->up; +} + +static bool +is_closed(resolver_state *state, int depth, pic_sym sym) +{ + resolver_scope *scope = state->scope; + + while (depth-- > 0) { + scope = scope->up; + } + + return xh_get(scope->cvs, pic_symbol_name(state->pic, sym)) != NULL; +} + +static pic_value +resolve_gref(resolver_state *state, pic_sym sym) +{ + pic_state *pic = state->pic; + const char *name = pic_symbol_name(pic, sym); + struct xh_entry *e; + int i; + + if ((e = xh_get(pic->global_tbl, name))) { + i = e->val; + } + else { + i = pic->glen++; + if (i >= pic->gcapa) { + pic_error(pic, "global table overflow"); + } + xh_put(pic->global_tbl, name, i); + } + return pic_list(pic, 2, pic_symbol_value(state->sGREF), pic_int_value(i)); +} + +static pic_value +resolve_lref(resolver_state *state, pic_sym sym) +{ + pic_state *pic = state->pic; + int i; + + i = xh_get(state->scope->lvs, pic_symbol_name(pic, sym))->val; + + return pic_list(pic, 2, pic_symbol_value(state->sLREF), pic_int_value(i)); +} + +static pic_value +resolve_cref(resolver_state *state, int depth, pic_sym sym) +{ + pic_state *pic = state->pic; + resolver_scope *scope = state->scope; + int i, d; + + d = depth; + while (d-- > 0) { + scope = scope->up; + } + + i = xh_get(scope->cvs, pic_symbol_name(pic, sym))->val; + + return pic_list(pic, 3, + pic_symbol_value(state->sCREF), + pic_int_value(depth), + pic_int_value(i)); +} + +static pic_value +resolve_reference(resolver_state *state, pic_value obj) +{ + pic_state *pic = state->pic; + resolver_scope *scope = state->scope; + pic_sym tag; + + if (! pic_pair_p(obj)) + return obj; + + tag = pic_sym(pic_car(pic, obj)); + if (tag == state->sREF) { + int depth; + pic_sym sym; + + depth = pic_int(pic_list_ref(pic, obj, 1)); + sym = pic_sym(pic_list_ref(pic, obj, 2)); + if (depth == scope->depth) { + return resolve_gref(state, sym); + } + else if (depth == 0 && is_closed(state, depth, sym)) { + return resolve_lref(state, sym); + } + else { + return resolve_cref(state, depth, sym); + } + } + else if (tag == pic->sLAMBDA) { + pic_value args, decls, body; + + args = pic_list_ref(pic, obj, 1); + decls = pic_cdr(pic, pic_list_ref(pic, obj, 2)); + body = pic_list_ref(pic, obj, 3); + + push_resolver_scope(state, args, decls); + { + int localc; + + body = resolve_reference(state, body); + + /* slice decls. dropping out close declarations */ + localc = scope->localc - (scope->varg ? 1 : 0); + decls = pic_reverse(pic, decls); + decls = pic_list_tail(pic, decls, pic_length(pic, decls) - localc); + decls = pic_reverse(pic, decls); + decls = pic_cons(pic, pic_symbol_value(pic->sBEGIN), decls); + } + pop_resolver_scope(state); + + return pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, decls, body); + } + else if (tag == pic->sQUOTE) { + return obj; + } + else { + pic_value seq = pic_list(pic, 1, pic_symbol_value(tag)); + for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { + seq = pic_cons(pic, resolve_reference(state, pic_car(pic, obj)), seq); + } + return pic_reverse(pic, seq); + } +} + +static pic_value +pic_resolve(pic_state *pic, pic_value obj) +{ + resolver_state *state; + + state = new_resolver_state(pic); + + obj = resolve_reference(state, obj); + + destroy_resolver_state(state); + return obj; +} + /** * scope object */ @@ -801,6 +1036,10 @@ codegen(codegen_state *state, pic_value obj) codegen_context *cxt = state->cxt; pic_sym sym; + printf("generating... "); + pic_debug(pic, obj); + puts(""); + sym = pic_sym(pic_car(pic, obj)); if (sym == state->sGREF) { cxt->code[cxt->clen].insn = OP_GREF; @@ -1106,6 +1345,10 @@ pic_compile(pic_state *pic, pic_value obj) obj = pic_analyze(pic, obj); pic_debug(pic, obj); + /* resolution */ + obj = pic_resolve(pic, obj); + pic_debug(pic, obj); + /* codegen */ irep = pic_codegen(pic, obj); From 09840601c468d8e21325af0175ca36f1b274e156 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 24 Jan 2014 17:11:52 +0900 Subject: [PATCH 28/43] fflush buffer in pic_debug --- src/write.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/write.c b/src/write.c index 17957185..026cb391 100644 --- a/src/write.c +++ b/src/write.c @@ -156,6 +156,7 @@ void pic_debug(pic_state *pic, pic_value obj) { write(pic, obj); + fflush(stdout); } static pic_value From 15ca95eb8fb11a623b0b913ea6985cbf76f7f217 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:14:41 +0900 Subject: [PATCH 29/43] improve debug prints --- src/codegen.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index 242a9e5a..82e2668c 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1338,19 +1338,35 @@ pic_compile(pic_state *pic, pic_value obj) goto exit; } + fprintf(stderr, "## input expression\n"); + pic_debug(pic, obj); + fprintf(stderr, "\n"); + /* macroexpand */ + fprintf(stderr, "## macroexpand started\n"); obj = pic_macroexpand(pic, obj); + pic_debug(pic, obj); + fprintf(stderr, "\n"); /* analyze */ + fprintf(stderr, "## analyzer started\n"); obj = pic_analyze(pic, obj); pic_debug(pic, obj); + fprintf(stderr, "\n"); /* resolution */ + fprintf(stderr, "## resolver started\n"); obj = pic_resolve(pic, obj); pic_debug(pic, obj); + fprintf(stderr, "\n"); /* codegen */ + fprintf(stderr, "## codegen started\n"); irep = pic_codegen(pic, obj); + pic_dump_irep(pic, irep); + + fprintf(stderr, "## compilation finished\n"); + puts(""); proc = pic_proc_new_irep(pic, irep, NULL); From 26544ff6fd96c0e27aaf5f5af8fd0fc46ed9673f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:14:59 +0900 Subject: [PATCH 30/43] dump ireps recursively --- src/codegen.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index 82e2668c..ec8c6176 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1572,4 +1572,8 @@ pic_dump_irep(pic_state *pic, struct pic_irep *irep) for (i = 0; i < irep->clen; ++i) { print_code(pic, irep->code[i]); } + + for (i = 0; i < irep->ilen; ++i) { + pic_dump_irep(pic, irep->irep[i]); + } } From 244ec069534ab72059e746e7bbd9bdd635c9d962 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:17:04 +0900 Subject: [PATCH 31/43] add implicit casts from void * --- src/codegen.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index ec8c6176..b3af1251 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -40,7 +40,7 @@ new_irep(pic_state *pic) static pic_sym * analyze_args(pic_state *pic, pic_value args, bool *varg, size_t *argc, size_t *localc) { - pic_sym *syms = pic_alloc(pic, sizeof(pic_sym)); + pic_sym *syms = (pic_sym *)pic_alloc(pic, sizeof(pic_sym)); size_t i = 1, l = 0; pic_value v; @@ -53,7 +53,7 @@ analyze_args(pic_state *pic, pic_value args, bool *varg, size_t *argc, size_t *l pic_free(pic, syms); return NULL; } - syms = pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); + syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); syms[i] = pic_sym(sym); i++; } @@ -62,7 +62,7 @@ analyze_args(pic_state *pic, pic_value args, bool *varg, size_t *argc, size_t *l } else if (pic_symbol_p(v)) { *varg = true; - syms = pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); + syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1)); syms[i] = pic_sym(v); l++; } @@ -254,7 +254,7 @@ define_var(analyze_state *state, pic_sym sym) xh_put(state->scope->var_tbl, name, 0); scope->localc++; - scope->vars = pic_realloc(pic, scope->vars, sizeof(pic_sym) * scope->argc + scope->localc); + scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc)); scope->vars[scope->argc + scope->localc - 1] = sym; } From 52927ac45215474efafa12b52ca05d8318244936 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:17:24 +0900 Subject: [PATCH 32/43] gc resolver --- src/codegen.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index b3af1251..63951f18 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -816,8 +816,22 @@ resolve_cref(resolver_state *state, int depth, pic_sym sym) pic_int_value(i)); } +static pic_value resolve_reference_node(resolver_state *state, pic_value obj); + static pic_value resolve_reference(resolver_state *state, pic_value obj) +{ + int ai = pic_gc_arena_preserve(state->pic); + + obj = resolve_reference_node(state, obj); + + pic_gc_arena_restore(state->pic, ai); + pic_gc_protect(state->pic, obj); + return obj; +} + +static pic_value +resolve_reference_node(resolver_state *state, pic_value obj) { pic_state *pic = state->pic; resolver_scope *scope = state->scope; From a2d9d2f93a6de8d30e032931435461916f0118b0 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:18:03 +0900 Subject: [PATCH 33/43] resolve TODOs --- src/codegen.c | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 63951f18..52cd6b4a 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -700,7 +700,8 @@ new_resolver_state(pic_state *pic) static void destroy_resolver_state(resolver_state *state) { - /* TODO */ + pop_resolver_scope(state); + pic_free(state->pic, state); } static void @@ -748,8 +749,15 @@ push_resolver_scope(resolver_state *state, pic_value args, pic_value decls) static void pop_resolver_scope(resolver_state *state) { - /* FIXME */ - state->scope = state->scope->up; + resolver_scope *scope; + + scope = state->scope; + xh_destory(scope->cvs); + xh_destory(scope->lvs); + + scope = scope->up; + pic_free(state->pic, state->scope); + state->scope = scope; } static bool @@ -1050,10 +1058,6 @@ codegen(codegen_state *state, pic_value obj) codegen_context *cxt = state->cxt; pic_sym sym; - printf("generating... "); - pic_debug(pic, obj); - puts(""); - sym = pic_sym(pic_car(pic, obj)); if (sym == state->sGREF) { cxt->code[cxt->clen].insn = OP_GREF; From c3fd4addc3ec26d45ec44b48817734c32984576a Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:20:00 +0900 Subject: [PATCH 34/43] change AST format --- src/codegen.c | 135 ++++++++++++++++++++++++++------------------------ 1 file changed, 71 insertions(+), 64 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 52cd6b4a..1001c3be 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -595,7 +595,7 @@ analyze_lambda(analyze_state *state, pic_value obj) { pic_state *pic = state->pic; int ai = pic_gc_arena_preserve(pic); - pic_value args, body, decls; + pic_value args, body, locals, varg, closes; if (pic_length(pic, obj) < 2) { pic_error(pic, "syntax error"); @@ -617,28 +617,32 @@ analyze_lambda(analyze_state *state, pic_value obj) body = pic_cons(pic, pic_symbol_value(pic->sBEGIN), body); body = analyze(state, body, true); - /* declare local variables */ - decls = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); - for (i = scope->varg ? 1 : 0; i < scope->localc; ++i) { - pic_value decl = pic_list(pic, 2, - pic_symbol_value(state->sDECLARE), - pic_symbol_value(scope->vars[scope->argc + i])); - decls = pic_cons(pic, decl, decls); + args = pic_nil_value(); + for (i = 1; i < scope->argc; ++i) { + args = pic_cons(pic, pic_symbol_value(scope->vars[i]), args); } + args = pic_reverse(pic, args); + + locals = pic_nil_value(); + for (i = 0; i < scope->localc; ++i) { + locals = pic_cons(pic, pic_symbol_value(scope->vars[scope->argc + i]), locals); + } + locals = pic_reverse(pic, locals); + + varg = scope->varg ? pic_true_value() : pic_false_value(); + + closes = pic_nil_value(); for (i = 1; i < scope->argc + scope->localc; ++i) { pic_sym var = scope->vars[i]; if (xh_get(scope->var_tbl, pic_symbol_name(pic, var))) { - pic_value close = pic_list(pic, 2, - pic_symbol_value(state->sCLOSE), - pic_symbol_value(var)); - decls = pic_cons(pic, close, decls); + closes = pic_cons(pic, pic_symbol_value(var), closes); } } - decls = pic_reverse(pic, decls); + closes = pic_reverse(pic, closes); } pop_scope(state); - obj = pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, decls, body); + obj = pic_list(pic, 6, pic_symbol_value(pic->sLAMBDA), args, locals, varg, closes, body); pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, obj); return obj; @@ -674,7 +678,7 @@ typedef struct resolver_state { pic_sym sGREF, sCREF, sLREF; } resolver_state; -static void push_resolver_scope(resolver_state *, pic_value, pic_value); +static void push_resolver_scope(resolver_state *, pic_value, pic_value, bool, pic_value); static void pop_resolver_scope(resolver_state *); static resolver_state * @@ -692,7 +696,7 @@ new_resolver_state(pic_state *pic) register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); - push_resolver_scope(state, pic_nil_value(), pic_nil_value()); + push_resolver_scope(state, pic_nil_value(), pic_nil_value(), false, pic_nil_value()); return state; } @@ -705,44 +709,37 @@ destroy_resolver_state(resolver_state *state) } static void -push_resolver_scope(resolver_state *state, pic_value args, pic_value decls) +push_resolver_scope(resolver_state *state, pic_value args, pic_value locals, bool varg, pic_value closes) { pic_state *pic = state->pic; resolver_scope *scope; - pic_sym *vars; - int i; + int i, c; scope = (resolver_scope *)pic_alloc(pic, sizeof(resolver_scope)); scope->up = state->scope; scope->depth = scope->up ? scope->up->depth + 1 : 0; scope->lvs = xh_new(); scope->cvs = xh_new(); + scope->argc = pic_length(pic, args) + 1; + scope->localc = pic_length(pic, locals); + scope->varg = varg; - vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc); - for (; ! pic_nil_p(decls); decls = pic_cdr(pic, decls)) { - pic_value decl = pic_car(pic, decls); - if (pic_sym(pic_car(pic, decl)) == state->sCLOSE) { - break; - } - scope->localc++; - vars = (pic_sym *)pic_realloc(pic, vars, sizeof(pic_sym) * (scope->argc + scope->localc)); - vars[scope->argc + scope->localc - 1] = pic_sym(pic_list_ref(pic, decl, 1)); + /* arguments */ + for (i = 1; i < scope->argc; ++i) { + xh_put(scope->lvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, args, i - 1))), i); } - /* local variables */ - for (i = 1; i < scope->argc + scope->localc; ++i) { - xh_put(scope->lvs, pic_symbol_name(pic, vars[i]), i); + /* locals */ + for (i = 0; i < scope->localc; ++i) { + xh_put(scope->lvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, locals, i))), scope->argc + i); } /* closed variables */ scope->cv_num = 0; - for (; ! pic_nil_p(decls); decls = pic_cdr(pic, decls)) { - pic_value decl = pic_car(pic, decls); - xh_put(scope->cvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, decl, 1))), scope->cv_num++); + for (i = 0, c = pic_length(pic, closes); i < c; ++i) { + xh_put(scope->cvs, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, closes, i))), scope->cv_num++); } - pic_free(pic, vars); - state->scope = scope; } @@ -866,28 +863,22 @@ resolve_reference_node(resolver_state *state, pic_value obj) } } else if (tag == pic->sLAMBDA) { - pic_value args, decls, body; + pic_value args, locals, closes, body; + bool varg; args = pic_list_ref(pic, obj, 1); - decls = pic_cdr(pic, pic_list_ref(pic, obj, 2)); - body = pic_list_ref(pic, obj, 3); + locals = pic_list_ref(pic, obj, 2); + varg = pic_true_p(pic_list_ref(pic, obj, 3)); + closes = pic_list_ref(pic, obj, 4); + body = pic_list_ref(pic, obj, 5); - push_resolver_scope(state, args, decls); + push_resolver_scope(state, args, locals, varg, closes); { - int localc; - body = resolve_reference(state, body); - - /* slice decls. dropping out close declarations */ - localc = scope->localc - (scope->varg ? 1 : 0); - decls = pic_reverse(pic, decls); - decls = pic_list_tail(pic, decls, pic_length(pic, decls) - localc); - decls = pic_reverse(pic, decls); - decls = pic_cons(pic, pic_symbol_value(pic->sBEGIN), decls); } pop_resolver_scope(state); - return pic_list(pic, 4, pic_symbol_value(pic->sLAMBDA), args, decls, body); + return pic_list(pic, 6, pic_symbol_value(pic->sLAMBDA), args, locals, pic_bool_value(varg), closes, body); } else if (tag == pic->sQUOTE) { return obj; @@ -949,7 +940,7 @@ typedef struct codegen_state { unsigned *cv_tbl, cv_num; } codegen_state; -static void push_codegen_context(codegen_state *, pic_value, pic_value); +static void push_codegen_context(codegen_state *, pic_value, pic_value, bool, pic_value); static struct pic_irep *pop_codegen_context(codegen_state *); static codegen_state * @@ -967,7 +958,7 @@ new_codegen_state(pic_state *pic) register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); - push_codegen_context(state, pic_nil_value(), pic_nil_value()); + push_codegen_context(state, pic_nil_value(), pic_nil_value(), false, pic_nil_value()); return state; } @@ -985,25 +976,38 @@ destroy_codegen_state(codegen_state *state) } static void -push_codegen_context(codegen_state *state, pic_value args, pic_value defs) +push_codegen_context(codegen_state *state, pic_value args, pic_value locals, bool varg, pic_value closes) { pic_state *pic = state->pic; codegen_context *cxt; - pic_sym *syms; + int i, c; + struct xhash *vars; cxt = (codegen_context *)pic_alloc(pic, sizeof(codegen_context)); cxt->up = state->cxt; + cxt->argc = pic_length(pic, args) + 1; + cxt->localc = pic_length(pic, locals); + cxt->varg = varg; - syms = analyze_args(pic, args, &cxt->varg, &cxt->argc, &cxt->localc); - if (! syms) { - pic_error(pic, "logic flaw"); - } else { - pic_free(pic, syms); + /* number local variables */ + vars = xh_new(); + for (i = 1; i < cxt->argc; ++i) { + xh_put(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, args, i - 1))), i); + } + for (i = 0; i < cxt->localc; ++i) { + xh_put(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, locals, i))), cxt->argc + i); } - cxt->localc += pic_length(pic, defs); + /* closed variables */ cxt->cv_tbl = NULL; cxt->cv_num = 0; + for (i = 0, c = pic_length(pic, closes); i < c; ++i) { + i = cxt->cv_num++; + cxt->cv_tbl = (unsigned *)pic_realloc(pic, cxt->cv_tbl, sizeof(unsigned) * cxt->cv_num); + cxt->cv_tbl[i] = xh_get(vars, pic_symbol_name(pic, pic_sym(pic_list_ref(pic, closes, i))))->val; + } + + xh_destory(vars); cxt->code = (struct pic_code *)pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(struct pic_code)); cxt->clen = 0; @@ -1307,14 +1311,17 @@ static struct pic_irep * codegen_lambda(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; - pic_value args, decls, body; + pic_value args, locals, closes, body; + bool varg; args = pic_list_ref(pic, obj, 1); - decls = pic_cdr(pic, pic_list_ref(pic, obj, 2)); - body = pic_list_ref(pic, obj, 3); + locals = pic_list_ref(pic, obj, 2); + varg = pic_true_p(pic_list_ref(pic, obj, 3)); + closes = pic_list_ref(pic, obj, 4); + body = pic_list_ref(pic, obj, 5); /* inner environment */ - push_codegen_context(state, args, decls); + push_codegen_context(state, args, locals, varg, closes); { /* body */ codegen(state, body); From 3418aebe3f7527bef5dd57b848a539ed234eddda Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:20:12 +0900 Subject: [PATCH 35/43] remove unused properties --- src/codegen.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index 1001c3be..d4af043d 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -110,8 +110,7 @@ typedef struct analyze_state { pic_sym rCONS, rCAR, rCDR, rNILP; pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rEQ, rLT, rLE, rGT, rGE; - pic_sym sCALL, sTAILCALL; - pic_sym sDECLARE, sCLOSE, sREF; + pic_sym sCALL, sTAILCALL, sREF; } analyze_state; static void push_scope(analyze_state *, pic_value); @@ -159,8 +158,6 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sCALL, "call"); register_symbol(pic, state, sTAILCALL, "tail-call"); - register_symbol(pic, state, sDECLARE, "declare"); - register_symbol(pic, state, sCLOSE, "close"); register_symbol(pic, state, sREF, "ref"); /* push initial scope */ @@ -674,7 +671,7 @@ typedef struct resolver_scope { typedef struct resolver_state { pic_state *pic; resolver_scope *scope; - pic_sym sREF, sCLOSE; + pic_sym sREF; pic_sym sGREF, sCREF, sLREF; } resolver_state; @@ -691,7 +688,6 @@ new_resolver_state(pic_state *pic) state->scope = NULL; register_symbol(pic, state, sREF, "ref"); - register_symbol(pic, state, sCLOSE, "close"); register_symbol(pic, state, sGREF, "gref"); register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); From 30fcd6468fa05563af0835846c99e2aa00cba54b Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 21:24:10 +0900 Subject: [PATCH 36/43] reverse condition for tail position marking --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index d4af043d..212465fc 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -571,7 +571,7 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos) pic_value seq; pic_sym call; - if (tailpos) { + if (! tailpos) { call = state->sCALL; } else { call = state->sTAILCALL; From 2f8b016d86e65b4c452eb818c4b490c19e5272e0 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:18:49 +0900 Subject: [PATCH 37/43] improve debug prints --- src/codegen.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index 212465fc..ce92b196 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1359,28 +1359,38 @@ pic_compile(pic_state *pic, pic_value obj) goto exit; } + fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); + fprintf(stderr, "## input expression\n"); pic_debug(pic, obj); fprintf(stderr, "\n"); + fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); + /* macroexpand */ fprintf(stderr, "## macroexpand started\n"); obj = pic_macroexpand(pic, obj); pic_debug(pic, obj); fprintf(stderr, "\n"); + fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); + /* analyze */ fprintf(stderr, "## analyzer started\n"); obj = pic_analyze(pic, obj); pic_debug(pic, obj); fprintf(stderr, "\n"); + fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); + /* resolution */ fprintf(stderr, "## resolver started\n"); obj = pic_resolve(pic, obj); pic_debug(pic, obj); fprintf(stderr, "\n"); + fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); + /* codegen */ fprintf(stderr, "## codegen started\n"); irep = pic_codegen(pic, obj); From 82ea416c344a2d701b2e2facabd609a1bb59edea Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:19:26 +0900 Subject: [PATCH 38/43] get rid of redundant code in is_closed function --- src/codegen.c | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/codegen.c b/src/codegen.c index ce92b196..52fae0b4 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -754,15 +754,9 @@ pop_resolver_scope(resolver_state *state) } static bool -is_closed(resolver_state *state, int depth, pic_sym sym) +is_closed(resolver_state *state, pic_sym sym) { - resolver_scope *scope = state->scope; - - while (depth-- > 0) { - scope = scope->up; - } - - return xh_get(scope->cvs, pic_symbol_name(state->pic, sym)) != NULL; + return xh_get(state->scope->cvs, pic_symbol_name(state->pic, sym)) != NULL; } static pic_value @@ -851,7 +845,7 @@ resolve_reference_node(resolver_state *state, pic_value obj) if (depth == scope->depth) { return resolve_gref(state, sym); } - else if (depth == 0 && is_closed(state, depth, sym)) { + else if (depth == 0 && is_closed(state, sym)) { return resolve_lref(state, sym); } else { From 8343ccd675b68e874c17f3d538820f557f707fae Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:20:08 +0900 Subject: [PATCH 39/43] [bugfix] lset never be emit --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index 52fae0b4..2566a32d 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -1096,7 +1096,7 @@ codegen(codegen_state *state, pic_value obj) return; } else if (type == state->sLREF) { - cxt->code[cxt->clen].insn = OP_CSET; + cxt->code[cxt->clen].insn = OP_LSET; cxt->code[cxt->clen].u.i = pic_int(pic_list_ref(pic, var, 1)); cxt->clen++; cxt->code[cxt->clen].insn = OP_PUSHNONE; From 8255e11486430e17bbc0b90c68498e71dbe73885 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:20:18 +0900 Subject: [PATCH 40/43] gc management --- src/codegen.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/codegen.c b/src/codegen.c index 2566a32d..c7380f56 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -874,9 +874,14 @@ resolve_reference_node(resolver_state *state, pic_value obj) return obj; } else { + int ai = pic_gc_arena_preserve(pic); pic_value seq = pic_list(pic, 1, pic_symbol_value(tag)); for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { seq = pic_cons(pic, resolve_reference(state, pic_car(pic, obj)), seq); + + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, obj); + pic_gc_protect(pic, seq); } return pic_reverse(pic, seq); } From b5cf174b5c5c8abe5789f0fb92b921f735472ca2 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:20:31 +0900 Subject: [PATCH 41/43] wrong FOLD_ARGS impl --- src/codegen.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/codegen.c b/src/codegen.c index c7380f56..e82db71e 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -447,7 +447,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) #define FOLD_ARGS(sym) do { \ obj = analyze(state, pic_car(pic, args), false); \ - for (args = pic_cdr(pic, obj); ! pic_nil_p(args); args = pic_cdr(pic, args)) { \ + for (args = pic_cdr(pic, args); ! pic_nil_p(args); args = pic_cdr(pic, args)) { \ obj = pic_list(pic, 3, pic_symbol_value(sym), obj, \ analyze(state, pic_car(pic, args), false)); \ } \ From 055272f0d5853cd48ffb39bf6bddd8e9a2801ae7 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:20:46 +0900 Subject: [PATCH 42/43] arena management in pic_list --- src/pair.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/pair.c b/src/pair.c index e30d3882..30291d46 100644 --- a/src/pair.c +++ b/src/pair.c @@ -58,6 +58,7 @@ pic_list_p(pic_state *pic, pic_value obj) pic_value pic_list(pic_state *pic, size_t c, ...) { + int ai = pic_gc_arena_preserve(pic); va_list ap; pic_value v; @@ -69,6 +70,10 @@ pic_list(pic_state *pic, size_t c, ...) } va_end(ap); + + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, v); + return pic_reverse(pic, v); } From d471dba322962ddd43e28f1a5a6261e7e35030e8 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 27 Jan 2014 22:24:12 +0900 Subject: [PATCH 43/43] current codegen not supporting env chain short cut --- src/vm.c | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/vm.c b/src/vm.c index 74b134d6..64fa4aaf 100644 --- a/src/vm.c +++ b/src/vm.c @@ -616,18 +616,13 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) } /* prepare env */ - if (proc->u.irep->cv_num == 0) { - ci->env = proc->env; - } - else { - ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); - ci->env->up = proc->env; - ci->env->valuec = proc->u.irep->cv_num; - ci->env->values = (pic_value *)pic_calloc(pic, ci->env->valuec, sizeof(pic_value)); - for (i = 0; i < ci->env->valuec; ++i) { - ci->env->values[i] = ci->fp[proc->u.irep->cv_tbl[i]]; - } - } + ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); + ci->env->up = proc->env; + ci->env->valuec = proc->u.irep->cv_num; + ci->env->values = (pic_value *)pic_calloc(pic, ci->env->valuec, sizeof(pic_value)); + for (i = 0; i < ci->env->valuec; ++i) { + ci->env->values[i] = ci->fp[proc->u.irep->cv_tbl[i]]; + } pc = proc->u.irep->code; pic_gc_arena_restore(pic, ai);