summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-08-23 13:30:44 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2021-12-02 17:05:30 +0000
commit64f213282bfe51a56ffb5937fa2bc74e4dabea40 (patch)
tree69ef5542d9c54b94e995828bdc2c99fa96ed2c29
parentd3c7f9be47ac99637ac0ede0759f77da320afaad (diff)
downloadhaskell-wip/revert-data-list.tar.gz
Revert "Data.List specialization to []"wip/revert-data-list
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.
-rw-r--r--compiler/GHC/Rename/Names.hs5
-rw-r--r--docs/users_guide/using-warnings.rst9
-rw-r--r--libraries/base/Data/Foldable.hs4
-rw-r--r--libraries/base/Data/List.hs1402
-rw-r--r--libraries/base/Data/OldList.hs1580
-rw-r--r--libraries/base/Foreign/Marshal/Pool.hs2
-rw-r--r--libraries/base/GHC/Event/Internal/Types.hs2
-rw-r--r--libraries/base/GHC/Event/Manager.hs2
-rw-r--r--libraries/base/GHC/Event/Windows.hsc2
-rw-r--r--libraries/base/GHC/Exception.hs2
-rwxr-xr-xlibraries/base/GHC/Exts.hs2
-rw-r--r--libraries/base/GHC/IO/Encoding/CodePage.hs2
-rw-r--r--libraries/base/GHC/IO/Exception.hs2
-rw-r--r--libraries/base/GHC/OldList.hs29
-rw-r--r--libraries/base/GHC/Windows.hs2
-rw-r--r--libraries/base/base.cabal2
-rw-r--r--libraries/base/changelog.md3
-rw-r--r--libraries/base/tests/T9586.hs1
-rw-r--r--libraries/base/tests/list001.hs3
-rw-r--r--testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs2
-rw-r--r--testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs2
-rw-r--r--testsuite/tests/codeGen/should_run/T20137/T20137.hs2
-rw-r--r--testsuite/tests/ghci/scripts/T10663.script4
-rw-r--r--testsuite/tests/ghci/scripts/T14828.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T20473a.script2
-rw-r--r--testsuite/tests/ghci/scripts/T20473b.script2
-rw-r--r--testsuite/tests/ghci/scripts/ghci008.stdout4
-rw-r--r--testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs1
-rw-r--r--testsuite/tests/parser/should_compile/DumpSemis.hs2
-rw-r--r--testsuite/tests/parser/should_compile/DumpSemis.stderr24
-rw-r--r--testsuite/tests/perf/compiler/T16875.hs1
-rw-r--r--testsuite/tests/perf/compiler/T16875.stderr8
-rw-r--r--testsuite/tests/perf/should_run/T5949.hs1
-rw-r--r--testsuite/tests/rename/should_compile/T17244A.hs (renamed from testsuite/tests/rename/should_fail/T17244A.hs)3
-rw-r--r--testsuite/tests/rename/should_compile/T17244A.stderr5
-rw-r--r--testsuite/tests/rename/should_compile/T17244C.hs (renamed from testsuite/tests/rename/should_fail/T17244C.hs)1
-rw-r--r--testsuite/tests/rename/should_compile/T17244C.stderr0
-rw-r--r--testsuite/tests/rename/should_compile/T1972.stderr1
-rw-r--r--testsuite/tests/rename/should_compile/T4478.hs4
-rw-r--r--testsuite/tests/rename/should_compile/all.T2
-rw-r--r--testsuite/tests/rename/should_fail/T17244A.stderr10
-rw-r--r--testsuite/tests/rename/should_fail/T17244C.stderr10
-rw-r--r--testsuite/tests/rename/should_fail/all.T2
-rw-r--r--testsuite/tests/rename/should_fail/rnfail040.stderr1
-rw-r--r--testsuite/tests/simplCore/should_run/T10830.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr4
m---------utils/haddock0
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 b6273f56de..76aa94825a 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