{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}------------------------------------------------------------------------------- |-- Module : Data.List-- Copyright : (c) The University of Glasgow 2001-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : stable-- Portability : portable---- Operations on lists.-------------------------------------------------------------------------------moduleData.List(#ifdef __NHC__[](..),#endif-- * Basic functions(++)-- :: [a] -> [a] -> [a],head-- :: [a] -> a,last-- :: [a] -> a,tail-- :: [a] -> [a],init-- :: [a] -> [a],null-- :: [a] -> Bool,length-- :: [a] -> Int-- * List transformations,map-- :: (a -> b) -> [a] -> [b],reverse-- :: [a] -> [a],intersperse-- :: a -> [a] -> [a],intercalate-- :: [a] -> [[a]] -> [a],transpose-- :: [[a]] -> [[a]],subsequences-- :: [a] -> [[a]],permutations-- :: [a] -> [[a]]-- * Reducing lists (folds),foldl-- :: (a -> b -> a) -> a -> [b] -> a,foldl'-- :: (a -> b -> a) -> a -> [b] -> a,foldl1-- :: (a -> a -> a) -> [a] -> a,foldl1'-- :: (a -> a -> a) -> [a] -> a,foldr-- :: (a -> b -> b) -> b -> [a] -> b,foldr1-- :: (a -> a -> a) -> [a] -> a-- ** Special folds,concat-- :: [[a]] -> [a],concatMap-- :: (a -> [b]) -> [a] -> [b],and-- :: [Bool] -> Bool,or-- :: [Bool] -> Bool,any-- :: (a -> Bool) -> [a] -> Bool,all-- :: (a -> Bool) -> [a] -> Bool,sum-- :: (Num a) => [a] -> a,product-- :: (Num a) => [a] -> a,maximum-- :: (Ord a) => [a] -> a,minimum-- :: (Ord a) => [a] -> a-- * Building lists-- ** Scans,scanl-- :: (a -> b -> a) -> a -> [b] -> [a],scanl1-- :: (a -> a -> a) -> [a] -> [a],scanr-- :: (a -> b -> b) -> b -> [a] -> [b],scanr1-- :: (a -> a -> a) -> [a] -> [a]-- ** Accumulating maps,mapAccumL-- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]),mapAccumR-- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])-- ** Infinite lists,iterate-- :: (a -> a) -> a -> [a],repeat-- :: a -> [a],replicate-- :: Int -> a -> [a],cycle-- :: [a] -> [a]-- ** Unfolding,unfoldr-- :: (b -> Maybe (a, b)) -> b -> [a]-- * Sublists-- ** Extracting sublists,take-- :: Int -> [a] -> [a],drop-- :: Int -> [a] -> [a],splitAt-- :: Int -> [a] -> ([a], [a]),takeWhile-- :: (a -> Bool) -> [a] -> [a],dropWhile-- :: (a -> Bool) -> [a] -> [a],span-- :: (a -> Bool) -> [a] -> ([a], [a]),break-- :: (a -> Bool) -> [a] -> ([a], [a]),stripPrefix-- :: Eq a => [a] -> [a] -> Maybe [a],group-- :: Eq a => [a] -> [[a]],inits-- :: [a] -> [[a]],tails-- :: [a] -> [[a]]-- ** Predicates,isPrefixOf-- :: (Eq a) => [a] -> [a] -> Bool,isSuffixOf-- :: (Eq a) => [a] -> [a] -> Bool,isInfixOf-- :: (Eq a) => [a] -> [a] -> Bool-- * Searching lists-- ** Searching by equality,elem-- :: a -> [a] -> Bool,notElem-- :: a -> [a] -> Bool,lookup-- :: (Eq a) => a -> [(a,b)] -> Maybe b-- ** Searching with a predicate,find-- :: (a -> Bool) -> [a] -> Maybe a,filter-- :: (a -> Bool) -> [a] -> [a],partition-- :: (a -> Bool) -> [a] -> ([a], [a])-- * Indexing lists-- | These functions treat a list @xs@ as a indexed collection,-- with indices ranging from 0 to @'length' xs - 1@.,(!!)-- :: [a] -> Int -> a,elemIndex-- :: (Eq a) => a -> [a] -> Maybe Int,elemIndices-- :: (Eq a) => a -> [a] -> [Int],findIndex-- :: (a -> Bool) -> [a] -> Maybe Int,findIndices-- :: (a -> Bool) -> [a] -> [Int]-- * Zipping and unzipping lists,zip-- :: [a] -> [b] -> [(a,b)],zip3,zip4,zip5,zip6,zip7,zipWith-- :: (a -> b -> c) -> [a] -> [b] -> [c],zipWith3,zipWith4,zipWith5,zipWith6,zipWith7,unzip-- :: [(a,b)] -> ([a],[b]),unzip3,unzip4,unzip5,unzip6,unzip7-- * Special lists-- ** Functions on strings,lines-- :: String -> [String],words-- :: String -> [String],unlines-- :: [String] -> String,unwords-- :: [String] -> String-- ** \"Set\" operations,nub-- :: (Eq a) => [a] -> [a],delete-- :: (Eq a) => a -> [a] -> [a],(\\)-- :: (Eq a) => [a] -> [a] -> [a],union-- :: (Eq a) => [a] -> [a] -> [a],intersect-- :: (Eq a) => [a] -> [a] -> [a]-- ** Ordered lists,sort-- :: (Ord a) => [a] -> [a],insert-- :: (Ord a) => a -> [a] -> [a]-- * Generalized functions-- ** The \"@By@\" operations-- | By convention, overloaded functions have a non-overloaded-- counterpart whose name is suffixed with \`@By@\'.---- It is often convenient to use these functions together with-- 'Data.Function.on', for instance @'sortBy' ('compare'-- \`on\` 'fst')@.-- *** User-supplied equality (replacing an @Eq@ context)-- | The predicate is assumed to define an equivalence.,nubBy-- :: (a -> a -> Bool) -> [a] -> [a],deleteBy-- :: (a -> a -> Bool) -> a -> [a] -> [a],deleteFirstsBy-- :: (a -> a -> Bool) -> [a] -> [a] -> [a],unionBy-- :: (a -> a -> Bool) -> [a] -> [a] -> [a],intersectBy-- :: (a -> a -> Bool) -> [a] -> [a] -> [a],groupBy-- :: (a -> a -> Bool) -> [a] -> [[a]]-- *** User-supplied comparison (replacing an @Ord@ context)-- | The function is assumed to define a total ordering.,sortBy-- :: (a -> a -> Ordering) -> [a] -> [a],insertBy-- :: (a -> a -> Ordering) -> a -> [a] -> [a],maximumBy-- :: (a -> a -> Ordering) -> [a] -> a,minimumBy-- :: (a -> a -> Ordering) -> [a] -> a-- ** The \"@generic@\" operations-- | The prefix \`@generic@\' indicates an overloaded function that-- is a generalized version of a "Prelude" function.,genericLength-- :: (Integral a) => [b] -> a,genericTake-- :: (Integral a) => a -> [b] -> [b],genericDrop-- :: (Integral a) => a -> [b] -> [b],genericSplitAt-- :: (Integral a) => a -> [b] -> ([b], [b]),genericIndex-- :: (Integral a) => [b] -> a -> b,genericReplicate-- :: (Integral a) => a -> b -> [b])where#ifdef __NHC__importPrelude#endifimportData.MaybeimportData.Char(isSpace)#ifdef __GLASGOW_HASKELL__importGHC.NumimportGHC.RealimportGHC.ListimportGHC.Base#endifinfix5\\-- comment to fool cpp-- ------------------------------------------------------------------------------- List functions-- | The 'stripPrefix' function drops the given prefix from a list.-- It returns 'Nothing' if the list did not start with the prefix-- given, or 'Just' the list after the prefix, if it does.---- > stripPrefix "foo" "foobar" == Just "bar"-- > stripPrefix "foo" "foo" == Just ""-- > stripPrefix "foo" "barfoo" == Nothing-- > stripPrefix "foo" "barfoobaz" == NothingstripPrefix::Eqa=>[a]->[a]->Maybe[a]stripPrefix[]ys=JustysstripPrefix(x:xs)(y:ys)|x==y=stripPrefixxsysstripPrefix__=Nothing-- | The 'elemIndex' function returns the index of the first element-- in the given list which is equal (by '==') to the query element,-- or 'Nothing' if there is no such element.elemIndex::Eqa=>a->[a]->MaybeIntelemIndexx=findIndex(x==)-- | The 'elemIndices' function extends 'elemIndex', by returning the-- indices of all elements equal to the query element, in ascending order.elemIndices::Eqa=>a->[a]->[Int]elemIndicesx=findIndices(x==)-- | The 'find' function takes a predicate and a list and returns the-- first element in the list matching the predicate, or 'Nothing' if-- there is no such element.find::(a->Bool)->[a]->Maybeafindp=listToMaybe.filterp-- | The 'findIndex' function takes a predicate and a list and returns-- the index of the first element in the list satisfying the predicate,-- or 'Nothing' if there is no such element.findIndex::(a->Bool)->[a]->MaybeIntfindIndexp=listToMaybe.findIndicesp-- | The 'findIndices' function extends 'findIndex', by returning the-- indices of all elements satisfying the predicate, in ascending order.findIndices::(a->Bool)->[a]->[Int]#if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)findIndicespxs=[i|(x,i)<-zipxs[0..],px]#else-- Efficient definitionfindIndicespls=loop0#lswhereloop_[]=[]loopn(x:xs)|px=I#n:loop(n+#1#)xs|otherwise=loop(n+#1#)xs#endif /* USE_REPORT_PRELUDE */-- | The 'isPrefixOf' function takes two lists and returns 'True'-- iff the first list is a prefix of the second.isPrefixOf::(Eqa)=>[a]->[a]->BoolisPrefixOf[]_=TrueisPrefixOf_[]=FalseisPrefixOf(x:xs)(y:ys)=x==y&&isPrefixOfxsys-- | The 'isSuffixOf' function takes two lists and returns 'True'-- iff the first list is a suffix of the second.-- Both lists must be finite.isSuffixOf::(Eqa)=>[a]->[a]->BoolisSuffixOfxy=reversex`isPrefixOf`reversey-- | The 'isInfixOf' function takes two lists and returns 'True'-- iff the first list is contained, wholly and intact,-- anywhere within the second.---- Example:---- >isInfixOf "Haskell" "I really like Haskell." == True-- >isInfixOf "Ial" "I really like Haskell." == FalseisInfixOf::(Eqa)=>[a]->[a]->BoolisInfixOfneedlehaystack=any(isPrefixOfneedle)(tailshaystack)-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.-- In particular, it keeps only the first occurrence of each element.-- (The name 'nub' means \`essence\'.)-- It is a special case of 'nubBy', which allows the programmer to supply-- their own equality test.nub::(Eqa)=>[a]->[a]#ifdef USE_REPORT_PRELUDEnub=nubBy(==)#else-- stolen from HBCnubl=nub'l[]-- 'wherenub'[]_=[]-- 'nub'(x:xs)ls-- '|x`elem`ls=nub'xsls-- '|otherwise=x:nub'xs(x:ls)-- '#endif-- | The 'nubBy' function behaves just like 'nub', except it uses a-- user-supplied equality predicate instead of the overloaded '=='-- function.nubBy::(a->a->Bool)->[a]->[a]#ifdef USE_REPORT_PRELUDEnubByeq[]=[]nubByeq(x:xs)=x:nubByeq(filter(\y->not(eqxy))xs)#elsenubByeql=nubBy'l[]wherenubBy'[]_=[]nubBy'(y:ys)xs|elem_byeqyxs=nubBy'ysxs|otherwise=y:nubBy'ys(y:xs)-- Not exported:-- Note that we keep the call to `eq` with arguments in the-- same order as in the reference implementation-- 'xs' is the list of things we've seen so far,-- 'y' is the potential new elementelem_by::(a->a->Bool)->a->[a]->Boolelem_by__[]=Falseelem_byeqy(x:xs)=y`eq`x||elem_byeqyxs#endif-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.-- For example,---- > delete 'a' "banana" == "bnana"---- It is a special case of 'deleteBy', which allows the programmer to-- supply their own equality test.delete::(Eqa)=>a->[a]->[a]delete=deleteBy(==)-- | The 'deleteBy' function behaves like 'delete', but takes a-- user-supplied equality predicate.deleteBy::(a->a->Bool)->a->[a]->[a]deleteBy__[]=[]deleteByeqx(y:ys)=ifx`eq`ythenyselsey:deleteByeqxys-- | The '\\' function is list difference ((non-associative).-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of-- @ys@ in turn (if any) has been removed from @xs@. Thus---- > (xs ++ ys) \\ xs == ys.---- It is a special case of 'deleteFirstsBy', which allows the programmer-- to supply their own equality test.(\\)::(Eqa)=>[a]->[a]->[a](\\)=foldl(flipdelete)-- | The 'union' function returns the list union of the two lists.-- For example,---- > "dog" `union` "cow" == "dogcw"---- Duplicates, and elements of the first list, are removed from the-- the second list, but if the first list contains duplicates, so will-- the result.-- It is a special case of 'unionBy', which allows the programmer to supply-- their own equality test.union::(Eqa)=>[a]->[a]->[a]union=unionBy(==)-- | The 'unionBy' function is the non-overloaded version of 'union'.unionBy::(a->a->Bool)->[a]->[a]->[a]unionByeqxsys=xs++foldl(flip(deleteByeq))(nubByeqys)xs-- | The 'intersect' function takes the list intersection of two lists.-- For example,---- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]---- If the first list contains duplicates, so will the result.---- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]---- It is a special case of 'intersectBy', which allows the programmer to-- supply their own equality test.intersect::(Eqa)=>[a]->[a]->[a]intersect=intersectBy(==)-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.intersectBy::(a->a->Bool)->[a]->[a]->[a]intersectBy_[]_=[]intersectBy__[]=[]intersectByeqxsys=[x|x<-xs,any(eqx)ys]-- | The 'intersperse' function takes an element and a list and-- \`intersperses\' that element between the elements of the list.-- For example,---- > intersperse ',' "abcde" == "a,b,c,d,e"intersperse::a->[a]->[a]intersperse_[]=[]interspersesep(x:xs)=x:prependToAllsepxs-- Not exported:-- We want to make every element in the 'intersperse'd list available-- as soon as possible to avoid space leaks. Experiments suggested that-- a separate top-level helper is more efficient than a local worker.prependToAll::a->[a]->[a]prependToAll_[]=[]prependToAllsep(x:xs)=sep:x:prependToAllsepxs-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the-- result.intercalate::[a]->[[a]]->[a]intercalatexsxss=concat(interspersexsxss)-- | The 'transpose' function transposes the rows and columns of its argument.-- For example,---- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]transpose::[[a]]->[[a]]transpose[]=[]transpose([]:xss)=transposexsstranspose((x:xs):xss)=(x:[h|(h:_)<-xss]):transpose(xs:[t|(_:t)<-xss])-- | The 'partition' function takes a predicate a list and returns-- the pair of lists of elements which do and do not satisfy the-- predicate, respectively; i.e.,---- > partition p xs == (filter p xs, filter (not . p) xs)partition::(a->Bool)->[a]->([a],[a]){-# INLINE partition #-}partitionpxs=foldr(selectp)([],[])xsselect::(a->Bool)->a->([a],[a])->([a],[a])selectpx~(ts,fs)|px=(x:ts,fs)|otherwise=(ts,x:fs)-- | The 'mapAccumL' function behaves like a combination of 'map' and-- 'foldl'; it applies a function to each element of a list, passing-- an accumulating parameter from left to right, and returning a final-- value of this accumulator together with the new list.mapAccumL::(acc->x->(acc,y))-- Function of elt of input list-- and accumulator, returning new-- accumulator and elt of result list->acc-- Initial accumulator->[x]-- Input list->(acc,[y])-- Final accumulator and result listmapAccumL_s[]=(s,[])mapAccumLfs(x:xs)=(s'',y:ys)where(s',y)=fsx(s'',ys)=mapAccumLfs'xs-- | The 'mapAccumR' function behaves like a combination of 'map' and-- 'foldr'; it applies a function to each element of a list, passing-- an accumulating parameter from right to left, and returning a final-- value of this accumulator together with the new list.mapAccumR::(acc->x->(acc,y))-- Function of elt of input list-- and accumulator, returning new-- accumulator and elt of result list->acc-- Initial accumulator->[x]-- Input list->(acc,[y])-- Final accumulator and result listmapAccumR_s[]=(s,[])mapAccumRfs(x:xs)=(s'',y:ys)where(s'',y)=fs'x(s',ys)=mapAccumRfsxs-- | The 'insert' function takes an element and a list and inserts the-- element into the list at the last position where it is still less-- than or equal to the next element. In particular, if the list-- is sorted before the call, the result will also be sorted.-- It is a special case of 'insertBy', which allows the programmer to-- supply their own comparison function.insert::Orda=>a->[a]->[a]insertels=insertBy(compare)els-- | The non-overloaded version of 'insert'.insertBy::(a->a->Ordering)->a->[a]->[a]insertBy_x[]=[x]insertBycmpxys@(y:ys')=casecmpxyofGT->y:insertBycmpxys'_->x:ys#ifdef __GLASGOW_HASKELL__-- | 'maximum' returns the maximum value from a list,-- which must be non-empty, finite, and of an ordered type.-- It is a special case of 'Data.List.maximumBy', which allows the-- programmer to supply their own comparison function.maximum::(Orda)=>[a]->amaximum[]=errorEmptyList"maximum"maximumxs=foldl1maxxs{-# RULES "maximumInt" maximum = (strictMaximum :: [Int] -> Int); "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer) #-}-- We can't make the overloaded version of maximum strict without-- changing its semantics (max might not be strict), but we can for-- the version specialised to 'Int'.strictMaximum::(Orda)=>[a]->astrictMaximum[]=errorEmptyList"maximum"strictMaximumxs=foldl1'maxxs-- | 'minimum' returns the minimum value from a list,-- which must be non-empty, finite, and of an ordered type.-- It is a special case of 'Data.List.minimumBy', which allows the-- programmer to supply their own comparison function.minimum::(Orda)=>[a]->aminimum[]=errorEmptyList"minimum"minimumxs=foldl1minxs{-# RULES "minimumInt" minimum = (strictMinimum :: [Int] -> Int); "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer) #-}strictMinimum::(Orda)=>[a]->astrictMinimum[]=errorEmptyList"minimum"strictMinimumxs=foldl1'minxs#endif /* __GLASGOW_HASKELL__ */-- | The 'maximumBy' function takes a comparison function and a list-- and returns the greatest element of the list by the comparison function.-- The list must be finite and non-empty.maximumBy::(a->a->Ordering)->[a]->amaximumBy_[]=error"List.maximumBy: empty list"maximumBycmpxs=foldl1maxByxswheremaxByxy=casecmpxyofGT->x_->y-- | The 'minimumBy' function takes a comparison function and a list-- and returns the least element of the list by the comparison function.-- The list must be finite and non-empty.minimumBy::(a->a->Ordering)->[a]->aminimumBy_[]=error"List.minimumBy: empty list"minimumBycmpxs=foldl1minByxswhereminByxy=casecmpxyofGT->y_->x-- | The 'genericLength' function is an overloaded version of 'length'. In-- particular, instead of returning an 'Int', it returns any type which is-- an instance of 'Num'. It is, however, less efficient than 'length'.genericLength::(Numi)=>[b]->igenericLength[]=0genericLength(_:l)=1+genericLengthl{-# RULES "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int); "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer); #-}strictGenericLength::(Numi)=>[b]->istrictGenericLengthl=gll0wheregl[]a=agl(_:xs)a=leta'=a+1ina'`seq`glxsa'-- | The 'genericTake' function is an overloaded version of 'take', which-- accepts any 'Integral' value as the number of elements to take.genericTake::(Integrali)=>i->[a]->[a]genericTaken_|n<=0=[]genericTake_[]=[]genericTaken(x:xs)=x:genericTake(n-1)xs-- | The 'genericDrop' function is an overloaded version of 'drop', which-- accepts any 'Integral' value as the number of elements to drop.genericDrop::(Integrali)=>i->[a]->[a]genericDropnxs|n<=0=xsgenericDrop_[]=[]genericDropn(_:xs)=genericDrop(n-1)xs-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which-- accepts any 'Integral' value as the position at which to split.genericSplitAt::(Integrali)=>i->[b]->([b],[b])genericSplitAtnxs|n<=0=([],xs)genericSplitAt_[]=([],[])genericSplitAtn(x:xs)=(x:xs',xs'')where(xs',xs'')=genericSplitAt(n-1)xs-- | The 'genericIndex' function is an overloaded version of '!!', which-- accepts any 'Integral' value as the index.genericIndex::(Integrala)=>[b]->a->bgenericIndex(x:_)0=xgenericIndex(_:xs)n|n>0=genericIndexxs(n-1)|otherwise=error"List.genericIndex: negative argument."genericIndex__=error"List.genericIndex: index too large."-- | The 'genericReplicate' function is an overloaded version of 'replicate',-- which accepts any 'Integral' value as the number of repetitions to make.genericReplicate::(Integrali)=>i->a->[a]genericReplicatenx=genericTaken(repeatx)-- | The 'zip4' function takes four lists and returns a list of-- quadruples, analogous to 'zip'.zip4::[a]->[b]->[c]->[d]->[(a,b,c,d)]zip4=zipWith4(,,,)-- | The 'zip5' function takes five lists and returns a list of-- five-tuples, analogous to 'zip'.zip5::[a]->[b]->[c]->[d]->[e]->[(a,b,c,d,e)]zip5=zipWith5(,,,,)-- | The 'zip6' function takes six lists and returns a list of six-tuples,-- analogous to 'zip'.zip6::[a]->[b]->[c]->[d]->[e]->[f]->[(a,b,c,d,e,f)]zip6=zipWith6(,,,,,)-- | The 'zip7' function takes seven lists and returns a list of-- seven-tuples, analogous to 'zip'.zip7::[a]->[b]->[c]->[d]->[e]->[f]->[g]->[(a,b,c,d,e,f,g)]zip7=zipWith7(,,,,,,)-- | The 'zipWith4' function takes a function which combines four-- elements, as well as four lists and returns a list of their point-wise-- combination, analogous to 'zipWith'.zipWith4::(a->b->c->d->e)->[a]->[b]->[c]->[d]->[e]zipWith4z(a:as)(b:bs)(c:cs)(d:ds)=zabcd:zipWith4zasbscsdszipWith4_____=[]-- | The 'zipWith5' function takes a function which combines five-- elements, as well as five lists and returns a list of their point-wise-- combination, analogous to 'zipWith'.zipWith5::(a->b->c->d->e->f)->[a]->[b]->[c]->[d]->[e]->[f]zipWith5z(a:as)(b:bs)(c:cs)(d:ds)(e:es)=zabcde:zipWith5zasbscsdseszipWith5______=[]-- | The 'zipWith6' function takes a function which combines six-- elements, as well as six lists and returns a list of their point-wise-- combination, analogous to 'zipWith'.zipWith6::(a->b->c->d->e->f->g)->[a]->[b]->[c]->[d]->[e]->[f]->[g]zipWith6z(a:as)(b:bs)(c:cs)(d:ds)(e:es)(f:fs)=zabcdef:zipWith6zasbscsdsesfszipWith6_______=[]-- | The 'zipWith7' function takes a function which combines seven-- elements, as well as seven lists and returns a list of their point-wise-- combination, analogous to 'zipWith'.zipWith7::(a->b->c->d->e->f->g->h)->[a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]zipWith7z(a:as)(b:bs)(c:cs)(d:ds)(e:es)(f:fs)(g:gs)=zabcdefg:zipWith7zasbscsdsesfsgszipWith7________=[]-- | The 'unzip4' function takes a list of quadruples and returns four-- lists, analogous to 'unzip'.unzip4::[(a,b,c,d)]->([a],[b],[c],[d])unzip4=foldr(\(a,b,c,d)~(as,bs,cs,ds)->(a:as,b:bs,c:cs,d:ds))([],[],[],[])-- | The 'unzip5' function takes a list of five-tuples and returns five-- lists, analogous to 'unzip'.unzip5::[(a,b,c,d,e)]->([a],[b],[c],[d],[e])unzip5=foldr(\(a,b,c,d,e)~(as,bs,cs,ds,es)->(a:as,b:bs,c:cs,d:ds,e:es))([],[],[],[],[])-- | The 'unzip6' function takes a list of six-tuples and returns six-- lists, analogous to 'unzip'.unzip6::[(a,b,c,d,e,f)]->([a],[b],[c],[d],[e],[f])unzip6=foldr(\(a,b,c,d,e,f)~(as,bs,cs,ds,es,fs)->(a:as,b:bs,c:cs,d:ds,e:es,f:fs))([],[],[],[],[],[])-- | The 'unzip7' function takes a list of seven-tuples and returns-- seven lists, analogous to 'unzip'.unzip7::[(a,b,c,d,e,f,g)]->([a],[b],[c],[d],[e],[f],[g])unzip7=foldr(\(a,b,c,d,e,f,g)~(as,bs,cs,ds,es,fs,gs)->(a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))([],[],[],[],[],[],[])-- | The 'deleteFirstsBy' function takes a predicate and two lists and-- returns the first list with the first occurrence of each element of-- the second list removed.deleteFirstsBy::(a->a->Bool)->[a]->[a]->[a]deleteFirstsByeq=foldl(flip(deleteByeq))-- | The 'group' function takes a list and returns a list of lists such-- that the concatenation of the result is equal to the argument. Moreover,-- each sublist in the result contains only equal elements. For example,---- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]---- It is a special case of 'groupBy', which allows the programmer to supply-- their own equality test.group::Eqa=>[a]->[[a]]group=groupBy(==)-- | The 'groupBy' function is the non-overloaded version of 'group'.groupBy::(a->a->Bool)->[a]->[[a]]groupBy_[]=[]groupByeq(x:xs)=(x:ys):groupByeqzswhere(ys,zs)=span(eqx)xs-- | The 'inits' function returns all initial segments of the argument,-- shortest first. For example,---- > inits "abc" == ["","a","ab","abc"]---- Note that 'inits' has the following strictness property:-- @inits _|_ = [] : _|_@inits::[a]->[[a]]initsxs=[]:casexsof[]->[]x:xs'->map(x:)(initsxs')-- | The 'tails' function returns all final segments of the argument,-- longest first. For example,---- > tails "abc" == ["abc", "bc", "c",""]---- Note that 'tails' has the following strictness property:-- @tails _|_ = _|_ : _|_@tails::[a]->[[a]]tailsxs=xs:casexsof[]->[]_:xs'->tailsxs'-- | The 'subsequences' function returns the list of all subsequences of the argument.---- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]subsequences::[a]->[[a]]subsequencesxs=[]:nonEmptySubsequencesxs-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,-- except for the empty list.---- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]nonEmptySubsequences::[a]->[[a]]nonEmptySubsequences[]=[]nonEmptySubsequences(x:xs)=[x]:foldrf[](nonEmptySubsequencesxs)wherefysr=ys:(x:ys):r-- | The 'permutations' function returns the list of all permutations of the argument.---- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]permutations::[a]->[[a]]permutationsxs0=xs0:permsxs0[]whereperms[]_=[]perms(t:ts)is=foldrinterleave(permsts(t:is))(permutationsis)whereinterleavexsr=let(_,zs)=interleave'idxsrinzsinterleave'_[]r=(ts,r)interleave'f(y:ys)r=let(us,zs)=interleave'(f.(y:))ysrin(y:us,f(t:y:us):zs)-------------------------------------------------------------------------------- Quick Sort algorithm taken from HBC's QSort library.-- | The 'sort' function implements a stable sorting algorithm.-- It is a special case of 'sortBy', which allows the programmer to supply-- their own comparison function.sort::(Orda)=>[a]->[a]-- | The 'sortBy' function is the non-overloaded version of 'sort'.sortBy::(a->a->Ordering)->[a]->[a]#ifdef USE_REPORT_PRELUDEsort=sortBycomparesortBycmp=foldr(insertBycmp)[]#else{-GHC's mergesort replaced by a better implementation, 24/12/2009.This code originally contributed to the nhc12 compiler by Thomas Nordinin 2002. Rumoured to have been based on code by Lennart Augustsson, e.g.http://www.mail-archive.com/haskell@haskell.org/msg01822.htmland possibly to bear similarities to a 1982 paper by Richard O'Keefe:"A smooth applicative merge sort".Benchmarks show it to be often 2x the speed of the previous implementation.Fixes tickethttp://hackage.haskell.org/trac/ghc/ticket/2143-}sort=sortBycomparesortBycmp=mergeAll.sequenceswheresequences(a:b:xs)|a`cmp`b==GT=descendingb[a]xs|otherwise=ascendingb(a:)xssequencesxs=[xs]descendingaas(b:bs)|a`cmp`b==GT=descendingb(a:as)bsdescendingaasbs=(a:as):sequencesbsascendingaas(b:bs)|a`cmp`b/=GT=ascendingb(\ys->as(a:ys))bsascendingaasbs=as[a]:sequencesbsmergeAll[x]=xmergeAllxs=mergeAll(mergePairsxs)mergePairs(a:b:xs)=mergeab:mergePairsxsmergePairsxs=xsmergeas@(a:as')bs@(b:bs')|a`cmp`b==GT=b:mergeasbs'|otherwise=a:mergeas'bsmerge[]bs=bsmergeas[]=as{-sortBy cmp l = mergesort cmp lsort l = mergesort compare lQuicksort replaced by mergesort, 14/5/2002.From: Ian Lynagh <igloo@earth.li>I am curious as to why the List.sort implementation in GHC is aquicksort algorithm rather than an algorithm that guarantees n log ntime in the worst case? I have attached a mergesort implementation alongwith a few scripts to time it's performance, the results of which areshown below (* means it didn't finish successfully - in all cases thiswas due to a stack overflow).If I heap profile the random_list case with only 10000 then I seerandom_list peaks at using about 2.5M of memory, whereas in the sameprogram using List.sort it uses only 100k.Input style Input length Sort data Sort alg User timestdin 10000 random_list sort 2.82stdin 10000 random_list mergesort 2.96stdin 10000 sorted sort 31.37stdin 10000 sorted mergesort 1.90stdin 10000 revsorted sort 31.21stdin 10000 revsorted mergesort 1.88stdin 100000 random_list sort *stdin 100000 random_list mergesort *stdin 100000 sorted sort *stdin 100000 sorted mergesort *stdin 100000 revsorted sort *stdin 100000 revsorted mergesort *func 10000 random_list sort 0.31func 10000 random_list mergesort 0.91func 10000 sorted sort 19.09func 10000 sorted mergesort 0.15func 10000 revsorted sort 19.17func 10000 revsorted mergesort 0.16func 100000 random_list sort 3.85func 100000 random_list mergesort *func 100000 sorted sort 5831.47func 100000 sorted mergesort 2.23func 100000 revsorted sort 5872.34func 100000 revsorted mergesort 2.24mergesort :: (a -> a -> Ordering) -> [a] -> [a]mergesort cmp = mergesort' cmp . map wrapmergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]mergesort' _ [] = []mergesort' _ [xs] = xsmergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]merge_pairs _ [] = []merge_pairs _ [xs] = [xs]merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xssmerge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]merge _ [] ys = ysmerge _ xs [] = xsmerge cmp (x:xs) (y:ys) = case x `cmp` y of GT -> y : merge cmp (x:xs) ys _ -> x : merge cmp xs (y:ys)wrap :: a -> [a]wrap x = [x]OLDER: qsort version-- qsort is stable and does not concatenate.qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]qsort _ [] r = rqsort _ [x] r = x:rqsort cmp (x:xs) r = qpart cmp x xs [] [] r-- qpart partitions and sorts the sublistsqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]qpart cmp x [] rlt rge r = -- rlt and rge are in reverse order and must be sorted with an -- anti-stable sorting rqsort cmp rlt (x:rqsort cmp rge r)qpart cmp x (y:ys) rlt rge r = case cmp x y of GT -> qpart cmp x ys (y:rlt) rge r _ -> qpart cmp x ys rlt (y:rge) r-- rqsort is as qsort but anti-stable, i.e. reverses equal elementsrqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]rqsort _ [] r = rrqsort _ [x] r = x:rrqsort cmp (x:xs) r = rqpart cmp x xs [] [] rrqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]rqpart cmp x [] rle rgt r = qsort cmp rle (x:qsort cmp rgt r)rqpart cmp x (y:ys) rle rgt r = case cmp y x of GT -> rqpart cmp x ys rle (y:rgt) r _ -> rqpart cmp x ys (y:rle) rgt r-}#endif /* USE_REPORT_PRELUDE */-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'-- reduces a list to a summary value, 'unfoldr' builds a list from-- a seed value. The function takes the element and returns 'Nothing'-- if it is done producing the list or returns 'Just' @(a,b)@, in which-- case, @a@ is a prepended to the list and @b@ is used as the next-- element in a recursive call. For example,---- > iterate f == unfoldr (\x -> Just (x, f x))---- In some cases, 'unfoldr' can undo a 'foldr' operation:---- > unfoldr f' (foldr f z xs) == xs---- if the following holds:---- > f' (f x y) = Just (x,y)-- > f' z = Nothing---- A simple use of unfoldr:---- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10-- > [10,9,8,7,6,5,4,3,2,1]--unfoldr::(b->Maybe(a,b))->b->[a]unfoldrfb=casefbofJust(a,new_b)->a:unfoldrfnew_bNothing->[]-- ------------------------------------------------------------------------------- | A strict version of 'foldl'.foldl'::(a->b->a)->a->[b]->a#ifdef __GLASGOW_HASKELL__foldl'fz0xs0=lgoz0xs0wherelgoz[]=zlgoz(x:xs)=letz'=fzxinz'`seq`lgoz'xs#elsefoldl'fa[]=afoldl'fa(x:xs)=leta'=faxina'`seq`foldl'fa'xs#endif#ifdef __GLASGOW_HASKELL__-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,-- and thus must be applied to non-empty lists.foldl1::(a->a->a)->[a]->afoldl1f(x:xs)=foldlfxxsfoldl1_[]=errorEmptyList"foldl1"#endif /* __GLASGOW_HASKELL__ */-- | A strict version of 'foldl1'foldl1'::(a->a->a)->[a]->afoldl1'f(x:xs)=foldl'fxxsfoldl1'_[]=errorEmptyList"foldl1'"#ifdef __GLASGOW_HASKELL__-- ------------------------------------------------------------------------------- List sum and product{-# SPECIALISE sum :: [Int] -> Int #-}{-# SPECIALISE sum :: [Integer] -> Integer #-}{-# SPECIALISE product :: [Int] -> Int #-}{-# SPECIALISE product :: [Integer] -> Integer #-}-- | The 'sum' function computes the sum of a finite list of numbers.sum::(Numa)=>[a]->a-- | The 'product' function computes the product of a finite list of numbers.product::(Numa)=>[a]->a#ifdef USE_REPORT_PRELUDEsum=foldl(+)0product=foldl(*)1#elsesuml=sum'l0wheresum'[]a=asum'(x:xs)a=sum'xs(a+x)productl=prodl1whereprod[]a=aprod(x:xs)a=prodxs(a*x)#endif-- ------------------------------------------------------------------------------- Functions on strings-- | 'lines' breaks a string up into a list of strings at newline-- characters. The resulting strings do not contain newlines.lines::String->[String]lines""=[]#ifdef __GLASGOW_HASKELL__-- Somehow GHC doesn't detect the selector thunks in the below code,-- so s' keeps a reference to the first line via the pair and we have-- a space leak (cf. #4334).-- So we need to make GHC see the selector thunks with a trick.liness=cons(casebreak(=='\n')sof(l,s')->(l,cases'of[]->[]_:s''->liness''))wherecons~(h,t)=h:t#elseliness=let(l,s')=break(=='\n')sinl:cases'of[]->[](_:s'')->liness''#endif-- | 'unlines' is an inverse operation to 'lines'.-- It joins lines, after appending a terminating newline to each.unlines::[String]->String#ifdef USE_REPORT_PRELUDEunlines=concatMap(++"\n")#else-- HBC version (stolen)-- here's a more efficient versionunlines[]=[]unlines(l:ls)=l++'\n':unlinesls#endif-- | 'words' breaks a string up into a list of words, which were delimited-- by white space.words::String->[String]wordss=casedropWhile{-partain:Char.-}isSpacesof""->[]s'->w:wordss''where(w,s'')=break{-partain:Char.-}isSpaces'-- | 'unwords' is an inverse operation to 'words'.-- It joins words with separating spaces.unwords::[String]->String#ifdef USE_REPORT_PRELUDEunwords[]=""unwordsws=foldr1(\ws->w++' ':s)ws#else-- HBC version (stolen)-- here's a more efficient versionunwords[]=""unwords[w]=wunwords(w:ws)=w++' ':unwordsws#endif#else /* !__GLASGOW_HASKELL__ */errorEmptyList::String->aerrorEmptyListfun=error("Prelude."++fun++": empty list")#endif /* !__GLASGOW_HASKELL__ */