├── .gitignore ├── .travis.yml ├── LICENSE.txt ├── README.md ├── collections-doc ├── info.rkt └── scribblings │ ├── data │ └── collection │ │ ├── collection │ │ ├── examples.scrbl │ │ ├── experimental.scrbl │ │ ├── introduction.scrbl │ │ └── reference.scrbl │ │ ├── collections.scrbl │ │ └── private │ │ └── utils.rkt │ └── info.rkt ├── collections-lib ├── data │ ├── collection.rkt │ └── collection │ │ ├── collection.rkt │ │ ├── contract.rkt │ │ ├── countable.rkt │ │ ├── experimental │ │ └── quasi.rkt │ │ ├── indexable.rkt │ │ ├── match.rkt │ │ ├── private │ │ ├── random-access.rkt │ │ └── util.rkt │ │ └── sequence.rkt └── info.rkt ├── collections-test ├── info.rkt └── tests │ └── data │ └── collection │ ├── collection.rkt │ ├── contract.rkt │ ├── dict.rkt │ ├── experimental │ └── quasi.rkt │ ├── match.rkt │ ├── sequence-lib.rkt │ └── sequence.rkt ├── collections └── info.rkt └── deploy-docs.sh /.gitignore: -------------------------------------------------------------------------------- 1 | # Racket compiled files 2 | compiled/ 3 | 4 | # Scribble documentation files 5 | doc/ 6 | 7 | # cover-generated code coverage reports 8 | coverage/ 9 | 10 | # common backups, autosaves, lock files, OS meta-files 11 | *~ 12 | \#* 13 | .#* 14 | .DS_Store 15 | *.bak 16 | TAGS 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | sudo: false 4 | 5 | env: 6 | global: 7 | - RACKET_DIR: '~/racket' 8 | - GH_REF: 'github.com/lexi-lambda/racket-collections.git' 9 | - secure: 'nyKZY6uUXYxDjt/NcrNDBjLVRL8Ia6WYLweE59mZeNHw363e5L0fBbb0ThVX0Za51jWGCPRuANFZxIvD5S29zvCo/h3LLUvtM1PVR0YUPAKOvxjAgU0h56Bf1m8Ua61ON5Tk5O4mBTqwlKdpDW1E2w4tbkp2riLX2gqP/rHlgOBg2Af9fCCdosQu9ZayiUPqeVT4tm91p6HiY5pWcUnfbrRKwss7hylYG9d0h8qlRWvS9yfzt5BVjcKzthmpP1vPUGketgPqnWUNelnP05WJGgx9jui7gBam/XHZOWNQHGfOu9Hq0p4/mojD2xXJiv1thfsmIhR7gIWsrm4uapk7WVdt8aTNBLA9hc5izoaX6AOoB+94w5QxkqnonfTAY1SqcPY2KWTjypQ+HdIyVbuX5ZyqnXfAP3G93xEjRUgBDzI5/QiJBCLRux2Lbs++K8eTD1jy4X4lM37yUFeKYkciafQu4krW00PTHN2J0CJIjCeYMr3kS42UE53eSnEoI4Yip+oNW3n9LMxr3oiNTmY4kJOxpFYnDLRAk5lt8onS+KignvuV1CYexqdr6YCWqTJSmhGtzBhpB4gBCPPXrR1myU459t0vA0GzLr4QLgV0GKyC1nPM1XEgTZM8TdxqnGwofVlKylFNckzqHR5VY1lVDaOFJ3r6dYgni7QXrxOZ77Y=' 10 | matrix: 11 | - RACKET_VERSION: 6.3 12 | - RACKET_VERSION: 6.4 13 | - RACKET_VERSION: 6.5 14 | - RACKET_VERSION: 6.6 15 | - RACKET_VERSION: HEAD 16 | 17 | before_install: 18 | - git clone https://github.com/greghendershott/travis-racket.git 19 | - cat travis-racket/install-racket.sh | bash 20 | - export PATH="${RACKET_DIR}/bin:${PATH}" 21 | 22 | install: 23 | - raco pkg install --auto --link 24 | $TRAVIS_BUILD_DIR/collections 25 | $TRAVIS_BUILD_DIR/collections-lib 26 | $TRAVIS_BUILD_DIR/collections-doc 27 | $TRAVIS_BUILD_DIR/collections-test 28 | - raco pkg install --auto cover cover-coveralls 29 | 30 | script: 31 | - raco test -ep collections-lib collections-test 32 | - raco cover -bf coveralls -d $TRAVIS_BUILD_DIR/coverage -p collections-lib collections-test 33 | 34 | after_success: 35 | - bash deploy-docs.sh 36 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Alexis King 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # collections [![Build Status](https://travis-ci.org/lexi-lambda/racket-collections.svg?branch=master)](https://travis-ci.org/lexi-lambda/racket-collections) [![Coverage Status](https://coveralls.io/repos/lexi-lambda/racket-collections/badge.svg?branch=master)](https://coveralls.io/r/lexi-lambda/racket-collections?branch=master) 2 | 3 | This package provides **generic collections** for Racket. It uses Racket's [generics](http://docs.racket-lang.org/reference/struct-generics.html) to provide a implementation-agnostic interface for manipulating collections. 4 | 5 | [**See the docs for more information.**](http://lexi-lambda.github.io/racket-collections/index.html) 6 | -------------------------------------------------------------------------------- /collections-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define version "1.3.1") 6 | 7 | (define deps 8 | '()) 9 | (define build-deps 10 | '("base" 11 | "collections-lib" 12 | "functional-doc" 13 | "racket-doc" 14 | "scribble-lib")) 15 | -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/collection/examples.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require 4 | racket/require 5 | (for-label (subtract-in 6 | (combine-in 7 | racket/base 8 | racket/list 9 | racket/set 10 | racket/dict) 11 | data/collection) 12 | (prefix-in base: racket/base) 13 | data/collection 14 | racket/generic 15 | racket/contract 16 | racket/stream 17 | racket/string 18 | racket/match) 19 | scribble/eval 20 | "../private/utils.rkt") 21 | 22 | @title[#:tag "collections-examples"]{Examples} 23 | 24 | Obviously, the primary purpose of generic collections is the ability to operate on values in a 25 | collection-agnostic way. For example, it is possible to map over all kinds of sequences, even 26 | sequences of heterogenous types. 27 | 28 | @(coll-interaction 29 | (sequence->list (map + #(1 2 3) (stream 10 20 30)))) 30 | 31 | However, more interesting applications of generic collections involve the ability to use lazy 32 | sequences to create infinite streams of values. For example, it is possible to create an infinite 33 | stream of all the Fibonacci numbers: 34 | 35 | @(coll-interaction 36 | (define fibs (stream-cons 1 (stream-cons 1 (map + fibs (rest fibs))))) 37 | (sequence->list (take 15 fibs))) 38 | 39 | Similarly, here is an implementation of the classic 40 | @hyperlink["http://en.wikipedia.org/wiki/Fizz_buzz#Other_uses"]{“fizz buzz” problem} that uses 41 | infinite sequences: 42 | 43 | @(coll-interaction 44 | (define ((divisible-by? x) n) 45 | (zero? (remainder n x))) 46 | (define fizzbuzz 47 | (map 48 | (match-lambda 49 | [(? (divisible-by? 15)) 'fizzbuzz] 50 | [(? (divisible-by? 3)) 'fizz] 51 | [(? (divisible-by? 5)) 'buzz] 52 | [n n]) 53 | (in-naturals 1))) 54 | (sequence->list (take 20 fizzbuzz))) 55 | -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/collection/experimental.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require 4 | racket/require 5 | (for-label (subtract-in 6 | (combine-in 7 | racket/base 8 | racket/list 9 | racket/set 10 | racket/dict 11 | racket/math) 12 | data/collection) 13 | (prefix-in base: racket/base) 14 | data/collection 15 | racket/function 16 | racket/generic 17 | racket/contract 18 | racket/stream 19 | racket/string 20 | racket/match 21 | racket/generator) 22 | scribble/core 23 | "../private/utils.rkt") 24 | 25 | @(module racket-forms racket/base 26 | (require (for-label racket/base) 27 | scribble/manual) 28 | (provide racket:quasiquote) 29 | (define racket:quasiquote 30 | (racket quasiquote))) 31 | @(require 'racket-forms) 32 | 33 | @title[#:tag "experimental"]{Experimental Forms and Functions} 34 | 35 | @(define (yellow . content) 36 | (make-element (make-style #f (list (make-background-color-property "yellow"))) content)) 37 | 38 | @nested[#:style 'inset]{ 39 | @yellow{@bold{WARNING}}: The following forms and functions are @emph{experimental}; compatibility 40 | will not be maintained.} 41 | 42 | @section{Generic Quasiquotation} 43 | 44 | @defmodule[data/collection/experimental/quasi] 45 | 46 | @defform[(quasiquote datum)]{ 47 | Equivalent to @racket:quasiquote from @racketmodname[racket/base], except that uses of 48 | @racket[unquote-splicing] accept arbitrary @racket[sequence?] values instead of only lists. 49 | 50 | Note that this handling only applies to uses of @racket[unquote-splicing], not @racket[unquote], so 51 | @racket[`(1 @#,racketvalfont{.} ,_more)] will produce different results from @racket[`(1 ,@_more)] 52 | when @racket[_more] is a non-list sequence. 53 | 54 | @(coll-examples 55 | `(1 2 ,(+ 1 2)) 56 | `(Z = ,@(take 5 (naturals)) ...) 57 | `#s(prefab i ,@#(ii iii iv) v))} 58 | -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/collection/introduction.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require 4 | racket/require 5 | (for-label (subtract-in 6 | (combine-in 7 | racket/base 8 | racket/list 9 | racket/set 10 | racket/dict) 11 | data/collection) 12 | (prefix-in base: racket/base) 13 | data/collection 14 | racket/generic 15 | racket/contract 16 | racket/stream 17 | racket/string) 18 | scribble/eval 19 | "../private/utils.rkt") 20 | 21 | @title[#:tag "collections-intro"]{Introduction} 22 | 23 | The @racketmodname[data/collection] library attempts to provide a suitable generic interface for 24 | interacting with all of Racket's collections through a uniform interface. That said, in doing so, its 25 | approach is something of a departure from how some of the functions from @racketmodname[racket/base] 26 | operate. 27 | 28 | Virtually all of the functions provided by @racketmodname[data/collection] are 29 | @emph{collection-agnostic}, so they will operate on any type of collection with consistent behavior. 30 | This is in stark contrast to @racketmodname[racket/base]'s library, including functions with distinct 31 | behavior for different kinds of collections (e.g. @racket[list-ref], @racket[vector-ref], 32 | @racket[string-ref], @etc). 33 | 34 | As an example, @racket[ref] can operate on all kinds of sequences with reasonable behavior for all of 35 | them: 36 | 37 | @(coll-interaction 38 | (ref '(1 2 3) 1) 39 | (ref #(1 2 3) 1) 40 | (ref (in-naturals) 5) 41 | (ref (hash 'a 'b 'c 'd) 'a)) 42 | 43 | However, it also means that some of the functions provided by @racketmodname[data/collection] have 44 | different behavior from their @racketmodname[racket/base] equivalents. When calling a function on a 45 | collection in @racketmodname[racket/base], there is a guarantee on the type of collection recieved as 46 | a result. With generic collections, there is often no such guarantee. 47 | 48 | For example, consider reversing a list. This is a simple operation, and it performs as one might 49 | expect. 50 | 51 | @(coll-interaction 52 | (reverse '(1 2 3))) 53 | 54 | But what about reversing a vector? The same strategy would require allocating a new vector, which 55 | would be unnecessarily slow. Instead, a different kind of sequence is returned. 56 | 57 | @(coll-interaction 58 | (reverse #(1 2 3))) 59 | 60 | The only guarantee is that the result must be a sequence, but otherwise, it can be almost anything. 61 | Fortunately, in the majority of cases, this is irrelevant, which is the point of generic collections: 62 | you don't need to worry about what @emph{kind} of collection you are dealing with, since the behavior 63 | is still what one would expect. 64 | 65 | @(coll-interaction 66 | (first (reverse #(1 2 3)))) 67 | 68 | This also permits one of the other changes from @racketmodname[racket/base]—a few of the collections 69 | operations are @emph{lazy}, in that they return @emph{lazy sequences}. In many cases, these lazy 70 | sequences are Racket @reftech{streams}, but not always. For example, @racket[map] is lazy. 71 | 72 | @(coll-interaction 73 | (map add1 '(10 20 30))) 74 | 75 | Sometimes, of course, it is useful to convert a collection into a particular representation. Usually, 76 | this can be done using @racket[extend], which takes a particular sequence and returns a new sequence 77 | with the values from a different sequence added. For example, we can put the results from the example 78 | above into a vector: 79 | 80 | @(coll-interaction 81 | (extend #() (map add1 '(10 20 30)))) 82 | 83 | The implementation of @racket[extend] uses the primitive collection operator, @racket[conj]. It is 84 | much like @racket[cons] for lists in that it adds a single value to a collection. However, it also 85 | makes no guarantees about what @emph{order} the new elements are placed in. For example, @racket[conj] 86 | prepends to lists but appends to vectors. 87 | 88 | @(coll-interaction 89 | (conj '(1 2 3) 4) 90 | (conj #(1 2 3) 4)) 91 | 92 | This permits efficient implementation of @racket[conj] on a per-collection basis. It does mean that 93 | using @racket[extend] on lists will reverse the input sequence, which is probably not desired in the 94 | majority of cases. For that purpose, @racket[sequence->list] is provided, which is equivalent to 95 | @racket[reverse] combined with @racket[extend]. 96 | 97 | @(coll-interaction 98 | (extend '() (map add1 '(10 20 30))) 99 | (sequence->list (map add1 '(10 20 30)))) 100 | 101 | A few other functions are lazy, such as @racket[filter] and @racket[append], though functions that do 102 | not return sequences cannot be lazy, such as @racket[foldl], so they are still strict. 103 | 104 | The existence of a generic interface also allows the various for loop sequence operations, such as 105 | @racket[in-list], @racket[in-vector], @racket[in-stream], @etc, can be collected into a single 106 | operator, simply called @racket[in]. When used as an ordinary function, it simply returns a lazy 107 | sequence equivalent to its input. However, when used in a @racket[for] clause, it expands into a more 108 | efficient form which iterates over the sequence directly. 109 | 110 | @(coll-interaction 111 | (in #(1 2 3)) 112 | (for ([e (in #(1 2 3))]) 113 | (displayln e))) 114 | 115 | Additionally, a @racket[for/sequence] form is provided, which operates similarly to @racket[for/list], 116 | but it returns a @emph{lazy} sequence, so it can even operate on infinite sequences. 117 | 118 | @(coll-interaction 119 | (for/sequence ([e (in-naturals)]) 120 | (* e e))) 121 | 122 | For a full list of all functions which support generic sequences, see the @secref["collections-api"]. 123 | -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/collection/reference.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require 4 | racket/require 5 | (for-label (subtract-in 6 | (combine-in 7 | racket/base 8 | racket/list 9 | racket/set 10 | racket/dict 11 | racket/math) 12 | data/collection) 13 | (prefix-in base: racket/base) 14 | data/collection 15 | racket/function 16 | racket/generic 17 | racket/contract 18 | racket/stream 19 | racket/string 20 | racket/match 21 | racket/generator) 22 | "../private/utils.rkt") 23 | 24 | @title[#:tag "collections-api"]{API Documentation} 25 | 26 | @section{Generic Collections and Sequences} 27 | 28 | @tech{Generic sequences} are the bulk of this library, providing a uniform interface for interacting 29 | with collections. Sequences are distinct from Racket @reftech{sequences}, which are a different, much 30 | more ad-hoc concept. 31 | 32 | A @deftech{generic collection} is any structure that can contain values, while a @deftech{generic 33 | sequence} represents a sequence of ordered values. 34 | 35 | @subsection{Collections} 36 | 37 | @defthing[gen:collection any/c]{ 38 | 39 | A @reftech{generic interface} that represents any structure that can contain values. The 40 | @racket[gen:collection] interface only provides two functions, @racket[conj] and @racket[extend]. 41 | 42 | The following built-in datatypes have implementations for @racket[gen:collection]: 43 | 44 | @itemlist[ 45 | @item{@reftech{lists}} 46 | @item{@emph{immutable} @reftech{hash tables}} 47 | @item{@emph{immutable} @reftech{vectors}} 48 | @item{@emph{immutable} @reftech{hash sets}} 49 | @item{@emph{immutable} @reftech{dictionaries}}] 50 | 51 | @(coll-examples 52 | (conj #(1 2 3) 4) 53 | (extend '() (hash 'a "b" 'c "d")))} 54 | 55 | @defproc[(collection? [v any/c]) boolean?]{ 56 | A predicate that determines if @racket[v] is a @tech{generic collection}.} 57 | 58 | @subsubsection[#:tag "collection-methods"]{Generic Methods} 59 | 60 | @defproc[(conj [coll collection?] [item any/c]) collection?]{ 61 | Returns a new collection with all the items in @racket[coll], plus @racket[item]. There is no 62 | requirement for @emph{where} the value is added to the collection—@reftech{lists} prepend elements 63 | @italic{a la} @racket[cons], while @reftech{vectors} append them. 64 | 65 | If @racket[extend] is implemented but not @racket[conj], an implementation will automatically be 66 | provided. 67 | 68 | @(coll-examples 69 | (conj '() 'a) 70 | (conj '(1 2) 3) 71 | (conj #(1 2) 3) 72 | (conj (hash) '(a . b)))} 73 | 74 | @defproc[(extend [a collection?] [b sequence?]) collection?]{ 75 | Returns a new collection with all the items in both @racket[a] and @racket[b], and the result is the 76 | same kind of collection as @racket[a]. 77 | 78 | If @racket[conj] is implemented but not @racket[extend], an implementation will automatically be 79 | provided. 80 | 81 | @(coll-examples 82 | (extend '(1 2) '(3 4)) 83 | (extend '() #(1 2 3 4)) 84 | (extend #() '(1 2 3 4)) 85 | (extend (hash) (set '(a . b) '(b . c))))} 86 | 87 | @subsubsection[#:tag "collection-functions"]{Derived Functions} 88 | 89 | @defproc[(conj* [coll collection?] [item any/c] ...) collection?]{ 90 | Repeatedly calls @racket[conj] for each @racket[item] provided, in order. 91 | 92 | @(coll-examples 93 | (conj* '() 1 2 3 4))} 94 | 95 | @defproc[(extend* [base collection?] [extension sequence?] ...) collection?]{ 96 | Repeatedly calls @racket[extend] for each @racket[extension] provided, in order. 97 | 98 | @(coll-examples 99 | (extend* '() #(1 2) (stream 3 4) (set 5 6)))} 100 | 101 | @subsection{Sequences} 102 | 103 | @defthing[gen:sequence any/c]{ 104 | 105 | A @reftech{generic interface} that represents any ordered sequence of values. The 106 | @racket[gen:sequence] interface provides the @racket[empty?], @racket[first], @racket[rest], 107 | @racket[nth], @racket[set-nth], @racket[update-nth], @racket[reverse], and @racket[random-access?] 108 | functions. 109 | 110 | The following built-in datatypes have implementations for @racket[gen:sequence]: 111 | 112 | @itemlist[ 113 | @item{@reftech{lists}} 114 | @item{@emph{immutable} @reftech{hash tables}} 115 | @item{@emph{immutable} @reftech{vectors}} 116 | @item{@emph{immutable} @reftech{hash sets}} 117 | @item{@emph{immutable} @reftech{dictionaries}} 118 | @item{@reftech{streams}}] 119 | 120 | @(coll-examples 121 | (extend (set) (map + '(1 2 3) #(4 5 6))))} 122 | 123 | @defproc[(sequence? [v any/c]) boolean?]{ 124 | A predicate that determines if @racket[v] is a @tech{generic sequence}.} 125 | 126 | @subsubsection[#:tag "sequence-methods"]{Generic Methods} 127 | 128 | @defproc[(empty? [seq sequence?]) boolean?]{ 129 | Determines if @racket[seq] has no values. 130 | 131 | All implementations of @racket[gen:sequence] are required to implement this method, unless they also 132 | implement @racket[gen:countable]. 133 | 134 | @(coll-examples 135 | (empty? '()) 136 | (empty? (stream)) 137 | (empty? #()) 138 | (empty? '(a b c)))} 139 | 140 | @defproc[(first [seq (and/c sequence? (not/c empty?))]) any/c]{ 141 | Retrieves the first values in @racket[seq]. 142 | 143 | This method is optional if an implementation of @racket[nth] is provided. 144 | 145 | @(coll-examples 146 | (first '(1 2 3)) 147 | (first (set 'a 'b 'c)) 148 | (first (hash 'a 'b 'c 'd)))} 149 | 150 | @defproc[(rest [seq (and/c sequence? (not/c empty?))]) any/c]{ 151 | Retrieves a new sequence which represents all but the first value in @racket[seq]. 152 | 153 | All implementations of @racket[gen:sequence] are required to implement this method. 154 | 155 | @(coll-examples 156 | (rest '(1 2 3)) 157 | (rest (set 'a 'b 'c)) 158 | (rest (hash 'a 'b 'c 'd)) 159 | (extend (hash) (rest (hash 'a 'b 'c 'd))))} 160 | 161 | @defproc[(nth [seq sequence?] [index exact-nonnegative-integer?]) any/c]{ 162 | Retrieves the element within @racket[seq] at @racket[index]. 163 | 164 | If @racket[seq] also implements @racket[gen:countable] @emph{and} is @racket[known-finite?], bounds 165 | checking will automatically be provided, and a @racket[exn:fail:contract] error will be raised if 166 | @racket[index] is out of range. 167 | 168 | This method is optional if an implementation of @racket[first] is provided. 169 | 170 | @(coll-examples 171 | (nth '(1 2 3) 1) 172 | (nth #(1 2 3) 2))} 173 | 174 | @defproc[(set-nth [seq sequence?] [index exact-nonnegative-integer?] [value any/c]) sequence?]{ 175 | Performs a functional update and returns a new sequence with the same elements as @racket[seq], except 176 | the element at @racket[index] is replaced with @racket[value]. 177 | 178 | @(coll-examples 179 | (set-nth '(1 2 3) 1 'b))} 180 | 181 | @defproc[(update-nth [seq sequence?] [index exact-nonnegative-integer?] [proc (any/c . -> . any/c)]) 182 | sequence?]{ 183 | Like @racket[set-nth], but instead of supplying the value to be replaced directly, the @racket[proc] 184 | procedure is applied to the old value at @racket[index] to produce its replacement. 185 | 186 | @(coll-examples 187 | (update-nth '(1 2 3) 1 (λ (n) (+ 10 n))))} 188 | 189 | @defproc[(set-nth* [seq sequence?] [index exact-nonnegative-integer?] [value any/c] ... ...) 190 | sequence?]{ 191 | Repeatedly calls @racket[set-nth] using each pair of @racket[index] and @racket[value] arguments to 192 | produce a final sequence. The @racket[set-nth*] function @emph{must} be provided an odd number of 193 | arguments (including the @racket[seq] argument) or a contract error will be raised. 194 | 195 | @(coll-examples 196 | (set-nth* '(1 2 3) 0 'a 2 'c))} 197 | 198 | @defproc[(update-nth* [seq sequence?] [index exact-nonnegative-integer?] 199 | [proc (any/c . -> . any/c)] ... ...) 200 | sequence?]{ 201 | Repeatedly calls @racket[update-nth] using each pair of @racket[index] and @racket[proc] arguments to 202 | produce a final sequence. The @racket[update-nth*] function @emph{must} be provided an odd number of 203 | arguments (including the @racket[seq] argument) or a contract error will be raised. 204 | 205 | @(coll-examples 206 | (update-nth* '(1 2 3) 0 add1 2 sub1))} 207 | 208 | @defproc[(reverse [seq sequence?]) sequence?]{ 209 | Returns a new sequence with all the elements of @racket[seq], but in reverse order. If @racket[seq] is 210 | infinite, this may not terminate. 211 | 212 | A default implementation is provided for this method for many built-in sequences, as well as for any 213 | custom sequence that is @racket[random-access?]. 214 | 215 | @(coll-examples 216 | (reverse '(1 2 3)) 217 | (reverse #(1 2 3)) 218 | (extend #() (reverse #(1 2 3))))} 219 | 220 | @defproc[(sequence->collection [seq sequence?]) collection?]{ 221 | Converts @racket[seq] to a collection. By default, if @racket[seq] is already a collection, then this 222 | is a no-op, and the result is @racket[seq]. Otherwise, a collection will be returned that is 223 | implemented in terms of @racket[append]. 224 | 225 | Beware that the fallback collection returned by this function can be very slow if repeatedly 226 | @racket[conj]'d upon. However, since most sequences are also collections, it can also be much, much 227 | faster than copying the sequence into a collection type with @racket[extend]. Therefore, it is 228 | recommended that general-purpose sequences which are not collections @emph{always} implement a 229 | performant version of @racket[sequence->collection]. 230 | 231 | @(coll-examples 232 | (reverse #(2 1)) 233 | (collection? (reverse #(2 1))) 234 | (sequence->collection (reverse #(2 1))) 235 | (sequence->list (conj (sequence->collection (reverse #(2 1))) 3)))} 236 | 237 | @defproc[(random-access? [seq sequence?]) boolean?]{ 238 | Provides a way for sequence implementations to convey whether or not they are random access. If no 239 | implementation is provided, the default implementation always returns @racket[#f]. 240 | 241 | This can be used as a heuristic to determine what sort of algorithm to use when operating over generic 242 | sequences. For example, if a sequence is determined to be random access, the default implementation 243 | for @racket[update-nth] will use @racket[nth] and @racket[set-nth]. Otherwise, it will lazily loop.} 244 | 245 | @subsubsection[#:tag "sequence-functions"]{Derived Functions} 246 | 247 | @defproc[(last [seq sequence?]) any/c]{ 248 | Gets the last element of @racket[seq]. If @racket[seq] is infinite, this may not terminate. 249 | 250 | @(coll-examples 251 | (last '(1 2 3)) 252 | (last (set 'a 'b 'c)) 253 | (last (hash 'a 'b 'c 'd)))} 254 | 255 | @defproc[(apply [proc procedure?] [arg any/c] ... [args sequence?] [#: kw-arg any/c] ...) any]{ 256 | The same as @racket[base:apply] but with support for any sequence as the final argument instead of 257 | only lists. Just like in @racket[base:apply], @racket[#:] stands for any keyword. 258 | 259 | @(coll-examples 260 | (apply + #(1 1 1)) 261 | (apply + (set 1 1 1)) 262 | (apply string-replace #:all? #f "foo" #("o" "a")))} 263 | 264 | @defproc[(append [seq sequence?] ...) sequence?]{ 265 | Returns a new @emph{lazy sequence} with all the values of the @racket[seq] arguments concatenated, in 266 | order. 267 | 268 | In many cases, it may be preferably to use @racket[extend] or @racket[extend*], which may also provide 269 | better performance, especially for homogenous sequence types. 270 | 271 | @(coll-examples 272 | (append '(1 2) '(3 4)) 273 | (sequence->list (append '(1 2) '(3 4))) 274 | (sequence->list (append (hash 'a 'b) (set 'c 'd))))} 275 | 276 | @defproc[(append* [seq sequence?] ... [seqs (sequenceof sequence?)]) sequence?]{ 277 | Functionally identical to @racket[(apply append seq ... seqs)] except that using @racket[append*] can 278 | potentially be lazier since the @racket[seqs] sequence does not need to be forced. Consequently, 279 | @racket[append*] can concatenate an infinite number of sequences if @racket[seqs] is an infinite lazy 280 | sequence, but @racket[append] cannot. 281 | 282 | @(coll-examples 283 | (append* (stream '(1 2) '(3 4))) 284 | (sequence->list (append* (stream '(1 2) '(3 4)))) 285 | (sequence->list (append* (stream (hash 'a 'b) (set 'c 'd)))))} 286 | 287 | @defproc*[([(build-sequence [proc (exact-nonnegative-integer? . -> . any/c)]) sequence?] 288 | [(build-sequence [n exact-nonnegative-integer?] 289 | [proc (exact-nonnegative-integer? . -> . any/c)]) sequence?])]{ 290 | Lazily constructs a sequence where each value is produced by calling @racket[proc] with the index of 291 | the element to be produced. That is, @racket[build-sequence] creates a sequence, @racket[_seq], such 292 | that @racket[(nth _seq _i)] is equal to @racket[(proc _i)] for all valid values of @racket[_i]. 293 | 294 | By default, @racket[build-sequence] produces an infinite sequence. If @racket[n] is provided, then the 295 | result is limited to @racket[n] elements; it is equivalent to @racket[(take n (build-sequence proc))]. 296 | 297 | @(coll-examples 298 | (sequence->list (build-sequence 5 values)) 299 | (sequence->list (subsequence (build-sequence sqr) 5 10)))} 300 | 301 | @defproc[(repeat [val any/c]) sequence?]{ 302 | Creates an infinite sequence simply containing @racket[val] repeated infinitely. 303 | 304 | @(coll-examples 305 | (repeat 0) 306 | (extend #() (take 5 (repeat 0))))} 307 | 308 | @defproc[(cycle [seq (and/c sequence? (not/c empty?))]) sequence?]{ 309 | Creates an infinite sequence containing the values in @racket[seq] repeated infinitely. 310 | 311 | @(coll-examples 312 | (nth (cycle '(1 2 3)) 10) 313 | (sequence->list (take 5 (cycle '(a b)))))} 314 | 315 | @defproc[(naturals [start exact-nonnegative-integer? 0]) stream?]{ 316 | The same binding as @racket[in-naturals] but provided under a different name. 317 | 318 | @(coll-examples 319 | (nth (naturals) 20) 320 | (nth (naturals 5) 20))} 321 | 322 | @defproc*[([(range [end number?]) stream?] 323 | [(range [start number?] 324 | [end number?] 325 | [step number? 1]) stream?])]{ 326 | The same binding as @racket[in-range] but provided under a different name. 327 | 328 | @(coll-examples 329 | (nth (range 100) 20) 330 | (nth (range 0 100 0.5) 20))} 331 | 332 | @defproc*[([(randoms [rand-gen pseudo-random-generator? (make-pseudo-random-generator)]) 333 | (sequenceof (and/c real? inexact? (>/c 0) (list (take 10 (randoms))) 344 | (sequence->list (take 10 (randoms 20))))} 345 | 346 | @defproc[(take [n exact-nonnegative-integer?] [seq sequence?]) sequence?]{ 347 | Returns a new @emph{lazy sequence} that contains the first @racket[n] elements of @racket[seq]. 348 | 349 | @(coll-examples 350 | (sequence->list (take 10 (in-naturals))))} 351 | 352 | @defproc[(drop [n exact-nonnegative-integer?] [seq sequence?]) sequence?]{ 353 | Returns a new sequence that contains all @emph{except} the first @racket[n] elements of @racket[seq]. 354 | 355 | @(coll-examples 356 | (sequence->list (drop 5 (range 10))))} 357 | 358 | @defproc[(subsequence [seq sequence?] 359 | [start exact-nonnegative-integer?] 360 | [end exact-nonnegative-integer?]) sequence?]{ 361 | Returns a new sequence containing the elements of @racket[seq] from @racket[start], inclusive, to 362 | @racket[end], exclusive. Equivalent to @racket[(take (- end start) (drop start seq))]. 363 | 364 | @(coll-examples 365 | (sequence->list (subsequence (in-naturals) 10 20)))} 366 | 367 | @defproc[(subsequence* [seq sequence?] 368 | [start exact-nonnegative-integer?] 369 | [len exact-nonnegative-integer?]) sequence?]{ 370 | Like @racket[subsequence], but instead of specifying the end index, @racket[len] specifies the length 371 | of the resulting sequence. Equivalent to @racket[(take len (drop start seq))] and 372 | @racket[(subsequence seq start (+ start len))]. 373 | 374 | @(coll-examples 375 | (sequence->list (subsequence* (in-naturals) 20 5)))} 376 | 377 | @defproc[(filter [pred (any/c . -> . any/c)] [seq sequence?]) sequence?]{ 378 | Returns a new @emph{lazy sequence} containing all the elements of @racket[seq] for which @racket[pred] 379 | applied to them produces a non-@racket[#f] value. 380 | 381 | @(coll-examples 382 | (filter odd? '(1 2 3 4 5)) 383 | (sequence->list (filter odd? '(1 2 3 4 5))))} 384 | 385 | @defproc[(map [proc procedure?] [seq sequence?] ...+) sequence?]{ 386 | Returns a new @emph{lazy sequence} consisting of the results of applying @racket[proc] to the elements 387 | of the provided @racket[seq] arguments. The @racket[proc] procedure must take as many arguments as 388 | @racket[seq] arguments are provided. If more than one @racket[seq] is provided, they must all be of 389 | the same length. 390 | 391 | @(coll-examples 392 | (map add1 '(10 20 30)) 393 | (sequence->list (map add1 '(10 20 30))) 394 | (sequence->list (map + '(5 10 15) #(3 6 9))) 395 | (define fibs (stream-cons 1 (stream-cons 1 (map + fibs (rest fibs))))) 396 | (sequence->list (take 15 fibs)))} 397 | 398 | @defproc[(foldl [proc procedure?] [init any/c] [seq sequence?] ...+) any/c]{ 399 | Continually applies @racket[proc] over the elements in the provided @racket[seq] arguments, passing 400 | the result of each application to the subsequent invokation of @racket[proc]. The @racket[proc] 401 | procedure must accept @italic{n}+1 arguments where @italic{n} is the number of @racket[seq] arguments 402 | provided. If more than one @racket[seq] is provided, they must all be of the same length. 403 | 404 | Unlike @racket[base:foldl], the accumulator argument is always provided to @racket[proc] @emph{first}, 405 | not last. 406 | 407 | @(coll-examples 408 | (foldl cons null (set 1 2 3 4)) 409 | (foldl (λ (a b) (cons b a)) null (set 1 2 3 4)))} 410 | 411 | @defproc[(foldl/steps [proc procedure?] [init any/c] [seq sequence?] ...+) sequence?]{ 412 | Like @racket[foldl], but instead of producing a single result, lazily produces a sequence containing 413 | each step of the reduction, starting with @racket[init]. 414 | 415 | @(coll-examples 416 | (sequence->list (foldl/steps + 0 '(1 3 7))) 417 | (sequence->list (foldl/steps conj #() '(a b c))) 418 | (let ([factorials (foldl/steps * 1 (naturals 1))]) 419 | (nth factorials 6)))} 420 | 421 | @defproc[(for-each [proc procedure?] [seq sequence?] ...+) void?]{ 422 | Applies @racket[proc] over the @racket[seq] arguments just like @racket[map], but does so strictly and 423 | does not return a sequence. Instead, it simply returns @|void-const|.} 424 | 425 | @defproc[(andmap [proc procedure?] [seq sequence?] ...+) any/c]{ 426 | Like @racket[map], applies @racket[proc] over the @racket[seq] arguments and collects the results 427 | together using @racket[and] like @racket[foldl]. 428 | 429 | @(coll-examples 430 | (andmap symbol? '(a 1 c d)) 431 | (andmap symbol? '(a b c d)) 432 | (andmap values '(a b c d)))} 433 | 434 | @defproc[(ormap [proc procedure?] [seq sequence?] ...+) any/c]{ 435 | Like @racket[map], applies @racket[proc] over the @racket[seq] arguments and collects the results 436 | together using @racket[or] like @racket[foldl]. 437 | 438 | @(coll-examples 439 | (ormap symbol? '(1 2 3 4)) 440 | (ormap symbol? '(1 a 3 4)) 441 | (ormap values '(#f a #f #f)))} 442 | 443 | @defproc[(find-best [seq (and/c sequence? (not/c empty?))] 444 | [>? (any/c any/c . -> . any/c)] 445 | [#:key extract-key (any/c . -> . any/c) values]) 446 | any/c]{ 447 | A generalization of @racket[find-min] and @racket[find-max], @racket[find-best] returns the first 448 | element, @racket[_e], of @racket[seq] for which @racket[(>? (extract-key _e) (extract-key _v))] is 449 | non-@racket[#f] for all other elements, @racket[_v], of @racket[seq]. It is assumed that @racket[>?] 450 | is a well-behaved ordering procedure. 451 | 452 | @(coll-examples 453 | (find-best '("pears" "bananas" "apples") stringstring second)) 456 | (find-best '((2 apples) (5 apples)) stringstring second))) 458 | 459 | The functions @racket[find-min] and @racket[find-max] are defined in terms of @racket[find-best], 460 | with @racket[<] and @racket[>] as the ordering procedures, respectively.} 461 | 462 | @defproc[(find-min [seq (and/c sequence? (not/c empty?))] 463 | [#:key extract-key (any/c . -> . real?) values]) 464 | any/c]{ 465 | Returns the first element, @racket[_e], of @racket[seq] for which @racket[(extract-key _e)] returns 466 | the smallest value. 467 | 468 | @(coll-examples 469 | (find-min '((3 pears) (1 banana) (2 apples)) #:key first) 470 | (find-min '((1 banana) (1 orange)) #:key first))} 471 | 472 | @defproc[(find-max [seq (and/c sequence? (not/c empty?))] 473 | [#:key extract-key (any/c . -> . real?) values]) 474 | any/c]{ 475 | Returns the first element, @racket[_e], of @racket[seq] for which @racket[(extract-key _e)] returns 476 | the largest value. 477 | 478 | @(coll-examples 479 | (find-max '((3 pears) (1 banana) (2 apples)) #:key first) 480 | (find-max '((1 banana) (1 orange)) #:key first))} 481 | 482 | @defproc[(index-of [seq sequence?] [v any/c] [is-equal? (any/c any/c . -> . any/c) equal?]) 483 | (or/c any/c #f)]{ 484 | Retrieves the index of the first element @racket[_x] of @racket[seq] for which 485 | @racket[(is-equal? _x v)] is not @racket[#f]. If no such value exists, this function returns 486 | @racket[#f]. 487 | 488 | @(coll-examples 489 | (index-of '(a b c) 'b) 490 | (index-of '(a b c) 'd) 491 | (index-of '(1 2 3) 2.0) 492 | (index-of '(1 2 3) 2.0 =))} 493 | 494 | @defproc[(index-where [seq sequence?] [proc (any/c . -> . any/c)]) (or/c any/c #f)]{ 495 | Retrieves the index of the first element @racket[_x] of @racket[seq] for which 496 | @racket[(proc _x)] is not @racket[#f]. If no such value exists, this function returns @racket[#f]. 497 | 498 | @(coll-examples 499 | (index-where '(1 2 3) positive?) 500 | (index-where '(-1 2 3) positive?) 501 | (index-where '(-1 -2 -3) positive?))} 502 | 503 | @defproc*[([(remove-first [seq sequence?] 504 | [val any/c] 505 | [=? (any/c any/c . -> . any/c) equal?]) 506 | sequence?] 507 | [(remove-first [seq sequence?] 508 | [val any/c] 509 | [=? (any/c any/c . -> . any/c)] 510 | [failure-thunk (-> any/c)]) 511 | any/c])]{ 512 | Returns a new sequence like @racket[seq], but with the first ocurrence of an element equal to 513 | @racket[val] omitted, as determined by @racket[=?]. By default, if no such element exists, 514 | @racket[seq] is returned unmodified. Alternatively, a @racket[failure-thunk] may be provided, which 515 | will be invoked if no equal element exists to produce a return value. 516 | 517 | Importantly, if no @racket[failure-thunk] is provided, @racket[remove-first] will be @emph{lazy} in 518 | its production of a new sequence. However, if @racket[failure-thunk] @emph{is} provided, 519 | @racket[remove-first] will be strict. This is necessary because the result may not be a sequence, and 520 | a non-sequence value must be returned strictly in ordinary Racket. 521 | 522 | @(coll-examples 523 | (sequence->list (remove-first '(a b c a b c) 'a)) 524 | (sequence->list (remove-first '(1 2 3 1 2 3) 1.0)) 525 | (sequence->list (remove-first '(1 2 3 1 2 3) 1.0 =)) 526 | (remove-first '(1 2 3 1 2 3) 1.0 equal? (thunk #f)))} 527 | 528 | @defproc[(remove-all [seq sequence?] [val any/c] [=? (any/c any/c . -> . any/c) equal?]) sequence?]{ 529 | Lazily produces a new sequence like @racket[seq], but with all elements equal to @racket[val] omitted, 530 | as determined by @racket[=?]. 531 | 532 | @(coll-examples 533 | (sequence->list (remove-all '(a b c a b c) 'a)) 534 | (sequence->list (remove-all '(1 2 3 1 2 3) 1.0)) 535 | (sequence->list (remove-all '(1 2 3 1 2 3) 1.0 =)))} 536 | 537 | @defproc[(flatten [s sequence?]) sequence?]{ 538 | Flattens a potentially nested sequence into a sequence of flat values. 539 | 540 | @(coll-examples 541 | (flatten '((a) b (c (d) e) ())) 542 | (sequence->list (flatten '((a) b (c (d) e) ()))) 543 | (sequence->list (flatten '((((()()()))(((()))()))))) 544 | (sixth (flatten (repeat 1))))} 545 | 546 | @defproc[(indexed [seq sequence?]) (sequenceof (cons/c exact-nonnegative-integer? any/c))]{ 547 | Lazily produces a new sequence based on @racket[seq], but each element is paired with its index within 548 | the sequence. 549 | 550 | @(coll-examples 551 | (sequence->list (indexed '(a b c))) 552 | (extend (hash) (indexed '(a b c))))} 553 | 554 | @defproc[(chunk [n exact-positive-integer?] [seq sequence?]) (sequenceof sequence?)]{ 555 | Lazily produces a new sequence based on @racket[seq] but with its elements grouped into subsequences 556 | taken @racket[n] at a time. If the length of @racket[seq] is not evenly divisible by @racket[n], then 557 | the final subsequence will contain the remaining elements. 558 | 559 | @(coll-examples 560 | (sequence->list* (chunk 3 (range 10))))} 561 | 562 | @defproc[(chunk* [n exact-positive-integer?] [seq sequence?]) (sequenceof sequence?)]{ 563 | Like @racket[chunk], but if the length of @racket[seq] is not evenly divisible by @racket[n], then an 564 | exception will be raised. 565 | 566 | @(coll-examples 567 | (sequence->list* (chunk* 3 (range 10))))} 568 | 569 | @defproc[(append-map [f procedure?] [seq sequence?] ...+) sequence?]{ 570 | Like @racket[(apply append (map f seq ...))]. 571 | 572 | @(coll-examples 573 | (sequence->list (append-map values '((1) (2) (3)))))} 574 | 575 | @defproc[(cartesian-product [seq sequence?] ...) (sequenceof sequence?)]{ 576 | Computes the n-ary @hyperlink["https://en.wikipedia.org/wiki/Cartesian_product"]{Cartesian product} of 577 | the given sequences. The result is computed lazily—if any of the @racket[seq]s are infinite, then the 578 | result will also be infinite. 579 | 580 | @(coll-examples 581 | (sequence->list* (cartesian-product '(1 2) '(a b) '(c d))) 582 | (sequence->list* (cartesian-product '(a) '(1 2 3))) 583 | (sequence->list* (cartesian-product '(4 5 6) '(d e f) '(#t #f))))} 584 | 585 | @deftogether[(@defproc[(second [seq sequence?]) any/c] 586 | @defproc[(third [seq sequence?]) any/c] 587 | @defproc[(fourth [seq sequence?]) any/c] 588 | @defproc[(fifth [seq sequence?]) any/c] 589 | @defproc[(sixth [seq sequence?]) any/c] 590 | @defproc[(seventh [seq sequence?]) any/c] 591 | @defproc[(eighth [seq sequence?]) any/c] 592 | @defproc[(ninth [seq sequence?]) any/c] 593 | @defproc[(tenth [seq sequence?]) any/c])]{ 594 | A set of helper functions for accessing elements of @racket[seq] implemented in terms of @racket[nth]. 595 | A random-access implementation of @racket[nth] will make these random-access as well. 596 | 597 | @(coll-examples 598 | (second (in-naturals)) 599 | (third (in-naturals)) 600 | (fourth (in-naturals)))} 601 | 602 | @defproc[(in [seq sequence?]) stream?]{ 603 | When used as a procedure, converts @racket[seq] into a lazy @reftech{stream}. This function is 604 | primarily intended to be used directly in a @racket[for] clause, in which case the sequence will 605 | be iterated directly without any conversion taking place. 606 | 607 | @(coll-examples 608 | (in '(1 2 3 4)) 609 | (for ([e (in (filter even? (set 1 2 3 4 5 6)))]) 610 | (displayln e)))} 611 | 612 | @deftogether[(@defform[(for/sequence (for-clause ...) body-or-break ... body)] 613 | @defform[(for*/sequence (for-clause ...) body-or-break ... body)])]{ 614 | Both forms iterate like @racket[for], but the results of the @racket[body] expressions are collected 615 | into a @emph{lazy sequence}. This means that the body of the loop isn't actually evaluated until the 616 | sequence is used, so any side-effects performed will be delayed until the sequence is forced. 617 | 618 | The @racket[for*/sequence] form is the same as @racket[for/sequence] but with the implicit nesting 619 | behavior of @racket[for*]. 620 | 621 | @(coll-examples 622 | (extend 623 | (set) 624 | (for/sequence ([i (in-range 10)]) 625 | (* i i))))} 626 | 627 | @deftogether[(@defform[(for/sequence/derived name-id (for-clause ...) body-or-break ... body)] 628 | @defform[(for*/sequence/derived name-id (for-clause ...) body-or-break ... body)])]{ 629 | Both forms work exactly like @racket[for/sequence] or @racket[for*/sequence], respectively, except 630 | that errors are reported in terms of @racket[name-id]. This can be useful for creating new forms that 631 | collect the results of @racket[for/sequence]. 632 | 633 | @(coll-examples 634 | (define-syntax-rule (for/immutable-vector . rest) 635 | (extend #() (for/sequence/derived for/immutable-vector . rest))) 636 | (for/immutable-vector ([i (in-range 10)]) 637 | (* i i)) 638 | (for/immutable-vector (malformed) 639 | (* i i)))} 640 | 641 | @defproc[(sequence->list [seq sequence?]) list?]{ 642 | Converts any sequence to a list. Equivalent to @racket[(reverse (extend '() seq))]. 643 | 644 | If @racket[seq] is infinite, then this function will not terminate, and it will infinitely allocate 645 | memory until it is exhausted. 646 | 647 | @(coll-examples 648 | (sequence->list #(1 2 3)) 649 | (sequence->list (hash 'a 'b 1 2 "foo" "bar")))} 650 | 651 | @defproc[(sequence->list* [seq sequence?]) list?]{ 652 | Like @racket[sequence->list], but recursively calls itself on any of the elements of @racket[seq] that 653 | are also sequences. 654 | 655 | If @racket[seq] or any of its subsequences are infinite, then this function will not terminate, and it 656 | will infinitely allocate memory until it is exhausted. 657 | 658 | @(coll-examples 659 | (sequence->list* #(1 #(2 3))) 660 | (sequence->list* (chunk 2 (range 10))))} 661 | 662 | @defproc[(sequence->string [seq (sequenceof char?)]) (and/c string? sequence?)]{ 663 | Converts @racket[seq], which must contain only @reftech{characters}, to an immutable 664 | @reftech{string}.} 665 | 666 | @defproc[(sequence->bytes [seq (sequenceof byte?)]) (and/c bytes? sequence?)]{ 667 | Converts @racket[seq], which must contain only 668 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{bytes}, to an immutable @reftech{byte string}.} 669 | 670 | @defproc[(generate-sequence [gen generator?]) sequence?]{ 671 | Creates a new lazy sequence by repeatedly calling @racket[gen] until @racket[generator-state] returns 672 | @racket['done]. The first element of the sequence is evaluated eagerly, but the remaining sequence is 673 | lazy. 674 | 675 | @(coll-examples 676 | (sequence->list 677 | (take 5 (generate-sequence (generator () 678 | (let loop ([n 0]) 679 | (yield (* n n)) 680 | (loop (add1 (* n n)))))))))} 681 | 682 | @section{General-Purpose Interfaces} 683 | 684 | @subsection{Countable Collections} 685 | 686 | Lots of data structures may be considered @deftech{countable}—that is, they have a discrete number of 687 | elements. The @racket[gen:countable] interface only provides a single function, @racket[length]. 688 | 689 | @defthing[gen:countable any/c]{ 690 | 691 | A @reftech{generic interface} that defines two functions, @racket[length], which accepts a 692 | single argument and returns the number of elements contained within the collection, and 693 | @racket[known-finite?], which provides a pessimistic check for finite collections. 694 | 695 | The following built-in datatypes have implementations for @racket[gen:countable]: 696 | 697 | @itemlist[ 698 | @item{@reftech{lists}} 699 | @item{@reftech{vectors}} 700 | @item{@reftech{strings}} 701 | @item{@reftech{byte strings}} 702 | @item{@reftech{hash tables}} 703 | @item{@reftech{sets}} 704 | @item{@reftech{dictionaries}} 705 | @item{@reftech{streams}}] 706 | 707 | For @reftech{streams}, if the argument is infinite, then @racket[length] does not terminate. 708 | 709 | @(coll-examples 710 | (length (range 20)) 711 | (length #(λ)) 712 | (length "Hello!") 713 | (length (set 1 2 3 4 5)) 714 | (struct wrapped-collection (value) 715 | #:methods gen:countable 716 | [(define/generic -length length) 717 | (define (length w) 718 | (-length (wrapped-collection-value w)))]) 719 | (length (wrapped-collection (hash 'a "b" 'c "d"))))} 720 | 721 | @defproc[(countable? [v any/c]) boolean?]{ 722 | 723 | A predicate that identifies if @racket[v] is @tech{countable}.} 724 | 725 | @defproc[(length [countable countable?]) exact-nonnegative-integer?]{ 726 | Returns the number of discrete elements contained by @racket[countable]. If @racket[countable] is 727 | infinite, then this function does not terminate.} 728 | 729 | @defproc[(known-finite? [countable countable?]) boolean?]{ 730 | If this function returns @racket[#t], then @racket[countable] @emph{must} be finite, and therefore, 731 | @racket[length] must terminate. If this function returns @racket[#f], then no additional information 732 | is gained: @racket[countable] could be either finite or infinite. 733 | 734 | If no implementation for @racket[known-finite?] is provided, it will always return @racket[#f]. 735 | 736 | @(coll-examples 737 | (known-finite? #(a b c)) 738 | (known-finite? (sequence->list (range 10))) 739 | (known-finite? (in-naturals)))} 740 | 741 | @subsection{Indexable Collections} 742 | 743 | Data structures are @deftech{indexable} if they provide any sort of indexed data. 744 | 745 | @defthing[gen:indexable any/c]{ 746 | 747 | A @reftech{generic interface} that defines @racket[ref] and @racket[set-ref] for getting and setting 748 | key-value data. 749 | 750 | @margin-note{ 751 | Be careful when using @racket[ref] with @tech{generic sequences}. If numeric indexing is your 752 | intention, use @racket[nth] instead, since @racket[ref] and @racket[nth] may have different behaviors 753 | on the same sequence. Notably, @racket[ref] on @reftech{association lists} uses @racket[dict-ref], not 754 | @racket[list-ref].} 755 | 756 | All @tech{generic sequences} are also @tech{indexable}, so implementations of @racket[gen:sequence] do 757 | @emph{not} need to implement @racket[gen:indexable] if they provide simply key/value mappings based on 758 | index. Additionally, mutable @reftech{hash tables}, mutable @reftech{vectors}, 759 | and @reftech{dictionaries} are also indexable. 760 | 761 | @(coll-examples 762 | (ref '(a b c) 1) 763 | (ref (hash 'foo "bar") 'foo) 764 | (ref '((1 . 2) (3 . 4)) 1) 765 | (set-ref '(a b c) 1 'x) 766 | (set-ref (hash 'foo "bar") 'foo "baz") 767 | (set-ref '((1 . 2) (3 . 4)) 1 -2))} 768 | 769 | @defproc[(indexable? [v any/c]) boolean?]{ 770 | 771 | A predicate that identifies if @racket[v] is @tech{indexable}.} 772 | 773 | @defproc[(ref [collection indexable?] [index any/c]) any]{ 774 | 775 | Returns the value associated with the provided @racket[index] for the given @racket[collection].} 776 | 777 | @defproc[(set-ref [collection indexable?] [index any/c] [value any/c]) any]{ 778 | 779 | Returns a new collection with all the associations in @racket[collection], plus a association between 780 | @racket[index] and @racket[value].} 781 | 782 | @subsection{Using sequences with @racket[match]} 783 | 784 | @(define lit-... (racket ...)) 785 | @defform[(sequence svp ...) 786 | #:grammar 787 | [(svp pat (code:line pat ooo)) 788 | (ooo #,lit-...)]]{ 789 | Similar to @tt{list} patterns for @racket[match], but matches any type of sequence and does not 790 | support @tt{..k} splicing patterns. 791 | 792 | If @racket[pat ...] splicing patterns are used in a non-final position, the sequence will be 793 | forced, and if the sequence is not finite, the match will not terminate. Otherwise, the other elements 794 | of the sequence not matched will not be forced, including a possible lazy tail. 795 | 796 | @(coll-examples 797 | (match (stream 1 2 3 4) 798 | [(sequence a b c d) c]) 799 | (match (stream 1 2 3 4) 800 | [(sequence a b ... c) b]) 801 | (match (stream 1 2 3 4) 802 | [(sequence a b ...) b]))} 803 | 804 | @subsection{Contracts on Collections} 805 | 806 | @defproc[(sequenceof [ctc contract?] [#:chaperone? chaperone? any/c #f]) contract?]{ 807 | Produces a @reftech{contract} that recognizes sequences and ensures their elements all match the 808 | @racket[ctc] contract. When a @racket[sequenceof] contract is applied to a sequence, the result is not 809 | @racket[eq?] to its input. 810 | 811 | If @racket[chaperone?] is non-@racket[#f], then the result will always be a 812 | @racket[chaperone-contract?], and @racket[ctc] @emph{must} also be a @racket[chaperone-contract?]. If 813 | @racket[chaperone?] is @racket[#f], the result will always be a simple @racket[contract?]. 814 | 815 | For most sequence types, when a @racket[sequenceof] contract is applied to a sequence, the result is 816 | always @racket[equal?] to its input. However, for a small set of sequences, such as @reftech{hash 817 | tables}, @reftech{strings}, and @reftech{byte strings}, the result will be an entirely disparate type 818 | of sequence. This behavior is only supported for non-chaperone contracts, so if @racket[chaperone?] is 819 | non-@racket[#f], then those sequences will not be permitted by the contract.} 820 | -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/collections.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "private/utils.rkt") 4 | 5 | @title{Generic Collections} 6 | 7 | @defmodule[data/collection] 8 | 9 | This provides a set of @reftech{generic interfaces} for built-in Racket collections to create a 10 | unified interface for working with Racket data structures. 11 | @seclink["structures" #:doc '(lib "scribblings/reference/reference.scrbl")]{User-defined structures} 12 | may also implement the collections API to provide implementations for additional datatypes. 13 | 14 | This collection provides a number of bindings that override bindings in @racketmodname[racket/base], 15 | some with slightly different semantics in addition to support for multiple kinds of collections. For 16 | this reason, this @emph{may} not be a drop-in replacement for existing code. 17 | 18 | @local-table-of-contents[] 19 | 20 | @include-section["collection/introduction.scrbl"] 21 | @include-section["collection/examples.scrbl"] 22 | @include-section["collection/reference.scrbl"] 23 | @include-section["collection/experimental.scrbl"] -------------------------------------------------------------------------------- /collections-doc/scribblings/data/collection/private/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | scribble/manual 5 | scribble/eval) 6 | 7 | (provide 8 | reftech 9 | coll-evaluator 10 | coll-interaction 11 | coll-examples) 12 | 13 | (define (reftech . content) 14 | (apply tech #:doc '(lib "scribblings/reference/reference.scrbl") content)) 15 | 16 | (define coll-evaluator 17 | (make-eval-factory 18 | #:lang 'racket 19 | '(racket/generic 20 | data/collection 21 | data/collection/experimental/quasi 22 | racket/generator))) 23 | 24 | (define-syntax-rule (coll-interaction . body) 25 | (interaction #:eval (coll-evaluator) . body)) 26 | 27 | (define-syntax-rule (coll-examples . body) 28 | (examples #:eval (coll-evaluator) . body)) 29 | -------------------------------------------------------------------------------- /collections-doc/scribblings/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(["data/collection/collections.scrbl" (multi-page)])) 4 | -------------------------------------------------------------------------------- /collections-lib/data/collection.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | (except-in data/collection/collection map) 5 | data/collection/sequence 6 | data/collection/indexable 7 | data/collection/countable 8 | data/collection/contract 9 | data/collection/match 10 | (only-in data/functor map)) 11 | 12 | (provide 13 | (all-from-out 14 | data/collection/collection 15 | data/collection/sequence 16 | data/collection/indexable 17 | data/collection/countable 18 | data/collection/contract 19 | data/collection/match 20 | data/functor)) 21 | -------------------------------------------------------------------------------- /collections-lib/data/collection/collection.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;; This contains the base implementations for gen:collection and gen:sequence, as well as some derived 4 | ;; functions to operate on them. 5 | 6 | (require racket/require 7 | (for-syntax racket/base 8 | syntax/parse) 9 | (multi-in racket [contract function generator generic lazy-require match]) 10 | (prefix-in b: (multi-in racket [base dict list set stream vector])) 11 | (prefix-in u: (multi-in unstable [function list])) 12 | (submod racket/performance-hint begin-encourage-inline) 13 | match-plus 14 | static-rename 15 | "countable.rkt" 16 | "private/util.rkt") 17 | 18 | ; lazily depend on random-access.rkt since it depends on this 19 | (lazy-require 20 | ["sequence.rkt" [sequence->string]] 21 | ["private/random-access.rkt" [wrap-random-access-sequence]]) 22 | 23 | (provide 24 | gen:collection (rename-out [collection?* collection?]) collection/c 25 | gen:sequence (rename-out [sequence?* sequence?]) sequence/c 26 | in for/sequence for*/sequence for/sequence/derived for*/sequence/derived 27 | (contract-out 28 | ; gen:collection 29 | [extend (collection?* sequence?* . -> . collection?*)] 30 | [conj (collection?* any/c . -> . collection?*)] 31 | ; gen:sequence 32 | [empty? (sequence?* . -> . boolean?)] 33 | [first ((and/c sequence?* (not/c empty?)) . -> . any)] 34 | [rest ((and/c sequence?* (not/c empty?)) . -> . any)] 35 | [rename nth* nth (sequence?* exact-nonnegative-integer? . -> . any)] 36 | [rename set-nth* set-nth (sequence?* exact-nonnegative-integer? any/c . -> . sequence?*)] 37 | [rename update-nth* update-nth (sequence?* exact-nonnegative-integer? (any/c . -> . any/c) 38 | . -> . sequence?*)] 39 | [reverse (sequence?* . -> . sequence?*)] 40 | [sequence->collection (sequence?* . -> . collection?*)] 41 | [random-access? (sequence?* . -> . boolean?)] 42 | ; derived functions 43 | [extend* ([collection?*] #:rest (listof sequence?*) . ->* . sequence?*)] 44 | [conj* ([collection?*] #:rest any/c . ->* . sequence?*)] 45 | [rename set-nth** set-nth* ([sequence?*] 46 | #:rest (tuple-listof exact-nonnegative-integer? any/c) 47 | . ->* . sequence?*)] 48 | [rename update-nth** update-nth* ([sequence?*] 49 | #:rest (tuple-listof exact-nonnegative-integer? 50 | (any/c . -> . any/c)) 51 | . ->* . sequence?*)] 52 | [apply apply/c] 53 | [append ([] #:rest (listof sequence?*) . ->* . sequence?*)] 54 | [filter ((any/c . -> . any/c) sequence?* . -> . sequence?*)] 55 | [map (->i ([proc (seqs) (and/c (procedure-arity-includes/c (b:length seqs)) 56 | (unconstrained-domain-> any/c))]) 57 | #:rest [seqs (non-empty-listof sequence?*)] 58 | [result sequence?*])] 59 | [foldl (->i ([proc (seqs) (and/c (procedure-arity-includes/c (add1 (b:length seqs))) 60 | (unconstrained-domain-> any/c))] 61 | [init any/c]) 62 | #:rest [seqs (non-empty-listof sequence?*)] 63 | [result any/c])] 64 | [sequence->list (sequence?* . -> . list?)] 65 | [sequence->list* (sequence?* . -> . list?)] 66 | ; helpers 67 | [second (sequence?* . -> . any)] 68 | [third (sequence?* . -> . any)] 69 | [fourth (sequence?* . -> . any)] 70 | [fifth (sequence?* . -> . any)] 71 | [sixth (sequence?* . -> . any)] 72 | [seventh (sequence?* . -> . any)] 73 | [eighth (sequence?* . -> . any)] 74 | [ninth (sequence?* . -> . any)] 75 | [tenth (sequence?* . -> . any)])) 76 | 77 | ;; wrappers 78 | ;; --------------------------------------------------------------------------------------------------- 79 | 80 | ; provide nice range errors for countable sequences 81 | (define (nth* seq i) 82 | (when (and (countable? seq) 83 | (known-finite? seq) 84 | (>= i (length seq))) 85 | (raise-range-error 'nth "sequence" "" i seq 0 (sub1 (length seq)))) 86 | (nth seq i)) 87 | 88 | (define (set-nth* seq i v) 89 | (when (and (countable? seq) 90 | (known-finite? seq) 91 | (>= i (length seq))) 92 | (raise-range-error 'set-nth "sequence" "" i seq 0 (sub1 (length seq)))) 93 | (set-nth seq i v)) 94 | 95 | (define (update-nth* seq i p) 96 | (when (and (countable? seq) 97 | (known-finite? seq) 98 | (>= i (length seq))) 99 | (raise-range-error 'update-nth "sequence" "" i seq 0 (sub1 (length seq)))) 100 | (update-nth seq i p)) 101 | 102 | ;; fallbacks 103 | ;; --------------------------------------------------------------------------------------------------- 104 | 105 | (define (-conj coll item) 106 | (extend coll (list item))) 107 | 108 | (define (-extend coll coll*) 109 | (foldl conj coll coll*)) 110 | 111 | (define (-empty? seq) 112 | (zero? (length seq))) 113 | 114 | (define (-first seq) 115 | (nth seq 0)) 116 | 117 | (define (-rest seq) 118 | (if (and (random-access? seq) (sequence-implements? seq 'nth)) 119 | (rest (wrap-random-access-sequence seq)) 120 | (raise-support-error 'rest seq))) 121 | 122 | (define (-reverse seq) 123 | (if (and (random-access? seq) (sequence-implements? seq 'nth)) 124 | (reverse (wrap-random-access-sequence seq)) 125 | (raise-support-error 'reverse seq))) 126 | 127 | (define (-nth seq index) 128 | (if (zero? index) 129 | (first seq) 130 | (nth (rest seq) (sub1 index)))) 131 | 132 | (define (-set-nth seq index value) 133 | (let loop ([seq seq] 134 | [index index]) 135 | (if (zero? index) 136 | (b:stream-cons value (in (rest seq))) 137 | (b:stream-cons (first seq) (loop (rest seq) (sub1 index)))))) 138 | 139 | (define (-update-nth seq index proc) 140 | (cond 141 | [(and (random-access? seq) (sequence-implements? seq 'nth 'set-nth)) 142 | (set-nth seq index (proc (nth seq index)))] 143 | [else 144 | (let loop ([seq seq] 145 | [index index]) 146 | (if (zero? index) 147 | (b:stream-cons (proc (first seq)) (in (rest seq))) 148 | (b:stream-cons (first seq) (loop (rest seq) (sub1 index)))))])) 149 | 150 | (define (-sequence->collection seq) 151 | (if (collection? seq) seq 152 | (appending-collection seq))) 153 | 154 | (define (stream-reverse str) 155 | (for/fold ([str* b:empty-stream]) 156 | ([e (b:in-stream str)]) 157 | (b:stream-cons e str*))) 158 | 159 | ;; generic interfaces 160 | ;; --------------------------------------------------------------------------------------------------- 161 | 162 | ; a collection is anything that can hold values 163 | (define-generics collection 164 | (conj collection item) 165 | (extend collection collection*) 166 | #:fallbacks 167 | [(define conj -conj) 168 | (define extend -extend)] 169 | #:defaults 170 | ([list? 171 | (define (conj lst item) (cons item lst))] 172 | [(u:conjoin vector? immutable?) 173 | (define (conj vec item) 174 | (b:vector->immutable-vector 175 | (b:vector-append vec (b:vector item))))] 176 | [(u:conjoin hash? immutable?) 177 | (define/contract (conj hsh item) 178 | ((and/c hash? immutable?) pair? . -> . (and/c hash? immutable?)) 179 | (hash-set hsh (car item) (cdr item)))] 180 | [b:set? 181 | (define conj b:set-add)] 182 | [(u:conjoin b:dict? (negate b:dict-mutable?) b:dict-can-functional-set?) 183 | (define/contract (conj dct item) 184 | ((and/c b:dict? (negate b:dict-mutable?) b:dict-can-functional-set?) 185 | pair? . -> . (and/c b:dict? (negate b:dict-mutable?) b:dict-can-functional-set?)) 186 | (b:dict-set dct (car item) (cdr item)))] 187 | [b:stream? 188 | (define (conj strm item) (b:stream-cons item strm))])) 189 | 190 | ; a sequence is an ordered set of values 191 | (define-generics sequence 192 | (empty? sequence) 193 | (first sequence) 194 | (rest sequence) 195 | (nth sequence index) 196 | (set-nth sequence index value) 197 | (update-nth sequence index proc) 198 | (reverse sequence) 199 | (sequence->collection sequence) 200 | (random-access? sequence) 201 | #:defined-predicate sequence-implements? 202 | #:fallbacks 203 | [(define empty? -empty?) 204 | (define first -first) 205 | (define rest -rest) 206 | (define nth -nth) 207 | (define set-nth -set-nth) 208 | (define update-nth -update-nth) 209 | (define reverse -reverse) 210 | (define sequence->collection -sequence->collection) 211 | (define (random-access? seq) #f)] 212 | #:derive-property prop:sequence (λ (s) (in s)) 213 | #:defaults 214 | ([list? 215 | (define empty? b:null?) 216 | (define first b:car) 217 | (define rest b:cdr) 218 | (define reverse b:reverse) 219 | (define nth list-ref) 220 | (define set-nth u:list-set) 221 | (define update-nth u:list-update)] 222 | [(u:conjoin vector? immutable?) 223 | (define nth vector-ref) 224 | (define (set-nth vec i v) 225 | (let ([copy (b:vector-copy vec)]) 226 | (vector-set! copy i v) 227 | (vector->immutable-vector copy))) 228 | (define (random-access? v) #t)] 229 | [b:stream? 230 | (define empty? b:stream-empty?) 231 | (define first b:stream-first) 232 | (define rest b:stream-rest) 233 | (define reverse stream-reverse)] 234 | [(u:conjoin hash? immutable?) 235 | (define empty? hash-empty?) 236 | (define hash->stream (compose1 b:sequence->stream b:in-hash-pairs)) 237 | (define first (compose1 b:stream-first hash->stream)) 238 | (define rest (compose1 b:stream-rest hash->stream)) 239 | (define reverse (compose1 stream-reverse hash->stream))] 240 | [b:set? 241 | (define empty? b:set-empty?) 242 | (define first (compose1 b:stream-first b:set->stream)) 243 | (define rest (compose1 b:stream-rest b:set->stream)) 244 | (define reverse (compose1 stream-reverse b:set->stream))] 245 | [(u:conjoin b:dict? (negate b:dict-mutable?)) 246 | (define empty? b:dict-empty?) 247 | (define first (compose1 b:stream-first b:sequence->stream b:in-dict-pairs)) 248 | (define rest (compose1 b:stream-rest b:sequence->stream b:in-dict-pairs)) 249 | (define reverse (compose1 stream-reverse b:sequence->stream b:in-dict-pairs))] 250 | [(u:conjoin string? immutable?) 251 | (define nth string-ref) 252 | (define rest (compose1 b:stream-rest b:sequence->stream in-string)) 253 | (define reverse (compose1 sequence->string stream-reverse b:sequence->stream in-string)) 254 | (define (random-access? s) #t)] 255 | [(u:conjoin bytes? immutable?) 256 | (define nth bytes-ref) 257 | (define rest (compose1 b:stream-rest b:sequence->stream in-bytes)) 258 | (define reverse (compose1 stream-reverse b:sequence->stream in-bytes)) 259 | (define (random-access? b) #t)])) 260 | 261 | ; create custom flat contracts to provide nice error messages for mutable builtins 262 | (define sequence?* 263 | (make-flat-contract 264 | #:name 'sequence? 265 | #:first-order sequence? 266 | #:projection 267 | (λ (blame) 268 | (λ (val) 269 | (cond 270 | [(sequence? val) val] 271 | [((u:disjoin vector? hash? b:set-mutable? b:set-weak? b:dict? string? bytes?) val) 272 | (raise-blame-error 273 | blame val 274 | '(expected: "sequence?, which must be immutable" given: "~e, which is mutable") val)] 275 | [else 276 | (raise-blame-error blame val '(expected: "sequence?" given: "~e") val)]))))) 277 | 278 | (define collection?* 279 | (make-flat-contract 280 | #:name 'collection? 281 | #:first-order collection? 282 | #:projection 283 | (λ (blame) 284 | (λ (val) 285 | (cond 286 | [(collection? val) val] 287 | [((u:disjoin vector? hash? b:set-mutable? b:set-weak? b:dict?) val) 288 | (raise-blame-error 289 | blame val 290 | '(expected: "collection?, which must be immutable" given: "~e, which is mutable") val)] 291 | [else 292 | (raise-blame-error blame val '(expected: "collection?" given: "~e") val)]))))) 293 | 294 | ;; utility implementations 295 | ;; --------------------------------------------------------------------------------------------------- 296 | 297 | (struct appending-collection (seq) 298 | #:methods gen:collection 299 | [(define/match* (conj (appending-collection seq) e) 300 | (appending-collection (append seq (list e))))] 301 | #:methods gen:sequence 302 | [(define/generic -empty? empty?) 303 | (define/generic -first first) 304 | (define/generic -rest rest) 305 | (define/generic -set-nth set-nth) 306 | (define/match* (empty? (appending-collection seq)) (-empty? seq)) 307 | (define/match* (first (appending-collection seq)) (-first seq)) 308 | (define/match* (rest (appending-collection seq)) (-rest seq)) 309 | (define/match* (set-nth (appending-collection seq) i v) (-set-nth seq i v))]) 310 | 311 | ;; derived functions 312 | ;; --------------------------------------------------------------------------------------------------- 313 | 314 | ; helper for make-apply-wrapper 315 | (begin-encourage-inline 316 | (define (contract-positional-args args blame) 317 | ; fail fast if the arity is wrong 318 | (when (< (b:length args) 2) 319 | (apply raise-arity-error 'apply (arity-at-least 2) args)) 320 | 321 | ; ensure the first argument is a procedure 322 | (define initial (b:first args)) 323 | (define initial-blame (blame-add-context blame "the first argument of")) 324 | (define initial-contracted (((contract-projection procedure?) initial-blame) initial)) 325 | 326 | ; ensure the last argument is a sequence 327 | (define-values [middle final] (b:split-at (b:rest args) (- (b:length args) 2))) 328 | (define final-blame (blame-add-context blame "the last argument of")) 329 | (define final-contracted (((contract-projection sequence?*) final-blame) (car final))) 330 | 331 | ; return all the arguments with contracts properly applied 332 | (b:cons initial-contracted (b:append middle (list final-contracted))))) 333 | 334 | ; creates a wrapper for chaperoning apply 335 | (define (make-apply-wrapper blame) 336 | (make-keyword-procedure 337 | (λ (kws kw-vals . args) (b:apply values kw-vals (contract-positional-args args blame))) 338 | (λ args (b:apply values (contract-positional-args args blame))))) 339 | 340 | ; the actual implementation of apply/c 341 | (define (apply/c-projection blame) 342 | (let ([wrapper-fn (make-apply-wrapper (blame-swap blame))]) 343 | (λ (val) (chaperone-procedure val wrapper-fn)))) 344 | 345 | ; a custom contract for apply to enable using the special sequence?* error message 346 | (define apply/c 347 | (make-chaperone-contract 348 | #:name '(-> procedure? any/c ... sequence? any) 349 | #:first-order procedure? 350 | #:projection apply/c-projection)) 351 | 352 | ; validates the arguments passed to apply and converts the final argument to a list from a sequence 353 | (define (parse-apply-arguments args) 354 | (define fn (b:first args)) 355 | (define main-args (b:rest args)) 356 | (define-values (init last) (b:split-at main-args (sub1 (length main-args)))) 357 | (define last* (sequence->list (b:first last))) 358 | (values fn (b:append init (list last*)))) 359 | 360 | ; implementation of apply when no keyword arguments are supplied 361 | (define/renamed apply (apply/basic . args) 362 | (let-values ([(fn args) (parse-apply-arguments args)]) 363 | (b:apply b:apply fn args))) 364 | 365 | ; implementation of apply when keyword arguments are supplied 366 | (define (apply/kws kws kw-vals . args) 367 | (let-values ([(fn args) (parse-apply-arguments args)]) 368 | (b:apply b:keyword-apply fn kws kw-vals args))) 369 | 370 | ; just like b:apply, but converts the last argument to a list from an arbitrary sequence 371 | (define apply (make-keyword-procedure apply/kws apply/basic)) 372 | 373 | ; lazily concatenates sequences 374 | (define (append . seqs) 375 | (for*/sequence ([seq (in-list seqs)] 376 | [e (in seq)]) 377 | e)) 378 | 379 | ; conj over multiple items 380 | (define (conj* seq . items) 381 | (foldl conj seq items)) 382 | 383 | ; extend over multiple sequences 384 | (define (extend* seq . seqs) 385 | (foldl extend seq seqs)) 386 | 387 | ; set-nth over multiple values 388 | (define/match (set-nth** seq . args) 389 | [(_ (list)) seq] 390 | [(_ (list n v args ...)) 391 | (apply set-nth** (set-nth* seq n v) args)]) 392 | 393 | ; update-nth over multiple values 394 | (define/match (update-nth** seq . args) 395 | [(_ (list)) seq] 396 | [(_ (list n proc args ...)) 397 | (apply update-nth** (update-nth* seq n proc) args)]) 398 | 399 | ; lazy filter 400 | (define (filter pred seq) 401 | (if (empty? seq) b:empty-stream 402 | (let ([head (first seq)] 403 | [tail (rest seq)]) 404 | (if (pred head) 405 | (b:stream-cons head (filter pred tail)) 406 | (filter pred tail))))) 407 | 408 | ; lazy map 409 | (define map 410 | (case-lambda 411 | [(proc seq) 412 | (let loop ([seq* seq]) 413 | (cond 414 | [(empty? seq*) 415 | b:empty-stream] 416 | [else 417 | (b:stream-cons (proc (first seq*)) 418 | (loop (rest seq*)))]))] 419 | [(proc . seqs) 420 | (let loop ([seqs* seqs]) 421 | (cond 422 | [(andmap empty? seqs*) 423 | b:empty-stream] 424 | [(ormap empty? seqs*) 425 | (raise-arguments-error 426 | 'map "all sequences must have the same length" 427 | "proc" proc 428 | "sequences" seqs)] 429 | [else 430 | (b:stream-cons (b:apply proc (b:map first seqs*)) 431 | (loop (b:map rest seqs*)))]))])) 432 | 433 | ; strict fold 434 | (define foldl 435 | (case-lambda 436 | [(proc init seq) 437 | (let loop ([init* init] 438 | [seq* seq]) 439 | (cond 440 | [(empty? seq*) 441 | init*] 442 | [else 443 | (loop (proc init* (first seq*)) (rest seq*))]))] 444 | [(proc init . seqs) 445 | (let loop ([init* init] 446 | [seqs* seqs]) 447 | (cond 448 | [(andmap empty? seqs*) 449 | init*] 450 | [(ormap empty? seqs*) 451 | (raise-arguments-error 452 | 'foldl "all sequences must have the same length" 453 | "proc" proc 454 | "init" init 455 | "sequences" seqs)] 456 | [else 457 | (loop (b:apply proc init* (b:map first seqs*)) (b:map rest seqs*))]))])) 458 | 459 | ; nth abbreviations 460 | (define (second seq) (nth* seq 1)) 461 | (define (third seq) (nth* seq 2)) 462 | (define (fourth seq) (nth* seq 3)) 463 | (define (fifth seq) (nth* seq 4)) 464 | (define (sixth seq) (nth* seq 5)) 465 | (define (seventh seq) (nth* seq 6)) 466 | (define (eighth seq) (nth* seq 7)) 467 | (define (ninth seq) (nth* seq 8)) 468 | (define (tenth seq) (nth* seq 9)) 469 | 470 | ; simple abbreviation to avoid manually reversing the result list 471 | (define (sequence->list seq) 472 | (reverse (extend '() seq))) 473 | 474 | ; like sequence->list, but deep 475 | (define (sequence->list* seq) 476 | (for/list ([e (in seq)]) 477 | (if (sequence? e) 478 | (sequence->list* e) 479 | e))) 480 | 481 | ; using ‘in’ outside of a for clause converts a sequence to a stream 482 | (define/contract in/proc 483 | (sequence?* . -> . b:stream?) 484 | (let () ; this is done to get the compiler to statically infer the name as ‘in’, not ‘in/proc’ 485 | (define (in seq) 486 | (if (empty? seq) b:empty-stream 487 | (b:stream-cons (first seq) (in/proc (rest seq))))) 488 | in)) 489 | 490 | ; if used in a for clause, it uses the sequence directly 491 | (define-sequence-syntax in 492 | (λ () #'in/proc) 493 | (λ (stx) 494 | (syntax-case stx () 495 | [[(e) (_ seq)] 496 | #'[(e) 497 | (:do-in 498 | ([(s) seq]) 499 | (unless (sequence? s) 500 | (raise-argument-error 'in "sequence?" s)) 501 | ([v s]) 502 | (not (empty? v)) 503 | ([(e) (first v)] 504 | [(r) (rest v)]) 505 | #t #t 506 | [r])]]))) 507 | 508 | (define-syntaxes (for/sequence/derived for*/sequence/derived) 509 | (let () 510 | (define ((make-for/sequence/derived derived-stx) stx) 511 | (syntax-parse stx 512 | [(_ name:id clauses . body) 513 | (begin 514 | (when (null? (syntax->list #'body)) 515 | (raise-syntax-error (syntax-e #'name) 516 | "missing body expression after sequence bindings" 517 | stx #'body)) 518 | #`(sequence->stream 519 | (in-generator 520 | (#,derived-stx 521 | (name clauses . body) () clauses 522 | (yield (let () . body)) 523 | (values)))))])) 524 | (values (make-for/sequence/derived #'for/fold/derived) 525 | (make-for/sequence/derived #'for*/fold/derived)))) 526 | 527 | (define-syntax-rule (for/sequence . rest) 528 | (for/sequence/derived for/sequence . rest)) 529 | (define-syntax-rule (for*/sequence . rest) 530 | (for*/sequence/derived for*/sequence . rest)) 531 | -------------------------------------------------------------------------------- /collections-lib/data/collection/contract.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | data/collection/collection 5 | racket/contract 6 | racket/generic 7 | racket/function 8 | racket/stream 9 | racket/set 10 | unstable/function) 11 | 12 | (provide 13 | (contract-out 14 | [sequenceof ([contract?] [#:chaperone? any/c] . ->* . contract?)])) 15 | 16 | (define (add-sequence-context blame) 17 | (blame-add-context blame "a value in")) 18 | 19 | ; a helper function for impersonating or chaperoning sequences 20 | (define (redirect-sequence seq chaperone? empty?* first* rest* nth* reverse* . props) 21 | (define redir-proc (if chaperone? chaperone-procedure impersonate-procedure)) 22 | (redirect-generics 23 | chaperone? gen:sequence seq 24 | [empty? (λ (empty?) (and empty? (redir-proc empty? empty?*)))] 25 | [first (λ (first) (and first (redir-proc first first*)))] 26 | [rest (λ (rest) (and rest (redir-proc rest rest*)))] 27 | [nth (λ (nth) (and nth (redir-proc nth nth*)))] 28 | [reverse (λ (reverse) (and reverse (redir-proc reverse reverse*)))] 29 | #:properties props)) 30 | 31 | ;; --------------------------------------------------------------------------------------------------- 32 | 33 | (define (sequenceof-name ctc) 34 | (build-compound-type-name 'sequenceof (base-sequenceof-content ctc))) 35 | 36 | (define (check-sequenceof! ctc val blame) 37 | (unless (sequence? val) 38 | (raise-blame-error blame val '(expected: "a sequence" given: "~e") val))) 39 | 40 | (define ((sequenceof-first-order ctc) val) 41 | (sequence? val)) 42 | 43 | (define (sequenceof-stronger? a b) 44 | (contract-stronger? (base-sequenceof-content a) 45 | (base-sequenceof-content b))) 46 | 47 | (define (raise-unsupported-type-error blame val type) 48 | (raise-blame-error 49 | blame val 50 | '(expected: "a chaperoneable sequence" given: "~e, and ~a is not chaperoneable") val type)) 51 | 52 | (define ((ho-projection chaperone?) ctc) 53 | (let ([elem-ctc (base-sequenceof-content ctc)]) 54 | (λ (blame) 55 | (let* ([passthrough-blame (blame-add-context blame #f)] 56 | [sequence-blame (add-sequence-context blame)] 57 | [pos-elem-proj ((contract-projection elem-ctc) sequence-blame)] 58 | [neg-elem-proj ((contract-projection elem-ctc) (blame-swap sequence-blame))]) 59 | (define (attach val) 60 | (check-sequenceof! ctc val sequence-blame) 61 | (cond 62 | [(empty? val) val] 63 | ; check for lists to get nicer contract errors 64 | [(list? val) 65 | (((contract-projection (listof elem-ctc)) passthrough-blame) val)] 66 | [(pair? val) 67 | (((contract-projection (cons/c elem-ctc ctc)) passthrough-blame) val)] 68 | [((conjoin vector? immutable?) val) 69 | (((contract-projection (vectorof elem-ctc #:immutable #t)) sequence-blame) val)] 70 | [(set? val) 71 | (((contract-projection (set/c elem-ctc #:kind 'immutable)) passthrough-blame) val)] 72 | [(stream? val) 73 | (((contract-projection (stream/c elem-ctc)) passthrough-blame) val)] 74 | ; force some values to streams for the contract checking 75 | ; (only allowed for non-chaperone contracts) 76 | [((conjoin hash? immutable?) val) 77 | (when chaperone? (raise-unsupported-type-error sequence-blame val 'hash?)) 78 | (((contract-projection (stream/c elem-ctc)) passthrough-blame) 79 | (sequence->stream (in-hash-pairs val)))] 80 | [((conjoin string? immutable?) val) 81 | (when chaperone? (raise-unsupported-type-error sequence-blame val 'string?)) 82 | (((contract-projection (stream/c elem-ctc)) passthrough-blame) 83 | (sequence->stream (in-string val)))] 84 | [((conjoin bytes? immutable?) val) 85 | (when chaperone? (raise-unsupported-type-error sequence-blame val 'bytes?)) 86 | (((contract-projection (stream/c elem-ctc)) passthrough-blame) 87 | (sequence->stream (in-bytes val)))] 88 | [else 89 | (redirect-sequence 90 | val chaperone? 91 | values 92 | (λ (seq) (values (λ (result) (with-continuation-mark 93 | contract-continuation-mark-key blame 94 | (pos-elem-proj result))) 95 | seq)) 96 | (λ (seq) (values (λ (result) (with-continuation-mark 97 | contract-continuation-mark-key blame 98 | (attach result))) 99 | seq)) 100 | (λ (seq n) (values (λ (result) (with-continuation-mark 101 | contract-continuation-mark-key blame 102 | (pos-elem-proj result))) 103 | seq n)) 104 | (λ (seq) (values (λ (result) (with-continuation-mark 105 | contract-continuation-mark-key blame 106 | (attach result))) 107 | seq)) 108 | impersonator-prop:contracted ctc 109 | impersonator-prop:blame sequence-blame)])) 110 | attach)))) 111 | 112 | (struct base-sequenceof (content)) 113 | 114 | (struct chaperone-sequenceof base-sequenceof () 115 | #:property prop:custom-write custom-write-property-proc 116 | #:property prop:chaperone-contract 117 | (build-chaperone-contract-property 118 | #:name sequenceof-name 119 | #:first-order sequenceof-first-order 120 | #:stronger sequenceof-stronger? 121 | #:projection (ho-projection #t))) 122 | 123 | (struct impersonator-sequenceof base-sequenceof () 124 | #:property prop:custom-write custom-write-property-proc 125 | #:property prop:contract 126 | (build-contract-property 127 | #:name sequenceof-name 128 | #:first-order sequenceof-first-order 129 | #:stronger sequenceof-stronger? 130 | #:projection (ho-projection #f))) 131 | 132 | (define (sequenceof v #:chaperone? [chaperone? #f]) 133 | (define ctc (coerce-contract 'sequenceof v)) 134 | (if chaperone? 135 | (chaperone-sequenceof ctc) 136 | (impersonator-sequenceof ctc))) 137 | -------------------------------------------------------------------------------- /collections-lib/data/collection/countable.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/generic 4 | (prefix-in b: racket/base) 5 | racket/contract 6 | racket/set 7 | racket/dict 8 | racket/stream) 9 | 10 | (provide 11 | gen:countable countable? countable/c 12 | (contract-out 13 | [length (countable? . -> . exact-nonnegative-integer?)] 14 | [known-finite? (countable? . -> . boolean?)])) 15 | 16 | (define-generics countable 17 | (length countable) 18 | (known-finite? countable) 19 | #:fallbacks 20 | [(define (known-finite? c) #f)] 21 | #:defaults 22 | ([list? (define length b:length) 23 | (define (known-finite? c) #t)] 24 | [vector? (define length vector-length) 25 | (define (known-finite? c) #t)] 26 | [string? (define length string-length) 27 | (define (known-finite? c) #t)] 28 | [bytes? (define length bytes-length) 29 | (define (known-finite? c) #t)] 30 | [hash? (define length hash-count) 31 | (define (known-finite? c) #t)] 32 | [set? (define length set-count) 33 | (define (known-finite? c) #t)] 34 | [stream? (define length stream-length)] 35 | [dict? (define length dict-count)])) 36 | -------------------------------------------------------------------------------- /collections-lib/data/collection/experimental/quasi.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base) 4 | data/collection 5 | syntax/parse/define 6 | (only-in racket/base [cons pair])) 7 | 8 | (provide quasiquote unquote unquote-splicing) 9 | 10 | (begin-for-syntax 11 | (define-syntax-class qqed 12 | #:attributes [expr] 13 | #:description #f 14 | #:literals [unquote] 15 | [pattern (uq:unquote ~! e:expr) 16 | #:attr expr (syntax-property #'e 17 | 'disappeared-use 18 | (syntax-local-introduce #'uq))] 19 | [pattern x 20 | #:attr expr #'(quasiquote x)]) 21 | 22 | (define-syntax-class qqed/splicing 23 | #:attributes [expr] 24 | #:description #f 25 | #:literals [unquote-splicing] 26 | [pattern (uqs:unquote-splicing ~! e) 27 | #:declare e (expr/c #'sequence? 28 | #:macro 'unquote-splicing 29 | #:name "argument") 30 | #:attr expr (syntax-property #'e.c 31 | 'disappeared-use 32 | (syntax-local-introduce #'uqs))] 33 | [pattern e:qqed 34 | #:attr expr #`(list #,(attribute e.expr))])) 35 | 36 | (define-syntax-parser quasiquote 37 | [(_ (x:qqed/splicing ...)) 38 | #'(sequence->list (append x.expr ...))] 39 | [(_ #(x:qqed/splicing ...)) 40 | #'(extend #() (append x.expr ...))] 41 | [(_ (a:qqed . b:qqed)) 42 | #'(pair a.expr b.expr)] 43 | [(_ prefab) 44 | #:when (prefab-struct-key (syntax-e #'prefab)) 45 | #:with key (prefab-struct-key (syntax-e #'prefab)) 46 | #:with #(_ x:qqed/splicing ...) (struct->vector (syntax-e #'prefab)) 47 | #'(apply make-prefab-struct 'key (append x.expr ...))] 48 | [(_ hsh) 49 | #:do [(define datum (syntax-e #'hsh))] 50 | #:when (hash? datum) 51 | #:with [(k . v:qqed) ...] (hash->list datum) 52 | #:with ctor (cond [(hash-eq? datum) #'make-immutable-hasheq] 53 | [(hash-eqv? datum) #'make-immutable-hasheqv] 54 | [else #'make-immutable-hash]) 55 | #'(ctor (list (pair 'k v.expr) ...))] 56 | [(_ other) 57 | #''other]) 58 | -------------------------------------------------------------------------------- /collections-lib/data/collection/indexable.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/generic 4 | racket/function 5 | racket/dict 6 | "collection.rkt") 7 | 8 | (provide 9 | gen:indexable indexable? indexable/c 10 | ref set-ref) 11 | 12 | (define-generics indexable 13 | (ref indexable . _) 14 | (set-ref indexable . _) 15 | #:defaults 16 | ([hash? (define ref hash-ref) 17 | (define set-ref hash-set)] 18 | [dict? (define ref dict-ref) 19 | (define set-ref dict-set)] 20 | [sequence? (define ref nth) 21 | (define set-ref set-nth)])) 22 | -------------------------------------------------------------------------------- /collections-lib/data/collection/match.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | (for-syntax racket/base 5 | racket/list 6 | syntax/parse 7 | syntax/parse/experimental/template) 8 | data/collection/countable 9 | data/collection/collection 10 | data/collection/sequence 11 | racket/match) 12 | 13 | (provide sequence) 14 | 15 | (define ((length-at-least n) seq) 16 | (if (and (countable? seq) 17 | (known-finite? seq)) 18 | (>= (length seq) n) 19 | (let loop ([n n] 20 | [seq seq]) 21 | (cond [(zero? n) #t] 22 | [(empty? seq) #f] 23 | [else (loop (sub1 n) (rest seq))])))) 24 | 25 | (define-match-expander sequence 26 | (λ (stx) 27 | (define-splicing-syntax-class svp 28 | #:attributes [pat multi?] 29 | (pattern (~seq pat:expr (~literal ...)) 30 | #:attr multi? #t) 31 | (pattern pat:expr 32 | #:attr multi? #f)) 33 | (syntax-parse stx 34 | ; if the arg list is empty, just expand to predicates 35 | [(_) #'(and (? sequence?) (? empty?))] 36 | ; otherwise do actual pattern matching 37 | [(_ svp:svp ...) 38 | (define multi? (attribute svp.multi?)) 39 | (define last-multi? (last multi?)) 40 | (define other-multi? (ormap values (drop-right multi? 1))) 41 | (cond 42 | ; if there are any internal greedy multi-matches, force the whole sequence to a list 43 | [other-multi? 44 | (template (? sequence? (app sequence->list (list (?@ . svp) ...))))] 45 | ; if the last one is a multi-match, match it as a lazy sequence 46 | [last-multi? 47 | (define init-pats (drop-right (syntax->list #'(svp.pat ...)) 1)) 48 | (with-syntax ([(init-pat ...) init-pats] 49 | [last-pat (last (syntax->list #'(svp.pat ...)))] 50 | [init-len (length init-pats)]) 51 | #'(and (? sequence?) (? (length-at-least init-len)) 52 | (app (λ (seq) (sequence->list (take init-len seq))) (list init-pat ...)) 53 | (and c (app (λ (seq) (drop init-len seq)) last-pat))))] 54 | ; otherwise just match the first elements as pats 55 | [else 56 | (define pats (syntax->list #'(svp.pat ...))) 57 | (with-syntax ([(pat ...) pats] 58 | [len (length pats)]) 59 | #'(? sequence? 60 | (and (app (λ (seq) (sequence->list (take len seq))) (list pat ...)) 61 | (app (λ (seq) (empty? (drop len seq))) #t))))])]))) 62 | -------------------------------------------------------------------------------- /collections-lib/data/collection/private/random-access.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | (multi-in data/collection [collection countable]) 5 | (multi-in racket [contract generic]) 6 | match-plus) 7 | 8 | (provide 9 | (contract-out 10 | [wrap-random-access-sequence ((and/c sequence? random-access?) . -> . sequence?)])) 11 | 12 | (define (wrap-random-access-sequence seq) 13 | (random-access-sequence seq 0)) 14 | 15 | (struct random-access-sequence (sequence offset) 16 | ; the length is just the internal length minus the offset 17 | #:methods gen:countable 18 | [(define/generic -length length) 19 | (define/match* (length (random-access-sequence seq i)) 20 | (- (-length seq) i))] 21 | ; we get first and empty? for free 22 | #:methods gen:sequence 23 | [(define (random-access? s) #t) 24 | (define/generic -nth nth) 25 | ; just increment the offset for rest 26 | (define/match* (rest (random-access-sequence seq i)) 27 | (random-access-sequence seq (add1 i))) 28 | ; offset the lookup 29 | (define/match* (nth (random-access-sequence seq i) i*) 30 | (-nth seq (+ i i*))) 31 | ; just wrap the whole thing in a layer of indirection for reversal 32 | (define (reverse ra-seq) 33 | (reversed-sequence ra-seq))]) 34 | 35 | (struct reversed-sequence (seq) 36 | #:reflection-name 'random-access-sequence 37 | ; the length is just the internal length 38 | #:methods gen:countable 39 | [(define/generic -length length) 40 | (define/match* (length (reversed-sequence seq)) 41 | (-length seq))] 42 | ; we get first and empty? for free 43 | #:methods gen:sequence 44 | [(define (random-access? s) #t) 45 | (define/generic -nth nth) 46 | ; just wrap the whole thing in a random access iterator for iteration 47 | (define (rest rev-seq) 48 | (random-access-sequence rev-seq 1)) 49 | ; reverse the lookup 50 | (define/match* (nth (reversed-sequence seq) i) 51 | (-nth seq (- (length seq) i 1))) 52 | ; if the sequence is reversed, we can just throw away the shell 53 | (define/match* (reverse (reversed-sequence seq)) 54 | seq)]) 55 | -------------------------------------------------------------------------------- /collections-lib/data/collection/private/util.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | racket/contract) 5 | 6 | (provide 7 | (contract-out 8 | [tuple-listof ([] #:rest (listof contract?) . ->* . contract?)])) 9 | 10 | ; adapted from plistof from unstable/gui/redex 11 | (define (tuple-listof . ctcs) 12 | (define ctc 13 | (recursive-contract 14 | (or/c null? tuple/c))) 15 | (define tuple/c 16 | (foldr cons/c ctc ctcs)) 17 | ctc) 18 | -------------------------------------------------------------------------------- /collections-lib/data/collection/sequence.rkt: -------------------------------------------------------------------------------- 1 | #lang curly-fn racket/base 2 | 3 | ;; This contains the implementation for derived sequence functions that have no need to access the 4 | ;; internal representation of the underlying interfaces. 5 | 6 | (require racket/require 7 | (multi-in data/collection [collection contract countable]) 8 | (multi-in racket [contract function generator generic stream]) 9 | (prefix-in b: racket/list) 10 | match-plus) 11 | 12 | (provide 13 | (rename-out [in-naturals naturals] 14 | [in-range range]) 15 | (contract-out 16 | [for-each (->i ([proc (seqs) (and/c (procedure-arity-includes/c (length seqs)) 17 | (unconstrained-domain-> any/c))]) 18 | #:rest [seqs (non-empty-listof sequence?)] 19 | [result void?])] 20 | [foldl/steps (->i ([proc (seqs) (and/c (procedure-arity-includes/c (add1 (length seqs))) 21 | (unconstrained-domain-> any/c))] 22 | [init any/c]) 23 | #:rest [seqs (non-empty-listof sequence?)] 24 | [result sequence?])] 25 | [andmap (->i ([proc (seqs) (and/c (procedure-arity-includes/c (length seqs)) 26 | (unconstrained-domain-> any/c))]) 27 | #:rest [seqs (non-empty-listof sequence?)] 28 | [result any/c])] 29 | [ormap (->i ([proc (seqs) (and/c (procedure-arity-includes/c (length seqs)) 30 | (unconstrained-domain-> any/c))]) 31 | #:rest [seqs (non-empty-listof sequence?)] 32 | [result any/c])] 33 | [append-map (->i ([proc (seqs) (and/c (procedure-arity-includes/c (length seqs)) 34 | (unconstrained-domain-> sequence?))]) 35 | #:rest [seqs (non-empty-listof sequence?)] 36 | [result sequence?])] 37 | [find-best (->* [(and/c sequence? (not/c empty?)) (any/c any/c . -> . any/c)] 38 | [#:key (any/c . -> . any/c)] 39 | any/c)] 40 | [find-min (->* [(and/c sequence? (not/c empty?))] [#:key (any/c . -> . real?)] any/c)] 41 | [find-max (->* [(and/c sequence? (not/c empty?))] [#:key (any/c . -> . real?)] any/c)] 42 | [remove-all (->* [sequence? any/c] [(any/c any/c . -> . any/c)] sequence?)] 43 | [remove-first (->* [sequence? any/c] [(any/c any/c . -> . any/c) (-> any/c)] any/c)] 44 | [last ((and/c sequence? (not/c empty?)) . -> . any)] 45 | [index-of ([sequence? any/c] [(any/c any/c . -> . any/c)] 46 | . ->* . (or/c exact-nonnegative-integer? #f))] 47 | [index-where (sequence? (any/c . -> . any/c) . -> . (or/c exact-nonnegative-integer? #f))] 48 | [build-sequence (case-> ((exact-nonnegative-integer? . -> . any/c) . -> . sequence?) 49 | (exact-nonnegative-integer? (exact-nonnegative-integer? . -> . any/c) 50 | . -> . sequence?))] 51 | [repeat (any/c . -> . sequence?)] 52 | [cycle ((and/c sequence? (not/c empty?)) . -> . sequence?)] 53 | [take (exact-nonnegative-integer? sequence? . -> . sequence?)] 54 | [drop (exact-nonnegative-integer? sequence? . -> . sequence?)] 55 | [subsequence (->i ([seq sequence?] 56 | [start exact-nonnegative-integer?] 57 | [end (start) (and/c exact-nonnegative-integer? (>=/c start))]) 58 | [result sequence?])] 59 | [subsequence* (sequence? exact-nonnegative-integer? exact-nonnegative-integer? . -> . sequence?)] 60 | [append* ([] #:rest (non-empty-listof sequence?) . ->* . sequence?)] 61 | [flatten (sequence? . -> . sequence?)] 62 | [indexed (sequence? . -> . sequence?)] 63 | [chunk (exact-nonnegative-integer? sequence? . -> . sequence?)] 64 | [chunk* (exact-nonnegative-integer? sequence? . -> . sequence?)] 65 | [cartesian-product ([] #:rest (listof sequence?) . ->* . (sequenceof sequence?))] 66 | [generate-sequence (generator? . -> . sequence?)] 67 | [sequence->string ((sequenceof char?) . -> . (and/c string? sequence?))] 68 | [sequence->bytes ((sequenceof byte?) . -> . (and/c bytes? sequence?))] 69 | [randoms (case-> (-> sequence?) 70 | (-> (or/c (integer-in 1 4294967087) pseudo-random-generator?) sequence?) 71 | (-> (integer-in 1 4294967087) pseudo-random-generator? sequence?))])) 72 | 73 | ; like map, but strict, returns void, and is only for side-effects 74 | (define for-each 75 | (case-lambda 76 | [(proc seq) 77 | (let loop ([seq* seq]) 78 | (cond 79 | [(empty? seq*) (void)] 80 | [else 81 | (proc (first seq*)) 82 | (loop (rest seq*))]))] 83 | [(proc . seqs) 84 | (let loop ([seqs* seqs]) 85 | (cond 86 | [(andmap empty? seqs*) (void)] 87 | [(ormap empty? seqs*) 88 | (raise-arguments-error 89 | 'for-each "all sequences must have the same length" 90 | "proc" proc 91 | "sequences" seqs)] 92 | [else 93 | (apply proc (map first seqs*)) 94 | (loop (map rest seqs*))]))])) 95 | 96 | ; like foldl, but lazily produces each step of the reduction 97 | (define foldl/steps 98 | (case-lambda 99 | [(proc init seq) 100 | (let loop ([init* init] 101 | [seq* seq]) 102 | (stream-cons init* 103 | (if (empty? seq*) 104 | empty-stream 105 | (loop (proc init* (first seq*)) (rest seq*)))))] 106 | [(proc init . seqs) 107 | (let loop ([init* init] 108 | [seqs* seqs]) 109 | (stream-cons init* 110 | (cond 111 | [(andmap empty? seqs*) empty-stream] 112 | [(ormap empty? seqs*) 113 | (raise-arguments-error 114 | 'foldl/steps "all sequences must have the same length" 115 | "proc" proc 116 | "init" init 117 | "sequences" seqs)] 118 | [else (loop (apply proc init* (map first seqs*)) (map rest seqs*))])))])) 119 | 120 | ; boolean folds for arbitrary sequences 121 | (define (andmap proc . seqs) 122 | (apply foldl (λ (acc . vals) (and acc (apply proc vals))) #t seqs)) 123 | (define (ormap proc . seqs) 124 | (apply foldl (λ (acc . vals) (or acc (apply proc vals))) #f seqs)) 125 | 126 | ; get an element that optimizes a given criterion 127 | (define (find-best seq >? #:key [extract-key values]) 128 | (define-values [v x] 129 | (for/fold ([v (first seq)] 130 | [x (extract-key (first seq))]) 131 | ([v2 (in (rest seq))]) 132 | (define x2 (extract-key v2)) 133 | (if (>? x2 x) 134 | (values v2 x2) 135 | (values v x)))) 136 | v) 137 | 138 | ; common cases of find-best 139 | (define (find-min seq #:key [extract-key values]) 140 | (find-best seq < #:key extract-key)) 141 | (define (find-max seq #:key [extract-key values]) 142 | (find-best seq > #:key extract-key)) 143 | 144 | ; total sequence element removal helper 145 | (define (remove-all seq val [=? equal?]) 146 | (filter #{not (=? val %)} seq)) 147 | 148 | ; single element removal helper 149 | (define remove-first 150 | (case-lambda 151 | [(seq val) (remove-first seq val equal?)] 152 | ; if no failure-thunk is provided, we can be lazy 153 | [(seq val =?) 154 | (let loop ([seq seq]) 155 | (if (empty? seq) 156 | seq 157 | (if (=? (first seq) val) 158 | (rest seq) 159 | (stream-cons (first seq) (loop (rest seq))))))] 160 | ; if a failure-thunk is provided, we need to be strict 161 | [(seq val =? failure-thunk) 162 | (let loop ([seq seq] 163 | [result '()]) 164 | (if (empty? seq) 165 | (failure-thunk) 166 | (if (=? (first seq) val) 167 | (append (reverse result) (rest seq)) 168 | (loop (rest seq) (cons (first seq) result)))))])) 169 | 170 | ; get the end of a finite sequence 171 | (define (last seq) 172 | (if (and (countable? seq) 173 | (known-finite? seq)) 174 | (nth seq (sub1 (length seq))) 175 | (let loop ([seq seq]) 176 | (let ([next (rest seq)]) 177 | (if (empty? next) 178 | (first seq) 179 | (loop next)))))) 180 | 181 | ; index-searching functions for sequences 182 | (define (index-of seq x [=? equal?]) 183 | (for/or ([y (in seq)] 184 | [i (in-naturals)]) 185 | (and (=? y x) i))) 186 | (define (index-where seq proc) 187 | (for/or ([y (in seq)] 188 | [i (in-naturals)]) 189 | (and (proc y) i))) 190 | 191 | ; indexed sequence constructor 192 | (define build-sequence 193 | (case-lambda 194 | [(proc) 195 | (let loop ([i 0]) 196 | (stream-cons (proc i) (loop (add1 i))))] 197 | [(n proc) 198 | (let loop ([i 0]) 199 | (if (= i n) empty-stream 200 | (stream-cons (proc i) (loop (add1 i)))))])) 201 | 202 | ; wrapper for ‘repeat’ 203 | (struct single-value-seq (val) 204 | #:reflection-name 'infinite-sequence 205 | #:methods gen:custom-write 206 | [(define (write-proc s out mode) 207 | (fprintf out "#" (single-value-seq-val s)))] 208 | #:methods gen:sequence 209 | [(define (empty? s) #f) 210 | (define (first s) (single-value-seq-val s)) 211 | ; return a new value to unwrap any contracts so they don't build up 212 | (define (rest s) (single-value-seq (single-value-seq-val s))) 213 | (define (nth s i) (first s)) 214 | (define (reverse s) (rest s)) 215 | (define (random-access? s) #t)]) 216 | 217 | ; infinite, single-valued sequence constructor 218 | (define (repeat v) 219 | (single-value-seq v)) 220 | 221 | ; wrapper for ‘cycle’ 222 | (struct cycled-seq (head current) 223 | #:reflection-name 'cycled-sequence 224 | #:methods gen:sequence 225 | [(define/generic -empty? empty?) 226 | (define/generic -first first) 227 | (define/generic -rest rest) 228 | (define (empty? s) #f) 229 | (define (first s) (-first (cycled-seq-current s))) 230 | (define/match* (rest (cycled-seq head current)) 231 | (define current* (-rest current)) 232 | (if (-empty? current*) 233 | (cycled-seq head head) 234 | (cycled-seq head current*)))]) 235 | 236 | ; infinite, multi-valued sequence constructor 237 | (define (cycle s) 238 | (cycled-seq s s)) 239 | 240 | ; wrapper for lazy sections of a sequence 241 | (struct bounded-seq (source left) 242 | #:reflection-name 'lazy-sequence 243 | #:methods gen:countable 244 | [(define/match* (length (bounded-seq _ left)) left) 245 | (define (known-finite? seq) #t)] 246 | #:methods gen:sequence 247 | [(define/generic -first first) 248 | (define/generic -rest rest) 249 | (define/generic -nth nth) 250 | (define/match* (empty? (bounded-seq _ left)) 251 | (zero? left)) 252 | (define/match* (first (bounded-seq source _)) 253 | (-first source)) 254 | (define/match* (rest (bounded-seq source left)) 255 | (bounded-seq (-rest source) (sub1 left))) 256 | (define/match* (nth (bounded-seq source _) index) 257 | (-nth source index)) 258 | ; reversing the sequence can't possibly be lazy, anyway, so just turn it into a list 259 | (define/match* (reverse seq) 260 | (extend '() seq))]) 261 | 262 | ; lazily grabs the first n elements of seq 263 | (define (take n seq) 264 | (when (and (countable? seq) 265 | (known-finite? seq) 266 | (> n (length seq))) 267 | (raise-range-error 'take "sequence" "length " n seq 0 (length seq))) 268 | (bounded-seq seq n)) 269 | 270 | ; strictly drops the first n elements of seq 271 | (define (drop n seq) 272 | (when (and (countable? seq) 273 | (known-finite? seq) 274 | (> n (length seq))) 275 | (raise-range-error 'drop "sequence" "length " n seq 0 (length seq))) 276 | (let loop ([n n] 277 | [seq seq]) 278 | (if (zero? n) 279 | seq 280 | (loop (sub1 n) (rest seq))))) 281 | 282 | ; utility for composing take and drop 283 | (define (subsequence seq start end) 284 | (when (and (countable? seq) 285 | (known-finite? seq)) 286 | (when (> start (length seq)) 287 | (raise-range-error 'subsequence "sequence" "start " start seq 0 (length seq))) 288 | (when (> end (length seq)) 289 | (raise-range-error 'subsequence "sequence" "end " end seq 0 (length seq)))) 290 | (take (- end start) (drop start seq))) 291 | 292 | ; like subsequence but specifying a length instead of an end index 293 | (define (subsequence* seq start len) 294 | (when (and (countable? seq) 295 | (known-finite? seq)) 296 | (when (> start (length seq)) 297 | (raise-range-error 'subsequence* "sequence" "start " start seq 0 (length seq))) 298 | (when (> (+ start len) (length seq)) 299 | (raise-range-error 'subsequence* "sequence" "end " (+ start len) seq 0 (length seq)))) 300 | (take len (drop start seq))) 301 | 302 | ; lazily flatten a sequence 303 | (define (flatten seq) 304 | (generate-sequence 305 | (generator () 306 | (let loop ([seq seq]) 307 | (unless (empty? seq) 308 | (let ([head (first seq)] 309 | [tail (rest seq)]) 310 | (if (sequence? head) 311 | (loop head) 312 | (yield head)) 313 | (loop tail))))))) 314 | 315 | ; like (apply append seqs) but can be lazier 316 | (define append* 317 | (case-lambda 318 | ; provide a fast case when only one argument is supplied 319 | [(seqs) 320 | (for*/sequence ([seq (in seqs)] 321 | [e (in seq)]) 322 | e)] 323 | ; use ‘append’ otherwise 324 | [seqs 325 | (define-values (init last) (b:split-at-right seqs 1)) 326 | (append 327 | (apply append init) 328 | (for*/sequence ([seq (in (car last))] 329 | [e (in seq)]) 330 | e))])) 331 | 332 | ; like (apply append (map proc . seqs)) but lazier and less expensive 333 | (define (append-map proc . seqs) 334 | (generate-sequence 335 | (generator () 336 | (let loop ([seqs* seqs]) 337 | (cond 338 | [(andmap empty? seqs*) (void)] 339 | [(ormap empty? seqs*) 340 | (raise-arguments-error 341 | 'append-map "all sequences must have the same length" 342 | "proc" proc 343 | "sequences" seqs)] 344 | [else 345 | (for-each yield (apply proc (map first seqs*))) 346 | (loop (map rest seqs*))]))))) 347 | 348 | ; maps over a sequence and creates pairs of each element and its index in the sequence 349 | (define (indexed seq) 350 | (for/sequence ([x (in seq)] 351 | [i (in-naturals)]) 352 | (cons i x))) 353 | 354 | ; groups sequences into subsequences of length ‘n’ 355 | (define (chunk n seq) 356 | (if (empty? seq) empty-stream 357 | (let loop ([x n] 358 | [seq seq] 359 | [acc empty-stream]) 360 | (if (or (zero? x) (empty? seq)) 361 | (stream-cons (reverse acc) (chunk n seq)) 362 | (loop (sub1 x) (rest seq) (stream-cons (first seq) acc)))))) 363 | 364 | ; like ‘chunk’, but throws an exception if the sequence cannot be divided perfectly 365 | (define (chunk* n seq) 366 | (if (empty? seq) empty-stream 367 | (let ([head (take n seq)] 368 | [tail (drop n seq)]) 369 | (stream-cons head (chunk* n tail))))) 370 | 371 | ; performs a lazy, n-dimensional cartesian product 372 | (define (cartesian-product . seqs) 373 | (define (cp-2 as bs) 374 | (for*/sequence ([i (in as)] 375 | [j (in bs)]) 376 | (stream-cons i j))) 377 | (foldr cp-2 (list empty-stream) seqs)) 378 | 379 | ; creates a sequence by lazily pulling values from a generator 380 | (define (generate-sequence g) 381 | (let loop () 382 | (define v (g)) 383 | (if (eq? 'done (generator-state g)) 384 | empty-stream 385 | (stream-cons v (loop))))) 386 | 387 | ; some conversion functions for non-collections 388 | (define (sequence->string seq) 389 | (string->immutable-string (list->string (sequence->list seq)))) 390 | (define (sequence->bytes seq) 391 | (bytes->immutable-bytes (list->bytes (sequence->list seq)))) 392 | 393 | ; infinite sequence of random numbers 394 | (define (randoms [k #f] [gen #f]) 395 | (define integral? (integer? k)) 396 | ; if ‘k’ isn't provided as an integer, it's actually the generator due to how the 397 | ; arity of this function works 398 | (define gen* (if integral? gen k)) 399 | (define random-generator (or gen* (make-pseudo-random-generator))) 400 | (generate-sequence 401 | (generator () 402 | (let loop () 403 | (yield 404 | (if integral? 405 | (random k random-generator) 406 | (random random-generator))) 407 | (loop))))) 408 | -------------------------------------------------------------------------------- /collections-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define version "1.3.1") 6 | 7 | (define deps 8 | '(["base" #:version "6.3"] 9 | "curly-fn-lib" 10 | ["functional-lib" #:version "0.3.1"] 11 | "match-plus" 12 | "static-rename" 13 | "unstable-list-lib")) 14 | (define build-deps 15 | '()) 16 | -------------------------------------------------------------------------------- /collections-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define version "1.3.1") 6 | 7 | (define deps 8 | '()) 9 | (define build-deps 10 | '("base" 11 | "collections-lib" 12 | "match-plus" 13 | "rackunit-lib")) 14 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/collection.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | rackunit 5 | data/collection 6 | racket/set 7 | racket/function) 8 | 9 | (test-case 10 | "Basic collection operations (conj)" 11 | (check-equal? (conj '() 'a) '(a)) 12 | (check-equal? (conj '(a) 'b) '(b a)) 13 | (check-equal? (conj #() 'a) #(a)) 14 | (check-equal? (conj #(a) 'b) #(a b)) 15 | (check-equal? (conj (hash) '(a . b)) (hash 'a 'b)) 16 | (check-equal? (conj (hash 'a 'b) '(c . d)) (hash 'a 'b 'c 'd)) 17 | (check-equal? (conj (hash 'a 'b) '(a . c)) (hash 'a 'c)) 18 | (check-equal? (conj (set) 'a) (set 'a)) 19 | (check-equal? (conj (set 'a) 'b) (set 'a 'b)) 20 | (check-equal? (conj (set 'a) 'a) (set 'a))) 21 | 22 | (test-case 23 | "Basic collection operations (extend)" 24 | (check-equal? (extend '() '(a b c)) '(c b a)) 25 | (check-equal? (extend '() #(a b c)) '(c b a)) 26 | (check-equal? (extend '() (hash 'a 'b)) '((a . b))) 27 | (check-equal? (extend #() '(a b c)) #(a b c)) 28 | (check-equal? (extend #() #(a b c)) #(a b c)) 29 | (check-equal? (extend (hash) '((a . b) (c . d))) (hash 'a 'b 'c 'd)) 30 | (check-exn exn:fail:contract? (thunk (extend (hash) '(a b c))))) 31 | 32 | (test-case 33 | "Collection abbreviations" 34 | (check-equal? (conj* '() 'a 'b 'c) '(c b a)) 35 | (check-equal? (extend* '() '(a b c) #(1 2 3) (hash 'foo 'bar)) '((foo . bar) 3 2 1 c b a))) 36 | 37 | (test-case 38 | "Special contract errors on mutable builtins" 39 | (check-exn #rx"which is mutable" (thunk (conj (vector) #f))) 40 | (check-exn #rx"which is mutable" (thunk (conj (make-hash) #f))) 41 | (check-exn #rx"which is mutable" (thunk (conj (mutable-set) #f))) 42 | (check-exn #rx"expected: collection\\?\n" (thunk (conj 'not-a-collection #f)))) 43 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/contract.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | rackunit 5 | data/collection 6 | data/collection/contract 7 | racket/contract 8 | racket/function 9 | racket/stream 10 | racket/set) 11 | 12 | (test-case 13 | "Contracts on defaults" 14 | (check-not-exn 15 | (thunk (contract (sequenceof integer?) null 16 | 'pos 'neg))) 17 | (check-exn 18 | #rx"broke its (own )?contract" 19 | (thunk (contract (sequenceof integer?) 20 | '(1 2 a 3 4 5) 21 | 'pos 'neg))) 22 | (check-exn 23 | #rx"broke its (own )?contract" 24 | (thunk (nth (contract (sequenceof integer?) 25 | `(1 2 3 . ,(stream 'a)) 26 | 'pos 'neg) 27 | 3))) 28 | (check-exn 29 | #rx"broke its (own )?contract" 30 | (thunk (contract (sequenceof integer?) 31 | #(1 2 a 3 4 5) 32 | 'pos 'neg))) 33 | (check-exn 34 | #rx"hash\\? is not chaperoneable" 35 | (thunk (contract (sequenceof integer? #:chaperone? #t) 36 | (hash 1 2 3 4) 37 | 'pos 'neg))) 38 | (check-exn 39 | #rx"string\\? is not chaperoneable" 40 | (thunk (contract (sequenceof char? #:chaperone? #t) 41 | "abcd" 42 | 'pos 'neg))) 43 | (check-exn 44 | #rx"bytes\\? is not chaperoneable" 45 | (thunk (contract (sequenceof byte? #:chaperone? #t) 46 | #"abcd" 47 | 'pos 'neg))) 48 | (check-exn 49 | #rx"broke its (own )?contract" 50 | (thunk (first (contract (sequenceof integer?) 51 | (hash 1 2 3 4) 52 | 'pos 'neg)))) 53 | (check-exn 54 | #rx"broke its (own )?contract" 55 | (thunk (contract (sequenceof integer?) 56 | (set 1 2 'a 3 4 5) 57 | 'pos 'neg)))) 58 | 59 | (test-case 60 | "Contracts on custom sequences" 61 | (struct my-seq () 62 | #:methods gen:sequence 63 | [(define (first seq) 'datum) 64 | (define (rest seq) (my-seq)) 65 | (define (empty? seq) #f)]) 66 | (check-not-exn 67 | (thunk (first (contract (sequenceof symbol?) 68 | (my-seq) 69 | 'pos 'neg)))) 70 | (check-exn 71 | #rx"broke its (own )?contract" 72 | (thunk (first (contract (sequenceof integer?) 73 | (my-seq) 74 | 'pos 'neg))))) 75 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/dict.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit 4 | data/collection 5 | match-plus 6 | racket/generic 7 | racket/dict) 8 | 9 | (struct my-dict (assocs) 10 | #:transparent 11 | #:methods gen:dict 12 | [(define/generic -dict-ref dict-ref) 13 | (define/generic -dict-set dict-set) 14 | (define/generic -dict-remove dict-remove) 15 | (define/generic -dict-count dict-count) 16 | (define/generic -dict-iterate-first dict-iterate-first) 17 | (define/generic -dict-iterate-next dict-iterate-next) 18 | (define/generic -dict-iterate-key dict-iterate-key) 19 | (define/generic -dict-iterate-value dict-iterate-value) 20 | (define (dict-ref dct k [fail #f]) (-dict-ref (my-dict-assocs dct) k)) 21 | (define (dict-set dct k v) (my-dict (-dict-set (my-dict-assocs dct) k v))) 22 | (define (dict-remove dct k) (my-dict (-dict-remove (my-dict-assocs dct) k))) 23 | (define (dict-count dct) (-dict-count (my-dict-assocs dct))) 24 | (define (dict-iterate-first dct) (-dict-iterate-first (my-dict-assocs dct))) 25 | (define (dict-iterate-next dct pos) (-dict-iterate-next (my-dict-assocs dct) pos)) 26 | (define (dict-iterate-key dct pos) (-dict-iterate-key (my-dict-assocs dct) pos)) 27 | (define (dict-iterate-value dct pos) (-dict-iterate-value (my-dict-assocs dct) pos))]) 28 | 29 | (define my-dict-null (my-dict null)) 30 | 31 | (test-case 32 | "Dicts as collections" 33 | (check-equal? (conj my-dict-null '(a . b)) (my-dict '((a . b)))) 34 | (check-equal? (conj (my-dict '((a . b))) '(c . d)) (my-dict '((a . b) (c . d)))) 35 | (check-equal? (conj (my-dict '((a . b))) '(a . d)) (my-dict '((a . d)))) 36 | (check-equal? (extend my-dict-null '((a . b) (c . d))) (my-dict '((a . b) (c . d))))) 37 | 38 | (test-case 39 | "Dicts as sequences" 40 | (check-true (empty? my-dict-null)) 41 | (check-false (empty? (my-dict '((a . b))))) 42 | (check-equal? (ref (my-dict '((a . b))) 'a) 'b) 43 | (check-equal? (nth (my-dict '((a . b))) 0) '(a . b))) 44 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/experimental/quasi.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require data/collection/experimental/quasi 4 | racket/stream 5 | rackunit) 6 | 7 | (test-case 8 | "Simple successful quasiquotation" 9 | (check-equal? `(1 . #(,(+ 1 1) 10 | #hash((a . #s(sct ,(string-append "a" "b" "c"))) 11 | (b . ,(- 4 3))) 12 | 4)) 13 | '(1 . #(2 14 | #hash((a . #s(sct "abc")) 15 | (b . 1)) 16 | 4)))) 17 | 18 | (test-case 19 | "Splicing quasiquotation with sequences" 20 | (check-equal? `(1 ,@(list 2 3 4) 21 | ,@(stream 5 6 7) 22 | #hash((a . #s(sct i ,@(vector-immutable 'ii 'iii 'iv) v)))) 23 | '(1 2 3 4 5 6 7 24 | #hash((a . #s(sct i ii iii iv v)))))) 25 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/match.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | rackunit 5 | data/collection 6 | racket/match) 7 | 8 | (test-case 9 | "Empty matches" 10 | (check-equal? (match '(1 2 3) [(sequence) #t] [_ #f]) #f) 11 | (check-equal? (match '() [(sequence) #t] [_ #f]) #t)) 12 | 13 | (test-case 14 | "Finite matches" 15 | (check-equal? (match #(1 2 3 4) [(sequence a b c d) c]) 3) 16 | (check-equal? (match #(1 2 3 4) [(sequence 2 b c d) c] [_ #f]) #f) 17 | (check-equal? (match #(1 2 3 4) [(sequence 1 2 3 4) #t]) #t) 18 | (check-equal? (match #(1 2 3 4) [(sequence 1 2 3) #t] [_ #f]) #f)) 19 | 20 | (test-case 21 | "Lazy tail matches" 22 | (check-equal? (match #(1 2 3 4) [(sequence a b ...) a]) 1) 23 | (check-equal? (match #(1 2 3 4) [(sequence a b ...) (last b)]) 4) 24 | (check-equal? (match #() [(sequence a b ...) a] [_ #f]) #f)) 25 | 26 | (test-case 27 | "Strict internal matches" 28 | (check-equal? (match #(1 2 3 4) [(sequence a b ... c) b]) '(2 3))) 29 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/sequence-lib.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | rackunit 5 | data/collection 6 | racket/function 7 | racket/stream 8 | racket/port) 9 | 10 | (test-case 11 | "Side-effectful for-each" 12 | (check-equal? 13 | (with-output-to-string 14 | (thunk (for-each display (take 5 (in-naturals))))) 15 | "01234")) 16 | 17 | (test-case 18 | "Lazy fold steps" 19 | (check-equal? (sequence->list (foldl/steps conj #() '(1 2 3))) '(#() #(1) #(1 2) #(1 2 3))) 20 | (check-equal? (sequence->list (foldl/steps list '() '(1 2) '(3 4))) '(() (() 1 3) ((() 1 3) 2 4))) 21 | (check-equal? (with-output-to-string 22 | (thunk (foldl/steps (λ (_ n) (display n)) (void) '(1 2 3)))) 23 | "") 24 | (check-equal? (with-output-to-string 25 | (thunk (first (foldl/steps (λ (_ n) (display n)) (void) '(1 2 3))))) 26 | "") 27 | (check-equal? (with-output-to-string 28 | (thunk (second (foldl/steps (λ (_ n) (display n)) (void) '(1 2 3))))) 29 | "1") 30 | (check-equal? (with-output-to-string 31 | (thunk (sequence->list (foldl/steps (λ (_ n) (display n)) (void) '(1 2 3))))) 32 | "123")) 33 | 34 | (test-case 35 | "Logical fold abbreviations" 36 | (check-equal? (andmap symbol? '(a 1 c d)) #f) 37 | (check-equal? (andmap symbol? '(a b c d)) #t) 38 | (check-equal? (andmap values '(a b c d)) 'd) 39 | (check-equal? (ormap symbol? '(1 2 3 4)) #f) 40 | (check-equal? (ormap symbol? '(1 a 3 4)) #t) 41 | (check-equal? (ormap values '(#f a #f #f)) 'a)) 42 | 43 | (test-case 44 | "find-best, find-min, and find-max" 45 | (check-equal? (find-best '("pears" "bananas" "apples") string?) "pears") 47 | 48 | (check-equal? (find-best '((3 pears) (1 banana) (2 apples)) stringstring second)) 50 | '(2 apples)) 51 | (check-equal? (find-best '((3 pears) (1 banana) (2 apples)) string>? 52 | #:key (compose1 symbol->string second)) 53 | '(3 pears)) 54 | 55 | (check-equal? (find-min '(8 5 0 -2 5)) -2) 56 | (check-equal? (find-max '(8 5 0 -2 5)) 8) 57 | 58 | (check-equal? (find-min '((3 pears) (1 banana) (2 apples)) #:key first) '(1 banana)) 59 | (check-equal? (find-min '((1 banana) (1 orange)) #:key first) '(1 banana)) 60 | (check-equal? (find-max '((3 pears) (1 banana) (2 apples)) #:key first) '(3 pears)) 61 | (check-equal? (find-max '((3 pears) (3 oranges)) #:key first) '(3 pears))) 62 | 63 | (test-case 64 | "Extra sequence operations" 65 | (check-equal? (last '(1 2 3 4)) 4) 66 | (check-equal? (last #(1 2 3 4)) 4) 67 | (check-equal? (last (stream 1 2 3 4)) 4) 68 | (check-equal? (last (take 5 (in-naturals))) 4) 69 | (check-equal? (first (drop 2 (in-naturals))) 2) 70 | (check-equal? (reverse (extend '() (subsequence (in-naturals) 1 5))) '(1 2 3 4))) 71 | 72 | (test-case 73 | "Finding element indicies" 74 | (check-equal? (index-of '(1 2 3) 2) 1) 75 | (check-equal? (index-of '(1 2 3) 4) #f) 76 | (check-equal? (index-of '(1 2 3) 2 (const #f)) #f) 77 | 78 | (check-equal? (index-where '(1 2 3) positive?) 0) 79 | (check-equal? (index-where '(-1 2 3) positive?) 1) 80 | (check-equal? (index-where '(-1 -2 -3) positive?) #f)) 81 | 82 | (test-case 83 | "Indexed sequence construction" 84 | (check-equal? (sequence->list (take 5 (build-sequence values))) '(0 1 2 3 4)) 85 | (check-equal? (sequence->list (take 5 (build-sequence add1))) '(1 2 3 4 5)) 86 | (check-equal? (sequence->list (take 5 (build-sequence (λ _ 'a)))) '(a a a a a)) 87 | 88 | (check-equal? (sequence->list (build-sequence 5 values)) '(0 1 2 3 4)) 89 | (check-equal? (sequence->list (build-sequence 5 add1)) '(1 2 3 4 5)) 90 | (check-equal? (sequence->list (build-sequence 5 (λ _ 'a))) '(a a a a a))) 91 | 92 | (test-case 93 | "Bounded sequences" 94 | (check-equal? (length (take 3 (in-naturals))) 3) 95 | (check-equal? (nth (take 3 (in-naturals)) 2) 2) 96 | (check-exn exn:fail:contract? (thunk (take 5 (take 3 (in-naturals))))) 97 | (check-exn exn:fail:contract? (thunk (fifth (take 3 (in-naturals))))) 98 | (check-exn exn:fail:contract? (thunk (nth (take 3 (in-naturals)) 23)))) 99 | 100 | (test-case 101 | "Infinite sequence constructors" 102 | (check-equal? (first (repeat 'foo)) 'foo) 103 | (check-equal? (nth (repeat 'foo) 10000) 'foo) 104 | (check-exn exn:fail:contract? (thunk (cycle '()))) 105 | (check-equal? (sequence->list (take 6 (cycle '(1 2 3)))) '(1 2 3 1 2 3))) 106 | 107 | (test-case 108 | "Sequence to string and bytestring conversions" 109 | (check-equal? (sequence->string #(#\a #\b #\c)) "abc") 110 | (check-equal? (sequence->bytes #(1 2 3)) #"\1\2\3")) 111 | 112 | (test-case 113 | "Flattening operations" 114 | (check-true (empty? (flatten '((((()))))))) 115 | (check-equal? (sequence->list (flatten '((1 2) 3 (((4)))))) '(1 2 3 4)) 116 | (check-equal? (nth (flatten (repeat (repeat '(1)))) 1000) 1) 117 | (check-equal? (second (append-map values (repeat (repeat 1)))) 1)) 118 | 119 | (test-case 120 | "Indexed sequences" 121 | (check-equal? (sequence->list (indexed '(a b c))) '((0 . a) (1 . b) (2 . c))) 122 | (check-equal? (extend (hash) (indexed '(a b c))) #hash((0 . a) (1 . b) (2 . c)))) 123 | 124 | (test-case 125 | "Sequence chunking" 126 | (check-equal? (sequence->list* (chunk 2 (range 10))) '((0 1) (2 3) (4 5) (6 7) (8 9))) 127 | (check-equal? (sequence->list* (chunk 3 (range 10))) '((0 1 2) (3 4 5) (6 7 8) (9))) 128 | (check-exn exn:fail:contract? (thunk (sequence->list* (chunk* 3 (range 10)))))) 129 | 130 | (test-case 131 | "cartesian-product" 132 | (check-equal? (sequence->list* (cartesian-product)) 133 | '(())) 134 | (check-equal? (sequence->list* (cartesian-product (range 20) '() (naturals))) 135 | '()) 136 | (check-equal? (sequence->list* (cartesian-product '(1 2) '(a b) '(c d))) 137 | '((1 a c) (1 a d) (1 b c) (1 b d) (2 a c) (2 a d) (2 b c) (2 b d))) 138 | (check-equal? (sequence->list* (cartesian-product '(1 2 3) '(a b c))) 139 | '((1 a) (1 b) (1 c) (2 a) (2 b) (2 c) (3 a) (3 b) (3 c))) 140 | (check-equal? (sequence->list* (cartesian-product '(4 5 6) '(d e f) '(#t #f))) 141 | '((4 d #t) 142 | (4 d #f) 143 | (4 e #t) 144 | (4 e #f) 145 | (4 f #t) 146 | (4 f #f) 147 | (5 d #t) 148 | (5 d #f) 149 | (5 e #t) 150 | (5 e #f) 151 | (5 f #t) 152 | (5 f #f) 153 | (6 d #t) 154 | (6 d #f) 155 | (6 e #t) 156 | (6 e #f) 157 | (6 f #t) 158 | (6 f #f))) 159 | (check-equal? (sequence->list* (take 10 (cartesian-product (naturals) '(a b) '(c d)))) 160 | '((0 a c) (0 a d) (0 b c) (0 b d) (1 a c) (1 a d) (1 b c) (1 b d) (2 a c) (2 a d)))) 161 | 162 | (test-case 163 | "Built-in infinite sequences" 164 | (check-equal? 165 | (parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)]) 166 | (random-seed 0) 167 | (sequence->list (take 10 (randoms 10 (current-pseudo-random-generator))))) 168 | '(8 6 2 4 8 4 5 3 2 6))) 169 | 170 | (test-case 171 | "Total element removal" 172 | (check-equal? (sequence->list (remove-all '(a b c d a b d e) 'a)) '(b c d b d e)) 173 | (check-equal? (sequence->list (remove-all (stream 'a 'b 'c 'd 'a 'b 'd 'e) 'a)) '(b c d b d e)) 174 | (check-equal? (sequence->list (remove-all #(a b c d a b d e) 'a)) '(b c d b d e))) 175 | 176 | (test-case 177 | "Single element removal" 178 | (check-equal? (sequence->list (remove-first '(a b c d a b d e) 'a)) '(b c d a b d e)) 179 | (check-equal? (sequence->list (remove-first '(a b c d a b d e) 'f)) '(a b c d a b d e)) 180 | (check-equal? (remove-first '(a b c d a b d e) 'f equal? (thunk #f)) #f)) 181 | -------------------------------------------------------------------------------- /collections-test/tests/data/collection/sequence.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | rackunit 5 | data/collection 6 | racket/set 7 | racket/stream 8 | racket/function 9 | racket/string) 10 | 11 | (test-case 12 | "Basic sequence operations (empty?)" 13 | (check-true (empty? '())) 14 | (check-false (empty? '(a))) 15 | (check-true (empty? #())) 16 | (check-false (empty? #(a))) 17 | (check-true (empty? (hash))) 18 | (check-false (empty? (hash 'a 'b))) 19 | (check-true (empty? (set))) 20 | (check-false (empty? (set 'a))) 21 | (check-true (empty? empty-stream)) 22 | (check-false (empty? (stream 'a)))) 23 | 24 | (test-case 25 | "Basic sequence operations (first / rest / nth)" 26 | (check-equal? (first '(a b)) 'a) 27 | (check-equal? (rest '(a b)) '(b)) 28 | (check-equal? (first #(a b)) 'a) 29 | (check-equal? (first (rest #(a b))) 'b) 30 | (check-equal? (nth '(a b c) 1) 'b) 31 | (check-equal? (nth (stream 1 2 3) 1) 2)) 32 | 33 | (test-case 34 | "Functional sequence updates" 35 | (check-equal? (set-nth '(a b) 0 'c) '(c b)) 36 | (check-equal? (update-nth '(1 2) 0 add1) '(2 2)) 37 | (check-equal? (sequence->list (set-nth (stream 'a 'b) 1 'c)) '(a c)) 38 | (check-equal? (sequence->list (update-nth (stream 1 2) 1 add1)) '(1 3)) 39 | (check-equal? (sequence->list (set-nth (rest #(a b c)) 1 'd)) '(b d)) 40 | (check-equal? (update-nth #(1 2 3) 1 add1) #(1 3 3))) 41 | 42 | (test-case 43 | "Sequence reversal" 44 | (check-equal? (reverse '(1 2 3)) '(3 2 1)) 45 | (check-equal? (extend '() (reverse #(1 2 3))) '(1 2 3)) 46 | (check-equal? (sequence->list (reverse (stream 1 2 3 4))) '(4 3 2 1)) 47 | (check-equal? (reverse "abc") "cba")) 48 | 49 | (test-case 50 | "Converting sequences to collections" 51 | (define (check-eq-ness seq) 52 | (check-eq? (sequence->collection seq) seq)) 53 | 54 | (check-eq-ness '(1 2 3)) 55 | (check-eq-ness #(1 2 3)) 56 | (check-eq-ness (set 1 2 3)) 57 | (check-eq-ness (stream 1 2 3)) 58 | 59 | (check-false (collection? (reverse #(2 1)))) 60 | (check-equal? (sequence->list (conj (sequence->collection (reverse #(2 1))) 3)) '(1 2 3))) 61 | 62 | (test-case 63 | "Sequence-based application" 64 | (check-equal? (apply + #(1 1 1)) 3) 65 | (check-equal? (apply + 1 1 #(1)) 3) 66 | (check-equal? (apply string-replace #("foo" "o" "a")) "faa") 67 | (check-equal? (apply string-replace #:all? #f #("foo" "o" "a")) "fao") 68 | (check-exn exn:fail:contract? (thunk (apply +))) 69 | (check-exn exn:fail:contract? (thunk (apply 'not-a-fn #()))) 70 | (check-exn exn:fail:contract? (thunk (apply + 'not-a-seq))) 71 | (check-exn exn:fail:contract? (thunk (apply))) 72 | (check-exn exn:fail:contract? (thunk (apply #:kw 'any)))) 73 | 74 | (test-case 75 | "Sequence concatenation" 76 | (check-true (empty? (append))) 77 | (check-equal? (length (append '(1 2) '(3 4))) 4) 78 | (check-equal? (extend #() (append '(1 2) '(3 4))) #(1 2 3 4)) 79 | (check-equal? (extend #() (append #(1 2) (hash 3 4))) #(1 2 (3 . 4)))) 80 | 81 | (test-case 82 | "Sequence filtering" 83 | (check-equal? (extend #() (filter positive? '(-2 -1 0 1 2))) #(1 2))) 84 | 85 | (test-case 86 | "Sequence mapping" 87 | (check-equal? (extend #() (map add1 '(1 2 3))) #(2 3 4)) 88 | (check-exn exn:fail:contract? (thunk (extend null (map + '(1 2) '(3)))))) 89 | 90 | (test-case 91 | "Sequence folding" 92 | (check-equal? (foldl + 0 (set 1 2 3)) 6) 93 | (check-exn exn:fail:contract? (thunk (foldl + 0 '(1 2) '(3))))) 94 | 95 | (test-case 96 | "Sequence indexing abbreviations" 97 | (check-equal? (second (range 10)) 1) 98 | (check-equal? (third (range 10)) 2) 99 | (check-equal? (fourth (range 10)) 3) 100 | (check-equal? (fifth (range 10)) 4) 101 | (check-equal? (sixth (range 10)) 5) 102 | (check-equal? (seventh (range 10)) 6) 103 | (check-equal? (eighth (range 10)) 7) 104 | (check-equal? (ninth (range 10)) 8) 105 | (check-equal? (tenth (range 10)) 9)) 106 | 107 | (test-case 108 | "Sequence for clause iteration" 109 | (check-pred procedure? in) 110 | (check-pred stream? (in #(1 2 3))) 111 | (check-equal? (sequence->list (in #(1 2 3))) '(1 2 3)) 112 | (check-equal? (for/list ([x (in #(1 2 3))]) (add1 x)) '(2 3 4)) 113 | (check-exn exn:fail:contract? (thunk (for ([i (in 'not-a-sequence)]) (void))))) 114 | 115 | (test-case 116 | "Derived for/sequence loops" 117 | (check-equal? (extend #() (for/sequence ([i (in-range 10)]) (* i i))) 118 | #(0 1 4 9 16 25 36 49 64 81)) 119 | (check-equal? (extend #() (for*/sequence ([x (in-range 1 5)] 120 | [y (in-range 1 5)]) (* x y))) 121 | #(1 2 3 4 2 4 6 8 3 6 9 12 4 8 12 16))) 122 | 123 | (test-case 124 | "Special sequence errors on mutable builtins" 125 | (check-exn #rx"which is mutable" (thunk (empty? (vector)))) 126 | (check-exn #rx"which is mutable" (thunk (empty? (make-hash)))) 127 | (check-exn #rx"which is mutable" (thunk (empty? (mutable-set)))) 128 | (check-exn #rx"expected: sequence\\?\n" (thunk (empty? 'not-a-sequence))) 129 | (check-exn #rx"which is mutable" (thunk (apply + (vector 1 2 3))))) 130 | 131 | (test-case 132 | "Good error messages for finite sequences" 133 | (check-exn #rx"index is out of range" (thunk (nth #(1 2 3 4) 4))) 134 | (check-exn #rx"index is out of range" (thunk (set-nth #(1 2 3 4) 4 'x))) 135 | (check-exn #rx"index is out of range" (thunk (update-nth #(1 2 3 4) 4 void)))) 136 | -------------------------------------------------------------------------------- /collections/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define version "1.3.1") 6 | 7 | (define deps 8 | '("collections-lib" 9 | "collections-doc")) 10 | (define build-deps 11 | '()) 12 | 13 | (define implies deps) 14 | -------------------------------------------------------------------------------- /deploy-docs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -ev # exit with nonzero exit code if anything fails 3 | 4 | if [[ "$TRAVIS_PULL_REQUEST" != 'false' || "$TRAVIS_BRANCH" != 'master' ]]; then 5 | exit 0; 6 | fi 7 | 8 | # clear the documentation directory 9 | rm -rf docs || exit 0; 10 | 11 | # build the documentation files 12 | scribble +m --redirect-main http://pkg-build.racket-lang.org/doc/ --htmls --dest ./docs ./collections-doc/scribblings/data/collection/collections.scrbl 13 | 14 | # go to the documentation directory and create a *new* Git repo 15 | cd docs/collections 16 | git init 17 | 18 | # inside this git repo we'll pretend to be a new user 19 | git config user.name 'Travis CI' 20 | git config user.email 'lexi.lambda@gmail.com' 21 | 22 | # The first and only commit to this new Git repo contains all the 23 | # files present with the commit message "Deploy to GitHub Pages". 24 | git add . 25 | git commit -m 'Deploy to GitHub Pages' 26 | 27 | # Force push from the current repo's master branch to the remote 28 | # repo. (All previous history on the branch will be lost, since we are 29 | # overwriting it.) We redirect any output to /dev/null to hide any sensitive 30 | # credential data that might otherwise be exposed. 31 | git push --force --quiet "https://${GH_TOKEN}@${GH_REF}" master:gh-pages > /dev/null 2>&1 32 | --------------------------------------------------------------------------------