core: make-vector: Move to core.

* src/vector.c (make_vector_): Rename from make_vector__.  Add
parameter.  Fix double allocation.
(make_vector): Rename from make_vector_.  Use arity n.  Update users.

include/mes/builtins.h

@@ -169,7 +169,7 @@ SCM struct_length (SCM x);
 SCM struct_ref (SCM x, SCM i);
 SCM struct_set_x (SCM x, SCM i, SCM e);
 /* src/vector.c */
-SCM make_vector_ (SCM n);
+SCM make_vector (SCM x);
 SCM vector_length (SCM x);
 SCM vector_ref (SCM x, SCM i);
 SCM vector_entry (SCM x);

include/mes/mes.h

@@ -130,7 +130,7 @@ SCM make_ref (SCM x);
 SCM make_string (char const *s, size_t length);
 SCM make_string0 (char const *s);
 SCM make_string_port (SCM x);
-SCM make_vector__ (long k);
+SCM make_vector_ (long k, SCM e);
 SCM mes_builtins (SCM a);
 SCM push_cc (SCM p1, SCM p2, SCM a, SCM c);
 SCM struct_ref_ (SCM x, long i);
@@ -147,6 +147,7 @@ long length__ (SCM x);
 size_t bytes_cells (size_t length);
 void assert_max_string (size_t i, char const *msg, char *string);
 void assert_msg (int check, char *msg);
+void assert_number (char const *name, SCM x);
 void copy_cell (SCM to, SCM from);
 void gc_ ();
 void gc_init ();

mes/module/mes/scm.mes

@@ -193,9 +193,6 @@
 
 ;; Vector
 (define (vector . rest) (list->vector rest))
-(define (make-vector n . x)
-  (if (null? x) (core:make-vector n)
-      (list->vector (apply make-list (cons n x)))))
 
 (define (vector-copy x)
   (list->vector (vector->list x)))

mes/module/srfi/srfi-43.mes

@@ -26,7 +26,7 @@
 
 (define (vector-map f v)
   (let* ((k (vector-length v))
-         (n (core:make-vector k)))
+         (n (make-vector k)))
     (let loop ((i 0))
       (if (= i k) n
           (begin

src/builtins.c

@@ -262,7 +262,7 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "struct-ref", 2, &struct_ref, a);
   a = init_builtin (builtin_type, "struct-set!", 3, &struct_set_x, a);
   /* src/vector.c */
-  a = init_builtin (builtin_type, "core:make-vector", 1, &make_vector_, a);
+  a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a);
   a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a);
   a = init_builtin (builtin_type, "vector-ref", 2, &vector_ref, a);
   a = init_builtin (builtin_type, "vector-entry", 1, &vector_entry, a);

src/eval-apply.c

@@ -971,7 +971,7 @@ call_with_current_continuation:
   gc_push_frame ();
   x = make_continuation (g_continuations);
   g_continuations = g_continuations + 1;
-  v = make_vector__ (STACK_SIZE - g_stack);
+  v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified);
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
     vector_set_x_ (v, i - g_stack, g_stack_array[i]);
   CONTINUATION (x) = v;
@@ -979,7 +979,7 @@ call_with_current_continuation:
   push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2);
   goto apply;
 call_with_current_continuation2:
-  v = make_vector__ (STACK_SIZE - g_stack);
+  v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified);
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
     vector_set_x_ (v, i - g_stack, g_stack_array[i]);
   CONTINUATION (R2) = v;

src/hash.c

@@ -193,7 +193,7 @@ make_hash_table_ (long size)
     size = 100;
   SCM hashq_type = make_hashq_type ();
 
-  SCM buckets = make_vector__ (size);
+  SCM buckets = make_vector_ (size, cell_unspecified);
   SCM values = cell_nil;
   values = cons (buckets, values);
   values = cons (make_number (size), values);

src/stack.c

@@ -79,7 +79,7 @@ make_stack (SCM stack)          /*:((arity . n)) */
 {
   SCM stack_type = make_stack_type ();
   long size = (STACK_SIZE - g_stack) / FRAME_SIZE;
-  SCM frames = make_vector__ (size);
+  SCM frames = make_vector_ (size, cell_unspecified);
   long i;
   for (i = 0; i < size; i = i + 1)
     {

src/vector.c

@@ -30,21 +30,31 @@
 #endif
 
 SCM
-make_vector__ (long k)
+make_vector_ (long k, SCM e)
 {
+  SCM x = alloc (1);
   SCM v = alloc (k);
-  SCM x = make_cell (TVECTOR, k, v);
+  TYPE (x) = TVECTOR;
+  LENGTH (x) = k;
+  VECTOR (x) = v;
   long i;
   for (i = 0; i < k; i = i + 1)
-    copy_cell (cell_ref (v, i), vector_entry (cell_unspecified));
+    copy_cell (cell_ref (v, i), vector_entry (e));
 
   return x;
 }
 
 SCM
-make_vector_ (SCM n)
+make_vector (SCM x)               /*:((arity . n)) */
 {
-  return make_vector__ (VALUE (n));
+  SCM k = CAR (x);
+  assert_number ("make-vector", k);
+  long n = VALUE (k);
+  SCM e = cell_unspecified;
+  if (CDR (x) != cell_nil)
+    e = CADR (x);
+
+  return make_vector_ (n, e);
 }
 
 SCM
@@ -101,7 +111,7 @@ vector_set_x (SCM x, SCM i, SCM e)
 SCM
 list_to_vector (SCM x)
 {
-  SCM v = make_vector__ (length__ (x));
+  SCM v = make_vector_ (length__ (x), cell_unspecified);
   SCM p = VECTOR (v);
   while (x != cell_nil)
     {

tests/vector.test

@@ -39,8 +39,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
 (pass-if "vector?" (vector? #(1 2 c)))
 (pass-if "vector-length" (seq? (vector-length #(1)) 1))
 
-(if (not guile?)
-    (pass-if "core:make-vector" (sequal? (core:make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
+(pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*)))
+(pass-if "make-vector 1" (sequal? (make-vector 3 0) #(0 0 0)))
 
 (pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))
 (pass-if "vector-set!" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))