Avoid traversing immutable vectors when specified.

This adds #:eager as an option for controlling this behavior.

Using `#:eager 10` is a 2x improvement in performance for configuration 010001
of the suffixtree benchmark from Takikawa et al, POPL 2016.

The default behavior is unchanged. This is configurable because some
programs are much faster when eager checking is performed. For example:

(require racket/contract)
(collect-garbage)
(time (for/sum ([_ 100000])
        (vector-ref (contract (vectorof integer? #:eager #t) #(1) 'pos 'neg)
                    0)))
(collect-garbage)

(time (for/sum ([_ 100000])
        (vector-ref (contract (vectorof integer? #:eager #f) #(1) 'pos 'neg)
                    0)))

The second loop is 3-4 times slower than the first. However, making
the vector much larger will make the difference go the other way.

pkgs/racket-doc/scribblings/reference/contracts.scrbl

@@ -420,7 +420,8 @@ passes its arguments to @racket[or/c].
 
 @defproc[(vectorof [c contract?]
                    [#:immutable immutable (or/c #t #f 'dont-care) 'dont-care]
-                   [#:flat? flat? boolean? #f])
+                   [#:flat? flat? boolean? #f]
+                   [#:eager eager (or/c #t #f exact-nonnegative-integer?) #t])
          contract?]{
 Returns a @tech{contract} that recognizes vectors. The elements of the vector must
 match @racket[c].
@@ -431,9 +432,16 @@ a @tech{flat contract}, and the @racket[c] argument must also be a @tech{flat co
 check future operations on the vector.
 
 If the @racket[immutable] argument is @racket[#t] and the @racket[c] argument is
-a @tech{flat contract}, the result will be a @tech{flat contract}.  If the @racket[c] argument
+a @tech{flat contract} and the @racket[eager] argument is @racket[#t],
+the result will be a @tech{flat contract}.  If the @racket[c] argument
 is a @tech{chaperone contract}, then the result will be a @tech{chaperone contract}.
 
+If the @racket[eager] argument is @racket[#t], then immutable vectors are
+checked eagerly when @racket[c] is a @tech{flat contract}. If the
+@racket[eager] argument is a number @racket[n], then immutable vectors are checked
+eagerly when @racket[c] is a @tech{flat contract} and the length of the vector
+is less than or equal to @racket[n].}.
+
 When a higher-order @racket[vectorof] contract is applied to a vector, the result
 is not @racket[eq?] to the input.  The result will be a copy for immutable vectors
 and a @tech{chaperone} or @tech{impersonator} of the input for mutable vectors,
@@ -441,7 +449,8 @@ unless the @racket[c] argument is a @tech{flat contract} and the vector is immut
 in which case the result is the original vector.
 
 @history[#:changed "6.3.0.5" @list{Changed flat vector contracts to not copy
-           immutable vectors.}]}
+           immutable vectors.}
+         #:changed "6.7.0.3" @list{Added the @racket[#:eager] option.}]}
 
 
 @defproc[(vector-immutableof [c contract?]) contract?]{

pkgs/racket-test/tests/racket/contract/vector.rkt

@@ -148,5 +148,24 @@
                 0)
    1
    2)
-  
+
+  (test/spec-passed/result
+   'vectorof-eager
+   '(vector-ref (contract (vectorof integer? #:eager #f) (vector-immutable 0 "") 'pos 'neg) 0)
+   0)
+
+  (test/spec-passed/result
+   'vectorof-eager-1
+   '(vector-ref (contract (vectorof integer? #:eager 1) (vector-immutable 0 "") 'pos 'neg) 0)
+   0)
+
+
+  (test/pos-blame
+   'vectorof-eager-1-fail
+   '(vector-ref (contract (vectorof integer? #:eager 2) (vector-immutable 0 "") 'pos 'neg) 1))
+
+  (test/pos-blame
+   'vectorof-eager-fail
+   '(contract (vectorof integer? #:eager 5) (vector-immutable 0 "") 'pos 'neg))
+
   )

racket/collects/racket/contract/private/vector.rkt

@@ -10,7 +10,11 @@
                      [wrap-vector/c vector/c])
          vector-immutable/c vector-immutableof)
 
-(define-struct base-vectorof (elem immutable))
+;; eager is one of:
+;; - #t: always perform an eager check of the elements of an immutable vector
+;; - #f: never  perform an eager check of the elements of an immutable vector
+;; - N (for N>=0): perform an eager check of immutable vectors size <= N
+(define-struct base-vectorof (elem immutable eager))
 
 (define-for-syntax (convert-args args this-one)
   (let loop ([args args]
@@ -148,6 +152,7 @@
   (λ (ctc)
     (define elem-ctc (base-vectorof-elem ctc))
     (define immutable (base-vectorof-immutable ctc))
+    (define eager (base-vectorof-eager ctc))
     (define check (check-vectorof ctc))
     (λ (blame)
       (define pos-blame (blame-add-element-of-context blame))
@@ -174,7 +179,12 @@
            (define (raise-blame val . args) 
              (apply raise-blame-error blame #:missing-party neg-party val args))
            (check val raise-blame #f)
-           (if (and (immutable? val) (not (chaperone? val)))
+           ;; avoid traversing large vectors
+           ;; unless `eager` is specified
+           (if (and (or (equal? eager #t)
+                        (and eager (<= (vector-length val) eager)))
+                    (immutable? val)
+                    (not (chaperone? val)))
                (begin (for ([e (in-vector val)])
                         (unless (p? e)
                           (elem-pos-proj e neg-party)))
@@ -240,20 +250,30 @@
           'racket/contract:contract
           (vector this-one (list #'vecof) null))))]))
 
-(define/subexpression-pos-prop (vectorof c #:immutable [immutable 'dont-care] #:flat? [flat? #f])
+(define/subexpression-pos-prop (vectorof c #:immutable [immutable 'dont-care] #:flat? [flat? #f] #:eager [eager #t])
   (define ctc
     (if flat?
         (coerce-flat-contract 'vectorof c)
         (coerce-contract 'vectorof c)))
+  (unless (or (boolean? eager)
+              (exact-nonnegative-integer? eager))
+    (raise-argument-error 'vectorof
+                          "(or/c #t #f exact-nonnegative-integer?)"
+                          eager))
   (cond
-    [(or flat?
+    [(and flat? (not (equal? eager #t)))
+     (raise-arguments-error 'vectorof "flat? cannot be true unless eager is true"
+                            "flat?" flat?
+                            "eager" eager)]
+    [(or (and flat? (equal? eager #t))
          (and (equal? immutable #t)
+              (equal? eager #t)
               (flat-contract? ctc)))
-     (make-flat-vectorof ctc immutable)]
+     (make-flat-vectorof ctc immutable eager)]
     [(chaperone-contract? ctc)
-     (make-chaperone-vectorof ctc immutable)]
+     (make-chaperone-vectorof ctc immutable eager)]
     [else
-     (make-impersonator-vectorof ctc immutable)]))
+     (make-impersonator-vectorof ctc immutable eager)]))
 
 (define/subexpression-pos-prop (vector-immutableof c)
   (vectorof c #:immutable #t))