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"
|
|
|
|
#include "picrin/pair.h"
|
|
|
|
|
|
|
|
struct pic_vector *
|
|
|
|
pic_vec_new(pic_state *pic, size_t len)
|
|
|
|
{
|
|
|
|
struct pic_vector *vec;
|
2013-11-15 05:29:54 -05:00
|
|
|
int 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;
|
|
|
|
int i, len;
|
|
|
|
|
|
|
|
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
|
|
|
|
pic_vec_extend_ip(pic_state *pic, struct pic_vector *vec, int size)
|
|
|
|
{
|
|
|
|
int len, i;
|
|
|
|
|
|
|
|
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;
|
|
|
|
int k, n, i;
|
|
|
|
struct pic_vector *vec;
|
|
|
|
|
|
|
|
n = pic_get_args(pic, "i|o", &k, &v);
|
|
|
|
|
|
|
|
vec = pic_vec_new(pic, k);
|
|
|
|
if (n == 3) {
|
|
|
|
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_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
|
|
|
|
2013-11-16 12:32:27 -05:00
|
|
|
if (k < 0 || v->len <= k) {
|
|
|
|
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);
|
|
|
|
|
2013-11-16 12:32:27 -05:00
|
|
|
if (k < 0 || v->len <= k) {
|
|
|
|
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
|
|
|
}
|
|
|
|
|
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);
|
2013-11-04 20:53:33 -05:00
|
|
|
}
|