From 8814469eac246eef08887716408044b2e5453ffa Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 14 Feb 2016 17:14:33 +0900 Subject: [PATCH] pic_apply_trampoline -> pic_applyk --- contrib/10.callcc/callcc.c | 4 +- extlib/benz/cont.c | 2 +- extlib/benz/include/picrin.h | 4 +- extlib/benz/pair.c | 20 ++++---- extlib/benz/proc.c | 91 ++++++++++++------------------------ extlib/benz/string.c | 4 +- extlib/benz/vector.c | 4 +- 7 files changed, 50 insertions(+), 79 deletions(-) diff --git a/contrib/10.callcc/callcc.c b/contrib/10.callcc/callcc.c index 6ba305ca..60347935 100644 --- a/contrib/10.callcc/callcc.c +++ b/contrib/10.callcc/callcc.c @@ -273,6 +273,7 @@ pic_callcc_callcc(pic_state *pic) else { struct pic_proc *c; struct pic_data *dat; + pic_value args[1]; c = pic_make_proc(pic, cont_call); @@ -281,7 +282,8 @@ pic_callcc_callcc(pic_state *pic) /* save the continuation object in proc */ pic_proc_env_set(pic, c, "cont", pic_obj_value(dat)); - return pic_apply_trampoline_list(pic, proc, pic_list1(pic, pic_obj_value(c))); + args[0] = pic_obj_value(c); + return pic_applyk(pic, proc, 1, args); } } diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 16f7bf04..5966a904 100644 --- a/extlib/benz/cont.c +++ b/extlib/benz/cont.c @@ -300,7 +300,7 @@ pic_cont_call_with_values(pic_state *pic) pic_receive(pic, argc, args->data); - return pic_apply_trampoline(pic, consumer, argc, args->data); + return pic_applyk(pic, consumer, argc, args->data); } void diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 456beef1..adabd21e 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -164,9 +164,7 @@ PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); pic_value pic_call(pic_state *, struct pic_proc *, int, ...); pic_value pic_vcall(pic_state *, struct pic_proc *, int, va_list); pic_value pic_apply(pic_state *, struct pic_proc *, int, pic_value *); -pic_value pic_apply_list(pic_state *, struct pic_proc *, pic_value); -pic_value pic_apply_trampoline(pic_state *, struct pic_proc *, int, pic_value *); -pic_value pic_apply_trampoline_list(pic_state *, struct pic_proc *, pic_value); +pic_value pic_applyk(pic_state *, struct pic_proc *, int, pic_value *); pic_value pic_eval(pic_state *, pic_value, struct pic_lib *); diff --git a/extlib/benz/pair.c b/extlib/benz/pair.c index 66d5b073..09138a80 100644 --- a/extlib/benz/pair.c +++ b/extlib/benz/pair.c @@ -639,29 +639,29 @@ pic_pair_map(pic_state *pic) { struct pic_proc *proc; int argc, i; - pic_value *args; - pic_value arg, ret; + pic_value *args, *arg_list, ret; pic_get_args(pic, "l*", &proc, &argc, &args); if (argc == 0) pic_errorf(pic, "map: wrong number of arguments (1 for at least 2)"); + arg_list = pic_alloca(pic, sizeof(pic_value) * argc); + ret = pic_nil_value(); do { - arg = pic_nil_value(); for (i = 0; i < argc; ++i) { if (! pic_pair_p(args[i])) { break; } - pic_push(pic, pic_car(pic, args[i]), arg); + arg_list[i] = pic_car(pic, args[i]); args[i] = pic_cdr(pic, args[i]); } if (i != argc) { break; } - pic_push(pic, pic_apply_list(pic, proc, pic_reverse(pic, arg)), ret); + pic_push(pic, pic_apply(pic, proc, i, arg_list), ret); } while (1); return pic_reverse(pic, ret); @@ -672,24 +672,24 @@ pic_pair_for_each(pic_state *pic) { struct pic_proc *proc; int argc, i; - pic_value *args; - pic_value arg; + pic_value *args, *arg_list; pic_get_args(pic, "l*", &proc, &argc, &args); + arg_list = pic_alloca(pic, sizeof(pic_value) * argc); + do { - arg = pic_nil_value(); for (i = 0; i < argc; ++i) { if (! pic_pair_p(args[i])) { break; } - pic_push(pic, pic_car(pic, args[i]), arg); + arg_list[i] = pic_car(pic, args[i]); args[i] = pic_cdr(pic, args[i]); } if (i != argc) { break; } - pic_apply_list(pic, proc, pic_reverse(pic, arg)); + pic_apply(pic, proc, i, arg_list); } while (1); return pic_undef_value(); diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c index 1a1dad59..935a876f 100644 --- a/extlib/benz/proc.c +++ b/extlib/benz/proc.c @@ -784,49 +784,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) } pic_value -pic_call(pic_state *pic, struct pic_proc *proc, int n, ...) -{ - pic_value r; - va_list ap; - - va_start(ap, n); - r = pic_vcall(pic, proc, n, ap); - va_end(ap); - return r; -} - -pic_value -pic_vcall(pic_state *pic, struct pic_proc *proc, int n, va_list ap) -{ - pic_value *args = pic_alloca(pic, sizeof(pic_value) * n); - int i; - - for (i = 0; i < n; ++i) { - args[i] = va_arg(ap, pic_value); - } - return pic_apply(pic, proc, n, args); -} - -pic_value -pic_apply_list(pic_state *pic, struct pic_proc *proc, pic_value list) -{ - int n, i = 0; - pic_vec *args; - pic_value x, it; - - n = pic_length(pic, list); - - args = pic_make_vec(pic, n); - - pic_for_each (x, list, it) { - args->data[i++] = x; - } - - return pic_apply(pic, proc, n, args->data); -} - -pic_value -pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args) +pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args) { pic_value *sp; pic_callinfo *ci; @@ -855,18 +813,27 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, int argc, pic_value } pic_value -pic_apply_trampoline_list(pic_state *pic, struct pic_proc *proc, pic_value args) +pic_call(pic_state *pic, struct pic_proc *proc, int n, ...) { - int i, argc = pic_length(pic, args); - pic_value val, it; - pic_vec *argv = pic_make_vec(pic, argc); + pic_value r; + va_list ap; - i = 0; - pic_for_each (val, args, it) { - argv->data[i++] = val; + va_start(ap, n); + r = pic_vcall(pic, proc, n, ap); + va_end(ap); + return r; +} + +pic_value +pic_vcall(pic_state *pic, struct pic_proc *proc, int n, va_list ap) +{ + pic_value *args = pic_alloca(pic, sizeof(pic_value) * n); + int i; + + for (i = 0; i < n; ++i) { + args[i] = va_arg(ap, pic_value); } - - return pic_apply_trampoline(pic, proc, argc, argv->data); + return pic_apply(pic, proc, n, args); } void @@ -1043,9 +1010,8 @@ static pic_value pic_proc_apply(pic_state *pic) { struct pic_proc *proc; - pic_value *args; - int argc; - pic_value arg_list; + pic_value *args, *arg_list; + int argc, n, i; pic_get_args(pic, "l*", &proc, &argc, &args); @@ -1053,12 +1019,17 @@ pic_proc_apply(pic_state *pic) pic_errorf(pic, "apply: wrong number of arguments"); } - arg_list = args[--argc]; - while (argc--) { - arg_list = pic_cons(pic, args[argc], arg_list); - } + n = argc - 1 + pic_length(pic, args[argc - 1]); - return pic_apply_trampoline_list(pic, proc, arg_list); + arg_list = pic_alloca(pic, sizeof(pic_value) * n); + for (i = 0; i < argc - 1; ++i) { + arg_list[i] = args[i]; + } + while (i < n) { + arg_list[i] = pic_list_ref(pic, args[argc - 1], i - argc + 1); + i++; + } + return pic_applyk(pic, proc, n, arg_list); } void diff --git a/extlib/benz/string.c b/extlib/benz/string.c index fb3d3ae9..dc5dcb9e 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -578,7 +578,7 @@ pic_str_string_map(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } - val = pic_apply_list(pic, proc, vals); + val = pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); pic_assert_type(pic, val, char); buf[i] = pic_char(val); @@ -623,7 +623,7 @@ pic_str_string_for_each(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } - pic_apply_list(pic, proc, vals); + pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); } return pic_undef_value(); diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index c06d0023..09ed95fb 100644 --- a/extlib/benz/vector.c +++ b/extlib/benz/vector.c @@ -240,7 +240,7 @@ pic_vec_vector_map(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } - vec->data[i] = pic_apply_list(pic, proc, vals); + vec->data[i] = pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); } return pic_obj_value(vec); @@ -269,7 +269,7 @@ pic_vec_vector_for_each(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } - pic_apply_list(pic, proc, vals); + pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); } return pic_undef_value();