convert stream/c to late-neg-projection

Also, tune the projection to get a few modest performance gains.

This program gets about 20% faster:

  #lang racket
  (define s (contract (stream/c exact-nonnegative-integer?)
                      (in-naturals) 'pos 'neg))
  (time
   (for ([x (in-range 1000)])
     (for/fold ([s s])
               ([x (in-range 100)])
       (stream-rest s))))

and this program gets about 15% faster:

  #lang racket
  (define f (contract (-> (stream/c exact-nonnegative-integer?)
                          any)
                      (λ (x) 1)
                      'pos 'neg))
  (define l (make-list 10000 0))
  (time (for ([x (in-range 1000)])
          (f l) (f l) (f l) (f l) (f l)))

racket/collects/racket/stream.rkt

@@ -240,45 +240,46 @@
 (define (add-stream-context blame)
   (blame-add-context blame "a value generated by"))
 
-(define (check-stream/c ctc val blame)
-  (unless (stream? val)
-    (raise-blame-error blame val '(expected "a stream" given: "~e") val)))
-
 (define (stream/c-stronger? a b)
   (contract-stronger? (base-stream/c-content a) (base-stream/c-content b)))
 
-; streams are lazy, so we need to contract the rest of the stream lazily (which can be a list)
+(define ((late-neg-projection impersonate/chaperone-stream) ctc)
-(define (contract-stream-rest v ctc blame)
   (define elem-ctc (base-stream/c-content ctc))
-  (define new-ctc (if (list? v) (listof elem-ctc) ctc))
+  (define listof-elem-ctc (listof elem-ctc))
-  (((contract-projection new-ctc) blame) v))
+  (define elem-ctc-late-neg (get/build-late-neg-projection elem-ctc))
-
+  (define listof-elem-ctc-late-neg (get/build-late-neg-projection listof-elem-ctc))
-(define ((ho-projection impersonate/chaperone-stream) ctc)
+  (λ (blame)
-  (let ([elem-ctc (base-stream/c-content ctc)])
+    (define stream-blame (add-stream-context blame))
-    (λ (blame)
+    (define elem-ctc-late-neg-acceptor (elem-ctc-late-neg stream-blame))
-      (define stream-blame (add-stream-context blame))
+    (define listof-elem-ctc-neg-acceptor (listof-elem-ctc-late-neg stream-blame))
-      (define pos-elem-proj ((contract-projection elem-ctc) stream-blame))
+    (define (stream/c-late-neg-proj-val-acceptor val neg-party)
-      (λ (val)
+      (unless (stream? val)
-        (check-stream/c ctc val stream-blame)
+        (raise-blame-error blame #:missing-party neg-party
-        (if (list? val)
+                           val '(expected "a stream" given: "~e") val))
-            (contract-stream-rest val ctc stream-blame)
+      (if (list? val)
-            (impersonate/chaperone-stream
+          (listof-elem-ctc-neg-acceptor val neg-party)
-             val
+          (impersonate/chaperone-stream
-             (λ (v) (pos-elem-proj v))
+           val
-             (λ (v) (contract-stream-rest v ctc stream-blame))
+           (λ (v) (elem-ctc-late-neg-acceptor v neg-party))
-             impersonator-prop:contracted ctc
+           (λ (v)
-             impersonator-prop:blame stream-blame))))))
+             (if (list? v)
+                 (listof-elem-ctc-neg-acceptor v neg-party)
+                 (stream/c-late-neg-proj-val-acceptor v neg-party)))
+           impersonator-prop:contracted ctc
+           impersonator-prop:blame stream-blame)))
+    stream/c-late-neg-proj-val-acceptor))
 
 (struct base-stream/c (content))
 
 (struct chaperone-stream/c base-stream/c ()
   #:property prop:custom-write custom-write-property-proc
   #:property prop:chaperone-contract
-  (build-chaperone-contract-property
+  (parameterize ([skip-projection-wrapper? #t])
-   #:name stream/c-name
+    (build-chaperone-contract-property
-   #:first-order stream?
+     #:name stream/c-name
-   #:stronger stream/c-stronger?
+     #:first-order stream?
-   #:projection (ho-projection chaperone-stream)))
+     #:stronger stream/c-stronger?
+     #:late-neg-projection (late-neg-projection chaperone-stream))))
 
 (struct impersonator-stream/c base-stream/c ()
   #:property prop:custom-write custom-write-property-proc
@@ -287,7 +288,7 @@
    #:name stream/c-name
    #:first-order stream?
    #:stronger stream/c-stronger?
-   #:projection (ho-projection impersonate-stream)))
+   #:late-neg-projection (late-neg-projection impersonate-stream)))
 
 (define (stream/c elem)
   (define ctc (coerce-contract 'stream/c elem))