From 01a5819706e3046c43eb0b53b65d6f44e0984f32 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 4 Nov 2013 20:53:33 -0500
Subject: [PATCH] add vector primitives

---
 src/init.c   |  2 ++
 src/vector.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/vm.c     | 41 +++++++++++++++++++++++++++++++++++++
 3 files changed, 101 insertions(+)

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");