sequence/c changes

- build the sub projections only once and build them before getting
  the blame objects (instead of after getting the actual values)
- added context information to the blame objects
- added an optional #:min-count argument to insist on a minimum length
  for the stream

related to PR 13709

collects/tests/unstable/contract.rkt

@@ -36,7 +36,12 @@
        (test-bad
          (for ([(x y) (with/c (sequence/c integer?)
                               (in-dict (list (cons 1 'one) (cons 2 'two))))])
-           (void)))))
+           (void)))
+       (let ([s (sequence->stream (contract (sequence/c #:min-count 2 any/c) "x" 'pos 'neg))])
+         (check-equal? (stream-first s) #\x)
+         (check-exn (λ (x) (and (exn:fail? x)
+                                (regexp-match #rx"blaming: pos" (exn-message x))))
+                    (lambda () (stream-first (stream-rest s)))))))
    (test-suite "Data structure contracts"
      (test-suite "maybe/c"
        (test-true "flat" (flat-contract? (maybe/c number?)))

collects/unstable/contract.rkt

@@ -133,23 +133,30 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (sequence/c . elem/cs)
+(define (sequence/c #:min-count [min-count #f] . elem/cs)
-  (let* ([elem/cs (for/list ([elem/c (in-list elem/cs)])
+  (define ctcs (for/list ([elem/c (in-list elem/cs)])
-                    (coerce-contract 'sequence/c elem/c))]
+                 (coerce-contract 'sequence/c elem/c)))
-         [n-cs (length elem/cs)])
+  (define elem/mk-projs 
+    (for/list ([ctc (in-list ctcs)])
+      (contract-projection ctc)))
+  (define n-cs (length elem/cs))
   (make-contract
-     #:name (apply build-compound-type-name 'sequence/c elem/cs)
+   #:name (apply build-compound-type-name 'sequence/c 
+                 (append
+                  (if min-count
+                      (list '#:min-count min-count)
+                      '())
+                  ctcs))
    #:first-order sequence?
    #:projection
-     (λ (blame)       
+   (λ (orig-blame)
+     (define blame (blame-add-context orig-blame "an element of"))
+     (define ps (for/list ([mk-proj (in-list elem/mk-projs)])
+                  (mk-proj blame)))
      (λ (seq)
-         (define pos (blame-positive blame))
-         (define neg (blame-negative blame))
-         (define src (list (blame-source blame) (blame-value blame)))
-         (define name (blame-contract blame))
        (unless (sequence? seq)
          (raise-blame-error
-            blame seq
+          orig-blame seq
           '(expected: "a sequence" given: "~e")
           seq))
        (make-do-sequence
@@ -168,13 +175,23 @@
                                    (apply
                                     values
                                     (for/list ([elem (in-list elems)]
-                                                 [elem/c (in-list elem/cs)])
+                                               [p (in-list ps)])
-                                        (((contract-projection elem/c) blame) elem))))))
+                                      (p elem))))))
-               (lambda (idx) idx)
+             add1
-               #f
+             0
-               (lambda (idx) (more?))
+             (lambda (idx) 
+               (define ans (more?))
+               (when (and min-count (idx . < . min-count))
+                 (unless ans
+                   (raise-blame-error 
+                    orig-blame
+                    seq
+                    '(expected: "a sequence that contains at least ~a values" given: "~e")
+                    min-count
+                    seq)))
+               ans)
              (lambda elems #t)
-               (lambda (idx . elems) #t))))))))))
+             (lambda (idx . elems) #t)))))))))
 
 ;; Added by ntoronto
 
@@ -202,8 +219,10 @@
 
  [truth/c flat-contract?]
 
- [sequence/c (->* [] [] #:rest (listof contract?) contract?)]
+ [sequence/c (->* () 
+                  (#:min-count (or/c #f exact-nonnegative-integer?))
+                  #:rest (listof contract?) 
+                  contract?)]
  
- [treeof (contract? . -> . contract?)]
+ [treeof (contract? . -> . contract?)])
- )
 

collects/unstable/scribblings/contract.scrbl

@@ -89,7 +89,9 @@ that accept arbitrary truth values that may not be booleans.
 
 }
 
-@defproc[(sequence/c [elem/c contract?] ...) contract?]{
+@defproc[(sequence/c [#:min-count min-count (or/c #f exact-nonnegative-integer?) #f]
+                     [elem/c contract?] ...)
+         contract?]{
 
 Wraps a @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{sequence},
 obligating it to produce as many values as there are @racket[elem/c] contracts,
@@ -97,6 +99,8 @@ and obligating each value to satisfy the corresponding @racket[elem/c].  The
 result is not guaranteed to be the same kind of sequence as the original value;
 for instance, a wrapped list is not guaranteed to satisfy @racket[list?].
 
+If @racket[min-count] is a number, the stream is required to have at least that many elements in it.
+
 @defexamples[
 #:eval the-eval
 (define/contract predicates
@@ -112,6 +116,12 @@ for instance, a wrapped list is not guaranteed to satisfy @racket[list?].
                  (cons 3 'three))))
 (for ([(N S) numbers&strings])
   (printf "~s: ~a\n" N S))
+(define/contract a-sequence
+  (sequence/c #:min-count 2 char?)
+  "x")
+(for ([x a-sequence]
+      [i (in-naturals)])
+  (printf "~a is ~a\n" i x))
 ]
 
 }