pic_apply_trampoline -> pic_applyk

This commit is contained in:
Yuichi Nishiwaki 2016-02-14 17:14:33 +09:00
parent 2632956b6e
commit 8814469eac
7 changed files with 50 additions and 79 deletions

View File

@ -273,6 +273,7 @@ pic_callcc_callcc(pic_state *pic)
else { else {
struct pic_proc *c; struct pic_proc *c;
struct pic_data *dat; struct pic_data *dat;
pic_value args[1];
c = pic_make_proc(pic, cont_call); c = pic_make_proc(pic, cont_call);
@ -281,7 +282,8 @@ pic_callcc_callcc(pic_state *pic)
/* save the continuation object in proc */ /* save the continuation object in proc */
pic_proc_env_set(pic, c, "cont", pic_obj_value(dat)); 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);
} }
} }

View File

@ -300,7 +300,7 @@ pic_cont_call_with_values(pic_state *pic)
pic_receive(pic, argc, args->data); pic_receive(pic, argc, args->data);
return pic_apply_trampoline(pic, consumer, argc, args->data); return pic_applyk(pic, consumer, argc, args->data);
} }
void void

View File

@ -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_call(pic_state *, struct pic_proc *, int, ...);
pic_value pic_vcall(pic_state *, struct pic_proc *, int, va_list); 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(pic_state *, struct pic_proc *, int, pic_value *);
pic_value pic_apply_list(pic_state *, struct pic_proc *, pic_value); pic_value pic_applyk(pic_state *, struct pic_proc *, int, 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_eval(pic_state *, pic_value, struct pic_lib *); pic_value pic_eval(pic_state *, pic_value, struct pic_lib *);

View File

@ -639,29 +639,29 @@ pic_pair_map(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
int argc, i; int argc, i;
pic_value *args; pic_value *args, *arg_list, ret;
pic_value arg, ret;
pic_get_args(pic, "l*", &proc, &argc, &args); pic_get_args(pic, "l*", &proc, &argc, &args);
if (argc == 0) if (argc == 0)
pic_errorf(pic, "map: wrong number of arguments (1 for at least 2)"); 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(); ret = pic_nil_value();
do { do {
arg = pic_nil_value();
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
if (! pic_pair_p(args[i])) { if (! pic_pair_p(args[i])) {
break; 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]); args[i] = pic_cdr(pic, args[i]);
} }
if (i != argc) { if (i != argc) {
break; 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); } while (1);
return pic_reverse(pic, ret); return pic_reverse(pic, ret);
@ -672,24 +672,24 @@ pic_pair_for_each(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
int argc, i; int argc, i;
pic_value *args; pic_value *args, *arg_list;
pic_value arg;
pic_get_args(pic, "l*", &proc, &argc, &args); pic_get_args(pic, "l*", &proc, &argc, &args);
arg_list = pic_alloca(pic, sizeof(pic_value) * argc);
do { do {
arg = pic_nil_value();
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
if (! pic_pair_p(args[i])) { if (! pic_pair_p(args[i])) {
break; 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]); args[i] = pic_cdr(pic, args[i]);
} }
if (i != argc) { if (i != argc) {
break; break;
} }
pic_apply_list(pic, proc, pic_reverse(pic, arg)); pic_apply(pic, proc, i, arg_list);
} while (1); } while (1);
return pic_undef_value(); return pic_undef_value();

View File

@ -784,49 +784,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
} }
pic_value pic_value
pic_call(pic_state *pic, struct pic_proc *proc, int n, ...) pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args)
{
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_value *sp; pic_value *sp;
pic_callinfo *ci; pic_callinfo *ci;
@ -855,18 +813,27 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, int argc, pic_value
} }
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 r;
pic_value val, it; va_list ap;
pic_vec *argv = pic_make_vec(pic, argc);
i = 0; va_start(ap, n);
pic_for_each (val, args, it) { r = pic_vcall(pic, proc, n, ap);
argv->data[i++] = val; 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);
return pic_apply_trampoline(pic, proc, argc, argv->data);
} }
void void
@ -1043,9 +1010,8 @@ static pic_value
pic_proc_apply(pic_state *pic) pic_proc_apply(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
pic_value *args; pic_value *args, *arg_list;
int argc; int argc, n, i;
pic_value arg_list;
pic_get_args(pic, "l*", &proc, &argc, &args); 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"); pic_errorf(pic, "apply: wrong number of arguments");
} }
arg_list = args[--argc]; n = argc - 1 + pic_length(pic, args[argc - 1]);
while (argc--) {
arg_list = pic_cons(pic, args[argc], arg_list);
}
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 void

View File

@ -578,7 +578,7 @@ pic_str_string_map(pic_state *pic)
for (j = 0; j < argc; ++j) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); 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); pic_assert_type(pic, val, char);
buf[i] = pic_char(val); buf[i] = pic_char(val);
@ -623,7 +623,7 @@ pic_str_string_for_each(pic_state *pic)
for (j = 0; j < argc; ++j) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); 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(); return pic_undef_value();

View File

@ -240,7 +240,7 @@ pic_vec_vector_map(pic_state *pic)
for (j = 0; j < argc; ++j) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); 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); return pic_obj_value(vec);
@ -269,7 +269,7 @@ pic_vec_vector_for_each(pic_state *pic)
for (j = 0; j < argc; ++j) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); 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(); return pic_undef_value();