picrin/extlib/benz/vector.c

414 lines
8.2 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
2016-02-20 10:58:58 -05:00
#include "picrin/extra.h"
2016-02-20 11:13:16 -05:00
#include "picrin/private/object.h"
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
pic_value
2016-02-19 03:38:49 -05:00
pic_make_vec(pic_state *pic, int len, pic_value *argv)
2014-08-25 00:38:09 -04:00
{
2016-02-21 06:32:00 -05:00
struct vector *vec;
2015-08-26 06:04:27 -04:00
int i;
2014-08-25 00:38:09 -04:00
2016-02-21 06:32:00 -05:00
vec = (struct vector *)pic_obj_alloc(pic, sizeof(struct vector), PIC_TYPE_VECTOR);
2014-08-25 00:38:09 -04:00
vec->len = len;
2015-05-28 03:42:16 -04:00
vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len);
2016-02-19 03:38:49 -05:00
if (argv == NULL) {
for (i = 0; i < len; ++i) {
vec->data[i] = pic_undef_value(pic);
}
} else {
memcpy(vec->data, argv, sizeof(pic_value) * len);
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
return pic_obj_value(vec);
}
pic_value
2016-02-21 05:19:35 -05:00
pic_vec_ref(pic_state *PIC_UNUSED(pic), pic_value vec, int k)
2016-02-19 07:56:45 -05:00
{
return pic_vec_ptr(pic, vec)->data[k];
}
void
2016-02-21 05:19:35 -05:00
pic_vec_set(pic_state *PIC_UNUSED(pic), pic_value vec, int k, pic_value val)
2016-02-19 07:56:45 -05:00
{
pic_vec_ptr(pic, vec)->data[k] = val;
}
int
2016-02-21 05:19:35 -05:00
pic_vec_len(pic_state *PIC_UNUSED(pic), pic_value vec)
2016-02-19 07:56:45 -05:00
{
return pic_vec_ptr(pic, vec)->len;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic, pic_vec_p(pic, v));
2014-08-25 00:38:09 -04:00
}
2014-09-12 07:55:34 -04:00
static pic_value
pic_vec_vector(pic_state *pic)
{
2016-02-19 03:38:49 -05:00
int argc;
2014-09-12 07:55:34 -04:00
pic_value *argv;
pic_get_args(pic, "*", &argc, &argv);
2016-02-19 07:56:45 -05:00
return pic_make_vec(pic, argc, argv);
2014-09-12 07:55:34 -04:00
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_vec_make_vector(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value vec, init;
2015-08-26 06:04:27 -04:00
int n, k, i;
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
n = pic_get_args(pic, "i|o", &k, &init);
if (k < 0) {
2016-02-22 14:03:42 -05:00
pic_error(pic, "make-vector: negative length given", 1, pic_int_value(pic, k));
2016-02-19 07:56:45 -05:00
}
2014-08-25 00:38:09 -04:00
2016-02-19 03:38:49 -05:00
vec = pic_make_vec(pic, k, NULL);
2014-08-25 00:38:09 -04:00
if (n == 2) {
2014-09-27 05:10:14 -04:00
for (i = 0; i < k; ++i) {
2016-02-19 07:56:45 -05:00
pic_vec_set(pic, vec, i, init);
2014-08-25 00:38:09 -04:00
}
}
2016-02-19 07:56:45 -05:00
return vec;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_length(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value v;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "v", &v);
2016-02-19 07:56:45 -05:00
return pic_int_value(pic, pic_vec_len(pic, v));
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_ref(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value v;
2015-08-26 06:04:27 -04:00
int k;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
pic_get_args(pic, "vi", &v, &k);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
VALID_INDEX(pic, pic_vec_len(pic, v), k);
return pic_vec_ref(pic, v, k);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_set(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value v, o;
2015-08-26 06:04:27 -04:00
int k;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
pic_get_args(pic, "vio", &v, &k, &o);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
VALID_INDEX(pic, pic_vec_len(pic, v), k);
pic_vec_set(pic, v, k, o);
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_copy_i(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value to, from;
int n, at, start, end, tolen, fromlen;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "viv|ii", &to, &at, &from, &start, &end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
tolen = pic_vec_len(pic, to);
fromlen = pic_vec_len(pic, from);
2014-08-25 00:38:09 -04:00
switch (n) {
case 3:
start = 0;
case 4:
2016-02-19 07:56:45 -05:00
end = fromlen;
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
VALID_ATRANGE(pic, tolen, at, fromlen, start, end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
memmove(pic_vec_ptr(pic, to)->data + at, pic_vec_ptr(pic, from)->data + start, sizeof(pic_value) * (end - start));
2014-08-25 00:38:09 -04:00
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_copy(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value from;
int n, start, end, fromlen;
2014-08-25 00:38:09 -04:00
2016-02-19 03:38:49 -05:00
n = pic_get_args(pic, "v|ii", &from, &start, &end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
fromlen = pic_vec_len(pic, from);
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
start = 0;
case 2:
2016-02-19 07:56:45 -05:00
end = fromlen;
}
2016-02-19 07:56:45 -05:00
VALID_RANGE(pic, fromlen, start, end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
return pic_make_vec(pic, end - start, pic_vec_ptr(pic, from)->data + start);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_append(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value *argv, vec;
int argc, i, len;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "*", &argc, &argv);
len = 0;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec);
2016-02-19 07:56:45 -05:00
len += pic_vec_len(pic, argv[i]);
2014-08-25 00:38:09 -04:00
}
2016-02-19 03:38:49 -05:00
vec = pic_make_vec(pic, len, NULL);
2014-08-25 00:38:09 -04:00
len = 0;
for (i = 0; i < argc; ++i) {
2016-02-19 07:56:45 -05:00
int l = pic_vec_len(pic, argv[i]);
memcpy(pic_vec_ptr(pic, vec)->data + len, pic_vec_ptr(pic, argv[i])->data, sizeof(pic_value) * l);
len += l;
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
return vec;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_fill_i(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value vec, obj;
int n, start, end, len;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "vo|ii", &vec, &obj, &start, &end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
len = pic_vec_len(pic, vec);
2014-08-25 00:38:09 -04:00
switch (n) {
case 2:
start = 0;
case 3:
2016-02-19 07:56:45 -05:00
end = len;
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
VALID_RANGE(pic, len, start, end);
2014-08-25 00:38:09 -04:00
while (start < end) {
2016-02-19 07:56:45 -05:00
pic_vec_set(pic, vec, start++, obj);
2014-08-25 00:38:09 -04:00
}
return pic_undef_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_map(pic_state *pic)
{
2015-08-26 06:04:27 -04:00
int argc, i, len, j;
2016-02-19 10:03:16 -05:00
pic_value proc, *argv, vec, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
2016-02-19 07:56:45 -05:00
if (argc == 0) {
2016-02-22 14:03:42 -05:00
pic_error(pic, "vector-map: wrong number of arguments (1 for at least 2)", 0);
2016-02-19 07:56:45 -05:00
}
len = INT_MAX;
2014-09-27 07:17:02 -04:00
for (i = 0; i < argc; ++i) {
2016-02-19 07:56:45 -05:00
int l;
pic_assert_type(pic, argv[i], vec);
2016-02-19 07:56:45 -05:00
l = pic_vec_len(pic, argv[i]);
len = len < l ? len : l;
}
2016-02-19 03:38:49 -05:00
vec = pic_make_vec(pic, len, NULL);
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
2014-09-27 07:17:02 -04:00
for (j = 0; j < argc; ++j) {
2016-02-19 07:56:45 -05:00
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
2016-02-19 13:26:52 -05:00
vals = pic_reverse(pic, vals);
2016-02-19 10:03:16 -05:00
pic_vec_set(pic, vec, i, pic_funcall(pic, "picrin.base", "apply", 2, proc, vals));
}
2016-02-19 07:56:45 -05:00
return vec;
}
static pic_value
pic_vec_vector_for_each(pic_state *pic)
{
2015-08-26 06:04:27 -04:00
int argc, i, len, j;
2016-02-19 10:03:16 -05:00
pic_value proc, *argv, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
2016-02-19 07:56:45 -05:00
if (argc == 0) {
2016-02-22 14:03:42 -05:00
pic_error(pic, "vector-for-each: wrong number of arguments (1 for at least 2)", 0);
2016-02-19 07:56:45 -05:00
}
len = INT_MAX;
2014-09-27 07:17:02 -04:00
for (i = 0; i < argc; ++i) {
2016-02-19 07:56:45 -05:00
int l;
pic_assert_type(pic, argv[i], vec);
2016-02-19 07:56:45 -05:00
l = pic_vec_len(pic, argv[i]);
len = len < l ? len : l;
}
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
2014-09-27 07:17:02 -04:00
for (j = 0; j < argc; ++j) {
2016-02-19 07:56:45 -05:00
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
2016-02-19 13:26:52 -05:00
vals = pic_reverse(pic, vals);
2016-02-19 10:03:16 -05:00
pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
}
return pic_undef_value(pic);
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_vec_list_to_vector(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value list, vec, e, it;
int len, i = 0;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "o", &list);
2016-02-19 07:56:45 -05:00
len = pic_length(pic, list);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
vec = pic_make_vec(pic, len, NULL);
2015-01-22 05:28:31 -05:00
pic_for_each (e, list, it) {
2016-02-19 07:56:45 -05:00
pic_vec_set(pic, vec, i++, e);
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
return vec;
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_vec_vector_to_list(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value vec;
2014-08-25 00:38:09 -04:00
pic_value list;
2016-02-19 07:56:45 -05:00
int n, start, end, i, len;
2014-08-25 00:38:09 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
len = pic_vec_len(pic, vec);
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
start = 0;
case 2:
2016-02-19 07:56:45 -05:00
end = len;
2014-08-25 00:38:09 -04:00
}
2016-02-19 07:56:45 -05:00
VALID_RANGE(pic, len, start, end);
2014-08-25 00:38:09 -04:00
2016-02-19 07:56:45 -05:00
list = pic_nil_value(pic);
2014-08-25 00:38:09 -04:00
for (i = start; i < end; ++i) {
2016-02-19 07:56:45 -05:00
pic_push(pic, pic_vec_ref(pic, vec, i), list);
2014-08-25 00:38:09 -04:00
}
return pic_reverse(pic, list);
}
2014-09-12 07:51:36 -04:00
static pic_value
pic_vec_vector_to_string(pic_state *pic)
{
2016-02-19 07:56:45 -05:00
pic_value vec, t;
2014-09-12 07:51:36 -04:00
char *buf;
2016-02-19 07:56:45 -05:00
int n, start, end, i, len;
2014-09-12 07:51:36 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
2014-09-12 07:51:36 -04:00
2016-02-19 07:56:45 -05:00
len = pic_vec_len(pic, vec);
2014-09-12 07:51:36 -04:00
switch (n) {
case 1:
start = 0;
case 2:
2016-02-19 07:56:45 -05:00
end = len;
}
2016-02-19 07:56:45 -05:00
VALID_RANGE(pic, len, start, end);
2014-09-12 07:51:36 -04:00
2016-02-19 13:26:52 -05:00
buf = pic_alloca(pic, end - start);
2014-09-12 07:51:36 -04:00
for (i = start; i < end; ++i) {
2016-02-19 07:56:45 -05:00
t = pic_vec_ref(pic, vec, i);
2014-09-12 07:51:36 -04:00
2016-02-19 07:56:45 -05:00
pic_assert_type(pic, t, char);
buf[i - start] = pic_char(pic, t);
2014-09-12 07:51:36 -04:00
}
2016-02-19 13:26:52 -05:00
return pic_str_value(pic, buf, end - start);
2014-09-12 07:51:36 -04:00
}
static pic_value
pic_vec_string_to_vector(pic_state *pic)
{
2016-02-19 13:26:52 -05:00
pic_value str, vec;
int n, start, end, len, i;
2014-09-12 07:51:36 -04:00
2015-08-26 06:04:27 -04:00
n = pic_get_args(pic, "s|ii", &str, &start, &end);
2014-09-12 07:51:36 -04:00
2016-02-19 13:26:52 -05:00
len = pic_str_len(pic, str);
2014-09-12 07:51:36 -04:00
switch (n) {
case 1:
start = 0;
case 2:
2016-02-19 13:26:52 -05:00
end = len;
2014-09-12 07:51:36 -04:00
}
2016-02-19 13:26:52 -05:00
VALID_RANGE(pic, len, start, end);
2014-09-12 07:51:36 -04:00
2016-02-19 03:38:49 -05:00
vec = pic_make_vec(pic, end - start, NULL);
2014-09-27 05:10:14 -04:00
for (i = 0; i < end - start; ++i) {
2016-02-19 07:56:45 -05:00
pic_vec_set(pic, vec, i, pic_char_value(pic, pic_str_ref(pic, str, i + start)));
2014-09-12 07:51:36 -04:00
}
2016-02-19 07:56:45 -05:00
return vec;
2014-09-12 07:51:36 -04:00
}
2014-08-25 00:38:09 -04:00
void
pic_init_vector(pic_state *pic)
{
pic_defun(pic, "vector?", pic_vec_vector_p);
2014-09-12 07:55:34 -04:00
pic_defun(pic, "vector", pic_vec_vector);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "make-vector", pic_vec_make_vector);
pic_defun(pic, "vector-length", pic_vec_vector_length);
pic_defun(pic, "vector-ref", pic_vec_vector_ref);
pic_defun(pic, "vector-set!", pic_vec_vector_set);
pic_defun(pic, "vector-copy!", pic_vec_vector_copy_i);
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);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "list->vector", pic_vec_list_to_vector);
pic_defun(pic, "vector->list", pic_vec_vector_to_list);
2014-09-12 07:51:36 -04:00
pic_defun(pic, "string->vector", pic_vec_string_to_vector);
pic_defun(pic, "vector->string", pic_vec_vector_to_string);
2014-08-25 00:38:09 -04:00
}