diff options
| m--------- | libraries/array | 0 | ||||
| -rw-r--r-- | libraries/base/Data/Foldable.hs | 2 | ||||
| -rw-r--r-- | libraries/base/Data/List.hs | 910 | ||||
| -rw-r--r-- | libraries/base/Data/OldList.hs | 1115 | ||||
| -rw-r--r-- | libraries/base/Data/OldTypeable/Internal.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Internal.hs | 3 | ||||
| -rwxr-xr-x | libraries/base/GHC/Exts.hs | 2 | ||||
| -rw-r--r-- | libraries/base/Prelude.hs | 2 | ||||
| -rw-r--r-- | libraries/base/base.cabal | 1 | ||||
| m--------- | libraries/haskell2010 | 0 | ||||
| m--------- | libraries/haskell98 | 0 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/ghci008.stdout | 4 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/integerGmpInternals.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/T1972.stderr | 1 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/T7963a.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/rnfail040.stderr | 1 |
16 files changed, 1132 insertions, 916 deletions
diff --git a/libraries/array b/libraries/array -Subproject bfb488592cf5c92a6970eff64b9495970464014 +Subproject f7955522c45a6b7da352349381d93be7c38dff3 diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index b839106c93..cb13e5ce7e 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -61,7 +61,7 @@ module Data.Foldable ( import Data.Bool import Data.Either import Data.Eq -import qualified Data.List as List +import qualified Data.OldList as List import Data.Maybe import Data.Monoid import Data.Ord diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index 5e5acc17ee..44c86bb7d8 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -207,909 +207,5 @@ module Data.List ) where -import Data.Maybe -import Data.Char ( isSpace ) -import Data.Ord ( comparing ) -import Data.Tuple ( fst, snd ) - -import GHC.Num -import GHC.Real -import GHC.List -import GHC.Base - -infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps - --- ----------------------------------------------------------------------------- --- List functions - --- | The 'dropWhileEnd' function drops the largest suffix of a list --- in which the given predicate holds for all elements. For example: --- --- > dropWhileEnd isSpace "foo\n" == "foo" --- > dropWhileEnd isSpace "foo bar" == "foo bar" --- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined --- --- /Since: 4.5.0.0/ -dropWhileEnd :: (a -> Bool) -> [a] -> [a] -dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] - --- | 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" == Nothing -stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] -stripPrefix [] ys = Just ys -stripPrefix (x:xs) (y:ys) - | x == y = stripPrefix xs ys -stripPrefix _ _ = 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 :: 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 -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 /* 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 - --- | 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." == False -isInfixOf :: (Eq a) => [a] -> [a] -> Bool -isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) - --- | /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 :: (Eq a) => [a] -> [a] -#ifdef USE_REPORT_PRELUDE -nub = nubBy (==) -#else --- stolen from HBC -nub l = nub' l [] -- ' - where - nub' [] _ = [] -- ' - nub' (x:xs) ls -- ' - | x `elem` ls = nub' xs ls -- ' - | 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 [] = [] -nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs) -#else -nubBy eq l = nubBy' l [] - where - nubBy' [] _ = [] - nubBy' (y:ys) xs - | elem_by eq y xs = nubBy' ys xs - | 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 element -elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool -elem_by _ _ [] = False -elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs -#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 :: (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 - --- | 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) - --- | 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. --- --- > [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. If the element is found in both the first --- and the second list, the element from the first list will be used. - -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 _ [] _ = [] -intersectBy _ _ [] = [] -intersectBy eq xs ys = [x | x <- xs, any (eq x) 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 _ [] = [] -intersperse sep (x:xs) = x : prependToAll sep xs - - --- 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 _ [] = [] -prependToAll sep (x:xs) = sep : x : prependToAll sep xs - --- | '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] -intercalate xs xss = concat (intersperse xs xss) - --- | 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:_) <- 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 #-} -partition p xs = foldr (select p) ([],[]) xs - -select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) -select p x ~(ts,fs) | p x = (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 list -mapAccumL _ s [] = (s, []) -mapAccumL f s (x:xs) = (s'',y:ys) - where (s', y ) = f s x - (s'',ys) = mapAccumL f s' 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 list -mapAccumR _ s [] = (s, []) -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 first position where it is 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') - = case cmp x y of - GT -> y : insertBy cmp x ys' - _ -> x : ys - --- | '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 :: (Ord a) => [a] -> a -{-# INLINE [1] maximum #-} -maximum [] = errorEmptyList "maximum" -maximum xs = foldl1 max xs - -{-# 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 :: (Ord a) => [a] -> a -strictMaximum [] = errorEmptyList "maximum" -strictMaximum xs = foldl1' max xs - --- | '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 :: (Ord a) => [a] -> a -{-# INLINE [1] minimum #-} -minimum [] = errorEmptyList "minimum" -minimum xs = foldl1 min xs - -{-# RULES - "minimumInt" minimum = (strictMinimum :: [Int] -> Int); - "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer) - #-} - -strictMinimum :: (Ord a) => [a] -> a -strictMinimum [] = errorEmptyList "minimum" -strictMinimum xs = foldl1' min xs - --- | 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 maxBy xs - where - maxBy x y = case cmp x y of - 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 minBy xs - where - minBy x y = case cmp x y of - 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) => [a] -> i -{-# NOINLINE [1] genericLength #-} -genericLength [] = 0 -genericLength (_:l) = 1 + genericLength l - -{-# RULES - "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int); - "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer); - #-} - -strictGenericLength :: (Num i) => [b] -> i -strictGenericLength l = gl l 0 - where - gl [] a = a - gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a' - --- | 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 n _ | n <= 0 = [] -genericTake _ [] = [] -genericTake n (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 :: (Integral i) => i -> [a] -> [a] -genericDrop n xs | n <= 0 = xs -genericDrop _ [] = [] -genericDrop n (_: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 :: (Integral i) => i -> [a] -> ([a], [a]) -genericSplitAt n xs | n <= 0 = ([],xs) -genericSplitAt _ [] = ([],[]) -genericSplitAt n (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 :: (Integral i) => [a] -> i -> a -genericIndex (x:_) 0 = x -genericIndex (_:xs) n - | n > 0 = genericIndex xs (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 :: (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)) - --- | 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 - --- | 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]] -inits xs = [] : case xs of - [] -> [] - x : xs' -> map (x :) (inits xs') - --- | 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]] -tails xs = xs : case xs of - [] -> [] - _ : xs' -> tails xs' - --- | The 'subsequences' function returns the list of all subsequences of the argument. --- --- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"] -subsequences :: [a] -> [[a]] -subsequences xs = [] : nonEmptySubsequences xs - --- | 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] : foldr f [] (nonEmptySubsequences xs) - where f ys r = 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]] -permutations xs0 = xs0 : perms xs0 [] - where - perms [] _ = [] - perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is) - where interleave xs r = let (_,zs) = interleave' id xs r in zs - interleave' _ [] r = (ts, r) - interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r - in (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 :: (Ord a) => [a] -> [a] - --- | The 'sortBy' function is the non-overloaded version of 'sort'. -sortBy :: (a -> a -> Ordering) -> [a] -> [a] - -#ifdef USE_REPORT_PRELUDE -sort = sortBy compare -sortBy cmp = foldr (insertBy cmp) [] -#else - -{- -GHC's mergesort replaced by a better implementation, 24/12/2009. -This code originally contributed to the nhc12 compiler by Thomas Nordin -in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g. - http://www.mail-archive.com/haskell@haskell.org/msg01822.html -and 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 ticket http://ghc.haskell.org/trac/ghc/ticket/2143 --} - -sort = sortBy compare -sortBy cmp = mergeAll . sequences - where - sequences (a:b:xs) - | a `cmp` b == GT = descending b [a] xs - | otherwise = ascending b (a:) xs - sequences xs = [xs] - - descending a as (b:bs) - | a `cmp` b == GT = descending b (a:as) bs - descending a as bs = (a:as): sequences bs - - ascending a as (b:bs) - | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs - ascending a as bs = as [a]: sequences bs - - mergeAll [x] = x - mergeAll xs = mergeAll (mergePairs xs) - - mergePairs (a:b:xs) = merge a b: mergePairs xs - mergePairs xs = xs - - merge as@(a:as') bs@(b:bs') - | a `cmp` b == GT = b:merge as bs' - | otherwise = a:merge as' bs - merge [] bs = bs - merge as [] = as - -{- -sortBy cmp l = mergesort cmp l -sort l = mergesort compare l - -Quicksort 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 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' _ [] = [] -mergesort' _ [xs] = xs -mergesort' 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 xss - -merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -merge _ [] ys = ys -merge _ xs [] = xs -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] - - - -OLDER: qsort version - --- qsort is stable and does not concatenate. -qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -qsort _ [] r = r -qsort _ [x] r = x:r -qsort cmp (x:xs) r = qpart cmp x xs [] [] r - --- qpart partitions and sorts the sublists -qpart :: (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 elements -rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -rqsort _ [] r = r -rqsort _ [x] r = x:r -rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r - -rqpart :: (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 */ - --- | Sort a list by comparing the results of a key function applied to each --- element. @sortOn f@ is equivalent to @sortBy . comparing f@, but has the --- performance advantage of only evaluating @f@ once for each element in the --- input list. This is called the decorate-sort-undecorate paradigm, or --- Schwartzian transform. --- --- /Since: 4.8.0.0/ -sortOn :: Ord b => (a -> b) -> [a] -> [a] -sortOn f = - map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) - --- | 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] --- - --- Note [INLINE unfoldr] --- We treat unfoldr a little differently from some other forms for list fusion --- for two reasons: --- --- 1. We don't want to use a rule to rewrite a basic form to a fusible --- form because this would inline before constant floating. As Simon Peyton- --- Jones and others have pointed out, this could reduce sharing in some cases --- where sharing is beneficial. Thus we simply INLINE it, which is, for --- example, how enumFromTo::Int becomes eftInt. Unfortunately, we don't seem --- to get enough of an inlining discount to get a version of eftInt based on --- unfoldr to inline as readily as the usual one. We know that all the Maybe --- nonsense will go away, but the compiler does not. --- --- 2. The benefit of inlining unfoldr is likely to be huge in many common cases, --- even apart from list fusion. In particular, inlining unfoldr often --- allows GHC to erase all the Maybes. This appears to be critical if unfoldr --- is to be used in high-performance code. A small increase in code size --- in the relatively rare cases when this does not happen looks like a very --- small price to pay. --- --- Doing a back-and-forth dance doesn't seem to accomplish anything if the --- final form has to be inlined in any case. - -unfoldr :: (b -> Maybe (a, b)) -> b -> [a] - -{-# INLINE unfoldr #-} -- See Note [INLINE unfoldr] -unfoldr f b0 = build (\c n -> - let go b = case f b of - Just (a, new_b) -> a `c` go new_b - Nothing -> n - in go b0) - --- ----------------------------------------------------------------------------- - --- | A strict version of 'foldl'. -foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b -foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0 --- Implementing foldl' via foldr is only a good idea if the compiler can optimize --- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity! --- Also see #7994 - --- | '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] -> a -foldl1 f (x:xs) = foldl f x xs -foldl1 _ [] = errorEmptyList "foldl1" - --- | A strict version of 'foldl1' -foldl1' :: (a -> a -> a) -> [a] -> a -foldl1' f (x:xs) = foldl' f x xs -foldl1' _ [] = errorEmptyList "foldl1'" - --- ----------------------------------------------------------------------------- --- List sum and product - --- | 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 - -{-# INLINE sum #-} -sum = foldl (+) 0 -{-# INLINE product #-} -product = foldl (*) 1 - --- ----------------------------------------------------------------------------- --- 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 "" = [] --- 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. -lines s = cons (case break (== '\n') s of - (l, s') -> (l, case s' of - [] -> [] - _:s'' -> lines s'')) - where - cons ~(h, t) = h : t - --- | '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 +import Data.Foldable () +import Data.OldList diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs new file mode 100644 index 0000000000..fe0f38e284 --- /dev/null +++ b/libraries/base/Data/OldList.hs @@ -0,0 +1,1115 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, 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. +-- +----------------------------------------------------------------------------- + +module Data.OldList + ( + -- * Basic functions + + (++) + , head + , last + , tail + , init + , uncons + , null + , length + + -- * List transformations + , map + , reverse + + , intersperse + , intercalate + , transpose + + , subsequences + , permutations + + -- * Reducing lists (folds) + + , foldl + , foldl' + , foldl1 + , foldl1' + , foldr + , foldr1 + + -- ** Special folds + + , concat + , concatMap + , and + , or + , any + , all + , sum + , product + , maximum + , minimum + + -- * Building lists + + -- ** Scans + , scanl + , scanl1 + , scanr + , scanr1 + + -- ** Accumulating maps + , mapAccumL + , mapAccumR + + -- ** Infinite lists + , iterate + , repeat + , replicate + , cycle + + -- ** Unfolding + , unfoldr + + -- * Sublists + + -- ** Extracting sublists + , take + , drop + , splitAt + + , takeWhile + , dropWhile + , dropWhileEnd + , span + , break + + , stripPrefix + + , group + + , inits + , tails + + -- ** Predicates + , isPrefixOf + , isSuffixOf + , isInfixOf + + -- * Searching lists + + -- ** Searching by equality + , elem + , notElem + , lookup + + -- ** Searching with a predicate + , find + , filter + , partition + + -- * Indexing lists + -- | These functions treat a list @xs@ as a indexed collection, + -- with indices ranging from 0 to @'length' xs - 1@. + + , (!!) + + , elemIndex + , elemIndices + + , findIndex + , findIndices + + -- * Zipping and unzipping lists + + , zip + , zip3 + , zip4, zip5, zip6, zip7 + + , zipWith + , zipWith3 + , zipWith4, zipWith5, zipWith6, zipWith7 + + , unzip + , unzip3 + , unzip4, unzip5, unzip6, unzip7 + + -- * Special lists + + -- ** Functions on strings + , lines + , words + , unlines + , unwords + + -- ** \"Set\" operations + + , nub + + , delete + , (\\) + + , union + , intersect + + -- ** Ordered lists + , sort + , sortOn + , insert + + -- * 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 + , deleteBy + , deleteFirstsBy + , unionBy + , intersectBy + , groupBy + + -- *** User-supplied comparison (replacing an @Ord@ context) + -- | The function is assumed to define a total ordering. + , sortBy + , insertBy + , maximumBy + , minimumBy + + -- ** The \"@generic@\" operations + -- | The prefix \`@generic@\' indicates an overloaded function that + -- is a generalized version of a "Prelude" function. + + , genericLength + , genericTake + , genericDrop + , genericSplitAt + , genericIndex + , genericReplicate + + ) where + +import Data.Maybe +import Data.Char ( isSpace ) +import Data.Ord ( comparing ) +import Data.Tuple ( fst, snd ) + +import GHC.Num +import GHC.Real +import GHC.List +import GHC.Base + +infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps + +-- ----------------------------------------------------------------------------- +-- List functions + +-- | The 'dropWhileEnd' function drops the largest suffix of a list +-- in which the given predicate holds for all elements. For example: +-- +-- > dropWhileEnd isSpace "foo\n" == "foo" +-- > dropWhileEnd isSpace "foo bar" == "foo bar" +-- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined +-- +-- /Since: 4.5.0.0/ +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] + +-- | 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" == Nothing +stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] +stripPrefix [] ys = Just ys +stripPrefix (x:xs) (y:ys) + | x == y = stripPrefix xs ys +stripPrefix _ _ = 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 :: 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 +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 /* 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 + +-- | 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." == False +isInfixOf :: (Eq a) => [a] -> [a] -> Bool +isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) + +-- | /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 :: (Eq a) => [a] -> [a] +#ifdef USE_REPORT_PRELUDE +nub = nubBy (==) +#else +-- stolen from HBC +nub l = nub' l [] -- ' + where + nub' [] _ = [] -- ' + nub' (x:xs) ls -- ' + | x `elem` ls = nub' xs ls -- ' + | 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 [] = [] +nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs) +#else +nubBy eq l = nubBy' l [] + where + nubBy' [] _ = [] + nubBy' (y:ys) xs + | elem_by eq y xs = nubBy' ys xs + | 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 element +elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool +elem_by _ _ [] = False +elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs +#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 :: (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 + +-- | 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) + +-- | 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. +-- +-- > [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. If the element is found in both the first +-- and the second list, the element from the first list will be used. + +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 _ [] _ = [] +intersectBy _ _ [] = [] +intersectBy eq xs ys = [x | x <- xs, any (eq x) 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 _ [] = [] +intersperse sep (x:xs) = x : prependToAll sep xs + + +-- 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 _ [] = [] +prependToAll sep (x:xs) = sep : x : prependToAll sep xs + +-- | '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] +intercalate xs xss = concat (intersperse xs xss) + +-- | 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:_) <- 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 #-} +partition p xs = foldr (select p) ([],[]) xs + +select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) +select p x ~(ts,fs) | p x = (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 list +mapAccumL _ s [] = (s, []) +mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' 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 list +mapAccumR _ s [] = (s, []) +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 first position where it is 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') + = case cmp x y of + GT -> y : insertBy cmp x ys' + _ -> x : ys + +-- | '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 :: (Ord a) => [a] -> a +{-# INLINE [1] maximum #-} +maximum [] = errorEmptyList "maximum" +maximum xs = foldl1 max xs + +{-# 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 :: (Ord a) => [a] -> a +strictMaximum [] = errorEmptyList "maximum" +strictMaximum xs = foldl1' max xs + +-- | '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 :: (Ord a) => [a] -> a +{-# INLINE [1] minimum #-} +minimum [] = errorEmptyList "minimum" +minimum xs = foldl1 min xs + +{-# RULES + "minimumInt" minimum = (strictMinimum :: [Int] -> Int); + "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer) + #-} + +strictMinimum :: (Ord a) => [a] -> a +strictMinimum [] = errorEmptyList "minimum" +strictMinimum xs = foldl1' min xs + +-- | 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 maxBy xs + where + maxBy x y = case cmp x y of + 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 minBy xs + where + minBy x y = case cmp x y of + 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) => [a] -> i +{-# NOINLINE [1] genericLength #-} +genericLength [] = 0 +genericLength (_:l) = 1 + genericLength l + +{-# RULES + "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int); + "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer); + #-} + +strictGenericLength :: (Num i) => [b] -> i +strictGenericLength l = gl l 0 + where + gl [] a = a + gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a' + +-- | 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 n _ | n <= 0 = [] +genericTake _ [] = [] +genericTake n (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 :: (Integral i) => i -> [a] -> [a] +genericDrop n xs | n <= 0 = xs +genericDrop _ [] = [] +genericDrop n (_: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 :: (Integral i) => i -> [a] -> ([a], [a]) +genericSplitAt n xs | n <= 0 = ([],xs) +genericSplitAt _ [] = ([],[]) +genericSplitAt n (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 :: (Integral i) => [a] -> i -> a +genericIndex (x:_) 0 = x +genericIndex (_:xs) n + | n > 0 = genericIndex xs (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 :: (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)) + +-- | 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 + +-- | 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]] +inits xs = [] : case xs of + [] -> [] + x : xs' -> map (x :) (inits xs') + +-- | 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]] +tails xs = xs : case xs of + [] -> [] + _ : xs' -> tails xs' + +-- | The 'subsequences' function returns the list of all subsequences of the argument. +-- +-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"] +subsequences :: [a] -> [[a]] +subsequences xs = [] : nonEmptySubsequences xs + +-- | 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] : foldr f [] (nonEmptySubsequences xs) + where f ys r = 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]] +permutations xs0 = xs0 : perms xs0 [] + where + perms [] _ = [] + perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is) + where interleave xs r = let (_,zs) = interleave' id xs r in zs + interleave' _ [] r = (ts, r) + interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r + in (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 :: (Ord a) => [a] -> [a] + +-- | The 'sortBy' function is the non-overloaded version of 'sort'. +sortBy :: (a -> a -> Ordering) -> [a] -> [a] + +#ifdef USE_REPORT_PRELUDE +sort = sortBy compare +sortBy cmp = foldr (insertBy cmp) [] +#else + +{- +GHC's mergesort replaced by a better implementation, 24/12/2009. +This code originally contributed to the nhc12 compiler by Thomas Nordin +in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g. + http://www.mail-archive.com/haskell@haskell.org/msg01822.html +and 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 ticket http://ghc.haskell.org/trac/ghc/ticket/2143 +-} + +sort = sortBy compare +sortBy cmp = mergeAll . sequences + where + sequences (a:b:xs) + | a `cmp` b == GT = descending b [a] xs + | otherwise = ascending b (a:) xs + sequences xs = [xs] + + descending a as (b:bs) + | a `cmp` b == GT = descending b (a:as) bs + descending a as bs = (a:as): sequences bs + + ascending a as (b:bs) + | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs + ascending a as bs = as [a]: sequences bs + + mergeAll [x] = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs (a:b:xs) = merge a b: mergePairs xs + mergePairs xs = xs + + merge as@(a:as') bs@(b:bs') + | a `cmp` b == GT = b:merge as bs' + | otherwise = a:merge as' bs + merge [] bs = bs + merge as [] = as + +{- +sortBy cmp l = mergesort cmp l +sort l = mergesort compare l + +Quicksort 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 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' _ [] = [] +mergesort' _ [xs] = xs +mergesort' 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 xss + +merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +merge _ [] ys = ys +merge _ xs [] = xs +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] + + + +OLDER: qsort version + +-- qsort is stable and does not concatenate. +qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +qsort _ [] r = r +qsort _ [x] r = x:r +qsort cmp (x:xs) r = qpart cmp x xs [] [] r + +-- qpart partitions and sorts the sublists +qpart :: (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 elements +rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +rqsort _ [] r = r +rqsort _ [x] r = x:r +rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r + +rqpart :: (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 */ + +-- | Sort a list by comparing the results of a key function applied to each +-- element. @sortOn f@ is equivalent to @sortBy . comparing f@, but has the +-- performance advantage of only evaluating @f@ once for each element in the +-- input list. This is called the decorate-sort-undecorate paradigm, or +-- Schwartzian transform. +-- +-- /Since: 4.8.0.0/ +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = + map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) + +-- | 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] +-- + +-- Note [INLINE unfoldr] +-- We treat unfoldr a little differently from some other forms for list fusion +-- for two reasons: +-- +-- 1. We don't want to use a rule to rewrite a basic form to a fusible +-- form because this would inline before constant floating. As Simon Peyton- +-- Jones and others have pointed out, this could reduce sharing in some cases +-- where sharing is beneficial. Thus we simply INLINE it, which is, for +-- example, how enumFromTo::Int becomes eftInt. Unfortunately, we don't seem +-- to get enough of an inlining discount to get a version of eftInt based on +-- unfoldr to inline as readily as the usual one. We know that all the Maybe +-- nonsense will go away, but the compiler does not. +-- +-- 2. The benefit of inlining unfoldr is likely to be huge in many common cases, +-- even apart from list fusion. In particular, inlining unfoldr often +-- allows GHC to erase all the Maybes. This appears to be critical if unfoldr +-- is to be used in high-performance code. A small increase in code size +-- in the relatively rare cases when this does not happen looks like a very +-- small price to pay. +-- +-- Doing a back-and-forth dance doesn't seem to accomplish anything if the +-- final form has to be inlined in any case. + +unfoldr :: (b -> Maybe (a, b)) -> b -> [a] + +{-# INLINE unfoldr #-} -- See Note [INLINE unfoldr] +unfoldr f b0 = build (\c n -> + let go b = case f b of + Just (a, new_b) -> a `c` go new_b + Nothing -> n + in go b0) + +-- ----------------------------------------------------------------------------- + +-- | A strict version of 'foldl'. +foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b +foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0 +-- Implementing foldl' via foldr is only a good idea if the compiler can optimize +-- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity! +-- Also see #7994 + +-- | '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] -> a +foldl1 f (x:xs) = foldl f x xs +foldl1 _ [] = errorEmptyList "foldl1" + +-- | A strict version of 'foldl1' +foldl1' :: (a -> a -> a) -> [a] -> a +foldl1' f (x:xs) = foldl' f x xs +foldl1' _ [] = errorEmptyList "foldl1'" + +-- ----------------------------------------------------------------------------- +-- List sum and product + +-- | 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 + +{-# INLINE sum #-} +sum = foldl (+) 0 +{-# INLINE product #-} +product = foldl (*) 1 + +-- ----------------------------------------------------------------------------- +-- 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 "" = [] +-- 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. +lines s = cons (case break (== '\n') s of + (l, s') -> (l, case s' of + [] -> [] + _:s'' -> lines s'')) + where + cons ~(h, t) = h : t + +-- | '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 diff --git a/libraries/base/Data/OldTypeable/Internal.hs b/libraries/base/Data/OldTypeable/Internal.hs index d5e39c5688..76869400b1 100644 --- a/libraries/base/Data/OldTypeable/Internal.hs +++ b/libraries/base/Data/OldTypeable/Internal.hs @@ -57,7 +57,7 @@ module Data.OldTypeable.Internal {-# DEPRECATED "Use Data.Typeable.Internal inst import GHC.Base import GHC.Word import GHC.Show -import Data.List +import Data.OldList import GHC.Num import GHC.Real import GHC.IORef diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs index f57cf9b88a..f1bd45ebc5 100644 --- a/libraries/base/GHC/Event/Internal.hs +++ b/libraries/base/GHC/Event/Internal.hs @@ -23,13 +23,12 @@ module GHC.Event.Internal ) where import Data.Bits ((.|.), (.&.)) -import Data.List (foldl', intercalate) +import Data.OldList (foldl', filter, intercalate, null) import Foreign.C.Error (eINTR, getErrno, throwErrno) import System.Posix.Types (Fd) import GHC.Base import GHC.Num (Num(..)) import GHC.Show (Show(..)) -import GHC.List (filter, null) -- | An I\/O event. newtype Event = Event Int diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 6499da878a..aa0fc93484 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -81,7 +81,7 @@ import GHC.Stack import qualified Data.Coerce import Data.String -import Data.List +import Data.OldList import Data.Data import Data.Ord import qualified Debug.Trace diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 53414c95dc..72100d64f9 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -148,7 +148,7 @@ import Data.Maybe import Data.Traversable ( Traversable ) import Data.Tuple -import GHC.Base +import GHC.Base hiding ( foldr ) import Text.Read import GHC.Enum import GHC.Num diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 74297bb317..e1b6b327e5 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -136,6 +136,7 @@ Library Data.List Data.Maybe Data.Monoid + Data.OldList Data.OldTypeable Data.OldTypeable.Internal Data.Ord diff --git a/libraries/haskell2010 b/libraries/haskell2010 -Subproject 8d5301d03f2bb945ef3c7d975dcff3a4d93a0ad +Subproject 8ab509b674c73df2298d0f356b438d7db52896e diff --git a/libraries/haskell98 b/libraries/haskell98 -Subproject a97ea9fa765b4d8afe44d92470519719a4ede29 +Subproject 51ac61ffff22ad23b5c7edc3fcc503af1d88c74 diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout index f0a3f19a9c..057e9b298a 100644 --- a/testsuite/tests/ghci/scripts/ghci008.stdout +++ b/testsuite/tests/ghci/scripts/ghci008.stdout @@ -32,5 +32,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ -Data.List.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘Data.List’ +Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘Data.OldList’ diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index 1cbad60b7b..3abb14031a 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -160,4 +160,4 @@ main = do roll :: [Word8] -> Integer - roll = foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0 + roll = GHC.Base.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0 diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index e8e8f39a6b..38f013e222 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -7,5 +7,6 @@ T1972.hs:14:3: Warning: This binding for ‘mapAccumL’ shadows the existing bindings defined at T1972.hs:16:1 imported from ‘Data.List’ at T1972.hs:7:1-16 + (and originally defined in ‘Data.OldList’) T1972.hs:20:10: Warning: Defined but not used: ‘c’ diff --git a/testsuite/tests/rename/should_compile/T7963a.hs b/testsuite/tests/rename/should_compile/T7963a.hs index 2a21a18181..fc8004d0ee 100644 --- a/testsuite/tests/rename/should_compile/T7963a.hs +++ b/testsuite/tests/rename/should_compile/T7963a.hs @@ -1,4 +1,7 @@ module T7963a where +import Prelude () +import Data.OldList + unlines = concat diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr index 38ffb08b60..80fad233b0 100644 --- a/testsuite/tests/rename/should_fail/rnfail040.stderr +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr @@ -3,6 +3,7 @@ rnfail040.hs:7:12: Conflicting exports for ‘nub’: ‘module M’ exports ‘M.nub’ imported from ‘Data.List’ at rnfail040.hs:10:2-22 + (and originally defined in ‘Data.OldList’) ‘module M’ exports ‘T.nub’ imported from ‘Rnfail040_A’ at rnfail040.hs:11:2-24 (and originally defined at Rnfail040_A.hs:2:3-5) |