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

move map/for-each to pair.c

This commit is contained in:
Yuichi Nishiwaki 2014-09-13 18:51:20 +09:00
parent 391b597dc6
commit b20a97ed9f
2 changed files with 59 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
pair.c
View File

@ -667,6 +667,63 @@ pic_pair_list_copy(pic_state *pic)
return pic_list_copy(pic, obj);
}
static pic_value
pic_pair_map(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value *args;
int i;
pic_value cars, ret;
pic_get_args(pic, "l*", &proc, &argc, &args);
ret = pic_nil_value();
do {
cars = pic_nil_value();
for (i = argc - 1; i >= 0; --i) {
if (! pic_pair_p(args[i])) {
break;
}
cars = pic_cons(pic, pic_car(pic, args[i]), cars);
args[i] = pic_cdr(pic, args[i]);
}
if (i >= 0)
break;
ret = pic_cons(pic, pic_apply(pic, proc, cars), ret);
} while (1);
return pic_reverse(pic, ret);
}
static pic_value
pic_pair_for_each(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value *args;
int i;
pic_value cars;
pic_get_args(pic, "l*", &proc, &argc, &args);
do {
cars = pic_nil_value();
for (i = argc - 1; i >= 0; --i) {
if (! pic_pair_p(args[i])) {
break;
}
cars = pic_cons(pic, pic_car(pic, args[i]), cars);
args[i] = pic_cdr(pic, args[i]);
}
if (i >= 0)
break;
pic_apply(pic, proc, cars);
} while (1);
return pic_none_value();
}
static pic_value
pic_pair_memq(pic_state *pic)
{
@ -754,6 +811,8 @@ pic_init_pair(pic_state *pic)
pic_defun(pic, "list-ref", pic_pair_list_ref);
pic_defun(pic, "list-set!", pic_pair_list_set);
pic_defun(pic, "list-copy", pic_pair_list_copy);
pic_defun(pic, "map", pic_pair_map);
pic_defun(pic, "for-each", pic_pair_for_each);
pic_defun(pic, "memq", pic_pair_memq);
pic_defun(pic, "memv", pic_pair_memv);
pic_defun(pic, "member", pic_pair_member);

59
proc.c
View File

@ -102,63 +102,6 @@ pic_proc_apply(pic_state *pic)
return pic_apply_trampoline(pic, proc, arg_list);
}
static pic_value
pic_proc_map(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value *args;
int i;
pic_value cars, ret;
pic_get_args(pic, "l*", &proc, &argc, &args);
ret = pic_nil_value();
do {
cars = pic_nil_value();
for (i = argc - 1; i >= 0; --i) {
if (! pic_pair_p(args[i])) {
break;
}
cars = pic_cons(pic, pic_car(pic, args[i]), cars);
args[i] = pic_cdr(pic, args[i]);
}
if (i >= 0)
break;
ret = pic_cons(pic, pic_apply(pic, proc, cars), ret);
} while (1);
return pic_reverse(pic, ret);
}
static pic_value
pic_proc_for_each(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value *args;
int i;
pic_value cars;
pic_get_args(pic, "l*", &proc, &argc, &args);
do {
cars = pic_nil_value();
for (i = argc - 1; i >= 0; --i) {
if (! pic_pair_p(args[i])) {
break;
}
cars = pic_cons(pic, pic_car(pic, args[i]), cars);
args[i] = pic_cdr(pic, args[i]);
}
if (i >= 0)
break;
pic_apply(pic, proc, cars);
} while (1);
return pic_none_value();
}
static pic_value
pic_proc_attribute(pic_state *pic)
{
@ -174,8 +117,6 @@ pic_init_proc(pic_state *pic)
{
pic_defun(pic, "procedure?", pic_proc_proc_p);
pic_defun(pic, "apply", pic_proc_apply);
pic_defun(pic, "map", pic_proc_map);
pic_defun(pic, "for-each", pic_proc_for_each);
pic_defun(pic, "attribute", pic_proc_attribute);
}