From c357a9302d8f5ceb85d7384026d1d9149229369f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 1 Mar 2014 20:46:08 +0900 Subject: [PATCH] remove pic_list, and add pic_listn --- include/picrin/pair.h | 7 +++- src/codegen.c | 80 +++++++++++++++++++++---------------------- src/cont.c | 2 +- src/error.c | 2 +- src/macro.c | 2 +- src/pair.c | 75 +++++++++++++++++++++++++++++++++------- 6 files changed, 111 insertions(+), 57 deletions(-) diff --git a/include/picrin/pair.h b/include/picrin/pair.h index be8b8268..8db722d6 100644 --- a/include/picrin/pair.h +++ b/include/picrin/pair.h @@ -23,7 +23,12 @@ pic_value pic_car(pic_state *, pic_value); pic_value pic_cdr(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_make_list(pic_state *, int, pic_value); diff --git a/src/codegen.c b/src/codegen.c index 5262e088..4f273cf7 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -248,10 +248,10 @@ define_var(analyze_state *state, pic_sym sym) static pic_value new_ref(analyze_state *state, int depth, pic_sym sym) { - return pic_list(state->pic, 3, - pic_symbol_value(state->sREF), - pic_int_value(depth), - pic_symbol_value(sym)); + return pic_list3(state->pic, + pic_symbol_value(state->sREF), + pic_int_value(depth), + pic_symbol_value(sym)); } 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 */ } 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)); - return pic_list(pic, 3, - pic_symbol_value(pic->sSETBANG), - analyze(state, var, false), - analyze(state, val, false)); + return pic_list3(pic, + pic_symbol_value(pic->sSETBANG), + analyze(state, var, false), + analyze(state, val, false)); } else if (sym == pic->sLAMBDA) { 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_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) { pic_value seq; @@ -376,7 +376,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) case 2: return analyze(state, pic_list_ref(pic, obj, 1), tailpos); 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)) { if (pic_nil_p(pic_cdr(pic, obj))) { tail = tailpos; @@ -402,10 +402,10 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) val = pic_list_ref(pic, obj, 2); - return pic_list(pic, 3, - pic_symbol_value(pic->sSETBANG), - analyze(state, var, false), - analyze(state, val, false)); + return pic_list3(pic, + pic_symbol_value(pic->sSETBANG), + analyze(state, var, false), + analyze(state, val, false)); } else if (sym == pic->sQUOTE) { if (pic_length(pic, obj) != 2) { @@ -421,15 +421,15 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) } while (0) #define CONSTRUCT_OP1(op) \ - pic_list(pic, 2, \ - pic_symbol_value(op), \ - analyze(state, pic_list_ref(pic, obj, 1), false)) + pic_list2(pic, \ + pic_symbol_value(op), \ + analyze(state, pic_list_ref(pic, obj, 1), false)) #define CONSTRUCT_OP2(op) \ - pic_list(pic, 3, \ - pic_symbol_value(op), \ - analyze(state, pic_list_ref(pic, obj, 1), false), \ - analyze(state, pic_list_ref(pic, obj, 2), false)) + pic_list3(pic, \ + pic_symbol_value(op), \ + 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); @@ -457,8 +457,8 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) #define FOLD_ARGS(sym) do { \ obj = analyze(state, pic_car(pic, args), false); \ pic_for_each (arg, pic_cdr(pic, args)) { \ - obj = pic_list(pic, 3, pic_symbol_value(sym), obj, \ - analyze(state, arg, false)); \ + obj = pic_list3(pic, pic_symbol_value(sym), obj, \ + analyze(state, arg, false)); \ } \ } while (0) @@ -483,8 +483,8 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) 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)); + return pic_list2(pic, 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); @@ -513,7 +513,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) 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)); + obj = pic_list3(pic, proc, pic_float_value(1), pic_car(pic, args)); return analyze(state, obj, tailpos); default: 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) { 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)) { 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); 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); @@ -581,7 +581,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) case PIC_TT_STRING: case PIC_TT_VECTOR: 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_ENV: @@ -614,7 +614,7 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos) } else { 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) { seq = pic_cons(pic, analyze(state, elt, false), seq); } @@ -677,7 +677,7 @@ analyze_lambda(analyze_state *state, pic_value obj) } 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_protect(pic, obj); return obj; @@ -814,7 +814,7 @@ resolve_gref(resolver_state *state, pic_sym sym) } 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 @@ -825,7 +825,7 @@ resolve_lref(resolver_state *state, pic_sym sym) 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 @@ -842,10 +842,10 @@ resolve_cref(resolver_state *state, int depth, pic_sym sym) i = xh_get_int(scope->cvs, sym)->val; - return pic_list(pic, 3, - pic_symbol_value(state->sCREF), - pic_int_value(depth), - pic_int_value(i)); + return pic_list3(pic, + pic_symbol_value(state->sCREF), + pic_int_value(depth), + pic_int_value(i)); } 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); - 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) { return obj; } else { 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)) { seq = pic_cons(pic, resolve_reference(state, elt), seq); diff --git a/src/cont.c b/src/cont.c index 9e77a1f0..30b8f860 100644 --- a/src/cont.c +++ b/src/cont.c @@ -257,7 +257,7 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc) pic_proc_cv_init(pic, c, 1); 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))); } } diff --git a/src/error.c b/src/error.c index 0522bc1b..9e2fda30 100644 --- a/src/error.c +++ b/src/error.c @@ -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->type = PIC_ERROR_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); } diff --git a/src/macro.c b/src/macro.c index 181db2af..3b24e64c 100644 --- a/src/macro.c +++ b/src/macro.c @@ -615,7 +615,7 @@ pic_macro_include(pic_state *pic) pic_get_args(pic, "*", &argc, &argv); /* 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) { const char *filename; diff --git a/src/pair.c b/src/pair.c index e461ba70..1b993722 100644 --- a/src/pair.c +++ b/src/pair.c @@ -58,25 +58,74 @@ pic_list_p(pic_state *pic, pic_value obj) } 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); - va_list ap; - pic_value v; + pic_value val; - va_start(ap, c); - - v = pic_nil_value(); - while (c--) { - v = pic_cons(pic, va_arg(ap, pic_value), v); - } - - va_end(ap); + val = pic_cons(pic, obj1, pic_list1(pic, obj2)); 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