picrin/extlib/benz/vector.c

427 lines
8.0 KiB
C

/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
struct pic_vector *
pic_make_vec(pic_state *pic, size_t len)
{
struct pic_vector *vec;
size_t i;
vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TT_VECTOR);
vec->len = len;
vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len);
for (i = 0; i < len; ++i) {
vec->data[i] = pic_undef_value();
}
return vec;
}
struct pic_vector *
pic_make_vec_from_list(pic_state *pic, pic_value data)
{
struct pic_vector *vec;
size_t len, i;
len = pic_length(pic, data);
vec = pic_make_vec(pic, len);
for (i = 0; i < len; ++i) {
vec->data[i] = pic_car(pic, data);
data = pic_cdr(pic, data);
}
return vec;
}
static pic_value
pic_vec_vector_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic_vec_p(v));
}
static pic_value
pic_vec_vector(pic_state *pic)
{
size_t argc, i;
pic_value *argv;
pic_vec *vec;
pic_get_args(pic, "*", &argc, &argv);
vec = pic_make_vec(pic, (size_t)argc);
for (i = 0; i < argc; ++i) {
vec->data[i] = argv[i];
}
return pic_obj_value(vec);
}
static pic_value
pic_vec_make_vector(pic_state *pic)
{
pic_value v;
int n;
size_t k, i;
struct pic_vector *vec;
n = pic_get_args(pic, "k|o", &k, &v);
vec = pic_make_vec(pic, k);
if (n == 2) {
for (i = 0; i < k; ++i) {
vec->data[i] = v;
}
}
return pic_obj_value(vec);
}
static pic_value
pic_vec_vector_length(pic_state *pic)
{
struct pic_vector *v;
pic_get_args(pic, "v", &v);
return pic_size_value(v->len);
}
static pic_value
pic_vec_vector_ref(pic_state *pic)
{
struct pic_vector *v;
size_t k;
pic_get_args(pic, "vk", &v, &k);
if (v->len <= k) {
pic_errorf(pic, "vector-ref: index out of range");
}
return v->data[k];
}
static pic_value
pic_vec_vector_set(pic_state *pic)
{
struct pic_vector *v;
size_t k;
pic_value o;
pic_get_args(pic, "vko", &v, &k, &o);
if (v->len <= k) {
pic_errorf(pic, "vector-set!: index out of range");
}
v->data[k] = o;
return pic_undef_value();
}
static pic_value
pic_vec_vector_copy_i(pic_state *pic)
{
pic_vec *to, *from;
int n;
size_t at, start, end;
n = pic_get_args(pic, "vkv|kk", &to, &at, &from, &start, &end);
switch (n) {
case 3:
start = 0;
case 4:
end = from->len;
}
if (to == from && (start <= at && at < end)) {
/* copy in reversed order */
at += end - start;
while (start < end) {
to->data[--at] = from->data[--end];
}
return pic_undef_value();
}
while (start < end) {
to->data[at++] = from->data[start++];
}
return pic_undef_value();
}
static pic_value
pic_vec_vector_copy(pic_state *pic)
{
pic_vec *vec, *to;
int n;
size_t start, end, i = 0;
n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) {
case 1:
start = 0;
case 2:
end = vec->len;
}
if (end < start) {
pic_errorf(pic, "vector-copy: end index must not be less than start index");
}
to = pic_make_vec(pic, end - start);
while (start < end) {
to->data[i++] = vec->data[start++];
}
return pic_obj_value(to);
}
static pic_value
pic_vec_vector_append(pic_state *pic)
{
pic_value *argv;
size_t argc, i, j, len;
pic_vec *vec;
pic_get_args(pic, "*", &argc, &argv);
len = 0;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec);
len += pic_vec_ptr(argv[i])->len;
}
vec = pic_make_vec(pic, len);
len = 0;
for (i = 0; i < argc; ++i) {
for (j = 0; j < pic_vec_ptr(argv[i])->len; ++j) {
vec->data[len + j] = pic_vec_ptr(argv[i])->data[j];
}
len += pic_vec_ptr(argv[i])->len;
}
return pic_obj_value(vec);
}
static pic_value
pic_vec_vector_fill_i(pic_state *pic)
{
pic_vec *vec;
pic_value obj;
int n;
size_t start, end;
n = pic_get_args(pic, "vo|kk", &vec, &obj, &start, &end);
switch (n) {
case 2:
start = 0;
case 3:
end = vec->len;
}
while (start < end) {
vec->data[start++] = obj;
}
return pic_undef_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 = INT_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 = INT_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_undef_value();
}
static pic_value
pic_vec_list_to_vector(pic_state *pic)
{
struct pic_vector *vec;
pic_value list, e, it, *data;
pic_get_args(pic, "o", &list);
vec = pic_make_vec(pic, pic_length(pic, list));
data = vec->data;
pic_for_each (e, list, it) {
*data++ = e;
}
return pic_obj_value(vec);
}
static pic_value
pic_vec_vector_to_list(pic_state *pic)
{
struct pic_vector *vec;
pic_value list;
int n;
size_t start, end, i;
n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) {
case 1:
start = 0;
case 2:
end = vec->len;
}
list = pic_nil_value();
for (i = start; i < end; ++i) {
pic_push(pic, vec->data[i], list);
}
return pic_reverse(pic, list);
}
static pic_value
pic_vec_vector_to_string(pic_state *pic)
{
pic_vec *vec;
char *buf;
int n;
size_t start, end, i;
pic_str *str;
n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) {
case 1:
start = 0;
case 2:
end = vec->len;
}
if (end < start) {
pic_errorf(pic, "vector->string: end index must not be less than start index");
}
buf = pic_malloc(pic, end - start);
for (i = start; i < end; ++i) {
pic_assert_type(pic, vec->data[i], char);
buf[i - start] = pic_char(vec->data[i]);
}
str = pic_make_str(pic, buf, end - start);
pic_free(pic, buf);
return pic_obj_value(str);
}
static pic_value
pic_vec_string_to_vector(pic_state *pic)
{
pic_str *str;
int n;
size_t start, end;
size_t i;
pic_vec *vec;
n = pic_get_args(pic, "s|kk", &str, &start, &end);
switch (n) {
case 1:
start = 0;
case 2:
end = pic_str_len(str);
}
if (end < start) {
pic_errorf(pic, "string->vector: end index must not be less than start index");
}
vec = pic_make_vec(pic, end - start);
for (i = 0; i < end - start; ++i) {
vec->data[i] = pic_char_value(pic_str_ref(pic, str, i + start));
}
return pic_obj_value(vec);
}
void
pic_init_vector(pic_state *pic)
{
pic_defun(pic, "vector?", pic_vec_vector_p);
pic_defun(pic, "vector", pic_vec_vector);
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);
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);
pic_defun(pic, "vector->string", pic_vec_vector_to_string);
}