diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-08-23 13:30:44 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-03 10:12:04 -0500 |
commit | 81082cf410fdcdbf10627f5334cc1dba1a9a2e06 (patch) | |
tree | 49bb8038aab46f97ea2414ffc60652800614d4c2 | |
parent | 0e274c39bf836d5bb846f5fa08649c75f85326ac (diff) | |
download | haskell-81082cf410fdcdbf10627f5334cc1dba1a9a2e06.tar.gz |
Revert "Data.List specialization to []"
This reverts commit bddecda1a4c96da21e3f5211743ce5e4c78793a2.
This implements the first step in the plan formulated in #20025 to
improve the communication and migration strategy for the proposed
changes to Data.List.
Requires changing the haddock submodule to update the test output.
47 files changed, 1694 insertions, 1464 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 768e43fca1..806a9e4dbf 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -594,8 +594,6 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by = -- | Issue a warning if the user imports Data.List without either an import -- list or `qualified`. This is part of the migration plan for the -- `Data.List.singleton` proposal. See #17244. --- --- Currently not used for anything. warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM () warnUnqualifiedImport decl iface = when bad_import $ do @@ -627,8 +625,7 @@ warnUnqualifiedImport decl iface = ] -- Modules for which we warn if we see unqualified imports - -- Currently empty. - qualifiedMods = mkModuleSet [] + qualifiedMods = mkModuleSet [ dATA_LIST ] warnRedundantSourceImport :: ModuleName -> TcRnMessage diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 6ddeb66e41..db91a760de 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -275,8 +275,13 @@ of ``-W(no-)*``. :since: 8.10 Warns on qualified imports of core library modules which are subject to - change in future GHC releases. Currently there are no modules - covered by this warning. + change in future GHC releases. Currently the following modules are covered + by this warning: + + - ``Data.List`` due to the future addition of ``Data.List.singleton`` and + specialisation of exports to the ``[]`` type. See the + `mailing list <https://groups.google.com/forum/#!topic/haskell-core-libraries/q3zHLmzBa5E>`_ + for details. This warning can be addressed by either adding an explicit import list or using a ``qualified`` import. 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 diff --git a/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs index b13aece069..a138615b2d 100644 --- a/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs +++ b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs @@ -19,7 +19,7 @@ import Data.Map (Map) import Data.Bifunctor (second) import Packed.Bytes (Bytes) import qualified Data.Char -import qualified Data.List as L +import qualified GHC.OldList as L import qualified Packed.Bytes.Parser as P import qualified Packed.Bytes as B import qualified Data.Semigroup as SG diff --git a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs index d4538506df..224e03f75d 100644 --- a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs +++ b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs @@ -27,7 +27,7 @@ import Data.Primitive (ByteArray(..)) import Data.Word (Word8) import Control.Monad.ST (runST, ST) import qualified Data.Primitive as PM -import qualified Data.List as L +import qualified GHC.OldList as L data Bytes = Bytes {-# UNPACK #-} !ByteArray -- payload diff --git a/testsuite/tests/codeGen/should_run/T20137/T20137.hs b/testsuite/tests/codeGen/should_run/T20137/T20137.hs index 4786e27778..2fa33b5cd9 100644 --- a/testsuite/tests/codeGen/should_run/T20137/T20137.hs +++ b/testsuite/tests/codeGen/should_run/T20137/T20137.hs @@ -5,7 +5,7 @@ module Main where -import Data.List +import Data.List (foldl') import Data.Bits import GHC.Ptr import Foreign.Ptr diff --git a/testsuite/tests/ghci/scripts/T10663.script b/testsuite/tests/ghci/scripts/T10663.script index 406d0ca7ee..30f003050b 100644 --- a/testsuite/tests/ghci/scripts/T10663.script +++ b/testsuite/tests/ghci/scripts/T10663.script @@ -1,2 +1,2 @@ -import Data.List; xs = sort [2, 1] -xs
\ No newline at end of file +import Data.List (sort); xs = sort [2, 1] +xs diff --git a/testsuite/tests/ghci/scripts/T14828.stdout b/testsuite/tests/ghci/scripts/T14828.stdout index aeab49d226..90ba8f3c13 100644 --- a/testsuite/tests/ghci/scripts/T14828.stdout +++ b/testsuite/tests/ghci/scripts/T14828.stdout @@ -8,5 +8,5 @@ pure :: Applicative f => a -> f a pure = (_t4::Applicative f => a -> f a) mempty = (_t5::Monoid a => a) mappend = (_t6::Monoid a => a -> a -> a) -foldl' = (_t7::(b -> a -> b) -> b -> [a] -> b) +foldl' = (_t7::Foldable t => (b -> a -> b) -> b -> t a -> b) f = (_t8::(forall a. a -> a) -> b -> b) diff --git a/testsuite/tests/ghci/scripts/T20473a.script b/testsuite/tests/ghci/scripts/T20473a.script index d84edb4129..73e2355564 100644 --- a/testsuite/tests/ghci/scripts/T20473a.script +++ b/testsuite/tests/ghci/scripts/T20473a.script @@ -1,5 +1,5 @@ :{ -import Data.List +import Data.List (sort) xs :: [Int] xs = sort [2,1] diff --git a/testsuite/tests/ghci/scripts/T20473b.script b/testsuite/tests/ghci/scripts/T20473b.script index 4fb53badf3..e43ac8b6f7 100644 --- a/testsuite/tests/ghci/scripts/T20473b.script +++ b/testsuite/tests/ghci/scripts/T20473b.script @@ -1,2 +1,2 @@ -import Data.List; import Data.Function +import Data.List (sort); import Data.Function on (==) sort [1,2] [2,1] diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout index 812dffc36a..3f62f3f7f2 100644 --- a/testsuite/tests/ghci/scripts/ghci008.stdout +++ b/testsuite/tests/ghci/scripts/ghci008.stdout @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ -Data.List.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘Data.List’ +base-4.13.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.13.0.0:Data.OldList’ diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs index c1ed84d0fa..3abdd5da87 100644 --- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs +++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedLists, TypeFamilies, RebindableSyntax #-} import Prelude +import Data.List main = do print [] print [0,3..20] diff --git a/testsuite/tests/parser/should_compile/DumpSemis.hs b/testsuite/tests/parser/should_compile/DumpSemis.hs index 9f2f9629d8..23ccd717a3 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.hs +++ b/testsuite/tests/parser/should_compile/DumpSemis.hs @@ -2,7 +2,7 @@ module DumpSemis where -- Make sure we get all the semicolons in statements ;;;; ;; -import Data.List +import Data.List () ; ; ; import Data.Kind ; ;; diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr index b5836252ad..8f7b2252d8 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.stderr +++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr @@ -47,7 +47,7 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpSemis.hs:5:1-16 } + { DumpSemis.hs:5:1-19 } (UnchangedAnchor)) (AnnListItem [(AddSemiAnn @@ -57,7 +57,7 @@ ,(AddSemiAnn (EpaSpan { DumpSemis.hs:6:5 }))]) (EpaComments - [])) { DumpSemis.hs:5:1-16 }) + [])) { DumpSemis.hs:5:1-19 }) (ImportDecl (EpAnn (Anchor @@ -82,7 +82,25 @@ (NotQualified) (False) (Nothing) - (Nothing))) + (Just + ((,) + (False) + (L + (SrcSpanAnn (EpAnn + (Anchor + { DumpSemis.hs:5:18-19 } + (UnchangedAnchor)) + (AnnList + (Nothing) + (Just + (AddEpAnn AnnOpenP (EpaSpan { DumpSemis.hs:5:18 }))) + (Just + (AddEpAnn AnnCloseP (EpaSpan { DumpSemis.hs:5:19 }))) + [] + []) + (EpaComments + [])) { DumpSemis.hs:5:18-19 }) + []))))) ,(L (SrcSpanAnn (EpAnn (Anchor diff --git a/testsuite/tests/perf/compiler/T16875.hs b/testsuite/tests/perf/compiler/T16875.hs index 0ba3c17d5b..dcf93ad5ac 100644 --- a/testsuite/tests/perf/compiler/T16875.hs +++ b/testsuite/tests/perf/compiler/T16875.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-compat-unqualified-imports #-} module T16875 where import Control.Applicative diff --git a/testsuite/tests/perf/compiler/T16875.stderr b/testsuite/tests/perf/compiler/T16875.stderr index af6954792e..95c54362c3 100644 --- a/testsuite/tests/perf/compiler/T16875.stderr +++ b/testsuite/tests/perf/compiler/T16875.stderr @@ -1,12 +1,12 @@ -T16875.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)] +T16875.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: p Where: ‘p’ is a rigid type variable bound by the inferred type of a :: p - at T16875.hs:12:1-5 + at T16875.hs:13:1-5 • In an equation for ‘a’: a = _ - • Relevant bindings include a :: p (bound at T16875.hs:12:1) + • Relevant bindings include a :: p (bound at T16875.hs:13:1) Valid hole fits include a :: forall {p}. p with a - (defined at T16875.hs:12:1) + (defined at T16875.hs:13:1) diff --git a/testsuite/tests/perf/should_run/T5949.hs b/testsuite/tests/perf/should_run/T5949.hs index 7a65d582ce..f3f8cce0d3 100644 --- a/testsuite/tests/perf/should_run/T5949.hs +++ b/testsuite/tests/perf/should_run/T5949.hs @@ -1,4 +1,3 @@ -import Prelude hiding (foldr) import Data.List (foldr) {- diff --git a/testsuite/tests/rename/should_fail/T17244A.hs b/testsuite/tests/rename/should_compile/T17244A.hs index e0152d95d2..290120affd 100644 --- a/testsuite/tests/rename/should_fail/T17244A.hs +++ b/testsuite/tests/rename/should_compile/T17244A.hs @@ -2,8 +2,7 @@ module T17244A (hello) where --- This should NOT warn with -Wcompat-unqualified-imports, --- Instead this just fails. +-- This should warn with -Wcompat-unqualified-imports. import Data.List hello :: [Int] -> Int diff --git a/testsuite/tests/rename/should_compile/T17244A.stderr b/testsuite/tests/rename/should_compile/T17244A.stderr new file mode 100644 index 0000000000..621e9439f1 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T17244A.stderr @@ -0,0 +1,5 @@ + +T17244A.hs:6:8: warning: [-Wcompat-unqualified-imports (in -Wcompat)] + To ensure compatibility with future core libraries changes + imports to Data.List should be + either qualified or have an explicit import list. diff --git a/testsuite/tests/rename/should_fail/T17244C.hs b/testsuite/tests/rename/should_compile/T17244C.hs index e77ff39b61..3da92dddd6 100644 --- a/testsuite/tests/rename/should_fail/T17244C.hs +++ b/testsuite/tests/rename/should_compile/T17244C.hs @@ -3,7 +3,6 @@ module T17244C (hello) where -- This should not warn with -Wcompat-unqualified-imports. --- But not his fails, as sum name clashes with Prelude import Data.List (sum) hello :: [Int] -> Int diff --git a/testsuite/tests/rename/should_compile/T17244C.stderr b/testsuite/tests/rename/should_compile/T17244C.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T17244C.stderr diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index 779b2425ef..3311f0aded 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -6,6 +6,7 @@ T1972.hs:13:3: warning: [-Wname-shadowing (in -Wall)] T1972.hs:15:3: warning: [-Wname-shadowing (in -Wall)] This binding for ‘mapAccumL’ shadows the existing bindings imported from ‘Data.List’ at T1972.hs:8:19-27 + (and originally defined in ‘Data.Traversable’) defined at T1972.hs:17:1 T1972.hs:21:10: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] diff --git a/testsuite/tests/rename/should_compile/T4478.hs b/testsuite/tests/rename/should_compile/T4478.hs index ca6d8e5be0..9e3fcee81a 100644 --- a/testsuite/tests/rename/should_compile/T4478.hs +++ b/testsuite/tests/rename/should_compile/T4478.hs @@ -2,7 +2,7 @@ -- We don't want to warn about duplicate exports for things exported -- by both "module" exports -module T4478 (module Prelude, module Data.Foldable) where +module T4478 (module Prelude, module Data.List) where import Prelude -import Data.Foldable +import Data.List diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 8e55b3705a..536c5b9013 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -168,7 +168,9 @@ test('T15798b', normal, compile, ['']) test('T15798c', normal, compile, ['']) test('T16116a', normal, compile, ['']) test('T15957', normal, compile, ['-Werror -Wredundant-record-wildcards -Wunused-record-wildcards']) +test('T17244A', normal, compile, ['-Wno-error=compat-unqualified-imports']) test('T17244B', normal, compile, ['']) +test('T17244C', normal, compile, ['']) test('T17832', [], multimod_compile, ['T17832M1', 'T17832M2']) test('T17837', normal, compile, ['']) test('T18497', [], makefile_test, ['T18497']) diff --git a/testsuite/tests/rename/should_fail/T17244A.stderr b/testsuite/tests/rename/should_fail/T17244A.stderr deleted file mode 100644 index 6286a71de2..0000000000 --- a/testsuite/tests/rename/should_fail/T17244A.stderr +++ /dev/null @@ -1,10 +0,0 @@ - -T17244A.hs:10:9: error: - Ambiguous occurrence ‘sum’ - It could refer to - either ‘Prelude.sum’, - imported from ‘Prelude’ at T17244A.hs:3:8-14 - (and originally defined in ‘Data.Foldable’) - or ‘Data.List.sum’, - imported from ‘Data.List’ at T17244A.hs:7:1-16 - (and originally defined in ‘GHC.List’) diff --git a/testsuite/tests/rename/should_fail/T17244C.stderr b/testsuite/tests/rename/should_fail/T17244C.stderr deleted file mode 100644 index 71570a01bd..0000000000 --- a/testsuite/tests/rename/should_fail/T17244C.stderr +++ /dev/null @@ -1,10 +0,0 @@ - -T17244C.hs:10:9: error: - Ambiguous occurrence ‘sum’ - It could refer to - either ‘Prelude.sum’, - imported from ‘Prelude’ at T17244C.hs:3:8-14 - (and originally defined in ‘Data.Foldable’) - or ‘Data.List.sum’, - imported from ‘Data.List’ at T17244C.hs:7:19-21 - (and originally defined in ‘GHC.List’) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index aec42ad733..4ce00de399 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -154,8 +154,6 @@ test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) test('T16610', normal, compile_fail, ['']) -test('T17244A', normal, compile_fail, ['-Wno-error=compat-unqualified-imports']) -test('T17244C', normal, compile_fail, ['']) test('T17593', normal, compile_fail, ['']) test('T18021', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr index 9cd16615e0..33f2f8cba9 100644 --- a/testsuite/tests/rename/should_fail/rnfail040.stderr +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr @@ -3,6 +3,7 @@ rnfail040.hs:7:12: error: Conflicting exports for ‘nub’: ‘module M’ exports ‘M.nub’ imported from ‘Data.List’ at rnfail040.hs:10:2-22 + (and originally defined in ‘base-4.13.0.0:Data.OldList’) ‘module M’ exports ‘T.nub’ imported from ‘Rnfail040_A’ at rnfail040.hs:11:2-24 (and originally defined at Rnfail040_A.hs:2:3-5) diff --git a/testsuite/tests/simplCore/should_run/T10830.hs b/testsuite/tests/simplCore/should_run/T10830.hs index 3c62171db2..354f0f513a 100644 --- a/testsuite/tests/simplCore/should_run/T10830.hs +++ b/testsuite/tests/simplCore/should_run/T10830.hs @@ -1,3 +1,3 @@ -import Data.List (maximumBy) +import GHC.OldList main :: IO () main = maximumBy compare [1..10000] `seq` return () diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr index 7f9b3e6464..a081a78582 100644 --- a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr @@ -8,10 +8,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] Valid hole fits include lines :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘Data.List’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) words :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘Data.List’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) read :: forall a. Read a => String -> a with read @[String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 diff --git a/utils/haddock b/utils/haddock -Subproject 8a73a5babd07530326f1ba06bdfe95f49f66b96 +Subproject bbe3c508cc5688683f9febbed814e5230dce0c4 |