add vector primitives

This commit is contained in:
Yuichi Nishiwaki 2013-11-04 20:53:33 -05:00
parent eede3242a5
commit 01a5819706
3 changed files with 101 additions and 0 deletions

View File

@ -13,6 +13,7 @@ void pic_init_system(pic_state *);
void pic_init_file(pic_state *);
void pic_init_proc(pic_state *);
void pic_init_symbol(pic_state *);
void pic_init_vector(pic_state *);
void
pic_load_stdlib(pic_state *pic)
@ -75,6 +76,7 @@ pic_init_core(pic_state *pic)
pic_init_file(pic); DONE;
pic_init_proc(pic); DONE;
pic_init_symbol(pic); DONE;
pic_init_vector(pic); DONE;
pic_load_stdlib(pic); DONE;
}

View File

@ -27,3 +27,61 @@ pic_vec_new_from_list(pic_state *pic, pic_value 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_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;
pic_get_args(pic, "vi", &v, k);
return v->data[k];
}
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);
}

View File

@ -125,6 +125,29 @@ pic_get_args(pic_state *pic, const char *format, ...)
}
}
break;
case 'i':
{
int *k;
k = va_arg(ap, int *);
if (i < argc) {
pic_value v;
v = GET_OPERAND(pic, i);
switch (pic_type(v)) {
case PIC_TT_FLOAT:
*k = (int)pic_float(v);
break;
case PIC_TT_INT:
*k = pic_int(v);
break;
default:
pic_error(pic, "pic_get_args: expected int");
}
i++;
}
}
break;
case 's':
{
pic_value str;
@ -144,6 +167,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
}
}
break;
case 'v':
{
struct pic_vector **vec;
pic_value v;
vec = va_arg(ap, struct pic_vector **);
if (i < argc) {
v = GET_OPERAND(pic,i);
if (pic_vec_p(v)) {
*vec = pic_vec_ptr(v);
}
else {
pic_error(pic, "pic_get_args: expected vector");
}
i++;
}
}
break;
default:
{
pic_error(pic, "pic_get_args: invalid argument specifier given");