Added vector-length

cgen.scm

@@ -449,6 +449,7 @@
      ((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")
@@ -481,6 +482,7 @@
     ((eq? p 'current-input-port) "port_type")
     ((eq? p 'open-input-file) "port_type")
     ((eq? p 'length) "integer_type")
+    ((eq? p 'vector-length) "integer_type")
     ((eq? p 'char->integer) "integer_type")
     ((eq? p 'system) "integer_type")
     ((eq? p '+) "common_type")
@@ -506,7 +508,7 @@
              string-append string-cmp list->string string->list
              make-vector list->vector
              symbol->string number->string
-             + - * / apply cons length cell))))
+             + - * / apply cons length vector-length cell))))
 
 ;; Pass an integer arg count as the function's first parameter?
 (define (prim:arg-count? exp)

eval.scm

@@ -223,6 +223,7 @@
       (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)

runtime.c

@@ -577,12 +577,18 @@ object Cyc_set_cdr(object l, object val) {
     return l;
 }
 
+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);
+      return len;
+    }
+    Cyc_rt_raise_msg("vector-length - invalid parameter, expected vector\n"); }
+
 integer_type Cyc_length(object l){
     make_int(len, 0);
     while(!nullp(l)){
         if (((list)l)->tag != cons_tag){
-            printf("length - invalid parameter, expected list\n");
+            Cyc_rt_raise_msg("length - invalid parameter, expected list\n");
-            exit(1);
         }
         l = cdr(l);
         len.value++;
@@ -986,6 +992,9 @@ void _equal_127(object cont, object args){
 void _length(object cont, object args){ 
     integer_type i = Cyc_length(car(args));
     return_funcall1(cont, &i); }
+void _vector_91length(object cont, object args){ 
+    integer_type i = Cyc_vector_length(car(args));
+    return_funcall1(cont, &i); }
 void _null_127(object cont, object args) { 
     return_funcall1(cont, Cyc_is_null(car(args))); }
 void _set_91car_67(object cont, object args) { 
@@ -1760,6 +1769,7 @@ static primitive_type member_primitive = {primitive_tag, "member", &_member};
 static primitive_type memq_primitive = {primitive_tag, "memq", &_memq};
 static primitive_type memv_primitive = {primitive_tag, "memv", &_memv};
 static primitive_type length_primitive = {primitive_tag, "length", &_length};
+static primitive_type vector_91length_primitive = {primitive_tag, "vector-length", &_vector_91length};
 static primitive_type set_91car_67_primitive = {primitive_tag, "set-car!", &_set_91car_67};
 static primitive_type set_91cdr_67_primitive = {primitive_tag, "set-cdr!", &_set_91cdr_67};
 static primitive_type car_primitive = {primitive_tag, "car", &_car};
@@ -1860,6 +1870,7 @@ const object primitive_member = &member_primitive;
 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_set_91car_67 = &set_91car_67_primitive;
 const object primitive_set_91cdr_67 = &set_91cdr_67_primitive;
 const object primitive_car = &car_primitive;

runtime.h

@@ -82,6 +82,7 @@ object Cyc_eq(object x, object y);
 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);
 string_type Cyc_number2string(object n) ;
 string_type Cyc_symbol2string(object sym) ;
 object Cyc_string2symbol(object str);
@@ -108,6 +109,7 @@ object Cyc_is_null(object o);
 object Cyc_is_number(object o);
 object Cyc_is_real(object o);
 object Cyc_is_integer(object o);
+object Cyc_is_vector(object o);
 object Cyc_is_symbol(object o);
 object Cyc_is_string(object o);
 object Cyc_is_char(object o);
@@ -248,6 +250,7 @@ extern const object primitive_member;
 extern const object primitive_memq;
 extern const object primitive_memv;
 extern const object primitive_length;
+extern const object primitive_vector_91length;
 extern const object primitive_set_91car_67;
 extern const object primitive_set_91cdr_67;
 extern const object primitive_car;

trans.scm

@@ -498,6 +498,7 @@
      memv
      member
      length
+     vector-length
      set-car!
      set-cdr!
      car