From efee5c45814f009b78c0ba87c65546182707b6f0 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 2 Mar 2015 16:59:01 -0600 Subject: [PATCH] move sequence/c into racket/sequence --- .../scribblings/reference/sequences.scrbl | 45 +++++++++++- .../tests/racket/contract/sequence.rkt | 56 ++++++++++++++ racket/collects/racket/sequence.rkt | 73 ++++++++++++++++++- 3 files changed, 170 insertions(+), 4 deletions(-) create mode 100644 pkgs/racket-test/tests/racket/contract/sequence.rkt diff --git a/pkgs/racket-doc/scribblings/reference/sequences.scrbl b/pkgs/racket-doc/scribblings/reference/sequences.scrbl index 447bdcddc4..089f4f4ab9 100644 --- a/pkgs/racket-doc/scribblings/reference/sequences.scrbl +++ b/pkgs/racket-doc/scribblings/reference/sequences.scrbl @@ -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 diff --git a/pkgs/racket-test/tests/racket/contract/sequence.rkt b/pkgs/racket-test/tests/racket/contract/sequence.rkt new file mode 100644 index 0000000000..5e775ed2eb --- /dev/null +++ b/pkgs/racket-test/tests/racket/contract/sequence.rkt @@ -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))))) + + + \ No newline at end of file diff --git a/racket/collects/racket/sequence.rkt b/racket/collects/racket/sequence.rkt index bd2a59ffa8..998dd0f101 100644 --- a/racket/collects/racket/sequence.rkt +++ b/racket/collects/racket/sequence.rkt @@ -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)))))))))