[Wisp-cvs] wisp/src/builtin dictbase.wisp,1.253,1.254 lists.wisp,1.108,1.109 parser.wisp,1.121,1.122 stdenv.wisp,1.369,1.370 tostring.wisp,1.80,1.81 vectors.wisp,1.64,1.65

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv1563/src/builtin

Modified Files:
	dictbase.wisp lists.wisp parser.wisp stdenv.wisp tostring.wisp 
	vectors.wisp 
Log Message:
Implemented |<u8vector>|.

Index: dictbase.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/dictbase.wisp,v
retrieving revision 1.253
retrieving revision 1.254
diff -u -d -r1.253 -r1.254
--- dictbase.wisp	18 Sep 2002 21:12:38 -0000	1.253
+++ dictbase.wisp	18 Sep 2002 21:15:21 -0000	1.254
@@ -21,6 +21,7 @@
 (local <box> (asm RT_box))
 (local <c16string> (asm RT_c16string))
 (local <record-type> (asm RT_record_type))
+(local <u8vector> (asm RT_u8vector))
 (local <vector> (asm RT_vector))
 (local address-of (asm NN_encui))
 (local apply (asm NN_apply))
@@ -152,6 +153,7 @@
 (local sys:sync (asm NN_sys_sync))
 (local truncate (asm NN_truncate))
 (local type-of (asm NN_type_of))
+(local u8vector? (asm NN_u8vector_huh))
 (local unix-time (asm NN_unix_time))
 (local unsigned-get-bit (asm NN_unsigned_get_bit))
 (local utf-8-first-byte->length (asm NN_utf_8_first_byte2length))

Index: lists.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/lists.wisp,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -d -r1.108 -r1.109
--- lists.wisp	18 Sep 2002 21:12:38 -0000	1.108
+++ lists.wisp	18 Sep 2002 21:15:21 -0000	1.109
@@ -281,6 +281,11 @@
  d)
 
 ; {{{ |vector->list|
+; Note that this implementation works on all types that implement
+; |ref| and |length| in a vector-like fashion; in particular, on
+; |<u8vector>| and |<c16string>|.  Still, it is probably
+; desirable to add a fast path for instances of |<vector>| once
+; the translator is able to optimize it properly.
 (define (vector->list vec)
   (do ((i (- (length vec) 1) (- i 1))
        (l '() (cons vec[i] l)))

Index: parser.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/parser.wisp,v
retrieving revision 1.121
retrieving revision 1.122
diff -u -d -r1.121 -r1.122
--- parser.wisp	18 Sep 2002 21:11:14 -0000	1.121
+++ parser.wisp	18 Sep 2002 21:15:21 -0000	1.122
@@ -157,7 +157,19 @@
                              ((b) #\1)
                              ((o) #\3)
                              ((d) #\0)
-                             (else (raise 'invalid-reader-syntax "#$[name]")))))
+                             ((u) (my width (string->integer
+                                              (read-char-sequence
+                                               port char-digit?))
+                                    (case width
+                                      ((8) (if (eqv? (read-char port)
+                                                     #\open)
+                                            'u8
+                                             (raise 'invalid-reader-syntax
+                                                   "#$,[name]$,[width]")))
+                                      (else (raise 'invalid-reader-syntax
+                                                   "#$,[name]$,[width]")))))
+                             (else (raise 'invalid-reader-syntax
+                                          "#$,[name]")))))
                        (else
                          (case (read-char port)
                            ((#\<) (raise 'unreadable (string-copy "#<")))
@@ -263,6 +275,8 @@
              (read-list port))
            ((eqv? t #\V)
              (list->vector (read-block port #\close)))
+           ((eqv? t 'u8)
+             (list->vector (read-block port #\close) <u8vector>))
            ((eqv? t #\B)
              (if (eqv? (peek-token port) #\.)
                (begin

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.369
retrieving revision 1.370
diff -u -d -r1.369 -r1.370
--- stdenv.wisp	18 Sep 2002 21:12:38 -0000	1.369
+++ stdenv.wisp	18 Sep 2002 21:15:21 -0000	1.370
@@ -12,14 +12,14 @@
        (cons 'list
          (map (lambda (x) `(cons ',x ,x))
            '(* + - / /= < << <= <box> <c16string> <class> <file>
-             <macro> <port> <record-type> <vector> = > >= >> abs acons!
-             address-of alist->dict alist-copy analyse and append
-             append-reverse apply assert assert-object-type assoc assq
-             assv atom? big-integer? bind bit? boolean? box-empty!
-             box-empty? box-ref box? broketed? builtin-modules
-             c16string? c8string? caaaar caaadr caaar caadar caaddr
-             caadr caar cadaar cadadr cadar caddar cadddr caddr cadr
-             call-with-in/out-files call-with-input-file
+             <macro> <port> <record-type> <u8vector> <vector> = > >= >>
+             abs acons! address-of alist->dict alist-copy analyse and
+             append append-reverse apply assert assert-object-type
+             assoc assq assv atom? big-integer? bind bit? boolean?
+             box-empty! box-empty? box-ref box? broketed?
+             builtin-modules c16string? c8string? caaaar caaadr caaar
+             caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr
+             caddr cadr call-with-in/out-files call-with-input-file
              call-with-output-file car car! car* cardinal? case catch
              cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
              cddar cdddar cddddr cdddr cddr cdr cdr! cdr* ceiling
@@ -89,7 +89,7 @@
              symbol<? symbol>=? symbol>? symbol? system-constant
              tcchangeattr tcgetattr tcgetattr-raw tcsetattr-raw tenth
              third toposplit translate tree-copy truncate try tty? type
-             type-of ubyte? unix-time unpack-be-integer
+             type-of u8vector? ubyte? unix-time unpack-be-integer
              unpack-le-integer unsure-collect use utf-8->c16string
              utf-8-first-byte->length uwyde? vector vector->list
              vector-append vector-copy vector-fill! vector-move!

Index: tostring.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/tostring.wisp,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -d -r1.80 -r1.81
--- tostring.wisp	18 Sep 2002 21:06:31 -0000	1.80
+++ tostring.wisp	18 Sep 2002 21:15:23 -0000	1.81
@@ -119,6 +119,10 @@
                                (begin
                                  (emit #\#)
                                  (loop (vector->list s)))))
+                ((u8vector? s) (if (not (check-duplicity s))
+                                 (begin
+                                   (emit "#u8")
+                                   (loop (vector->list s)))))
                 ((cons? s) (if (not (check-duplicity s))
                              (cond
                                ((and (cons? (cdr s))

Index: vectors.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/vectors.wisp,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- vectors.wisp	7 Sep 2002 21:59:27 -0000	1.64
+++ vectors.wisp	18 Sep 2002 21:15:23 -0000	1.65
@@ -8,8 +8,8 @@
 
 ;;;; The fundamentals
 
-(define (list->vector l)
-  (my vec (make-vector (length l))
+(define (list->vector l (vectype <vector>))
+  (my vec (new vectype (length l))
     (my i 0
       (while (not (null? l))
         (set! vec[i] (car l))