From 0e8cd6a94e599b9cca9baff10c955e1a2b6918a9 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 2 Jun 2015 21:33:03 -0400
Subject: [PATCH] Added (vector-set!)

---
 cgen.scm  |  3 ++-
 eval.scm  |  3 ++-
 runtime.c | 22 +++++++++++++++++++++-
 runtime.h |  1 +
 trans.scm |  3 ++-
 5 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/cgen.scm b/cgen.scm
index 9eb08168..5ccd0dd1 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -436,7 +436,9 @@
      ((eq? p 'string->list)  "string2list")
      ((eq? p 'make-vector)   "make_vector")
      ((eq? p 'list->vector)  "list2vector")
+     ((eq? p 'vector-length) "Cyc_vector_length")
      ((eq? p 'vector-ref)    "Cyc_vector_ref")
+     ((eq? p 'vector-set!)   "Cyc_vector_set")
      ((eq? p 'string-append) "Cyc_string_append")
      ((eq? p 'string-cmp)    "Cyc_string_cmp")
      ((eq? p 'string->symbol) "Cyc_string2symbol")
@@ -450,7 +452,6 @@
      ((eq? p 'memv)          "memqp")
      ((eq? p 'member)        "memberp")
      ((eq? p 'length)        "Cyc_length")
-     ((eq? p 'vector-length) "Cyc_vector_length")
      ((eq? p 'set-car!)      "Cyc_set_car")
      ((eq? p 'set-cdr!)      "Cyc_set_cdr")
      ((eq? p 'eq?)           "Cyc_eq")
diff --git a/eval.scm b/eval.scm
index feae7a5c..1d9ce649 100644
--- a/eval.scm
+++ b/eval.scm
@@ -223,7 +223,6 @@
       (list 'memv memv)
       (list 'member member)
       (list 'length length)
-      (list 'vector-length vector-length)
       (list 'set-car! set-car!)
       (list 'set-cdr! set-cdr!)
       (list 'car car)
@@ -268,7 +267,9 @@
       (list 'number->string number->string)
       (list 'make-vector make-vector)
       (list 'list->vector list->vector)
+      (list 'vector-length vector-length)
       (list 'vector-ref vector-ref)
+      (list 'vector-set! vector-set!)
       (list 'boolean? boolean?)
       (list 'char? char?)
       (list 'eof-object? eof-object?)
diff --git a/runtime.c b/runtime.c
index 5a108447..e925b8d5 100644
--- a/runtime.c
+++ b/runtime.c
@@ -577,6 +577,16 @@ object Cyc_set_cdr(object l, object val) {
     return l;
 }
 
+object Cyc_vector_set(object v, object k, object obj) {
+  // TODO: bounds checking? do eventually need to figure out where that should go
+  int idx = ((integer_type *)k)->value;
+  ((vector)v)->elts[idx] = obj;
+  // TODO: probably could be more efficient here and also pass
+  //       index, so only that one entry needs GC.
+  add_mutation(v, obj);
+  return v;
+}
+
 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"); 
@@ -1138,6 +1148,9 @@ void _make_91vector(object cont, object args) {
 void _vector_91ref(object cont, object args) {
     object ref = Cyc_vector_ref(car(args), cadr(args));
     return_funcall1(cont, ref);}
+void _vector_91set_67(object cont, object args) {
+    object ref = Cyc_vector_set(car(args), cadr(args), caddr(args));
+    return_funcall1(cont, ref);}
 void _list_91_125vector(object cont, object args) {
     list2vector(l, car(args));
     return_funcall1(cont, l);}
@@ -1478,7 +1491,12 @@ void GC_loop(int major, closure cont, object *ans, int num_ans)
          //       GC's of list/car-cdr from same generation
          transp(car(o));
          transp(cdr(o));
-// TODO: } else if (type_of(o) == vector_tag) {
+     } else if (type_of(o) == vector_tag) {
+       int i;
+       // TODO: probably too inefficient, try collecting single index
+       for (i = 0; i < ((vector)o)->num_elt; i++) {
+         transp(((vector)o)->elts[i]);
+       }
      } else if (type_of(o) == forward_tag) {
          // Already transported, skip
      } else {
@@ -1830,6 +1848,7 @@ static primitive_type number_91_125string_primitive = {primitive_tag, "number->s
 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 vector_91set_67_primitive = {primitive_tag, "vector-set!", &_vector_91set_67};
 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};
@@ -1887,6 +1906,7 @@ 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_vector_91set_67 = &vector_91set_67_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 7b764044..f6580afa 100644
--- a/runtime.h
+++ b/runtime.h
@@ -297,6 +297,7 @@ 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_vector_91set_67;
 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 13edc60b..5ebbda87 100644
--- a/trans.scm
+++ b/trans.scm
@@ -498,7 +498,6 @@
      memv
      member
      length
-     vector-length
      set-car!
      set-cdr!
      car
@@ -519,7 +518,9 @@
      number->string
      make-vector
      list->vector
+     vector-length
      vector-ref
+     vector-set!
      boolean?
      char?
      eof-object?