diff --git a/src/init.c b/src/init.c index 8f7e38b1..e72ff457 100644 --- a/src/init.c +++ b/src/init.c @@ -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; } diff --git a/src/vector.c b/src/vector.c index 0160775f..6b1649ef 100644 --- a/src/vector.c +++ b/src/vector.c @@ -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); +} diff --git a/src/vm.c b/src/vm.c index 7fd5754a..9aeed7eb 100644 --- a/src/vm.c +++ b/src/vm.c @@ -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");