From c5a219ffe1b101a5011b636d9ae37908af73fa5e Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 1 Jun 2015 22:46:26 -0400
Subject: [PATCH] Added vector-ref

---
 cgen.scm  |  1 +
 eval.scm  |  1 +
 runtime.c | 16 ++++++++++++++++
 runtime.h |  2 ++
 trans.scm |  1 +
 5 files changed, 21 insertions(+)

diff --git a/cgen.scm b/cgen.scm
index f6748e06..9eb08168 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -436,6 +436,7 @@
      ((eq? p 'string->list)  "string2list")
      ((eq? p 'make-vector)   "make_vector")
      ((eq? p 'list->vector)  "list2vector")
+     ((eq? p 'vector-ref)    "Cyc_vector_ref")
      ((eq? p 'string-append) "Cyc_string_append")
      ((eq? p 'string-cmp)    "Cyc_string_cmp")
      ((eq? p 'string->symbol) "Cyc_string2symbol")
diff --git a/eval.scm b/eval.scm
index bfb46655..feae7a5c 100644
--- a/eval.scm
+++ b/eval.scm
@@ -268,6 +268,7 @@
       (list 'number->string number->string)
       (list 'make-vector make-vector)
       (list 'list->vector list->vector)
+      (list 'vector-ref vector-ref)
       (list 'boolean? boolean?)
       (list 'char? char?)
       (list 'eof-object? eof-object?)
diff --git a/runtime.c b/runtime.c
index ad8d2558..5a108447 100644
--- a/runtime.c
+++ b/runtime.c
@@ -577,6 +577,17 @@ object Cyc_set_cdr(object l, object val) {
     return l;
 }
 
+object Cyc_vector_ref(object v, object k) {
+    if (nullp(v) || is_value_type(v) || ((list)v)->tag != vector_tag) {
+      Cyc_rt_raise_msg("vector-ref - invalid parameter, expected vector\n"); 
+    }
+    if (nullp(k) || is_value_type(k) || ((list)k)->tag != integer_tag) {
+      Cyc_rt_raise_msg("vector-ref - invalid parameter, expected integer\n"); 
+    }
+
+    return ((vector)v)->elts[((integer_type *)k)->value];
+}
+
 integer_type Cyc_vector_length(object v) {
     if (!nullp(v) && !is_value_type(v) && ((list)v)->tag == vector_tag) {
       make_int(len, ((vector)v)->num_elt);
@@ -1124,6 +1135,9 @@ void _make_91vector(object cont, object args) {
     else {
       make_vector(v, car(args), boolean_f);
       return_funcall1(cont, v);}}
+void _vector_91ref(object cont, object args) {
+    object ref = Cyc_vector_ref(car(args), cadr(args));
+    return_funcall1(cont, ref);}
 void _list_91_125vector(object cont, object args) {
     list2vector(l, car(args));
     return_funcall1(cont, l);}
@@ -1815,6 +1829,7 @@ static primitive_type symbol_91_125string_primitive = {primitive_tag, "symbol->s
 static primitive_type number_91_125string_primitive = {primitive_tag, "number->string", &_number_91_125string};
 static primitive_type list_91_125vector_primitive = {primitive_tag, "list-vector", &_list_91_125vector};
 static primitive_type make_91vector_primitive = {primitive_tag, "make-vector", &_make_91vector};
+static primitive_type vector_91ref_primitive = {primitive_tag, "vector-ref", &_vector_91ref};
 static primitive_type boolean_127_primitive = {primitive_tag, "boolean?", &_boolean_127};
 static primitive_type char_127_primitive = {primitive_tag, "char?", &_char_127};
 static primitive_type eof_91object_127_primitive = {primitive_tag, "eof-object?", &_eof_91object_127};
@@ -1871,6 +1886,7 @@ const object primitive_memq = &memq_primitive;
 const object primitive_memv = &memv_primitive;
 const object primitive_length = &length_primitive;
 const object primitive_vector_91length = &vector_91length_primitive;
+const object primitive_vector_91ref = &vector_91ref_primitive;
 const object primitive_set_91car_67 = &set_91car_67_primitive;
 const object primitive_set_91cdr_67 = &set_91cdr_67_primitive;
 const object primitive_car = &car_primitive;
diff --git a/runtime.h b/runtime.h
index 229adbec..7b764044 100644
--- a/runtime.h
+++ b/runtime.h
@@ -83,6 +83,7 @@ object Cyc_set_car(object l, object val) ;
 object Cyc_set_cdr(object l, object val) ;
 integer_type Cyc_length(object l);
 integer_type Cyc_vector_length(object v);
+object Cyc_vector_ref(object v, object k);
 string_type Cyc_number2string(object n) ;
 string_type Cyc_symbol2string(object sym) ;
 object Cyc_string2symbol(object str);
@@ -295,6 +296,7 @@ extern const object primitive_symbol_91_125string;
 extern const object primitive_number_91_125string;
 extern const object primitive_make_91vector;
 extern const object primitive_list_91_125vector;
+extern const object primitive_vector_91ref;
 extern const object primitive_system;
 extern const object primitive_boolean_127;
 extern const object primitive_char_127;
diff --git a/trans.scm b/trans.scm
index 5e6b4fb4..13edc60b 100644
--- a/trans.scm
+++ b/trans.scm
@@ -519,6 +519,7 @@
      number->string
      make-vector
      list->vector
+     vector-ref
      boolean?
      char?
      eof-object?