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