implement vector-map, vector-for-each, string-map, string-for-each

This commit is contained in:
Yuichi Nishiwaki 2014-09-19 18:16:28 +09:00
parent 1ff327b11f
commit 0c67a4b77f
2 changed files with 135 additions and 0 deletions

View File

@ -433,6 +433,76 @@ pic_str_string_fill_ip(pic_state *pic)
return pic_none_value();
}
static pic_value
pic_str_string_map(pic_state *pic)
{
struct pic_proc *proc;
size_t argc, i, len, j;
pic_value *argv, vals, val;
pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], str);
len = len < pic_strlen(pic_str_ptr(argv[i]))
? len
: pic_strlen(pic_str_ptr(argv[i]));
}
if (len == SIZE_MAX) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero");
}
else {
char buf[len];
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
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(pic, proc, vals);
pic_assert_type(pic, val, char);
buf[i] = pic_char(val);
}
return pic_obj_value(pic_make_str(pic, buf, len));
}
}
static pic_value
pic_str_string_for_each(pic_state *pic)
{
struct pic_proc *proc;
size_t argc, i, len, j;
pic_value *argv, vals, val;
pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], str);
len = len < pic_strlen(pic_str_ptr(argv[i]))
? len
: pic_strlen(pic_str_ptr(argv[i]));
}
if (len == SIZE_MAX) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero");
}
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
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(pic, proc, vals);
}
return pic_none_value();
}
static pic_value
pic_str_list_to_string(pic_state *pic)
{
@ -490,6 +560,8 @@ pic_init_str(pic_state *pic)
pic_defun(pic, "string-copy!", pic_str_string_copy_ip);
pic_defun(pic, "string-append", pic_str_string_append);
pic_defun(pic, "string-fill!", pic_str_string_fill_ip);
pic_defun(pic, "string-map", pic_str_string_map);
pic_defun(pic, "string-for-each", pic_str_string_for_each);
pic_defun(pic, "list->string", pic_str_list_to_string);
pic_defun(pic, "string->list", pic_str_string_to_list);

View File

@ -231,6 +231,67 @@ pic_vec_vector_fill_i(pic_state *pic)
return pic_none_value();
}
static pic_value
pic_vec_vector_map(pic_state *pic)
{
struct pic_proc *proc;
size_t argc, i, len, j;
pic_value *argv, vals;
pic_vec *vec;
pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec);
len = len < pic_vec_ptr(argv[i])->len
? len
: pic_vec_ptr(argv[i])->len;
}
vec = pic_make_vec(pic, len);
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals);
}
vec->data[i] = pic_apply(pic, proc, vals);
}
return pic_obj_value(vec);
}
static pic_value
pic_vec_vector_for_each(pic_state *pic)
{
struct pic_proc *proc;
size_t argc, i, len, j;
pic_value *argv, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec);
len = len < pic_vec_ptr(argv[i])->len
? len
: pic_vec_ptr(argv[i])->len;
}
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals);
}
pic_apply(pic, proc, vals);
}
return pic_none_value();
}
static pic_value
pic_vec_list_to_vector(pic_state *pic)
{
@ -341,6 +402,8 @@ pic_init_vector(pic_state *pic)
pic_defun(pic, "vector-copy", pic_vec_vector_copy);
pic_defun(pic, "vector-append", pic_vec_vector_append);
pic_defun(pic, "vector-fill!", pic_vec_vector_fill_i);
pic_defun(pic, "vector-map", pic_vec_vector_map);
pic_defun(pic, "vector-for-each", pic_vec_vector_for_each);
pic_defun(pic, "list->vector", pic_vec_list_to_vector);
pic_defun(pic, "vector->list", pic_vec_vector_to_list);
pic_defun(pic, "string->vector", pic_vec_string_to_vector);