boot: vector support.

* mes.c (make_vector): Change to scm interface.
  (temp_number): New global.
  (list_to_vector): Use it.
* module/mes/scm.mes (c:make-vector): New function.
* tests/scm.test: Remove vector tests.
* tests/vector.test: New file.
* GNUmakefile (TESTS): Add it.

GNUmakefile

@@ -64,6 +64,7 @@ TESTS:=\
  tests/closure.test\
  tests/quasiquote.test\
  tests/let.test\
+ tests/vector.test\
  tests/scm.test\
  tests/record.test\
  tests/let-syntax.test\

mes.c

@@ -61,6 +61,8 @@ typedef struct scm_t {
   };
 } scm;
 
+scm temp_number = {NUMBER, .name="nul", .value=0};
+
 #define MES_C 1
 #include "mes.h"
 
@@ -734,12 +736,13 @@ make_symbol (char const *s)
 }
 
 scm *
-make_vector (int n)
+make_vector (scm *n)
 {
   scm *p = (scm*)malloc (sizeof (scm));
   p->type = VECTOR;
-  p->length = n;
-  p->vector = (scm**)malloc (n * sizeof (scm*));
+  p->length = n->value;
+  p->vector = (scm**)malloc (n->value * sizeof (scm*));
+  for (int i=0; i<n->value; i++) p->vector[i] = &scm_unspecified;
   return p;
 }
 
@@ -948,8 +951,8 @@ list2str (scm *l) // char*
 scm*
 list_to_vector (scm *x)
 {
-  int n = length (x)->value;
-  scm *v = make_vector (n);
+  temp_number.value = length (x)->value;
+  scm *v = make_vector (&temp_number);
   scm **p = v->vector;
   while (x != &scm_nil)
     {

module/mes/scm.mes

@@ -67,8 +67,10 @@
           (cons (string-ref s i) (loop (+ i 1)))))))
 
 (define (vector . rest) (list->vector rest))
+(define c:make-vector make-vector)
 (define (make-vector n . x)
-  (list->vector (apply make-list (cons n x))))
+  (if (null? x) (c:make-vector n)
+      (list->vector (apply make-list (cons n x)))))
 
 (define (acons key value alist)
   (cons (cons key value) alist))

tests/scm.test

@@ -85,17 +85,8 @@ exit $?
 (pass-if "string " (sequal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
 (pass-if "length" (seq? (length '()) 0))
 (pass-if "length 2" (seq? (length '(a b c)) 3))
-(pass-if "vector?" (vector? #(1 2 c)))
-(pass-if "vector-length" (seq? (vector-length #(1)) 1))
-(pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
-(pass-if "make-list" (sequal? (make-list 3 1) '(1 1 1)))
-(pass-if "vector" (sequal? #(vector 0 1 2) #(vector 0 1 2)))
-(when (not guile?)
-  (pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
-(pass-if "make-vector 2" (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)))
-(pass-if "vector-set 2" (not (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #())))
+(pass-if "make-list" (seq? (make-list 0) '()))
+(pass-if "make-list 1" (sequal? (make-list 1 0) '(0)))
 (pass-if "equal?" (sequal? #(1) #(1)))
 (pass-if "equal?" (not (equal? #() #(1))))
 (pass-if "memq" (sequal? (memq 'a '(a b c)) '(a b c)))
@@ -127,7 +118,8 @@ exit $?
 ;;        (display ((lambda (x) x) (values 1 2 3)))
 ;;        (newline)))
 
-(pass-if "builtin?" (builtin? eval))
+(pass-if "builtin?" (builtin? car))
+(pass-if "builtin?" (not (builtin? not)))
 ;;(pass-if "builtin?" (builtin? cond))
 (pass-if "procedure?" (procedure? builtin?))
 (pass-if "procedure?" (procedure? procedure?))

tests/vector.test

@@ -0,0 +1,56 @@
+#! /bin/sh
+# -*-scheme-*-
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; vector.test: This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mes base-0))
+(mes-use-module (mes base))
+(mes-use-module (mes quasiquote))
+(mes-use-module (mes let))
+(mes-use-module (srfi srfi-0))
+(mes-use-module (mes scm))
+(mes-use-module (mes test))
+
+(when guile?
+  (use-modules (srfi srfi-1)))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if "vector" (sequal? #(vector 0 1 2) #(vector 0 1 2)))
+(pass-if "vector?" (vector? #(1 2 c)))
+(pass-if "vector-length" (seq? (vector-length #(1)) 1))
+
+(when (not guile?)
+  (pass-if "c:make-vector" (sequal? (c:make-vector 3) #(*unspecified* *unspecified* *unspecified*)))
+  (pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
+
+(pass-if "make-vector 2" (sequal? (make-vector 3 1) #(1 1 1)))
+(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)))
+(pass-if "vector-set 2" (not (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #())))
+(pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
+
+(result 'report)