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

Add instrumentation to sequence/c.

Browse Source
This commit is contained in:
Vincent St-Amour 2016-01-13 16:22:58 -06:00
parent 451ef1d37e
commit d5ae7125e5
2 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -583,4 +583,18 @@
marked?)
#t)
(test/spec-passed
'contract-marks63
'(let ()
(eval '(require racket/sequence))
(eval '(sequence->list (contract (sequence/c pos-blame?) (in-range 3) 'pos 'neg)))))
(test/spec-passed
'contract-marks64
'(let ()
(eval '(require racket/sequence racket/dict))
(eval '(sequence-ref (contract (sequence/c pos-blame? pos-blame?)
(in-dict '((1 . 2) (3 . 4))) 'pos 'neg)
0))))
)

30
racket/collects/racket/sequence.rkt
View File

@ -218,6 +218,7 @@
orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e")
seq))
(define blame+neg-party (cons orig-blame neg-party))
(define result-seq
(make-do-sequence
(lambda ()
@ -228,7 +229,9 @@
next
(case-lambda
[(elem)
(p elem neg-party)]
(with-contract-continuation-mark
blame+neg-party
(p elem neg-party))]
[elems
(define n-elems (length elems))
(raise-blame-error
@ -251,6 +254,7 @@
orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e")
seq))
(define blame+neg-party (cons orig-blame neg-party))
(define result-seq
(make-do-sequence
(lambda ()
@ -260,17 +264,19 @@
(call-with-values
next
(lambda elems
(define n-elems (length elems))
(unless (= n-elems n-cs)
(raise-blame-error
blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems))
(apply
values
(for/list ([elem (in-list elems)]
[p (in-list ps)])
(p elem neg-party))))))
(with-contract-continuation-mark
blame+neg-party
(define n-elems (length elems))
(unless (= n-elems n-cs)
(raise-blame-error
blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems))
(apply
values
(for/list ([elem (in-list elems)]
[p (in-list ps)])
(p elem neg-party)))))))
add1
0
(lambda (idx)