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

remove pic_list, and add pic_listn

This commit is contained in:
Yuichi Nishiwaki 2014-03-01 20:46:08 +09:00
parent ac09af95ce
commit c357a9302d
6 changed files with 111 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
include/picrin/pair.h
View File

@ -23,7 +23,12 @@ pic_value pic_car(pic_state *, pic_value);
pic_value pic_cdr(pic_state *, pic_value); pic_value pic_cdr(pic_state *, pic_value);
bool pic_list_p(pic_state *, pic_value); bool pic_list_p(pic_state *, pic_value);
pic_value pic_list(pic_state *, size_t, ...); pic_value pic_list1(pic_state *, pic_value);
pic_value pic_list2(pic_state *, pic_value, pic_value);
pic_value pic_list3(pic_state *, pic_value, pic_value, pic_value);
pic_value pic_list4(pic_state *, pic_value, pic_value, pic_value, pic_value);
pic_value pic_list5(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value);
pic_value pic_list6(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value);
pic_value pic_list_by_array(pic_state *, size_t, pic_value *); pic_value pic_list_by_array(pic_state *, size_t, pic_value *);
pic_value pic_make_list(pic_state *, int, pic_value); pic_value pic_make_list(pic_state *, int, pic_value);

80
src/codegen.c
View File

@ -248,10 +248,10 @@ define_var(analyze_state *state, pic_sym sym)
static pic_value static pic_value
new_ref(analyze_state *state, int depth, pic_sym sym) new_ref(analyze_state *state, int depth, pic_sym sym)
{ {
return pic_list(state->pic, 3, return pic_list3(state->pic,
pic_symbol_value(state->sREF), pic_symbol_value(state->sREF),
pic_int_value(depth), pic_int_value(depth),
pic_symbol_value(sym)); pic_symbol_value(sym));
} }
static pic_value analyze_node(analyze_state *, pic_value, bool); static pic_value analyze_node(analyze_state *, pic_value, bool);
@ -274,7 +274,7 @@ analyze(analyze_state *state, pic_value obj, bool tailpos)
/* pass through */ /* pass through */
} }
else { else {
res = pic_list(pic, 2, pic_symbol_value(state->sRETURN), res); res = pic_list2(pic, pic_symbol_value(state->sRETURN), res);
} }
} }
@ -336,10 +336,10 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
} }
define_var(state, pic_sym(var)); define_var(state, pic_sym(var));
return pic_list(pic, 3, return pic_list3(pic,
pic_symbol_value(pic->sSETBANG), pic_symbol_value(pic->sSETBANG),
analyze(state, var, false), analyze(state, var, false),
analyze(state, val, false)); analyze(state, val, false));
} }
else if (sym == pic->sLAMBDA) { else if (sym == pic->sLAMBDA) {
return analyze_lambda(state, obj); return analyze_lambda(state, obj);
@ -364,7 +364,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
if_true = analyze(state, if_true, tailpos); if_true = analyze(state, if_true, tailpos);
if_false = analyze(state, if_false, tailpos); if_false = analyze(state, if_false, tailpos);
return pic_list(pic, 4, pic_symbol_value(pic->sIF), cond, if_true, if_false); return pic_list4(pic, pic_symbol_value(pic->sIF), cond, if_true, if_false);
} }
else if (sym == pic->sBEGIN) { else if (sym == pic->sBEGIN) {
pic_value seq; pic_value seq;
@ -376,7 +376,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
case 2: case 2:
return analyze(state, pic_list_ref(pic, obj, 1), tailpos); return analyze(state, pic_list_ref(pic, obj, 1), tailpos);
default: default:
seq = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); seq = pic_list1(pic, pic_symbol_value(pic->sBEGIN));
for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) { for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) {
if (pic_nil_p(pic_cdr(pic, obj))) { if (pic_nil_p(pic_cdr(pic, obj))) {
tail = tailpos; tail = tailpos;
@ -402,10 +402,10 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
val = pic_list_ref(pic, obj, 2); val = pic_list_ref(pic, obj, 2);
return pic_list(pic, 3, return pic_list3(pic,
pic_symbol_value(pic->sSETBANG), pic_symbol_value(pic->sSETBANG),
analyze(state, var, false), analyze(state, var, false),
analyze(state, val, false)); analyze(state, val, false));
} }
else if (sym == pic->sQUOTE) { else if (sym == pic->sQUOTE) {
if (pic_length(pic, obj) != 2) { if (pic_length(pic, obj) != 2) {
@ -421,15 +421,15 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
} while (0) } while (0)
#define CONSTRUCT_OP1(op) \ #define CONSTRUCT_OP1(op) \
pic_list(pic, 2, \ pic_list2(pic, \
pic_symbol_value(op), \ pic_symbol_value(op), \
analyze(state, pic_list_ref(pic, obj, 1), false)) analyze(state, pic_list_ref(pic, obj, 1), false))
#define CONSTRUCT_OP2(op) \ #define CONSTRUCT_OP2(op) \
pic_list(pic, 3, \ pic_list3(pic, \
pic_symbol_value(op), \ pic_symbol_value(op), \
analyze(state, pic_list_ref(pic, obj, 1), false), \ analyze(state, pic_list_ref(pic, obj, 1), false), \
analyze(state, pic_list_ref(pic, obj, 2), false)) analyze(state, pic_list_ref(pic, obj, 2), false))
else if (sym == state->rCONS) { else if (sym == state->rCONS) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
@ -457,8 +457,8 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
#define FOLD_ARGS(sym) do { \ #define FOLD_ARGS(sym) do { \
obj = analyze(state, pic_car(pic, args), false); \ obj = analyze(state, pic_car(pic, args), false); \
pic_for_each (arg, pic_cdr(pic, args)) { \ pic_for_each (arg, pic_cdr(pic, args)) { \
obj = pic_list(pic, 3, pic_symbol_value(sym), obj, \ obj = pic_list3(pic, pic_symbol_value(sym), obj, \
analyze(state, arg, false)); \ analyze(state, arg, false)); \
} \ } \
} while (0) } while (0)
@ -483,8 +483,8 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
ARGC_ASSERT_GE(1); ARGC_ASSERT_GE(1);
switch (pic_length(pic, obj)) { switch (pic_length(pic, obj)) {
case 2: case 2:
return pic_list(pic, 2, pic_symbol_value(pic->sMINUS), return pic_list2(pic, pic_symbol_value(pic->sMINUS),
analyze(state, pic_car(pic, pic_cdr(pic, obj)), false)); analyze(state, pic_car(pic, pic_cdr(pic, obj)), false));
default: default:
args = pic_cdr(pic, obj); args = pic_cdr(pic, obj);
FOLD_ARGS(pic->sSUB); FOLD_ARGS(pic->sSUB);
@ -513,7 +513,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
switch (pic_length(pic, obj)) { switch (pic_length(pic, obj)) {
case 2: case 2:
args = pic_cdr(pic, obj); args = pic_cdr(pic, obj);
obj = pic_list(pic, 3, proc, pic_float_value(1), pic_car(pic, args)); obj = pic_list3(pic, proc, pic_float_value(1), pic_car(pic, args));
return analyze(state, obj, tailpos); return analyze(state, obj, tailpos);
default: default:
args = pic_cdr(pic, obj); args = pic_cdr(pic, obj);
@ -549,7 +549,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
else if (sym == state->rVALUES && tailpos) { else if (sym == state->rVALUES && tailpos) {
pic_value v, seq; pic_value v, seq;
seq = pic_list(pic, 1, pic_symbol_value(state->sRETURN)); seq = pic_list1(pic, pic_symbol_value(state->sRETURN));
pic_for_each (v, pic_cdr(pic, obj)) { pic_for_each (v, pic_cdr(pic, obj)) {
seq = pic_cons(pic, analyze(state, v, false), seq); seq = pic_cons(pic, analyze(state, v, false), seq);
} }
@ -568,7 +568,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
} }
prod = analyze(state, pic_list_ref(pic, obj, 1), false); prod = analyze(state, pic_list_ref(pic, obj, 1), false);
cnsm = analyze(state, pic_list_ref(pic, obj, 2), false); cnsm = analyze(state, pic_list_ref(pic, obj, 2), false);
return pic_list(pic, 3, pic_symbol_value(call), prod, cnsm); return pic_list3(pic, pic_symbol_value(call), prod, cnsm);
} }
} }
return analyze_call(state, obj, tailpos); return analyze_call(state, obj, tailpos);
@ -581,7 +581,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
case PIC_TT_STRING: case PIC_TT_STRING:
case PIC_TT_VECTOR: case PIC_TT_VECTOR:
case PIC_TT_BLOB: { case PIC_TT_BLOB: {
return pic_list(pic, 2, pic_symbol_value(pic->sQUOTE), obj); return pic_list2(pic, pic_symbol_value(pic->sQUOTE), obj);
} }
case PIC_TT_CONT: case PIC_TT_CONT:
case PIC_TT_ENV: case PIC_TT_ENV:
@ -614,7 +614,7 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos)
} else { } else {
call = state->sTAILCALL; call = state->sTAILCALL;
} }
seq = pic_list(pic, 1, pic_symbol_value(call)); seq = pic_list1(pic, pic_symbol_value(call));
pic_for_each (elt, obj) { pic_for_each (elt, obj) {
seq = pic_cons(pic, analyze(state, elt, false), seq); seq = pic_cons(pic, analyze(state, elt, false), seq);
} }
@ -677,7 +677,7 @@ analyze_lambda(analyze_state *state, pic_value obj)
} }
pop_scope(state); pop_scope(state);
obj = pic_list(pic, 6, pic_symbol_value(pic->sLAMBDA), args, locals, varg, closes, body); obj = pic_list6(pic, pic_symbol_value(pic->sLAMBDA), args, locals, varg, closes, body);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, obj); pic_gc_protect(pic, obj);
return obj; return obj;
@ -814,7 +814,7 @@ resolve_gref(resolver_state *state, pic_sym sym)
} }
xh_put_int(pic->global_tbl, sym, i); xh_put_int(pic->global_tbl, sym, i);
} }
return pic_list(pic, 2, pic_symbol_value(state->sGREF), pic_int_value(i)); return pic_list2(pic, pic_symbol_value(state->sGREF), pic_int_value(i));
} }
static pic_value static pic_value
@ -825,7 +825,7 @@ resolve_lref(resolver_state *state, pic_sym sym)
i = xh_get_int(state->scope->lvs, sym)->val; i = xh_get_int(state->scope->lvs, sym)->val;
return pic_list(pic, 2, pic_symbol_value(state->sLREF), pic_int_value(i)); return pic_list2(pic, pic_symbol_value(state->sLREF), pic_int_value(i));
} }
static pic_value static pic_value
@ -842,10 +842,10 @@ resolve_cref(resolver_state *state, int depth, pic_sym sym)
i = xh_get_int(scope->cvs, sym)->val; i = xh_get_int(scope->cvs, sym)->val;
return pic_list(pic, 3, return pic_list3(pic,
pic_symbol_value(state->sCREF), pic_symbol_value(state->sCREF),
pic_int_value(depth), pic_int_value(depth),
pic_int_value(i)); pic_int_value(i));
} }
static pic_value resolve_reference_node(resolver_state *state, pic_value obj); static pic_value resolve_reference_node(resolver_state *state, pic_value obj);
@ -905,14 +905,14 @@ resolve_reference_node(resolver_state *state, pic_value obj)
} }
pop_resolver_scope(state); pop_resolver_scope(state);
return pic_list(pic, 6, pic_symbol_value(pic->sLAMBDA), args, locals, pic_bool_value(varg), closes, body); return pic_list6(pic, pic_symbol_value(pic->sLAMBDA), args, locals, pic_bool_value(varg), closes, body);
} }
else if (tag == pic->sQUOTE) { else if (tag == pic->sQUOTE) {
return obj; return obj;
} }
else { else {
int ai = pic_gc_arena_preserve(pic); int ai = pic_gc_arena_preserve(pic);
pic_value seq = pic_list(pic, 1, pic_symbol_value(tag)), elt; pic_value seq = pic_list1(pic, pic_symbol_value(tag)), elt;
pic_for_each (elt, pic_cdr(pic, obj)) { pic_for_each (elt, pic_cdr(pic, obj)) {
seq = pic_cons(pic, resolve_reference(state, elt), seq); seq = pic_cons(pic, resolve_reference(state, elt), seq);

2
src/cont.c
View File

@ -257,7 +257,7 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
pic_proc_cv_init(pic, c, 1); pic_proc_cv_init(pic, c, 1);
pic_proc_cv_set(pic, c, 0, pic_obj_value(cont)); pic_proc_cv_set(pic, c, 0, pic_obj_value(cont));
return pic_trampoline(pic, proc, pic_list(pic, 1, pic_obj_value(c))); return pic_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
} }
} }

2
src/error.c
View File

@ -149,7 +149,7 @@ pic_error_raise(pic_state *pic)
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR); e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
e->type = PIC_ERROR_RAISED; e->type = PIC_ERROR_RAISED;
e->msg = pic_str_new_cstr(pic, "raised"); e->msg = pic_str_new_cstr(pic, "raised");
e->irrs = pic_list(pic, 1, v); e->irrs = pic_list1(pic, v);
pic_raise(pic, e); pic_raise(pic, e);
} }

2
src/macro.c
View File

@ -615,7 +615,7 @@ pic_macro_include(pic_state *pic)
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
/* FIXME unhygienic */ /* FIXME unhygienic */
body = pic_list(pic, 1, pic_symbol_value(pic->sBEGIN)); body = pic_list1(pic, pic_symbol_value(pic->sBEGIN));
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
const char *filename; const char *filename;

75
src/pair.c
View File

@ -58,25 +58,74 @@ pic_list_p(pic_state *pic, pic_value obj)
} }
pic_value pic_value
pic_list(pic_state *pic, size_t c, ...) pic_list1(pic_state *pic, pic_value obj1)
{
return pic_cons(pic, obj1, pic_nil_value());
}
pic_value
pic_list2(pic_state *pic, pic_value obj1, pic_value obj2)
{ {
int ai = pic_gc_arena_preserve(pic); int ai = pic_gc_arena_preserve(pic);
va_list ap; pic_value val;
pic_value v;
va_start(ap, c); val = pic_cons(pic, obj1, pic_list1(pic, obj2));
v = pic_nil_value();
while (c--) {
v = pic_cons(pic, va_arg(ap, pic_value), v);
}
va_end(ap);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v); pic_gc_protect(pic, val);
return val;
}
return pic_reverse(pic, v); pic_value
pic_list3(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3)
{
int ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list2(pic, obj2, obj3));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
pic_value
pic_list4(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3, pic_value obj4)
{
int ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list3(pic, obj2, obj3, obj4));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
pic_value
pic_list5(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3, pic_value obj4, pic_value obj5)
{
int ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list4(pic, obj2, obj3, obj4, obj5));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
}
pic_value
pic_list6(pic_state *pic, pic_value obj1, pic_value obj2, pic_value obj3, pic_value obj4, pic_value obj5, pic_value obj6)
{
int ai = pic_gc_arena_preserve(pic);
pic_value val;
val = pic_cons(pic, obj1, pic_list5(pic, obj2, obj3, obj4, obj5, obj6));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, val);
return val;
} }
pic_value pic_value