suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Instrument stream/c.

Browse Source
This commit is contained in:
Vincent St-Amour 2016-01-12 16:57:03 -06:00
parent 74c423bb24
commit b8af007d94
2 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-test/tests/racket/contract/prof.rkt
View File

@ -556,4 +556,10 @@
(eval '(set-add s 3)) (eval '(set-add s 3))
(eval '(set-member? s 3)))) (eval '(set-member? s 3))))
(test/spec-passed
'contract-marks61
'(let ()
(eval '(require racket/stream))
(eval '(stream-first (contract (stream/c pos-blame?) (in-range 3) 'pos 'neg)))))
) )

13
racket/collects/racket/stream.rkt
View File

@ -256,15 +256,20 @@
(unless (stream? val) (unless (stream? val)
(raise-blame-error blame #:missing-party neg-party (raise-blame-error blame #:missing-party neg-party
val '(expected "a stream" given: "~e") val)) val '(expected "a stream" given: "~e") val))
(define blame+neg-party (cons blame neg-party))
(if (list? val) (if (list? val)
(listof-elem-ctc-neg-acceptor val neg-party) (listof-elem-ctc-neg-acceptor val neg-party)
(impersonate/chaperone-stream (impersonate/chaperone-stream
val val
(λ (v) (elem-ctc-late-neg-acceptor v neg-party)) (λ (v) (with-contract-continuation-mark
blame+neg-party
(elem-ctc-late-neg-acceptor v neg-party)))
(λ (v) (λ (v)
(if (list? v) (with-contract-continuation-mark
(listof-elem-ctc-neg-acceptor v neg-party) blame+neg-party
(stream/c-late-neg-proj-val-acceptor v neg-party))) (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:contracted ctc
impersonator-prop:blame stream-blame))) impersonator-prop:blame stream-blame)))
stream/c-late-neg-proj-val-acceptor)) stream/c-late-neg-proj-val-acceptor))