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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
contrib/10.callcc/callcc.c
View File

@ -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);
}
}

2
extlib/benz/cont.c
View File

@ -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

4
extlib/benz/include/picrin.h
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_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 *);

20
extlib/benz/pair.c
View File

@ -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();

89
extlib/benz/proc.c
View File

@ -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;
}
return pic_apply_trampoline(pic, proc, argc, argv->data);
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);
}
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

4
extlib/benz/string.c
View File

@ -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();

4
extlib/benz/vector.c
View File

@ -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();