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

move sequence/c into racket/sequence

Browse Source
This commit is contained in:
Robby Findler 2015-03-02 16:59:01 -06:00
parent 16a9f86f90
commit efee5c4581
3 changed files with 170 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
pkgs/racket-doc/scribblings/reference/sequences.scrbl
View File

@ -25,7 +25,8 @@ vice-versa.
@(define sequence-evaluator
(let ([evaluator (make-base-eval)])
(evaluator '(require racket/generic racket/list racket/stream racket/sequence))
(evaluator '(require racket/generic racket/list racket/stream racket/sequence
racket/contract))
evaluator))
@guideintro["sequences"]{sequences}
@ -145,7 +146,7 @@ example, a hash table generates two values---a key and its value---for
each element in the sequence.
@; ----------------------------------------------------------------------
@subsection{Sequence Predicate and Constructors}
@subsection{Sequence Predicate and Contract}
@defproc[(sequence? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] can be used as a @tech{sequence},
@ -157,6 +158,46 @@ each element in the sequence.
(sequence? "word")
(sequence? #\x)]}
@defproc[(sequence/c [#:min-count min-count (or/c #f exact-nonnegative-integer?) #f]
[elem/c contract?] ...)
contract?]{
Wraps a @tech{sequence},
obligating it to produce as many values as there are @racket[elem/c] contracts,
and obligating each value to satisfy the corresponding @racket[elem/c]. The
result is not guaranteed to be the same kind of sequence as the original value;
for instance, a wrapped list is not guaranteed to satisfy @racket[list?].
If @racket[min-count] is a number, the stream is required to have at least that many elements in it.
@defexamples[
#:eval sequence-evaluator
(define/contract predicates
(sequence/c (-> any/c boolean?))
(in-list (list integer?
string->symbol)))
(for ([P predicates])
(printf "~s\n" (P "cat")))
(define/contract numbers&strings
(sequence/c number? string?)
(in-dict (list (cons 1 "one")
(cons 2 "two")
(cons 3 'three))))
(for ([(N S) numbers&strings])
(printf "~s: ~a\n" N S))
(define/contract a-sequence
(sequence/c #:min-count 2 char?)
"x")
(for ([x a-sequence]
[i (in-naturals)])
(printf "~a is ~a\n" i x))
]
}
@subsection{Sequence Constructors}
@defproc*[([(in-range [end number?]) stream?]
[(in-range [start number?] [end number?] [step number? 1]) stream?])]{
Returns a sequence (that is also a @tech{stream}) whose elements are

56
pkgs/racket-test/tests/racket/contract/sequence.rkt Normal file
View File

@ -0,0 +1,56 @@
#lang racket/base
(require "test-util.rkt")
(parameterize ([current-contract-namespace
(make-basic-contract-namespace
'racket/sequence 'racket/dict
'racket/stream)])
(test/spec-passed
'sequence/c1
'(for ([x (contract (sequence/c integer?) '(1 2 3 4) 'pos 'neg)])
(void)))
(test/pos-blame
'sequence/c2
'(for ([x (contract (sequence/c integer?) '(1 2 #f 4) 'pos 'neg)])
(void)))
(test/pos-blame
'sequence/c3
'(for ([x (contract (sequence/c integer? symbol?) (list 1 2 3 4) 'pos 'neg)])
(void)))
(test/spec-passed
'sequence/c4
'(for ([(x y) (contract (sequence/c integer? symbol?)
(in-dict (list (cons 1 'one) (cons 2 'two)))
'pos 'neg)])
(void)))
(test/pos-blame
'sequence/c5
'(for ([(x y) (contract (sequence/c integer? symbol?)
(in-dict (list (cons 1 'one) (cons 2 "two")))
'pos 'neg)])
(void)))
(test/pos-blame
'sequence/c6
'(for ([(x y) (contract (sequence/c integer?)
(in-dict (list (cons 1 'one) (cons 2 'two)))
'pos 'neg)])
(void)))
(test/spec-passed/result
'sequence/c7
'(let ([s (sequence->stream (contract (sequence/c #:min-count 2 any/c) "x" 'pos 'neg))])
(stream-first s))
#\x)
(test/pos-blame
'sequence/c7
'(let ([s (sequence->stream (contract (sequence/c #:min-count 2 any/c) "x" 'pos 'neg))])
(stream-first (stream-rest s)))))

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

@ -1,7 +1,9 @@
#lang racket/base
(require "stream.rkt"
"private/sequence.rkt")
"private/sequence.rkt"
racket/contract/combinator
racket/contract/base)
(provide empty-sequence
sequence->list
@ -16,7 +18,8 @@
sequence-fold
sequence-filter
sequence-add-between
sequence-count)
sequence-count
sequence/c)
(define empty-sequence
(make-do-sequence
@ -160,3 +163,69 @@
car
#f
#f))))))
(define (sequence/c #:min-count [min-count #f] . elem/cs)
(unless (or (exact-nonnegative-integer? min-count)
(not min-count))
(raise-argument-error 'sequence/c
(format "~s" '(or/c exact-nonnegative-integer? #f))
min-count))
(define ctcs (for/list ([elem/c (in-list elem/cs)])
(coerce-contract 'sequence/c elem/c)))
(define elem/mk-projs
(for/list ([ctc (in-list ctcs)])
(contract-projection ctc)))
(define n-cs (length elem/cs))
(make-contract
#:name (apply build-compound-type-name 'sequence/c
(append
(if min-count
(list '#:min-count min-count)
'())
ctcs))
#:first-order sequence?
#:projection
(λ (orig-blame)
(define blame (blame-add-context orig-blame "an element of"))
(define ps (for/list ([mk-proj (in-list elem/mk-projs)])
(mk-proj blame)))
(λ (seq)
(unless (sequence? seq)
(raise-blame-error
orig-blame seq
'(expected: "a sequence" given: "~e")
seq))
(make-do-sequence
(lambda ()
(let*-values ([(more? next) (sequence-generate seq)])
(values
(lambda (idx)
(call-with-values
next
(lambda elems
(define n-elems (length elems))
(unless (= n-elems n-cs)
(raise-blame-error
blame 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))))))
add1
0
(lambda (idx)
(define ans (more?))
(when (and min-count (idx . < . min-count))
(unless ans
(raise-blame-error
orig-blame
seq
'(expected: "a sequence that contains at least ~a values" given: "~e")
min-count
seq)))
ans)
(lambda elems #t)
(lambda (idx . elems) #t)))))))))