diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/Data/Foldable.hs | 4 | ||||
| -rw-r--r-- | libraries/base/Data/List.hs | 1402 | ||||
| -rw-r--r-- | libraries/base/Data/OldList.hs | 1580 | ||||
| -rw-r--r-- | libraries/base/Foreign/Marshal/Pool.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Internal/Types.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Manager.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Windows.hsc | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Exception.hs | 2 | ||||
| -rwxr-xr-x | libraries/base/GHC/Exts.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/Encoding/CodePage.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/Exception.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/OldList.hs | 29 | ||||
| -rw-r--r-- | libraries/base/GHC/Windows.hs | 2 | ||||
| -rw-r--r-- | libraries/base/base.cabal | 2 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 3 | ||||
| -rw-r--r-- | libraries/base/tests/T9586.hs | 1 | ||||
| -rw-r--r-- | libraries/base/tests/list001.hs | 3 |
17 files changed, 1633 insertions, 1409 deletions
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 24bf13566a..c9e48bb868 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -2454,7 +2454,9 @@ elements in a single pass. -- The more general methods of the 'Foldable' class are now exported by the -- "Prelude" in place of the original List-specific methods (see the -- [FTP Proposal](https://wiki.haskell.org/Foldable_Traversable_In_Prelude)). --- The List-specific variants are still available in "Data.List". +-- The List-specific variants are for now still available in "GHC.OldList", but +-- that module is intended only as a transitional aid, and may be removed in +-- the future. -- -- Surprises can arise from the @Foldable@ instance of the 2-tuple @(a,)@ which -- now behaves as a 1-element @Foldable@ container in its second slot. In diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs index e7ce57aa75..4474e51268 100644 --- a/libraries/base/Data/List.hs +++ b/libraries/base/Data/List.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, - MagicHash, BangPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | @@ -212,16 +211,15 @@ module Data.List ) where -import Data.Maybe -import Data.Bits ( (.&.) ) -import Data.Char ( isSpace ) -import Data.Ord ( comparing ) -import Data.Tuple ( fst, snd ) +import Data.Foldable +import Data.Traversable -import GHC.Num -import GHC.Real -import GHC.List -import GHC.Base +import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find, + foldl, foldl1, foldl', foldr, foldr1, mapAccumL, + mapAccumR, maximum, maximumBy, minimum, minimumBy, + length, notElem, null, or, product, sum ) + +import GHC.Base ( Bool(..), Eq((==)), otherwise ) -- | The 'isSubsequenceOf' function takes two lists and returns 'True' if all -- the elements of the first list occur, in order, in the second. The @@ -244,1385 +242,3 @@ isSubsequenceOf [] _ = True isSubsequenceOf _ [] = False isSubsequenceOf a@(x:a') (y:b) | x == y = isSubsequenceOf a' b | otherwise = isSubsequenceOf a b - -infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#cpp-and-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) [] - --- | \(\mathcal{O}(\min(m,n))\). 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 4 [0..] --- Just 4 -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 'o' "Hello World" --- [4,7] -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 (> 4) [1..] --- Just 5 --- --- >>> find (< 0) [1..10] --- Nothing -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 isSpace "Hello World!" --- Just 5 -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 (`elem` "aeiou") "Hello World!" --- [1,4,7] -findIndices :: (a -> Bool) -> [a] -> [Int] -#if defined(USE_REPORT_PRELUDE) -findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] -#else --- Efficient definition, adapted from Data.Sequence --- (Note that making this INLINABLE instead of INLINE allows --- 'findIndex' to fuse, fixing #15426.) -{-# INLINABLE findIndices #-} -findIndices p ls = build $ \c n -> - let go x r k | p x = I# k `c` r (k +# 1#) - | otherwise = r (k +# 1#) - in foldr go (\_ -> n) ls 0# -#endif /* USE_REPORT_PRELUDE */ - --- | \(\mathcal{O}(\min(m,n))\). The 'isPrefixOf' function takes two lists and --- returns 'True' iff the first list is a prefix of the second. --- --- >>> "Hello" `isPrefixOf` "Hello World!" --- True --- --- >>> "Hello" `isPrefixOf` "Wello Horld!" --- False -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. The second list must be --- finite. --- --- >>> "ld!" `isSuffixOf` "Hello World!" --- True --- --- >>> "World" `isSuffixOf` "Hello World!" --- False -isSuffixOf :: (Eq a) => [a] -> [a] -> Bool -ns `isSuffixOf` hs = maybe False id $ do - delta <- dropLengthMaybe ns hs - return $ ns == dropLength delta hs - -- Since dropLengthMaybe ns hs succeeded, we know that (if hs is finite) - -- length ns + length delta = length hs - -- so dropping the length of delta from hs will yield a suffix exactly - -- the length of ns. - --- A version of drop that drops the length of the first argument from the --- second argument. If xs is longer than ys, xs will not be traversed in its --- entirety. dropLength is also generally faster than (drop . length) --- Both this and dropLengthMaybe could be written as folds over their first --- arguments, but this reduces clarity with no benefit to isSuffixOf. --- --- >>> dropLength "Hello" "Holla world" --- " world" --- --- >>> dropLength [1..] [1,2,3] --- [] -dropLength :: [a] -> [b] -> [b] -dropLength [] y = y -dropLength _ [] = [] -dropLength (_:x') (_:y') = dropLength x' y' - --- A version of dropLength that returns Nothing if the second list runs out of --- elements before the first. --- --- >>> dropLengthMaybe [1..] [1,2,3] --- Nothing -dropLengthMaybe :: [a] -> [b] -> Maybe [b] -dropLengthMaybe [] y = Just y -dropLengthMaybe _ [] = Nothing -dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y' - --- | The 'isInfixOf' function takes two lists and returns 'True' --- iff the first list is contained, wholly and intact, --- anywhere within the second. --- --- >>> 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) - --- | \(\mathcal{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 [1,2,3,4,3,2,1,2,4,3,5] --- [1,2,3,4,5] -nub :: (Eq a) => [a] -> [a] -nub = nubBy (==) - --- | The 'nubBy' function behaves just like 'nub', except it uses a --- user-supplied equality predicate instead of the overloaded '==' --- function. --- --- >>> nubBy (\x y -> mod x 3 == mod y 3) [1,2,4,5,6] --- [1,2,6] -nubBy :: (a -> a -> Bool) -> [a] -> [a] -#if defined(USE_REPORT_PRELUDE) -nubBy eq [] = [] -nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs) -#else --- stolen from HBC -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 (prelude) implementation, --- and that this order is different from how `elem` calls (==). --- See #2528, #3280 and #7913. --- '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) = x `eq` y || elem_by eq y xs -#endif - - --- | \(\mathcal{O}(n)\). '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 (==) - --- | \(\mathcal{O}(n)\). The 'deleteBy' function behaves like 'delete', but --- takes a user-supplied equality predicate. --- --- >>> deleteBy (<=) 4 [1..10] --- [1,2,3,5,6,7,8,9,10] -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. --- --- >>> "Hello World!" \\ "ell W" --- "Hoorld!" --- --- 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] - --- | \(\mathcal{O}(n)\). 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 ", " ["Lorem", "ipsum", "dolor"] --- "Lorem, ipsum, dolor" -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]] --- --- If some of the rows are shorter than the following rows, their elements are skipped: --- --- >>> transpose [[10,11],[20],[],[30,31,32]] --- [[10,20,30],[11,31],[32]] -transpose :: [[a]] -> [[a]] -transpose [] = [] -transpose ([] : xss) = transpose xss -transpose ((x : xs) : xss) = combine x hds xs tls - where - -- We tie the calculations of heads and tails together - -- to prevent heads from leaking into tails and vice versa. - -- unzip makes the selector thunk arrangements we need to - -- ensure everything gets cleaned up properly. - (hds, tls) = unzip [(hd, tl) | hd : tl <- xss] - combine y h ys t = (y:h) : transpose (ys:t) - {-# NOINLINE combine #-} - {- Implementation note: - If the bottom part of the function was written as such: - - ``` - transpose ((x : xs) : xss) = (x:hds) : transpose (xs:tls) - where - (hds,tls) = hdstls - hdstls = unzip [(hd, tl) | hd : tl <- xss] - {-# NOINLINE hdstls #-} - ``` - Here are the steps that would take place: - - 1. We allocate a thunk, `hdstls`, representing the result of unzipping. - 2. We allocate selector thunks, `hds` and `tls`, that deconstruct `hdstls`. - 3. Install `hds` as the tail of the result head and pass `xs:tls` to - the recursive call in the result tail. - - Once optimised, this code would amount to: - - ``` - transpose ((x : xs) : xss) = (x:hds) : (let tls = snd hdstls in transpose (xs:tls)) - where - hds = fst hdstls - hdstls = unzip [(hd, tl) | hd : tl <- xss] - {-# NOINLINE hdstls #-} - ``` - - In particular, GHC does not produce the `tls` selector thunk immediately; - rather, it waits to do so until the tail of the result is actually demanded. - So when `hds` is demanded, that does not resolve `snd hdstls`; the tail of the - result keeps `hdstls` alive. - - By writing `combine` and making it NOINLINE, we prevent GHC from delaying - the selector thunk allocation, requiring that `hds` and `tls` are actually - allocated to be passed to `combine`. - -} - - --- | The 'partition' function takes a predicate and 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 (`elem` "aeiou") "Hello World!" --- ("eoo","Hll Wrld!") -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 -{-# NOINLINE [1] mapAccumL #-} -mapAccumL _ s [] = (s, []) -mapAccumL f s (x:xs) = (s'',y:ys) - where (s', y ) = f s x - (s'',ys) = mapAccumL f s' xs - -{-# RULES -"mapAccumL" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s -"mapAccumLList" [1] forall f s xs . foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs - #-} - -pairWithNil :: acc -> (acc, [y]) -{-# INLINE [0] pairWithNil #-} -pairWithNil x = (x, []) - -mapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y]) -{-# INLINE [0] mapAccumLF #-} -mapAccumLF f = \x r -> oneShot (\s -> - let (s', y) = f s x - (s'', ys) = r s' - in (s'', y:ys)) - -- See Note [Left folds via right fold] - - --- | 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 - --- | \(\mathcal{O}(n)\). 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 4 [1,2,3,5,6,7] --- [1,2,3,4,5,6,7] -insert :: Ord a => a -> [a] -> [a] -insert e ls = insertBy (compare) e ls - --- | \(\mathcal{O}(n)\). 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 - --- | 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. --- --- We can use this to find the longest entry of a list: --- --- >>> maximumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"] --- "Longest" -maximumBy :: (a -> a -> Ordering) -> [a] -> a -maximumBy cmp = fromMaybe (errorWithoutStackTrace "maximumBy: empty structure") - . foldl' max' Nothing - where - max' mx y = Just $! case mx of - Nothing -> y - Just x -> case cmp x y of - GT -> x - _ -> y -{-# INLINEABLE maximumBy #-} - - --- | 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. --- --- We can use this to find the shortest entry of a list: --- --- >>> minimumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"] --- "!" -minimumBy :: (a -> a -> Ordering) -> [a] -> a -minimumBy cmp = fromMaybe (errorWithoutStackTrace "minimumBy: empty structure") - . foldl' min' Nothing - where - min' mx y = Just $! case mx of - Nothing -> y - Just x -> case cmp x y of - GT -> y - _ -> x -{-# INLINEABLE minimumBy #-} - --- | \(\mathcal{O}(n)\). 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 [1, 2, 3] :: Int --- 3 --- >>> genericLength [1, 2, 3] :: Float --- 3.0 --- --- Users should take care to pick a return type that is wide enough to contain --- the full length of the list. If the width is insufficient, the overflow --- behaviour will depend on the @(+)@ implementation in the selected 'Num' --- instance. The following example overflows because the actual list length --- of 200 lies outside of the 'Int8' range of @-128..127@. --- --- >>> genericLength [1..200] :: Int8 --- -56 -genericLength :: (Num i) => [a] -> i -{-# NOINLINE [2] genericLength #-} - -- Give time for the RULEs for (++) to fire in InitialPhase - -- It's recursive, so won't inline anyway, - -- but saying so is more explicit -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 = errorWithoutStackTrace "List.genericIndex: negative argument." -genericIndex _ _ = errorWithoutStackTrace "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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# INLINE zip4 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# INLINE zip5 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# INLINE zip6 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# INLINE zip7 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# NOINLINE [1] zipWith4 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# NOINLINE [1] zipWith5 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# NOINLINE [1] zipWith6 #-} -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'. --- It is capable of list fusion, but it is restricted to its --- first list argument and its resulting list. -{-# NOINLINE [1] zipWith7 #-} -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 _ _ _ _ _ _ _ _ = [] - -{- -Functions and rules for fusion of zipWith4, zipWith5, zipWith6 and zipWith7. -The principle is the same as for zip and zipWith in GHC.List: -Turn zipWithX into a version in which the first argument and the result -can be fused. Turn it back into the original function if no fusion happens. --} - -{-# INLINE [0] zipWith4FB #-} -- See Note [Inline FB functions] -zipWith4FB :: (e->xs->xs') -> (a->b->c->d->e) -> - a->b->c->d->xs->xs' -zipWith4FB cons func = \a b c d r -> (func a b c d) `cons` r - -{-# INLINE [0] zipWith5FB #-} -- See Note [Inline FB functions] -zipWith5FB :: (f->xs->xs') -> (a->b->c->d->e->f) -> - a->b->c->d->e->xs->xs' -zipWith5FB cons func = \a b c d e r -> (func a b c d e) `cons` r - -{-# INLINE [0] zipWith6FB #-} -- See Note [Inline FB functions] -zipWith6FB :: (g->xs->xs') -> (a->b->c->d->e->f->g) -> - a->b->c->d->e->f->xs->xs' -zipWith6FB cons func = \a b c d e f r -> (func a b c d e f) `cons` r - -{-# INLINE [0] zipWith7FB #-} -- See Note [Inline FB functions] -zipWith7FB :: (h->xs->xs') -> (a->b->c->d->e->f->g->h) -> - a->b->c->d->e->f->g->xs->xs' -zipWith7FB cons func = \a b c d e f g r -> (func a b c d e f g) `cons` r - -{-# INLINE [0] foldr4 #-} -foldr4 :: (a->b->c->d->e->e) -> - e->[a]->[b]->[c]->[d]->e -foldr4 k z = go - where - go (a:as) (b:bs) (c:cs) (d:ds) = k a b c d (go as bs cs ds) - go _ _ _ _ = z - -{-# INLINE [0] foldr5 #-} -foldr5 :: (a->b->c->d->e->f->f) -> - f->[a]->[b]->[c]->[d]->[e]->f -foldr5 k z = go - where - go (a:as) (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (go as bs cs ds es) - go _ _ _ _ _ = z - -{-# INLINE [0] foldr6 #-} -foldr6 :: (a->b->c->d->e->f->g->g) -> - g->[a]->[b]->[c]->[d]->[e]->[f]->g -foldr6 k z = go - where - go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = k a b c d e f ( - go as bs cs ds es fs) - go _ _ _ _ _ _ = z - -{-# INLINE [0] foldr7 #-} -foldr7 :: (a->b->c->d->e->f->g->h->h) -> - h->[a]->[b]->[c]->[d]->[e]->[f]->[g]->h -foldr7 k z = go - where - go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = k a b c d e f g ( - go as bs cs ds es fs gs) - go _ _ _ _ _ _ _ = z - -foldr4_left :: (a->b->c->d->e->f)-> - f->a->([b]->[c]->[d]->e)-> - [b]->[c]->[d]->f -foldr4_left k _z a r (b:bs) (c:cs) (d:ds) = k a b c d (r bs cs ds) -foldr4_left _ z _ _ _ _ _ = z - -foldr5_left :: (a->b->c->d->e->f->g)-> - g->a->([b]->[c]->[d]->[e]->f)-> - [b]->[c]->[d]->[e]->g -foldr5_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (r bs cs ds es) -foldr5_left _ z _ _ _ _ _ _ = z - -foldr6_left :: (a->b->c->d->e->f->g->h)-> - h->a->([b]->[c]->[d]->[e]->[f]->g)-> - [b]->[c]->[d]->[e]->[f]->h -foldr6_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = - k a b c d e f (r bs cs ds es fs) -foldr6_left _ z _ _ _ _ _ _ _ = z - -foldr7_left :: (a->b->c->d->e->f->g->h->i)-> - i->a->([b]->[c]->[d]->[e]->[f]->[g]->h)-> - [b]->[c]->[d]->[e]->[f]->[g]->i -foldr7_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = - k a b c d e f g (r bs cs ds es fs gs) -foldr7_left _ z _ _ _ _ _ _ _ _ = z - -{-# RULES - -"foldr4/left" forall k z (g::forall b.(a->b->b)->b->b). - foldr4 k z (build g) = g (foldr4_left k z) (\_ _ _ -> z) -"foldr5/left" forall k z (g::forall b.(a->b->b)->b->b). - foldr5 k z (build g) = g (foldr5_left k z) (\_ _ _ _ -> z) -"foldr6/left" forall k z (g::forall b.(a->b->b)->b->b). - foldr6 k z (build g) = g (foldr6_left k z) (\_ _ _ _ _ -> z) -"foldr7/left" forall k z (g::forall b.(a->b->b)->b->b). - foldr7 k z (build g) = g (foldr7_left k z) (\_ _ _ _ _ _ -> z) - -"zipWith4" [~1] forall f as bs cs ds. - zipWith4 f as bs cs ds = build (\c n -> - foldr4 (zipWith4FB c f) n as bs cs ds) -"zipWith5" [~1] forall f as bs cs ds es. - zipWith5 f as bs cs ds es = build (\c n -> - foldr5 (zipWith5FB c f) n as bs cs ds es) -"zipWith6" [~1] forall f as bs cs ds es fs. - zipWith6 f as bs cs ds es fs = build (\c n -> - foldr6 (zipWith6FB c f) n as bs cs ds es fs) -"zipWith7" [~1] forall f as bs cs ds es fs gs. - zipWith7 f as bs cs ds es fs gs = build (\c n -> - foldr7 (zipWith7FB c f) n as bs cs ds es fs gs) - -"zipWith4List" [1] forall f. foldr4 (zipWith4FB (:) f) [] = zipWith4 f -"zipWith5List" [1] forall f. foldr5 (zipWith5FB (:) f) [] = zipWith5 f -"zipWith6List" [1] forall f. foldr6 (zipWith6FB (:) f) [] = zipWith6 f -"zipWith7List" [1] forall f. foldr7 (zipWith7FB (:) f) [] = zipWith7 f - - #-} - -{- - -Note [Inline @unzipN@ functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The inline principle for @unzip{4,5,6,7}@ is the same as 'unzip'/'unzip3' in -"GHC.List". -The 'unzip'/'unzip3' functions are inlined so that the `foldr` with which they -are defined has an opportunity to fuse. - -As such, since there are not any differences between 2/3-ary 'unzip' and its -n-ary counterparts below aside from the number of arguments, the `INLINE` -pragma should be replicated in the @unzipN@ functions below as well. - --} - --- | The 'unzip4' function takes a list of quadruples and returns four --- lists, analogous to 'unzip'. -{-# INLINE unzip4 #-} --- Inline so that fusion with `foldr` has an opportunity to fire. --- See Note [Inline @unzipN@ functions] above. -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'. -{-# INLINE unzip5 #-} --- Inline so that fusion with `foldr` has an opportunity to fire. --- See Note [Inline @unzipN@ functions] above. -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'. -{-# INLINE unzip6 #-} --- Inline so that fusion with `foldr` has an opportunity to fire. --- See Note [Inline @unzipN@ functions] above. -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'. -{-# INLINE unzip7 #-} --- Inline so that fusion with `foldr` has an opportunity to fire. --- See Note [Inline @unzipN@ functions] above. -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 (xs ++ _|_) = inits xs ++ _|_@ --- --- In particular, --- @inits _|_ = [] : _|_@ -inits :: [a] -> [[a]] -inits = map toListSB . scanl' snocSB emptySB -{-# NOINLINE inits #-} - --- We do not allow inits to inline, because it plays havoc with Call Arity --- if it fuses with a consumer, and it would generally lead to serious --- loss of sharing if allowed to fuse with a producer. - --- | \(\mathcal{O}(n)\). 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]] -{-# INLINABLE tails #-} -tails lst = build (\c n -> - let tailsGo xs = xs `c` case xs of - [] -> n - _ : xs' -> tailsGo xs' - in tailsGo lst) - --- | 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. --- --- Elements are arranged from lowest to highest, keeping duplicates in --- the order they appeared in the input. --- --- >>> sort [1,6,4,3,2,5] --- [1,2,3,4,5,6] -sort :: (Ord a) => [a] -> [a] - --- | The 'sortBy' function is the non-overloaded version of 'sort'. --- --- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")] --- [(1,"Hello"),(2,"world"),(4,"!")] -sortBy :: (a -> a -> Ordering) -> [a] -> [a] - -#if defined(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 https://gitlab.haskell.org/ghc/ghc/issues/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 = let !x = as [a] - in x : sequences bs - - mergeAll [x] = x - mergeAll xs = mergeAll (mergePairs xs) - - mergePairs (a:b:xs) = let !x = merge a b - in x : 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. --- --- Elements are arranged from lowest to highest, keeping duplicates in --- the order they appeared in the input. --- --- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")] --- [(1,"Hello"),(2,"world"),(4,"!")] --- --- @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)) - --- | Produce singleton list. --- --- >>> singleton True --- [True] --- --- @since 4.15.0.0 --- -singleton :: a -> [a] -singleton x = [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) - --- ----------------------------------------------------------------------------- --- Functions on strings - --- | Splits the argument into a list of /lines/ stripped of their terminating --- @\n@ characters. The @\n@ terminator is optional in a final non-empty --- line of the argument string. --- --- For example: --- --- >>> lines "" -- empty input contains no lines --- [] --- --- >>> lines "\n" -- single empty line --- [""] --- --- >>> lines "one" -- single unterminated line --- ["one"] --- --- >>> lines "one\n" -- single non-empty line --- ["one"] --- --- >>> lines "one\n\n" -- second line is empty --- ["one",""] --- --- >>> lines "one\ntwo" -- second line is unterminated --- ["one","two"] --- --- >>> lines "one\ntwo\n" -- two non-empty lines --- ["one","two"] --- --- When the argument string is empty, or ends in a @\n@ character, it can be --- recovered by passing the result of 'lines' to the 'unlines' function. --- Otherwise, 'unlines' appends the missing terminating @\n@. This makes --- @unlines . lines@ /idempotent/: --- --- > (unlines . lines) . (unlines . lines) = (unlines . lines) --- -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 - --- | Appends a @\n@ character to each input string, then concatenates the --- results. Equivalent to @'foldMap' (\s -> s '++' "\n")@. --- --- >>> unlines ["Hello", "World", "!"] --- "Hello\nWorld\n!\n" --- --- = Note --- --- @'unlines' '.' 'lines' '/=' 'id'@ when the input is not @\n@-terminated: --- --- >>> unlines . lines $ "foo\nbar" --- "foo\nbar\n" -unlines :: [String] -> String -#if defined(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 - --- | Separates the argument into pieces, with (non-empty sequences of) word --- separator characters. A \'word separator character\' is anything for which --- 'isSpace' returns 'True'. --- --- None of the final results contain any word separator characters. A sequence --- of leading, or trailing, word separator characters will be ignored. --- --- >>> words "Lorem \r\t ipsum\n\n\ndolor\n\t" --- ["Lorem","ipsum","dolor"] --- --- = Note --- --- @'unwords' '.' 'words' '/=' 'id'@. Consider the example below: --- --- >>> unwords . words $ "foo bar" --- "foo bar" -words :: String -> [String] -{-# NOINLINE [1] words #-} -words s = case dropWhile {-partain:Char.-}isSpace s of - "" -> [] - s' -> w : words s'' - where (w, s'') = - break {-partain:Char.-}isSpace s' - -{-# RULES -"words" [~1] forall s . words s = build (\c n -> wordsFB c n s) -"wordsList" [1] wordsFB (:) [] = words - #-} -wordsFB :: ([Char] -> b -> b) -> b -> String -> b -{-# INLINE [0] wordsFB #-} -- See Note [Inline FB functions] in GHC.List -wordsFB c n = go - where - go s = case dropWhile isSpace s of - "" -> n - s' -> w `c` go s'' - where (w, s'') = break isSpace s' - --- | Links together adjacent strings in the argument with Space characters. --- Equivalent to @'intercalate' " "@. --- --- >>> unwords ["Lorem", "ipsum", "dolor"] --- "Lorem ipsum dolor" --- --- = Note --- --- @'unwords' '.' 'words' '/=' 'id'@. Consider the example below: --- --- >>> unwords . words $ "foo bar" --- "foo bar" -unwords :: [String] -> String -#if defined(USE_REPORT_PRELUDE) -unwords [] = "" -unwords ws = foldr1 (\w s -> w ++ ' ':s) ws -#else --- Here's a lazier version that can get the last element of a --- _|_-terminated list. -{-# NOINLINE [1] unwords #-} -unwords [] = "" -unwords (w:ws) = w ++ go ws - where - go [] = "" - go (v:vs) = ' ' : (v ++ go vs) - --- In general, the foldr-based version is probably slightly worse --- than the HBC version, because it adds an extra space and then takes --- it back off again. But when it fuses, it reduces allocation. How much --- depends entirely on the average word length--it's most effective when --- the words are on the short side. -{-# RULES -"unwords" [~1] forall ws . - unwords ws = tailUnwords (foldr unwordsFB "" ws) -"unwordsList" [1] forall ws . - tailUnwords (foldr unwordsFB "" ws) = unwords ws - #-} - -{-# INLINE [0] tailUnwords #-} -tailUnwords :: String -> String -tailUnwords [] = [] -tailUnwords (_:xs) = xs - -{-# INLINE [0] unwordsFB #-} -unwordsFB :: String -> String -> String -unwordsFB w r = ' ' : w ++ r -#endif - -{- A "SnocBuilder" is a version of Chris Okasaki's banker's queue that supports -toListSB instead of uncons. In single-threaded use, its performance -characteristics are similar to John Hughes's functional difference lists, but -likely somewhat worse. In heavily persistent settings, however, it does much -better, because it takes advantage of sharing. The banker's queue guarantees -(amortized) O(1) snoc and O(1) uncons, meaning that we can think of toListSB as -an O(1) conversion to a list-like structure a constant factor slower than -normal lists--we pay the O(n) cost incrementally as we consume the list. Using -functional difference lists, on the other hand, we would have to pay the whole -cost up front for each output list. -} - -{- We store a front list, a rear list, and the length of the queue. Because we -only snoc onto the queue and never uncons, we know it's time to rotate when the -length of the queue plus 1 is a power of 2. Note that we rely on the value of -the length field only for performance. In the unlikely event of overflow, the -performance will suffer but the semantics will remain correct. -} - -data SnocBuilder a = SnocBuilder {-# UNPACK #-} !Word [a] [a] - -{- Smart constructor that rotates the builder when lp is one minus a power of -2. Does not rotate very small builders because doing so is not worth the -trouble. The lp < 255 test goes first because the power-of-2 test gives awful -branch prediction for very small n (there are 5 powers of 2 between 1 and -16). Putting the well-predicted lp < 255 test first avoids branching on the -power-of-2 test until powers of 2 have become sufficiently rare to be predicted -well. -} - -{-# INLINE sb #-} -sb :: Word -> [a] -> [a] -> SnocBuilder a -sb lp f r - | lp < 255 || (lp .&. (lp + 1)) /= 0 = SnocBuilder lp f r - | otherwise = SnocBuilder lp (f ++ reverse r) [] - --- The empty builder - -emptySB :: SnocBuilder a -emptySB = SnocBuilder 0 [] [] - --- Add an element to the end of a queue. - -snocSB :: SnocBuilder a -> a -> SnocBuilder a -snocSB (SnocBuilder lp f r) x = sb (lp + 1) f (x:r) - --- Convert a builder to a list - -toListSB :: SnocBuilder a -> [a] -toListSB (SnocBuilder _ f r) = f ++ reverse r diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs new file mode 100644 index 0000000000..2a50de3ee5 --- /dev/null +++ b/libraries/base/Data/OldList.hs @@ -0,0 +1,1580 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, + MagicHash, BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- 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 + , singleton + , 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 + , scanl' + , scanl1 + , scanr + , scanr1 + + -- ** Accumulating maps + , mapAccumL + , mapAccumR + + -- ** Infinite lists + , iterate + , 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.Bits ( (.&.) ) +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://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#cpp-and-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) [] + +-- | \(\mathcal{O}(\min(m,n))\). 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 4 [0..] +-- Just 4 +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 'o' "Hello World" +-- [4,7] +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 (> 4) [1..] +-- Just 5 +-- +-- >>> find (< 0) [1..10] +-- Nothing +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 isSpace "Hello World!" +-- Just 5 +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 (`elem` "aeiou") "Hello World!" +-- [1,4,7] +findIndices :: (a -> Bool) -> [a] -> [Int] +#if defined(USE_REPORT_PRELUDE) +findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] +#else +-- Efficient definition, adapted from Data.Sequence +-- (Note that making this INLINABLE instead of INLINE allows +-- 'findIndex' to fuse, fixing #15426.) +{-# INLINABLE findIndices #-} +findIndices p ls = build $ \c n -> + let go x r k | p x = I# k `c` r (k +# 1#) + | otherwise = r (k +# 1#) + in foldr go (\_ -> n) ls 0# +#endif /* USE_REPORT_PRELUDE */ + +-- | \(\mathcal{O}(\min(m,n))\). The 'isPrefixOf' function takes two lists and +-- returns 'True' iff the first list is a prefix of the second. +-- +-- >>> "Hello" `isPrefixOf` "Hello World!" +-- True +-- +-- >>> "Hello" `isPrefixOf` "Wello Horld!" +-- False +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. The second list must be +-- finite. +-- +-- >>> "ld!" `isSuffixOf` "Hello World!" +-- True +-- +-- >>> "World" `isSuffixOf` "Hello World!" +-- False +isSuffixOf :: (Eq a) => [a] -> [a] -> Bool +ns `isSuffixOf` hs = maybe False id $ do + delta <- dropLengthMaybe ns hs + return $ ns == dropLength delta hs + -- Since dropLengthMaybe ns hs succeeded, we know that (if hs is finite) + -- length ns + length delta = length hs + -- so dropping the length of delta from hs will yield a suffix exactly + -- the length of ns. + +-- A version of drop that drops the length of the first argument from the +-- second argument. If xs is longer than ys, xs will not be traversed in its +-- entirety. dropLength is also generally faster than (drop . length) +-- Both this and dropLengthMaybe could be written as folds over their first +-- arguments, but this reduces clarity with no benefit to isSuffixOf. +-- +-- >>> dropLength "Hello" "Holla world" +-- " world" +-- +-- >>> dropLength [1..] [1,2,3] +-- [] +dropLength :: [a] -> [b] -> [b] +dropLength [] y = y +dropLength _ [] = [] +dropLength (_:x') (_:y') = dropLength x' y' + +-- A version of dropLength that returns Nothing if the second list runs out of +-- elements before the first. +-- +-- >>> dropLengthMaybe [1..] [1,2,3] +-- Nothing +dropLengthMaybe :: [a] -> [b] -> Maybe [b] +dropLengthMaybe [] y = Just y +dropLengthMaybe _ [] = Nothing +dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y' + +-- | The 'isInfixOf' function takes two lists and returns 'True' +-- iff the first list is contained, wholly and intact, +-- anywhere within the second. +-- +-- >>> 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) + +-- | \(\mathcal{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 [1,2,3,4,3,2,1,2,4,3,5] +-- [1,2,3,4,5] +nub :: (Eq a) => [a] -> [a] +nub = nubBy (==) + +-- | The 'nubBy' function behaves just like 'nub', except it uses a +-- user-supplied equality predicate instead of the overloaded '==' +-- function. +-- +-- >>> nubBy (\x y -> mod x 3 == mod y 3) [1,2,4,5,6] +-- [1,2,6] +nubBy :: (a -> a -> Bool) -> [a] -> [a] +#if defined(USE_REPORT_PRELUDE) +nubBy eq [] = [] +nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs) +#else +-- stolen from HBC +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 (prelude) implementation, +-- and that this order is different from how `elem` calls (==). +-- See #2528, #3280 and #7913. +-- '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) = x `eq` y || elem_by eq y xs +#endif + + +-- | \(\mathcal{O}(n)\). '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 (==) + +-- | \(\mathcal{O}(n)\). The 'deleteBy' function behaves like 'delete', but +-- takes a user-supplied equality predicate. +-- +-- >>> deleteBy (<=) 4 [1..10] +-- [1,2,3,5,6,7,8,9,10] +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. +-- +-- >>> "Hello World!" \\ "ell W" +-- "Hoorld!" +-- +-- 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] + +-- | \(\mathcal{O}(n)\). 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 ", " ["Lorem", "ipsum", "dolor"] +-- "Lorem, ipsum, dolor" +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]] +-- +-- If some of the rows are shorter than the following rows, their elements are skipped: +-- +-- >>> transpose [[10,11],[20],[],[30,31,32]] +-- [[10,20,30],[11,31],[32]] +transpose :: [[a]] -> [[a]] +transpose [] = [] +transpose ([] : xss) = transpose xss +transpose ((x : xs) : xss) = combine x hds xs tls + where + -- We tie the calculations of heads and tails together + -- to prevent heads from leaking into tails and vice versa. + -- unzip makes the selector thunk arrangements we need to + -- ensure everything gets cleaned up properly. + (hds, tls) = unzip [(hd, tl) | hd : tl <- xss] + combine y h ys t = (y:h) : transpose (ys:t) + {-# NOINLINE combine #-} + {- Implementation note: + If the bottom part of the function was written as such: + + ``` + transpose ((x : xs) : xss) = (x:hds) : transpose (xs:tls) + where + (hds,tls) = hdstls + hdstls = unzip [(hd, tl) | hd : tl <- xss] + {-# NOINLINE hdstls #-} + ``` + Here are the steps that would take place: + + 1. We allocate a thunk, `hdstls`, representing the result of unzipping. + 2. We allocate selector thunks, `hds` and `tls`, that deconstruct `hdstls`. + 3. Install `hds` as the tail of the result head and pass `xs:tls` to + the recursive call in the result tail. + + Once optimised, this code would amount to: + + ``` + transpose ((x : xs) : xss) = (x:hds) : (let tls = snd hdstls in transpose (xs:tls)) + where + hds = fst hdstls + hdstls = unzip [(hd, tl) | hd : tl <- xss] + {-# NOINLINE hdstls #-} + ``` + + In particular, GHC does not produce the `tls` selector thunk immediately; + rather, it waits to do so until the tail of the result is actually demanded. + So when `hds` is demanded, that does not resolve `snd hdstls`; the tail of the + result keeps `hdstls` alive. + + By writing `combine` and making it NOINLINE, we prevent GHC from delaying + the selector thunk allocation, requiring that `hds` and `tls` are actually + allocated to be passed to `combine`. + -} + + +-- | The 'partition' function takes a predicate and 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 (`elem` "aeiou") "Hello World!" +-- ("eoo","Hll Wrld!") +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 +{-# NOINLINE [1] mapAccumL #-} +mapAccumL _ s [] = (s, []) +mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' xs + +{-# RULES +"mapAccumL" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s +"mapAccumLList" [1] forall f s xs . foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs + #-} + +pairWithNil :: acc -> (acc, [y]) +{-# INLINE [0] pairWithNil #-} +pairWithNil x = (x, []) + +mapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y]) +{-# INLINE [0] mapAccumLF #-} +mapAccumLF f = \x r -> oneShot (\s -> + let (s', y) = f s x + (s'', ys) = r s' + in (s'', y:ys)) + -- See Note [Left folds via right fold] + + +-- | 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 + +-- | \(\mathcal{O}(n)\). 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 4 [1,2,3,5,6,7] +-- [1,2,3,4,5,6,7] +insert :: Ord a => a -> [a] -> [a] +insert e ls = insertBy (compare) e ls + +-- | \(\mathcal{O}(n)\). 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 + +-- | 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. +-- +-- We can use this to find the longest entry of a list: +-- +-- >>> maximumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"] +-- "Longest" +maximumBy :: (a -> a -> Ordering) -> [a] -> a +maximumBy _ [] = errorWithoutStackTrace "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. +-- +-- We can use this to find the shortest entry of a list: +-- +-- >>> minimumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"] +-- "!" +minimumBy :: (a -> a -> Ordering) -> [a] -> a +minimumBy _ [] = errorWithoutStackTrace "List.minimumBy: empty list" +minimumBy cmp xs = foldl1 minBy xs + where + minBy x y = case cmp x y of + GT -> y + _ -> x + +-- | \(\mathcal{O}(n)\). 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 [1, 2, 3] :: Int +-- 3 +-- >>> genericLength [1, 2, 3] :: Float +-- 3.0 +-- +-- Users should take care to pick a return type that is wide enough to contain +-- the full length of the list. If the width is insufficient, the overflow +-- behaviour will depend on the @(+)@ implementation in the selected 'Num' +-- instance. The following example overflows because the actual list length +-- of 200 lies outside of the 'Int8' range of @-128..127@. +-- +-- >>> genericLength [1..200] :: Int8 +-- -56 +genericLength :: (Num i) => [a] -> i +{-# NOINLINE [2] genericLength #-} + -- Give time for the RULEs for (++) to fire in InitialPhase + -- It's recursive, so won't inline anyway, + -- but saying so is more explicit +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 = errorWithoutStackTrace "List.genericIndex: negative argument." +genericIndex _ _ = errorWithoutStackTrace "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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# INLINE zip4 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# INLINE zip5 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# INLINE zip6 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# INLINE zip7 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# NOINLINE [1] zipWith4 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# NOINLINE [1] zipWith5 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# NOINLINE [1] zipWith6 #-} +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'. +-- It is capable of list fusion, but it is restricted to its +-- first list argument and its resulting list. +{-# NOINLINE [1] zipWith7 #-} +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 _ _ _ _ _ _ _ _ = [] + +{- +Functions and rules for fusion of zipWith4, zipWith5, zipWith6 and zipWith7. +The principle is the same as for zip and zipWith in GHC.List: +Turn zipWithX into a version in which the first argument and the result +can be fused. Turn it back into the original function if no fusion happens. +-} + +{-# INLINE [0] zipWith4FB #-} -- See Note [Inline FB functions] +zipWith4FB :: (e->xs->xs') -> (a->b->c->d->e) -> + a->b->c->d->xs->xs' +zipWith4FB cons func = \a b c d r -> (func a b c d) `cons` r + +{-# INLINE [0] zipWith5FB #-} -- See Note [Inline FB functions] +zipWith5FB :: (f->xs->xs') -> (a->b->c->d->e->f) -> + a->b->c->d->e->xs->xs' +zipWith5FB cons func = \a b c d e r -> (func a b c d e) `cons` r + +{-# INLINE [0] zipWith6FB #-} -- See Note [Inline FB functions] +zipWith6FB :: (g->xs->xs') -> (a->b->c->d->e->f->g) -> + a->b->c->d->e->f->xs->xs' +zipWith6FB cons func = \a b c d e f r -> (func a b c d e f) `cons` r + +{-# INLINE [0] zipWith7FB #-} -- See Note [Inline FB functions] +zipWith7FB :: (h->xs->xs') -> (a->b->c->d->e->f->g->h) -> + a->b->c->d->e->f->g->xs->xs' +zipWith7FB cons func = \a b c d e f g r -> (func a b c d e f g) `cons` r + +{-# INLINE [0] foldr4 #-} +foldr4 :: (a->b->c->d->e->e) -> + e->[a]->[b]->[c]->[d]->e +foldr4 k z = go + where + go (a:as) (b:bs) (c:cs) (d:ds) = k a b c d (go as bs cs ds) + go _ _ _ _ = z + +{-# INLINE [0] foldr5 #-} +foldr5 :: (a->b->c->d->e->f->f) -> + f->[a]->[b]->[c]->[d]->[e]->f +foldr5 k z = go + where + go (a:as) (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (go as bs cs ds es) + go _ _ _ _ _ = z + +{-# INLINE [0] foldr6 #-} +foldr6 :: (a->b->c->d->e->f->g->g) -> + g->[a]->[b]->[c]->[d]->[e]->[f]->g +foldr6 k z = go + where + go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = k a b c d e f ( + go as bs cs ds es fs) + go _ _ _ _ _ _ = z + +{-# INLINE [0] foldr7 #-} +foldr7 :: (a->b->c->d->e->f->g->h->h) -> + h->[a]->[b]->[c]->[d]->[e]->[f]->[g]->h +foldr7 k z = go + where + go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = k a b c d e f g ( + go as bs cs ds es fs gs) + go _ _ _ _ _ _ _ = z + +foldr4_left :: (a->b->c->d->e->f)-> + f->a->([b]->[c]->[d]->e)-> + [b]->[c]->[d]->f +foldr4_left k _z a r (b:bs) (c:cs) (d:ds) = k a b c d (r bs cs ds) +foldr4_left _ z _ _ _ _ _ = z + +foldr5_left :: (a->b->c->d->e->f->g)-> + g->a->([b]->[c]->[d]->[e]->f)-> + [b]->[c]->[d]->[e]->g +foldr5_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (r bs cs ds es) +foldr5_left _ z _ _ _ _ _ _ = z + +foldr6_left :: (a->b->c->d->e->f->g->h)-> + h->a->([b]->[c]->[d]->[e]->[f]->g)-> + [b]->[c]->[d]->[e]->[f]->h +foldr6_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = + k a b c d e f (r bs cs ds es fs) +foldr6_left _ z _ _ _ _ _ _ _ = z + +foldr7_left :: (a->b->c->d->e->f->g->h->i)-> + i->a->([b]->[c]->[d]->[e]->[f]->[g]->h)-> + [b]->[c]->[d]->[e]->[f]->[g]->i +foldr7_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = + k a b c d e f g (r bs cs ds es fs gs) +foldr7_left _ z _ _ _ _ _ _ _ _ = z + +{-# RULES + +"foldr4/left" forall k z (g::forall b.(a->b->b)->b->b). + foldr4 k z (build g) = g (foldr4_left k z) (\_ _ _ -> z) +"foldr5/left" forall k z (g::forall b.(a->b->b)->b->b). + foldr5 k z (build g) = g (foldr5_left k z) (\_ _ _ _ -> z) +"foldr6/left" forall k z (g::forall b.(a->b->b)->b->b). + foldr6 k z (build g) = g (foldr6_left k z) (\_ _ _ _ _ -> z) +"foldr7/left" forall k z (g::forall b.(a->b->b)->b->b). + foldr7 k z (build g) = g (foldr7_left k z) (\_ _ _ _ _ _ -> z) + +"zipWith4" [~1] forall f as bs cs ds. + zipWith4 f as bs cs ds = build (\c n -> + foldr4 (zipWith4FB c f) n as bs cs ds) +"zipWith5" [~1] forall f as bs cs ds es. + zipWith5 f as bs cs ds es = build (\c n -> + foldr5 (zipWith5FB c f) n as bs cs ds es) +"zipWith6" [~1] forall f as bs cs ds es fs. + zipWith6 f as bs cs ds es fs = build (\c n -> + foldr6 (zipWith6FB c f) n as bs cs ds es fs) +"zipWith7" [~1] forall f as bs cs ds es fs gs. + zipWith7 f as bs cs ds es fs gs = build (\c n -> + foldr7 (zipWith7FB c f) n as bs cs ds es fs gs) + +"zipWith4List" [1] forall f. foldr4 (zipWith4FB (:) f) [] = zipWith4 f +"zipWith5List" [1] forall f. foldr5 (zipWith5FB (:) f) [] = zipWith5 f +"zipWith6List" [1] forall f. foldr6 (zipWith6FB (:) f) [] = zipWith6 f +"zipWith7List" [1] forall f. foldr7 (zipWith7FB (:) f) [] = zipWith7 f + + #-} + +{- + +Note [Inline @unzipN@ functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The inline principle for @unzip{4,5,6,7}@ is the same as 'unzip'/'unzip3' in +"GHC.List". +The 'unzip'/'unzip3' functions are inlined so that the `foldr` with which they +are defined has an opportunity to fuse. + +As such, since there are not any differences between 2/3-ary 'unzip' and its +n-ary counterparts below aside from the number of arguments, the `INLINE` +pragma should be replicated in the @unzipN@ functions below as well. + +-} + +-- | The 'unzip4' function takes a list of quadruples and returns four +-- lists, analogous to 'unzip'. +{-# INLINE unzip4 #-} +-- Inline so that fusion with `foldr` has an opportunity to fire. +-- See Note [Inline @unzipN@ functions] above. +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'. +{-# INLINE unzip5 #-} +-- Inline so that fusion with `foldr` has an opportunity to fire. +-- See Note [Inline @unzipN@ functions] above. +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'. +{-# INLINE unzip6 #-} +-- Inline so that fusion with `foldr` has an opportunity to fire. +-- See Note [Inline @unzipN@ functions] above. +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'. +{-# INLINE unzip7 #-} +-- Inline so that fusion with `foldr` has an opportunity to fire. +-- See Note [Inline @unzipN@ functions] above. +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 (xs ++ _|_) = inits xs ++ _|_@ +-- +-- In particular, +-- @inits _|_ = [] : _|_@ +inits :: [a] -> [[a]] +inits = map toListSB . scanl' snocSB emptySB +{-# NOINLINE inits #-} + +-- We do not allow inits to inline, because it plays havoc with Call Arity +-- if it fuses with a consumer, and it would generally lead to serious +-- loss of sharing if allowed to fuse with a producer. + +-- | \(\mathcal{O}(n)\). 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]] +{-# INLINABLE tails #-} +tails lst = build (\c n -> + let tailsGo xs = xs `c` case xs of + [] -> n + _ : xs' -> tailsGo xs' + in tailsGo lst) + +-- | 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. +-- +-- Elements are arranged from lowest to highest, keeping duplicates in +-- the order they appeared in the input. +-- +-- >>> sort [1,6,4,3,2,5] +-- [1,2,3,4,5,6] +sort :: (Ord a) => [a] -> [a] + +-- | The 'sortBy' function is the non-overloaded version of 'sort'. +-- +-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")] +-- [(1,"Hello"),(2,"world"),(4,"!")] +sortBy :: (a -> a -> Ordering) -> [a] -> [a] + +#if defined(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 https://gitlab.haskell.org/ghc/ghc/issues/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 = let !x = as [a] + in x : sequences bs + + mergeAll [x] = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs (a:b:xs) = let !x = merge a b + in x : 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. +-- +-- Elements are arranged from lowest to highest, keeping duplicates in +-- the order they appeared in the input. +-- +-- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")] +-- [(1,"Hello"),(2,"world"),(4,"!")] +-- +-- @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)) + +-- | Produce singleton list. +-- +-- >>> singleton True +-- [True] +-- +-- @since 4.15.0.0 +-- +singleton :: a -> [a] +singleton x = [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) + +-- ----------------------------------------------------------------------------- +-- Functions on strings + +-- | Splits the argument into a list of /lines/ stripped of their terminating +-- @\n@ characters. The @\n@ terminator is optional in a final non-empty +-- line of the argument string. +-- +-- For example: +-- +-- >>> lines "" -- empty input contains no lines +-- [] +-- +-- >>> lines "\n" -- single empty line +-- [""] +-- +-- >>> lines "one" -- single unterminated line +-- ["one"] +-- +-- >>> lines "one\n" -- single non-empty line +-- ["one"] +-- +-- >>> lines "one\n\n" -- second line is empty +-- ["one",""] +-- +-- >>> lines "one\ntwo" -- second line is unterminated +-- ["one","two"] +-- +-- >>> lines "one\ntwo\n" -- two non-empty lines +-- ["one","two"] +-- +-- When the argument string is empty, or ends in a @\n@ character, it can be +-- recovered by passing the result of 'lines' to the 'unlines' function. +-- Otherwise, 'unlines' appends the missing terminating @\n@. This makes +-- @unlines . lines@ /idempotent/: +-- +-- > (unlines . lines) . (unlines . lines) = (unlines . lines) +-- +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 + +-- | Appends a @\n@ character to each input string, then concatenates the +-- results. Equivalent to @'foldMap' (\s -> s '++' "\n")@. +-- +-- >>> unlines ["Hello", "World", "!"] +-- "Hello\nWorld\n!\n" +-- +-- = Note +-- +-- @'unlines' '.' 'lines' '/=' 'id'@ when the input is not @\n@-terminated: +-- +-- >>> unlines . lines $ "foo\nbar" +-- "foo\nbar\n" +unlines :: [String] -> String +#if defined(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 "Lorem ipsum\ndolor" +-- ["Lorem","ipsum","dolor"] +words :: String -> [String] +{-# NOINLINE [1] words #-} +words s = case dropWhile {-partain:Char.-}isSpace s of + "" -> [] + s' -> w : words s'' + where (w, s'') = + break {-partain:Char.-}isSpace s' + +{-# RULES +"words" [~1] forall s . words s = build (\c n -> wordsFB c n s) +"wordsList" [1] wordsFB (:) [] = words + #-} +wordsFB :: ([Char] -> b -> b) -> b -> String -> b +{-# INLINE [0] wordsFB #-} -- See Note [Inline FB functions] in GHC.List +wordsFB c n = go + where + go s = case dropWhile isSpace s of + "" -> n + s' -> w `c` go s'' + where (w, s'') = break isSpace s' + +-- | 'unwords' is an inverse operation to 'words'. +-- It joins words with separating spaces. +-- +-- >>> unwords ["Lorem", "ipsum", "dolor"] +-- "Lorem ipsum dolor" +unwords :: [String] -> String +#if defined(USE_REPORT_PRELUDE) +unwords [] = "" +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws +#else +-- Here's a lazier version that can get the last element of a +-- _|_-terminated list. +{-# NOINLINE [1] unwords #-} +unwords [] = "" +unwords (w:ws) = w ++ go ws + where + go [] = "" + go (v:vs) = ' ' : (v ++ go vs) + +-- In general, the foldr-based version is probably slightly worse +-- than the HBC version, because it adds an extra space and then takes +-- it back off again. But when it fuses, it reduces allocation. How much +-- depends entirely on the average word length--it's most effective when +-- the words are on the short side. +{-# RULES +"unwords" [~1] forall ws . + unwords ws = tailUnwords (foldr unwordsFB "" ws) +"unwordsList" [1] forall ws . + tailUnwords (foldr unwordsFB "" ws) = unwords ws + #-} + +{-# INLINE [0] tailUnwords #-} +tailUnwords :: String -> String +tailUnwords [] = [] +tailUnwords (_:xs) = xs + +{-# INLINE [0] unwordsFB #-} +unwordsFB :: String -> String -> String +unwordsFB w r = ' ' : w ++ r +#endif + +{- A "SnocBuilder" is a version of Chris Okasaki's banker's queue that supports +toListSB instead of uncons. In single-threaded use, its performance +characteristics are similar to John Hughes's functional difference lists, but +likely somewhat worse. In heavily persistent settings, however, it does much +better, because it takes advantage of sharing. The banker's queue guarantees +(amortized) O(1) snoc and O(1) uncons, meaning that we can think of toListSB as +an O(1) conversion to a list-like structure a constant factor slower than +normal lists--we pay the O(n) cost incrementally as we consume the list. Using +functional difference lists, on the other hand, we would have to pay the whole +cost up front for each output list. -} + +{- We store a front list, a rear list, and the length of the queue. Because we +only snoc onto the queue and never uncons, we know it's time to rotate when the +length of the queue plus 1 is a power of 2. Note that we rely on the value of +the length field only for performance. In the unlikely event of overflow, the +performance will suffer but the semantics will remain correct. -} + +data SnocBuilder a = SnocBuilder {-# UNPACK #-} !Word [a] [a] + +{- Smart constructor that rotates the builder when lp is one minus a power of +2. Does not rotate very small builders because doing so is not worth the +trouble. The lp < 255 test goes first because the power-of-2 test gives awful +branch prediction for very small n (there are 5 powers of 2 between 1 and +16). Putting the well-predicted lp < 255 test first avoids branching on the +power-of-2 test until powers of 2 have become sufficiently rare to be predicted +well. -} + +{-# INLINE sb #-} +sb :: Word -> [a] -> [a] -> SnocBuilder a +sb lp f r + | lp < 255 || (lp .&. (lp + 1)) /= 0 = SnocBuilder lp f r + | otherwise = SnocBuilder lp (f ++ reverse r) [] + +-- The empty builder + +emptySB :: SnocBuilder a +emptySB = SnocBuilder 0 [] [] + +-- Add an element to the end of a queue. + +snocSB :: SnocBuilder a -> a -> SnocBuilder a +snocSB (SnocBuilder lp f r) x = sb (lp + 1) f (x:r) + +-- Convert a builder to a list + +toListSB :: SnocBuilder a -> [a] +toListSB (SnocBuilder _ f r) = f ++ reverse r diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs index c0bbcacf94..8d704c1a2d 100644 --- a/libraries/base/Foreign/Marshal/Pool.hs +++ b/libraries/base/Foreign/Marshal/Pool.hs @@ -54,7 +54,7 @@ import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) -import Data.List ( delete ) +import Data.OldList ( delete ) import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Marshal.Error ( throwIf ) diff --git a/libraries/base/GHC/Event/Internal/Types.hs b/libraries/base/GHC/Event/Internal/Types.hs index 1ff02efa53..e02ff36b61 100644 --- a/libraries/base/GHC/Event/Internal/Types.hs +++ b/libraries/base/GHC/Event/Internal/Types.hs @@ -33,7 +33,7 @@ module GHC.Event.Internal.Types , Timeout(..) ) where -import Data.List (foldl', filter, intercalate, null) +import Data.OldList (foldl', filter, intercalate, null) import Data.Bits ((.|.), (.&.)) import Data.Semigroup.Internal (stimesMonoid) diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index b086cbe748..88bf450426 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -67,7 +67,7 @@ import Data.Functor (void) import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) import Data.Maybe (maybe) -import Data.List (partition) +import Data.OldList (partition) import GHC.Arr (Array, (!), listArray) import GHC.Base import GHC.Conc.Sync (yield) diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc index dd0b2d9db9..b97250e897 100644 --- a/libraries/base/GHC/Event/Windows.hsc +++ b/libraries/base/GHC/Event/Windows.hsc @@ -104,7 +104,7 @@ import GHC.Exception as E import GHC.IORef import GHC.Maybe import GHC.Word -import Data.List (deleteBy) +import GHC.OldList (deleteBy) import Foreign import qualified GHC.Event.Array as A import GHC.Base diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index a2a457891a..abaa308aec 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -37,7 +37,7 @@ module GHC.Exception import GHC.Base import GHC.Show import GHC.Stack.Types -import Data.List (intercalate, reverse) -- TODO: remove import list? +import GHC.OldList import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 29f6bdaca0..b9d632095c 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -143,7 +143,7 @@ import GHC.Stack import qualified Data.Coerce import Data.String -import Data.List (all, sortBy, span) +import Data.OldList import Data.Data import Data.Ord import Data.Version ( Version(..), makeVersion ) diff --git a/libraries/base/GHC/IO/Encoding/CodePage.hs b/libraries/base/GHC/IO/Encoding/CodePage.hs index 597e426ca1..39430c5ee0 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage.hs @@ -27,7 +27,7 @@ import GHC.IO.Encoding.Types import GHC.IO.Buffer import Data.Bits import Data.Maybe -import Data.List (lookup) +import Data.OldList (lookup) import qualified GHC.IO.Encoding.CodePage.API as API import GHC.IO.Encoding.CodePage.Table diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 3909132687..758a84bf32 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -54,7 +54,7 @@ import GHC.Show import GHC.Read import GHC.Exception import GHC.IO.Handle.Types -import Data.List ( intercalate ) +import GHC.OldList ( intercalate ) import {-# SOURCE #-} GHC.Stack.CCS import Foreign.C.Types diff --git a/libraries/base/GHC/OldList.hs b/libraries/base/GHC/OldList.hs new file mode 100644 index 0000000000..cfb7314636 --- /dev/null +++ b/libraries/base/GHC/OldList.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.OldList +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- This legacy module provides access to the list-specialised operations +-- of "Data.List". This module may go away again in future GHC versions and +-- is provided as transitional tool to access some of the list-specialised +-- operations that had to be generalised due to the implementation of the +-- <https://wiki.haskell.org/Foldable_Traversable_In_Prelude Foldable/Traversable-in-Prelude Proposal (FTP)>. +-- +-- If the operations needed are available in "GHC.List", it's +-- recommended to avoid importing this module and use "GHC.List" +-- instead for now. +-- +-- @since 4.8.0.0 +----------------------------------------------------------------------------- + +module GHC.OldList (module Data.OldList) where + +import Data.OldList diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs index 2cee2d8908..be0c3837a9 100644 --- a/libraries/base/GHC/Windows.hs +++ b/libraries/base/GHC/Windows.hs @@ -76,7 +76,7 @@ module GHC.Windows ( import Data.Bits (finiteBitSize, shiftL, shiftR, (.|.), (.&.)) import Data.Char -import Data.List (dropWhileEnd) +import Data.OldList import Data.Maybe import Data.Word import Data.Int diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index bb62f89ddd..79d481ada6 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -254,6 +254,7 @@ Library GHC.MVar GHC.Natural GHC.Num + GHC.OldList GHC.OverloadedLabels GHC.Pack GHC.Profiling @@ -324,6 +325,7 @@ Library Control.Monad.ST.Imp Control.Monad.ST.Lazy.Imp Data.Functor.Utils + Data.OldList Data.Semigroup.Internal Data.Typeable.Internal Foreign.ForeignPtr.Imp diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index aab8234e47..7ddc112af4 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -79,9 +79,6 @@ * `fromInteger :: Integer -> Float/Double` now consistently round to the nearest value, with ties to even. - * Functions in `Data.List` are specialized to list. - `Data.OldList` and `GHC.List` modules are removed. - * Add `GHC.TypeError` module to contain functionality related to custom type errors. `TypeError` is re-exported from `GHC.TypeLits` for backwards compatibility. diff --git a/libraries/base/tests/T9586.hs b/libraries/base/tests/T9586.hs index d496c30e49..cf1c35625c 100644 --- a/libraries/base/tests/T9586.hs +++ b/libraries/base/tests/T9586.hs @@ -4,6 +4,7 @@ module XPrelude (module X) where import Control.Monad as X import Data.Foldable as X +import Data.List as X import Data.Monoid as X import Data.Traversable as X import Prelude as X diff --git a/libraries/base/tests/list001.hs b/libraries/base/tests/list001.hs index 6ba7725a56..8f3babe607 100644 --- a/libraries/base/tests/list001.hs +++ b/libraries/base/tests/list001.hs @@ -2,9 +2,6 @@ {-# OPTIONS_GHC -Wno-compat-unqualified-imports #-} module Main where -import Prelude (Int, String, print, putStr, error, - Eq (..), Ord (..), Num (..), Bool (..)) - import Data.List import Control.Exception |