EdisonAPI-1.2.2/0000755000000000000000000000000012077643166011471 5ustar0000000000000000EdisonAPI-1.2.2/Setup.hs0000644000000000000000000000011012077643166013115 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain EdisonAPI-1.2.2/COPYRIGHT0000644000000000000000000000235012077643166012764 0ustar0000000000000000Copyright (c) 1998-1999 Chris Okasaki Portions Copyright (c) 2002 Andrew Bromage Portions Copyright (c) 2006-2007 Robert Dockins Portions Copyright (c) 2006 David F. Place Portions Copyright (c) 2006 Ross Paterson and Ralf Hinze Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. EdisonAPI-1.2.2/EdisonAPI.cabal0000644000000000000000000000256012077643166014233 0ustar0000000000000000Build-type: Simple Name: EdisonAPI Version: 1.2.2 License: OtherLicense License-File: COPYRIGHT Author: Chris Okasaki Maintainer: robdockins AT fastmail DOT fm Synopsis: A library of efficent, purely-functional data structures (API) Category: Data Structures Homepage: http://www.cs.princeton.edu/~rdockins/edison/home/ Stability: Stable Description: Edison is a library of purely functional data structures written by Chris Okasaki. It is named after Thomas Alva Edison and for the mnemonic value EDiSon (Efficent Data Structures). Edison provides several families of abstractions, each with multiple implementations. The main abstractions provided by Edison are: Sequences such as stacks, queues, and dequeues; Collections such as sets, bags and heaps; and Associative Collections such as finite maps and priority queues where the priority and element are distinct. Hs-Source-Dirs: src Exposed-modules: Data.Edison Data.Edison.Prelude Data.Edison.Sym Data.Edison.Assoc Data.Edison.Coll Data.Edison.Coll.Utils Data.Edison.Seq Data.Edison.Seq.ListSeq Build-Depends: base >= 2.0 && < 5, mtl >= 1.0 Extensions: MultiParamTypeClasses FunctionalDependencies UndecidableInstances Ghc-Options: -funbox-strict-fields -fwarn-incomplete-patterns EdisonAPI-1.2.2/src/0000755000000000000000000000000012077643166012260 5ustar0000000000000000EdisonAPI-1.2.2/src/Data/0000755000000000000000000000000012077643166013131 5ustar0000000000000000EdisonAPI-1.2.2/src/Data/Edison.hs0000644000000000000000000004106012077643166014707 0ustar0000000000000000-- | -- Module : Data.Edison -- Copyright : Copyright (c) 2006 Robert Dockins -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- Edison is a library of purely functional data structures written by -- Chris Okasaki. It is named after Thomas Alva Edison and for the -- mnemonic value /ED/i/S/on (/E/fficent /D/ata /S/tructures). -- -- Edison provides several families of abstractions, each with -- multiple implementations. The main abstractions provided by Edison are: -- -- * /Sequences/ such as stacks, queues, and dequeues, -- -- * /Collections/ such as sets, bags and heaps, and -- -- * /Associative Collections/ such as finite maps and priority queues -- where the priority and element are distinct. -- -- -- -- /Conventions:/ -- -- Each data structure is implemented as a separate module. These modules -- should always be imported @qualified@ to prevent a flood of name clashes, -- and it is recommended to rename the module using the @as@ keyword to reduce -- the overhead of qualified names and to make substituting one implementation -- for another as painless as possible. -- -- Names have been chosen to match standard usage as much as possible. This -- means that operations for abstractions frequently share the same name -- (for example, @empty@, @null@, @size@, etc). It also means that in many -- cases names have been reused from the Prelude. However, the use of -- @qualified@ imports will prevent name reuse from becoming name clashes. If -- for some reason you chose to import an Edison data structure unqualified, -- you will likely need to import the Prelude @hiding@ the relevant names. -- -- Edison modules also frequently share type names. For example, most sequence -- type constructors are named @Seq@. This additionally aids substituting -- implementations by simply importing a different module. -- -- Argument orders are selected with the following points in mind: -- -- * /Partial application:/ arguments more likely to be static usually -- appear before other arguments in order to facilitate partial -- application. -- -- * /Collection appears last:/ in all cases where an operation queries a -- single collection or modifies an existing collection, the collection -- argument will appear last. This is something of a de facto standard -- for Haskell datastructure libraries -- and lends a degree of consistency to the API. -- -- * /Most usual order:/ where an operation represents a well-known -- mathematical function on more than one datastructure, the arguments -- are chosen to match the most usual argument order for the function. -- -- -- /Type classes:/ -- -- Each family of abstractions is defined as a set of classes: a main class -- that every implementation of that abstraction should support and several -- auxiliary subclasses that an implementation may or may not support. However, -- not all applications require the power of type classes, so each method -- is also directly accessible from the implementation module. Thus you can -- choose to use overloading or not, as appropriate for your particular -- application. -- -- Documentation about the behavior of data structure operations is defined -- in the modules "Data.Edison.Seq", "Data.Edison.Coll" and -- "Data.Edison.Assoc". Implementations are required to respect -- the descriptions and axioms found in these modules. In some cases time -- complexity is also given. Implementations may differ from these time -- complexities; if so, the differences will be given in the documentation for -- the individual implementation module. -- -- -- -- /Notes on Eq and Ord instances:/ -- -- Many Edison data structures require @Eq@ or @Ord@ contexts to define equivalence -- and total ordering on elements or keys. Edison makes the following assumptions -- about all such required instances: -- -- * An @Eq@ instance correctly defines an equivalence relation (but not necessarily -- structural equality); that is, we assume @(==)@ (considered as a -- relation) is reflexive, symmetric and transitive, but allow that equivalent -- items may be distinguishable by other means. -- -- * An @Ord@ instance correctly defines a total order which is consistent with -- the @Eq@ instance for that type. -- -- These assumptions correspond to the usual meanings assigned to these classes. If -- an Edison data structure is used with an @Eq@ or @Ord@ instance which violates these -- assumptions, then the behavior of that data structure is undefined. -- -- -- -- /Notes on Read and Show instances:/ -- -- The usual Haskell convention for @Read@ and @Show@ instances (as championed by the -- Haskell \"deriving\" mechanism), is that @show@ generates a string which is a -- valid Haskell expression built up -- using the data type's data constructors such that, if interpreted as Haskell code, the -- string would generate an identical data item. Furthermore, the derived @Read@ -- instances are able to parse such strings, such that @(read . show) === id@. -- So, derived instances of @Read@ and @Show@ exhibit -- the following useful properties: -- -- * @read@ and @show@ are complementary; that is, @read@ is a useful inverse for @show@ -- -- * @show@ generates a string which is legal Haskell code representing the data item -- -- For concrete data types, the deriving mechanism is usually quite sufficient. -- However, for abstract types the derived @Read@ instance may allow users to create data -- which violates invariants. Furthermore, the strings resulting from @show@ reference hidden -- data constructors which violates good software engineering principles and also -- cannot be compiled because the constructors are not available outside the defining module. -- -- Edison avoids most of these problems and still maintains the above useful properties by -- doing conversions to and from lists and inserting explicit calls to the list conversion -- operations. The corresponding @Read@ instance strips the list conversion call before -- parsing the list. In this way, private data constructors are not revealed and @show@ strings -- are still legal, compilable Haskell code. Furthermore, the showed strings gain a degree of -- independence from the underlying datastructure implementation. -- -- For example, calling @show@ on an empty Banker's queue will result in the following string: -- -- > Data.Edison.Seq.BankersQueue.fromList [] -- -- Datatypes which are not native Edison data structures (such as StandardSet and StandardMap) -- may or may not provide @Read@ or @Show@ instances and, if they exist, they may or may -- not also provide the properties that Edison native @Read@ and @Show@ instances do. -- -- -- /Notes on time complexities:/ -- -- Some Edison data structures (only the sequences currently) have detailed time complexity -- information. Unless otherwise stated, these are amortized time complexities, assuming -- persistent usage of the datastructure. Much of this data comes from: -- -- Martin Holters. /Efficent Data Structures in a Lazy Functional Language/. Master's Thesis. -- Chalmers University of Technology, Sweden. 2003. -- -- /Notes on unsafe functions:/ -- -- There are a number of different notions of what constitutes an unsafe function. -- In Haskell, a function is generally called \"unsafe\" if it can subvert -- type safety or referential integrity, such as @unsafePerformIO@ or @unsafeCoerce#@. -- In Edison, however, we downgrade the meaning of \"unsafe\" somewhat. An -- \"unsafe\" Edison function is one which, if misused, can violate the structural -- invariants of a data structure. Misusing an Edison \"unsafe\" function should -- never cause your runtime to crash or break referential integrity, but it may cause -- later uses of a data structure to behave in undefined ways. Almost all unsafe functions -- in Edison are labeled with the @unsafe@ prefix. An exception to this rule is the -- @With@ functions in the 'Set' class, which are also unsafe but do not have -- the prefix. Unsafe functions will have explicit preconditions listed in their -- documentation. -- -- -- -- /Notes on ambiguous functions:/ -- -- Edison also contains some functions which are labeled \"ambiguous\". These -- functions cannot violate the structural invariants of a data structure, but, under -- some conditions, the result of applying an ambiguous function is not well defined. -- For ambiguous functions, the result of applying the function may depend on otherwise -- unobservable internal state of the data structure, such as the actual shape of a -- balanced tree. For example, the 'AssocX' class contains the @fold@ function, which -- folds over the elements in the collection in an arbitrary order. If the combining -- function passed to @fold@ is not fold-commutative (see below), then the result of -- the fold will depend on the actual order that elements are presented to the -- combining function, which is not defined. -- -- To aid programmers, each API function is labeled /ambiguous/ or /unambiguous/ in its -- documentation. If a function is unambiguous only under some circumstances, -- that will also be explicitly stated. -- -- An \"unambiguous\" operation is one where all correct implementations of the operation -- will return \"indistinguishable\" results. For concrete data types, \"indistinguishable\" -- means structural equality. An instance of an abstract data type is considered -- indistinguishable from another if all possible applications of unambiguous -- operations to both yield indistinguishable results. (Note: this definition is -- impredicative and rather imprecise. Should it become an issue, I will attempt to -- develop a better definition. I hope the intent is sufficiently clear). -- -- A higher-order unambiguous operation may be rendered ambiguous if passed a \"function\" which -- does not respect referential integrity (one containing @unsafePerformIO@ for example). -- Only do something like this if you are 110% sure you know what you are doing, and even then -- think it over two or three times. -- -- -- -- /How to choose a fold:/ -- -- /Folds/ are an important class of operations on data structures in a functional -- language; they perform essentially the same role that iterators perform in -- imperative languages. Edison provides a dizzying array of folds which (hopefully) -- correspond to all the various ways a programmer might want to fold over a data -- structure. However, it can be difficult to know which fold to choose for a -- particular application. In general, you should choose a fold which provides -- the /fewest/ guarantees necessary for correctness. The folds which have fewer -- guarantees give data structure implementers more leeway to provide efficient -- implementations. For example, if you which to fold a commutative, associative -- function, you should chose @fold@ (which does not guarantee an order) over @foldl@ -- or @foldr@, which specify particular orders. -- -- Also, if your function is strict in -- the accumulating argument, you should prefer the strict folds (eg, @fold'@); they will -- often provide better space behavior. /Be aware/, however, that the \"strict\" folds -- are not /necessarily/ more strict than the \"non-strict\" folds; they merely give -- implementers the option to provide additional strictness if it improves performance. -- -- For associative collections, only use with @WithKey@ folds if you actually need the -- value of the key. -- -- -- /Painfully detailed information about ambiguous folds:/ -- -- All of the folds that are listed ambiguous are ambiguous because they do not or cannot -- guarantee a stable order with which the folding function will be applied. However, -- some functions are order insensitive, and the result will be unambiguous regardless -- of the fold order chosen. Here we formalize this property, which we call -- \"fold commutativity\". -- -- We say @f :: a -> b -> b@ is /fold-commutative/ iff @f@ is unambiguous and -- -- > forall w, z :: b; m, n :: a -- > -- > w = z ==> f m (f n w) = f n (f m z) -- > -- -- where @=@ means indistinguishability. -- -- This property is sufficient (but not necessary) to ensure that, for any -- collection of elements to -- fold over, folds over all permutations of those elements will generate -- indistinguishable results. In other words, an ambiguous fold applied to a -- fold-commutative combining function becomes /unambiguous/. -- -- Some fold combining functions take their arguments in the reverse order. We -- straightforwardly extend the notion of fold commutativity to such functions -- by reversing the arguments. More formally, we say @g :: b -> a -> b@ is fold -- commutative iff @flip g :: a -> b -> b@ is fold commutative. -- -- For folds which take both a key and an element value, we extend the notion of fold -- commutativity by considering the key and element to be a single, uncurried argument. -- More formally, we say @g :: k -> a -> b -> b@ is fold commutative iff -- -- > \(k,x) z -> g k x z :: (k,a) -> b -> b -- -- is fold commutative according to the above definition. -- -- Note that for @g :: a -> a -> a@, if @g@ is unambiguous, -- commutative, and associative, then @g@ is fold-commutative. -- -- Proof: -- -- > let w = z, then -- > g m (g n w) = g m (g n z) g is unambiguous -- > = g (g n z) m commutative property of g -- > = g n (g z m) associative property of g -- > = g n (g m z) commutative property of g -- -- Qed. -- -- Thus, many common numeric combining functions, including @(+)@ and @(*)@ at -- integral types, are fold commutative and can be safely used with ambiguous -- folds. -- -- /Be aware/ however, that @(+)@ and @(*)@ at floating point types are only -- /approximately/ commutative and associative due to rounding errors; using -- ambiguous folds with these operations may result in subtle differences in -- the results. As always, be aware of the limitations and numeric -- properties of floating point representations. -- -- -- -- /About this module:/ -- -- This module re-exports the various data structure abstraction classes, but -- not their methods. This allows you to write type signatures which have -- contexts that mention Edison type classes without having to import the -- appropriate modules @qualified@. The class methods are not exported to -- avoid name clashes. Obviously, to use the methods of these classes, you -- will have to import the appropriate modules. This module additionally -- re-exports the entire "Data.Edison.Prelude" module. -- -- -- -- /Miscellaneous points:/ -- -- Some implementations export a few extra functions beyond those included -- in the relevant classes. These are typically operations that are -- particularly efficient for that implementation, but are not general enough -- to warrant inclusion in a class. -- -- Since qualified infix symbols are fairly ugly, they have been largely avoided. -- However, the "Data.Edison.Sym" module defines a number of infix operators -- which alias the prefix operators; this module is intended to be imported -- unqualified. -- -- Most of the operations on most of the data structures are strict. This is -- inevitable for data structures with non-trivial invariants. Even given -- that, however, many of the operations are stricter than necessary. In -- fact, operations are never deliberately made lazy unless the laziness is -- required by the algorithm, as can happen with amortized data structures. -- -- Note, however, that the various sequence implementations are always lazy -- in their elements. Similarly, associative collections are always lazy in -- their elements (but usually strict in their keys). Non-associative -- collections are usually strict in their elements. module Data.Edison ( -- * Sequence class Sequence -- * Collection classes -- ** Non-observable collections , CollX , OrdCollX , SetX , OrdSetX -- ** Observable collections , Coll , OrdColl , Set , OrdSet -- * Associative collection classes -- ** Non-observable associative collections , AssocX , OrdAssocX , FiniteMapX , OrdFiniteMapX -- ** Observable associative collections , Assoc , OrdAssoc , FiniteMap , OrdFiniteMap , module Data.Edison.Prelude ) where import Data.Edison.Prelude import Data.Edison.Seq import Data.Edison.Coll import Data.Edison.Assoc EdisonAPI-1.2.2/src/Data/Edison/0000755000000000000000000000000012077643166014352 5ustar0000000000000000EdisonAPI-1.2.2/src/Data/Edison/Seq.hs0000644000000000000000000011061012077643166015435 0ustar0000000000000000-- | -- Module : Data.Edison.Seq -- Copyright : Copyright (c) 1998-1999 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- The sequence abstraction is usually viewed as a hierarchy of ADTs -- including lists, queues, deques, catenable lists, etc. However, such -- a hierarchy is based on efficiency rather than functionality. For example, -- a list supports all the operations that a deque supports, even though -- some of the operations may be inefficient. Hence, in Edison, all sequence -- data structures are defined as instances of the single Sequence class: -- -- @ class (Functor s, MonadPlus s) => Sequence s@ -- -- All sequences are also instances of 'Functor', 'Monad', and 'MonadPlus'. -- In addition, all sequences are expected to be instances of @Eq@, @Show@, -- and @Read@, although this is not enforced. -- -- We follow the naming convention that every module implementing sequences -- defines a type constructor named @Seq@. -- -- For each method the \"default\" complexity is listed. Individual -- implementations may differ for some methods. The documentation for -- each implementation will list those methods for which the running time -- differs from these. -- -- A description of each Sequence function appears below. In most cases -- psudeocode is also provided. Obviously, the psudeocode is illustrative only. -- -- Sequences are represented in psudecode between angle brackets: -- -- > -- -- Such that @x0@ is at the left (front) of the sequence and -- @xn-1@ is at the right (rear) of the sequence. module Data.Edison.Seq ( -- * Superclass aliases -- ** Functor aliases map -- ** Monad aliases , singleton , concatMap -- ** MonadPlus aliases , empty , append -- * The Sequence class , Sequence (..) ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import Control.Monad import Data.Monoid import Data.Edison.Prelude -- | Return the result of applying a function to -- every element of a sequence. Identical -- to @fmap@ from @Functor@. -- -- > map f = -- -- /Axioms:/ -- -- * @map f empty = empty@ -- -- * @map f (lcons x xs) = lcons (f x) (map f xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ map :: Sequence s => (a -> b) -> s a -> s b map = fmap -- | Create a singleton sequence. Identical to @return@ -- from @Monad@. -- -- > singleton x = -- -- /Axioms:/ -- -- * @singleton x = lcons x empty = rcons x empty@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ singleton :: Sequence s => a -> s a singleton = return -- | Apply a sequence-producing function to every element -- of a sequence and flatten the result. 'concatMap' -- is the bind @(>>=)@ operation of from @Monad@ with the -- arguments in the reverse order. -- -- > concatMap f xs = concat (map f xs) -- -- /Axioms:/ -- -- * @concatMap f xs = concat (map f xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n + m )@ -- where @n@ is the length of the input sequence, @m@ is the -- length of the output sequence, and @t@ is the running time of @f@ concatMap :: Sequence s => (a -> s b) -> s a -> s b concatMap = flip (>>=) -- | The empty sequence. Identical to @mzero@ -- from @MonadPlus@. -- -- > empty = <> -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ empty :: Sequence s => s a empty = mzero -- | Append two sequence, with the first argument on the left -- and the second argument on the right. Identical to @mplus@ -- from @MonadPlus@. -- -- > append = -- -- /Axioms:/ -- -- * @append xs ys = foldr lcons ys xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n1 )@ append :: Sequence s => s a -> s a -> s a append = mplus -- | The 'Sequence' class defines an interface for datatypes which -- implement sequences. A description for each function is -- given below. class (Functor s, MonadPlus s) => Sequence s where -- | Add a new element to the front\/left of a sequence -- -- > lcons x = -- -- /Axioms:/ -- -- * @lcons x xs = append (singleton x) xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ lcons :: a -> s a -> s a -- | Add a new element to the right\/rear of a sequence -- -- > rcons x = -- -- /Axioms:/ -- -- * @rcons x xs = append xs (singleton x)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rcons :: a -> s a -> s a -- | Convert a list into a sequence -- -- > fromList [x0,...,xn-1] = -- -- /Axioms:/ -- -- * @fromList xs = foldr lcons empty xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ fromList :: [a] -> s a -- | Create a sequence containing @n@ copies of the given element. -- Return 'empty' if @n\<0@. -- -- @copy n x = \@ -- -- /Axioms:/ -- -- * @n > 0 ==> copy n x = cons x (copy (n-1) x)@ -- -- * @n \<= 0 ==> copy n x = empty@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ copy :: Int -> a -> s a -- | Separate a sequence into its first (leftmost) element and the -- remaining sequence. Calls 'fail' if the sequence is empty. -- -- /Axioms:/ -- -- * @lview empty = fail@ -- -- * @lview (lcons x xs) = return (x,xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ lview :: (Monad m) => s a -> m (a, s a) -- | Return the first element of a sequence. -- Signals an error if the sequence is empty. -- -- /Axioms:/ -- -- * @lhead empty = undefined@ -- -- * @lhead (lcons x xs) = x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ lhead :: s a -> a -- | Returns the first element of a sequence. -- Calls 'fail' if the sequence is empty. -- -- /Axioms:/ -- -- * @lheadM empty = fail@ -- -- * @lheadM (lcons x xs) = return x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ lheadM :: (Monad m) => s a -> m a -- | Delete the first element of the sequence. -- Signals error if sequence is empty. -- -- /Axioms:/ -- -- * @ltail empty = undefined@ -- -- * @ltail (lcons x xs) = xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ ltail :: s a -> s a -- | Delete the first element of the sequence. -- Calls 'fail' if the sequence is empty. -- -- /Axioms:/ -- -- * @ltailM empty = fail@ -- -- * @ltailM (lcons x xs) = return xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ ltailM :: (Monad m) => s a -> m (s a) -- | Separate a sequence into its last (rightmost) element and the -- remaining sequence. Calls 'fail' if the sequence is empty. -- -- /Axioms:/ -- -- * @rview empty = fail@ -- -- * @rview (rcons x xs) = return (x,xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rview :: (Monad m) => s a -> m (a, s a) -- | Return the last (rightmost) element of the sequence. -- Signals error if sequence is empty. -- -- /Axioms:/ -- -- * @rhead empty = undefined@ -- -- * @rhead (rcons x xs) = x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rhead :: s a -> a -- | Returns the last element of the sequence. -- Calls 'fail' if the sequence is empty. -- -- /Axioms:/ -- -- * @rheadM empty = fail@ -- -- * @rheadM (rcons x xs) = return x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rheadM :: (Monad m) => s a -> m a -- | Delete the last (rightmost) element of the sequence. -- Signals an error if the sequence is empty. -- -- /Axioms:/ -- -- * @rtail empty = undefined@ -- -- * @rtail (rcons x xs) = xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rtail :: s a -> s a -- | Delete the last (rightmost) element of the sequence. -- Calls 'fail' of the sequence is empty -- -- /Axioms:/ -- -- * @rtailM empty = fail@ -- -- * @rtailM (rcons x xs) = return xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ rtailM :: (Monad m) => s a -> m (s a) -- | Returns 'True' if the sequence is empty and 'False' otherwise. -- -- > null = (n==0) -- -- /Axioms:/ -- -- * @null xs = (size xs == 0)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( 1 )@ null :: s a -> Bool -- | Returns the length of a sequence. -- -- > size = n -- -- /Axioms:/ -- -- * @size empty = 0@ -- -- * @size (lcons x xs) = 1 + size xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ size :: s a -> Int -- | Convert a sequence to a list. -- -- > toList = [x0,...,xn-1] -- -- /Axioms:/ -- -- * @toList empty = []@ -- -- * @toList (lcons x xs) = x : toList xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ toList :: s a -> [a] -- | Flatten a sequence of sequences into a simple sequence. -- -- > concat xss = foldr append empty xss -- -- /Axioms:/ -- -- * @concat xss = foldr append empty xss@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n + m )@ -- where @n@ is the length of the input sequence and @m@ is -- length of the output sequence. concat :: s (s a) -> s a -- | Reverse the order of a sequence -- -- > reverse = -- -- /Axioms:/ -- -- * @reverse empty = empty@ -- -- * @reverse (lcons x xs) = rcons x (reverse xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ reverse :: s a -> s a -- | Reverse a sequence onto the front of another sequence. -- -- > reverseOnto = -- -- /Axioms:/ -- -- * @reverseOnto xs ys = append (reverse xs) ys@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n1 )@ reverseOnto :: s a -> s a -> s a -- | Combine all the elements of a sequence into a single value, -- given a combining function and an initial value. The order -- in which the elements are applied to the combining function -- is unspecified. @fold@ is one of the few ambiguous sequence -- functions. -- -- /Axioms:/ -- -- * @fold f c empty = c@ -- -- * @f is fold-commutative ==> fold f = foldr f = foldl f@ -- -- @fold f@ is /unambiguous/ iff @f@ is fold-commutative. -- -- Default running type: @O( t * n )@ -- where @t@ is the running tome of @f@. fold :: (a -> b -> b) -> b -> s a -> b -- | A strict variant of 'fold'. @fold'@ is one of the few ambiguous -- sequence functions. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ ==> fold f x xs = fold' f x xs@ -- -- @fold f@ is /unambiguous/ iff @f@ is fold-commutative. -- -- Default running type: @O( t * n )@ -- where @t@ is the running tome of @f@. fold' :: (a -> b -> b) -> b -> s a -> b -- | Combine all the elements of a non-empty sequence into a -- single value, given a combining function. Signals an error -- if the sequence is empty. -- -- /Axioms:/ -- -- * @f is fold-commutative ==> fold1 f = foldr1 f = foldl1 f@ -- -- @fold1 f@ is /unambiguous/ iff @f@ is fold-commutative. -- -- Default running type: @O( t * n )@ -- where @t@ is the running tome of @f@. fold1 :: (a -> a -> a) -> s a -> a -- | A strict variant of 'fold1'. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ ==> fold1' f xs = fold1 f xs@ -- -- @fold1' f@ is /unambiguous/ iff @f@ is fold-commutative. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ fold1' :: (a -> a -> a) -> s a -> a -- | Combine all the elements of a sequence into a single value, -- given a combining function and an initial value. The function -- is applied with right nesting. -- -- > foldr (%) c = x0 % (x1 % ( ... % (xn-1 % c))) -- -- /Axioms:/ -- -- * @foldr f c empty = c@ -- -- * @foldr f c (lcons x xs) = f x (foldr f c xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldr :: (a -> b -> b) -> b -> s a -> b -- | Strict variant of 'foldr'. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ ==> foldr f x xs = foldr' f x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldr' :: (a -> b -> b) -> b -> s a -> b -- | Combine all the elements of a sequence into a single value, -- given a combining function and an initial value. The function -- is applied with left nesting. -- -- > foldl (%) c = (((c % x0) % x1) % ... ) % xn-1 -- -- /Axioms:/ -- -- * @foldl f c empty = c@ -- -- * @foldl f c (lcons x xs) = foldl f (f c x) xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldl :: (b -> a -> b) -> b -> s a -> b -- | Strict variant of 'foldl'. -- -- /Axioms:/ -- -- * forall a. f _|_ a = _|_ ==> foldl f z xs = foldl' f z xs -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldl' :: (b -> a -> b) -> b -> s a -> b -- | Combine all the elements of a non-empty sequence into a -- single value, given a combining function. The function -- is applied with right nesting. Signals an error if the -- sequence is empty. -- -- > foldr1 (+) -- > | n==0 = error "ModuleName.foldr1: empty sequence" -- > | n>0 = x0 + (x1 + ... + xn-1) -- -- /Axioms:/ -- -- * @foldr1 f empty = undefined@ -- -- * @foldr1 f (rcons x xs) = foldr f x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldr1 :: (a -> a -> a) -> s a -> a -- | Strict variant of 'foldr1'. -- -- /Axioms:/ -- -- * forall a. f a _|_ = _|_ ==> foldr1 f xs = foldr1' f xs -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldr1' :: (a -> a -> a) -> s a -> a -- | Combine all the elements of a non-empty sequence into -- a single value, given a combining function. The function -- is applied with left nesting. Signals an error if the -- sequence is empty. -- -- > foldl1 (+) -- > | n==0 = error "ModuleName.foldl1: empty sequence" -- > | n>0 = (x0 + x1) + ... + xn-1 -- -- /Axioms:/ -- -- * @foldl1 f empty = undefined@ -- -- * @foldl1 f (lcons x xs) = foldl f x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldl1 :: (a -> a -> a) -> s a -> a -- | Strict variant of 'foldl1'. -- -- /Axioms:/ -- -- * forall a. f _|_ a = _|_ ==> foldl1 f xs = foldl1' f xs -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldl1' :: (a -> a -> a) -> s a -> a -- | See 'reduce1' for additional notes. -- -- > reducer f x xs = reduce1 f (cons x xs) -- -- /Axioms:/ -- -- * @reducer f c xs = foldr f c xs@ for associative @f@ -- -- @reducer f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reducer :: (a -> a -> a) -> a -> s a -> a -- | Strict variant of 'reducer'. -- -- See 'reduce1' for additional notes. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ && forall a. f _|_ a = _|_ ==> -- reducer f x xs = reducer' f x xs@ -- -- @reducer' f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reducer' :: (a -> a -> a) -> a -> s a -> a -- | See 'reduce1' for additional notes. -- -- > reducel f x xs = reduce1 f (rcons x xs) -- -- /Axioms:/ -- -- * @reducel f c xs = foldl f c xs@ for associative @f@ -- -- @reducel f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reducel :: (a -> a -> a) -> a -> s a -> a -- | Strict variant of 'reducel'. -- -- See 'reduce1' for additional notes. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ && forall a. f _|_ a = _|_ ==> -- reducel f x xs = reducel' f x xs@ -- -- @reducel' f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reducel' :: (a -> a -> a) -> a -> s a -> a -- | A reduce is similar to a fold, but combines elements in a balanced fashion. -- The combining function should usually be associative. If the combining -- function is associative, the various reduce functions yield the same -- results as the corresponding folds. -- -- What is meant by \"in a balanced fashion\"? We mean that -- @reduce1 (%) \@ equals some complete parenthesization of -- @x0 % x1 % ... % xn-1@ such that the nesting depth of parentheses -- is @O( log n )@. The precise shape of this parenthesization is -- unspecified. -- -- > reduce1 f = x -- > reduce1 f = -- > f (reduce1 f ) (reduce1 f ) -- -- for some @i@ such that @ 0 \<= i && i \< n-1 @ -- -- Although the exact value of i is unspecified it tends toward @n\/2@ -- so that the depth of calls to @f@ is at most logarithmic. -- -- Note that @reduce@* are some of the only sequence operations for which -- different implementations are permitted to yield different answers. Also -- note that a single implementation may choose different parenthisizations -- for different sequences, even if they are the same length. This will -- typically happen when the sequences were constructed differently. -- -- The canonical applications of the reduce functions are algorithms like -- merge sort where: -- -- > mergesort xs = reducer merge empty (map singleton xs) -- -- -- /Axioms:/ -- -- * @reduce1 f empty = undefined@ -- -- * @reduce1 f xs = foldr1 f xs = foldl1 f xs@ for associative @f@ -- -- @reduce1 f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reduce1 :: (a -> a -> a) -> s a -> a -- | Strict variant of 'reduce1'. -- -- /Axioms:/ -- -- * @forall a. f a _|_ = _|_ && forall a. f _|_ a = _|_ ==> -- reduce1 f xs = reduce1' f xs@ -- -- @reduce1' f@ is unambiguous iff @f@ is an associative function. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ reduce1' :: (a -> a -> a) -> s a -> a -- | Extract a prefix of length @i@ from the sequence. Return -- 'empty' if @i@ is negative, or the entire sequence if @i@ -- is too large. -- -- > take i xs = fst (splitAt i xs) -- -- /Axioms:/ -- -- * @i \< 0 ==> take i xs = empty@ -- -- * @i > size xs ==> take i xs = xs@ -- -- * @size xs == i ==> take i (append xs ys) = xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ take :: Int -> s a -> s a -- | Delete a prefix of length @i@ from a sequence. Return -- the entire sequence if @i@ is negative, or 'empty' if -- @i@ is too large. -- -- > drop i xs = snd (splitAt i xs) -- -- /Axioms:/ -- -- * @i \< 0 ==> drop i xs = xs@ -- -- * @i > size xs ==> drop i xs = empty@ -- -- * @size xs == i ==> drop i (append xs ys) = ys@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ drop :: Int -> s a -> s a -- | Split a sequence into a prefix of length @i@ -- and the remaining sequence. Behaves the same -- as the corresponding calls to 'take' and 'drop' -- if @i@ is negative or too large. -- -- > splitAt i xs -- > | i < 0 = (<> , ) -- > | i < n = (, ) -- > | i >= n = (, <> ) -- -- /Axioms:/ -- -- * @splitAt i xs = (take i xs,drop i xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ splitAt :: Int -> s a -> (s a, s a) -- | Extract a subsequence from a sequence. The integer -- arguments are \"start index\" and \"length\" NOT -- \"start index\" and \"end index\". Behaves the same -- as the corresponding calls to 'take' and 'drop' if the -- start index or length are negative or too large. -- -- > subseq i len xs = take len (drop i xs) -- -- /Axioms:/ -- -- * @subseq i len xs = take len (drop i xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i + len )@ subseq :: Int -> Int -> s a -> s a -- | Extract the elements of a sequence that satisfy the -- given predicate, retaining the relative ordering of -- elements from the original sequence. -- -- > filter p xs = foldr pcons empty xs -- > where pcons x xs = if p x then cons x xs else xs -- -- /Axioms:/ -- -- * @filter p empty = empty@ -- -- * @filter p (lcons x xs) = if p x -- then lcons x (filter p xs) -- else filter p xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @p@ filter :: (a -> Bool) -> s a -> s a -- | Separate the elements of a sequence into those that -- satisfy the given predicate and those that do not, -- retaining the relative ordering of elements from the -- original sequence. -- -- > partition p xs = (filter p xs, filter (not . p) xs) -- -- /Axioms:/ -- -- * @partition p xs = (filter p xs, filter (not . p) xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @p@ partition :: (a -> Bool) -> s a -> (s a, s a) -- | Extract the maximal prefix of elements satisfying the -- given predicate. -- -- > takeWhile p xs = fst (splitWhile p xs) -- -- /Axioms:/ -- -- * @takeWhile p empty = empty@ -- -- * @takeWhile p (lcons x xs) = if p x -- then lcons x (takeWhile p xs) -- else empty@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @p@ takeWhile :: (a -> Bool) -> s a -> s a -- | Delete the maximal prefix of elements satisfying the -- given predicate. -- -- > dropWhile p xs = snd (splitWhile p xs) -- -- /Axioms:/ -- -- * @dropWhile p empty = empty@ -- -- * @dropWhile p (lcons x xs) = if p x -- then dropWhile p xs -- else lcons x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @p@ dropWhile :: (a -> Bool) -> s a -> s a -- | Split a sequence into the maximal prefix of elements -- satisfying the given predicate, and the remaining sequence. -- -- > splitWhile p = (, ) -- > where i = min j such that p xj (or n if no such j) -- -- /Axioms:/ -- -- * @splitWhile p xs = (takeWhile p xs,dropWhile p xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @p@ splitWhile :: (a -> Bool) -> s a -> (s a, s a) -- | Test whether an index is valid for the given sequence. All indexes -- are 0 based. -- -- > inBounds i = (0 <= i && i < n) -- -- /Axioms:/ -- -- * @inBounds i xs = (0 \<= i && i \< size xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ inBounds :: Int -> s a -> Bool -- | Return the element at the given index. All indexes are 0 based. -- Signals error if the index out of bounds. -- -- > lookup i xs@ -- > | inBounds i xs = xi -- > | otherwise = error "ModuleName.lookup: index out of bounds" -- -- /Axioms:/ -- -- * @not (inBounds i xs) ==> lookup i xs = undefined@ -- -- * @size xs == i ==> lookup i (append xs (lcons x ys)) = x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ lookup :: Int -> s a -> a -- | Return the element at the given index. All indexes are 0 based. -- Calls 'fail' if the index is out of bounds. -- -- > lookupM i xs@ -- > | inBounds i xs = Just xi -- > | otherwise = Nothing -- -- /Axioms:/ -- -- * @not (inBounds i xs) ==> lookupM i xs = fail@ -- -- * @size xs == i ==> lookupM i (append xs (lcons x ys)) = return x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ lookupM :: (Monad m) => Int -> s a -> m a -- | Return the element at the given index, or the -- default argument if the index is out of bounds. All indexes are -- 0 based. -- -- > lookupWithDefault d i xs@ -- > | inBounds i xs = xi -- > | otherwise = d -- -- /Axioms:/ -- -- * @not (inBounds i xs) ==> lookupWithDefault d i xs = d@ -- -- * @size xs == i ==> lookupWithDefault d i (append xs (lcons x ys)) = x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ lookupWithDefault :: a -> Int -> s a -> a -- | Replace the element at the given index, or return -- the original sequence if the index is out of bounds. -- All indexes are 0 based. -- -- > update i y xs@ -- > | inBounds i xs = -- > | otherwise = xs -- -- /Axioms:/ -- -- * @not (inBounds i xs) ==> update i y xs = xs@ -- -- * @size xs == i ==> update i y (append xs (lcons x ys)) = -- append xs (lcons y ys)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i )@ update :: Int -> a -> s a -> s a -- | Apply a function to the element at the given index, or -- return the original sequence if the index is out of bounds. -- All indexes are 0 based. -- -- > adjust f i xs@ -- > | inBounds i xs = -- > | otherwise = xs -- -- /Axioms:/ -- -- * @not (inBounds i xs) ==> adjust f i xs = xs@ -- -- * @size xs == i ==> adjust f i (append xs (lcons x ys)) = -- append xs (cons (f x) ys)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( i + t )@ -- where @t@ is the running time of @f@ adjust :: (a -> a) -> Int -> s a -> s a -- map a single element -- | Like 'map', but include the index with each element. -- All indexes are 0 based. -- -- > mapWithIndex f = -- -- /Axioms:/ -- -- * @mapWithIndex f empty = empty@ -- -- * @mapWithIndex f (rcons x xs) = rcons (f (size xs) x) (mapWithIndex f xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ mapWithIndex :: (Int -> a -> b) -> s a -> s b -- | Like 'foldr', but include the index with each element. -- All indexes are 0 based. -- -- > foldrWithIndex f c = -- > f 0 x0 (f 1 x1 (... (f (n-1) xn-1 c))) -- -- /Axioms:/ -- -- * @foldrWithIndex f c empty = c@ -- -- * @foldrWithIndex f c (rcons x xs) = -- foldrWithIndex f (f (size xs) x c) xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldrWithIndex :: (Int -> a -> b -> b) -> b -> s a -> b -- | Strict variant of 'foldrWithIndex'. -- -- /Axioms:/ -- -- * @forall i a. f i a _|_ = _|_ ==> foldrWithIndex f x xs = -- foldrWithIndex' f x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldrWithIndex' :: (Int -> a -> b -> b) -> b -> s a -> b -- | Like 'foldl', but include the index with each element. -- All indexes are 0 based. -- -- > foldlWithIndex f c = -- > f (...(f (f c 0 x0) 1 x1)...) (n-1) xn-1) -- -- /Axioms:/ -- -- * @foldlWithIndex f c empty = c@ -- -- * @foldlWithIndex f c (rcons x xs) = -- f (foldlWithIndex f c xs) (size xs) x@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldlWithIndex :: (b -> Int -> a -> b) -> b -> s a -> b -- | Strict variant of 'foldlWithIndex'. -- -- /Axioms:/ -- -- * @forall i a. f _|_ i a = _|_ ==> foldlWithIndex f x xs = -- foldlWithIndex' f x xs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the running time of @f@ foldlWithIndex' :: (b -> Int -> a -> b) -> b -> s a -> b -- | Combine two sequences into a sequence of pairs. If the -- sequences are different lengths, the excess elements of the -- longer sequence is discarded. -- -- > zip = <(x0,y0),...,(xj-1,yj-1)> -- > where j = min {n,m} -- -- /Axioms:/ -- -- * @zip xs ys = zipWith (,) xs ys@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( min( n1, n2 ) )@ zip :: s a -> s b -> s (a,b) -- | Like 'zip', but combines three sequences into triples. -- -- > zip3 = -- > <(x0,y0,z0),...,(xj-1,yj-1,zj-1)> -- > where j = min {n,m,k} -- -- /Axioms:/ -- -- * @zip3 xs ys zs = zipWith3 (,,) xs ys zs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( min( n1, n2, n3 ) )@ zip3 :: s a -> s b -> s c -> s (a,b,c) -- | Combine two sequences into a single sequence by mapping -- a combining function across corresponding elements. If -- the sequences are of different lengths, the excess elements -- of the longer sequence are discarded. -- -- > zipWith f xs ys = map (uncurry f) (zip xs ys) -- -- /Axioms:/ -- -- * @zipWith f (lcons x xs) (lcons y ys) = -- lcons (f x y) (zipWith f xs ys)@ -- -- * @(null xs || null ys) ==> zipWith xs ys = empty@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * min( n1, n2 ) )@ -- where @t@ is the running time of @f@ zipWith :: (a -> b -> c) -> s a -> s b -> s c -- | Like 'zipWith' but for a three-place function and three -- sequences. -- -- > zipWith3 f xs ys zs = map (uncurry f) (zip3 xs ys zs) -- -- /Axioms:/ -- -- * @zipWith3 (lcons x xs) (lcons y ys) (lcons z zs) = -- lcons (f x y z) (zipWith3 f xs ys zs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * min( n1, n2, n3 ) )@ -- where @t@ is the running time of @f@ zipWith3 :: (a -> b -> c -> d) -> s a -> s b -> s c -> s d -- | Transpose a sequence of pairs into a pair of sequences. -- -- > unzip xs = (map fst xs, map snd xs) -- -- /Axioms:/ -- -- * @unzip xys = unzipWith fst snd xys@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ unzip :: s (a,b) -> (s a, s b) -- | Transpose a sequence of triples into a triple of sequences -- -- > unzip3 xs = (map fst3 xs, map snd3 xs, map thd3 xs) -- > where fst3 (x,y,z) = x -- > snd3 (x,y,z) = y -- > thd3 (x,y,z) = z -- -- /Axioms:/ -- -- * @unzip3 xyzs = unzipWith3 fst3 snd3 thd3 xyzs@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ unzip3 :: s (a,b,c) -> (s a, s b, s c) -- | Map two functions across every element of a sequence, -- yielding a pair of sequences -- -- > unzipWith f g xs = (map f xs, map g xs) -- -- /Axioms:/ -- -- * @unzipWith f g xs = (map f xs, map g xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the maximum running time -- of @f@ and @g@ unzipWith :: (a -> b) -> (a -> c) -> s a -> (s b, s c) -- | Map three functions across every element of a sequence, -- yielding a triple of sequences. -- -- > unzipWith3 f g h xs = (map f xs, map g xs, map h xs) -- -- /Axioms:/ -- -- * @unzipWith3 f g h xs = (map f xs,map g xs,map h xs)@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( t * n )@ -- where @t@ is the maximum running time -- of @f@, @g@, and @h@ unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d) -- | Semanticly, this function is a partial identity function. If the -- datastructure is infinite in size or contains exceptions or non-termination -- in the structure itself, then @strict@ will result in bottom. Operationally, -- this function walks the datastructure forcing any closures. Elements contained -- in the sequence are /not/ forced. -- -- /Axioms:/ -- -- * @strict xs = xs@ OR @strict xs = _|_@ -- -- This function is always /unambiguous/. -- -- Default running time: @O( n )@ strict :: s a -> s a -- | Similar to 'strict', this function walks the datastructure forcing closures. -- However, @strictWith@ will additionally apply the given function to the -- sequence elements, force the result using @seq@, and then ignore it. -- This function can be used to perform various levels of forcing on the -- sequence elements. In particular: -- -- > strictWith id xs -- -- will force the spine of the datastructure and reduce each element to WHNF. -- -- /Axioms:/ -- -- * forall @f :: a -> b@, @strictWith f xs = xs@ OR @strictWith f xs = _|_@ -- -- This function is always /unambiguous/. -- -- Default running time: unbounded (forcing element closures can take arbitrairly long) strictWith :: (a -> b) -> s a -> s a -- | A method to facilitate unit testing. Returns 'True' if the structural -- invariants of the implementation hold for the given sequence. If -- this function returns 'False', it represents a bug in the implementation. structuralInvariant :: s a -> Bool -- | The name of the module implementing s. instanceName :: s a -> String ---------------------------------------------------------------------- -- Other possible operations not currently included {- insertAt :: Int -> a -> s a -> s a -- adds to front or rear if index out of bounds -- -- insertAt i y xs@ -- | i < 0 = cons y xs -- | i >= n = snoc xs y -- | otherwise = deleteAt :: Int -> s a -> s a -- returns original sequence if index out of bounds -- -- deleteAt i xs@ -- | i < 0 = xs -- | i >= n = xs -- | otherwise = insertAt i x s = append before (cons x after) where (before, after) = splitAt i s deleteAt i s = if i < 0 then s else append before (ltail after) where (before, after) = splitAt i s -} EdisonAPI-1.2.2/src/Data/Edison/Coll.hs0000644000000000000000000007006412077643166015606 0ustar0000000000000000-- | -- Module : Data.Edison.Coll -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- The /collection/ abstraction includes sets, bags and priority queues -- (heaps). Collections are defined in Edison as a set of eight classes. -- -- All collections assume at least an equality relation of elements, and -- may also assume an ordering relation. -- -- The hierarchy contains a root class 'CollX' together with seven -- subclasses satisfying one or more of three common sub-properties: -- -- * /Uniqueness/ Each element in the collection is unique (no two -- elements in the collection are equal). These subclasses, indicated -- by the name @Set@, represent sets rather than bags (multi-sets). -- -- * /Ordering/ The elements have a total ordering and it is possible to -- process the elements in non-decreasing order. These subclasses, -- indicates by the @Ord@ prefix, typically represent either priority -- queues (heaps) or sets\/bags implemented as binary search trees. -- -- * /Observability/ An observable collection is one in which it is -- possible to view the elements in a collection. The @X@ suffix -- indicates a lack of observability. This property is discussed is -- greater detail below. -- -- Because collections encompass a wide range of abstractions, there is no -- single name that is suitable for all collection type constructors. -- However, most modules implementing collections will define a type -- constructor named either @Bag@, @Set@, or @Heap@. -- -- /Notes on observability/ -- -- Note that the equality relation defined by the 'Eq' class is not -- necessarily true equality. Very often it is merely an equivalence -- relation, where two equivalent values may be distinguishable by other -- means. For example, we might consider two binary trees to be equal -- if they contain the same elements, even if their shapes are different. -- -- Because of this phenomenon, implementations of observable collections -- (ie, collections where it is possible to inspect the elements) are rather -- constrained. Such an implementation must retain the actual elements that -- were inserted. For example, it is not possible in general to represent an -- observable bag as a finite map from elements to counts, because even if we -- know that a given bag contains, say, three elements from some equivalence -- class, we do not necessarily know /which/ three. -- -- On the other hand, implementations of /non-observable/ collections have -- much greater freedom to choose abstract representations of each -- equivalence class. For example, representing a bag as a finite map from -- elements to counts works fine if we never need to know /which/ -- representatives from an equivalence class are actually present. As -- another example, consider the 'UniqueHash' class defined in -- "Data.Edison.Prelude". If we know that the 'hash' function yields a -- unique integer for each equivalence class, then we can represent a -- collection of hashable elements simply as a collection of integers. With -- such a representation, we can still do many useful things like testing for -- membership; we just can't support functions like 'fold' or 'filter' that -- require the elements themselves, rather than the hashed values. module Data.Edison.Coll ( -- * Superclass aliases -- ** Monoid empty, union, -- * Non-observable collections CollX(..), OrdCollX(..), SetX(..), OrdSetX, -- * Observable collections Coll(..), OrdColl(..), Set(..), OrdSet, -- * Specializations of all the sequence operations to lists fromList, insertList, unionList, deleteList, unsafeFromOrdList, toList, lookupList, toOrdList, fromListWith, insertListWith, unionListWith, ) where import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import Data.Monoid import Data.Edison.Prelude import Data.Edison.Seq(Sequence) import Data.Edison.Seq.ListSeq() -- | The empty collection. Equivalant to @mempty@ from -- the @Monoid@ instance. -- -- This function is always /unambiguous/. empty :: CollX c a => c empty = mempty -- | Merge two collections. For sets, it is unspecified which element is -- kept in the case of duplicates. Equivalant to @mappend@ from the -- @Monoid@ instance. -- -- This function is /ambiguous/ at set types if the sets are not disjoint. -- Otherwise it is /unambiguous/. union :: CollX c a => c -> c -> c union = mappend -- | This is the root class of the collection hierarchy. However, it -- is perfectly adequate for many applications that use sets or bags. class (Eq a,Monoid c) => CollX c a | c -> a where -- | create a singleton collection -- -- This function is always /unambiguous/. singleton :: a -> c -- | Convert a sequence to a collection. For sets, it is unspecified -- which element is kept in case of duplicates. -- -- This function is /ambiguous/ at set types if more than one -- equivalent item is in the sequence. Otherwise it is /unambiguous/. fromSeq :: Sequence seq => seq a -> c -- | Merge a sequence of collections. For sets, it is unspecified which -- element is kept in the case of duplicates. -- -- This function is /ambiguous/ at set types if the sets in the sequence -- are not mutually disjoint. Otherwise it is /unambiguous/. unionSeq :: Sequence seq => seq c -> c -- | Insert an element into a collection. For sets, if an equal element -- is already in the set, the newly inserted element is kept, and the -- old element is discarded. -- -- This function is always /unambiguous/. insert :: a -> c -> c -- | Insert a sequence of elements into a collection. For sets, -- the behavior with regard to multiple equal elements is unspecified. -- -- This function is /ambiguous/ at set types if the sequence contains -- more than one equivalent item or an item which is already in the set. -- Otherwise it is /unambiguous/. insertSeq :: Sequence seq => seq a -> c -> c -- | Delete a single occurrence of the given element from a collection. -- For bags, it is unspecified which element will be deleted. -- -- This function is /ambiguous/ at bag types if more than one item exists -- in the bag equivalent to the given item. Otherwise it is /unambiguous/. delete :: a -> c -> c -- | Delete all occurrences of an element from a collection. For sets -- this operation is identical to 'delete'. -- -- This function is always /unambiguous/. deleteAll :: a -> c -> c -- | Delete a single occurrence of each of the given elements from -- a collection. For bags, there may be multiple occurrences of a -- given element in the collection, in which case it is unspecified -- which is deleted. -- -- This function is /ambiguous/ at bag types if more than one item -- exists in the bag equivalent to any item in the list and the number -- of equivalent occurrences of that item in the sequence is less than -- the number of occurrences in the bag. Otherwise it is /unambiguous/. deleteSeq :: Sequence seq => seq a -> c -> c -- | Test whether the collection is empty. -- -- /Axioms:/ -- -- * @null xs = (size xs == 0)@ -- -- This function is always /unambiguous/. null :: c -> Bool -- | Return the number of elements in the collection. -- -- This function is always /unambiguous/. size :: c -> Int -- | Test whether the given element is in the collection. -- -- /Axioms:/ -- -- * @member x xs = (count x xs > 0)@ -- -- This function is always /unambiguous/. member :: a -> c -> Bool -- | Count how many copies of the given element are in the collection. -- For sets, this will always return 0 or 1. -- -- This function is always /unambiguous/. count :: a -> c -> Int -- | Semanticly, this function is a partial identity function. If the -- datastructure is infinite in size or contains exceptions or non-termination -- in the structure itself, then @strict@ will result in bottom. Operationally, -- this function walks the datastructure forcing any closures. In many -- collections, the collction \"shape\" depends on the value of the elemnts; -- in such cases, the values of the elements will be forced to the extent -- necessary to force the structure of the collection, but no further. -- -- This function is always /unambiguous/. strict :: c -> c -- | A method to facilitate unit testing. Returns 'True' if the structural -- invariants of the implementation hold for the given collection. If -- this function returns 'False', it represents a bug; generally, either -- the implementation itself is flawed, or an unsafe operation has been -- used while violating the preconditions. structuralInvariant :: c -> Bool -- | The name of the module implementing @c@ instanceName :: c -> String -- | Collections for which the elements have an ordering relation. class (CollX c a, Ord a) => OrdCollX c a | c -> a where -- | Delete the minimum element from the collection. If there is more -- than one minimum, it is unspecified which is deleted. If the collection -- is empty, it will be returned unchanged. -- -- This function is /ambiguous/ at bag types if more than one minimum -- element exists in the bag. Otherwise it is /unambiguous/. deleteMin :: c -> c -- | Delete the maximum element from the collection. If there is more -- than one maximum, it is unspecified which is deleted. If the collection -- is empty, it will be returned unchanged. -- -- This function is /ambiguous/ at bag types if more than one maximum -- element exists in the bag. Otherwise it is /unambiguous/. deleteMax :: c -> c -- | Insert an element into a collection which is guaranteed to be -- @\<=@ any existing elements in the collection. For sets, the -- precondition is strengthened to @\<@. -- -- This function is /unambiguous/, under the above preconditions. unsafeInsertMin :: a -> c -> c -- | Insert an element into a collection which is guaranteed to be -- @>=@ any existing elements in the collection. For sets, the -- precondition is strengthened to @>@. -- -- This function is /unambiguous/, under the above preconditions. unsafeInsertMax :: a -> c -> c -- | Convert a sequence in non-decreasing order into a collection. -- For sets, the sequence must be in increasing order. -- -- This function is /unambiguous/, under the above preconditions. unsafeFromOrdSeq :: Sequence seq => seq a -> c -- | Union two collections where every element in the first -- collection is @\<=@ every element in the second collection. -- For sets, this precondition is strengthened to @\<@. -- -- This function is /unambiguous/, under the above preconditions. unsafeAppend :: c -> c -> c -- | Extract the sub-collection of elements @\<@ the given element. -- -- /Axioms:/ -- -- * @filterLT x xs = filter (\< x) xs@ -- -- This function is always /unambiguous/. filterLT :: a -> c -> c -- | Extract the sub-collection of elements @\<=@ the given element. -- -- /Axioms:/ -- -- * @filterLE x xs = filter (\<= x) xs@ -- -- This function is always /unambiguous/. filterLE :: a -> c -> c -- | Extract the sub-collection of elements @>@ the given element. -- -- /Axioms:/ -- -- * @filterGT x xs = filter (> x) xs@ -- -- This function is always /unambiguous/. filterGT :: a -> c -> c -- | Extract the sub-collection of elements @>=@ the given element. -- -- /Axioms:/ -- -- * @filterGE x xs = filter (>= x) xs@ -- -- This function is always /unambiguous/. filterGE :: a -> c -> c -- | Split a collection into those elements @\<@ a given element and -- those @>=@. -- -- /Axioms:/ -- -- * @partitionLT_GE xs = partition (\<) xs@ -- -- This function is always /unambiguous/. partitionLT_GE :: a -> c -> (c, c) -- | Split a collection into those elements @\<=@ a given element and -- those @>@. -- -- /Axioms:/ -- -- * @partitionLE_GT xs = partition (\<=) xs@ -- -- This function is always /unambiguous/. partitionLE_GT :: a -> c -> (c, c) -- | Split a collection into those elements @\<@ a given element and -- those @>@. All elements equal to the given element are discarded. -- -- /Axioms:/ -- -- *@partitionLT_GT x xs = (filterLT x xs,filterGT x xs)@ -- -- This function is always /unambiguous/. partitionLT_GT :: a -> c -> (c, c) -- | A collection where the set property is maintained; that is, a set -- contains at most one element of the equivalence class formed by the -- 'Eq' instance on the elements. class CollX c a => SetX c a | c -> a where -- | Computes the intersection of two sets. It is unspecified which -- element is kept when equal elements appear in each set. -- -- This function is /ambiguous/, except when the sets are disjoint. intersection :: c -> c -> c -- | Computes the difference of two sets; that is, all elements in -- the first set which are not in the second set. -- -- This function is always /unambiguous/. difference :: c -> c -> c -- | Computes the symmetric difference of two sets; that is, all elements -- which appear in exactily one of the two sets. -- -- This function is always /unambiguous/. symmetricDifference :: c -> c -> c -- | Test whether the first set is a proper subset of the second set; -- that is, if every element in the first set is also a member of the -- second set AND there exists some element in the second set which -- is not present in the first. -- -- This function is always /unambiguous/. properSubset :: c -> c -> Bool -- | Test whether the first set is a subset of the second set; that is, if -- every element in the first set is also a member of the second set. -- -- This function is always /unambiguous/. subset :: c -> c -> Bool -- | Sets where the elements also have an ordering relation. -- This class contains no methods; it is only an abbreviation for -- the context @(OrdCollX c a,SetX c a)@. class (OrdCollX c a, SetX c a) => OrdSetX c a | c -> a -- no methods -- | Collections with observable elements. See the module documentation for -- comments on observability. class CollX c a => Coll c a | c -> a where -- | List the elements of the collection in an unspecified order. -- -- This function is /ambiguous/ iff the collection contains more -- than one element. toSeq :: Sequence seq => c -> seq a -- | Lookup one element equal to the given element. If no elements -- exist in the collection equal to the given element, an error is -- signaled. If multiple copies of the given element exist in the -- collection, it is unspecified which is returned. -- -- This function is /ambiguous/ at bag types, when more than one -- element equivalent to the given item is in the bag. Otherwise -- it is /unambiguous/. lookup :: a -> c -> a -- | Lookup one element equal to the given element. If no elements -- exist in the collection equal to the given element, 'fail' is called. -- If multiple copies of the given element exist in the collection, it -- is unspecified which is returned. -- -- This function is /ambiguous/ at bag types, when more than one -- element equivalent to the given item is in the bag. Otherwise -- it is /unambiguous/. lookupM :: (Monad m) => a -> c -> m a -- | Return a sequence containing all elements in the collection equal to -- the given element in an unspecified order. -- -- This function is /ambiguous/ at bag types, when more than one -- element equivalent to the given item is in the bag. Otherwise -- it is /unambiguous/. lookupAll :: Sequence seq => a -> c -> seq a -- | Lookup one element equal to the (second) given element in the collection. -- If no elements exist in the collection equal to the given element, then -- the default element is returned. -- -- This function is /ambiguous/ at bag types, when more than one -- element equivalent to the given item is in the bag. Otherwise -- it is /unambiguous/. lookupWithDefault :: a -- ^ default element -> a -- ^ element to lookup -> c -- ^ collection -> a -- | Fold over all the elements in a collection in an unspecified order. -- -- @fold f@ is /unambiguous/ iff @f@ is fold-commutative. fold :: (a -> b -> b) -> b -> c -> b -- | A strict variant of 'fold'. -- -- @fold' f@ is /unambiguous/ iff @f@ is fold-commutative. fold' :: (a -> b -> b) -> b -> c -> b -- | Fold over all the elements in a collection in an unspecified order. -- An error is signaled if the collection is empty. -- -- @fold1 f@ is /unambiguous/ iff @f@ is fold-commutative. fold1 :: (a -> a -> a) -> c -> a -- | A strict variant of 'fold1'. -- -- @fold1' f@ is /unambiguous/ iff @f@ is fold-commutative. fold1' :: (a -> a -> a) -> c -> a -- | Remove all elements not satisfying the predicate. -- -- This function is always /unambiguous/. filter :: (a -> Bool) -> c -> c -- | Returns two collections, the first containing all the elements -- satisfying the predicate, and the second containing all the -- elements not satisfying the predicate. -- -- This function is always /unambiguous/. partition :: (a -> Bool) -> c -> (c, c) -- | Similar to 'strict', this function walks the datastructure forcing closures. -- However, @strictWith@ will additionally apply the given function to the -- collection elements, force the result using @seq@, and then ignore it. -- This function can be used to perform various levels of forcing on the -- sequence elements. In particular: -- -- > strictWith id xs -- -- will force the spine of the datastructure and reduce each element to WHNF. -- -- This function is always /unambiguous/. strictWith :: (a -> b) -> c -> c -- | Collections with observable elements where the elements additionally -- have an ordering relation. See the module documentation for comments -- on observability. class (Coll c a, OrdCollX c a) => OrdColl c a | c -> a where -- | Return the minimum element in the collection, together with -- the collection without that element. If there are multiple -- copies of the minimum element, it is unspecified which is chosen. -- /Note/ that 'minView', 'minElem', and 'deleteMin' may make different -- choices. Calls 'fail' if the collection is empty. -- -- This function is /ambiguous/ at bag types, if more than one minimum -- element exists in the bag. Otherwise, it is /unambiguous/. minView :: (Monad m) => c -> m (a, c) -- | Return the minimum element in the collection. If there are multiple -- copies of the minimum element, it is unspecified which is chosen. -- /Note/ that 'minView', 'minElem', and 'deleteMin' may make different -- choices. Signals an error if the collection is empty. -- -- This function is /ambiguous/ at bag types, if more than one minimum -- element exists in the bag. Otherwise, it is /unambiguous/. minElem :: c -> a -- | Return the maximum element in the collection, together with -- the collection without that element. If there are multiple -- copies of the maximum element, it is unspecified which is chosen. -- /Note/ that 'maxView', 'maxElem' and 'deleteMax' may make different -- choices. Calls 'fail' if the collection is empty. -- -- This function is /ambiguous/ at bag types, if more than one maximum -- element exists in the bag. Otherwise, it is /unambiguous/. maxView :: (Monad m) => c -> m (a, c) -- | Return the maximum element in the collection. If there are multiple -- copies of the maximum element, it is unspecified which is chosen. -- /Note/ that 'maxView', 'maxElem' and 'deleteMax' may make different -- choices. Signals an error if the collection is empty. -- -- This function is /ambiguous/ at bag types, if more than one maximum -- element exists in the bag. Otherwise, it is /unambiguous/. maxElem :: c -> a -- | Fold across the elements in non-decreasing order with right -- associativity. (For sets, this will always be increasing order) -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldr :: (a -> b -> b) -> b -> c -> b -- | A strict variant of 'foldr'. -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldr' :: (a -> b -> b) -> b -> c -> b -- | Fold across the elements in non-decreasing order with left -- associativity. (For sets, this will always be increasing order) -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldl :: (b -> a -> b) -> b -> c -> b -- | A strict variant of 'foldl'. -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldl' :: (b -> a -> b) -> b -> c -> b -- | Fold across the elements in non-decreasing order with right -- associativity, or signal an error if the collection is empty. -- (For sets, this will always be increasing order) -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldr1 :: (a -> a -> a) -> c -> a -- | A strict variant of 'foldr1'. -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldr1' :: (a -> a -> a) -> c -> a -- | Fold across the elements in non-decreasing order with left -- associativity, or signal an error if the collection is empty. -- (For sets, this will always be increasing order) -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldl1 :: (a -> a -> a) -> c -> a -- | A strict variant of 'foldl1'. -- -- This function is /unambiguous/ if the combining function is -- fold-commutative, at all set types, and at bag types -- where no two equivalent elements exist in the bag. Otherwise -- it is /ambiguous/. foldl1' :: (a -> a -> a) -> c -> a -- | List the elements in non-decreasing order. (For sets, this will always -- be increasing order) -- -- At set types, this function is /unambiguous/. At bag types, it -- is /unambiguous/ if no two equivalent elements exist in the bag; -- otherwise it is /ambiguous/. toOrdSeq :: Sequence seq => c -> seq a -- | Map a monotonic function across all elements of a collection. The -- function is required to satisfy the following precondition: -- -- > forall x y. x < y ==> f x < f y -- -- This function is /unambiguous/, under the precondition. unsafeMapMonotonic :: (a -> a) -> c -> c -- | Collections with observable elements where the set property is maintained; -- that is, a set contains at most one element of the equivalence class -- formed by the 'Eq' instance on the elements. -- -- /WARNING: Each of the following \"With\" functions is unsafe./ -- The passed in combining functions are used to choose which element is kept -- in the case of duplicates. They are required to satisfy the precondition -- that, given two equal elements, they return a third element equal to the -- other two. Usually, the combining function just returns its first or -- second argument, but it can combine elements in non-trivial ways. -- -- The combining function should usually be associative. Where the function -- involves a sequence of elements, the elements will be combined from -- left-to-right, but with an unspecified associativity. -- -- For example, if @x == y == z@, -- then @fromSeqWith (+) [x,y,z]@ equals either -- @single (x + (y + z))@ -- or -- @single ((x + y) + z)@ class (Coll c a, SetX c a) => Set c a | c -> a where -- | Same as 'fromSeq' but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition -- if the combining function is associative. Otherwise it is /ambiguous/. fromSeqWith :: Sequence seq => (a -> a -> a) -> seq a -> c -- | Same as 'insert' but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition. insertWith :: (a -> a -> a) -> a -> c -> c -- | Same as 'insertSeq' but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition -- if the combining function is associative. Otherwise it is /ambiguous/. insertSeqWith :: Sequence seq => (a -> a -> a) -> seq a -> c -> c -- | Left biased union. -- -- /Axioms:/ -- -- * @unionl = unionWith (\\x y -> x)@ -- -- This function is always /unambiguous/. unionl :: c -> c -> c -- | Right biased union. -- -- /Axioms:/ -- -- * @unionr = unionWith (\\x y -> y)@ -- -- This function is always /unambiguous/. unionr :: c -> c -> c -- | Same as 'union', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition. unionWith :: (a -> a -> a) -> c -> c -> c -- | Same as 'unionSeq', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition -- if the combining function is associative. Otherwise it is /ambiguous/. unionSeqWith :: Sequence seq => (a -> a -> a) -> seq (c) -> c -- | Same as 'intersection', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/ under the \"with\" precondition. intersectionWith :: (a -> a -> a) -> c -> c -> c -- | Collections with observable elements where the set property is maintained -- and where additionally, there is an ordering relation on the elements. -- This class introduces no new methods, and is simply an abbreviation -- for the context: -- -- @(OrdColl c a,Set c a)@ class (OrdColl c a, Set c a) => OrdSet c a | c -> a -- no methods -- specialize all the sequence operations to lists fromList :: CollX c a => [a] -> c insertList :: CollX c a => [a] -> c -> c unionList :: CollX c a => [c] -> c deleteList :: CollX c a => [a] -> c -> c unsafeFromOrdList :: OrdCollX c a => [a] -> c toList :: Coll c a => c -> [a] lookupList :: Coll c a => a -> c -> [a] toOrdList :: OrdColl c a => c -> [a] fromListWith :: Set c a => (a -> a -> a) -> [a] -> c insertListWith :: Set c a => (a -> a -> a) -> [a] -> c -> c unionListWith :: Set c a => (a -> a -> a) -> [c] -> c fromList = fromSeq insertList = insertSeq unionList = unionSeq deleteList = deleteSeq unsafeFromOrdList = unsafeFromOrdSeq toList = toSeq lookupList = lookupAll toOrdList = toOrdSeq fromListWith = fromSeqWith insertListWith = insertSeqWith unionListWith = unionSeqWith EdisonAPI-1.2.2/src/Data/Edison/Sym.hs0000644000000000000000000000532512077643166015463 0ustar0000000000000000-- | -- Module : Data.Edison.Sym -- Copyright : Copyright (c) 2006 Robert Dockins -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- This module introduces a number of infix symbols which are aliases -- for some of the operations in the sequence and set abstractions. -- For several, the argument orders are reversed to more closely -- match usual symbolic usage. -- -- The symbols are intended to evoke the the operations they -- represent. Unfortunately, ASCII is pretty limited, and Haskell 98 -- only allocates a few symbols to the operator lexical class. -- Thus, some of the operators are less evocative than one would -- like. A future version of Edison may introduce unicode operators, which -- will allow a wider range of operations to be represented symbolicly. -- -- Unlike most of the modules in Edison, this module is intended to be -- imported unqualified. However, the definition of @(++)@ will conflict -- with the Prelude definition. Either this definition or the Prelude -- definition will need to be imported @hiding ( (++) )@. This definition -- subsumes the Prelude definition, and can be safely used in place of it. module Data.Edison.Sym where import qualified Prelude as P import qualified Data.Edison.Seq as S import qualified Data.Edison.Coll as C import qualified Data.Edison.Coll as A -- pull in the Sequence instance for lists to make sure (++) -- works as advertised import qualified Data.Edison.Seq.ListSeq -- | Left (front) cons on a sequence. The new element appears on the left. -- Identical to 'S.lcons'. (<|) :: S.Sequence seq => a -> seq a -> seq a (<|) = S.lcons -- | Right (rear) cons on a sequence. The new element appears on the right. -- Identical to 'S.rcons' with reversed arguments. (|>) :: S.Sequence seq => seq a -> a -> seq a (|>) = P.flip S.rcons -- | Append two sequences. Identical to 'S.append'. Subsumes the Prelude -- definition. (++) :: S.Sequence seq => seq a -> seq a -> seq a (++) = S.append -- | Lookup an element in a sequence. Identical to 'S.lookup' with -- reversed arguments. (!) :: S.Sequence seq => seq a -> P.Int -> a (!) = P.flip S.lookup -- | Subset test operation. Identical to 'C.subset'. (|=) :: C.SetX set a => set -> set -> P.Bool (|=) = C.subset -- | Set difference. Identical to 'C.difference'. (\\) :: C.SetX set a => set -> set -> set (\\) = C.difference -- | Set intersection. Identical to 'C.intersection'. (/\) :: C.SetX set a => set -> set -> set (/\) = C.intersection -- | Set union. Identical to 'C.union'. (\/) :: C.SetX set a => set -> set -> set (\/) = C.union EdisonAPI-1.2.2/src/Data/Edison/Assoc.hs0000644000000000000000000012004312077643166015756 0ustar0000000000000000-- | -- Module : Data.Edison.Assoc -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- The /associative collection/ abstraction includes finite maps, finite -- relations, and priority queues where the priority is separate from the -- element. Associative collections are defined in Edison as a set of eight -- classes. -- -- Note that this -- hierarchy mirrors the hierarchy for collections, but with the addition -- of 'Functor' as a superclass of every associative collection. See -- "Data.Edison.Coll" for a description of the class hierarchy. -- -- In almost all cases, associative collections make no guarantees about -- behavior with respect to the actual keys stored and (in the case of -- observable maps) which keys can be retrieved. We adopt the convention -- that methods which create associative collections are /unambiguous/ -- with respect to the key storage behavior, but that methods which can -- observe keys are /ambiguous/ with respect to the actual keys returned. -- -- In all cases where an operation is ambiguous with respect to the key, -- the operation is rendered /unambiguous/ if the @Eq@ instance on keys -- corresponds to indistinguisability. module Data.Edison.Assoc ( -- * Superclass aliases map, -- * Non-observable associative collections AssocX(..), OrdAssocX(..), FiniteMapX(..), OrdFiniteMapX, -- * Observable associative collections Assoc(..), OrdAssoc(..), FiniteMap(..), OrdFiniteMap, -- * Specilizations of submap operations submap, properSubmap, sameMap, -- * Specializations of sequence operations to lists fromList, insertList, unionList, deleteList, lookupList, elementsList, unsafeFromOrdList, fromListWith, fromListWithKey, insertListWith, insertListWithKey, unionListWith, toList, keysList, toOrdList, unionListWithKey ) where import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import Data.Edison.Prelude import Data.Edison.Seq(Sequence) import Data.Edison.Seq.ListSeq() -- | Apply a function to the elements of every binding in the associative -- collection. Identical to @fmap@ from @Functor@. -- -- This function is always /unambiguous/. map :: AssocX m k => (a -> b) -> m a -> m b map = fmap -- | Specialization of 'submapBy' where the comparison function is -- given by @(==)@. submap :: (Eq a,FiniteMapX m k) => m a -> m a -> Bool submap = submapBy (==) -- | Specialization of 'properSubmapBy' where the comparison function -- is given by @(==)@. properSubmap :: (Eq a, FiniteMapX m k) => m a -> m a -> Bool properSubmap = properSubmapBy (==) -- | Specialization of 'sameMapBy' where the comparison function is -- given by @(==)@. sameMap :: (Eq a,FiniteMapX m k) => m a -> m a -> Bool sameMap = sameMapBy (==) -- | The root class of the associative collection hierarchy. class (Eq k,Functor m) => AssocX m k | m -> k where -- | The empty associative collection. -- -- This function is always /unambiguous/. empty :: m a -- | Create an associative collection with a single binding. -- -- This function is always /unambiguous/. singleton :: k -> a -> m a -- | Create an associative collection from a list of bindings. Which element -- and key are kept in the case of duplicate keys is unspecified. -- -- This function is /ambiguous/ at finite map types if the sequence -- contains more than one equivalent key. Otherwise it is /unambiguous/. fromSeq :: Sequence seq => seq (k,a) -> m a -- | Add a binding to an associative collection. For finite maps, 'insert' -- keeps the new element in the case of duplicate keys. -- -- This function is /unambiguous/. insert :: k -> a -> m a -> m a -- | Add a sequence of bindings to a collection. For finite maps, which key -- and which element are kept in the case of duplicates is unspecified. -- However, if a key appears in the sequence and in the map, (one of) the -- elements in the list will be given preference. -- -- This function is /ambiguous/ at finite map types if the sequence contains -- more than one equivalent key. Otherwise it is /unambiguous/. insertSeq :: Sequence seq => seq (k,a) -> m a -> m a -- | Merge two associative collections. For finite maps, which element -- to keep in the case of duplicate keys is unspecified. -- -- This function is /ambiguous/ at finite map types if the map keys are not -- disjoint. Otherwise it is /unambiguous/. union :: m a -> m a -> m a -- | Merge a sequence of associative collections. Which element -- to keep in the case of duplicate keys is unspecified. -- -- This function is /ambiguous/ at finite map types if the map keys are not -- mutually disjoint. Otherwise it is /unambiguous/. unionSeq :: Sequence seq => seq (m a) -> m a -- | Delete one binding with the given key, or leave the associative collection -- unchanged if it does not contain the key. For bag-like associative -- collections, it is unspecified which binding will be removed. -- -- This function is /ambiguous/ at finite relation types if the key appears more -- than once in the relation. Otherwise it is /unambiguous/. delete :: k -> m a -> m a -- | Delete all bindings with the given key, or leave the associative collection -- unchanged if it does not contain the key. -- -- This function is always /unambiguous/. deleteAll :: k -> m a -> m a -- | Delete a single occurrence of each of the given keys from an associative -- collection. For bag-like associative collections containing duplicate keys, -- it is unspecified which bindings will be removed. -- -- This function is /ambiguous/ at finite relation types if any key appears both -- in the sequence and in the finite relation AND the number of occurrences in -- the sequence is less than the number of occurrences in the finite relation. -- Otherwise it is /unambiguous/. deleteSeq :: Sequence seq => seq k -> m a -> m a -- | Test whether the associative collection is empty. -- -- /Axioms:/ -- -- * @null m = (size m == 0)@ -- -- This function is always /unambiguous/. null :: m a -> Bool -- | Return the number of bindings in the associative collection. -- -- This function is always /unambiguous/. size :: m a -> Int -- | Test whether the given key is bound in the associative collection. -- -- This function is always /unambiguous/. member :: k -> m a -> Bool -- | Returns the number of bindings with the given key. For finite maps -- this will always return 0 or 1. -- -- This function is always /unambiguous/. count :: k -> m a -> Int -- | Find the element associated with the given key. Signals an error if -- the given key is not bound. If more than one element is bound by the -- given key, it is unspecified which is returned. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookup :: k -> m a -> a -- | Find the element associated with the given key. Calls 'fail' if the -- given key is not bound. If more than one element is bound by the given -- key, it is unspecified which is returned. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupM :: (Monad rm) => k -> m a -> rm a -- | Return all elements bound by the given key in an unspecified order. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupAll :: Sequence seq => k -> m a -> seq a -- | Find the element associated with the given key; return the element -- and the collection with that element deleted. Signals an error if -- the given key is not bound. If more than one element is bound by the -- given key, it is unspecified which is deleted and returned. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupAndDelete :: k -> m a -> (a, m a) -- | Find the element associated with the given key; return the element -- and the collection with that element deleted. Calls @fail@ if -- the given key is not bound. If more than one element is bound by the -- given key, it is unspecified which is deleted and returned. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupAndDeleteM :: (Monad rm) => k -> m a -> rm (a, m a) -- | Find all elements bound by the given key; return a sequence containing -- all such bound elements in an unspecified order and the collection -- with all such elements deleted. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupAndDeleteAll :: (Sequence seq) => k -> m a -> (seq a,m a) -- | Return the element associated with the given key. If no such element -- is found, return the default. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. lookupWithDefault :: a -- ^ default element -> k -- ^ the key to look up -> m a -- ^ the associative collection -> a -- | Change a single binding for the given key by applying a function to its -- element. If the key binds more than one element, it is unspecified which -- will be modified. If the key is not found in the collection, it is returned -- unchanged. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. adjust :: (a -> a) -> k -> m a -> m a -- | Change all bindings for the given key by applying a function to its -- elements. If the key is not found in the collection, it is returned -- unchanged. -- -- This function is always /unambiguous/. adjustAll :: (a -> a) -> k -> m a -> m a -- | Searches for a matching key in the collection. If the key is found, -- the given function is called to adjust the value. If the key is not -- found, a new binding is inserted with the given element. If the given -- key is bound more than once in the collection, it is unspecified -- which element is adjusted. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. adjustOrInsert :: (a -> a) -> a -> k -> m a -> m a -- | Searches for all matching keys in the collection. If the key is found, -- the given function is applied to all its elements to adjust their values. -- If the key is not found, a new binding is inserted with the given element. -- -- This function is always /unambiguous/. adjustAllOrInsert :: (a -> a) -> a -> k -> m a -> m a -- | Change or delete a single binding for the given key by applying a function -- to its element. If the function returns @Nothing@, then the binding -- will be deleted. If the key binds more than one element, it is unspecified which -- will be modified. If the key is not found in the collection, it is returned -- unchanged. -- -- This function is /ambiguous/ at finite relation types if the key appears -- more than once in the finite relation. Otherwise, it is /unambiguous/. adjustOrDelete :: (a -> Maybe a) -> k -> m a -> m a -- | Change or delete all bindings for the given key by applying a function to -- its elements. For any element where the function returns @Nothing@, the -- corresponding binding is deleted. If the key is not found in the collection, -- it is returned unchanged. -- -- This function is always /unambiguous/. adjustOrDeleteAll :: (a -> Maybe a) -> k -> m a -> m a -- | Combine all the elements in the associative collection, given a combining -- function and an initial value. The elements are processed in an -- unspecified order. /Note/ that 'fold' ignores the keys. -- -- @fold f@ is /unambiguous/ iff @f@ is fold-commutative. fold :: (a -> b -> b) -> b -> m a -> b -- | A strict variant of 'fold'. -- -- @fold' f@ is /unambiguous/ iff @f@ is fold-commutative. fold' :: (a -> b -> b) -> b -> m a -> b -- | Combine all the elements in a non-empty associative collection using the -- given combining function. Signals an error if the associative collection -- is empty. The elements are processed in an unspecified order. An -- implementation may choose to process the elements linearly or in a -- balanced fashion (like 'reduce1' on sequences). /Note/ that 'fold1' -- ignores the keys. -- -- @fold1 f@ is /unambiguous/ iff @f@ is fold-commutative. fold1 :: (a -> a -> a) -> m a -> a -- | A strict variant of 'fold1'. -- -- @fold1' f@ is /unambiguous/ iff @f@ is fold-commutative. fold1' :: (a -> a -> a) -> m a -> a -- | Extract all bindings whose elements satisfy the given predicate. -- -- This function is always /unambiguous/. filter :: (a -> Bool) -> m a -> m a -- | Split an associative collection into those bindings which satisfy the -- given predicate, and those which do not. -- -- This function is always /unambiguous/. partition :: (a -> Bool) -> m a -> (m a, m a) -- | Returns all the elements in an associative collection, in an unspecified -- order. -- -- This function is /ambiguous/ iff the associative collection contains -- more than one element. elements :: Sequence seq => m a -> seq a -- | Semanticly, this function is a partial identity function. If the -- datastructure is infinite in size or contains exceptions or non-termination -- in the structure itself, then @strict@ will result in bottom. Operationally, -- this function walks the datastructure forcing any closures. Elements contained -- in the map are /not/ forced. -- -- This function is always /unambiguous/. strict :: m a -> m a -- | Similar to 'strict', this function walks the datastructure forcing closures. -- However, @strictWith@ will additionally apply the given function to the -- map elements, force the result using @seq@, and then ignore it. -- This function can be used to perform various levels of forcing on the -- sequence elements. In particular: -- -- > strictWith id xs -- -- will force the spine of the datastructure and reduce each element to WHNF. -- -- This function is always /unambiguous/. strictWith :: (a -> b) -> m a -> m a -- | A method to facilitate unit testing. Returns 'True' if the structural -- invariants of the implementation hold for the given associative -- collection. If this function returns 'False', it represents a bug; -- generally, either the implementation itself is flawed, or an unsafe -- operation has been used while violating the preconditions. structuralInvariant :: m a -> Bool -- | Returns the name of the module implementing this associative collection. instanceName :: m a -> String -- | An associative collection where the keys additionally have an ordering -- relation. class (AssocX m k, Ord k) => OrdAssocX m k | m -> k where -- | Remove the binding with the minimum key, and return its element together -- with the remaining associative collection. Calls 'fail' if the -- associative collection is empty. Which binding is removed if there -- is more than one minimum is unspecified. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. minView :: (Monad rm) => m a -> rm (a, m a) -- | Find the binding with the minimum key and return its element. Signals -- an error if the associative collection is empty. Which element is chosen -- if there is more than one minimum is unspecified. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. minElem :: m a -> a -- | Remove the binding with the minimum key and return the remaining -- associative collection, or return empty if it is already empty. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. deleteMin :: m a -> m a -- | Insert a binding into an associative collection with the precondition -- that the given key is @\<=@ any existing keys already in the collection. -- For finite maps, this precondition is strengthened to @\<@. -- -- This function is /unambiguous/ under the preconditions. unsafeInsertMin :: k -> a -> m a -> m a -- | Remove the binding with the maximum key, and return its element together -- with the remaining associative collection. Calls 'fail' if the -- associative collection is empty. Which binding is removed if there -- is more than one maximum is unspecified. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. maxView :: (Monad rm) => m a -> rm (a, m a) -- | Find the binding with the maximum key and return its element. Signals -- an error if the associative collection is empty. Which element is chosen -- if there is more than one maximum is unspecified. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. maxElem :: m a -> a -- | Remove the binding with the maximum key and return the remaining -- associative collection, or return empty if it is already empty. -- -- This function is /ambiguous/ at finite relation types if the finite relation -- contains more than one minimum key. Otherwise it is /unambiguous/. deleteMax :: m a -> m a -- | Insert a binding into an associative collection with the precondition -- that the given key is @>=@ any existing keys already in the collection. -- For finite maps, this precondition is strengthened to @>@. -- -- This function is /unambiguous/ under the precondition. unsafeInsertMax :: k -> a -> m a -> m a -- | Fold across the elements of an associative collection in non-decreasing -- order by key with right associativity. For finite maps, the order -- is increasing. -- -- @foldr f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldr :: (a -> b -> b) -> b -> m a -> b -- | A strict variant of 'foldr'. -- -- @foldr' f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldr' :: (a -> b -> b) -> b -> m a -> b -- | Fold across the elements of an associative collection in non-decreasing -- order by key with left associativity. For finite maps, the order -- is increasing. -- -- @foldl f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldl :: (b -> a -> b) -> b -> m a -> b -- | A strict variant of 'foldl'. -- -- @foldl' f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldl' :: (b -> a -> b) -> b -> m a -> b -- | Fold across the elements of an associative collection in non-decreasing -- order by key with right associativity. Signals an error if the -- associative collection is empty. For finite maps, the order is -- increasing. -- -- @foldr1 f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldr1 :: (a -> a -> a) -> m a -> a -- | A strict variant of 'foldr1'. -- -- @foldr1' f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldr1' :: (a -> a -> a) -> m a -> a -- | Fold across the elements of an associative collection in non-decreasing -- order by key with left associativity. Signals an error if the -- associative collection is empty. For finite maps, the order is -- increasing. -- -- @foldl1 f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldl1 :: (a -> a -> a) -> m a -> a -- | A strict variant of 'foldl1'. -- -- @foldl1' f@ is /unambiguous/ if @f@ is fold-commutative, at finite -- map types, or at finite relation types if the relation contains no -- duplicate keys. Otherwise it is /ambiguous/. foldl1' :: (a -> a -> a) -> m a -> a -- | Convert a sequence of bindings into an associative collection with the -- precondition that the sequence is sorted into non-decreasing order by -- key. For finite maps, this precondition is strengthened to increasing -- order. -- -- This function is /unambiguous/ under the precondition. unsafeFromOrdSeq :: Sequence seq => seq (k,a) -> m a -- | Merge two associative collections with the precondition that every key -- in the first associative collection is @\<=@ every key in the second -- associative collection. For finite maps, this precondition is -- strengthened to @\<@. -- -- This function is /unambiguous/ under the precondition. unsafeAppend :: m a -> m a -> m a -- | Extract all bindings whose keys are @\<@ the given key. -- -- This function is always /unambiguous/. filterLT :: k -> m a -> m a -- | Extract all bindings whose keys are @\<=@ the given key. -- -- This function is always /unambiguous/. filterLE :: k -> m a -> m a -- | Extract all bindings whose keys are @>@ the given key. -- -- This function is always /unambiguous/. filterGT :: k -> m a -> m a -- | Extract all bindings whose keys are @>=@ the given key. -- -- This function is always /unambiguous/. filterGE :: k -> m a -> m a -- | Split an associative collection into two sub-collections, containing -- those bindings whose keys are @\<@ the given key and those which are @>=@. -- -- This function is always /unambiguous/. partitionLT_GE :: k -> m a -> (m a, m a) -- | Split an associative collection into two sub-collections, containing -- those bindings whose keys are @\<=@ the given key and those which are @>@. -- -- This function is always /unambiguous/. partitionLE_GT :: k -> m a -> (m a, m a) -- | Split an associative collection into two sub-collections, containing -- those bindings whose keys are @\<@ the given key and those which are @>@. -- All bindings with keys equal to the given key are discarded. -- -- This function is always /unambiguous/. partitionLT_GT :: k -> m a -> (m a, m a) -- | An associative collection where the keys form a set; that is, each key -- appears in the associative collection at most once. class AssocX m k => FiniteMapX m k | m -> k where -- | Same as 'fromSeq', but with a combining function to resolve duplicates. -- -- This function is always /unambiguous/. fromSeqWith :: Sequence seq => (a -> a -> a) -> seq (k,a) -> m a -- | Same as 'fromSeq', but with a combining function to resolve duplicates; -- the combining function takes the key in addition to the two elements. -- -- This function is always /unambiguous/. fromSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (k,a) -> m a -- | Same as 'insert', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/. insertWith :: (a -> a -> a) -> k -> a -> m a -> m a -- | Same as 'insert', but with a combining function to resolve duplicates; -- the combining function takes the key in addition to the two elements. -- The key passed to the combining function is always the same as the -- given key. -- -- This function is /unambiguous/. insertWithKey :: (k -> a -> a -> a) -> k -> a -> m a -> m a -- | Same as 'insertSeq', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/. insertSeqWith :: Sequence seq => (a -> a -> a) -> seq (k,a) -> m a -> m a -- | Same as 'insertSeq', but with a combining function to resolve duplicates; -- the combining function takes the key in addition to the two elements. -- -- This function is /unambiguous/. insertSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (k,a) -> m a -> m a -- | Left biased union. -- -- /Axioms:/ -- -- * @unionl = unionwith (\\x y -> x)@ -- -- This function is /unambiguous/. unionl :: m a -> m a -> m a -- | Right biased union. -- -- /Axioms:/ -- -- * @unionr = unionWith (\\x y -> y)@ -- -- This function is /unambiguous/. unionr :: m a -> m a -> m a -- | Same as 'union', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/. unionWith :: (a -> a -> a) -> m a -> m a -> m a -- | Same as 'unionSeq', but with a combining function to resolve duplicates. -- -- This function is /unambiguous/. unionSeqWith :: Sequence seq => (a -> a -> a) -> seq (m a) -> m a -- | Compute the intersection of two finite maps. The resulting finite map -- will contain bindings where the keys are the set intersection of the -- keys in the argument finite maps. The combining function computes -- the value of the element given the bound elements from the argument -- finite maps. -- -- This function is /unambiguous/. intersectionWith :: (a -> b -> c) -> m a -> m b -> m c -- | Computes the difference of two finite maps; that is, all bindings -- in the first finite map whose keys to not appear in the second. -- -- This function is always /unambiguous/. difference :: m a -> m b -> m a -- | Test whether the set of keys in the first finite map is a proper subset -- of the set of keys of the second; that is, every key present in -- the first finite map is also a member of the second finite map AND -- there exists some key in the second finite map which is not present -- in the first. -- -- This function is always /unambiguous/. properSubset :: m a -> m b -> Bool -- | Test whether the set of keys in the first finite map is a subset of -- the set of keys of the second; that is, if every key present in the first -- finite map is also present in the second. -- -- This function is always /unambiguous/. subset :: m a -> m b -> Bool -- | Test whether the first map is a submap of the second map given a comparison -- function on elements; that is, if every key present in the first map is also -- present in the second map and the comparison function returns true when applied -- two the bound elements. -- -- This function is always /unambiguous/. submapBy :: (a -> a -> Bool) -> m a -> m a -> Bool -- | Test whether the first map is a proper submap of the second map given a comparison -- function on elements; that is, if every key present in the first map is also -- present in the second map and the comparison function returns true when applied -- two the bound elements AND there exiss some key in the second finite map which -- is not present in the first. -- -- This function is always /unambiguous/. properSubmapBy :: (a -> a -> Bool) -> m a -> m a -> Bool -- | Test whether the first map is the \"same\" map as the second map given a comparison -- function on elements; that is, if the first and second maps have the same set of keys -- and the comparison function returns true when applied to corresponding elements. -- -- This function is always /unambiguous/. sameMapBy :: (a -> a -> Bool) -> m a -> m a -> Bool -- | Finite maps where the keys additionally have an ordering relation. -- This class introduces no new methods. class (OrdAssocX m k, FiniteMapX m k) => OrdFiniteMapX m k | m -> k -- | Associative collections where the keys are observable. class AssocX m k => Assoc m k | m -> k where -- | Extract the bindings of an associative collection into a -- sequence. The bindings are emitted in an unspecified order. -- -- This function is /ambiguous/ with respect to the sequence order -- iff the associative collection contains more than one binding. -- Furthermore, it is /ambiguous/ with respect to the actual key -- returned, unless the @Eq@ instance on keys corresponds to -- indistinguisability. toSeq :: Sequence seq => m a -> seq (k,a) -- | Extract the keys of an associative collection into a sequence. -- The keys are emitted in an unspecified order. For finite relations, -- keys which appear multiple times in the relation will appear as many -- times in the extracted sequence. -- -- This function is /ambiguous/ with respect to the sequence order -- iff the associative collection contains more than one binding. -- Furthermore, it is /ambiguous/ with respect to the actual key -- returned, unless the @Eq@ instance on keys corresponds to -- indistinguisability. keys :: Sequence seq => m a -> seq k -- | Apply a function to every element in an associative collection. The -- mapped function additionally takes the value of the key. -- -- This function is /ambiguous/ with respect to the actual keys -- observed, unless the @Eq@ instance on keys corresponds to -- indistinguisability. mapWithKey :: (k -> a -> b) -> m a -> m b -- | Combine all the elements in the associative collection, given a combining -- function and an initial value. The elements are processed in an -- unspecified order. The combining function additionally takes the -- value of the key. -- -- @foldWithKey f@ is /unambiguous/ iff @f@ is fold-commutative and -- the @Eq@ instance on keys corresponds to indistinguisability. foldWithKey :: (k -> a -> b -> b) -> b -> m a -> b -- | A strict variant of 'foldWithKey'. -- -- @foldWithKey' f@ is /unambiguous/ iff @f@ is fold-commutative and -- the @Eq@ instance on keys corresponds to indistinguisability. foldWithKey' :: (k -> a -> b -> b) -> b -> m a -> b -- | Extract all bindings from an associative collection which satisfy the -- given predicate. -- -- This function is /ambiguous/ with respect to the actual keys -- observed, unless the @Eq@ instance on keys corresponds to -- indistinguisability. filterWithKey :: (k -> a -> Bool) -> m a -> m a -- | Split an associative collection into two sub-collections containing those -- bindings which satisfy the given predicate and those which do not. -- -- This function is /ambiguous/ with respect to the actual keys -- observed, unless the @Eq@ instance on keys corresponds to -- indistinguisability. partitionWithKey :: (k -> a -> Bool) -> m a -> (m a, m a) -- | An associative collection with observable keys where the keys additionally -- have an ordering relation. class (Assoc m k, OrdAssocX m k) => OrdAssoc m k | m -> k where -- | Delete the binding with the minimum key from an associative -- collection and return the key, the element and the remaining -- associative collection. Calls 'fail' if the associative collection -- is empty. Which binding is chosen if there are multiple minimum keys -- is unspecified. -- -- This function is /ambiguous/ at finite relation types if more than one -- minimum key exists in the relation. Furthermore, it is /ambiguous/ -- with respect to the actual key observed unless the @Eq@ instance on -- keys corresponds to indistinguisability. minViewWithKey :: (Monad rm) => m a -> rm ((k, a), m a) -- | Find the binding with the minimum key in an associative collection and -- return the key and the element. Signals an error if the associative -- collection is empty. Which binding is chosen if there are multiple -- minimum keys is unspecified. -- -- This function is /ambiguous/ at finite relation types if more than one -- minimum key exists in the relation. Furthermore, it is /ambiguous/ -- with respect to the actual key observed unless the @Eq@ instance on -- keys corresponds to indistinguisability. minElemWithKey :: m a -> (k,a) -- | Delete the binding with the maximum key from an associative -- collection and return the key, the element and the remaining -- associative collection. Calls 'fail' if the associative collection -- is empty. Which binding is chosen if there are multiple maximum keys -- is unspecified. -- -- This function is /ambiguous/ at finite relation types if more than one -- maximum key exists in the relation. Furthermore, it is /ambiguous/ -- with respect to the actual key observed unless the @Eq@ instance on -- keys corresponds to indistinguisability. maxViewWithKey :: (Monad rm) => m a -> rm ((k, a), m a) -- | Find the binding with the maximum key in an associative collection and -- return the key and the element. Signals an error if the associative -- collection is empty. Which binding is chosen if there are multiple -- maximum keys is unspecified. -- -- This function is /ambiguous/ at finite relation types if more than one -- maximum key exists in the relation. Furthermore, it is /ambiguous/ -- with respect to the actual key observed unless the @Eq@ instance on -- keys corresponds to indistinguisability. maxElemWithKey :: m a -> (k,a) -- | Fold over all bindings in an associative collection in non-decreasing -- order by key with right associativity, given a combining function -- and an initial value. For finite maps, the order is increasing. -- -- @foldrWithKey f@ is /ambiguous/ at finite relation types if -- the relation contains more than one equivalent key and -- @f@ is not fold-commutative OR if the @Eq@ instance on keys -- does not correspond to indistingusihability. foldrWithKey :: (k -> a -> b -> b) -> b -> m a -> b -- | A strict variant of 'foldrWithKey'. -- -- @foldrWithKey' f@ is /ambiguous/ at finite relation types if -- the relation contains more than one equivalent key and -- @f@ is not fold-commutative OR if the @Eq@ instance on keys -- does not correspond to indistingusihability. Otherwise it -- is /unambiguous/. foldrWithKey' :: (k -> a -> b -> b) -> b -> m a -> b -- | Fold over all bindings in an associative collection in non-decreasing -- order by key with left associativity, given a combining function -- and an initial value. For finite maps, the order is increasing. -- -- @foldlWithKey f@ is /ambiguous/ at finite relation types if -- the relation contains more than one equivalent key and -- @f@ is not fold-commutative OR if the @Eq@ instance on keys -- does not correspond to indistingusihability. Otherwise it -- is /unambiguous/. foldlWithKey :: (b -> k -> a -> b) -> b -> m a -> b -- | A strict variant of 'foldlWithKey'. -- -- @foldlWithKey' f@ is /ambiguous/ at finite relation types if -- the relation contains more than one equivalent key and -- @f@ is not fold-commutative OR if the @Eq@ instance on keys -- does not correspond to indistinguishability. Otherwise it -- is /unambiguous/. foldlWithKey' :: (b -> k -> a -> b) -> b -> m a -> b -- | Extract the bindings of an associative collection into a sequence, where -- the bindings are in non-decreasing order by key. For finite maps, this -- is increasing order. -- -- This function is /ambiguous/ at finite relation types if the relation -- contains more than one equivalent key, or if the @Eq@ instance on -- keys does not correspond to indistinguishability. toOrdSeq :: Sequence seq => m a -> seq (k,a) -- | Finite maps with observable keys. class (Assoc m k, FiniteMapX m k) => FiniteMap m k | m -> k where -- | Same as 'union', but with a combining function to resolve duplicates. -- The combining function additionally takes the key. Which key is kept -- and passed into the combining function is unspecified. -- -- This function is /unambiguous/ provided that the @Eq@ instance on keys -- corresponds to indistinguishability. unionWithKey :: (k -> a -> a -> a) -> m a -> m a -> m a -- | Same as 'unionSeq', but with a combining function to resolve duplicates. -- The combining function additionally takes the key. Which key is -- kept and passed into the combining function is unspecified. -- -- This function is /unambiguous/ provided that the @Eq@ instance on keys -- corresponds to indistinguishability. unionSeqWithKey :: Sequence seq => (k -> a -> a -> a) -> seq (m a) -> m a -- | Same as 'intersectionWith', except that the combining function -- additionally takes the key value for each binding. Which key is -- kept and passed into the combining function is unspecified. -- -- This function is /unambiguous/ provided the @Eq@ instance on keys -- corresponds to indistinguishability. intersectionWithKey :: (k -> a -> b -> c) -> m a -> m b -> m c -- | Finite maps with observable keys where the keys additionally -- have an ordering relation. This class introduces no new methods. class (OrdAssoc m k, FiniteMap m k) => OrdFiniteMap m k | m -> k -- specialize sequence operations to lists fromList :: AssocX m k => [(k,a)] -> m a insertList :: AssocX m k => [(k,a)] -> m a -> m a unionList :: AssocX m k => [m a] -> m a deleteList :: AssocX m k => [k] -> m a -> m a lookupList :: AssocX m k => k -> m a -> [a] elementsList :: AssocX m k => m a -> [a] unsafeFromOrdList :: OrdAssocX m k => [(k,a)] -> m a fromListWith :: FiniteMapX m k => (a -> a -> a) -> [(k,a)] -> m a fromListWithKey :: FiniteMapX m k => (k -> a -> a -> a) -> [(k,a)] -> m a insertListWith :: FiniteMapX m k => (a -> a -> a) -> [(k,a)] -> m a -> m a insertListWithKey :: FiniteMapX m k => (k -> a -> a -> a) -> [(k,a)] -> m a -> m a unionListWith :: FiniteMapX m k => (a -> a -> a) -> [m a] -> m a toList :: Assoc m k => m a -> [(k,a)] keysList :: Assoc m k => m a -> [k] toOrdList :: OrdAssoc m k => m a -> [(k,a)] unionListWithKey :: FiniteMap m k => (k -> a -> a -> a) -> [m a] -> m a fromList = fromSeq insertList = insertSeq unionList = unionSeq deleteList = deleteSeq lookupList = lookupAll elementsList = elements unsafeFromOrdList = unsafeFromOrdSeq fromListWith = fromSeqWith fromListWithKey = fromSeqWithKey insertListWith = insertSeqWith insertListWithKey = insertSeqWithKey unionListWith = unionSeqWith toList = toSeq keysList = keys toOrdList = toOrdSeq unionListWithKey = unionSeqWithKey EdisonAPI-1.2.2/src/Data/Edison/Prelude.hs0000644000000000000000000000336012077643166016310 0ustar0000000000000000-- | -- Module : Data.Edison.Prelude -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : BSD3; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- This module is a central depository of common definitions -- used throughout Edison. module Data.Edison.Prelude ( -- * Hashing classes Hash (..) , UniqueHash , ReversibleHash (..) , Measured (..) ) where import Data.Monoid -- | This class represents hashable objects. If obeys the -- following invariant: -- -- @forall x,y :: a. (x == y) implies (hash x == hash y)@ class Eq a => Hash a where hash :: a -> Int -- | This class represents hashable objects where the hash function -- is /unique/ (injective). There are no new methods, just a -- stronger invariant: -- -- @forall x,y :: a. (x == y) iff (hash x == hash y)@ class Hash a => UniqueHash a -- | This class represents hashable objects where the hash is -- reversible. -- -- @forall x :: a. unhash (hash x) == x@ -- -- Note that: -- -- @hash (unhash i) == i@ -- -- does not necessarily hold because 'unhash' is not necessarily -- defined for all @i@, only for all @i@ in the range of hash. class UniqueHash a => ReversibleHash a where unhash :: Int -> a -- | This class represents a quantity that can be measured. It is -- calculated by an associative function with a unit (hence the -- @Monoid@ superclass, and by a function which gives the measurement -- for an individual item. Some datastructures are able to speed up -- the calculation of a measure by caching intermediate values of -- the computation. class (Monoid v) => Measured v a | a -> v where measure :: a -> v EdisonAPI-1.2.2/src/Data/Edison/Seq/0000755000000000000000000000000012077643166015102 5ustar0000000000000000EdisonAPI-1.2.2/src/Data/Edison/Seq/ListSeq.hs0000644000000000000000000002722012077643166017025 0ustar0000000000000000-- | -- Module : Data.Edison.Seq.ListSeq -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- This module packages the standard prelude list type as a -- sequence. This is the baseline sequence implementation and -- all methods have the default running times listed in -- "Data.Edison.Seq", except for the following two trivial operations: -- -- * toList, fromList @O( 1 )@ -- module Data.Edison.Seq.ListSeq ( -- * Sequence Type Seq, -- * Sequence Operations empty,singleton,lcons,rcons,append,lview,lhead,lheadM,ltail,ltailM, rview,rhead,rheadM,rtail,rtailM, null,size,concat,reverse,reverseOnto,fromList,toList,map,concatMap, fold,fold',fold1,fold1',foldr,foldr',foldl,foldl',foldr1,foldr1',foldl1,foldl1', reducer,reducer',reducel,reducel',reduce1,reduce1', copy,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldrWithIndex',foldlWithIndex,foldlWithIndex', take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, strict,strictWith, -- * Unit testing structuralInvariant, -- * Documentation moduleName ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Control.Monad.Identity as ID import qualified Prelude import Data.Edison.Prelude import qualified Data.List import Data.Monoid import qualified Data.Edison.Seq as S ( Sequence(..) ) -- signatures for exported functions moduleName :: String empty :: [a] singleton :: a -> [a] lcons :: a -> [a] -> [a] rcons :: a -> [a] -> [a] append :: [a] -> [a] -> [a] lview :: (Monad rm) => [a] -> rm (a, [a]) lhead :: [a] -> a lheadM :: (Monad rm) => [a] -> rm a ltail :: [a] -> [a] ltailM :: (Monad rm) => [a] -> rm [a] rview :: (Monad rm) => [a] -> rm (a, [a]) rhead :: [a] -> a rheadM :: (Monad rm) => [a] -> rm a rtail :: [a] -> [a] rtailM :: (Monad rm) => [a] -> rm [a] null :: [a] -> Bool size :: [a] -> Int concat :: [[a]] -> [a] reverse :: [a] -> [a] reverseOnto :: [a] -> [a] -> [a] fromList :: [a] -> [a] toList :: [a] -> [a] map :: (a -> b) -> [a] -> [b] concatMap :: (a -> [b]) -> [a] -> [b] fold :: (a -> b -> b) -> b -> [a] -> b fold' :: (a -> b -> b) -> b -> [a] -> b fold1 :: (a -> a -> a) -> [a] -> a fold1' :: (a -> a -> a) -> [a] -> a foldr :: (a -> b -> b) -> b -> [a] -> b foldl :: (b -> a -> b) -> b -> [a] -> b foldr1 :: (a -> a -> a) -> [a] -> a foldl1 :: (a -> a -> a) -> [a] -> a reducer :: (a -> a -> a) -> a -> [a] -> a reducel :: (a -> a -> a) -> a -> [a] -> a reduce1 :: (a -> a -> a) -> [a] -> a foldl' :: (b -> a -> b) -> b -> [a] -> b foldl1' :: (a -> a -> a) -> [a] -> a reducer' :: (a -> a -> a) -> a -> [a] -> a reducel' :: (a -> a -> a) -> a -> [a] -> a reduce1' :: (a -> a -> a) -> [a] -> a copy :: Int -> a -> [a] inBounds :: Int -> [a] -> Bool lookup :: Int -> [a] -> a lookupM :: (Monad m) => Int -> [a] -> m a lookupWithDefault :: a -> Int -> [a] -> a update :: Int -> a -> [a] -> [a] adjust :: (a -> a) -> Int -> [a] -> [a] mapWithIndex :: (Int -> a -> b) -> [a] -> [b] foldrWithIndex :: (Int -> a -> b -> b) -> b -> [a] -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> [a] -> b foldlWithIndex' :: (b -> Int -> a -> b) -> b -> [a] -> b take :: Int -> [a] -> [a] drop :: Int -> [a] -> [a] splitAt :: Int -> [a] -> ([a], [a]) subseq :: Int -> Int -> [a] -> [a] filter :: (a -> Bool) -> [a] -> [a] partition :: (a -> Bool) -> [a] -> ([a], [a]) takeWhile :: (a -> Bool) -> [a] -> [a] dropWhile :: (a -> Bool) -> [a] -> [a] splitWhile :: (a -> Bool) -> [a] -> ([a], [a]) zip :: [a] -> [b] -> [(a,b)] zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] unzip :: [(a,b)] -> ([a], [b]) unzip3 :: [(a,b,c)] -> ([a], [b], [c]) unzipWith :: (a -> b) -> (a -> c) -> [a] -> ([b], [c]) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> [a] -> ([b], [c], [d]) strict :: [a] -> [a] strictWith :: (a -> b) -> [a] -> [a] structuralInvariant :: [a] -> Bool moduleName = "Data.Edison.Seq.ListSeq" type Seq a = [a] empty = [] singleton x = [x] lcons = (:) rcons x s = s ++ [x] append = (++) lview [] = fail "ListSeq.lview: empty sequence" lview (x:xs) = return (x, xs) lheadM [] = fail "ListSeq.lheadM: empty sequence" lheadM (x:xs) = return x lhead [] = error "ListSeq.lhead: empty sequence" lhead (x:xs) = x ltailM [] = fail "ListSeq.ltailM: empty sequence" ltailM (x:xs) = return xs ltail [] = error "ListSeq.ltail: empty sequence" ltail (x:xs) = xs rview [] = fail "ListSeq.rview: empty sequence" rview xs = return (rhead xs, rtail xs) rheadM [] = fail "ListSeq.rheadM: empty sequence" rheadM (x:xs) = rh x xs where rh y [] = return y rh y (x:xs) = rh x xs rhead [] = error "ListSeq.rhead: empty sequence" rhead (x:xs) = rh x xs where rh y [] = y rh y (x:xs) = rh x xs rtailM [] = fail "ListSeq.rtailM: empty sequence" rtailM (x:xs) = return (rt x xs) where rt y [] = [] rt y (x:xs) = y : rt x xs rtail [] = error "ListSeq.rtail: empty sequence" rtail (x:xs) = rt x xs where rt y [] = [] rt y (x:xs) = y : rt x xs null = Prelude.null size = length concat = foldr append empty reverse = Prelude.reverse reverseOnto [] ys = ys reverseOnto (x:xs) ys = reverseOnto xs (x:ys) fromList xs = xs toList xs = xs map = Data.List.map concatMap = Data.List.concatMap fold = foldr fold' f = foldl' (flip f) fold1 f [] = error "ListSeq.fold1: empty sequence" fold1 f (x:xs) = foldr f x xs fold1' f [] = error "ListSeq.fold1': empty sequence" fold1' f (x:xs) = foldl' f x xs foldr = Data.List.foldr foldl = Data.List.foldl foldr' f e [] = e foldr' f e (x:xs) = f x $! foldr' f e xs foldl' f e [] = e foldl' f e (x:xs) = e `seq` foldl' f (f e x) xs foldr1 f [] = error "ListSeq.foldr1: empty sequence" foldr1 f xs = fr xs where fr [x] = x fr (x:xs) = f x $ fr xs fr _ = error "ListSeq.foldr1: bug!" foldr1' f [] = error "ListSeq.foldr1': empty sequence" foldr1' f xs = fr xs where fr [x] = x fr (x:xs) = f x $! fr xs fr _ = error "ListSeq.foldr1': bug!" foldl1 f [] = error "ListSeq.foldl1: empty sequence" foldl1 f (x:xs) = foldl f x xs foldl1' f [] = error "ListSeq.foldl1': empty sequence" foldl1' f (x:xs) = foldl' f x xs reducer f e [] = e reducer f e xs = f (reduce1 f xs) e reducer' f e [] = e reducer' f e xs = (f $! (reduce1' f xs)) $! e reducel f e [] = e reducel f e xs = f e (reduce1 f xs) reducel' f e [] = e reducel' f e xs = (f $! e) $! (reduce1' f xs) reduce1 f [] = error "ListSeq.reduce1: empty sequence" reduce1 f [x] = x reduce1 f (x1 : x2 : xs) = reduce1 f (f x1 x2 : pairup xs) where pairup (x1 : x2 : xs) = f x1 x2 : pairup xs pairup xs = xs -- can be improved using a counter and bit ops! reduce1' f [] = error "ListSeq.reduce1': empty sequence" reduce1' f [x] = x reduce1' f (x1 : x2 : xs) = x1 `seq` x2 `seq` reduce1' f (f x1 x2 : pairup xs) where pairup (x1 : x2 : xs) = x1 `seq` x2 `seq` (f x1 x2 : pairup xs) pairup xs = xs copy n x | n <= 0 = [] | otherwise = x : copy (n-1) x -- depends on n to be unboxed, should test this! inBounds i xs | i >= 0 = not (null (drop i xs)) | otherwise = False lookup i xs = ID.runIdentity (lookupM i xs) lookupM i xs | i < 0 = fail "ListSeq.lookup: not found" | otherwise = case drop i xs of [] -> fail "ListSeq.lookup: not found" (x:_) -> return x lookupWithDefault d i xs | i < 0 = d | otherwise = case drop i xs of [] -> d (x:_) -> x update i y xs | i < 0 = xs | otherwise = upd i xs where upd _ [] = [] upd i (x:xs) | i > 0 = x : upd (i - 1) xs | otherwise = y : xs adjust f i xs | i < 0 = xs | otherwise = adj i xs where adj _ [] = [] adj i (x:xs) | i > 0 = x : adj (i - 1) xs | otherwise = f x : xs mapWithIndex f = mapi 0 where mapi i [] = [] mapi i (x:xs) = f i x : mapi (succ i) xs foldrWithIndex f e = foldi 0 where foldi i [] = e foldi i (x:xs) = f i x (foldi (succ i) xs) foldrWithIndex' f e = foldi 0 where foldi i [] = e foldi i (x:xs) = f i x $! (foldi (succ i) xs) foldlWithIndex f = foldi 0 where foldi i e [] = e foldi i e (x:xs) = foldi (succ i) (f e i x) xs foldlWithIndex' f = foldi 0 where foldi i e [] = e foldi i e (x:xs) = e `seq` foldi (succ i) (f e i x) xs take i xs | i <= 0 = [] | otherwise = Data.List.take i xs drop i xs | i <= 0 = xs | otherwise = Data.List.drop i xs splitAt i xs | i <= 0 = ([], xs) | otherwise = Data.List.splitAt i xs subseq i len xs = take len (drop i xs) strict l@[] = l strict l@(_:xs) = strict xs `seq` l strictWith f l@[] = l strictWith f l@(x:xs) = f x `seq` strictWith f xs `seq` l filter = Data.List.filter partition = Data.List.partition takeWhile = Data.List.takeWhile dropWhile = Data.List.dropWhile splitWhile = Data.List.span zip = Data.List.zip zip3 = Data.List.zip3 zipWith = Data.List.zipWith zipWith3 = Data.List.zipWith3 unzip = Data.List.unzip unzip3 = Data.List.unzip3 unzipWith f g = foldr consfg ([], []) where consfg a (bs, cs) = (f a : bs, g a : cs) -- could put ~ on tuple unzipWith3 f g h = foldr consfgh ([], [], []) where consfgh a (bs, cs, ds) = (f a : bs, g a : cs, h a : ds) -- could put ~ on tuple -- no invariants structuralInvariant = const True -- declare the instance instance S.Sequence [] where {lcons = lcons; rcons = rcons; null = null; lview = lview; lhead = lhead; ltail = ltail; lheadM = lheadM; ltailM = ltailM; rview = rview; rhead = rhead; rtail = rtail; rheadM = rheadM; rtailM = rtailM; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1'; foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1'; reducer = reducer; reducel = reducel; reduce1 = reduce1; reducel' = reducel'; reducer' = reducer'; reduce1' = reduce1'; copy = copy; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldrWithIndex' = foldrWithIndex'; foldlWithIndex = foldlWithIndex; foldlWithIndex' = foldlWithIndex'; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; strict = strict; strictWith = strictWith; structuralInvariant = structuralInvariant; instanceName s = moduleName} EdisonAPI-1.2.2/src/Data/Edison/Coll/0000755000000000000000000000000012077643166015243 5ustar0000000000000000EdisonAPI-1.2.2/src/Data/Edison/Coll/Utils.hs0000644000000000000000000000425612077643166016706 0ustar0000000000000000-- | -- Module : Data.Edison.Coll.Utils -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- This module provides implementations of several useful operations -- that are not included in the collection classes themselves. This is -- usually because the operation involves transforming a collection into a -- different type of collection; such operations cannot be typed using -- the collection classes without significantly complicating them. -- -- Be aware that these functions are defined using the external class -- interfaces and may be less efficient than corresponding, but more -- restrictively typed, functions in the collection classes. module Data.Edison.Coll.Utils where import Prelude hiding (map,null,foldr,foldl,foldr1,foldl1,lookup,filter) import Data.Edison.Coll -- | Apply a function across all the elements in a collection and transform -- the collection type. map :: (Coll cin a, CollX cout b) => (a -> b) -> (cin -> cout) map f xs = fold (\x ys -> insert (f x) ys) empty xs -- | Map a partial function across all elements of a collection and transform -- the collection type. mapPartial :: (Coll cin a, CollX cout b) => (a -> Maybe b) -> (cin -> cout) mapPartial f xs = fold (\ x ys -> case f x of Just y -> insert y ys Nothing -> ys) empty xs -- | Map a monotonic function across all the elements of a collection and -- transform the collection type. The function is required to satisfy -- the following precondition: -- -- > forall x y. x < y ==> f x < f y unsafeMapMonotonic :: (OrdColl cin a, OrdCollX cout b) => (a -> b) -> (cin -> cout) unsafeMapMonotonic f xs = foldr (unsafeInsertMin . f) empty xs -- | Map a collection-producing function across all elements of a collection -- and collect the results together using 'union'. unionMap :: (Coll cin a, CollX cout b) => (a -> cout) -> (cin -> cout) unionMap f xs = fold (\x ys -> union (f x) ys) empty xs