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

port sequence/c to late-neg projections

Browse Source
This commit is contained in:
Robby Findler 2016-01-04 19:22:49 -06:00
parent 3ed7dfd62b
commit 94ac77d30e
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -182,7 +182,7 @@
(coerce-contract 'sequence/c elem/c))) (coerce-contract 'sequence/c elem/c)))
(define elem/mk-projs (define elem/mk-projs
(for/list ([ctc (in-list ctcs)]) (for/list ([ctc (in-list ctcs)])
(contract-projection ctc))) (contract-late-neg-projection ctc)))
(define n-cs (length elem/cs)) (define n-cs (length elem/cs))
(make-contract (make-contract
#:name (apply build-compound-type-name 'sequence/c #:name (apply build-compound-type-name 'sequence/c
@ -197,15 +197,15 @@
(if (vector? val) (= n-cs 1) #t) (if (vector? val) (= n-cs 1) #t)
(if (list? val) (= n-cs 1) #t) (if (list? val) (= n-cs 1) #t)
(if (hash? val) (= n-cs 2) #t))) (if (hash? val) (= n-cs 2) #t)))
#:projection #:late-neg-projection
(λ (orig-blame) (λ (orig-blame)
(define blame (blame-add-context orig-blame "an element of")) (define blame (blame-add-context orig-blame "an element of"))
(define ps (for/list ([mk-proj (in-list elem/mk-projs)]) (define ps (for/list ([mk-proj (in-list elem/mk-projs)])
(mk-proj blame))) (mk-proj blame)))
(λ (seq) (λ (seq neg-party)
(unless (sequence? seq) (unless (sequence? seq)
(raise-blame-error (raise-blame-error
orig-blame seq orig-blame #:missing-party neg-party seq
'(expected: "a sequence" given: "~e") '(expected: "a sequence" given: "~e")
seq)) seq))
(define result-seq (define result-seq
@ -220,14 +220,14 @@
(define n-elems (length elems)) (define n-elems (length elems))
(unless (= n-elems n-cs) (unless (= n-elems n-cs)
(raise-blame-error (raise-blame-error
blame seq blame #:missing-party neg-party seq
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e") '(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
n-cs n-elems elems)) n-cs n-elems elems))
(apply (apply
values values
(for/list ([elem (in-list elems)] (for/list ([elem (in-list elems)]
[p (in-list ps)]) [p (in-list ps)])
(p elem)))))) (p elem neg-party))))))
add1 add1
0 0
(lambda (idx) (lambda (idx)
@ -235,7 +235,7 @@
(when (and min-count (idx . < . min-count)) (when (and min-count (idx . < . min-count))
(unless ans (unless ans
(raise-blame-error (raise-blame-error
orig-blame orig-blame #:missing-party neg-party
seq seq
'(expected: "a sequence that contains at least ~a values" given: "~e") '(expected: "a sequence that contains at least ~a values" given: "~e")
min-count min-count