X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FList.hs;h=c3b5df6340640f2bddda42e448e14641a8eaa2aa;hb=69daab60bb6f89433a0394182481d721dc2f42fd;hp=069a31afba84778c4367abfbb37f4410a1f811ff;hpb=746ef6a7fd71bb1e9ebe3cd107c5f9f79f3b7a68;p=ghc-base.git diff --git a/Data/List.hs b/Data/List.hs index 069a31a..c3b5df6 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -3,7 +3,7 @@ -- | -- Module : Data.List -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional @@ -15,132 +15,197 @@ module Data.List ( - [] (..), - - , elemIndex -- :: (Eq a) => a -> [a] -> Maybe Int - , elemIndices -- :: (Eq a) => a -> [a] -> [Int] - - , find -- :: (a -> Bool) -> [a] -> Maybe a - , findIndex -- :: (a -> Bool) -> [a] -> Maybe Int - , findIndices -- :: (a -> Bool) -> [a] -> [Int] - - , nub -- :: (Eq a) => [a] -> [a] - , nubBy -- :: (a -> a -> Bool) -> [a] -> [a] - - , delete -- :: (Eq a) => a -> [a] -> [a] - , deleteBy -- :: (a -> a -> Bool) -> a -> [a] -> [a] - , (\\) -- :: (Eq a) => [a] -> [a] -> [a] - , deleteFirstsBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] - - , union -- :: (Eq a) => [a] -> [a] -> [a] - , unionBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] - - , intersect -- :: (Eq a) => [a] -> [a] -> [a] - , intersectBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a] - - , intersperse -- :: a -> [a] -> [a] - , transpose -- :: [[a]] -> [[a]] - , partition -- :: (a -> Bool) -> [a] -> ([a], [a]) - - , group -- :: Eq a => [a] -> [[a]] - , groupBy -- :: (a -> a -> Bool) -> [a] -> [[a]] - - , inits -- :: [a] -> [[a]] - , tails -- :: [a] -> [[a]] - - , isPrefixOf -- :: (Eq a) => [a] -> [a] -> Bool - , isSuffixOf -- :: (Eq a) => [a] -> [a] -> Bool - - , mapAccumL -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) - , mapAccumR -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) - - , sort -- :: (Ord a) => [a] -> [a] - , sortBy -- :: (a -> a -> Ordering) -> [a] -> [a] - - , insert -- :: (Ord a) => a -> [a] -> [a] - , insertBy -- :: (a -> a -> Ordering) -> a -> [a] -> [a] - - , maximumBy -- :: (a -> a -> Ordering) -> [a] -> a - , minimumBy -- :: (a -> a -> Ordering) -> [a] -> a - - , 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] - - , unfoldr -- :: (b -> Maybe (a, b)) -> b -> [a] +#ifdef __NHC__ + [] (..) + , +#endif - , zip4, zip5, zip6, zip7 - , zipWith4, zipWith5, zipWith6, zipWith7 - , unzip4, unzip5, unzip6, unzip7 + -- * Basic functions - , map -- :: ( a -> b ) -> [a] -> [b] - , (++) -- :: [a] -> [a] -> [a] - , concat -- :: [[a]] -> [a] - , filter -- :: (a -> Bool) -> [a] -> [a] + (++) -- :: [a] -> [a] -> [a] , head -- :: [a] -> a , last -- :: [a] -> a , tail -- :: [a] -> [a] , init -- :: [a] -> [a] , null -- :: [a] -> Bool , length -- :: [a] -> Int - , (!!) -- :: [a] -> Int -> a + + -- * List transformations + , map -- :: (a -> b) -> [a] -> [b] + , reverse -- :: [a] -> [a] + + , intersperse -- :: a -> [a] -> [a] + , transpose -- :: [[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 - , scanl -- :: (a -> b -> a) -> a -> [b] -> [a] - , scanl1 -- :: (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]) - , lines -- :: String -> [String] - , words -- :: String -> [String] - , unlines -- :: [String] -> String - , unwords -- :: [String] -> String - , reverse -- :: [a] -> [a] - , and -- :: [Bool] -> Bool - , or -- :: [Bool] -> Bool - , any -- :: (a -> Bool) -> [a] -> Bool - , all -- :: (a -> Bool) -> [a] -> Bool + , group -- :: Eq a => [a] -> [[a]] + + , inits -- :: [a] -> [[a]] + , tails -- :: [a] -> [[a]] + + -- ** Predicates + , isPrefixOf -- :: (Eq a) => [a] -> [a] -> Bool + , isSuffixOf -- :: (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 - , sum -- :: (Num a) => [a] -> a - , product -- :: (Num a) => [a] -> a - , maximum -- :: (Ord a) => [a] -> a - , minimum -- :: (Ord a) => [a] -> a - , concatMap -- :: (a -> [b]) -> [a] -> [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@\'. + + -- *** 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__ +import Prelude hiding (Maybe(..)) +#endif + import Data.Maybe +import Data.Char ( isSpace ) #ifdef __GLASGOW_HASKELL__ import GHC.Num import GHC.Real import GHC.List -import GHC.Show ( lines, words, unlines, unwords ) import GHC.Base #endif @@ -149,44 +214,62 @@ infix 5 \\ -- ----------------------------------------------------------------------------- -- List functions +-- | 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 :: Eq a => a -> [a] -> Maybe Int elemIndex x = findIndex (x==) +-- | The 'elemIndices' function extends 'elemIndex', by returning the +-- indices of all elements equal to the query element, in ascending order. elemIndices :: Eq a => a -> [a] -> [Int] elemIndices x = 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] -> Maybe a find p = listToMaybe . filter p +-- | 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] -> Maybe Int findIndex p = listToMaybe . findIndices p +-- | The 'findIndices' function extends 'findIndex', by returning the +-- indices of all elements satisfying the predicate, in ascending order. findIndices :: (a -> Bool) -> [a] -> [Int] -#ifdef USE_REPORT_PRELUDE +#if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__) findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else -#ifdef __HUGS__ -findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] -#else -- Efficient definition findIndices p ls = loop 0# ls where loop _ [] = [] loop n (x:xs) | p x = I# n : loop (n +# 1#) xs | otherwise = loop (n +# 1#) xs -#endif /* __HUGS__ */ #endif /* USE_REPORT_PRELUDE */ +-- | The 'isPrefixOf' function takes two lists and returns 'True' +-- iff the first list is a prefix of the second. isPrefixOf :: (Eq a) => [a] -> [a] -> Bool isPrefixOf [] _ = True isPrefixOf _ [] = False isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys +-- | 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 :: (Eq a) => [a] -> [a] -> Bool isSuffixOf x y = reverse x `isPrefixOf` reverse y --- nub (meaning "essence") remove duplicate elements from its list argument. +-- | 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 :: (Eq a) => [a] -> [a] #ifdef USE_REPORT_PRELUDE nub = nubBy (==) @@ -200,6 +283,9 @@ nub l = nub' l [] -- ' | 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_PRELUDE nubBy eq [] = [] @@ -223,50 +309,97 @@ elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs #endif --- delete x removes the first occurrence of x from its list argument. +-- | '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 :: (Eq a) => 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 _ _ [] = [] deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys --- 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. +-- | 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. + (\\) :: (Eq a) => [a] -> [a] -> [a] (\\) = foldl (flip delete) --- List union, remove the elements of first list from second. +-- | 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 :: (Eq a) => [a] -> [a] -> [a] union = unionBy (==) +-- | The 'unionBy' function is the non-overloaded version of 'union'. unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) 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. +-- It is a special case of 'intersectBy', which allows the programmer to +-- supply their own equality test. + intersect :: (Eq a) => [a] -> [a] -> [a] intersect = intersectBy (==) +-- | The 'intersectBy' function is the non-overloaded version of 'intersect'. intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] --- intersperse sep inserts sep between the elements of its list argument. --- e.g. intersperse ',' "abcde" == "a,b,c,d,e" +-- | 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 _ [] = [] intersperse _ [x] = [x] intersperse sep (x:xs) = x : sep : intersperse sep xs +-- | 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) = transpose xss transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss]) --- partition takes a predicate and a list and returns a pair of lists: --- those elements of the argument list that do and do not satisfy the --- predicate, respectively; i,e,, --- partition p xs == (filter p xs, filter (not . p) xs). +-- | 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 #-} partition p xs = foldr (select p) ([],[]) xs @@ -274,12 +407,10 @@ partition p xs = foldr (select p) ([],[]) xs select p x (ts,fs) | p x = (x:ts,fs) | otherwise = (ts, x:fs) --- @mapAccumL@ 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. - +-- | 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 @@ -291,9 +422,10 @@ mapAccumL f s (x:xs) = (s'',y:ys) where (s', y ) = f s x (s'',ys) = mapAccumL f s' xs --- @mapAccumR@ does the same, but working from right to left instead. --- Its type is the same as @mapAccumL@, though. - +-- | 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 @@ -305,10 +437,16 @@ mapAccumR f s (x:xs) = (s'', y:ys) where (s'',y ) = f s' x (s', ys) = mapAccumR f s xs - +-- | 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 :: Ord a => a -> [a] -> [a] insert e ls = insertBy (compare) e ls +-- | The non-overloaded version of 'insert'. insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBy _ x [] = [x] insertBy cmp x ys@(y:ys') @@ -316,6 +454,9 @@ insertBy cmp x ys@(y:ys') GT -> y : insertBy cmp x ys' _ -> x : ys +-- | 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] -> a maximumBy _ [] = error "List.maximumBy: empty list" maximumBy cmp xs = foldl1 max xs @@ -324,6 +465,9 @@ maximumBy cmp xs = foldl1 max xs GT -> 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] -> a minimumBy _ [] = error "List.minimumBy: empty list" minimumBy cmp xs = foldl1 min xs @@ -332,22 +476,31 @@ minimumBy cmp xs = foldl1 min xs GT -> 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 :: (Num i) => [b] -> i genericLength [] = 0 genericLength (_:l) = 1 + genericLength l +-- | The 'genericTake' function is an overloaded version of 'take', which +-- accepts any 'Integral' value as the number of elements to take. genericTake :: (Integral i) => i -> [a] -> [a] genericTake 0 _ = [] genericTake _ [] = [] genericTake n (x:xs) | n > 0 = x : genericTake (n-1) xs genericTake _ _ = error "List.genericTake: negative argument" +-- | The 'genericDrop' function is an overloaded version of 'drop', which +-- accepts any 'Integral' value as the number of elements to drop. genericDrop :: (Integral i) => i -> [a] -> [a] genericDrop 0 xs = xs genericDrop _ [] = [] genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs genericDrop _ _ = error "List.genericDrop: negative argument" +-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which +-- accepts any 'Integral' value as the position at which to split. genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b]) genericSplitAt 0 xs = ([],xs) genericSplitAt _ [] = ([],[]) @@ -355,7 +508,8 @@ genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = genericSplitAt (n-1) xs genericSplitAt _ _ = error "List.genericSplitAt: negative argument" - +-- | The 'genericIndex' function is an overloaded version of '!!', which +-- accepts any 'Integral' value as the index. genericIndex :: (Integral a) => [b] -> a -> b genericIndex (x:_) 0 = x genericIndex (_:xs) n @@ -363,92 +517,134 @@ genericIndex (_:xs) n | 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 :: (Integral i) => i -> a -> [a] genericReplicate n x = genericTake n (repeat x) - +-- | 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] zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) = z a b c d : zipWith4 z as bs cs ds zipWith4 _ _ _ _ _ = [] +-- | 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] zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) = z a b c d e : zipWith5 z as bs cs ds es zipWith5 _ _ _ _ _ _ = [] +-- | 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] zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = z a b c d e f : zipWith6 z as bs cs ds es fs zipWith6 _ _ _ _ _ _ _ = [] +-- | 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] zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = z a b c d e f g : zipWith7 z as bs cs ds es fs gs zipWith7 _ _ _ _ _ _ _ _ = [] +-- | 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] deleteFirstsBy eq = foldl (flip (deleteBy eq)) - --- group splits its list argument into a list of lists of equal, adjacent --- elements. e.g., --- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"] -group :: (Eq a) => [a] -> [[a]] +-- | 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 :: Eq a => [a] -> [[a]] group = groupBy (==) +-- | The 'groupBy' function is the non-overloaded version of 'group'. groupBy :: (a -> a -> Bool) -> [a] -> [[a]] groupBy _ [] = [] groupBy eq (x:xs) = (x:ys) : groupBy eq zs where (ys,zs) = span (eq x) xs --- inits xs returns the list of initial segments of xs, shortest first. --- e.g., inits "abc" == ["","a","ab","abc"] +-- | The 'inits' function returns all initial segments of the argument, +-- shortest first. For example, +-- +-- > inits "abc" == ["","a","ab","abc"] +-- inits :: [a] -> [[a]] inits [] = [[]] inits (x:xs) = [[]] ++ map (x:) (inits xs) --- tails xs returns the list of all final segments of xs, longest first. --- e.g., tails "abc" == ["abc", "bc", "c",""] +-- | The 'tails' function returns all final segments of the argument, +-- longest first. For example, +-- +-- > tails "abc" == ["abc", "bc", "c",""] +-- tails :: [a] -> [[a]] tails [] = [[]] tails xxs@(_:xs) = xxs : tails xs @@ -457,7 +653,12 @@ tails xxs@(_:xs) = xxs : tails xs ------------------------------------------------------------------------------ -- 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 :: (Ord a) => [a] -> [a] + +-- | The 'sortBy' function is the non-overloaded version of 'sort'. sortBy :: (a -> a -> Ordering) -> [a] -> [a] #ifdef USE_REPORT_PRELUDE @@ -465,10 +666,78 @@ sort = sortBy compare sortBy cmp = foldr (insertBy cmp) [] #else -sortBy cmp l = qsort cmp l [] -sort l = qsort compare l [] +sortBy cmp l = mergesort cmp l +sort l = mergesort compare l --- rest is not exported: +{- +Quicksort replaced by mergesort, 14/5/2002. + +From: Ian Lynagh + +I am curious as to why the List.sort implementation in GHC is a +quicksort algorithm rather than an algorithm that guarantees n log n +time in the worst case? I have attached a mergesort implementation along +with a few scripts to time it's performance, the results of which are +shown below (* means it didn't finish successfully - in all cases this +was due to a stack overflow). + +If I heap profile the random_list case with only 10000 then I see +random_list peaks at using about 2.5M of memory, whereas in the same +program using List.sort it uses only 100k. + +Input style Input length Sort data Sort alg User time +stdin 10000 random_list sort 2.82 +stdin 10000 random_list mergesort 2.96 +stdin 10000 sorted sort 31.37 +stdin 10000 sorted mergesort 1.90 +stdin 10000 revsorted sort 31.21 +stdin 10000 revsorted mergesort 1.88 +stdin 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.31 +func 10000 random_list mergesort 0.91 +func 10000 sorted sort 19.09 +func 10000 sorted mergesort 0.15 +func 10000 revsorted sort 19.17 +func 10000 revsorted mergesort 0.16 +func 100000 random_list sort 3.85 +func 100000 random_list mergesort * +func 100000 sorted sort 5831.47 +func 100000 sorted mergesort 2.23 +func 100000 revsorted sort 5872.34 +func 100000 revsorted mergesort 2.24 +-} + +mergesort :: (a -> a -> Ordering) -> [a] -> [a] +mergesort cmp = mergesort' cmp . map wrap + +mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a] +mergesort' cmp [] = [] +mergesort' cmp [xs] = xs +mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss) + +merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]] +merge_pairs cmp [] = [] +merge_pairs cmp [xs] = [xs] +merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss + +merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +merge cmp xs [] = xs +merge cmp [] ys = ys +merge 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] + +{- +OLD: qsort version -- qsort is stable and does not concatenate. qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] @@ -500,19 +769,27 @@ 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 */ -{- -\begin{verbatim} - unfoldr f' (foldr f z xs) == (z,xs) - - if the following holds: - - f' (f x y) = Just (x,y) - f' z = Nothing -\end{verbatim} --} +-- | 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 unfoldr :: (b -> Maybe (a, b)) -> b -> [a] unfoldr f b = @@ -520,23 +797,25 @@ unfoldr f b = Just (a,new_b) -> a : unfoldr f new_b Nothing -> [] - -- ----------------------------------------------------------------------------- --- strict version of foldl +-- | A strict version of 'foldl'. foldl' :: (a -> b -> a) -> a -> [b] -> a foldl' f a [] = a foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs +#ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- List sum and product --- sum and product compute the sum or product of a finite list of numbers. {-# SPECIALISE sum :: [Int] -> Int #-} {-# SPECIALISE sum :: [Integer] -> Integer #-} {-# SPECIALISE product :: [Int] -> Int #-} {-# SPECIALISE product :: [Integer] -> Integer #-} -sum, product :: (Num a) => [a] -> a +-- | The 'sum' function computes the sum of a finite list of numbers. +sum :: (Num a) => [a] -> a +-- | The 'product' function computes the product of a finite list of numbers. +product :: (Num a) => [a] -> a #ifdef USE_REPORT_PRELUDE sum = foldl (+) 0 product = foldl (*) 1 @@ -550,3 +829,51 @@ product l = prod l 1 prod [] a = a prod (x:xs) a = prod xs (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 "" = [] +lines s = let (l, s') = break (== '\n') s + in l : case s' of + [] -> [] + (_:s'') -> lines s'' + +-- | 'unlines' is an inverse operation to 'lines'. +-- It joins lines, after appending a terminating newline to each. +unlines :: [String] -> String +#ifdef USE_REPORT_PRELUDE +unlines = concatMap (++ "\n") +#else +-- HBC version (stolen) +-- here's a more efficient version +unlines [] = [] +unlines (l:ls) = l ++ '\n' : unlines ls +#endif + +-- | 'words' breaks a string up into a list of words, which were delimited +-- by white space. +words :: String -> [String] +words s = case dropWhile {-partain:Char.-}isSpace s of + "" -> [] + s' -> w : words s'' + where (w, s'') = + break {-partain:Char.-}isSpace s' + +-- | 'unwords' is an inverse operation to 'words'. +-- It joins words with separating spaces. +unwords :: [String] -> String +#ifdef USE_REPORT_PRELUDE +unwords [] = "" +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws +#else +-- HBC version (stolen) +-- here's a more efficient version +unwords [] = "" +unwords [w] = w +unwords (w:ws) = w ++ ' ' : unwords ws +#endif +#endif /* __GLASGOW_HASKELL__ */