2014-01-17 06:58:31 -05:00
|
|
|
/**
|
|
|
|
* See Copyright Notice in picrin.h
|
|
|
|
*/
|
|
|
|
|
2013-10-29 21:12:04 -04:00
|
|
|
#include "picrin.h"
|
2014-02-22 01:20:53 -05:00
|
|
|
#include "picrin/vector.h"
|
2013-10-29 21:12:04 -04:00
|
|
|
#include "picrin/pair.h"
|
|
|
|
|
|
|
|
struct pic_vector *
|
|
|
|
pic_vec_new(pic_state *pic, size_t len)
|
|
|
|
{
|
|
|
|
struct pic_vector *vec;
|
2014-01-30 04:14:33 -05:00
|
|
|
size_t i;
|
2013-10-29 21:12:04 -04:00
|
|
|
|
|
|
|
vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TT_VECTOR);
|
|
|
|
vec->len = len;
|
|
|
|
vec->data = (pic_value *)pic_alloc(pic, sizeof(pic_value) * len);
|
2013-11-15 05:29:54 -05:00
|
|
|
for (i = 0; i < len; ++i) {
|
2014-01-08 01:22:23 -05:00
|
|
|
vec->data[i] = pic_none_value();
|
2013-11-15 05:29:54 -05:00
|
|
|
}
|
2013-10-29 21:12:04 -04:00
|
|
|
return vec;
|
|
|
|
}
|
|
|
|
|
|
|
|
struct pic_vector *
|
|
|
|
pic_vec_new_from_list(pic_state *pic, pic_value data)
|
|
|
|
{
|
|
|
|
struct pic_vector *vec;
|
2014-01-30 04:14:33 -05:00
|
|
|
size_t i, len;
|
2013-10-29 21:12:04 -04:00
|
|
|
|
|
|
|
len = pic_length(pic, data);
|
|
|
|
|
|
|
|
vec = pic_vec_new(pic, len);
|
|
|
|
for (i = 0; i < len; ++i) {
|
|
|
|
vec->data[i] = pic_car(pic, data);
|
|
|
|
data = pic_cdr(pic, data);
|
|
|
|
}
|
|
|
|
return vec;
|
|
|
|
}
|
2013-11-04 20:53:33 -05:00
|
|
|
|
2013-11-15 05:30:25 -05:00
|
|
|
void
|
2014-01-30 04:14:33 -05:00
|
|
|
pic_vec_extend_ip(pic_state *pic, struct pic_vector *vec, size_t size)
|
2013-11-15 05:30:25 -05:00
|
|
|
{
|
2014-01-30 04:14:33 -05:00
|
|
|
size_t len, i;
|
2013-11-15 05:30:25 -05:00
|
|
|
|
|
|
|
len = vec->len;
|
|
|
|
vec->len = size;
|
|
|
|
vec->data = (pic_value *)pic_realloc(pic, vec->data, sizeof(pic_value) * size);
|
|
|
|
for (i = len; i < size; ++i) {
|
2014-01-08 01:22:23 -05:00
|
|
|
vec->data[i] = pic_none_value();
|
2013-11-15 05:30:25 -05:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-11-04 20:53:33 -05: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_vec_p(v));
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_vec_make_vector(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_value v;
|
2014-01-30 04:14:33 -05:00
|
|
|
int n, k;
|
|
|
|
size_t i;
|
2013-11-04 20:53:33 -05:00
|
|
|
struct pic_vector *vec;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "i|o", &k, &v);
|
|
|
|
|
|
|
|
vec = pic_vec_new(pic, k);
|
2014-02-01 00:23:21 -05:00
|
|
|
if (n == 2) {
|
2014-01-30 04:14:33 -05:00
|
|
|
for (i = 0; i < (size_t)k; ++i) {
|
2013-11-04 20:53:33 -05:00
|
|
|
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_int_value(v->len);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_ref(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_vector *v;
|
|
|
|
int k;
|
|
|
|
|
2013-11-04 20:59:43 -05:00
|
|
|
pic_get_args(pic, "vi", &v, &k);
|
2013-11-04 20:53:33 -05:00
|
|
|
|
2014-01-30 04:14:33 -05:00
|
|
|
if (k < 0 || v->len <= (size_t)k) {
|
2013-11-16 12:32:27 -05:00
|
|
|
pic_error(pic, "vector-ref: index out of range");
|
|
|
|
}
|
2013-11-04 20:53:33 -05:00
|
|
|
return v->data[k];
|
|
|
|
}
|
|
|
|
|
2013-11-14 02:57:07 -05:00
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_set(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_vector *v;
|
|
|
|
int k;
|
|
|
|
pic_value o;
|
|
|
|
|
|
|
|
pic_get_args(pic, "vio", &v, &k, &o);
|
|
|
|
|
2014-01-30 04:14:33 -05:00
|
|
|
if (k < 0 || v->len <= (size_t)k) {
|
2013-11-16 12:32:27 -05:00
|
|
|
pic_error(pic, "vector-set!: index out of range");
|
|
|
|
}
|
2013-11-14 02:57:07 -05:00
|
|
|
v->data[k] = o;
|
2014-01-08 01:22:23 -05:00
|
|
|
return pic_none_value();
|
2013-11-14 02:57:07 -05:00
|
|
|
}
|
|
|
|
|
2014-07-21 19:58:48 -04:00
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_copy_i(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_vec *to, *from;
|
|
|
|
int n, at, start, end;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "viv|ii", &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_none_value();
|
|
|
|
}
|
|
|
|
|
|
|
|
while (start < end) {
|
|
|
|
to->data[at++] = from->data[start++];
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_none_value();
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_copy(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_vec *vec, *to;
|
|
|
|
int n, start, end, i = 0;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
|
|
|
|
|
|
|
|
switch (n) {
|
|
|
|
case 1:
|
|
|
|
start = 0;
|
|
|
|
case 2:
|
|
|
|
end = vec->len;
|
|
|
|
}
|
|
|
|
|
|
|
|
to = pic_vec_new(pic, end - start);
|
|
|
|
while (start < end) {
|
|
|
|
to->data[i++] = vec->data[start++];
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_obj_value(to);
|
|
|
|
}
|
|
|
|
|
2014-07-22 01:08:48 -04:00
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_append(pic_state *pic)
|
|
|
|
{
|
|
|
|
size_t argc, i, j, len;
|
|
|
|
pic_value *argv;
|
|
|
|
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_vec_new(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);
|
|
|
|
}
|
|
|
|
|
2014-07-21 20:24:30 -04:00
|
|
|
static pic_value
|
|
|
|
pic_vec_vector_fill_i(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_vec *vec;
|
|
|
|
pic_value obj;
|
|
|
|
int n, start, end;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "vo|ii", &vec, &obj, &start, &end);
|
|
|
|
|
|
|
|
switch (n) {
|
|
|
|
case 2:
|
|
|
|
start = 0;
|
|
|
|
case 3:
|
|
|
|
end = vec->len;
|
|
|
|
}
|
|
|
|
|
|
|
|
while (start < end) {
|
|
|
|
vec->data[start++] = obj;
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_none_value();
|
|
|
|
}
|
|
|
|
|
2014-07-21 09:51:33 -04:00
|
|
|
static pic_value
|
|
|
|
pic_vec_list_to_vector(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_vector *vec;
|
|
|
|
pic_value list, e, *data;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &list);
|
|
|
|
|
|
|
|
vec = pic_vec_new(pic, pic_length(pic, list));
|
|
|
|
|
|
|
|
data = vec->data;
|
|
|
|
|
|
|
|
pic_for_each (e, list) {
|
|
|
|
*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, start, end, i;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "v|ii", &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);
|
|
|
|
}
|
|
|
|
|
2013-11-04 20:53:33 -05:00
|
|
|
void
|
|
|
|
pic_init_vector(pic_state *pic)
|
|
|
|
{
|
|
|
|
pic_defun(pic, "vector?", pic_vec_vector_p);
|
|
|
|
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);
|
2013-11-14 02:57:07 -05:00
|
|
|
pic_defun(pic, "vector-set!", pic_vec_vector_set);
|
2014-07-21 19:58:48 -04:00
|
|
|
pic_defun(pic, "vector-copy!", pic_vec_vector_copy_i);
|
|
|
|
pic_defun(pic, "vector-copy", pic_vec_vector_copy);
|
2014-07-22 01:08:48 -04:00
|
|
|
pic_defun(pic, "vector-append", pic_vec_vector_append);
|
2014-07-21 20:24:30 -04:00
|
|
|
pic_defun(pic, "vector-fill!", pic_vec_vector_fill_i);
|
2014-07-21 09:51:33 -04:00
|
|
|
pic_defun(pic, "list->vector", pic_vec_list_to_vector);
|
|
|
|
pic_defun(pic, "vector->list", pic_vec_vector_to_list);
|
2013-11-04 20:53:33 -05:00
|
|
|
}
|