conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

perform tail position analysis on the fly at codegen

This commit is contained in:
Yuichi Nishiwaki 2015-07-02 04:23:07 +09:00
parent 9c908b2622
commit 0a0c94fb91
3 changed files with 163 additions and 451 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

598
extlib/benz/codegen.c
View File

@ -378,7 +378,7 @@ define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
kh_put(a, &scope->locals, sym, &ret); kh_put(a, &scope->locals, sym, &ret);
} }
static pic_value analyze(pic_state *, analyze_scope *, pic_value, bool); static pic_value analyze(pic_state *, analyze_scope *, pic_value);
static pic_value analyze_lambda(pic_state *, analyze_scope *, pic_value); static pic_value analyze_lambda(pic_state *, analyze_scope *, pic_value);
static pic_value static pic_value
@ -444,7 +444,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
analyzer_scope_init(pic, scope, formals, up); analyzer_scope_init(pic, scope, formals, up);
/* analyze body */ /* analyze body */
body = analyze(pic, scope, body, true); body = analyze(pic, scope, body);
analyze_deferred(pic, scope); analyze_deferred(pic, scope);
args = pic_make_vec(pic, kh_size(&scope->args)); args = pic_make_vec(pic, kh_size(&scope->args));
@ -472,243 +472,37 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
analyzer_scope_destroy(pic, scope); analyzer_scope_destroy(pic, scope);
return pic_list6(pic, pic_obj_value(pic->sLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body); return pic_list6(pic, pic_obj_value(pic->uLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body);
}
static pic_value
analyze_list(pic_state *pic, analyze_scope *scope, pic_value obj)
{
pic_value seq = pic_nil_value(), val, it;
pic_for_each (val, obj, it) {
pic_push(pic, analyze(pic, scope, val), seq);
}
return pic_reverse(pic, seq);
} }
static pic_value static pic_value
analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj) analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
{ {
pic_value var, val;
define_var(pic, scope, pic_sym_ptr(pic_list_ref(pic, obj, 1))); define_var(pic, scope, pic_sym_ptr(pic_list_ref(pic, obj, 1)));
var = analyze(pic, scope, pic_list_ref(pic, obj, 1), false); return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
val = analyze(pic, scope, pic_list_ref(pic, obj, 2), false);
return pic_list3(pic, pic_obj_value(pic->sSETBANG), var, val);
} }
static pic_value static pic_value
analyze_if(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos) analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj)
{ {
pic_value cond, if_true, if_false; return pic_cons(pic, pic_obj_value(pic->sCALL), analyze_list(pic, scope, obj));
if_true = pic_list_ref(pic, obj, 2);
if_false = pic_list_ref(pic, obj, 3);
cond = analyze(pic, scope, pic_list_ref(pic, obj, 1), false);
if_true = analyze(pic, scope, if_true, tailpos);
if_false = analyze(pic, scope, if_false, tailpos);
return pic_list4(pic, pic_obj_value(pic->sIF), cond, if_true, if_false);
} }
static pic_value static pic_value
analyze_begin(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos) analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
{
pic_value beg1, beg2;
beg1 = pic_list_ref(pic, obj, 1);
beg2 = pic_list_ref(pic, obj, 2);
beg1 = analyze(pic, scope, beg1, false);
beg2 = analyze(pic, scope, beg2, tailpos);
return pic_list3(pic, pic_obj_value(pic->sBEGIN), beg1, beg2);
}
static pic_value
analyze_set(pic_state *pic, analyze_scope *scope, pic_value obj)
{
pic_value var, val;
var = pic_list_ref(pic, obj, 1);
val = pic_list_ref(pic, obj, 2);
var = analyze(pic, scope, var, false);
val = analyze(pic, scope, val, false);
return pic_list3(pic, pic_obj_value(pic->sSETBANG), var, val);
}
static pic_value
analyze_quote(pic_state *pic, pic_value obj)
{
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_list_ref(pic, obj, 1));
}
#define ARGC_ASSERT_GE(n, name) do { \
if (pic_length(pic, obj) < (n) + 1) { \
pic_errorf(pic, \
#name ": wrong number of arguments (%d for at least %d)", \
pic_length(pic, obj) - 1, \
n); \
} \
} while (0)
#define FOLD_ARGS(sym) do { \
obj = analyze(pic, scope, pic_car(pic, args), false); \
pic_for_each (arg, pic_cdr(pic, args), it) { \
obj = pic_list3(pic, pic_obj_value(sym), obj, \
analyze(pic, scope, arg, false)); \
} \
} while (0)
static pic_value
analyze_add(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{
pic_value args, arg, it;
ARGC_ASSERT_GE(0, "+");
switch (pic_length(pic, obj)) {
case 1:
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_int_value(0));
case 2:
return analyze(pic, scope, pic_car(pic, pic_cdr(pic, obj)), tailpos);
default:
args = pic_cdr(pic, obj);
FOLD_ARGS(pic->sADD);
return obj;
}
}
static pic_value
analyze_sub(pic_state *pic, analyze_scope *scope, pic_value obj)
{
pic_value args, arg, it;
ARGC_ASSERT_GE(1, "-");
switch (pic_length(pic, obj)) {
case 2:
return pic_list2(pic, pic_obj_value(pic->sMINUS),
analyze(pic, scope, pic_car(pic, pic_cdr(pic, obj)), false));
default:
args = pic_cdr(pic, obj);
FOLD_ARGS(pic->sSUB);
return obj;
}
}
static pic_value
analyze_mul(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{
pic_value args, arg, it;
ARGC_ASSERT_GE(0, "*");
switch (pic_length(pic, obj)) {
case 1:
return pic_list2(pic, pic_obj_value(pic->sQUOTE), pic_int_value(1));
case 2:
return analyze(pic, scope, pic_car(pic, pic_cdr(pic, obj)), tailpos);
default:
args = pic_cdr(pic, obj);
FOLD_ARGS(pic->sMUL);
return obj;
}
}
static pic_value
analyze_div(pic_state *pic, analyze_scope *scope, pic_value obj)
{
pic_value args, arg, it;
ARGC_ASSERT_GE(1, "/");
switch (pic_length(pic, obj)) {
case 2:
args = pic_cdr(pic, obj);
#if PIC_ENABLE_FLOAT
obj = pic_list3(pic, pic_car(pic, obj), pic_float_value(1), pic_car(pic, args));
#else
obj = pic_list3(pic, pic_car(pic, obj), pic_int_value(1), pic_car(pic, args));
#endif
return analyze(pic, scope, obj, false);
default:
args = pic_cdr(pic, obj);
FOLD_ARGS(pic->sDIV);
return obj;
}
}
static pic_value
analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{
pic_value seq, elt, it;
pic_sym *call;
if (! tailpos) {
call = pic->sCALL;
} else {
call = pic->sTAILCALL;
}
seq = pic_list1(pic, pic_obj_value(call));
pic_for_each (elt, obj, it) {
seq = pic_cons(pic, analyze(pic, scope, elt, false), seq);
}
return pic_reverse(pic, seq);
}
static pic_value
analyze_values(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{
pic_value v, seq, it;
if (! tailpos) {
return analyze_call(pic, scope, obj, false);
}
seq = pic_list1(pic, pic_obj_value(pic->sRETURN));
pic_for_each (v, pic_cdr(pic, obj), it) {
seq = pic_cons(pic, analyze(pic, scope, v, false), seq);
}
return pic_reverse(pic, seq);
}
static pic_value
analyze_call_with_values(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{
pic_value prod, cnsm;
pic_sym *call;
if (pic_length(pic, obj) != 3) {
pic_errorf(pic, "call-with-values: wrong number of arguments (%d for 2)", pic_length(pic, obj) - 1);
}
if (! tailpos) {
call = pic->sCALL_WITH_VALUES;
} else {
call = pic->sTAILCALL_WITH_VALUES;
}
prod = analyze(pic, scope, pic_list_ref(pic, obj, 1), false);
cnsm = analyze(pic, scope, pic_list_ref(pic, obj, 2), false);
return pic_list3(pic, pic_obj_value(call), prod, cnsm);
}
#define ARGC_ASSERT(n, name) do { \
if (pic_length(pic, obj) != (n) + 1) { \
pic_errorf(pic, #name ": wrong number of arguments (%d for %d)", \
pic_length(pic, obj) - 1, n); \
} \
} while (0)
#define ARGC_ASSERT_WITH_FALLBACK(n) do { \
if (pic_length(pic, obj) != (n) + 1) { \
goto fallback; \
} \
} while (0)
#define CONSTRUCT_OP1(op) \
pic_list2(pic, \
pic_obj_value(op), \
analyze(pic, scope, pic_list_ref(pic, obj, 1), false))
#define CONSTRUCT_OP2(op) \
pic_list3(pic, \
pic_obj_value(op), \
analyze(pic, scope, pic_list_ref(pic, obj, 1), false), \
analyze(pic, scope, pic_list_ref(pic, obj, 2), false))
static pic_value
analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
{ {
switch (pic_type(obj)) { switch (pic_type(obj)) {
case PIC_TT_SYMBOL: { case PIC_TT_SYMBOL: {
@ -731,112 +525,28 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
else if (sym == pic->uLAMBDA) { else if (sym == pic->uLAMBDA) {
return analyze_defer(pic, scope, obj); return analyze_defer(pic, scope, obj);
} }
else if (sym == pic->uIF) {
return analyze_if(pic, scope, obj, tailpos);
}
else if (sym == pic->uBEGIN) {
return analyze_begin(pic, scope, obj, tailpos);
}
else if (sym == pic->uSETBANG) {
return analyze_set(pic, scope, obj);
}
else if (sym == pic->uQUOTE) { else if (sym == pic->uQUOTE) {
return analyze_quote(pic, obj); return obj;
} }
else if (sym == pic->uCONS) { else if (sym == pic->uBEGIN || sym == pic->uSETBANG || sym == pic->uIF) {
ARGC_ASSERT(2, "cons"); return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
return CONSTRUCT_OP2(pic->sCONS);
}
else if (sym == pic->uCAR) {
ARGC_ASSERT(1, "car");
return CONSTRUCT_OP1(pic->sCAR);
}
else if (sym == pic->uCDR) {
ARGC_ASSERT(1, "cdr");
return CONSTRUCT_OP1(pic->sCDR);
}
else if (sym == pic->uNILP) {
ARGC_ASSERT(1, "nil?");
return CONSTRUCT_OP1(pic->sNILP);
}
else if (sym == pic->uSYMBOLP) {
ARGC_ASSERT(1, "symbol?");
return CONSTRUCT_OP1(pic->sSYMBOLP);
}
else if (sym == pic->uPAIRP) {
ARGC_ASSERT(1, "pair?");
return CONSTRUCT_OP1(pic->sPAIRP);
}
else if (sym == pic->uADD) {
return analyze_add(pic, scope, obj, tailpos);
}
else if (sym == pic->uSUB) {
return analyze_sub(pic, scope, obj);
}
else if (sym == pic->uMUL) {
return analyze_mul(pic, scope, obj, tailpos);
}
else if (sym == pic->uDIV) {
return analyze_div(pic, scope, obj);
}
else if (sym == pic->uEQ) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sEQ);
}
else if (sym == pic->uLT) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sLT);
}
else if (sym == pic->uLE) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sLE);
}
else if (sym == pic->uGT) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sGT);
}
else if (sym == pic->uGE) {
ARGC_ASSERT_WITH_FALLBACK(2);
return CONSTRUCT_OP2(pic->sGE);
}
else if (sym == pic->uNOT) {
ARGC_ASSERT(1, "not");
return CONSTRUCT_OP1(pic->sNOT);
}
else if (sym == pic->uVALUES) {
return analyze_values(pic, scope, obj, tailpos);
}
else if (sym == pic->uCALL_WITH_VALUES) {
return analyze_call_with_values(pic, scope, obj, tailpos);
} }
} }
fallback:
return analyze_call(pic, scope, obj, tailpos); return analyze_call(pic, scope, obj);
} }
default: default:
return pic_list2(pic, pic_obj_value(pic->sQUOTE), obj); return pic_list2(pic, pic_obj_value(pic->uQUOTE), obj);
} }
} }
static pic_value static pic_value
analyze(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos) analyze(pic_state *pic, analyze_scope *scope, pic_value obj)
{ {
size_t ai = pic_gc_arena_preserve(pic); size_t ai = pic_gc_arena_preserve(pic);
pic_value res; pic_value res;
pic_sym *tag;
res = analyze_node(pic, scope, obj, tailpos); res = analyze_node(pic, scope, obj);
tag = pic_sym_ptr(pic_car(pic, res));
if (tailpos) {
if (tag == pic->sIF || tag == pic->sBEGIN || tag == pic->sTAILCALL || tag == pic->sTAILCALL_WITH_VALUES || tag == pic->sRETURN) {
/* pass through */
}
else {
res = pic_list2(pic, pic_obj_value(pic->sRETURN), res);
}
}
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, res); pic_gc_protect(pic, res);
@ -851,7 +561,7 @@ pic_analyze(pic_state *pic, pic_value obj)
analyzer_scope_init(pic, scope, pic_nil_value(), NULL); analyzer_scope_init(pic, scope, pic_nil_value(), NULL);
obj = analyze(pic, scope, obj, true); obj = analyze(pic, scope, obj);
analyze_deferred(pic, scope); analyze_deferred(pic, scope);
@ -1054,7 +764,7 @@ index_symbol(pic_state *pic, codegen_context *cxt, pic_sym *sym)
return i; return i;
} }
static void codegen(pic_state *, codegen_context *, pic_value); static void codegen(pic_state *, codegen_context *, pic_value, bool);
static struct pic_irep * static struct pic_irep *
codegen_lambda(pic_state *pic, codegen_context *up, pic_value obj) codegen_lambda(pic_state *pic, codegen_context *up, pic_value obj)
@ -1077,19 +787,22 @@ codegen_lambda(pic_state *pic, codegen_context *up, pic_value obj)
codegen_context_init(pic, cxt, up, rest, args, locals, captures); codegen_context_init(pic, cxt, up, rest, args, locals, captures);
{ {
/* body */ /* body */
codegen(pic, cxt, body); codegen(pic, cxt, body, true);
} }
return codegen_context_destroy(pic, cxt); return codegen_context_destroy(pic, cxt);
} }
#define emit_ret(pic, cxt, tailpos) if (tailpos) emit_i(pic, cxt, OP_RET, 1)
static void static void
codegen(pic_state *pic, codegen_context *cxt, pic_value obj) codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
{ {
pic_sym *sym; pic_sym *sym;
sym = pic_sym_ptr(pic_car(pic, obj)); sym = pic_sym_ptr(pic_car(pic, obj));
if (sym == pic->sGREF) { if (sym == pic->sGREF) {
emit_i(pic, cxt, OP_GREF, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, obj, 1)))); emit_i(pic, cxt, OP_GREF, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, obj, 1))));
emit_ret(pic, cxt, tailpos);
return; return;
} }
else if (sym == pic->sCREF) { else if (sym == pic->sCREF) {
@ -1099,6 +812,7 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj)
depth = pic_int(pic_list_ref(pic, obj, 1)); depth = pic_int(pic_list_ref(pic, obj, 1));
name = pic_sym_ptr(pic_list_ref(pic, obj, 2)); name = pic_sym_ptr(pic_list_ref(pic, obj, 2));
emit_r(pic, cxt, OP_CREF, depth, index_capture(cxt, name, depth)); emit_r(pic, cxt, OP_CREF, depth, index_capture(cxt, name, depth));
emit_ret(pic, cxt, tailpos);
return; return;
} }
else if (sym == pic->sLREF) { else if (sym == pic->sLREF) {
@ -1108,23 +822,26 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj)
name = pic_sym_ptr(pic_list_ref(pic, obj, 1)); name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
if ((i = index_capture(cxt, name, 0)) != -1) { if ((i = index_capture(cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LREF, i + (int)cxt->args->len + (int)cxt->locals->len + 1); emit_i(pic, cxt, OP_LREF, i + (int)cxt->args->len + (int)cxt->locals->len + 1);
emit_ret(pic, cxt, tailpos);
return; return;
} }
emit_i(pic, cxt, OP_LREF, index_local(cxt, name)); emit_i(pic, cxt, OP_LREF, index_local(cxt, name));
emit_ret(pic, cxt, tailpos);
return; return;
} }
else if (sym == pic->sSETBANG) { else if (sym == pic->uSETBANG || sym == pic->uDEFINE) {
pic_value var, val; pic_value var, val;
pic_sym *type; pic_sym *type;
val = pic_list_ref(pic, obj, 2); val = pic_list_ref(pic, obj, 2);
codegen(pic, cxt, val); codegen(pic, cxt, val, false);
var = pic_list_ref(pic, obj, 1); var = pic_list_ref(pic, obj, 1);
type = pic_sym_ptr(pic_list_ref(pic, var, 0)); type = pic_sym_ptr(pic_list_ref(pic, var, 0));
if (type == pic->sGREF) { if (type == pic->sGREF) {
emit_i(pic, cxt, OP_GSET, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, var, 1)))); emit_i(pic, cxt, OP_GSET, index_symbol(pic, cxt, pic_sym_ptr(pic_list_ref(pic, var, 1))));
emit_n(pic, cxt, OP_PUSHUNDEF); emit_n(pic, cxt, OP_PUSHUNDEF);
emit_ret(pic, cxt, tailpos);
return; return;
} }
else if (type == pic->sCREF) { else if (type == pic->sCREF) {
@ -1135,6 +852,7 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj)
name = pic_sym_ptr(pic_list_ref(pic, var, 2)); name = pic_sym_ptr(pic_list_ref(pic, var, 2));
emit_r(pic, cxt, OP_CSET, depth, index_capture(cxt, name, depth)); emit_r(pic, cxt, OP_CSET, depth, index_capture(cxt, name, depth));
emit_n(pic, cxt, OP_PUSHUNDEF); emit_n(pic, cxt, OP_PUSHUNDEF);
emit_ret(pic, cxt, tailpos);
return; return;
} }
else if (type == pic->sLREF) { else if (type == pic->sLREF) {
@ -1145,34 +863,37 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj)
if ((i = index_capture(cxt, name, 0)) != -1) { if ((i = index_capture(cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LSET, i + (int)cxt->args->len + (int)cxt->locals->len + 1); emit_i(pic, cxt, OP_LSET, i + (int)cxt->args->len + (int)cxt->locals->len + 1);
emit_n(pic, cxt, OP_PUSHUNDEF); emit_n(pic, cxt, OP_PUSHUNDEF);
emit_ret(pic, cxt, tailpos);
return; return;
} }
emit_i(pic, cxt, OP_LSET, index_local(cxt, name)); emit_i(pic, cxt, OP_LSET, index_local(cxt, name));
emit_n(pic, cxt, OP_PUSHUNDEF); emit_n(pic, cxt, OP_PUSHUNDEF);
emit_ret(pic, cxt, tailpos);
return; return;
} }
} }
else if (sym == pic->sLAMBDA) { else if (sym == pic->uLAMBDA) {
int k; int k;
check_irep_size(pic, cxt); check_irep_size(pic, cxt);
k = (int)cxt->ilen++; k = (int)cxt->ilen++;
emit_i(pic, cxt, OP_LAMBDA, k); emit_i(pic, cxt, OP_LAMBDA, k);
emit_ret(pic, cxt, tailpos);
cxt->irep[k] = codegen_lambda(pic, cxt, obj); cxt->irep[k] = codegen_lambda(pic, cxt, obj);
return; return;
} }
else if (sym == pic->sIF) { else if (sym == pic->uIF) {
int s, t; int s, t;
codegen(pic, cxt, pic_list_ref(pic, obj, 1)); codegen(pic, cxt, pic_list_ref(pic, obj, 1), false);
s = (int)cxt->clen; s = (int)cxt->clen;
emit_n(pic, cxt, OP_JMPIF); emit_n(pic, cxt, OP_JMPIF);
/* if false branch */ /* if false branch */
codegen(pic, cxt, pic_list_ref(pic, obj, 3)); codegen(pic, cxt, pic_list_ref(pic, obj, 3), tailpos);
t = (int)cxt->clen; t = (int)cxt->clen;
@ -1181,164 +902,145 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj)
cxt->code[s].u.i = (int)cxt->clen - s; cxt->code[s].u.i = (int)cxt->clen - s;
/* if true branch */ /* if true branch */
codegen(pic, cxt, pic_list_ref(pic, obj, 2)); codegen(pic, cxt, pic_list_ref(pic, obj, 2), tailpos);
cxt->code[t].u.i = (int)cxt->clen - t; cxt->code[t].u.i = (int)cxt->clen - t;
return; return;
} }
else if (sym == pic->sBEGIN) { else if (sym == pic->uBEGIN) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1)); codegen(pic, cxt, pic_list_ref(pic, obj, 1), false);
emit_n(pic, cxt, OP_POP); emit_n(pic, cxt, OP_POP);
codegen(pic, cxt, pic_list_ref(pic, obj, 2)); codegen(pic, cxt, pic_list_ref(pic, obj, 2), tailpos);
return; return;
} }
else if (sym == pic->sQUOTE) { else if (sym == pic->uQUOTE) {
int pidx; int pidx;
obj = pic_list_ref(pic, obj, 1); obj = pic_list_ref(pic, obj, 1);
switch (pic_type(obj)) { switch (pic_type(obj)) {
case PIC_TT_BOOL: case PIC_TT_BOOL:
emit_n(pic, cxt, (pic_true_p(obj) ? OP_PUSHTRUE : OP_PUSHFALSE)); emit_n(pic, cxt, (pic_true_p(obj) ? OP_PUSHTRUE : OP_PUSHFALSE));
emit_ret(pic, cxt, tailpos);
return; return;
case PIC_TT_INT: case PIC_TT_INT:
emit_i(pic, cxt, OP_PUSHINT, pic_int(obj)); emit_i(pic, cxt, OP_PUSHINT, pic_int(obj));
emit_ret(pic, cxt, tailpos);
return; return;
case PIC_TT_NIL: case PIC_TT_NIL:
emit_n(pic, cxt, OP_PUSHNIL); emit_n(pic, cxt, OP_PUSHNIL);
emit_ret(pic, cxt, tailpos);
return; return;
case PIC_TT_CHAR: case PIC_TT_CHAR:
emit_c(pic, cxt, OP_PUSHCHAR, pic_char(obj)); emit_c(pic, cxt, OP_PUSHCHAR, pic_char(obj));
emit_ret(pic, cxt, tailpos);
return; return;
default: default:
check_pool_size(pic, cxt); check_pool_size(pic, cxt);
pidx = (int)cxt->plen++; pidx = (int)cxt->plen++;
cxt->pool[pidx] = obj; cxt->pool[pidx] = obj;
emit_i(pic, cxt, OP_PUSHCONST, pidx); emit_i(pic, cxt, OP_PUSHCONST, pidx);
emit_ret(pic, cxt, tailpos);
return; return;
} }
} }
else if (sym == pic->sCONS) { else if (sym == pic->sCALL) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_CONS);
return;
}
else if (sym == pic->sCAR) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_CAR);
return;
}
else if (sym == pic->sCDR) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_CDR);
return;
}
else if (sym == pic->sNILP) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_NILP);
return;
}
else if (sym == pic->sSYMBOLP) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_SYMBOLP);
return;
}
else if (sym == pic->sPAIRP) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_PAIRP);
return;
}
else if (sym == pic->sADD) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_ADD);
return;
}
else if (sym == pic->sSUB) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_SUB);
return;
}
else if (sym == pic->sMUL) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_MUL);
return;
}
else if (sym == pic->sDIV) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_DIV);
return;
}
else if (sym == pic->sMINUS) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_MINUS);
return;
}
else if (sym == pic->sEQ) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_EQ);
return;
}
else if (sym == pic->sLT) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_LT);
return;
}
else if (sym == pic->sLE) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
emit_n(pic, cxt, OP_LE);
return;
}
else if (sym == pic->sGT) {
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_LT);
return;
}
else if (sym == pic->sGE) {
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_LE);
return;
}
else if (sym == pic->sNOT) {
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
emit_n(pic, cxt, OP_NOT);
return;
}
else if (sym == pic->sCALL || sym == pic->sTAILCALL) {
int len = (int)pic_length(pic, obj); int len = (int)pic_length(pic, obj);
pic_value elt, it; pic_value elt, it;
pic_for_each (elt, pic_cdr(pic, obj), it) { pic_for_each (elt, pic_cdr(pic, obj), it) {
codegen(pic, cxt, elt); codegen(pic, cxt, elt, false);
} }
emit_i(pic, cxt, (sym == pic->sCALL ? OP_CALL : OP_TAILCALL), len - 1);
return;
}
else if (sym == pic->sCALL_WITH_VALUES || sym == pic->sTAILCALL_WITH_VALUES) {
/* stack consumer at first */
codegen(pic, cxt, pic_list_ref(pic, obj, 2));
codegen(pic, cxt, pic_list_ref(pic, obj, 1));
/* call producer */
emit_i(pic, cxt, OP_CALL, 1);
/* call consumer */
emit_i(pic, cxt, (sym == pic->sCALL_WITH_VALUES ? OP_CALL : OP_TAILCALL), -1);
return;
}
else if (sym == pic->sRETURN) {
int len = (int)pic_length(pic, obj);
pic_value elt, it;
pic_for_each (elt, pic_cdr(pic, obj), it) { if (pic_sym_ptr(pic_list_ref(pic, pic_list_ref(pic, obj, 1), 0)) == pic->sGREF) {
codegen(pic, cxt, elt); sym = pic_sym_ptr(pic_list_ref(pic, pic_list_ref(pic, obj, 1), 1));
/*
TODO:
- call-with-values, values, >, >=
- more than 2 arguments for add, sub, mul, ...
*/
if (len == 4) { /* binary operator */
if (sym == pic->uCONS) {
emit_n(pic, cxt, OP_CONS);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uADD) {
emit_n(pic, cxt, OP_ADD);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uSUB) {
emit_n(pic, cxt, OP_SUB);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uMUL) {
emit_n(pic, cxt, OP_MUL);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uDIV) {
emit_n(pic, cxt, OP_DIV);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uEQ) {
emit_n(pic, cxt, OP_EQ);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uLT) {
emit_n(pic, cxt, OP_LT);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uLE) {
emit_n(pic, cxt, OP_LE);
emit_ret(pic, cxt, tailpos);
return;
}
}
if (len == 3) { /* unary operator */
if (sym == pic->uCAR) {
emit_n(pic, cxt, OP_CAR);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uCDR) {
emit_n(pic, cxt, OP_CDR);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uNILP) {
emit_n(pic, cxt, OP_NILP);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uSYMBOLP) {
emit_n(pic, cxt, OP_SYMBOLP);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uPAIRP) {
emit_n(pic, cxt, OP_PAIRP);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uSUB) {
emit_n(pic, cxt, OP_MINUS);
emit_ret(pic, cxt, tailpos);
return;
}
else if (sym == pic->uNOT) {
emit_n(pic, cxt, OP_NOT);
emit_ret(pic, cxt, tailpos);
return;
}
}
} }
emit_i(pic, cxt, OP_RET, len - 1);
emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1);
return; return;
} }
pic_errorf(pic, "codegen: unknown AST type ~s", obj); pic_errorf(pic, "codegen: unknown AST type ~s", obj);
@ -1352,7 +1054,7 @@ pic_codegen(pic_state *pic, pic_value obj)
codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty); codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty);
codegen(pic, cxt, obj); codegen(pic, cxt, obj, true);
return codegen_context_destroy(pic, cxt); return codegen_context_destroy(pic, cxt);
} }

2
extlib/benz/include/picrin/config.h
View File

@ -128,7 +128,7 @@
#endif #endif
#ifndef PIC_STACK_SIZE #ifndef PIC_STACK_SIZE
# define PIC_STACK_SIZE 1024 # define PIC_STACK_SIZE 2048
#endif #endif
#ifndef PIC_RESCUE_SIZE #ifndef PIC_RESCUE_SIZE

14
extlib/benz/vm.c
View File

@ -713,6 +713,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value v; pic_value v;
v = pic_false_p(POP()) ? pic_true_value() : pic_false_value(); v = pic_false_p(POP()) ? pic_true_value() : pic_false_value();
(void)POP();
PUSH(v); PUSH(v);
NEXT; NEXT;
} }
@ -876,6 +877,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value a, b; pic_value a, b;
pic_gc_protect(pic, b = POP()); pic_gc_protect(pic, b = POP());
pic_gc_protect(pic, a = POP()); pic_gc_protect(pic, a = POP());
(void)POP();
PUSH(pic_cons(pic, a, b)); PUSH(pic_cons(pic, a, b));
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
NEXT; NEXT;
@ -883,32 +885,35 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
CASE(OP_CAR) { CASE(OP_CAR) {
pic_value p; pic_value p;
p = POP(); p = POP();
(void)POP();
PUSH(pic_car(pic, p)); PUSH(pic_car(pic, p));
NEXT; NEXT;
} }
CASE(OP_CDR) { CASE(OP_CDR) {
pic_value p; pic_value p;
p = POP(); p = POP();
(void)POP();
PUSH(pic_cdr(pic, p)); PUSH(pic_cdr(pic, p));
NEXT; NEXT;
} }
CASE(OP_NILP) { CASE(OP_NILP) {
pic_value p; pic_value p;
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic_nil_p(p))); PUSH(pic_bool_value(pic_nil_p(p)));
NEXT; NEXT;
} }
CASE(OP_SYMBOLP) { CASE(OP_SYMBOLP) {
pic_value p; pic_value p;
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic_sym_p(p))); PUSH(pic_bool_value(pic_sym_p(p)));
NEXT; NEXT;
} }
CASE(OP_PAIRP) { CASE(OP_PAIRP) {
pic_value p; pic_value p;
p = POP(); p = POP();
(void)POP();
PUSH(pic_bool_value(pic_pair_p(p))); PUSH(pic_bool_value(pic_pair_p(p)));
NEXT; NEXT;
} }
@ -918,6 +923,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value a, b; \ pic_value a, b; \
b = POP(); \ b = POP(); \
a = POP(); \ a = POP(); \
(void)POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \ if (pic_int_p(a) && pic_int_p(b)) { \
double f = (double)pic_int(a) op (double)pic_int(b); \ double f = (double)pic_int(a) op (double)pic_int(b); \
if (INT_MIN <= f && f <= INT_MAX && (guard)) { \ if (INT_MIN <= f && f <= INT_MAX && (guard)) { \
@ -947,6 +953,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value a, b; \ pic_value a, b; \
b = POP(); \ b = POP(); \
a = POP(); \ a = POP(); \
(void)POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \ if (pic_int_p(a) && pic_int_p(b)) { \
PUSH(pic_int_value(pic_int(a) op pic_int(b))); \ PUSH(pic_int_value(pic_int(a) op pic_int(b))); \
} \ } \
@ -971,6 +978,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
CASE(OP_MINUS) { CASE(OP_MINUS) {
pic_value n; pic_value n;
n = POP(); n = POP();
(void)POP();
if (pic_int_p(n)) { if (pic_int_p(n)) {
PUSH(pic_int_value(-pic_int(n))); PUSH(pic_int_value(-pic_int(n)));
} }
@ -990,6 +998,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value a, b; \ pic_value a, b; \
b = POP(); \ b = POP(); \
a = POP(); \ a = POP(); \
(void)POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \ if (pic_int_p(a) && pic_int_p(b)) { \
PUSH(pic_bool_value(pic_int(a) op pic_int(b))); \ PUSH(pic_bool_value(pic_int(a) op pic_int(b))); \
} \ } \
@ -1013,6 +1022,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
pic_value a, b; \ pic_value a, b; \
b = POP(); \ b = POP(); \
a = POP(); \ a = POP(); \
(void)POP(); \
if (pic_int_p(a) && pic_int_p(b)) { \ if (pic_int_p(a) && pic_int_p(b)) { \
PUSH(pic_bool_value(pic_int(a) op pic_int(b))); \ PUSH(pic_bool_value(pic_int(a) op pic_int(b))); \
} \ } \