Supporting byte-regexps and boxes in tester. Improving speed/allocation of parser and noting places where we could do better. Updating struct contracts in code and docs.

svn: r18262

original commit: 1eea5163cc

collects/compiler/zo-parse.ss

@@ -72,6 +72,7 @@
                                 (values (cdr v) #t))])
     (match v
       [`(,i ,tv . ,sv)
+       ; XXX Why not leave them as vectors and change the contract?
        (make-prefix i (vector->list tv) (vector->list sv))])))
 
 (define (read-unclosed-procedure v)
@@ -150,11 +151,13 @@
 (define (read-sequence v) 
   (make-seq v))
 
+; XXX Allocates unnessary list
 (define (read-define-values v)
   (make-def-values
    (cdr (vector->list v))
    (vector-ref v 0)))
 
+; XXX Allocates unnessary list
 (define (read-define-syntaxes mk v)
   (mk (list-tail (vector->list v) 4)
       (vector-ref v 0)
@@ -463,7 +466,10 @@
                  n)))]))
 
 (define (read-compact-svector port n)
-  (list->vector (reverse (for/list ([i (in-range n)]) (read-compact-number port)))))
+  (define v (make-vector n))
+  (for ([i (in-range n)])
+    (vector-set! v (sub1 (- n i)) (read-compact-number port)))
+  v)
 
 (define (read-marshalled type port)
   (let* ([type (if (number? type) (int->type type) type)]
@@ -665,7 +671,7 @@
       [nominal-path
        (make-simple-nominal-path nominal-path)]))
   
-  ; XXX Matthew, I'm ashamed
+  ; XXX Weird test copied from C code. Matthew?
   (define (nom_mod_p p)
     (and (pair? p) (not (pair? (cdr p))) (not (symbol? (cdr p))))) 
   
@@ -799,25 +805,34 @@
           [(true) #t]
           [(null) null]
           [(void) (void)]
-          [(vector) (let* ([n (read-compact-number cp)]
+          [(vector) 
-                           [lst (for/list ([i (in-range n)])
+           ; XXX We should provide build-immutable-vector and write this as:
-                                  (read-compact cp))])
+           #;(build-immutable-vector (read-compact-number cp)
-                      (vector->immutable-vector (list->vector lst)))]
+                                     (lambda (i) (read-compact cp)))
-          [(list) (let* ([n (read-compact-number cp)])
+           ; XXX Now it allocates an unnessary list AND vector
-                    (append
+           (let* ([n (read-compact-number cp)]
-                     (for/list ([i (in-range n)])
+                  [lst (for/list ([i (in-range n)])
-                       (read-compact cp))
+                         (read-compact cp))])
-                     (read-compact cp)))]
+             (vector->immutable-vector (list->vector lst)))]
+          [(list) 
+           (let ([len (read-compact-number cp)])
+             (let loop ([i len])
+               (if (zero? i)
+                   (read-compact cp)
+                   (list* (read-compact cp)
+                          (loop (sub1 i))))))]
           [(prefab)
            (let ([v (read-compact cp)])
-             (apply make-prefab-struct
+             ; XXX This is faster than apply+->list, but can we avoid allocating the vector?
-                    (vector-ref v 0)
+             (call-with-values (lambda () (vector->values v))
-                    (cdr (vector->list v))))]
+                               make-prefab-struct))]
           [(hash-table)
+           ; XXX Allocates an unnessary list (maybe use for/hash(eq))
            (let ([eq (read-compact-number cp)]
                  [len (read-compact-number cp)])
              ((case eq
                 [(0) make-hasheq-placeholder]
+                ; XXX One of these should be eqv
                 [(1) make-hash-placeholder]
                 [(2) make-hash-placeholder])
               (for/list ([i (in-range len)])

collects/compiler/zo-structs.ss

@@ -166,7 +166,7 @@
 (define-form-struct (imported-nominal-path nominal-path) ([value module-path-index?] 
                                                           [import-phase exact-integer?]))
 (define-form-struct (phased-nominal-path nominal-path) ([value module-path-index?]
-                                                        [import-phase exact-integer?]
+                                                        [import-phase (or/c false/c exact-integer?)]
                                                         [phase exact-integer?]))
 
 (define-form-struct module-binding ())

collects/tests/compiler/zo-test.ss

@@ -124,6 +124,19 @@
               (yield p "Unequal regexp" v1 v2))]
            [_
             (yield p "Not a regexp on right" v1 v2)])]
+        [(? byte-regexp?)
+         (match v2
+           [(? byte-regexp?)
+            (unless (bytes=? (object-name v1) (object-name v2))
+              (yield p "Unequal byte-regexp" v1 v2))]
+           [_
+            (yield p "Not a byte-regexp on right" v1 v2)])]
+        [(? box?)
+         (match v2
+           [(? box?)
+            (inner (list* 'unbox) (unbox v1) (unbox v2))]
+           [_
+            (yield p "Not a box on right" v1 v2)])]
         [(? symbol?)
          (match v2
            [(? symbol?)