{-# 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 :: forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
null [a]
xs then [] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
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 :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [] [a]
ys = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
stripPrefix (a
x:[a]
xs) (a
y:[a]
ys)
 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
xs [a]
ys
stripPrefix [a]
_ [a]
_ = Maybe [a]
forall a. Maybe a
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.
-- For the result to be 'Nothing', the list must be finite.
--
-- >>> elemIndex 4 [0..]
-- Just 4
elemIndex      :: Eq a => a -> [a] -> Maybe Int
elemIndex :: forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs = (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
xs -- arity 2 so that we don't get a PAP; #21345

-- | 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 :: forall a. Eq a => a -> [a] -> [Int]
elemIndices a
x [a]
xs = (a -> Bool) -> [a] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
xs -- arity 2 so that we don't get a PAP; #21345

-- | 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.
-- For the result to be 'Nothing', the list must be finite.
--
-- >>> find (> 4) [1..]
-- Just 5
--
-- >>> find (< 0) [1..10]
-- Nothing
find            :: (a -> Bool) -> [a] -> Maybe a
find :: forall a. (a -> Bool) -> [a] -> Maybe a
find a -> Bool
p          = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
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.
-- For the result to be 'Nothing', the list must be finite.
--
-- >>> findIndex isSpace "Hello World!"
-- Just 5
findIndex       :: (a -> Bool) -> [a] -> Maybe Int
findIndex :: forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
p     = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> ([a] -> [Int]) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices a -> Bool
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 :: forall a. (a -> Bool) -> [a] -> [Int]
findIndices a -> Bool
p [a]
ls = (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build ((forall b. (Int -> b -> b) -> b -> b) -> [Int])
-> (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a b. (a -> b) -> a -> b
$ \Int -> b -> b
c b
n ->
  let go :: a -> (Int# -> b) -> Int# -> b
go a
x Int# -> b
r Int#
k | a -> Bool
p a
x       = Int# -> Int
I# Int#
k Int -> b -> b
`c` Int# -> b
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
               | Bool
otherwise = Int# -> b
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
  in (a -> (Int# -> b) -> Int# -> b) -> (Int# -> b) -> [a] -> Int# -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> (Int# -> b) -> Int# -> b
go (\Int#
_ -> b
n) [a]
ls Int#
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
--
-- For the result to be 'True', the first list must be finite;
-- 'False', however, results from any mismatch:
--
-- >>> [0..] `isPrefixOf` [1..]
-- False
-- >>> [0..] `isPrefixOf` [0..99]
-- False
-- >>> [0..99] `isPrefixOf` [0..]
-- True
-- >>> [0..] `isPrefixOf` [0..]
-- * Hangs forever *
--
isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf :: forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [] [a]
_         =  Bool
True
isPrefixOf [a]
_  []        =  Bool
False
isPrefixOf (a
x:[a]
xs) (a
y:[a]
ys)=  a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
xs [a]
ys

-- | The 'isSuffixOf' function takes two lists and returns 'True' iff
-- the first list is a suffix of the second.
--
-- >>> "ld!" `isSuffixOf` "Hello World!"
-- True
-- >>> "World" `isSuffixOf` "Hello World!"
-- False
--
-- The second list must be finite; however the first list may be infinite:
--
-- >>> [0..] `isSuffixOf` [0..99]
-- False
-- >>> [0..99] `isSuffixOf` [0..]
-- * Hangs forever *
--
isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
[a]
ns isSuffixOf :: forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [a]
hs      = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
      [a]
delta <- [a] -> [a] -> Maybe [a]
forall a b. [a] -> [b] -> Maybe [b]
dropLengthMaybe [a]
ns [a]
hs
      Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [a]
ns [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a] -> [a]
forall a b. [a] -> [b] -> [b]
dropLength [a]
delta [a]
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 :: forall a b. [a] -> [b] -> [b]
dropLength [] [b]
y = [b]
y
dropLength [a]
_ [] = []
dropLength (a
_:[a]
x') (b
_:[b]
y') = [a] -> [b] -> [b]
forall a b. [a] -> [b] -> [b]
dropLength [a]
x' [b]
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 :: forall a b. [a] -> [b] -> Maybe [b]
dropLengthMaybe [] [b]
y = [b] -> Maybe [b]
forall a. a -> Maybe a
Just [b]
y
dropLengthMaybe [a]
_ [] = Maybe [b]
forall a. Maybe a
Nothing
dropLengthMaybe (a
_:[a]
x') (b
_:[b]
y') = [a] -> [b] -> Maybe [b]
forall a b. [a] -> [b] -> Maybe [b]
dropLengthMaybe [a]
x' [b]
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
--
-- For the result to be 'True', the first list must be finite;
-- for the result to be 'False', the second list must be finite:
--
-- >>> [20..50] `isInfixOf` [0..]
-- True
-- >>> [0..] `isInfixOf` [20..50]
-- False
-- >>> [0..] `isInfixOf` [0..]
-- * Hangs forever *
--
isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
isInfixOf :: forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
needle [a]
haystack = ([a] -> Bool) -> [[a]] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
needle) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
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]
--
-- If the order of outputs does not matter and there exists @instance Ord a@,
-- it's faster to use
-- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort',
-- which takes only \(\mathcal{O}(n \log n)\) time.
--
nub                     :: (Eq a) => [a] -> [a]
nub :: forall a. Eq a => [a] -> [a]
nub                     =  (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | 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 :: forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
eq [a]
l              = [a] -> [a] -> [a]
nubBy' [a]
l []
  where
    nubBy' :: [a] -> [a] -> [a]
nubBy' [] [a]
_         = []
    nubBy' (a
y:[a]
ys) [a]
xs
       | (a -> a -> Bool) -> a -> [a] -> Bool
forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elem_by a -> a -> Bool
eq a
y [a]
xs = [a] -> [a] -> [a]
nubBy' [a]
ys [a]
xs
       | Bool
otherwise       = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
nubBy' [a]
ys (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
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 :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elem_by a -> a -> Bool
_  a
_ []         =  Bool
False
elem_by a -> a -> Bool
eq a
y (a
x:[a]
xs)     =  a
x a -> a -> Bool
`eq` a
y Bool -> Bool -> Bool
|| (a -> a -> Bool) -> a -> [a] -> Bool
forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elem_by a -> a -> Bool
eq a
y [a]
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 :: forall a. Eq a => a -> [a] -> [a]
delete                  =  (a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | \(\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 :: forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
_  a
_ []        = []
deleteBy a -> a -> Bool
eq a
x (a
y:[a]
ys)    = if a
x a -> a -> Bool
`eq` a
y then [a]
ys else a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
eq a
x [a]
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.
--
-- The second list must be finite, but the first may be infinite.
--
-- >>> take 5 ([0..] \\ [2..4])
-- [0,1,5,6,7]
-- >>> take 5 ([0..] \\ [2..])
-- * Hangs forever *
--
(\\)                    :: (Eq a) => [a] -> [a] -> [a]
\\ :: forall a. Eq a => [a] -> [a] -> [a]
(\\)                    =  ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete)

-- | The 'union' function returns the list union of the two lists.
-- It is a special case of 'unionBy', which allows the programmer to supply
-- their own equality test.
-- For example,
--
-- >>> "dog" `union` "cow"
-- "dogcw"
--
-- If equal elements are present in both lists, an element from the first list
-- will be used. If the second list contains equal elements, only the first one
-- will be retained:
--
-- >>> import Data.Semigroup
-- >>> union [Arg () "dog"] [Arg () "cow"]
-- [Arg () "dog"]
-- >>> union [] [Arg () "dog", Arg () "cow"]
-- [Arg () "dog"]
--
-- However if the first list contains duplicates, so will
-- the result:
--
-- >>> "coot" `union` "duck"
-- "cootduk"
-- >>> "duck" `union` "coot"
-- "duckot"
--
-- 'union' is productive even if both arguments are infinite.
--
union                   :: (Eq a) => [a] -> [a] -> [a]
union :: forall a. Eq a => [a] -> [a] -> [a]
union                   = (a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | The 'unionBy' function is the non-overloaded version of 'union'.
-- Both arguments may be infinite.
--
unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy a -> a -> Bool
eq [a]
xs [a]
ys        =  [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
eq)) ((a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
eq [a]
ys) [a]
xs

-- | The 'intersect' function takes the list intersection of two lists.
-- It is a special case of 'intersectBy', which allows the programmer to
-- supply their own equality test.
-- For example,
--
-- >>> [1,2,3,4] `intersect` [2,4,6,8]
-- [2,4]
--
-- If equal elements are present in both lists, an element from the first list
-- will be used, and all duplicates from the second list quashed:
--
-- >>> import Data.Semigroup
-- >>> intersect [Arg () "dog"] [Arg () "cow", Arg () "cat"]
-- [Arg () "dog"]
--
-- However if the first list contains duplicates, so will the result.
--
-- >>> "coot" `intersect` "heron"
-- "oo"
-- >>> "heron" `intersect` "coot"
-- "o"
--
-- If the second list is infinite, 'intersect' either hangs
-- or returns its first argument in full. Otherwise if the first list
-- is infinite, 'intersect' might be productive:
--
-- >>> intersect [100..] [0..]
-- [100,101,102,103...
-- >>> intersect [0] [1..]
-- * Hangs forever *
-- >>> intersect [1..] [0]
-- * Hangs forever *
-- >>> intersect (cycle [1..3]) [2]
-- [2,2,2,2...
--
intersect               :: (Eq a) => [a] -> [a] -> [a]
intersect :: forall a. Eq a => [a] -> [a] -> [a]
intersect               =  (a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
-- It is productive for infinite arguments only if the first one
-- is a subset of the second.
--
intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy a -> a -> Bool
_  [] [a]
_     =  []
intersectBy a -> a -> Bool
_  [a]
_  []    =  []
intersectBy a -> a -> Bool
eq [a]
xs [a]
ys    =  [a
x | a
x <- [a]
xs, (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any (a -> a -> Bool
eq a
x) [a]
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 :: forall a. a -> [a] -> [a]
intersperse a
_   []      = []
intersperse a
sep (a
x:[a]
xs)  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
forall a. a -> [a] -> [a]
prependToAll a
sep [a]
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 :: forall a. a -> [a] -> [a]
prependToAll a
_   []     = []
prependToAll a
sep (a
x:[a]
xs) = a
sep a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
forall a. a -> [a] -> [a]
prependToAll a
sep [a]
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 :: forall a. [a] -> [[a]] -> [a]
intercalate [a]
xs [[a]]
xss = [[a]] -> [a]
forall a. [[a]] -> [a]
concat ([a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
intersperse [a]
xs [[a]]
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]]
--
-- For this reason the outer list must be finite; otherwise 'transpose' hangs:
--
-- >>> transpose (repeat [])
-- * Hangs forever *
--
transpose :: [[a]] -> [[a]]
transpose :: forall a. [[a]] -> [[a]]
transpose [] = []
transpose ([] : [[a]]
xss) = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose [[a]]
xss
transpose ((a
x : [a]
xs) : [[a]]
xss) = a -> [a] -> [a] -> [[a]] -> [[a]]
forall {a}. a -> [a] -> [a] -> [[a]] -> [[a]]
combine a
x [a]
hds [a]
xs [[a]]
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.
    ([a]
hds, [[a]]
tls) = [(a, [a])] -> ([a], [[a]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a
hd, [a]
tl) | a
hd : [a]
tl <- [[a]]
xss]
    combine :: a -> [a] -> [a] -> [[a]] -> [[a]]
combine a
y [a]
h [a]
ys [[a]]
t = (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
h) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose ([a]
ys[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
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 :: forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
xs = (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ((a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p) ([],[]) [a]
xs

select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select :: forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p a
x ~([a]
ts,[a]
fs) | a -> Bool
p a
x       = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ts,[a]
fs)
                    | Bool
otherwise = ([a]
ts, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
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 :: forall acc x y. (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumL acc -> x -> (acc, y)
_ acc
s []        =  (acc
s, [])
mapAccumL acc -> x -> (acc, y)
f acc
s (x
x:[x]
xs)    =  (acc
s'',y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys)
                           where (acc
s', y
y ) = acc -> x -> (acc, y)
f acc
s x
x
                                 (acc
s'',[y]
ys) = (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
forall acc x y. (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumL acc -> x -> (acc, y)
f acc
s' [x]
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 :: forall acc y. acc -> (acc, [y])
pairWithNil acc
x = (acc
x, [])

mapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y])
{-# INLINE [0] mapAccumLF #-}
mapAccumLF :: forall acc x y.
(acc -> x -> (acc, y))
-> x -> (acc -> (acc, [y])) -> acc -> (acc, [y])
mapAccumLF acc -> x -> (acc, y)
f = \x
x acc -> (acc, [y])
r -> (acc -> (acc, [y])) -> acc -> (acc, [y])
forall a b. (a -> b) -> a -> b
oneShot (\acc
s ->
                         let (acc
s', y
y)   = acc -> x -> (acc, y)
f acc
s x
x
                             (acc
s'', [y]
ys) = acc -> (acc, [y])
r acc
s'
                         in (acc
s'', y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[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 :: forall acc x y. (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumR acc -> x -> (acc, y)
_ acc
s []        =  (acc
s, [])
mapAccumR acc -> x -> (acc, y)
f acc
s (x
x:[x]
xs)    =  (acc
s'', y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys)
                           where (acc
s'',y
y ) = acc -> x -> (acc, y)
f acc
s' x
x
                                 (acc
s', [y]
ys) = (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
forall acc x y. (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumR acc -> x -> (acc, y)
f acc
s [x]
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 :: forall a. Ord a => a -> [a] -> [a]
insert a
e [a]
ls = (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) a
e [a]
ls

-- | \(\mathcal{O}(n)\). The non-overloaded version of 'insert'.
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy :: forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy a -> a -> Ordering
_   a
x [] = [a
x]
insertBy a -> a -> Ordering
cmp a
x ys :: [a]
ys@(a
y:[a]
ys')
 = case a -> a -> Ordering
cmp a
x a
y of
     Ordering
GT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy a -> a -> Ordering
cmp a
x [a]
ys'
     Ordering
_  -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys

-- | The 'maximumBy' function is the non-overloaded version of 'maximum',
-- which 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 :: forall a. (a -> a -> Ordering) -> [a] -> a
maximumBy a -> a -> Ordering
_ []          =  [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"List.maximumBy: empty list"
maximumBy a -> a -> Ordering
cmp [a]
xs        =  (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1 a -> a -> a
maxBy [a]
xs
                        where
                           maxBy :: a -> a -> a
maxBy a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
                                       Ordering
GT -> a
x
                                       Ordering
_  -> a
y

-- | The 'minimumBy' function is the non-overloaded version of 'minimum',
-- which 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 :: forall a. (a -> a -> Ordering) -> [a] -> a
minimumBy a -> a -> Ordering
_ []          =  [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"List.minimumBy: empty list"
minimumBy a -> a -> Ordering
cmp [a]
xs        =  (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1 a -> a -> a
minBy [a]
xs
                        where
                           minBy :: a -> a -> a
minBy a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
                                       Ordering
GT -> a
y
                                       Ordering
_  -> a
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 :: forall i a. Num i => [a] -> i
genericLength []        =  i
0
genericLength (a
_:[a]
l)     =  i
1 i -> i -> i
forall a. Num a => a -> a -> a
+ [a] -> i
forall i a. Num i => [a] -> i
genericLength [a]
l

{-# RULES
  "genericLengthInt"     genericLength = (strictGenericLength :: [a] -> Int);
  "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
 #-}

strictGenericLength     :: (Num i) => [b] -> i
strictGenericLength :: forall i a. Num i => [a] -> i
strictGenericLength [b]
l   =  [b] -> i -> i
forall {t} {a}. Num t => [a] -> t -> t
gl [b]
l i
0
                        where
                           gl :: [a] -> t -> t
gl [] t
a     = t
a
                           gl (a
_:[a]
xs) t
a = let a' :: t
a' = t
a t -> t -> t
forall a. Num a => a -> a -> a
+ t
1 in t
a' t -> t -> t
forall a b. a -> b -> b
`seq` [a] -> t -> t
gl [a]
xs t
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 :: forall i a. Integral i => i -> [a] -> [a]
genericTake i
n [a]
_ | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
0 = []
genericTake i
_ []        =  []
genericTake i
n (a
x:[a]
xs)    =  a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: i -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericTake (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
1) [a]
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 :: forall i a. Integral i => i -> [a] -> [a]
genericDrop i
n [a]
xs | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
0 = [a]
xs
genericDrop i
_ []        =  []
genericDrop i
n (a
_:[a]
xs)    =  i -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericDrop (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
1) [a]
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 :: forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt i
n [a]
xs | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
0 =  ([],[a]
xs)
genericSplitAt i
_ []     =  ([],[])
genericSplitAt i
n (a
x:[a]
xs) =  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs',[a]
xs'') where
    ([a]
xs',[a]
xs'') = i -> [a] -> ([a], [a])
forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
1) [a]
xs

-- | The 'genericIndex' function is an overloaded version of '!!', which
-- accepts any 'Integral' value as the index.
genericIndex :: (Integral i) => [a] -> i -> a
genericIndex :: forall i a. Integral i => [a] -> i -> a
genericIndex (a
x:[a]
_)  i
0 = a
x
genericIndex (a
_:[a]
xs) i
n
 | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0     = [a] -> i -> a
forall i a. Integral i => [a] -> i -> a
genericIndex [a]
xs (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
1)
 | Bool
otherwise = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"List.genericIndex: negative argument."
genericIndex [a]
_ i
_      = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"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 :: forall i a. Integral i => i -> a -> [a]
genericReplicate i
n a
x    =  i -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericTake i
n (a -> [a]
forall a. a -> [a]
repeat a
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 :: forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4                    =  (a -> b -> c -> d -> (a, b, c, d))
-> [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
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 :: forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5                    =  (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
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 :: forall a b c d e f.
[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
zip6                    =  (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
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 :: forall a b c d e f g.
[a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [(a, b, c, d, e, f, g)]
zip7                    =  (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [(a, b, c, d, e, f, g)]
forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
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 :: forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 a -> b -> c -> d -> e
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds)
                        =  a -> b -> c -> d -> e
z a
a b
b c
c d
d e -> [e] -> [e]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 a -> b -> c -> d -> e
z [a]
as [b]
bs [c]
cs [d]
ds
zipWith4 a -> b -> c -> d -> e
_ [a]
_ [b]
_ [c]
_ [d]
_      =  []

-- | 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 :: forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
zipWith5 a -> b -> c -> d -> e -> f
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es)
                        =  a -> b -> c -> d -> e -> f
z a
a b
b c
c d
d e
e f -> [f] -> [f]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
zipWith5 a -> b -> c -> d -> e -> f
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es
zipWith5 a -> b -> c -> d -> e -> f
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_    = []

-- | 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 :: forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 a -> b -> c -> d -> e -> f -> g
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs)
                        =  a -> b -> c -> d -> e -> f -> g
z a
a b
b c
c d
d e
e f
f g -> [g] -> [g]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6 a -> b -> c -> d -> e -> f -> g
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs
zipWith6 a -> b -> c -> d -> e -> f -> g
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_  = []

-- | 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 :: forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
zipWith7 a -> b -> c -> d -> e -> f -> g -> h
z (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs)
                   =  a -> b -> c -> d -> e -> f -> g -> h
z a
a b
b c
c d
d e
e f
f g
g h -> [h] -> [h]
forall a. a -> [a] -> [a]
: (a -> b -> c -> d -> e -> f -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
zipWith7 a -> b -> c -> d -> e -> f -> g -> h
z [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs
zipWith7 a -> b -> c -> d -> e -> f -> g -> h
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ = []

{-
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 :: forall e xs xs' a b c d.
(e -> xs -> xs')
-> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> xs -> xs'
zipWith4FB e -> xs -> xs'
cons a -> b -> c -> d -> e
func = \a
a b
b c
c d
d xs
r -> (a -> b -> c -> d -> e
func a
a b
b c
c d
d) e -> xs -> xs'
`cons` xs
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 :: forall f xs xs' a b c d e.
(f -> xs -> xs')
-> (a -> b -> c -> d -> e -> f)
-> a
-> b
-> c
-> d
-> e
-> xs
-> xs'
zipWith5FB f -> xs -> xs'
cons a -> b -> c -> d -> e -> f
func = \a
a b
b c
c d
d e
e xs
r -> (a -> b -> c -> d -> e -> f
func a
a b
b c
c d
d e
e) f -> xs -> xs'
`cons` xs
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 :: forall g xs xs' a b c d e f.
(g -> xs -> xs')
-> (a -> b -> c -> d -> e -> f -> g)
-> a
-> b
-> c
-> d
-> e
-> f
-> xs
-> xs'
zipWith6FB g -> xs -> xs'
cons a -> b -> c -> d -> e -> f -> g
func = \a
a b
b c
c d
d e
e f
f xs
r -> (a -> b -> c -> d -> e -> f -> g
func a
a b
b c
c d
d e
e f
f) g -> xs -> xs'
`cons` xs
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 :: forall h xs xs' a b c d e f g.
(h -> xs -> xs')
-> (a -> b -> c -> d -> e -> f -> g -> h)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> xs
-> xs'
zipWith7FB h -> xs -> xs'
cons a -> b -> c -> d -> e -> f -> g -> h
func = \a
a b
b c
c d
d e
e f
f g
g xs
r -> (a -> b -> c -> d -> e -> f -> g -> h
func a
a b
b c
c d
d e
e f
f g
g) h -> xs -> xs'
`cons` xs
r

{-# INLINE [0] foldr4 #-}
foldr4 :: (a->b->c->d->e->e) ->
          e->[a]->[b]->[c]->[d]->e
foldr4 :: forall a b c d e.
(a -> b -> c -> d -> e -> e) -> e -> [a] -> [b] -> [c] -> [d] -> e
foldr4 a -> b -> c -> d -> e -> e
k e
z = [a] -> [b] -> [c] -> [d] -> e
go
  where
    go :: [a] -> [b] -> [c] -> [d] -> e
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) = a -> b -> c -> d -> e -> e
k a
a b
b c
c d
d ([a] -> [b] -> [c] -> [d] -> e
go [a]
as [b]
bs [c]
cs [d]
ds)
    go [a]
_      [b]
_      [c]
_      [d]
_      = e
z

{-# INLINE [0] foldr5 #-}
foldr5 :: (a->b->c->d->e->f->f) ->
          f->[a]->[b]->[c]->[d]->[e]->f
foldr5 :: forall a b c d e f.
(a -> b -> c -> d -> e -> f -> f)
-> f -> [a] -> [b] -> [c] -> [d] -> [e] -> f
foldr5 a -> b -> c -> d -> e -> f -> f
k f
z = [a] -> [b] -> [c] -> [d] -> [e] -> f
go
  where
    go :: [a] -> [b] -> [c] -> [d] -> [e] -> f
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) = a -> b -> c -> d -> e -> f -> f
k a
a b
b c
c d
d e
e ([a] -> [b] -> [c] -> [d] -> [e] -> f
go [a]
as [b]
bs [c]
cs [d]
ds [e]
es)
    go [a]
_      [b]
_      [c]
_      [d]
_      [e]
_      = f
z

{-# INLINE [0] foldr6 #-}
foldr6 :: (a->b->c->d->e->f->g->g) ->
          g->[a]->[b]->[c]->[d]->[e]->[f]->g
foldr6 :: forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g -> g)
-> g -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> g
foldr6 a -> b -> c -> d -> e -> f -> g -> g
k g
z = [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> g
go
  where
    go :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> g
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) = a -> b -> c -> d -> e -> f -> g -> g
k a
a b
b c
c d
d e
e f
f (
        [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> g
go [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs)
    go [a]
_      [b]
_      [c]
_      [d]
_      [e]
_      [f]
_      = g
z

{-# INLINE [0] foldr7 #-}
foldr7 :: (a->b->c->d->e->f->g->h->h) ->
          h->[a]->[b]->[c]->[d]->[e]->[f]->[g]->h
foldr7 :: forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h -> h)
-> h -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
foldr7 a -> b -> c -> d -> e -> f -> g -> h -> h
k h
z = [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
go
  where
    go :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) = a -> b -> c -> d -> e -> f -> g -> h -> h
k a
a b
b c
c d
d e
e f
f g
g (
        [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
go [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs)
    go [a]
_      [b]
_      [c]
_      [d]
_      [e]
_      [f]
_      [g]
_      = h
z

foldr4_left :: (a->b->c->d->e->f)->
               f->a->([b]->[c]->[d]->e)->
               [b]->[c]->[d]->f
foldr4_left :: forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> f -> a -> ([b] -> [c] -> [d] -> e) -> [b] -> [c] -> [d] -> f
foldr4_left a -> b -> c -> d -> e -> f
k f
_z a
a [b] -> [c] -> [d] -> e
r (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) = a -> b -> c -> d -> e -> f
k a
a b
b c
c d
d ([b] -> [c] -> [d] -> e
r [b]
bs [c]
cs [d]
ds)
foldr4_left a -> b -> c -> d -> e -> f
_  f
z a
_ [b] -> [c] -> [d] -> e
_ [b]
_      [c]
_      [d]
_      = f
z

foldr5_left :: (a->b->c->d->e->f->g)->
               g->a->([b]->[c]->[d]->[e]->f)->
               [b]->[c]->[d]->[e]->g
foldr5_left :: forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> g
-> a
-> ([b] -> [c] -> [d] -> [e] -> f)
-> [b]
-> [c]
-> [d]
-> [e]
-> g
foldr5_left a -> b -> c -> d -> e -> f -> g
k g
_z a
a [b] -> [c] -> [d] -> [e] -> f
r (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) = a -> b -> c -> d -> e -> f -> g
k a
a b
b c
c d
d e
e ([b] -> [c] -> [d] -> [e] -> f
r [b]
bs [c]
cs [d]
ds [e]
es)
foldr5_left a -> b -> c -> d -> e -> f -> g
_  g
z a
_ [b] -> [c] -> [d] -> [e] -> f
_ [b]
_      [c]
_      [d]
_      [e]
_      = g
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 :: forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> h
-> a
-> ([b] -> [c] -> [d] -> [e] -> [f] -> g)
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> h
foldr6_left a -> b -> c -> d -> e -> f -> g -> h
k h
_z a
a [b] -> [c] -> [d] -> [e] -> [f] -> g
r (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) =
    a -> b -> c -> d -> e -> f -> g -> h
k a
a b
b c
c d
d e
e f
f ([b] -> [c] -> [d] -> [e] -> [f] -> g
r [b]
bs [c]
cs [d]
ds [e]
es [f]
fs)
foldr6_left a -> b -> c -> d -> e -> f -> g -> h
_  h
z a
_ [b] -> [c] -> [d] -> [e] -> [f] -> g
_ [b]
_      [c]
_      [d]
_      [e]
_      [f]
_      = h
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 :: forall a b c d e f g h i.
(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 a -> b -> c -> d -> e -> f -> g -> h -> i
k i
_z a
a [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
r (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) =
    a -> b -> c -> d -> e -> f -> g -> h -> i
k a
a b
b c
c d
d e
e f
f g
g ([b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
r [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs)
foldr7_left a -> b -> c -> d -> e -> f -> g -> h -> i
_  i
z a
_ [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> h
_ [b]
_      [c]
_      [d]
_      [e]
_      [f]
_      [g]
_      = i
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 :: forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4                  =  ((a, b, c, d) -> ([a], [b], [c], [d]) -> ([a], [b], [c], [d]))
-> ([a], [b], [c], [d]) -> [(a, b, c, d)] -> ([a], [b], [c], [d])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b,c
c,d
d) ~([a]
as,[b]
bs,[c]
cs,[d]
ds) ->
                                        (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs,c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs,d
dd -> [d] -> [d]
forall a. a -> [a] -> [a]
:[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 :: forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5                  =  ((a, b, c, d, e)
 -> ([a], [b], [c], [d], [e]) -> ([a], [b], [c], [d], [e]))
-> ([a], [b], [c], [d], [e])
-> [(a, b, c, d, e)]
-> ([a], [b], [c], [d], [e])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b,c
c,d
d,e
e) ~([a]
as,[b]
bs,[c]
cs,[d]
ds,[e]
es) ->
                                        (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs,c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs,d
dd -> [d] -> [d]
forall a. a -> [a] -> [a]
:[d]
ds,e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[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 :: forall a b c d e f.
[(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
unzip6                  =  ((a, b, c, d, e, f)
 -> ([a], [b], [c], [d], [e], [f])
 -> ([a], [b], [c], [d], [e], [f]))
-> ([a], [b], [c], [d], [e], [f])
-> [(a, b, c, d, e, f)]
-> ([a], [b], [c], [d], [e], [f])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b,c
c,d
d,e
e,f
f) ~([a]
as,[b]
bs,[c]
cs,[d]
ds,[e]
es,[f]
fs) ->
                                        (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs,c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs,d
dd -> [d] -> [d]
forall a. a -> [a] -> [a]
:[d]
ds,e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
es,f
ff -> [f] -> [f]
forall a. a -> [a] -> [a]
:[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 :: forall a b c d e f g.
[(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
unzip7          =  ((a, b, c, d, e, f, g)
 -> ([a], [b], [c], [d], [e], [f], [g])
 -> ([a], [b], [c], [d], [e], [f], [g]))
-> ([a], [b], [c], [d], [e], [f], [g])
-> [(a, b, c, d, e, f, g)]
-> ([a], [b], [c], [d], [e], [f], [g])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b,c
c,d
d,e
e,f
f,g
g) ~([a]
as,[b]
bs,[c]
cs,[d]
ds,[e]
es,[f]
fs,[g]
gs) ->
                                (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs,c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs,d
dd -> [d] -> [d]
forall a. a -> [a] -> [a]
:[d]
ds,e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
es,f
ff -> [f] -> [f]
forall a. a -> [a] -> [a]
:[f]
fs,g
gg -> [g] -> [g]
forall a. a -> [a] -> [a]
:[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. This is the non-overloaded version of '(\\)'.
--
-- The second list must be finite, but the first may be infinite.
--
deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy a -> a -> Bool
eq       =  ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
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 is non-empty and all elements are equal
-- to the first one.  For example,
--
-- >>> group "Mississippi"
-- ["M","i","ss","i","ss","i","pp","i"]
--
-- 'group' is a special case of 'groupBy', which allows the programmer to supply
-- their own equality test.
--
-- It's often preferable to use @Data.List.NonEmpty.@'Data.List.NonEmpty.group',
-- which provides type-level guarantees of non-emptiness of inner lists.
--
group                   :: Eq a => [a] -> [[a]]
group :: forall a. Eq a => [a] -> [[a]]
group                   =  (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | The 'groupBy' function is the non-overloaded version of 'group'.
--
-- When a supplied relation is not transitive, it is important
-- to remember that equality is checked against the first element in the group,
-- not against the nearest neighbour:
--
-- >>> groupBy (\a b -> b - a < 5) [0..19]
-- [[0,1,2,3,4],[5,6,7,8,9],[10,11,12,13,14],[15,16,17,18,19]]
--
-- It's often preferable to use @Data.List.NonEmpty.@'Data.List.NonEmpty.groupBy',
-- which provides type-level guarantees of non-emptiness of inner lists.
--
groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy :: forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
_  []           =  []
groupBy a -> a -> Bool
eq (a
x:[a]
xs)       =  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
eq [a]
zs
                           where ([a]
ys,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
eq a
x) [a]
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' is semantically equivalent to @'map' 'reverse' . 'scanl' ('flip' (:)) []@,
-- but under the hood uses a queue to amortize costs of 'reverse'.
--
inits                   :: [a] -> [[a]]
inits :: forall a. [a] -> [[a]]
inits                   = (SnocBuilder a -> [a]) -> [SnocBuilder a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map SnocBuilder a -> [a]
forall a. SnocBuilder a -> [a]
toListSB ([SnocBuilder a] -> [[a]])
-> ([a] -> [SnocBuilder a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SnocBuilder a -> a -> SnocBuilder a)
-> SnocBuilder a -> [a] -> [SnocBuilder a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' SnocBuilder a -> a -> SnocBuilder a
forall a. SnocBuilder a -> a -> SnocBuilder a
snocSB SnocBuilder a
forall a. SnocBuilder a
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 :: forall a. [a] -> [[a]]
tails [a]
lst               =  (forall b. ([a] -> b -> b) -> b -> b) -> [[a]]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\[a] -> b -> b
c b
n ->
  let tailsGo :: [a] -> b
tailsGo [a]
xs = [a]
xs [a] -> b -> b
`c` case [a]
xs of
                             []      -> b
n
                             a
_ : [a]
xs' -> [a] -> b
tailsGo [a]
xs'
  in [a] -> b
tailsGo [a]
lst)

-- | The 'subsequences' function returns the list of all subsequences of the argument.
--
-- >>> subsequences "abc"
-- ["","a","b","ab","c","ac","bc","abc"]
--
-- This function is productive on infinite inputs:
--
-- >>> take 8 $ subsequences ['a'..]
-- ["","a","b","ab","c","ac","bc","abc"]
--
subsequences            :: [a] -> [[a]]
subsequences :: forall a. [a] -> [[a]]
subsequences [a]
xs         =  [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
nonEmptySubsequences [a]
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 :: forall a. [a] -> [[a]]
nonEmptySubsequences []      =  []
nonEmptySubsequences (a
x:[a]
xs)  =  [a
x] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [[a]] -> [[a]]
f [] ([a] -> [[a]]
forall a. [a] -> [[a]]
nonEmptySubsequences [a]
xs)
  where f :: [a] -> [[a]] -> [[a]]
f [a]
ys [[a]]
r = [a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
r


-- | The 'permutations' function returns the list of all permutations of the argument.
--
-- >>> permutations "abc"
-- ["abc","bac","cba","bca","cab","acb"]
--
-- The 'permutations' function is maximally lazy:
-- for each @n@, the value of @'permutations' xs@ starts with those permutations
-- that permute @'take' n xs@ and keep @'drop' n xs@.
--
-- This function is productive on infinite inputs:
--
-- >>> take 6 $ map (take 3) $ permutations ['a'..]
-- ["abc","bac","cba","bca","cab","acb"]
--
-- Note that the order of permutations is not lexicographic.
-- It satisfies the following property:
--
-- > map (take n) (take (product [1..n]) (permutations ([1..n] ++ undefined))) == permutations [1..n]
--
permutations :: [a] -> [[a]]
-- See https://stackoverflow.com/questions/24484348/what-does-this-list-permutations-implementation-in-haskell-exactly-do/24564307#24564307
-- for the analysis of this rather cryptic implementation.
-- Related discussions:
-- * https://mail.haskell.org/pipermail/haskell-cafe/2021-December/134920.html
-- * https://mail.haskell.org/pipermail/libraries/2007-December/008788.html
permutations :: forall a. [a] -> [[a]]
permutations [a]
xs0 = [a]
xs0 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]]
forall a. [a] -> [a] -> [[a]]
perms [a]
xs0 []
  where
    perms :: forall a. [a] -> [a] -> [[a]]
    perms :: forall a. [a] -> [a] -> [[a]]
perms []     [a]
_  = []
    perms (a
t:[a]
ts) [a]
is = ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [[a]] -> [[a]]
interleave ([a] -> [a] -> [[a]]
forall a. [a] -> [a] -> [[a]]
perms [a]
ts (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
is)) ([a] -> [[a]]
forall a. [a] -> [[a]]
permutations [a]
is)
      where
        interleave :: [a] -> [[a]] -> [[a]]
        interleave :: [a] -> [[a]] -> [[a]]
interleave [a]
xs [[a]]
r = let ([a]
_,[[a]]
zs) = ([a] -> [a]) -> [a] -> [[a]] -> ([a], [[a]])
forall b. ([a] -> b) -> [a] -> [b] -> ([a], [b])
interleave' [a] -> [a]
forall a. a -> a
id [a]
xs [[a]]
r in [[a]]
zs

        interleave' :: ([a] -> b) -> [a] -> [b] -> ([a], [b])
        interleave' :: forall b. ([a] -> b) -> [a] -> [b] -> ([a], [b])
interleave' [a] -> b
_ []     [b]
r = ([a]
ts, [b]
r)
        interleave' [a] -> b
f (a
y:[a]
ys) [b]
r = let ([a]
us,[b]
zs) = ([a] -> b) -> [a] -> [b] -> ([a], [b])
forall b. ([a] -> b) -> [a] -> [b] -> ([a], [b])
interleave' ([a] -> b
f ([a] -> b) -> ([a] -> [a]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
ys [b]
r
                                 in  (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
us, [a] -> b
f (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
us) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
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]
--
-- The argument must be finite.
--
sort :: (Ord a) => [a] -> [a]

-- | The 'sortBy' function is the non-overloaded version of 'sort'.
-- The argument must be finite.
--
-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")]
-- [(1,"Hello"),(2,"world"),(4,"!")]
--
-- The supplied comparison relation is supposed to be reflexive and antisymmetric,
-- otherwise, e. g., for @\_ _ -> GT@, the ordered list simply does not exist.
-- The relation is also expected to be transitive: if it is not then 'sortBy'
-- might fail to find an ordered permutation, even if it exists.
--
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 :: forall a. Ord a => [a] -> [a]
sort = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
sortBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp = [[a]] -> [a]
mergeAll ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
sequences
  where
    sequences :: [a] -> [[a]]
sequences (a
a:a
b:[a]
xs)
      | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b [a
a]  [a]
xs
      | Bool
otherwise       = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending  a
b (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a]
xs
    sequences [a]
xs = [[a]
xs]

    descending :: a -> [a] -> [a] -> [[a]]
descending a
a [a]
as (a
b:[a]
bs)
      | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) [a]
bs
    descending a
a [a]
as [a]
bs  = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs

    ascending :: a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
a [a] -> [a]
as (a
b:[a]
bs)
      | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
b (\[a]
ys -> [a] -> [a]
as (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)) [a]
bs
    ascending a
a [a] -> [a]
as [a]
bs   = let !x :: [a]
x = [a] -> [a]
as [a
a]
                          in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs

    mergeAll :: [[a]] -> [a]
mergeAll [[a]
x] = [a]
x
    mergeAll [[a]]
xs  = [[a]] -> [a]
mergeAll ([[a]] -> [[a]]
mergePairs [[a]]
xs)

    mergePairs :: [[a]] -> [[a]]
mergePairs ([a]
a:[a]
b:[[a]]
xs) = let !x :: [a]
x = [a] -> [a] -> [a]
merge [a]
a [a]
b
                          in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
mergePairs [[a]]
xs
    mergePairs [[a]]
xs       = [[a]]
xs

    merge :: [a] -> [a] -> [a]
merge as :: [a]
as@(a
a:[a]
as') bs :: [a]
bs@(a
b:[a]
bs')
      | a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
merge [a]
as  [a]
bs'
      | Bool
otherwise       = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
merge [a]
as' [a]
bs
    merge [] [a]
bs         = [a]
bs
    merge [a]
as []         = [a]
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
-- <https://en.wikipedia.org/wiki/Schwartzian_transform 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,"!")]
--
-- The argument must be finite.
--
-- @since 4.8.0.0
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> b
f =
  ((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([a] -> [(b, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Ordering) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> let y :: b
y = a -> b
f a
x in b
y b -> (b, a) -> (b, a)
forall a b. a -> b -> b
`seq` (b
y, a
x))

-- | Produce singleton list.
--
-- >>> singleton True
-- [True]
--
-- @since 4.15.0.0
--
singleton :: a -> [a]
singleton :: forall a. a -> [a]
singleton a
x = [a
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 :: forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr b -> Maybe (a, b)
f b
b0 = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n ->
  let go :: b -> b
go b
b = case b -> Maybe (a, b)
f b
b of
               Just (a
a, b
new_b) -> a
a a -> b -> b
`c` b -> b
go b
new_b
               Maybe (a, b)
Nothing         -> b
n
  in b -> b
go b
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 :: [Char] -> [[Char]]
lines [Char]
""                =  []
-- 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 [Char]
s                 =  ([Char], [[Char]]) -> [[Char]]
forall {a}. (a, [a]) -> [a]
cons (case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
s of
                                    ([Char]
l, [Char]
s') -> ([Char]
l, case [Char]
s' of
                                                    []      -> []
                                                    Char
_:[Char]
s''   -> [Char] -> [[Char]]
lines [Char]
s''))
  where
    cons :: (a, [a]) -> [a]
cons ~(a
h, [a]
t)        =  a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
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 that @'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 :: [[Char]] -> [Char]
unlines [] = []
unlines ([Char]
l:[[Char]]
ls) = [Char]
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [[Char]] -> [Char]
unlines [[Char]]
ls
#endif

-- | 'words' breaks a string up into a list of words, which were delimited
-- by white space (as defined by 'isSpace'). This function trims any white spaces
-- at the beginning and at the end.
--
-- >>> words "Lorem ipsum\ndolor"
-- ["Lorem","ipsum","dolor"]
-- >>> words " foo bar "
-- ["foo","bar"]
--
words                   :: String -> [String]
{-# NOINLINE [1] words #-}
words :: [Char] -> [[Char]]
words [Char]
s                 =  case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile {-partain:Char.-}Char -> Bool
isSpace [Char]
s of
                                [Char]
"" -> []
                                [Char]
s' -> [Char]
w [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
words [Char]
s''
                                      where ([Char]
w, [Char]
s'') =
                                             (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break {-partain:Char.-}Char -> Bool
isSpace [Char]
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 :: forall b. ([Char] -> b -> b) -> b -> [Char] -> b
wordsFB [Char] -> b -> b
c b
n = [Char] -> b
go
  where
    go :: [Char] -> b
go [Char]
s = case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
s of
             [Char]
"" -> b
n
             [Char]
s' -> [Char]
w [Char] -> b -> b
`c` [Char] -> b
go [Char]
s''
                   where ([Char]
w, [Char]
s'') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
s'

-- | 'unwords' joins words with separating spaces (U+0020 SPACE).
--
-- >>> unwords ["Lorem", "ipsum", "dolor"]
-- "Lorem ipsum dolor"
--
-- 'unwords' is neither left nor right inverse of 'words':
--
-- >>> words (unwords [" "])
-- []
-- >>> unwords (words "foo\nbar")
-- "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 :: [[Char]] -> [Char]
unwords []              =  [Char]
""
unwords ([Char]
w:[[Char]]
ws)          = [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
go [[Char]]
ws
  where
    go :: [[Char]] -> [Char]
go []     = [Char]
""
    go ([Char]
v:[[Char]]
vs) = Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ([Char]
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
go [[Char]]
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 :: [Char] -> [Char]
tailUnwords []        = []
tailUnwords (Char
_:[Char]
xs)    = [Char]
xs

{-# INLINE [0] unwordsFB #-}
unwordsFB               :: String -> String -> String
unwordsFB :: [Char] -> [Char] -> [Char]
unwordsFB [Char]
w [Char]
r           = Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: forall a. Word -> [a] -> [a] -> SnocBuilder a
sb Word
lp [a]
f [a]
r
  | Word
lp Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
255 Bool -> Bool -> Bool
|| (Word
lp Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
lp Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Word -> [a] -> [a] -> SnocBuilder a
forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
lp [a]
f [a]
r
  | Bool
otherwise                          = Word -> [a] -> [a] -> SnocBuilder a
forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
lp ([a]
f [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
r) []

-- The empty builder

emptySB :: SnocBuilder a
emptySB :: forall a. SnocBuilder a
emptySB = Word -> [a] -> [a] -> SnocBuilder a
forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
0 [] []

-- Add an element to the end of a queue.

snocSB :: SnocBuilder a -> a -> SnocBuilder a
snocSB :: forall a. SnocBuilder a -> a -> SnocBuilder a
snocSB (SnocBuilder Word
lp [a]
f [a]
r) a
x = Word -> [a] -> [a] -> SnocBuilder a
forall a. Word -> [a] -> [a] -> SnocBuilder a
sb (Word
lp Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) [a]
f (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)

-- Convert a builder to a list

toListSB :: SnocBuilder a -> [a]
toListSB :: forall a. SnocBuilder a -> [a]
toListSB (SnocBuilder Word
_ [a]
f [a]
r) = [a]
f [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
r