base 4.14.3.0 → 4.15.0.0

raw patch · 151 files changed

+45885/−37485 lines, 151 filesdep +ghc-bignumdep −integer-gmpdep −integer-simpledep −invalid-cabal-flag-settingsdep ~ghc-primdep ~rtsPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-bignum

Dependencies removed: integer-gmp, integer-simple, invalid-cabal-flag-settings

Dependency ranges changed: ghc-prim, rts

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +17/−0
• Control/Category.hs +64/−0
• Control/Concurrent.hs-boot +30/−0
• Control/Exception/Base.hs +2/−6
• Control/Monad.hs +11/−26
• Control/Monad/Fix.hs +6/−0
• Control/Monad/IO/Class.hs +34/−0
• Control/Monad/ST/Lazy/Imp.hs +8/−9
• Control/Monad/Zip.hs +6/−0
• Data/Bifoldable.hs +589/−8
• Data/Bifunctor.hs +4/−0
• Data/Bitraversable.hs +67/−2
• Data/Bits.hs +44/−24
• Data/Complex.hs +10/−0
• Data/Data.hs +5/−1
• Data/Fixed.hs +58/−0
• Data/Foldable.hs +2260/−742
• Data/Functor.hs +1/−22
• Data/Functor/Classes.hs +20/−0
• Data/Functor/Contravariant.hs +131/−35
• Data/IORef.hs +1/−1
• Data/Kind.hs +2/−1
• Data/List.hs +1/−0
• Data/List/NonEmpty.hs +7/−0
• Data/Maybe.hs +2/−2
• Data/Monoid.hs +27/−21
• Data/OldList.hs +12/−1
• Data/Ord.hs +29/−6
• Data/STRef.hs +1/−1
• Data/Semigroup.hs +34/−7
• Data/Semigroup/Internal.hs +1/−1
• Data/Semigroup/Internal.hs-boot +1/−1
• Data/Traversable.hs +555/−92
• Data/Type/Equality.hs +1/−1
• Data/Typeable/Internal.hs +37/−28
• Data/Unique.hs +1/−2
• Data/Version.hs-boot +12/−0
• Data/Void.hs +1/−10
• Foreign/ForeignPtr/Imp.hs +0/−25
• Foreign/Marshal/Alloc.hs +4/−25
• Foreign/Marshal/Utils.hs +21/−11
• GHC/Base.hs +167/−120
• GHC/ByteOrder.hs +4/−0
• GHC/Conc/IO.hs +21/−7
• GHC/Conc/POSIX.hs +305/−0
• GHC/Conc/POSIX/Const.hsc +29/−0
• GHC/Conc/Sync.hs +20/−14
• GHC/Conc/Sync.hs-boot +72/−0
• GHC/Conc/WinIO.hs +28/−0
• GHC/Conc/Windows.hs +21/−247
• GHC/ConsoleHandler.hs +0/−162
• GHC/ConsoleHandler.hsc +142/−0
• GHC/Desugar.hs +4/−4
• GHC/Enum.hs +61/−22
• GHC/Err.hs +1/−5
• GHC/Event/Array.hs +31/−14
• GHC/Event/IntTable.hs +8/−5
• GHC/Event/Internal.hs +17/−135
• GHC/Event/Internal/Types.hs +160/−0
• GHC/Event/Manager.hs +2/−15
• GHC/Event/Thread.hs +3/−3
• GHC/Event/TimeOut.hs +40/−0
• GHC/Event/TimerManager.hs +3/−15
• GHC/Event/Windows.hsc +1291/−0
• GHC/Event/Windows/Clock.hs +55/−0
• GHC/Event/Windows/ConsoleEvent.hsc +72/−0
• GHC/Event/Windows/FFI.hsc +469/−0
• GHC/Event/Windows/ManagedThreadPool.hs +93/−0
• GHC/Event/Windows/Thread.hs +35/−0
• GHC/ExecutionStack/Internal.hsc +1/−1
• GHC/Exts.hs +22/−6
• GHC/Float.hs +85/−41
• GHC/Float/ConversionUtils.hs +7/−7
• GHC/Float/RealFracMethods.hs +26/−26
• GHC/Foreign.hs +13/−51
• GHC/ForeignPtr.hs +240/−35
• GHC/Generics.hs +20/−2
• GHC/IO.hs +6/−5
• GHC/IO.hs-boot +1/−1
• GHC/IO/Buffer.hs +55/−13
• GHC/IO/BufferedIO.hs +16/−8
• GHC/IO/Device.hs +19/−16
• GHC/IO/Encoding.hs +12/−2
• GHC/IO/Encoding/CodePage.hs +8/−11
• GHC/IO/Encoding/CodePage/API.hs +5/−13
• GHC/IO/FD.hs +51/−41
• GHC/IO/Handle.hs +44/−19
• GHC/IO/Handle/FD.hs +5/−0
• GHC/IO/Handle/Internals.hs +83/−25
• GHC/IO/Handle/Lock.hs +1/−1
• GHC/IO/Handle/Lock/Windows.hsc +66/−17
• GHC/IO/Handle/Text.hs +228/−95
• GHC/IO/Handle/Types.hs +9/−2
• GHC/IO/Handle/Windows.hs +235/−0
• GHC/IO/StdHandles.hs +73/−0
• GHC/IO/StdHandles.hs-boot +23/−0
• GHC/IO/SubSystem.hs +79/−0
• GHC/IO/Windows/Encoding.hs +218/−0
• GHC/IO/Windows/Handle.hsc +966/−0
• GHC/IO/Windows/Paths.hs +49/−0
• GHC/IOPort.hs +122/−0
• GHC/Int.hs +34/−34
• GHC/Integer.hs +219/−0
• GHC/Integer/Logarithms.hs +24/−0
• GHC/Ix.hs +428/−1
• GHC/List.hs +450/−84
• GHC/Maybe.hs +1/−1
• GHC/Natural.hs +114/−549
• GHC/Num.hs +33/−19
• GHC/OverloadedLabels.hs +2/−2
• GHC/Ptr.hs +5/−6
• GHC/RTS/Flags.hsc +82/−2
• GHC/Read.hs +6/−2
• GHC/Real.hs +74/−59
• GHC/ST.hs +2/−2
• GHC/Show.hs +11/−8
• GHC/Stable.hs +4/−2
• GHC/Stack/Types.hs +2/−3
• GHC/StaticPtr.hs +5/−4
• GHC/Stats.hsc +4/−0
• GHC/TopHandler.hs +1/−1
• GHC/TypeLits.hs +1/−1
• GHC/TypeNats.hs +3/−3
• GHC/Unicode.hs +7/−0
• GHC/Windows.hs +64/−13
• GHC/Word.hs +55/−21
• Numeric.hs +2/−0
• Numeric/Natural.hs +1/−1
• System/CPUTime.hsc +1/−1
• System/IO.hs +69/−10
• System/Info.hs +69/−10
• System/Posix/Internals.hs +1/−1
• System/Timeout.hs +1/−1
• Text/ParserCombinators/ReadPrec.hs +3/−3
• Text/Printf.hs +1/−0
• Unsafe/Coerce.hs +298/−49
• base.cabal +57/−31
• cbits/IOutils.c +484/−0
• cbits/WCsubst.c +30/−81
• cbits/Win32Utils.c +98/−4
• cbits/consUtils.c +5/−27
• cbits/fs.c +1/−1
• changelog.md +40/−12
• config.guess +25/−27
• config.sub +4/−8
• configure +32940/−33998
• configure.ac +2/−2
• include/HsBaseConfig.h.in +22/−81
• include/consUtils.h +1/−2
• include/fs.h +0/−1
• include/winio_structs.h +40/−0

@@ -141,5 +141,22 @@ -- extra functions  -- | One or none.+--+-- It is useful for modelling any computation that is allowed to fail.+--+-- ==== __Examples__+--+-- Using the 'Alternative' instance of `Control.Monad.Except`, the following functions:+--+-- >>> canFail = throwError "it failed" :: Except String Int+-- >>> final = return 42                :: Except String Int+--+-- Can be combined by allowing the first function to fail:+--+-- >>> runExcept $ canFail *> final+-- Left "it failed"+-- >>> runExcept $ optional canFail *> final+-- Right 42+ optional :: Alternative f => f a -> f (Maybe a) optional v = Just <$> v <|> pure Nothing

@@ -77,3 +77,67 @@ -- | Left-to-right composition (>>>) :: Category cat => cat a b -> cat b c -> cat a c f >>> g = g . f+{-# INLINE (>>>) #-} -- see Note [INLINE on >>>]++{- Note [INLINE on >>>]+~~~~~~~~~~~~~~~~~~~~~~~+It’s crucial that we include an INLINE pragma on >>>, which may be+surprising. After all, its unfolding is tiny, so GHC will be extremely+keen to inline it even without the pragma. Indeed, it is actually+/too/ keen: unintuitively, the pragma is needed to rein in inlining,+not to encourage it.++How is that possible? The difference lies entirely in whether GHC will+inline unsaturated calls. With no pragma at all, we get the following+unfolding guidance:+    ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)+But with the pragma, we restrict inlining to saturated calls:+    ALWAYS_IF(arity=3,unsat_ok=False,boring_ok=True)+Why does this matter? Because the programmer may have put an INLINE+pragma on (.):++    instance Functor f => Category (Blah f) where+      id = ...+      Blah f . Blah g = buildBlah (\x -> ...)+      {-# INLINE (.) #-}++The intent here is to inline (.) at all saturated call sites. Perhaps+there is a RULE on buildBlah the programmer wants to fire, or maybe+they just expect the inlining to expose further simplifications.+Either way, code that uses >>> should not defeat this inlining, but if+we inline unsaturated calls, it might! Consider:++    let comp = (>>>) ($fCategoryBlah $dFunctor) in f `comp` (g `comp` h)++While simplifying this expression, we’ll start with the RHS of comp.+Without the INLINE pragma on >>>, we’ll inline it immediately, even+though it isn’t saturated:++    let comp = \f g -> $fCategoryBlah_$c. $dFunctor g f+     in f `comp` (g `comp` h)++Now `$fCategoryBlah_$c. $dFunctor g f` /is/ a fully-saturated call, so+it will get inlined immediately, too:++    let comp = \(Blah g) (Blah f) -> buildBlah (\x -> ...)+     in f `comp` (g `comp` h)++All okay so far. But if the RHS of (.) is large, comp won’t be inlined+at its use sites, and any RULEs on `buildBlah` will never fire. Bad!++What happens differently with the INLINE pragma on >>>? Well, we won’t+inline >>> immediately, since it isn’t saturated, which means comp’s+unfolding will be tiny. GHC will inline it at both use sites:++    (>>>) ($fCategoryBlah $dFunctor) f+          ((>>>) ($fCategoryBlah $dFunctor) g h)++And now the calls to >>> are saturated, so they’ll be inlined,+followed by (.), and any RULEs can fire as desired. Problem solved.++This situation might seem academic --- who would ever write a+definition like comp? Probably nobody, but GHC generates such+definitions when desugaring proc notation, which causes real problems+(see #18013). That could be fixed by changing the proc desugaring, but+fixing it this way is the Right Thing, it might benefit other programs+in more subtle ways too, and it’s easier to boot. -}

@@ -0,0 +1,30 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Concurrent+-- Copyright   :  (c) The University of Glasgow 2018-2019+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (concurrency)+--+-- A common interface to a collection of useful concurrency+-- abstractions.+--+-----------------------------------------------------------------------------+module Control.Concurrent (+        -- * Bound Threads+        rtsSupportsBoundThreads,+        forkOS+    ) where++import Data.Bool++import GHC.IO+import GHC.Conc.Sync++rtsSupportsBoundThreads :: Bool+forkOS :: IO () -> IO ThreadId

@@ -95,7 +95,7 @@         -- * Calls for GHC runtime         recSelError, recConError, runtimeError,         nonExhaustiveGuardsError, patError, noMethodBindingError,-        absentError, absentSumFieldError, typeError,+        absentError, typeError,         nonTermination, nestedAtomically,   ) where @@ -166,7 +166,7 @@ -- | Similar to 'catch', but returns an 'Either' result which is -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@ -- if an exception of type @e@ was raised and its value is @ex@.--- If any other type of exception is raised than it will be propogated+-- If any other type of exception is raised then it will be propagated -- up to the next enclosing exception handler. -- -- >  try a = catch (Right `liftM` a) (return . Left)@@ -398,7 +398,3 @@ -- GHC's RTS calls this nestedAtomically :: SomeException nestedAtomically = toException NestedAtomically---- Introduced by unarise for unused unboxed sum fields-absentSumFieldError :: a-absentSumFieldError = absentError " in unboxed sum."#

@@ -164,17 +164,6 @@  -- | Repeat an action indefinitely. ----- Using @ApplicativeDo@: \'@'forever' as@\' can be understood as the--- pseudo-@do@ expression------ @--- do as---    as---    ..--- @------ with @as@ repeating.--- -- ==== __Examples__ -- -- A common use of 'forever' is to process input from network sockets,@@ -197,6 +186,10 @@ --     echo client = 'forever' $ --       hGetLine client >>= hPutStrLn client -- @+--+-- Note that "forever" isn't necessarily non-terminating.+-- If the action is in a @'MonadPlus'@ and short-circuits after some number of iterations.+-- then @'forever'@ actually returns `mzero`, effectively short-circuiting its caller. forever     :: (Applicative f) => f a -> f b {-# INLINE forever #-} forever a   = let a' = a *> a' in a'@@ -284,22 +277,14 @@ Core: https://gitlab.haskell.org/ghc/ghc/issues/11795#note_118976 -} --- | @'replicateM' n act@ performs the action @n@ times,--- gathering the results.------ Using @ApplicativeDo@: \'@'replicateM' 5 as@\' can be understood as--- the @do@ expression------ @--- do a1 <- as---    a2 <- as---    a3 <- as---    a4 <- as---    a5 <- as---    pure [a1,a2,a3,a4,a5]--- @+-- | @'replicateM' n act@ performs the action @act@ @n@ times,+-- and then returns the list of results: ----- Note the @Applicative@ constraint.+-- ==== __Examples__+-- >>> replicateM 3 (putStrLn "a")+-- a+-- a+-- a replicateM        :: (Applicative m) => Int -> m a -> m [a] {-# INLINABLE replicateM #-} {-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-}

@@ -33,6 +33,7 @@ import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail )+import GHC.Tuple (Solo (..)) import Control.Monad.ST.Imp import System.IO @@ -62,6 +63,11 @@         mfix :: (a -> m a) -> m a  -- Instances of MonadFix for Prelude monads++-- | @since 4.15+instance MonadFix Solo where+    mfix f = let a = f (unSolo a) in a+             where unSolo (Solo x) = x  -- | @since 2.01 instance MonadFix Maybe where

@@ -30,8 +30,42 @@  class (Monad m) => MonadIO m where     -- | Lift a computation from the 'IO' monad.+    -- This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations+    -- (i.e. 'IO' is the base monad for the stack).+    --+    -- === __Example__+    --+    --+    -- > import Control.Monad.Trans.State -- from the "transformers" library+    -- >+    -- > printState :: Show s => StateT s IO ()+    -- > printState = do+    -- >   state <- get+    -- >   liftIO $ print state+    --+    --+    -- Had we omitted @'liftIO'@, we would have ended up with this error:+    --+    -- > • Couldn't match type ‘IO’ with ‘StateT s IO’+    -- >  Expected type: StateT s IO ()+    -- >    Actual type: IO ()+    --+    -- The important part here is the mismatch between @StateT s IO ()@ and @'IO' ()@.+    --+    -- Luckily, we know of a function that takes an @'IO' a@ and returns an @(m a)@: @'liftIO'@,+    -- enabling us to run the program and see the expected results:+    --+    -- @+    -- > evalStateT printState "hello"+    -- "hello"+    --+    -- > evalStateT printState 3+    -- 3+    -- @+    --     liftIO :: IO a -> m a  -- | @since 4.9.0.0 instance MonadIO IO where     liftIO = id+

@@ -8,7 +8,7 @@ -- Module      :  Control.Monad.ST.Lazy.Imp -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional -- Portability :  non-portable (requires universal quantification for runST)@@ -44,12 +44,11 @@  import qualified GHC.ST as GHC.ST import GHC.Base-import qualified Control.Monad.Fail as Fail --- | The lazy @'ST' monad.--- The ST monad allows for destructive updates, but is escapable (unlike IO).+-- | The lazy @'ST'@ monad.+-- The ST monad allows for destructive updates, but is escapable (unlike @IO@). -- A computation of type @'ST' s a@ returns a value of type @a@, and--- execute in "thread" @s@. The @s@ parameter is either+-- executes in "thread" @s@. The @s@ parameter is either -- -- * an uninstantiated type variable (inside invocations of 'runST'), or --@@ -192,7 +191,7 @@          unST (k r) new_s  -- | @since 4.10-instance Fail.MonadFail (ST s) where+instance MonadFail (ST s) where     fail s = errorWithoutStackTrace s  -- | Return the value computed by an 'ST' computation.@@ -205,8 +204,8 @@ -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_@. fixST :: (a -> ST s a) -> ST s a-fixST m = ST (\ s -> -                let +fixST m = ST (\ s ->+                let                    q@(r,_s') = unST (m r) s                 in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q,@@ -233,7 +232,7 @@     (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a

@@ -25,6 +25,7 @@ import Data.Proxy import qualified Data.List.NonEmpty as NE import GHC.Generics+import GHC.Tuple (Solo (..))  -- | Instances should satisfy the laws: --@@ -70,6 +71,11 @@ instance MonadZip Identity where     mzipWith                 = liftM2     munzip (Identity (a, b)) = (Identity a, Identity b)++-- | @since 4.15.0.0+instance MonadZip Solo where+    mzipWith = liftM2+    munzip (Solo (a, b)) = (Solo a, Solo b)  -- | @since 4.8.0.0 instance MonadZip Dual where

@@ -55,9 +55,16 @@ import Data.Monoid import GHC.Generics (K1(..)) +-- $setup+-- >>> import Prelude+-- >>> import Data.Char+-- >>> import Data.Monoid (Product (..), Sum (..))+-- >>> data BiList a b = BiList [a] [b]+-- >>> instance Bifoldable BiList where bifoldr f g z (BiList as bs) = foldr f (foldr g z bs) as+ -- | 'Bifoldable' identifies foldable structures with two different varieties -- of elements (as opposed to 'Foldable', which has one variety of element).--- Common examples are 'Either' and '(,)':+-- Common examples are 'Either' and @(,)@: -- -- > instance Bifoldable Either where -- >   bifoldMap f _ (Left  a) = f a@@ -66,6 +73,15 @@ -- > instance Bifoldable (,) where -- >   bifoldr f g z (a, b) = f a (g b z) --+-- Some examples below also use the following BiList to showcase empty+-- Bifoldable behaviors when relevant ('Either' and '(,)' containing always exactly+-- resp. 1 and 2 elements):+--+-- > data BiList a b = BiList [a] [b]+-- >+-- > instance Bifoldable BiList where+-- >   bifoldr f g z (BiList as bs) = foldr f (foldr g z bs) as+-- -- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or -- 'bifoldr'. When defining more than this minimal set, one should ensure -- that the following identities hold:@@ -96,6 +112,25 @@   --   -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@   --+  -- ==== __Examples__+  --+  -- Basic usage:+  --+  -- >>> bifold (Right [1, 2, 3])+  -- [1,2,3]+  --+  -- >>> bifold (Left [5, 6])+  -- [5,6]+  --+  -- >>> bifold ([1, 2, 3], [4, 5])+  -- [1,2,3,4,5]+  --+  -- >>> bifold (Product 6, Product 7)+  -- Product {getProduct = 42}+  --+  -- >>> bifold (Sum 6, Sum 7)+  -- Sum {getSum = 13}+  --   -- @since 4.10.0.0   bifold :: Monoid m => p m m -> m   bifold = bifoldMap id id@@ -103,9 +138,21 @@   -- | Combines the elements of a structure, given ways of mapping them to a   -- common monoid.   ---  -- @'bifoldMap' f g-  --     ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@+  -- @'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@   --+  -- ==== __Examples__+  --+  -- Basic usage:+  --+  -- >>> bifoldMap (take 3) (fmap digitToInt) ([1..], "89")+  -- [1,2,3,8,9]+  --+  -- >>> bifoldMap (take 3) (fmap digitToInt) (Left [1..])+  -- [1,2,3]+  --+  -- >>> bifoldMap (take 3) (fmap digitToInt) (Right "89")+  -- [8,9]+  --   -- @since 4.10.0.0   bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m   bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty@@ -117,6 +164,24 @@   --   -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@   --+  -- ==== __Examples__+  --+  -- Basic usage:+  --+  -- @+  -- > bifoldr (+) (*) 3 (5, 7)+  -- 26 -- 5 + (7 * 3)+  --+  -- > bifoldr (+) (*) 3 (7, 5)+  -- 22 -- 7 + (5 * 3)+  --+  -- > bifoldr (+) (*) 3 (Right 5)+  -- 15 -- 5 * 3+  --+  -- > bifoldr (+) (*) 3 (Left 5)+  -- 8 -- 5 + 3+  -- @+  --   -- @since 4.10.0.0   bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c   bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z@@ -133,6 +198,24 @@   -- force the "inner" results, resulting in a thunk chain which then must be   -- evaluated from the outside-in.   --+  -- ==== __Examples__+  --+  -- Basic usage:+  --+  -- @+  -- > bifoldl (+) (*) 3 (5, 7)+  -- 56 -- (5 + 3) * 7+  --+  -- > bifoldl (+) (*) 3 (7, 5)+  -- 50 -- (7 + 3) * 5+  --+  -- > bifoldl (+) (*) 3 (Right 5)+  -- 15 -- 5 * 3+  --+  -- > bifoldl (+) (*) 3 (Left 5)+  -- 8 -- 5 + 3+  -- @+  --   -- @since 4.10.0.0   bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c   bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)@@ -187,6 +270,32 @@ -- | A variant of 'bifoldr' that has no base case, -- and thus may only be applied to non-empty structures. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bifoldr1 (+) (5, 7)+-- 12+--+-- >>> bifoldr1 (+) (Right 7)+-- 7+--+-- >>> bifoldr1 (+) (Left 5)+-- 5+--+-- @+-- > bifoldr1 (+) (BiList [1, 2] [3, 4])+-- 10 -- 1 + (2 + (3 + 4))+-- @+--+-- >>> bifoldr1 (+) (BiList [1, 2] [])+-- 3+--+-- On empty structures, this function throws an exception:+--+-- >>> bifoldr1 (+) (BiList [] [])+-- *** Exception: bifoldr1: empty structure+-- -- @since 4.10.0.0 bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure")@@ -222,6 +331,32 @@ -- | A variant of 'bifoldl' that has no base case, -- and thus may only be applied to non-empty structures. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bifoldl1 (+) (5, 7)+-- 12+--+-- >>> bifoldl1 (+) (Right 7)+-- 7+--+-- >>> bifoldl1 (+) (Left 5)+-- 5+--+-- @+-- > bifoldl1 (+) (BiList [1, 2] [3, 4])+-- 10 -- ((1 + 2) + 3) + 4+-- @+--+-- >>> bifoldl1 (+) (BiList [1, 2] [])+-- 3+--+-- On empty structures, this function throws an exception:+--+-- >>> bifoldl1 (+) (BiList [] [])+-- *** Exception: bifoldl1: empty structure+-- -- @since 4.10.0.0 bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure")@@ -233,6 +368,23 @@  -- | Left associative monadic bifold over a structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bifoldlM (\a b -> print b >> pure a) (\a c -> print (show c) >> pure a) 42 ("Hello", True)+-- "Hello"+-- "True"+-- 42+--+-- >>> bifoldlM (\a b -> print b >> pure a) (\a c -> print (show c) >> pure a) 42 (Right True)+-- "True"+-- 42+--+-- >>> bifoldlM (\a b -> print b >> pure a) (\a c -> print (show c) >> pure a) 42 (Left "Hello")+-- "Hello"+-- 42+-- -- @since 4.10.0.0 bifoldlM :: (Bifoldable t, Monad m)          => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a@@ -244,6 +396,20 @@ -- actions from left to right, and ignore the results. For a version that -- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bitraverse_ print (print . show) ("Hello", True)+-- "Hello"+-- "True"+--+-- >>> bitraverse_ print (print . show) (Right True)+-- "True"+--+-- >>> bitraverse_ print (print . show) (Left "Hello")+-- "Hello"+-- -- @since 4.10.0.0 bitraverse_ :: (Bifoldable t, Applicative f)             => (a -> f c) -> (b -> f d) -> t a b -> f ()@@ -252,10 +418,20 @@ -- | As 'bitraverse_', but with the structure as the primary argument. For a -- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'. ----- >>> > bifor_ ('a', "bc") print (print . reverse)--- 'a'--- "cb"+-- ==== __Examples__ --+-- Basic usage:+--+-- >>> bifor_ ("Hello", True) print (print . show)+-- "Hello"+-- "True"+--+-- >>> bifor_ (Right True) print (print . show)+-- "True"+--+-- >>> bifor_ (Left "Hello") print (print . show)+-- "Hello"+-- -- @since 4.10.0.0 bifor_ :: (Bifoldable t, Applicative f)        => t a b -> (a -> f c) -> (b -> f d) -> f ()@@ -285,12 +461,42 @@ -- results. For a version that doesn't ignore the results, see -- 'Data.Bitraversable.bisequence'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bisequence_ (print "Hello", print "World")+-- "Hello"+-- "World"+--+-- >>> bisequence_ (Left (print "Hello"))+-- "Hello"+--+-- >>> bisequence_ (Right (print "World"))+-- "World"+-- -- @since 4.10.0.0 bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequence_ = bifoldr (*>) (*>) (pure ())  -- | The sum of a collection of actions, generalizing 'biconcat'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biasum (Nothing, Nothing)+-- Nothing+--+-- >>> biasum (Nothing, Just 42)+-- Just 42+--+-- >>> biasum (Just 18, Nothing)+-- Just 18+--+-- >>> biasum (Just 18, Just 42)+-- Just 18+-- -- @since 4.10.0.0 biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a biasum = bifoldr (<|>) (<|>) empty@@ -303,36 +509,138 @@  -- | Collects the list of elements of a structure, from left to right. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biList (18, 42)+-- [18,42]+--+-- >>> biList (Left 18)+-- [18]+-- -- @since 4.10.0.0 biList :: Bifoldable t => t a a -> [a] biList = bifoldr (:) (:) []  -- | Test whether the structure is empty. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> binull (18, 42)+-- False+--+-- >>> binull (Right 42)+-- False+--+-- >>> binull (BiList [] [])+-- True+-- -- @since 4.10.0.0 binull :: Bifoldable t => t a b -> Bool binull = bifoldr (\_ _ -> False) (\_ _ -> False) True  -- | Returns the size/length of a finite structure as an 'Int'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bilength (True, 42)+-- 2+--+-- >>> bilength (Right 42)+-- 1+--+-- >>> bilength (BiList [1,2,3] [4,5])+-- 5+--+-- >>> bilength (BiList [] [])+-- 0+--+-- On infinite structures, this function hangs:+--+-- @+-- > bilength (BiList [1..] [])+-- * Hangs forever *+-- @+-- -- @since 4.10.0.0 bilength :: Bifoldable t => t a b -> Int bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0  -- | Does the element occur in the structure? --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bielem 42 (17, 42)+-- True+--+-- >>> bielem 42 (17, 43)+-- False+--+-- >>> bielem 42 (Left 42)+-- True+--+-- >>> bielem 42 (Right 13)+-- False+--+-- >>> bielem 42 (BiList [1..5] [1..100])+-- True+--+-- >>> bielem 42 (BiList [1..5] [1..41])+-- False+-- -- @since 4.10.0.0 bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool bielem x = biany (== x) (== x)  -- | Reduces a structure of lists to the concatenation of those lists. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biconcat ([1, 2, 3], [4, 5])+-- [1,2,3,4,5]+--+-- >>> biconcat (Left [1, 2, 3])+-- [1,2,3]+--+-- >>> biconcat (BiList [[1, 2, 3, 4, 5], [6, 7, 8]] [[9]])+-- [1,2,3,4,5,6,7,8,9]+-- -- @since 4.10.0.0 biconcat :: Bifoldable t => t [a] [a] -> [a] biconcat = bifold  -- | The largest element of a non-empty structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bimaximum (42, 17)+-- 42+--+-- >>> bimaximum (Right 42)+-- 42+--+-- >>> bimaximum (BiList [13, 29, 4] [18, 1, 7])+-- 29+--+-- >>> bimaximum (BiList [13, 29, 4] [])+-- 29+--+-- On empty structures, this function throws an exception:+--+-- >>> bimaximum (BiList [] [])+-- *** Exception: bimaximum: empty structure+-- -- @since 4.10.0.0 bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a bimaximum = fromMaybe (error "bimaximum: empty structure") .@@ -341,6 +649,27 @@  -- | The least element of a non-empty structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biminimum (42, 17)+-- 17+--+-- >>> biminimum (Right 42)+-- 42+--+-- >>> biminimum (BiList [13, 29, 4] [18, 1, 7])+-- 1+--+-- >>> biminimum (BiList [13, 29, 4] [])+-- 4+--+-- On empty structures, this function throws an exception:+--+-- >>> biminimum (BiList [] [])+-- *** Exception: biminimum: empty structure+-- -- @since 4.10.0.0 biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a biminimum = fromMaybe (error "biminimum: empty structure") .@@ -349,6 +678,25 @@  -- | The 'bisum' function computes the sum of the numbers of a structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bisum (42, 17)+-- 59+--+-- >>> bisum (Right 42)+-- 42+--+-- >>> bisum (BiList [13, 29, 4] [18, 1, 7])+-- 72+--+-- >>> bisum (BiList [13, 29, 4] [])+-- 46+--+-- >>> bisum (BiList [] [])+-- 0+-- -- @since 4.10.0.0 bisum :: (Bifoldable t, Num a) => t a a -> a bisum = getSum #. bifoldMap Sum Sum@@ -356,6 +704,25 @@ -- | The 'biproduct' function computes the product of the numbers of a -- structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biproduct (42, 17)+-- 714+--+-- >>> biproduct (Right 42)+-- 42+--+-- >>> biproduct (BiList [13, 29, 4] [18, 1, 7])+-- 190008+--+-- >>> biproduct (BiList [13, 29, 4] [])+-- 1508+--+-- >>> biproduct (BiList [] [])+-- 1+-- -- @since 4.10.0.0 biproduct :: (Bifoldable t, Num a) => t a a -> a biproduct = getProduct #. bifoldMap Product Product@@ -363,6 +730,19 @@ -- | Given a means of mapping the elements of a structure to lists, computes the -- concatenation of all such lists in order. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biconcatMap (take 3) (fmap digitToInt) ([1..], "89")+-- [1,2,3,8,9]+--+-- >>> biconcatMap (take 3) (fmap digitToInt) (Left [1..])+-- [1,2,3]+--+-- >>> biconcatMap (take 3) (fmap digitToInt) (Right "89")+-- [8,9]+-- -- @since 4.10.0.0 biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] biconcatMap = bifoldMap@@ -371,6 +751,43 @@ -- result to be 'True', the container must be finite; 'False', however, -- results from a 'False' value finitely far from the left end. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biand (True, False)+-- False+--+-- >>> biand (True, True)+-- True+--+-- >>> biand (Left True)+-- True+--+-- Empty structures yield 'True':+--+-- >>> biand (BiList [] [])+-- True+--+-- A 'False' value finitely far from the left end yields 'False' (short circuit):+--+-- >>> biand (BiList [True, True, False, True] (repeat True))+-- False+--+-- A 'False' value infinitely far from the left end hangs:+--+-- @+-- > biand (BiList (repeat True) [False])+-- * Hangs forever *+-- @+--+-- An infinitely 'True' value hangs:+--+-- @+-- > biand (BiList (repeat True) [])+-- * Hangs forever *+-- @+-- -- @since 4.10.0.0 biand :: Bifoldable t => t Bool Bool -> Bool biand = getAll #. bifoldMap All All@@ -379,20 +796,108 @@ -- result to be 'False', the container must be finite; 'True', however, -- results from a 'True' value finitely far from the left end. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bior (True, False)+-- True+--+-- >>> bior (False, False)+-- False+--+-- >>> bior (Left True)+-- True+--+-- Empty structures yield 'False':+--+-- >>> bior (BiList [] [])+-- False+--+-- A 'True' value finitely far from the left end yields 'True' (short circuit):+--+-- >>> bior (BiList [False, False, True, False] (repeat False))+-- True+--+-- A 'True' value infinitely far from the left end hangs:+--+-- @+-- > bior (BiList (repeat False) [True])+-- * Hangs forever *+-- @+--+-- An infinitely 'False' value hangs:+--+-- @+-- > bior (BiList (repeat False) [])+-- * Hangs forever *+-- @+-- -- @since 4.10.0.0 bior :: Bifoldable t => t Bool Bool -> Bool bior = getAny #. bifoldMap Any Any  -- | Determines whether any element of the structure satisfies its appropriate--- predicate argument.+-- predicate argument. Empty structures yield 'False'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biany even isDigit (27, 't')+-- False+--+-- >>> biany even isDigit (27, '8')+-- True+--+-- >>> biany even isDigit (26, 't')+-- True+--+-- >>> biany even isDigit (Left 27)+-- False+--+-- >>> biany even isDigit (Left 26)+-- True+--+-- >>> biany even isDigit (BiList [27, 53] ['t', '8'])+-- True+--+-- Empty structures yield 'False':+--+-- >>> biany even isDigit (BiList [] [])+-- False+-- -- @since 4.10.0.0 biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biany p q = getAny #. bifoldMap (Any . p) (Any . q)  -- | Determines whether all elements of the structure satisfy their appropriate--- predicate argument.+-- predicate argument. Empty structures yield 'True'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biall even isDigit (27, 't')+-- False+--+-- >>> biall even isDigit (26, '8')+-- True+--+-- >>> biall even isDigit (Left 27)+-- False+--+-- >>> biall even isDigit (Left 26)+-- True+--+-- >>> biall even isDigit (BiList [26, 52] ['3', '8'])+-- True+--+-- Empty structures yield 'True':+--+-- >>> biall even isDigit (BiList [] [])+-- True+-- -- @since 4.10.0.0 biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biall p q = getAll #. bifoldMap (All . p) (All . q)@@ -400,6 +905,24 @@ -- | The largest element of a non-empty structure with respect to the -- given comparison function. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bimaximumBy compare (42, 17)+-- 42+--+-- >>> bimaximumBy compare (Left 17)+-- 17+--+-- >>> bimaximumBy compare (BiList [42, 17, 23] [-5, 18])+-- 42+--+-- On empty structures, this function throws an exception:+--+-- >>> bimaximumBy compare (BiList [] [])+-- *** Exception: bifoldr1: empty structure+-- -- @since 4.10.0.0 bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a bimaximumBy cmp = bifoldr1 max'@@ -410,6 +933,24 @@ -- | The least element of a non-empty structure with respect to the -- given comparison function. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> biminimumBy compare (42, 17)+-- 17+--+-- >>> biminimumBy compare (Left 17)+-- 17+--+-- >>> biminimumBy compare (BiList [42, 17, 23] [-5, 18])+-- -5+--+-- On empty structures, this function throws an exception:+--+-- >>> biminimumBy compare (BiList [] [])+-- *** Exception: bifoldr1: empty structure+-- -- @since 4.10.0.0 biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a biminimumBy cmp = bifoldr1 min'@@ -419,6 +960,28 @@  -- | 'binotElem' is the negation of 'bielem'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> binotElem 42 (17, 42)+-- False+--+-- >>> binotElem 42 (17, 43)+-- True+--+-- >>> binotElem 42 (Left 42)+-- False+--+-- >>> binotElem 42 (Right 13)+-- True+--+-- >>> binotElem 42 (BiList [1..5] [1..100])+-- False+--+-- >>> binotElem 42 (BiList [1..5] [1..41])+-- True+-- -- @since 4.10.0.0 binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool binotElem x =  not . bielem x@@ -426,6 +989,24 @@ -- | The 'bifind' function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bifind even (27, 53)+-- Nothing+--+-- >>> bifind even (27, 52)+-- Just 52+--+-- >>> bifind even (26, 52)+-- Just 26+--+-- Empty structures always yield 'Nothing':+--+-- >>> bifind even (BiList [] [])+-- Nothing -- -- @since 4.10.0.0 bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a

@@ -20,6 +20,10 @@ import Control.Applicative  ( Const(..) ) import GHC.Generics ( K1(..) ) +-- $setup+-- >>> import Prelude+-- >>> import Data.Char (toUpper)+ -- | A bifunctor is a type constructor that takes -- two type arguments and is a functor in /both/ arguments. That -- is, unlike with 'Functor', a type constructor such as 'Either'

@@ -73,7 +73,7 @@ -- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and -- "Data.Functor.Compose". ----- Some simple examples are 'Either' and '(,)':+-- Some simple examples are 'Either' and @(,)@: -- -- > instance Bitraversable Either where -- >   bitraverse f _ (Left x) = Left <$> f x@@ -101,6 +101,25 @@   --   -- For a version that ignores the results, see 'bitraverse_'.   --+  -- ==== __Examples__+  --+  -- Basic usage:+  --+  -- >>> bitraverse listToMaybe (find odd) (Left [])+  -- Nothing+  --+  -- >>> bitraverse listToMaybe (find odd) (Left [1, 2, 3])+  -- Just (Left 1)+  --+  -- >>> bitraverse listToMaybe (find odd) (Right [4, 5])+  -- Just (Right 5)+  --+  -- >>> bitraverse listToMaybe (find odd) ([1, 2, 3], [4, 5])+  -- Just (1,5)+  --+  -- >>> bitraverse listToMaybe (find odd) ([], [4, 5])+  -- Nothing+  --   -- @since 4.10.0.0   bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)   bitraverse f g = bisequenceA . bimap f g@@ -124,6 +143,19 @@ -- -- @'bisequence' ≡ 'bitraverse' 'id' 'id'@ --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bisequence (Just 4, Nothing)+-- Nothing+--+-- >>> bisequence (Just 4, Just 5)+-- Just (4,5)+--+-- >>> bisequence ([1, 2, 3], [4, 5])+-- [(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]+-- -- @since 4.10.0.0 bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequence = bitraverse id id@@ -169,6 +201,25 @@ -- | 'bifor' is 'bitraverse' with the structure as the first argument. For a -- version that ignores the results, see 'bifor_'. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bifor (Left []) listToMaybe (find even)+-- Nothing+--+-- >>> bifor (Left [1, 2, 3]) listToMaybe (find even)+-- Just (Left 1)+--+-- >>> bifor (Right [4, 5]) listToMaybe (find even)+-- Just (Right 4)+--+-- >>> bifor ([1, 2, 3], [4, 5]) listToMaybe (find even)+-- Just (1,4)+--+-- >>> bifor ([], [4, 5]) listToMaybe (find even)+-- Nothing+-- -- @since 4.10.0.0 bifor :: (Bitraversable t, Applicative f)       => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)@@ -186,6 +237,13 @@ -- of type @a@ and using the given actions to compute new elements for the -- structure. --+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bimapAccumL (\acc bool -> (acc + 1, show bool)) (\acc string -> (acc * 2, reverse string)) 3 (True, "foo")+-- (8,("True","oof"))+-- -- @since 4.10.0.0 bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))             -> a -> t b d -> (a, t c e)@@ -193,9 +251,16 @@   = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s  -- | The 'bimapAccumR' function behaves like a combination of 'bimap' and--- 'bifoldl'; it traverses a structure from right to left, threading a state+-- 'bifoldr'; it traverses a structure from right to left, threading a state -- of type @a@ and using the given actions to compute new elements for the -- structure.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> bimapAccumR (\acc bool -> (acc + 1, show bool)) (\acc string -> (acc * 2, reverse string)) 3 (True, "foo")+-- (7,("True","oof")) -- -- @since 4.10.0.0 bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))

@@ -168,10 +168,14 @@     -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@     complementBit     :: a -> Int -> a -    -- | Return 'True' if the @n@th bit of the argument is 1-    ---    -- Can be implemented using `testBitDefault' if @a@ is also an-    -- instance of 'Num'.+    {-| @x \`testBit\` i@ is the same as @x .&. bit n /= 0@++        In other words it returns True if the bit at offset @n+        is set.++        Can be implemented using `testBitDefault' if @a@ is also an+        instance of 'Num'.+        -}     testBit           :: a -> Int -> Bool      {-| Return the number of bits in the type of the argument.  The actual@@ -529,17 +533,25 @@  -- | @since 2.01 instance Bits Integer where-   (.&.) = andInteger-   (.|.) = orInteger-   xor = xorInteger-   complement = complementInteger-   shift x i@(I# i#) | i >= 0    = shiftLInteger x i#-                     | otherwise = shiftRInteger x (negateInt# i#)-   testBit x (I# i) = testBitInteger x i-   zeroBits   = 0+   (.&.)      = integerAnd+   (.|.)      = integerOr+   xor        = integerXor+   complement = integerComplement+   unsafeShiftR x i = integerShiftR x (fromIntegral i)+   unsafeShiftL x i = integerShiftL x (fromIntegral i)+   shiftR x i@(I# i#)+      | isTrue# (i# >=# 0#) = unsafeShiftR x i+      | otherwise           = overflowError+   shiftL x i@(I# i#)+      | isTrue# (i# >=# 0#) = unsafeShiftL x i+      | otherwise           = overflowError+   shift x i | i >= 0    = integerShiftL x (fromIntegral i)+             | otherwise = integerShiftR x (fromIntegral (negate i))+   testBit x i = integerTestBit x (fromIntegral i)+   zeroBits    = integerZero -   bit (I# i#) = bitInteger i#-   popCount x  = I# (popCountInteger x)+   bit (I# i)  = integerBit# (int2Word# i)+   popCount x  = I# (integerPopCount# x)     rotate x i = shift x i   -- since an Integer never wraps around @@ -549,20 +561,28 @@  -- | @since 4.8.0 instance Bits Natural where-   (.&.) = andNatural-   (.|.) = orNatural-   xor = xorNatural-   complement _ = errorWithoutStackTrace+   (.&.)         = naturalAnd+   (.|.)         = naturalOr+   xor           = naturalXor+   complement _  = errorWithoutStackTrace                     "Bits.complement: Natural complement undefined"+   unsafeShiftR x i = naturalShiftR x (fromIntegral i)+   unsafeShiftL x i = naturalShiftL x (fromIntegral i)+   shiftR x i@(I# i#)+      | isTrue# (i# >=# 0#) = unsafeShiftR x i+      | otherwise           = overflowError+   shiftL x i@(I# i#)+      | isTrue# (i# >=# 0#) = unsafeShiftL x i+      | otherwise           = overflowError    shift x i-     | i >= 0    = shiftLNatural x i-     | otherwise = shiftRNatural x (negate i)-   testBit x i   = testBitNatural x i-   zeroBits      = wordToNaturalBase 0##+     | i >= 0    = naturalShiftL x (fromIntegral i)+     | otherwise = naturalShiftR x (fromIntegral (negate i))+   testBit x i   = naturalTestBit x (fromIntegral i)+   zeroBits      = naturalZero    clearBit x i  = x `xor` (bit i .&. x) -   bit (I# i#) = bitNatural i#-   popCount x  = popCountNatural x+   bit (I# i)  = naturalBit# (int2Word# i)+   popCount x  = I# (word2Int# (naturalPopCount# x))     rotate x i = shift x i   -- since an Natural never wraps around 

@@ -42,6 +42,8 @@ import Data.Data (Data) import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,                 alignment)+import Control.Monad.Fix (MonadFix(..))+import Control.Monad.Zip (MonadZip(..))  infix  6  :+ @@ -250,6 +252,14 @@ -- | @since 4.9.0.0 instance Monad Complex where   a :+ b >>= f = realPart (f a) :+ imagPart (f b)++-- | @since 4.15.0.0+instance MonadZip Complex where+  mzipWith = liftA2++-- | @since 4.15.0.0+instance MonadFix Complex where+  mfix f = (let a :+ _ = f a in a) :+ (let _ :+ a = f a in a)  -- ----------------------------------------------------------------------------- -- Rules on Complex

@@ -128,6 +128,7 @@ import GHC.Num import GHC.Read import GHC.Show+import GHC.Tuple (Solo (..)) import Text.Read( reads )  -- Imports for the instances@@ -194,7 +195,7 @@ needed. We use a higher-order accumulation trick to mediate between left-associative constructor application vs. right-associative binary operation (e.g., @(:)@).  When the query is meant to compute a value-of type @r@, then the result type withing generic folding is @r -> r@.+of type @r@, then the result type within generic folding is @r -> r@. So the result of folding is a function to which we finally pass the right unit. @@ -1184,6 +1185,9 @@  -- | @since 4.0.0.0 deriving instance Data ()++-- | @since 4.15+deriving instance Data a => Data (Solo a)  -- | @since 4.0.0.0 deriving instance (Data a, Data b) => Data (a,b)

@@ -94,6 +94,64 @@ withResolution foo = withType (foo . resolution)  -- | @since 2.01+--+-- Recall that, for numeric types, 'succ' and 'pred' typically add and subtract+-- @1@, respectively. This is not true in the case of 'Fixed', whose successor+-- and predecessor functions intuitively return the "next" and "previous" values+-- in the enumeration. The results of these functions thus depend on the+-- resolution of the 'Fixed' value. For example, when enumerating values of+-- resolution @10^-3@ of @type Milli = Fixed E3@,+--+-- @+--   succ (0.000 :: Milli) == 1.001+-- @+--+--+-- and likewise+--+-- @+--   pred (0.000 :: Milli) == -0.001+-- @+--+--+-- In other words, 'succ' and 'pred' increment and decrement a fixed-precision+-- value by the least amount such that the value's resolution is unchanged.+-- For example, @10^-12@ is the smallest (positive) amount that can be added to+-- a value of @type Pico = Fixed E12@ without changing its resolution, and so+--+-- @+--   succ (0.000000000000 :: Pico) == 0.000000000001+-- @+--+--+-- and similarly+--+-- @+--   pred (0.000000000000 :: Pico) == -0.000000000001+-- @+--+--+-- This is worth bearing in mind when defining 'Fixed' arithmetic sequences. In+-- particular, you may be forgiven for thinking the sequence+--+-- @+--   [1..10] :: [Pico]+-- @+--+--+-- evaluates to @[1, 2, 3, 4, 5, 6, 7, 8, 9, 10] :: [Pico]@.+--+-- However, this is not true. On the contrary, similarly to the above+-- implementations of 'succ' and 'pred', @enumFromTo :: Pico -> Pico -> [Pico]@+-- has a "step size" of @10^-12@. Hence, the list @[1..10] :: [Pico]@ has+-- the form+--+-- @+--   [1.000000000000, 1.00000000001, 1.00000000002, ..., 10.000000000000]+-- @+--+--+-- and contains @9 * 10^12 + 1@ values. instance Enum (Fixed a) where     succ (MkFixed a) = MkFixed (succ a)     pred (MkFixed a) = MkFixed (pred a)

@@ -48,745 +48,2263 @@     -- * Searches     notElem,     find-    ) where--import Data.Bool-import Data.Either-import Data.Eq-import Data.Functor.Utils (Max(..), Min(..), (#.))-import qualified GHC.List as List-import Data.Maybe-import Data.Monoid-import Data.Ord-import Data.Proxy--import GHC.Arr  ( Array(..), elems, numElements,-                  foldlElems, foldrElems,-                  foldlElems', foldrElems',-                  foldl1Elems, foldr1Elems)-import GHC.Base hiding ( foldr )-import GHC.Generics-import GHC.Num  ( Num(..) )--infix  4 `elem`, `notElem`---- | Data structures that can be folded.------ For example, given a data type------ > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)------ a suitable instance would be------ > instance Foldable Tree where--- >    foldMap f Empty = mempty--- >    foldMap f (Leaf x) = f x--- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r------ This is suitable even for abstract types, as the monoid is assumed--- to satisfy the monoid laws.  Alternatively, one could define @foldr@:------ > instance Foldable Tree where--- >    foldr f z Empty = z--- >    foldr f z (Leaf x) = f x z--- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l------ @Foldable@ instances are expected to satisfy the following laws:------ > foldr f z t = appEndo (foldMap (Endo . f) t ) z------ > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z------ > fold = foldMap id------ > length = getSum . foldMap (Sum . const  1)------ @sum@, @product@, @maximum@, and @minimum@ should all be essentially--- equivalent to @foldMap@ forms, such as------ > sum = getSum . foldMap Sum------ but may be less defined.------ If the type is also a 'Functor' instance, it should satisfy------ > foldMap f = fold . fmap f------ which implies that------ > foldMap f . fmap g = foldMap (f . g)--class Foldable t where-    {-# MINIMAL foldMap | foldr #-}--    -- | Combine the elements of a structure using a monoid.-    fold :: Monoid m => t m -> m-    fold = foldMap id--    -- | Map each element of the structure to a monoid,-    -- and combine the results.-    foldMap :: Monoid m => (a -> m) -> t a -> m-    {-# INLINE foldMap #-}-    -- This INLINE allows more list functions to fuse. See #9848.-    foldMap f = foldr (mappend . f) mempty--    -- | A variant of 'foldMap' that is strict in the accumulator.-    ---    -- @since 4.13.0.0-    foldMap' :: Monoid m => (a -> m) -> t a -> m-    foldMap' f = foldl' (\ acc a -> acc <> f a) mempty--    -- | Right-associative fold of a structure.-    ---    -- In the case of lists, 'foldr', when applied to a binary operator, a-    -- starting value (typically the right-identity of the operator), and a-    -- list, reduces the list using the binary operator, from right to left:-    ---    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)-    ---    -- Note that, since the head of the resulting expression is produced by-    -- an application of the operator to the first element of the list,-    -- 'foldr' can produce a terminating expression from an infinite list.-    ---    -- For a general 'Foldable' structure this should be semantically identical-    -- to,-    ---    -- @foldr f z = 'List.foldr' f z . 'toList'@-    ---    foldr :: (a -> b -> b) -> b -> t a -> b-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    -- | Right-associative fold of a structure, but with strict application of-    -- the operator.-    ---    -- @since 4.6.0.0-    foldr' :: (a -> b -> b) -> b -> t a -> b-    foldr' f z0 xs = foldl f' id xs z0-      where f' k x z = k $! f x z--    -- | Left-associative fold of a structure.-    ---    -- In the case of lists, 'foldl', when applied to a binary-    -- operator, a starting value (typically the left-identity of the operator),-    -- and a list, reduces the list using the binary operator, from left to-    -- right:-    ---    -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn-    ---    -- Note that to produce the outermost application of the operator the-    -- entire input list must be traversed. This means that 'foldl'' will-    -- diverge if given an infinite list.-    ---    -- Also note that if you want an efficient left-fold, you probably want to-    -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does-    -- not force the "inner" results (e.g. @z \`f\` x1@ in the above example)-    -- before applying them to the operator (e.g. to @(\`f\` x2)@). This results-    -- in a thunk chain \(\mathcal{O}(n)\) elements long, which then must be-    -- evaluated from the outside-in.-    ---    -- For a general 'Foldable' structure this should be semantically identical-    -- to,-    ---    -- @foldl f z = 'List.foldl' f z . 'toList'@-    ---    foldl :: (b -> a -> b) -> b -> t a -> b-    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z-    -- There's no point mucking around with coercions here,-    -- because flip forces us to build a new function anyway.--    -- | Left-associative fold of a structure but with strict application of-    -- the operator.-    ---    -- This ensures that each step of the fold is forced to weak head normal-    -- form before being applied, avoiding the collection of thunks that would-    -- otherwise occur. This is often what you want to strictly reduce a finite-    -- list to a single, monolithic result (e.g. 'length').-    ---    -- For a general 'Foldable' structure this should be semantically identical-    -- to,-    ---    -- @foldl' f z = 'List.foldl'' f z . 'toList'@-    ---    -- @since 4.6.0.0-    foldl' :: (b -> a -> b) -> b -> t a -> b-    foldl' f z0 xs = foldr f' id xs z0-      where f' x k z = k $! f z x--    -- | A variant of 'foldr' that has no base case,-    -- and thus may only be applied to non-empty structures.-    ---    -- @'foldr1' f = 'List.foldr1' f . 'toList'@-    foldr1 :: (a -> a -> a) -> t a -> a-    foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")-                    (foldr mf Nothing xs)-      where-        mf x m = Just (case m of-                         Nothing -> x-                         Just y  -> f x y)--    -- | A variant of 'foldl' that has no base case,-    -- and thus may only be applied to non-empty structures.-    ---    -- @'foldl1' f = 'List.foldl1' f . 'toList'@-    foldl1 :: (a -> a -> a) -> t a -> a-    foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")-                    (foldl mf Nothing xs)-      where-        mf m y = Just (case m of-                         Nothing -> y-                         Just x  -> f x y)--    -- | List of elements of a structure, from left to right.-    ---    -- @since 4.8.0.0-    toList :: t a -> [a]-    {-# INLINE toList #-}-    toList t = build (\ c n -> foldr c n t)--    -- | Test whether the structure is empty. The default implementation is-    -- optimized for structures that are similar to cons-lists, because there-    -- is no general way to do better.-    ---    -- @since 4.8.0.0-    null :: t a -> Bool-    null = foldr (\_ _ -> False) True--    -- | Returns the size/length of a finite structure as an 'Int'.  The-    -- default implementation is optimized for structures that are similar to-    -- cons-lists, because there is no general way to do better.-    ---    -- @since 4.8.0.0-    length :: t a -> Int-    length = foldl' (\c _ -> c+1) 0--    -- | Does the element occur in the structure?-    ---    -- @since 4.8.0.0-    elem :: Eq a => a -> t a -> Bool-    elem = any . (==)--    -- | The largest element of a non-empty structure.-    ---    -- @since 4.8.0.0-    maximum :: forall a . Ord a => t a -> a-    maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .-       getMax . foldMap (Max #. (Just :: a -> Maybe a))--    -- | The least element of a non-empty structure.-    ---    -- @since 4.8.0.0-    minimum :: forall a . Ord a => t a -> a-    minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .-       getMin . foldMap (Min #. (Just :: a -> Maybe a))--    -- | The 'sum' function computes the sum of the numbers of a structure.-    ---    -- @since 4.8.0.0-    sum :: Num a => t a -> a-    sum = getSum #. foldMap Sum--    -- | The 'product' function computes the product of the numbers of a-    -- structure.-    ---    -- @since 4.8.0.0-    product :: Num a => t a -> a-    product = getProduct #. foldMap Product---- instances for Prelude types---- | @since 2.01-instance Foldable Maybe where-    foldMap = maybe mempty--    foldr _ z Nothing = z-    foldr f z (Just x) = f x z--    foldl _ z Nothing = z-    foldl f z (Just x) = f z x---- | @since 2.01-instance Foldable [] where-    elem    = List.elem-    foldl   = List.foldl-    foldl'  = List.foldl'-    foldl1  = List.foldl1-    foldr   = List.foldr-    foldr1  = List.foldr1-    length  = List.length-    maximum = List.maximum-    minimum = List.minimum-    null    = List.null-    product = List.product-    sum     = List.sum-    toList  = id---- | @since 4.9.0.0-instance Foldable NonEmpty where-  foldr f z ~(a :| as) = f a (List.foldr f z as)-  foldl f z (a :| as) = List.foldl f (f z a) as-  foldl1 f (a :| as) = List.foldl f a as--  -- GHC isn't clever enough to transform the default definition-  -- into anything like this, so we'd end up shuffling a bunch of-  -- Maybes around.-  foldr1 f (p :| ps) = foldr go id ps p-    where-      go x r prev = f prev (r x)--  -- We used to say-  ---  --   length (_ :| as) = 1 + length as-  ---  -- but the default definition is better, counting from 1.-  ---  -- The default definition also works great for null and foldl'.-  -- As usual for cons lists, foldr' is basically hopeless.--  foldMap f ~(a :| as) = f a `mappend` foldMap f as-  fold ~(m :| ms) = m `mappend` fold ms-  toList ~(a :| as) = a : as---- | @since 4.7.0.0-instance Foldable (Either a) where-    foldMap _ (Left _) = mempty-    foldMap f (Right y) = f y--    foldr _ z (Left _) = z-    foldr f z (Right y) = f y z--    length (Left _)  = 0-    length (Right _) = 1--    null             = isLeft---- | @since 4.7.0.0-instance Foldable ((,) a) where-    foldMap f (_, y) = f y--    foldr f z (_, y) = f y z-    length _  = 1-    null _ = False---- | @since 4.8.0.0-instance Foldable (Array i) where-    foldr = foldrElems-    foldl = foldlElems-    foldl' = foldlElems'-    foldr' = foldrElems'-    foldl1 = foldl1Elems-    foldr1 = foldr1Elems-    toList = elems-    length = numElements-    null a = numElements a == 0---- | @since 4.7.0.0-instance Foldable Proxy where-    foldMap _ _ = mempty-    {-# INLINE foldMap #-}-    fold _ = mempty-    {-# INLINE fold #-}-    foldr _ z _ = z-    {-# INLINE foldr #-}-    foldl _ z _ = z-    {-# INLINE foldl #-}-    foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy"-    foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy"-    length _   = 0-    null _     = True-    elem _ _   = False-    sum _      = 0-    product _  = 1---- | @since 4.8.0.0-instance Foldable Dual where-    foldMap            = coerce--    elem               = (. getDual) #. (==)-    foldl              = coerce-    foldl'             = coerce-    foldl1 _           = getDual-    foldr f z (Dual x) = f x z-    foldr'             = foldr-    foldr1 _           = getDual-    length _           = 1-    maximum            = getDual-    minimum            = getDual-    null _             = False-    product            = getDual-    sum                = getDual-    toList (Dual x)    = [x]---- | @since 4.8.0.0-instance Foldable Sum where-    foldMap            = coerce--    elem               = (. getSum) #. (==)-    foldl              = coerce-    foldl'             = coerce-    foldl1 _           = getSum-    foldr f z (Sum x)  = f x z-    foldr'             = foldr-    foldr1 _           = getSum-    length _           = 1-    maximum            = getSum-    minimum            = getSum-    null _             = False-    product            = getSum-    sum                = getSum-    toList (Sum x)     = [x]---- | @since 4.8.0.0-instance Foldable Product where-    foldMap               = coerce--    elem                  = (. getProduct) #. (==)-    foldl                 = coerce-    foldl'                = coerce-    foldl1 _              = getProduct-    foldr f z (Product x) = f x z-    foldr'                = foldr-    foldr1 _              = getProduct-    length _              = 1-    maximum               = getProduct-    minimum               = getProduct-    null _                = False-    product               = getProduct-    sum                   = getProduct-    toList (Product x)    = [x]---- | @since 4.8.0.0-instance Foldable First where-    foldMap f = foldMap f . getFirst---- | @since 4.8.0.0-instance Foldable Last where-    foldMap f = foldMap f . getLast---- | @since 4.12.0.0-instance (Foldable f) => Foldable (Alt f) where-    foldMap f = foldMap f . getAlt---- | @since 4.12.0.0-instance (Foldable f) => Foldable (Ap f) where-    foldMap f = foldMap f . getAp---- Instances for GHC.Generics--- | @since 4.9.0.0-instance Foldable U1 where-    foldMap _ _ = mempty-    {-# INLINE foldMap #-}-    fold _ = mempty-    {-# INLINE fold #-}-    foldr _ z _ = z-    {-# INLINE foldr #-}-    foldl _ z _ = z-    {-# INLINE foldl #-}-    foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"-    foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"-    length _   = 0-    null _     = True-    elem _ _   = False-    sum _      = 0-    product _  = 1---- | @since 4.9.0.0-deriving instance Foldable V1---- | @since 4.9.0.0-deriving instance Foldable Par1---- | @since 4.9.0.0-deriving instance Foldable f => Foldable (Rec1 f)---- | @since 4.9.0.0-deriving instance Foldable (K1 i c)---- | @since 4.9.0.0-deriving instance Foldable f => Foldable (M1 i c f)---- | @since 4.9.0.0-deriving instance (Foldable f, Foldable g) => Foldable (f :+: g)---- | @since 4.9.0.0-deriving instance (Foldable f, Foldable g) => Foldable (f :*: g)---- | @since 4.9.0.0-deriving instance (Foldable f, Foldable g) => Foldable (f :.: g)---- | @since 4.9.0.0-deriving instance Foldable UAddr---- | @since 4.9.0.0-deriving instance Foldable UChar---- | @since 4.9.0.0-deriving instance Foldable UDouble---- | @since 4.9.0.0-deriving instance Foldable UFloat---- | @since 4.9.0.0-deriving instance Foldable UInt---- | @since 4.9.0.0-deriving instance Foldable UWord---- Instances for Data.Ord--- | @since 4.12.0.0-deriving instance Foldable Down---- | Monadic fold over the elements of a structure,--- associating to the right, i.e. from right to left.-foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b-foldrM f z0 xs = foldl c return xs z0-  -- See Note [List fusion and continuations in 'c']-  where c k x z = f x z >>= k-        {-# INLINE c #-}---- | Monadic fold over the elements of a structure,--- associating to the left, i.e. from left to right.-foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b-foldlM f z0 xs = foldr c return xs z0-  -- See Note [List fusion and continuations in 'c']-  where c x k z = f z x >>= k-        {-# INLINE c #-}---- | Map each element of a structure to an action, evaluate these--- actions from left to right, and ignore the results. For a version--- that doesn't ignore the results see 'Data.Traversable.traverse'.-traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()-traverse_ f = foldr c (pure ())-  -- See Note [List fusion and continuations in 'c']-  where c x k = f x *> k-        {-# INLINE c #-}---- | 'for_' is 'traverse_' with its arguments flipped. For a version--- that doesn't ignore the results see 'Data.Traversable.for'.------ >>> for_ [1..4] print--- 1--- 2--- 3--- 4-for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()-{-# INLINE for_ #-}-for_ = flip traverse_---- | Map each element of a structure to a monadic action, evaluate--- these actions from left to right, and ignore the results. For a--- version that doesn't ignore the results see--- 'Data.Traversable.mapM'.------ As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to--- 'Monad'.-mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()-mapM_ f = foldr c (return ())-  -- See Note [List fusion and continuations in 'c']-  where c x k = f x >> k-        {-# INLINE c #-}---- | 'forM_' is 'mapM_' with its arguments flipped. For a version that--- doesn't ignore the results see 'Data.Traversable.forM'.------ As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'.-forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()-{-# INLINE forM_ #-}-forM_ = flip mapM_---- | Evaluate each action in the structure from left to right, and--- ignore the results. For a version that doesn't ignore the results--- see 'Data.Traversable.sequenceA'.-sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()-sequenceA_ = foldr c (pure ())-  -- See Note [List fusion and continuations in 'c']-  where c m k = m *> k-        {-# INLINE c #-}---- | Evaluate each monadic action in the structure from left to right,--- and ignore the results. For a version that doesn't ignore the--- results see 'Data.Traversable.sequence'.------ As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized--- to 'Monad'.-sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()-sequence_ = foldr c (return ())-  -- See Note [List fusion and continuations in 'c']-  where c m k = m >> k-        {-# INLINE c #-}---- | The sum of a collection of actions, generalizing 'concat'.------ >>> asum [Just "Hello", Nothing, Just "World"]--- Just "Hello"-asum :: (Foldable t, Alternative f) => t (f a) -> f a-{-# INLINE asum #-}-asum = foldr (<|>) empty---- | The sum of a collection of actions, generalizing 'concat'.--- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'.-msum :: (Foldable t, MonadPlus m) => t (m a) -> m a-{-# INLINE msum #-}-msum = asum---- | The concatenation of all the elements of a container of lists.-concat :: Foldable t => t [a] -> [a]-concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)-{-# INLINE concat #-}---- | Map a function over all the elements of a container and concatenate--- the resulting lists.-concatMap :: Foldable t => (a -> [b]) -> t a -> [b]-concatMap f xs = build (\c n -> foldr (\x b -> foldr c b (f x)) n xs)-{-# INLINE concatMap #-}---- These use foldr rather than foldMap to avoid repeated concatenation.---- | 'and' returns the conjunction of a container of Bools.  For the--- result to be 'True', the container must be finite; 'False', however,--- results from a 'False' value finitely far from the left end.-and :: Foldable t => t Bool -> Bool-and = getAll #. foldMap All---- | 'or' returns the disjunction of a container of Bools.  For the--- result to be 'False', the container must be finite; 'True', however,--- results from a 'True' value finitely far from the left end.-or :: Foldable t => t Bool -> Bool-or = getAny #. foldMap Any---- | Determines whether any element of the structure satisfies the predicate.-any :: Foldable t => (a -> Bool) -> t a -> Bool-any p = getAny #. foldMap (Any #. p)---- | Determines whether all elements of the structure satisfy the predicate.-all :: Foldable t => (a -> Bool) -> t a -> Bool-all p = getAll #. foldMap (All #. p)---- | The largest element of a non-empty structure with respect to the--- given comparison function.---- See Note [maximumBy/minimumBy space usage]-maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-maximumBy cmp = foldl1 max'-  where max' x y = case cmp x y of-                        GT -> x-                        _  -> y---- | The least element of a non-empty structure with respect to the--- given comparison function.---- See Note [maximumBy/minimumBy space usage]-minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a-minimumBy cmp = foldl1 min'-  where min' x y = case cmp x y of-                        GT -> y-                        _  -> x---- | 'notElem' is the negation of 'elem'.-notElem :: (Foldable t, Eq a) => a -> t a -> Bool-notElem x = not . elem x---- | The 'find' function takes a predicate and a structure and returns--- the leftmost element of the structure matching the predicate, or--- 'Nothing' if there is no such element.-find :: Foldable t => (a -> Bool) -> t a -> Maybe a-find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))--{--Note [List fusion and continuations in 'c']-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we define-  mapM_ f = foldr ((>>) . f) (return ())-(this is the way it used to be).--Now suppose we want to optimise the call--  mapM_ <big> (build g)-    where-  g c n = ...(c x1 y1)...(c x2 y2)....n...--GHC used to proceed like this:--  mapM_ <big> (build g)--  = { Definition of mapM_ }-    foldr ((>>) . <big>) (return ()) (build g)--  = { foldr/build rule }-    g ((>>) . <big>) (return ())--  = { Inline g }-    let c = (>>) . <big>-        n = return ()-    in ...(c x1 y1)...(c x2 y2)....n...--The trouble is that `c`, being big, will not be inlined.  And that can-be absolutely terrible for performance, as we saw in #8763.--It's much better to define--  mapM_ f = foldr c (return ())-    where-      c x k = f x >> k-      {-# INLINE c #-}--Now we get-  mapM_ <big> (build g)--  = { inline mapM_ }-    foldr c (return ()) (build g)-      where c x k = f x >> k-            {-# INLINE c #-}-            f = <big>--Notice that `f` does not inline into the RHS of `c`,-because the INLINE pragma stops it; see-Note [Simplifying inside stable unfoldings] in SimplUtils.-Continuing:--  = { foldr/build rule }-    g c (return ())-      where ...-         c x k = f x >> k-         {-# INLINE c #-}-            f = <big>--  = { inline g }-    ...(c x1 y1)...(c x2 y2)....n...-      where c x k = f x >> k-            {-# INLINE c #-}-            f = <big>-            n = return ()--      Now, crucially, `c` does inline--  = { inline c }-    ...(f x1 >> y1)...(f x2 >> y2)....n...-      where f = <big>-            n = return ()--And all is well!  The key thing is that the fragment-`(f x1 >> y1)` is inlined into the body of the builder-`g`.--}--{--Note [maximumBy/minimumBy space usage]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-When the type signatures of maximumBy and minimumBy were generalized to work-over any Foldable instance (instead of just lists), they were defined using-foldr1. This was problematic for space usage, as the semantics of maximumBy-and minimumBy essentially require that they examine every element of the-data structure. Using foldr1 to examine every element results in space usage-proportional to the size of the data structure. For the common case of lists,-this could be particularly bad (see #10830).--For the common case of lists, switching the implementations of maximumBy and-minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then-make these functions only use O(1) stack space. It is perhaps not the optimal-way to fix this problem, as there are other conceivable data structures-(besides lists) which might benefit from specialized implementations for-maximumBy and minimumBy (see-https://gitlab.haskell.org/ghc/ghc/issues/10830#note_129843 for a further-discussion). But using foldl1 is at least always better than using foldr1, so-GHC has chosen to adopt that approach for now.--}++    -- * Overview+    -- $overview++    -- ** Recursive and corecursive reduction+    -- $reduction++    -- *** Strict recursive folds+    -- $strict++    -- **** List of strict functions+    -- $strictlist++    -- *** Lazy corecursive folds+    -- $lazy++    -- **** List of lazy functions+    -- $lazylist++    -- *** Short-circuit folds+    -- $shortcircuit++    -- **** List of short-circuit functions+    -- $shortlist++    -- *** Hybrid folds+    -- $hybrid++    -- ** Generative Recursion+    -- $generative++    -- ** Avoiding multi-pass folds+    -- $multipass++    -- * Defining instances+    -- $instances++    -- *** Being strict by being lazy+    -- $strictlazy++    -- * Laws+    -- $laws++    -- * Notes+    -- $notes++    -- * See also+    -- $also+    ) where++import Data.Bool+import Data.Either+import Data.Eq+import Data.Functor.Utils (Max(..), Min(..), (#.))+import qualified GHC.List as List+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Proxy++import GHC.Arr  ( Array(..), elems, numElements,+                  foldlElems, foldrElems,+                  foldlElems', foldrElems',+                  foldl1Elems, foldr1Elems)+import GHC.Base hiding ( foldr )+import GHC.Generics+import GHC.Tuple (Solo (..))+import GHC.Num  ( Num(..) )++-- $setup+-- >>> :set -XDeriveFoldable+-- >>> import Prelude+-- >>> import Data.Monoid (Product (..), Sum (..))+-- >>> data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving (Show, Foldable)++infix  4 `elem`, `notElem`++-- XXX: Missing haddock feature.  Links to anchors in other modules+-- don't have a sensible way to name the link within the module itself.+-- Thus, the below "Data.Foldable#overview" works well when shown as+-- @Data.Foldable@ from other modules, but in the home module it should+-- be possible to specify alternative link text. :-(++-- | The Foldable class represents data structures that can be reduced to a+-- summary value one element at a time.  Strict left-associative folds are a+-- good fit for space-efficient reduction, while lazy right-associative folds+-- are a good fit for corecursive iteration, or for folds that short-circuit+-- after processing an initial subsequence of the structure's elements.+--+-- Instances can be derived automatically by enabling the @DeriveFoldable@+-- extension.  For example, a derived instance for a binary tree might be:+--+-- > {-# LANGUAGE DeriveFoldable #-}+-- > data Tree a = Empty+-- >             | Leaf a+-- >             | Node (Tree a) a (Tree a)+-- >     deriving Foldable+--+-- A more detailed description can be found in the overview section of+-- "Data.Foldable#overview".+--+class Foldable t where+    {-# MINIMAL foldMap | foldr #-}++    -- | Given a structure with elements whose type is a 'Monoid', combine them+    -- via the monoid's @('<>')@ operator.  This fold is right-associative and+    -- lazy in the accumulator.  When you need a strict left-associative fold,+    -- use `foldMap'` instead, with 'id' as the map.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> fold [[1, 2, 3], [4, 5], [6], []]+    -- [1,2,3,4,5,6]+    --+    -- >>> fold $ Node (Leaf (Sum 1)) (Sum 3) (Leaf (Sum 5))+    -- Sum {getSum = 9}+    --+    -- Folds of unbounded structures do not terminate when the monoid's+    -- @('<>')@ operator is strict:+    --+    -- >>> fold (repeat Nothing)+    -- * Hangs forever *+    --+    -- Lazy corecursive folds of unbounded structures are fine:+    --+    -- >>> take 12 $ fold $ map (\i -> [i..i+2]) [0..]+    -- [0,1,2,1,2,3,2,3,4,3,4,5]+    -- >>> sum $ take 4000000 $ fold $ map (\i -> [i..i+2]) [0..]+    -- 2666668666666+    --+    fold :: Monoid m => t m -> m+    fold = foldMap id++    -- | Map each element of the structure into a monoid, and combine the+    -- results with @('<>')@.  This fold is right-associative and lazy in the+    -- accumulator.  For strict left-associative folds consider `foldMap'`+    -- instead.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> foldMap Sum [1, 3, 5]+    -- Sum {getSum = 9}+    --+    -- >>> foldMap Product [1, 3, 5]+    -- Product {getProduct = 15}+    --+    -- >>> foldMap (replicate 3) [1, 2, 3]+    -- [1,1,1,2,2,2,3,3,3]+    --+    -- When a Monoid's @('<>')@ is lazy in its second argument, 'foldMap' can+    -- return a result even from an unbounded structure.  For example, lazy+    -- accumulation enables "Data.ByteString.Builder" to efficiently serialise+    -- large data structures and produce the output incrementally:+    --+    -- >>> import qualified Data.ByteString.Lazy as L+    -- >>> import qualified Data.ByteString.Builder as B+    -- >>> let bld :: Int -> B.Builder; bld i = B.intDec i <> B.word8 0x20+    -- >>> let lbs = B.toLazyByteString $ foldMap bld [0..]+    -- >>> L.take 64 lbs+    -- "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"+    --+    foldMap :: Monoid m => (a -> m) -> t a -> m+    {-# INLINE foldMap #-}+    -- This INLINE allows more list functions to fuse.  See #9848.+    foldMap f = foldr (mappend . f) mempty++    -- | A left-associative variant of 'foldMap' that is strict in the+    -- accumulator.  Use this method for strict reduction when partial+    -- results are merged via @('<>')@.+    --+    -- ==== __Examples__+    --+    -- Define a 'Monoid' over finite bit strings under 'xor'.  Use it to+    -- strictly compute the `xor` of a list of 'Int' values.+    --+    -- >>> :set -XGeneralizedNewtypeDeriving+    -- >>> import Data.Bits (Bits, FiniteBits, xor, zeroBits)+    -- >>> import Data.Foldable (foldMap')+    -- >>> import Numeric (showHex)+    -- >>>+    -- >>> newtype X a = X a deriving (Eq, Bounded, Enum, Bits, FiniteBits)+    -- >>> instance Bits a => Semigroup (X a) where X a <> X b = X (a `xor` b)+    -- >>> instance Bits a => Monoid    (X a) where mempty     = X zeroBits+    -- >>>+    -- >>> let bits :: [Int]; bits = [0xcafe, 0xfeed, 0xdeaf, 0xbeef, 0x5411]+    -- >>> (\ (X a) -> showString "0x" . showHex a $ "") $ foldMap' X bits+    -- "0x42"+    --+    -- @since 4.13.0.0+    foldMap' :: Monoid m => (a -> m) -> t a -> m+    foldMap' f = foldl' (\ acc a -> acc <> f a) mempty++    -- | Right-associative fold of a structure, lazy in the accumulator.+    --+    -- In the case of lists, 'foldr', when applied to a binary operator, a+    -- starting value (typically the right-identity of the operator), and a+    -- list, reduces the list using the binary operator, from right to left:+    --+    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)+    --+    -- Note that since the head of the resulting expression is produced by an+    -- application of the operator to the first element of the list, given an+    -- operator lazy in its right argument, 'foldr' can produce a terminating+    -- expression from an unbounded list.+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to,+    --+    -- @foldr f z = 'List.foldr' f z . 'toList'@+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> foldr (||) False [False, True, False]+    -- True+    --+    -- >>> foldr (||) False []+    -- False+    --+    -- >>> foldr (\c acc -> acc ++ [c]) "foo" ['a', 'b', 'c', 'd']+    -- "foodcba"+    --+    -- ===== Infinite structures+    --+    -- ⚠️ Applying 'foldr' to infinite structures usually doesn't terminate.+    --+    -- It may still terminate under one of the following conditions:+    --+    -- * the folding function is short-circuiting+    -- * the folding function is lazy on its second argument+    --+    -- ====== Short-circuiting+    --+    -- @('||')@ short-circuits on 'True' values, so the following terminates+    -- because there is a 'True' value finitely far from the left side:+    --+    -- >>> foldr (||) False (True : repeat False)+    -- True+    --+    -- But the following doesn't terminate:+    --+    -- >>> foldr (||) False (repeat False ++ [True])+    -- * Hangs forever *+    --+    -- ====== Laziness in the second argument+    --+    -- Applying 'foldr' to infinite structures terminates when the operator is+    -- lazy in its second argument (the initial accumulator is never used in+    -- this case, and so could be left 'undefined', but @[]@ is more clear):+    --+    -- >>> take 5 $ foldr (\i acc -> i : fmap (+3) acc) [] (repeat 1)+    -- [1,4,7,10,13]+    foldr :: (a -> b -> b) -> b -> t a -> b+    foldr f z t = appEndo (foldMap (Endo #. f) t) z++    -- | Right-associative fold of a structure, strict in the accumulator.+    -- This is rarely what you want.+    --+    -- @since 4.6.0.0+    foldr' :: (a -> b -> b) -> b -> t a -> b+    foldr' f z0 xs = foldl f' id xs z0+      where f' k x z = k $! f x z++    -- | Left-associative fold of a structure, lazy in the accumulator.  This+    -- is rarely what you want, but can work well for structures with efficient+    -- right-to-left sequencing and an operator that is lazy in its left+    -- argument.+    --+    -- In the case of lists, 'foldl', when applied to a binary operator, a+    -- starting value (typically the left-identity of the operator), and a+    -- list, reduces the list using the binary operator, from left to right:+    --+    -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+    --+    -- Note that to produce the outermost application of the operator the+    -- entire input list must be traversed.  Like all left-associative folds,+    -- 'foldl' will diverge if given an infinite list.+    --+    -- If you want an efficient strict left-fold, you probably want to use+    -- `foldl'` instead of 'foldl'.  The reason for this is that the latter+    -- does not force the /inner/ results (e.g. @z \`f\` x1@ in the above+    -- example) before applying them to the operator (e.g. to @(\`f\` x2)@).+    -- This results in a thunk chain \(\mathcal{O}(n)\) elements long, which+    -- then must be evaluated from the outside-in.+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to:+    --+    -- @foldl f z = 'List.foldl' f z . 'toList'@+    --+    -- ==== __Examples__+    --+    -- The first example is a strict fold, which in practice is best performed+    -- with `foldl'`.+    --+    -- >>> foldl (+) 42 [1,2,3,4]+    -- 52+    --+    -- Though the result below is lazy, the input is reversed before prepending+    -- it to the initial accumulator, so corecursion begins only after traversing+    -- the entire input string.+    --+    -- >>> foldl (\acc c -> c : acc) "abcd" "efgh"+    -- "hgfeabcd"+    --+    -- A left fold of a structure that is infinite on the right cannot+    -- terminate, even when for any finite input the fold just returns the+    -- initial accumulator:+    --+    -- >>> foldl (\a _ -> a) 0 $ repeat 1+    -- * Hangs forever *+    --+    foldl :: (b -> a -> b) -> b -> t a -> b+    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+    -- There's no point mucking around with coercions here,+    -- because flip forces us to build a new function anyway.++    -- | Left-associative fold of a structure but with strict application of+    -- the operator.+    --+    -- This ensures that each step of the fold is forced to Weak Head Normal+    -- Form before being applied, avoiding the collection of thunks that would+    -- otherwise occur.  This is often what you want to strictly reduce a+    -- finite structure to a single strict result (e.g. 'sum').+    --+    -- For a general 'Foldable' structure this should be semantically identical+    -- to,+    --+    -- @foldl' f z = 'List.foldl'' f z . 'toList'@+    --+    -- @since 4.6.0.0+    foldl' :: (b -> a -> b) -> b -> t a -> b+    foldl' f z0 xs = foldr f' id xs z0+      where f' x k z = k $! f z x++    -- | A variant of 'foldr' that has no base case,+    -- and thus may only be applied to non-empty structures.+    --+    -- This function is non-total and will raise a runtime exception if the+    -- structure happens to be empty.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> foldr1 (+) [1..4]+    -- 10+    --+    -- >>> foldr1 (+) []+    -- Exception: Prelude.foldr1: empty list+    --+    -- >>> foldr1 (+) Nothing+    -- *** Exception: foldr1: empty structure+    --+    -- >>> foldr1 (-) [1..4]+    -- -2+    --+    -- >>> foldr1 (&&) [True, False, True, True]+    -- False+    --+    -- >>> foldr1 (||) [False, False, True, True]+    -- True+    --+    -- >>> foldr1 (+) [1..]+    -- * Hangs forever *+    foldr1 :: (a -> a -> a) -> t a -> a+    foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")+                    (foldr mf Nothing xs)+      where+        mf x m = Just (case m of+                         Nothing -> x+                         Just y  -> f x y)++    -- | A variant of 'foldl' that has no base case,+    -- and thus may only be applied to non-empty structures.+    --+    -- This function is non-total and will raise a runtime exception if the+    -- structure happens to be empty.+    --+    -- @'foldl1' f = 'List.foldl1' f . 'toList'@+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> foldl1 (+) [1..4]+    -- 10+    --+    -- >>> foldl1 (+) []+    -- *** Exception: Prelude.foldl1: empty list+    --+    -- >>> foldl1 (+) Nothing+    -- *** Exception: foldl1: empty structure+    --+    -- >>> foldl1 (-) [1..4]+    -- -8+    --+    -- >>> foldl1 (&&) [True, False, True, True]+    -- False+    --+    -- >>> foldl1 (||) [False, False, True, True]+    -- True+    --+    -- >>> foldl1 (+) [1..]+    -- * Hangs forever *+    foldl1 :: (a -> a -> a) -> t a -> a+    foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")+                    (foldl mf Nothing xs)+      where+        mf m y = Just (case m of+                         Nothing -> y+                         Just x  -> f x y)++    -- | List of elements of a structure, from left to right.  If the entire+    -- list is intended to be reduced via a fold, just fold the structure+    -- directly bypassing the list.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> toList Nothing+    -- []+    --+    -- >>> toList (Just 42)+    -- [42]+    --+    -- >>> toList (Left "foo")+    -- []+    --+    -- >>> toList (Node (Leaf 5) 17 (Node Empty 12 (Leaf 8)))+    -- [5,17,12,8]+    --+    -- For lists, 'toList' is the identity:+    --+    -- >>> toList [1, 2, 3]+    -- [1,2,3]+    --+    -- @since 4.8.0.0+    toList :: t a -> [a]+    {-# INLINE toList #-}+    toList t = build (\ c n -> foldr c n t)++    -- | Test whether the structure is empty.  The default implementation is+    -- Left-associative and lazy in both the initial element and the+    -- accumulator.  Thus optimised for structures where the first element can+    -- be accessed in constant time.  Structures where this is not the case+    -- should have a non-default implementation.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> null []+    -- True+    --+    -- >>> null [1]+    -- False+    --+    -- 'null' is expected to terminate even for infinite structures.+    -- The default implementation terminates provided the structure+    -- is bounded on the left (there is a left-most element).+    --+    -- >>> null [1..]+    -- False+    --+    -- @since 4.8.0.0+    null :: t a -> Bool+    null = foldr (\_ _ -> False) True++    -- | Returns the size/length of a finite structure as an 'Int'.  The+    -- default implementation just counts elements starting with the left-most.+    -- Instances for structures that can compute the element count faster+    -- than via element-by-element counting, should provide a specialised+    -- implementation.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> length []+    -- 0+    --+    -- >>> length ['a', 'b', 'c']+    -- 3+    -- >>> length [1..]+    -- * Hangs forever *+    --+    -- @since 4.8.0.0+    length :: t a -> Int+    length = foldl' (\c _ -> c+1) 0++    -- | Does the element occur in the structure?+    --+    -- Note: 'elem' is often used in infix form.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> 3 `elem` []+    -- False+    --+    -- >>> 3 `elem` [1,2]+    -- False+    --+    -- >>> 3 `elem` [1,2,3,4,5]+    -- True+    --+    -- For infinite structures, the default implementation of 'elem'+    -- terminates if the sought-after value exists at a finite distance+    -- from the left side of the structure:+    --+    -- >>> 3 `elem` [1..]+    -- True+    --+    -- >>> 3 `elem` ([4..] ++ [3])+    -- * Hangs forever *+    --+    -- @since 4.8.0.0+    elem :: Eq a => a -> t a -> Bool+    elem = any . (==)++    -- | The largest element of a non-empty structure.+    --+    -- This function is non-total and will raise a runtime exception if the+    -- structure happens to be empty.  A structure that supports random access+    -- and maintains its elements in order should provide a specialised+    -- implementation to return the maximum in faster than linear time.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> maximum [1..10]+    -- 10+    --+    -- >>> maximum []+    -- *** Exception: Prelude.maximum: empty list+    --+    -- >>> maximum Nothing+    -- *** Exception: maximum: empty structure+    --+    -- @since 4.8.0.0+    maximum :: forall a . Ord a => t a -> a+    maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .+       getMax . foldMap' (Max #. (Just :: a -> Maybe a))+    {-# INLINEABLE maximum #-}++    -- | The least element of a non-empty structure.+    --+    -- This function is non-total and will raise a runtime exception if the+    -- structure happens to be empty.  A structure that supports random access+    -- and maintains its elements in order should provide a specialised+    -- implementation to return the minimum in faster than linear time.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> minimum [1..10]+    -- 1+    --+    -- >>> minimum []+    -- *** Exception: Prelude.minimum: empty list+    --+    -- >>> minimum Nothing+    -- *** Exception: minimum: empty structure+    --+    -- @since 4.8.0.0+    minimum :: forall a . Ord a => t a -> a+    minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .+       getMin . foldMap' (Min #. (Just :: a -> Maybe a))+    {-# INLINEABLE minimum #-}++    -- | The 'sum' function computes the sum of the numbers of a structure.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> sum []+    -- 0+    --+    -- >>> sum [42]+    -- 42+    --+    -- >>> sum [1..10]+    -- 55+    --+    -- >>> sum [4.1, 2.0, 1.7]+    -- 7.8+    --+    -- >>> sum [1..]+    -- * Hangs forever *+    --+    -- @since 4.8.0.0+    sum :: Num a => t a -> a+    sum = getSum #. foldMap' Sum+    {-# INLINEABLE sum #-}++    -- | The 'product' function computes the product of the numbers of a+    -- structure.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- >>> product []+    -- 1+    --+    -- >>> product [42]+    -- 42+    --+    -- >>> product [1..10]+    -- 3628800+    --+    -- >>> product [4.1, 2.0, 1.7]+    -- 13.939999999999998+    --+    -- >>> product [1..]+    -- * Hangs forever *+    --+    -- @since 4.8.0.0+    product :: Num a => t a -> a+    product = getProduct #. foldMap' Product+    {-# INLINEABLE product #-}++-- instances for Prelude types++-- | @since 2.01+instance Foldable Maybe where+    foldMap = maybe mempty++    foldr _ z Nothing = z+    foldr f z (Just x) = f x z++    foldl _ z Nothing = z+    foldl f z (Just x) = f z x++-- | @since 2.01+instance Foldable [] where+    elem    = List.elem+    foldl   = List.foldl+    foldl'  = List.foldl'+    foldl1  = List.foldl1+    foldr   = List.foldr+    foldr1  = List.foldr1+    length  = List.length+    maximum = List.maximum+    minimum = List.minimum+    null    = List.null+    product = List.product+    sum     = List.sum+    toList  = id++-- | @since 4.9.0.0+instance Foldable NonEmpty where+  foldr f z ~(a :| as) = f a (List.foldr f z as)+  foldl f z (a :| as) = List.foldl f (f z a) as+  foldl1 f (a :| as) = List.foldl f a as++  -- GHC isn't clever enough to transform the default definition+  -- into anything like this, so we'd end up shuffling a bunch of+  -- Maybes around.+  foldr1 f (p :| ps) = foldr go id ps p+    where+      go x r prev = f prev (r x)++  -- We used to say+  --+  --   length (_ :| as) = 1 + length as+  --+  -- but the default definition is better, counting from 1.+  --+  -- The default definition also works great for null and foldl'.+  -- As usual for cons lists, foldr' is basically hopeless.++  foldMap f ~(a :| as) = f a `mappend` foldMap f as+  fold ~(m :| ms) = m `mappend` fold ms+  toList ~(a :| as) = a : as++-- | @since 4.7.0.0+instance Foldable (Either a) where+    foldMap _ (Left _) = mempty+    foldMap f (Right y) = f y++    foldr _ z (Left _) = z+    foldr f z (Right y) = f y z++    length (Left _)  = 0+    length (Right _) = 1++    null             = isLeft++-- | @since 4.15+deriving instance Foldable Solo++-- | @since 4.7.0.0+instance Foldable ((,) a) where+    foldMap f (_, y) = f y++    foldr f z (_, y) = f y z+    length _  = 1+    null _ = False++-- | @since 4.8.0.0+instance Foldable (Array i) where+    foldr = foldrElems+    foldl = foldlElems+    foldl' = foldlElems'+    foldr' = foldrElems'+    foldl1 = foldl1Elems+    foldr1 = foldr1Elems+    toList = elems+    length = numElements+    null a = numElements a == 0++-- | @since 4.7.0.0+instance Foldable Proxy where+    foldMap _ _ = mempty+    {-# INLINE foldMap #-}+    fold _ = mempty+    {-# INLINE fold #-}+    foldr _ z _ = z+    {-# INLINE foldr #-}+    foldl _ z _ = z+    {-# INLINE foldl #-}+    foldl1 _ _ = errorWithoutStackTrace "foldl1: Proxy"+    foldr1 _ _ = errorWithoutStackTrace "foldr1: Proxy"+    length _   = 0+    null _     = True+    elem _ _   = False+    sum _      = 0+    product _  = 1++-- | @since 4.8.0.0+instance Foldable Dual where+    foldMap            = coerce++    elem               = (. getDual) #. (==)+    foldl              = coerce+    foldl'             = coerce+    foldl1 _           = getDual+    foldr f z (Dual x) = f x z+    foldr'             = foldr+    foldr1 _           = getDual+    length _           = 1+    maximum            = getDual+    minimum            = getDual+    null _             = False+    product            = getDual+    sum                = getDual+    toList (Dual x)    = [x]++-- | @since 4.8.0.0+instance Foldable Sum where+    foldMap            = coerce++    elem               = (. getSum) #. (==)+    foldl              = coerce+    foldl'             = coerce+    foldl1 _           = getSum+    foldr f z (Sum x)  = f x z+    foldr'             = foldr+    foldr1 _           = getSum+    length _           = 1+    maximum            = getSum+    minimum            = getSum+    null _             = False+    product            = getSum+    sum                = getSum+    toList (Sum x)     = [x]++-- | @since 4.8.0.0+instance Foldable Product where+    foldMap               = coerce++    elem                  = (. getProduct) #. (==)+    foldl                 = coerce+    foldl'                = coerce+    foldl1 _              = getProduct+    foldr f z (Product x) = f x z+    foldr'                = foldr+    foldr1 _              = getProduct+    length _              = 1+    maximum               = getProduct+    minimum               = getProduct+    null _                = False+    product               = getProduct+    sum                   = getProduct+    toList (Product x)    = [x]++-- | @since 4.8.0.0+instance Foldable First where+    foldMap f = foldMap f . getFirst++-- | @since 4.8.0.0+instance Foldable Last where+    foldMap f = foldMap f . getLast++-- | @since 4.12.0.0+instance (Foldable f) => Foldable (Alt f) where+    foldMap f = foldMap f . getAlt++-- | @since 4.12.0.0+instance (Foldable f) => Foldable (Ap f) where+    foldMap f = foldMap f . getAp++-- Instances for GHC.Generics+-- | @since 4.9.0.0+instance Foldable U1 where+    foldMap _ _ = mempty+    {-# INLINE foldMap #-}+    fold _ = mempty+    {-# INLINE fold #-}+    foldr _ z _ = z+    {-# INLINE foldr #-}+    foldl _ z _ = z+    {-# INLINE foldl #-}+    foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"+    foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"+    length _   = 0+    null _     = True+    elem _ _   = False+    sum _      = 0+    product _  = 1++-- | @since 4.9.0.0+deriving instance Foldable V1++-- | @since 4.9.0.0+deriving instance Foldable Par1++-- | @since 4.9.0.0+deriving instance Foldable f => Foldable (Rec1 f)++-- | @since 4.9.0.0+deriving instance Foldable (K1 i c)++-- | @since 4.9.0.0+deriving instance Foldable f => Foldable (M1 i c f)++-- | @since 4.9.0.0+deriving instance (Foldable f, Foldable g) => Foldable (f :+: g)++-- | @since 4.9.0.0+deriving instance (Foldable f, Foldable g) => Foldable (f :*: g)++-- | @since 4.9.0.0+deriving instance (Foldable f, Foldable g) => Foldable (f :.: g)++-- | @since 4.9.0.0+deriving instance Foldable UAddr++-- | @since 4.9.0.0+deriving instance Foldable UChar++-- | @since 4.9.0.0+deriving instance Foldable UDouble++-- | @since 4.9.0.0+deriving instance Foldable UFloat++-- | @since 4.9.0.0+deriving instance Foldable UInt++-- | @since 4.9.0.0+deriving instance Foldable UWord++-- Instances for Data.Ord+-- | @since 4.12.0.0+deriving instance Foldable Down++-- | Monadic fold over the elements of a structure.  This type of fold is+-- left-associative in the monadic effects, and right-associative in the output+-- value.+--+-- Given a structure @t@ with elements @(a, b, c, ..., x, y)@, the result of+-- a fold with an operator function @f@ is equivalent to:+--+-- > foldrM f z t = do { yy <- f y z; xx <- f x yy; ... ; bb <- f b cc; f a bb }+--+-- If in a 'MonadPlus' the bind short-circuits, the evaluated effects will be+-- from a tail of the sequence.  If you want to evaluate the monadic effects in+-- left-to-right order, or perhaps be able to short-circuit after an initial+-- sequence of elements, you'll need to use `foldlM` instead.+--+-- If the monadic effects don't short-circuit, the outer-most application of+-- @f@ is to left-most element @a@, so that, ignoring effects, the result looks+-- like a right fold:+--+-- > a `f` (b `f` (c `f` (... (x `f` (y `f` z))))).+--+-- and yet, left-associative monadic binds, rather than right-associative+-- applications of @f@, sequence the computation.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> let f i acc = do { print i ; return $ i : acc }+-- >>> foldrM f [] [0..3]+-- 3+-- 2+-- 1+-- 0+-- [0,1,2,3]+--+foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b+foldrM f z0 xs = foldl c return xs z0+  -- See Note [List fusion and continuations in 'c']+  where c k x z = f x z >>= k+        {-# INLINE c #-}++-- | Monadic fold over the elements of a structure.  This type of fold is+-- right-associative in the monadic effects, and left-associative in the output+-- value.+--+-- Given a structure @t@ with elements @(a, b, ..., w, x, y)@, the result of+-- a fold with an operator function @f@ is equivalent to:+--+-- > foldlM f z t = do { aa <- f z a; bb <- f aa b; ... ; xx <- f ww x; f xx y }+--+-- If in a 'MonadPlus' the bind short-circuits, the evaluated effects will be+-- from an initial portion of the sequence.  If you want to evaluate the+-- monadic effects in right-to-left order, or perhaps be able to short-circuit+-- after processing a tail of the sequence of elements, you'll need to use+-- `foldrM` instead.+--+-- If the monadic effects don't short-circuit, the outer-most application of+-- @f@ is to the right-most element @y@, so that, ignoring effects, the result+-- looks like a left fold:+--+-- > ((((z `f` a) `f` b) ... `f` w) `f` x) `f` y+--+-- and yet, right-associative monadic binds, rather than left-associative+-- applications of @f@, sequence the computation.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> let f a e = do { print e ; return $ e : a }+-- >>> foldlM f [] [0..3]+-- 0+-- 1+-- 2+-- 3+-- [3,2,1,0]+--+foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b+foldlM f z0 xs = foldr c return xs z0+  -- See Note [List fusion and continuations in 'c']+  where c x k z = f z x >>= k+        {-# INLINE c #-}++-- | Map each element of a structure to an 'Applicative' action, evaluate these+-- actions from left to right, and ignore the results.  For a version that+-- doesn't ignore the results see 'Data.Traversable.traverse'.+--+-- 'traverse_' is just like 'mapM_', but generalised to 'Applicative' actions.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> traverse_ print ["Hello", "world", "!"]+-- "Hello"+-- "world"+-- "!"+traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()+traverse_ f = foldr c (pure ())+  -- See Note [List fusion and continuations in 'c']+  where c x k = f x *> k+        {-# INLINE c #-}++-- | 'for_' is 'traverse_' with its arguments flipped.  For a version+-- that doesn't ignore the results see 'Data.Traversable.for'.  This+-- is 'forM_' generalised to 'Applicative' actions.+--+-- 'for_' is just like 'forM_', but generalised to 'Applicative' actions.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> for_ [1..4] print+-- 1+-- 2+-- 3+-- 4+for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()+{-# INLINE for_ #-}+for_ = flip traverse_++-- | Map each element of a structure to a monadic action, evaluate+-- these actions from left to right, and ignore the results.  For a+-- version that doesn't ignore the results see+-- 'Data.Traversable.mapM'.+--+-- 'mapM_' is just like 'traverse_', but specialised to monadic actions.+--+mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()+mapM_ f = foldr c (return ())+  -- See Note [List fusion and continuations in 'c']+  where c x k = f x >> k+        {-# INLINE c #-}++-- | 'forM_' is 'mapM_' with its arguments flipped.  For a version that+-- doesn't ignore the results see 'Data.Traversable.forM'.+--+-- 'forM_' is just like 'for_', but specialised to monadic actions.+--+forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = flip mapM_++-- | Evaluate each action in the structure from left to right, and+-- ignore the results.  For a version that doesn't ignore the results+-- see 'Data.Traversable.sequenceA'.+--+-- 'sequenceA_' is just like 'sequence_', but generalised to 'Applicative'+-- actions.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> sequenceA_ [print "Hello", print "world", print "!"]+-- "Hello"+-- "world"+-- "!"+sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()+sequenceA_ = foldr c (pure ())+  -- See Note [List fusion and continuations in 'c']+  where c m k = m *> k+        {-# INLINE c #-}++-- | Evaluate each monadic action in the structure from left to right,+-- and ignore the results.  For a version that doesn't ignore the+-- results see 'Data.Traversable.sequence'.+--+-- 'sequence_' is just like 'sequenceA_', but specialised to monadic+-- actions.+--+sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()+sequence_ = foldr c (return ())+  -- See Note [List fusion and continuations in 'c']+  where c m k = m >> k+        {-# INLINE c #-}++-- | The sum of a collection of actions, generalizing 'concat'.+--+-- 'asum' is just like 'msum', but generalised to 'Alternative'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> asum [Just "Hello", Nothing, Just "World"]+-- Just "Hello"+asum :: (Foldable t, Alternative f) => t (f a) -> f a+{-# INLINE asum #-}+asum = foldr (<|>) empty++-- | The sum of a collection of actions, generalizing 'concat'.+--+-- 'msum' is just like 'asum', but specialised to 'MonadPlus'.+--+msum :: (Foldable t, MonadPlus m) => t (m a) -> m a+{-# INLINE msum #-}+msum = asum++-- | The concatenation of all the elements of a container of lists.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> concat (Just [1, 2, 3])+-- [1,2,3]+--+-- >>> concat (Left 42)+-- []+--+-- >>> concat [[1, 2, 3], [4, 5], [6], []]+-- [1,2,3,4,5,6]+--+concat :: Foldable t => t [a] -> [a]+concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)+{-# INLINE concat #-}++-- | Map a function over all the elements of a container and concatenate+-- the resulting lists.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> concatMap (take 3) [[1..], [10..], [100..], [1000..]]+-- [1,2,3,10,11,12,100,101,102,1000,1001,1002]+--+-- >>> concatMap (take 3) (Just [1..])+-- [1,2,3]+concatMap :: Foldable t => (a -> [b]) -> t a -> [b]+concatMap f xs = build (\c n -> foldr (\x b -> foldr c b (f x)) n xs)+{-# INLINE concatMap #-}++-- These use foldr rather than foldMap to avoid repeated concatenation.++-- | 'and' returns the conjunction of a container of Bools.  For the+-- result to be 'True', the container must be finite; 'False', however,+-- results from a 'False' value finitely far from the left end.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> and []+-- True+--+-- >>> and [True]+-- True+--+-- >>> and [False]+-- False+--+-- >>> and [True, True, False]+-- False+--+-- >>> and (False : repeat True) -- Infinite list [False,True,True,True,...+-- False+--+-- >>> and (repeat True)+-- * Hangs forever *+and :: Foldable t => t Bool -> Bool+and = getAll #. foldMap All++-- | 'or' returns the disjunction of a container of Bools.  For the+-- result to be 'False', the container must be finite; 'True', however,+-- results from a 'True' value finitely far from the left end.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> or []+-- False+--+-- >>> or [True]+-- True+--+-- >>> or [False]+-- False+--+-- >>> or [True, True, False]+-- True+--+-- >>> or (True : repeat False) -- Infinite list [True,False,False,False,...+-- True+--+-- >>> or (repeat False)+-- * Hangs forever *+or :: Foldable t => t Bool -> Bool+or = getAny #. foldMap Any++-- | Determines whether any element of the structure satisfies the predicate.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> any (> 3) []+-- False+--+-- >>> any (> 3) [1,2]+-- False+--+-- >>> any (> 3) [1,2,3,4,5]+-- True+--+-- >>> any (> 3) [1..]+-- True+--+-- >>> any (> 3) [0, -1..]+-- * Hangs forever *+any :: Foldable t => (a -> Bool) -> t a -> Bool+any p = getAny #. foldMap (Any #. p)++-- | Determines whether all elements of the structure satisfy the predicate.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> all (> 3) []+-- True+--+-- >>> all (> 3) [1,2]+-- False+--+-- >>> all (> 3) [1,2,3,4,5]+-- False+--+-- >>> all (> 3) [1..]+-- False+--+-- >>> all (> 3) [4..]+-- * Hangs forever *+all :: Foldable t => (a -> Bool) -> t a -> Bool+all p = getAll #. foldMap (All #. p)++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> maximumBy (compare `on` length) ["Hello", "World", "!", "Longest", "bar"]+-- "Longest"++-- See Note [maximumBy/minimumBy space usage]+maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a+maximumBy cmp = fromMaybe (errorWithoutStackTrace "maximumBy: empty structure")+  . foldl' max' Nothing+  where+    max' mx y = Just $! case mx of+      Nothing -> y+      Just x -> case cmp x y of+        GT -> x+        _ -> y+{-# INLINEABLE maximumBy #-}++-- | The least element of a non-empty structure with respect to the+-- given comparison function.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> minimumBy (compare `on` length) ["Hello", "World", "!", "Longest", "bar"]+-- "!"++-- See Note [maximumBy/minimumBy space usage]+minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a+minimumBy cmp = fromMaybe (errorWithoutStackTrace "minimumBy: empty structure")+  . foldl' min' Nothing+  where+    min' mx y = Just $! case mx of+      Nothing -> y+      Just x -> case cmp x y of+        GT -> y+        _ -> x+{-# INLINEABLE minimumBy #-}++-- | 'notElem' is the negation of 'elem'.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> 3 `notElem` []+-- True+--+-- >>> 3 `notElem` [1,2]+-- True+--+-- >>> 3 `notElem` [1,2,3,4,5]+-- False+--+-- For infinite structures, 'notElem' terminates if the value exists at a+-- finite distance from the left side of the structure:+--+-- >>> 3 `notElem` [1..]+-- False+--+-- >>> 3 `notElem` ([4..] ++ [3])+-- * Hangs forever *+notElem :: (Foldable t, Eq a) => a -> t a -> Bool+notElem x = not . elem x++-- | The 'find' function takes a predicate and a structure and returns+-- the leftmost element of the structure matching the predicate, or+-- 'Nothing' if there is no such element.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> find (> 42) [0, 5..]+-- Just 45+--+-- >>> find (> 12) [1..7]+-- Nothing+find :: Foldable t => (a -> Bool) -> t a -> Maybe a+find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))++{-+Note [List fusion and continuations in 'c']+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we define+  mapM_ f = foldr ((>>) . f) (return ())+(this is the way it used to be).++Now suppose we want to optimise the call++  mapM_ <big> (build g)+    where+  g c n = ...(c x1 y1)...(c x2 y2)....n...++GHC used to proceed like this:++  mapM_ <big> (build g)++  = { Definition of mapM_ }+    foldr ((>>) . <big>) (return ()) (build g)++  = { foldr/build rule }+    g ((>>) . <big>) (return ())++  = { Inline g }+    let c = (>>) . <big>+        n = return ()+    in ...(c x1 y1)...(c x2 y2)....n...++The trouble is that `c`, being big, will not be inlined.  And that can+be absolutely terrible for performance, as we saw in #8763.++It's much better to define++  mapM_ f = foldr c (return ())+    where+      c x k = f x >> k+      {-# INLINE c #-}++Now we get+  mapM_ <big> (build g)++  = { inline mapM_ }+    foldr c (return ()) (build g)+      where c x k = f x >> k+            {-# INLINE c #-}+            f = <big>++Notice that `f` does not inline into the RHS of `c`,+because the INLINE pragma stops it; see+Note [Simplifying inside stable unfoldings] in GHC.Core.Opt.Simplify.Utils.+Continuing:++  = { foldr/build rule }+    g c (return ())+      where ...+         c x k = f x >> k+         {-# INLINE c #-}+            f = <big>++  = { inline g }+    ...(c x1 y1)...(c x2 y2)....n...+      where c x k = f x >> k+            {-# INLINE c #-}+            f = <big>+            n = return ()++      Now, crucially, `c` does inline++  = { inline c }+    ...(f x1 >> y1)...(f x2 >> y2)....n...+      where f = <big>+            n = return ()++And all is well!  The key thing is that the fragment+`(f x1 >> y1)` is inlined into the body of the builder+`g`.+-}++{-+Note [maximumBy/minimumBy space usage]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When the type signatures of maximumBy and minimumBy were generalized to work+over any Foldable instance (instead of just lists), they were defined using+foldr1.  This was problematic for space usage, as the semantics of maximumBy+and minimumBy essentially require that they examine every element of the+data structure.  Using foldr1 to examine every element results in space usage+proportional to the size of the data structure.  For the common case of lists,+this could be particularly bad (see #10830).++For the common case of lists, switching the implementations of maximumBy and+minimumBy to foldl1 solves the issue, assuming GHC's strictness analysis can then+make these functions only use O(1) stack space. As of base 4.16, we have switched to employing foldl' over foldl1, not relying on GHC's optimiser. See https://gitlab.haskell.org/ghc/ghc/-/issues/17867 for more context.+-}++--------------++-- $overview+--+-- #overview#+-- Foldable structures are reduced to a summary value by accumulating+-- contributions to the result one element at a time.+--+-- == Left and right folds+--+-- #leftright#+-- Merging the contribution of the current element with an accumulator value+-- from a partial result is performed by an /operator/ function, either+-- explicitly provided by the caller as in `foldr`, implicit as in `length`, or+-- partly implicit as in `foldMap` (where each element is mapped into a+-- 'Monoid', and the monoid's `mappend` operator performs the merge).+--+-- A key distinction is between left-associative and right-associative+-- folds:+--+-- * In left-associative folds the accumulator is a partial fold over the+--   elements that __precede__ the current element, and is passed to the+--   operator as its first (left) argument.  The outer-most application of the+--   operator merges the contribution of the last element of the structure with+--   the contributions of all its predecessors.+--+-- * In right-associative folds the accumulator is a partial fold over the+--   elements that __follow__ the current element, and is passed to the+--   operator as its second (right) argument.  The outer-most application of+--   the operator merges the contribution of the first element of the structure+--   with the contributions of all its successors.+--+-- These two types of folds are typified by the left-associative strict+-- `foldl'` and the right-associative lazy `foldr`.+--+-- @+-- `foldl'` :: Foldable t => (b -> a -> b) -> b -> t a -> b+-- `foldr`  :: Foldable t => (a -> b -> b) -> b -> t a -> b+-- @+--+-- Example usage:+--+-- >>> foldl' (+) 0 [1..100]+-- 5050+-- >>> foldr (&&) True (repeat False)+-- False+--+-- The first argument of both is an explicit /operator/ that merges the+-- contribution of an element of the structure with a partial fold over,+-- respectively, either the preceding or following elements of the structure.+--+-- The second argument of both is an initial accumulator value @z@ of type+-- @b@.  This is the result of the fold when the structure is empty.+-- When the structure is non-empty, this is the accumulator value merged with+-- the first element in left-associative folds, or with the last element in+-- right-associative folds.+--+-- The third and final argument is a @Foldable@ structure containing elements+-- @(a, b, c, &#x2026;)@.+--+-- * __`foldl'`__ takes an operator function of the form:+--+--     @+--     f :: b -- accumulated fold of the initial elements+--       -> a -- current element+--       -> b -- updated fold, inclusive of current element+--     @+--+--     If the structure's last element is @y@, the result of the fold is:+--+--     @+--     g y . &#x2026; . g c . g b . g a $ z+--       where g element !acc = f acc element+--     @+--+--     Since `foldl'` is strict in the accumulator, this is always+--     a [strict](#strict) reduction with no opportunity for early return or+--     intermediate results.  The structure must be finite, since no result is+--     returned until the last element is processed.  The advantage of+--     strictness is space efficiency: the final result can be computed without+--     storing a potentially deep stack of lazy intermediate results.+--+-- * __`foldr`__ takes an operator function of the form:+--+--     @+--     f :: a -- current element+--       -> b -- accumulated fold of the remaining elements+--       -> b -- updated fold, inclusive of current element+--     @+--+--     the result of the fold is:+--+--     @f a . f b . f c . &#x2026; $ z@+--+--     If each call of @f@ on the current element @e@, (referenced as @(f e)@+--     below) returns a structure in which its second argument is captured in a+--     lazily-evaluated component, then the fold of the remaining elements is+--     available to the caller of `foldr` as a pending computation (thunk) that+--     is computed only when that component is evaluated.+--+--     Alternatively, if any of the @(f e)@ ignore their second argument, the+--     fold stops there, with the remaining elements unused.  As a result,+--     `foldr` is well suited to define both [corecursive](#corec)+--     and [short-circuit](#short) reductions.+--+--     When the operator is always strict in the second argument, `foldl'` is+--     generally a better choice than `foldr`.  When `foldr` is called with a+--     strict operator, evaluation cannot begin until the last element is+--     reached, by which point a deep stack of pending function applications+--     may have been built up in memory.+--+-- In finite structures for which right-to-left sequencing no less efficient+-- than left-to-right sequencing, there is no inherent performance distinction+-- between left-associative and right-associative folds.  If the structure's+-- @Foldable@ instance takes advantage of this symmetry to also make strict+-- right folds space-efficient and lazy left folds corecursive, one need only+-- take care to choose either a strict or lazy method for the task at hand.++--------------++-- $reduction+--+-- As observed in the [above description](#leftright) of left and right folds,+-- there are three general ways in which a structure can be reduced to a+-- summary value:+--+-- * __Recursive__ reduction, which is strict in all the elements of the+--   structure.  This produces a single final result only after processing the+--   entire input structure, and so the input must be finite.+--+-- * __Corecursion__, which yields intermediate results as it encounters+--   additional input elements.  Lazy processing of the remaining elements+--   makes the intermediate results available even before the rest of the+--   input is processed.  The input may be unbounded, and the caller can+--   stop processing intermediate results early.+--+-- * __Short-circuit__ reduction, which examines some initial sequence of the+--   input elements, but stops once a termination condition is met, returning a+--   final result based only on the elements considered up to that point.  The+--   remaining elements are not considered.  The input should generally be+--   finite, because the termination condition might otherwise never be met.+--+-- Whether a fold is recursive, corecursive or short-circuiting can depend on+-- both the method chosen to perform the fold and on the operator passed to+-- that method (which may be implicit, as with the `mappend` method of a monoid+-- instance).+--+-- There are also hybrid cases, where the method and/or operator are not well+-- suited to the task at hand, resulting in a fold that fails to yield+-- incremental results until the entire input is processed, or fails to+-- strictly evaluate results as it goes, deferring all the work to the+-- evaluation of a large final thunk.  Such cases should be avoided, either by+-- selecting a more appropriate @Foldable@ method, or by tailoring the operator+-- to the chosen method.+--+-- The distinction between these types of folds is critical, both in deciding+-- which @Foldable@ method to use to perform the reduction efficiently, and in+-- writing @Foldable@ instances for new structures.  Below is a more detailed+-- overview of each type.++--------------++-- $strict+-- #strict#+--+-- Common examples of strict recursive reduction are the various /aggregate/+-- functions, like 'sum', 'product', 'length', as well as more complex+-- summaries such as frequency counts.  These functions return only a single+-- value after processing the entire input structure.  In such cases, lazy+-- processing of the tail of the input structure is generally not only+-- unnecessary, but also inefficient.  Thus, these and similar folds should be+-- implemented in terms of strict left-associative @Foldable@ methods (typically+-- `foldl'`) to perform an efficient reduction in constant space.+--+-- Conversely, an implementation of @Foldable@ for a new structure should+-- ensure that `foldl'` actually performs a strict left-associative reduction.+--+-- The `foldMap'` method is a special case of `foldl'`, in which the initial+-- accumulator is `mempty` and the operator is @mappend . f@, where @f@ maps+-- each input element into the 'Monoid' in question.  Therefore, `foldMap'` is+-- an appropriate choice under essentially the same conditions as `foldl'`, and+-- its implementation for a given @Foldable@ structure should also be a strict+-- left-associative reduction.+--+-- While the examples below are not necessarily the most optimal definitions of+-- the intended functions, they are all cases in which `foldMap'` is far more+-- appropriate (as well as more efficient) than the lazy `foldMap`.+--+-- > length  = getSum     . foldMap' (const (Sum 1))+-- > sum     = getSum     . foldMap' Sum+-- > product = getProduct . foldMap' Product+--+-- [ The actual default definitions employ coercions to optimise out+--   'getSum' and 'getProduct'. ]++--------------++-- $strictlist+--+-- The full list of strict recursive functions in this module is:+--+-- * Provided the operator is strict in its left argument:+--+--     @`foldl'` :: Foldable t => (b -> a -> b) -> b -> t a -> b@+--+-- * Provided `mappend` is strict in its left argument:+--+--     @`foldMap'` :: (Foldable t, Monoid m) => (a -> m) -> t a -> m@+--+-- * Provided the instance is correctly defined:+--+--     @+--     `length`    :: Foldable t => t a -> Int+--     `sum`       :: (Foldable t, Num a) => t a -> a+--     `product`   :: (Foldable t, Num a) => t a -> a+--     `maximum`   :: (Foldable t, Ord a) => t a -> a+--     `minimum`   :: (Foldable t, Ord a) => t a -> a+--     `maximumBy` :: Foldable t => (a -> a -> Ordering) -> t a -> a+--     `minimumBy` :: Foldable t => (a -> a -> Ordering) -> t a -> a+--     @++--------------++-- $lazy+--+-- #corec#+-- Common examples of lazy corecursive reduction are functions that map and+-- flatten a structure to a lazy stream of result values, i.e.  an iterator+-- over the transformed input elements.  In such cases, it is important to+-- choose a @Foldable@ method that is lazy in the tail of the structure, such+-- as `foldr` (or `foldMap`, if the result @Monoid@ has a lazy `mappend` as+-- with e.g. ByteString Builders).+--+-- Conversely, an implementation of `foldr` for a structure that can+-- accommodate a large (and possibly unbounded) number of elements is expected+-- to be lazy in the tail of the input, allowing operators that are lazy in the+-- accumulator to yield intermediate results incrementally.  Such folds are+-- right-associative, with the tail of the stream returned as a lazily+-- evaluated component of the result (an element of a tuple or some other+-- non-strict constructor, e.g. the @(:)@ constructor for lists).+--+-- The @toList@ function below lazily transforms a @Foldable@ structure to a+-- List.  Note that this transformation may be lossy, e.g.  for a keyed+-- container (@Map@, @HashMap@, &#x2026;) the output stream holds only the+-- values, not the keys.  Lossless transformations to\/from lists of @(key,+-- value)@ pairs are typically available in the modules for the specific+-- container types.+--+-- > toList = foldr (:) []++--------------++-- $lazylist+--+-- The full list of lazy corecursive functions in this module is:+--+-- * Provided the reduction function is lazy in its second argument,+--   (otherwise best to use a strict recursive reduction):+--+--     @+--     `foldr`  :: Foldable t => (a -> b -> b) -> b -> t a -> b+--     `foldr1` :: Foldable t => (a -> a -> a) -> t a -> a+--     @+--+-- * Provided the 'Monoid' `mappend` is lazy in its second argument+--   (otherwise best to use a strict recursive reduction):+--+--     @+--     `fold`    :: Foldable t => Monoid m => t m -> m+--     `foldMap` :: Foldable t => Monoid m => (a -> m) -> t a -> m+--     @+--+-- * Provided the instance is correctly defined:+--+--     @+--     `toList`    :: Foldable t => t a -> [a]+--     `concat`    :: Foldable t => t [a] -> [a]+--     `concatMap` :: Foldable t => (a -> [b]) -> t a -> [b]+--     @++--------------++-- $shortcircuit+--+-- #short#+-- Examples of short-cicuit reduction include various boolean predicates that+-- test whether some or all the elements of a structure satisfy a given+-- condition.  Because these don't necessarily consume the entire list, they+-- typically employ `foldr` with an operator that is conditionally strict in+-- its second argument.  Once the termination condition is met the second+-- argument (tail of the input structure) is ignored.  No result is returned+-- until that happens.+--+-- The key distinguishing feature of these folds is /conditional/ strictness+-- in the second argument, it is sometimes evaluated and sometimes not.+--+-- The simplest (degenerate case) of these is 'null', which determines whether+-- a structure is empty or not.  This only needs to look at the first element,+-- and only to the extent of whether it exists or not, and not its value.  In+-- this case termination is guaranteed, and infinite input structures are fine.+-- Its default definition is of course in terms of the lazy 'foldr':+--+-- > null = foldr (\_ _ -> False) True+--+-- A more general example is `any`, which applies a predicate to each input+-- element in turn until it finds the first one for which the predicate is+-- true, at which point it returns success.  If, in an infinite input stream+-- the predicate is false for all the elements, `any` will not terminate,+-- but since it runs in constant space, it typically won't run out of memory,+-- it'll just loop forever.++--------------++-- $shortlist+--+-- The full list of short-circuit folds in this module is:+--+-- * Boolean predicate folds.+--   These functions examine elements strictly until a condition is met,+--   but then return a result ignoring the rest (lazy in the tail).  These+--   may loop forever given an unbounded input where no elements satisy the+--   termination condition.+--+--     @+--     `null`    :: Foldable t => t a -> Bool+--     `elem`    :: Foldable t => Eq a => a -> t a -> Bool+--     `notElem` :: (Foldable t, Eq a) => a -> t a -> Bool+--     `and`     :: Foldable t => t Bool -> Bool+--     `or`      :: Foldable t => t Bool -> Bool+--     `find`    :: Foldable t => (a -> Bool) -> t a -> Maybe a+--     `any`     :: Foldable t => (a -> Bool) -> t a -> Bool+--     `all`     :: Foldable t => (a -> Bool) -> t a -> Bool+--     @+--+-- * Many instances of '<|>' (e.g. the 'Maybe' instance) are conditionally+--   lazy, and use or don't use their second argument depending on the value+--   of the first.  These are used with the folds below, which terminate as+--   early as possible, but otherwise generally keep going.  Some instances+--   (e.g. for List) are always strict, but the result is lazy in the tail+--   of the output, so that `asum` for a list of lists is in fact corecursive.+--   These folds are defined in terms of `foldr`.+--+--     @+--     `asum` :: (Foldable t, Alternative f) => t (f a) -> f a+--     `msum` :: (Foldable t, MonadPlus m) => t (m a) -> m a+--     @+--+-- * Likewise, the '*>' operator in some `Applicative` functors, and '>>'+--   in some monads are conditionally lazy and can /short-circuit/ a chain of+--   computations.  The below folds will terminate as early as possible, but+--   even infinite loops can be productive here, when evaluated solely for+--   their stream of IO side-effects.  See "Data.Traversable#validation"+--   for some additional discussion.+--+--     @+--     `traverse_`  :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()+--     `for_`       :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()+--     `sequenceA_` :: (Foldable t, Applicative f) => t (f a) -> f ()+--     `mapM_`      :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()+--     `forM_`      :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()+--     `sequence_`  :: (Foldable t, Monad m) => t (m a) -> m ()+--     @+--+-- * Finally, there's one more special case, `foldlM`, which can short-circuit+--   when the monad @m@ is a 'MonadPlus', and the operator invokes 'mzero'.+--+--     @`foldlM` :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b@+--+--     This type of fold is right-associative in the monadic effects, and+--     left-associative in the output value.+--+--     Given a structure @t@ with elements @(a, b, ..., x, y)@, the result+--     of a fold with operator @f@ is equivalent to:+--+--     > foldlM f z t = do { aa <- f z a; bb <- f aa b; ... ; f xx y }+--+--     If in a 'MonadPlus' the bind short-circuits, the evaluated effects will+--     be from an initial portion of the sequence.+--+--     >>> :set -XBangPatterns+--     >>> import Control.Monad+--     >>> import Control.Monad.Trans.Class+--     >>> import Control.Monad.Trans.Maybe+--     >>> import Data.Foldable+--     >>> let f !_ e = when (e > 3) mzero >> lift (print e)+--     >>> runMaybeT $ foldlM f () [0..]+--     0+--     1+--     2+--     3+--     Nothing+--+--     Contrast this with `foldrM`, which uses `foldl` to sequence the effects,+--     and therefore diverges (running out of space) when given an unbounded+--     input structure.  The short-circuit condition is never reached+--+--     >>> let f e _ = when (e > 3) mzero >> lift (print e)+--     >>> runMaybeT $ foldrM f () [0..]+--     ...hangs...+--+--     If instead the operator short-circuits on the initial elements and the+--     structure is finite, `foldrM` will perform the monadic effects in reverse+--     order:+--+--     >>> let f e _ = when (e < 3) mzero >> lift (print e)+--     >>> runMaybeT $ foldrM f () [0..5]+--     5+--     4+--     3+--     Nothing++--------------++-- $hybrid+--+-- The below folds, are neither strict reductions that produce a final answer+-- in constant space, nor lazy corecursions, and so have limited applicability.+-- They do have specialised uses, but are best avoided when in doubt.+--+-- @+-- `foldr'` :: (a -> b -> b) -> b -> t a -> b+-- `foldl` :: (b -> a -> b) -> b -> t a -> b+-- `foldl1` :: (a -> a -> a) -> t a -> a+-- `foldrM` :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b+-- @+--+-- The lazy left-folds (used corecursively) and 'foldrM' (used to sequence+-- actions right-to-left) can be efficient in structures whose @Foldable@+-- instances take advantage of efficient right-to-left iteration to perform+-- lazy left folds outside-in from the right-most element.+--+-- The strict `foldr'` is the least likely to be useful, structures that+-- support efficient sequencing /only/ right-to-left are not at all common.++--------------++-- $instances+--+-- #instances#+-- For many structures reasonably efficient @Foldable@ instances can be derived+-- automatically, by enabling the @DeriveFoldable@ GHC extension.  When this+-- works, it is generally not necessary to define a custom instance by hand.+-- Though in some cases one may be able to get slightly faster hand-tuned code,+-- care is required to avoid producing slower code, or code that is not+-- sufficiently lazy, strict or /lawful/.+--+-- The hand-crafted instances can get away with only defining one of 'foldr' or+-- 'foldMap'.  All the other methods have default definitions in terms of one+-- of these.  The default definitions have the expected strictness and the+-- expected asymptotic runtime and space costs, modulo small constant factors.+-- If you choose to hand-tune, benchmarking is advised to see whether you're+-- doing better than the default derived implementations, plus careful tests to+-- ensure that the custom methods are correct.+--+-- Below we construct a @Foldable@ instance for a data type representing a+-- (finite) binary tree with depth-first traversal.+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be:+--+-- > instance Foldable Tree where+-- >    foldr f z Empty = z+-- >    foldr f z (Leaf x) = f x z+-- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l+--+-- The 'Node' case is a right fold of the left subtree whose initial+-- value is a right fold of the rest of the tree.+--+-- For example, when @f@ is @(':')@, all three cases return an immediate value,+-- respectively @z@ or a /cons cell/ holding @x@ or @l@, with the remainder the+-- structure, if any, encapsulated in a lazy thunk.  This meets the expected+-- efficient [corecursive](#corec) behaviour of 'foldr'.+--+-- Alternatively, one could define @foldMap@:+--+-- > instance Foldable Tree where+-- >    foldMap f Empty = mempty+-- >    foldMap f (Leaf x) = f x+-- >    foldMap f (Node l k r) = foldMap f l <> f k <> foldMap f r+--+-- And indeed some efficiency may be gained by directly defining both,+-- avoiding some indirection in the default definitions that express+-- one in terms of the other.  If you implement just one, likely 'foldr'+-- is the better choice.+--+-- A binary tree typically (when balanced, or randomly biased) provides equally+-- efficient access to its left and right subtrees.  This makes it possible to+-- define a `foldl` optimised for [corecursive](#corec) folds with operators+-- that are lazy in their first (left) argument.+--+-- > instance Foldable Tree where+-- >    foldr f z Empty = z+-- >    foldr f z (Leaf x) = f x z+-- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l+-- >    --+-- >    foldMap f Empty = mempty+-- >    foldMap f (Leaf x) = f x+-- >    foldMap f (Node l k r) = foldMap f l <> f k <> foldMap f r+-- >    --+-- >    foldl f z Empty = z+-- >    foldl f z (Leaf x) = f z x+-- >    foldl f z (Node l k r) = foldl f (f (foldl f z l) k) r+--+-- Now left-to-right and right-to-left iteration over the structure+-- elements are equally efficient (note the mirror-order output when+-- using `foldl`):+--+-- >>> foldr (\e acc -> e : acc) [] (Node (Leaf 1) 2 (Leaf 3))+-- [1,2,3]+-- >>> foldl (\acc e -> e : acc) [] (Node (Leaf 1) 2 (Leaf 3))+-- [3,2,1]+--+-- We can carry this further, and define more non-default methods...+--+-- The structure definition actually admits trees that are unbounded on either+-- or both sides.  The only fold that can plausibly terminate for a tree+-- unbounded on both left and right is `null`, when defined as shown below.+-- The default definition in terms of `foldr` diverges if the tree is unbounded+-- on the left.  Here we define a variant that avoids travelling down the tree+-- to find the left-most element and just examines the root node.+--+-- >    null Empty = True+-- >    null _     = False+--+-- This is a sound choice also for finite trees.+--+-- In practice, unbounded trees are quite uncommon, and can barely be said to+-- be @Foldable@.  They would typically employ breadth first traversal, and+-- would support only corecursive and short-circuit folds (diverge under strict+-- reduction).+--+-- Returning to simpler instances, defined just in terms of `foldr`, it is+-- somewhat surprising that a fairly efficient /default/ implementation of the+-- strict `foldl'` is defined in terms of lazy `foldr` when only the latter is+-- explicitly provided by the instance.  It may be instructive to take a look+-- at how this works.++--------------++-- $strictlazy+--+-- #strictlazy#+--+-- The left fold:+--+-- @foldl' f z [a, b, &#x2026;, x, y]@+--+-- can be expanded as:+--+-- @+-- id . g y . g x . &#x2026; . g b . g a $ z+--    where g = flip f+-- @+--+-- In which to maintain the expected strictness we need to perform function+-- application eagerly, and composition lazily.  To that end we introduce a new+-- function @f'@ which maps each element @x@ to an eager application of @g x@+-- to its argument, followed by an application of a lazily computed composition+-- (@k@) of the @g e@ functions for the remaining elements @e@:+--+-- > f' x k z = k $! (g x) z = k $! f z x+--+-- We see that a lazy 'foldr' of the @g e@ endomorphisms, with @f'@ as as the+-- operator, in fact yields a strict left fold, that avoids building a+-- deep chain of intermediate thunks:+--+-- > foldl' f z0 xs = foldr f' id xs z0+-- >   where f' x k z = k $! f z x+--+-- The function applied to @z0@ is built corecursively, and its terms are+-- applied eagerly to the accumulator before further terms are applied to+-- the result.  So, as promised, this will run in constant space, and GHC+-- is able to optimise this to an efficient loop.++--------------++-- $generative+--+-- #generative#+-- So far, we have not discussed /generative recursion/.  Unlike recursive+-- reduction or corecursion, instead of processing a sequence of elements+-- already in memory, generative recursion involves producing a possibly+-- unbounded sequence of values from an initial seed value.  The canonical+-- example of this is 'Data.List.unfoldr' for Lists, with variants available+-- for Vectors and various other structures.+--+-- A key issue with lists, when used generatively as /iterators/, rather than as+-- poor-man's containers (see [[1\]](#uselistsnot)), is that such iterators+-- tend to consume memory when used more than once.  A single traversal of a+-- list-as-iterator will run in constant space, but as soon as the list is+-- retained for reuse, its entire element sequence is stored in memory, and the+-- second traversal reads the copy, rather than regenerates the elements.  It+-- is sometimes better to recompute the elements rather than memoise the list.+--+-- Memoisation happens because the built-in Haskell list __@[]@__ is+-- represented as __data__, either empty or a /cons-cell/ holding the first+-- element and the tail of the list.  The @Foldable@ class enables a variant+-- representation of iterators as /functions/, which take an operator and a+-- starting accumulator and output a summary result.+--+-- The [@fmlist@](https://hackage.haskell.org/package/fmlist) package takes+-- this approach, by representing a list via its `foldMap` action.+--+-- Below we implement an analogous data structure using a representation+-- based on `foldr`.  This is an example of /Church encoding/+-- (named after Alonzo Church, inventor of the lambda calculus).+--+-- > {-# LANGUAGE RankNTypes #-}+-- > newtype FRList a = FR { unFR :: forall b. (a -> b -> b) -> b -> b }+--+-- The __@unFR@__ field of this type is essentially its `foldr` method+-- with the list as its first rather than last argument.  Thus we+-- immediately get a @Foldable@ instance (and a 'toList' function+-- mapping an __@FRList@__ to a regular list).+--+-- > instance Foldable FRList where+-- >     foldr f z l = unFR l f z+-- >     -- With older versions of @base@, also define sum, product, ...+-- >     -- to ensure use of the strict `foldl'`.+-- >     -- sum = foldl' (+) 0+-- >     -- ...+--+-- We can convert a regular list to an __@FRList@__ with:+--+-- > fromList :: [a] -> FRList a+-- > fromList as = FRList $ \ f z -> foldr f z as+--+-- However, reuse of an __@FRList@__ obtained in this way will typically+-- memoise the underlying element sequence.  Instead, we can define+-- __@FRList@__ terms directly:+--+-- > -- | Immediately return the initial accumulator+-- > nil :: FRList a+-- > nil = FRList $ \ _ z -> z+-- > {-# INLINE nil #-}+--+-- > -- | Fold the tail to use as an accumulator with the new initial element+-- > cons :: a -> FRList a -> FRList a+-- > cons a l = FRList $ \ f z -> f a (unFR l f z)+-- > {-# INLINE cons #-}+--+-- More crucially, we can also directly define the key building block for+-- generative recursion:+--+-- > -- | Generative recursion, dual to `foldr`.+-- > unfoldr :: (s -> Maybe (a, s)) -> s -> FRList a+-- > unfoldr g s0 = FR generate+-- >   where generate f z = loop s0+-- >           where loop s | Just (a, t) <- g s = f a (loop t)+-- >                        | otherwise = z+-- > {-# INLINE unfoldr #-}+--+-- Which can, for example, be specialised to number ranges:+--+-- > -- | Generate a range of consecutive integral values.+-- > range :: (Ord a, Integral a) => a -> a -> FRList a+-- > range lo hi =+-- >     unfoldr (\s -> if s > hi then Nothing else Just (s, s+1)) lo+-- > {-# INLINE range #-}+--+-- The program below, when compiled with optimisation:+--+-- > main :: IO ()+-- > main = do+-- >     let r :: FRList Int+-- >         r = range 1 10000000+-- >      in print (sum r, length r)+--+-- produces the expected output with no noticeable garbage-collection, despite+-- reuse of the __@FRList@__ term __@r@__.+--+-- > (50000005000000,10000000)+-- >     52,120 bytes allocated in the heap+-- >      3,320 bytes copied during GC+-- >     44,376 bytes maximum residency (1 sample(s))+-- >     25,256 bytes maximum slop+-- >          3 MiB total memory in use (0 MB lost due to fragmentation)+--+-- The Weak Head Normal Form of an __@FRList@__ is a lambda abstraction not a+-- data value, and reuse does not lead to memoisation.  Reuse of the iterator+-- above is somewhat contrived, when computing multiple folds over a common+-- list, you should generally traverse a  list only [once](#multipass).  The+-- goal is to demonstrate that the separate computations of the 'sum' and+-- 'length' run efficiently in constant space, despite reuse.  This would not+-- be the case with the list @[1..10000000]@.+--+-- This is, however, an artificially simple reduction.  More typically, there+-- are likely to be some allocations in the inner loop, but the temporary+-- storage used will be garbage-collected as needed, and overall memory+-- utilisation will remain modest and will not scale with the size of the list.+--+-- If we go back to built-in lists (i.e. __@[]@__), but avoid reuse by+-- performing reduction in a single pass, as below:+--+-- > data PairS a b = P !a !b -- We define a strict pair datatype+-- >+-- > main :: IO ()+-- > main = do+-- >     let l :: [Int]+-- >         l = [1..10000000]+-- >      in print $ average l+-- >   where+-- >     sumlen :: PairS Int Int -> Int -> PairS Int Int+-- >     sumlen (P s l) a = P (s + a) (l + 1)+-- >+-- >     average is =+-- >         let (P s l) = foldl' sumlen (P 0 0) is+-- >          in (fromIntegral s :: Double) / fromIntegral l+--+-- the result is again obtained in constant space:+--+-- > 5000000.5+-- >          102,176 bytes allocated in the heap+-- >            3,320 bytes copied during GC+-- >           44,376 bytes maximum residency (1 sample(s))+-- >           25,256 bytes maximum slop+-- >                3 MiB total memory in use (0 MB lost due to fragmentation)+--+-- (and, in fact, faster than with __@FRList@__ by a small factor).+--+-- The __@[]@__ list structure works as an efficient iterator when used+-- just once.  When space-leaks via list reuse are not a concern, and/or+-- memoisation is actually desirable, the regular list implementation is+-- likely to be faster.  This is not a suggestion to replace all your uses of+-- __@[]@__ with a generative alternative.+--+-- The __@FRList@__ type could be further extended with instances of 'Functor',+-- 'Applicative', 'Monad', 'Alternative', etc., and could then provide a+-- fully-featured list type, optimised for reuse without space-leaks.  If,+-- however, all that's required is space-efficient, re-use friendly iteration,+-- less is perhaps more, and just @Foldable@ may be sufficient.++--------------++-- $multipass+--+-- #multipass#+-- In applications where you want to compute a composite function of a+-- structure, which requires more than one aggregate as an input, it is+-- generally best to compute all the aggregates in a single pass, rather+-- than to traverse the same structure repeatedly.+--+-- The [@foldl@](http://hackage.haskell.org/package/foldl) package implements a+-- robust general framework for dealing with this situation.  If you choose to+-- to do it yourself, with a bit of care, the simplest cases are not difficult+-- to handle directly.  You just need to accumulate the individual aggregates+-- as __strict__ components of a single data type, and then apply a final+-- transformation to it to extract the composite result.  For example,+-- computing an average requires computing both the 'sum' and the 'length' of a+-- (non-empty) structure and dividing the sum by the length:+--+-- > import Data.Foldable (foldl')+-- >+-- > data PairS a b = P !a !b -- We define a strict pair datatype+-- >+-- > -- | Compute sum and length in a single pass, then reduce to the average.+-- > average :: (Foldable f, Fractional a) => f a -> a+-- > average xs =+-- >     let sumlen (P s l) a = P (s + a) (l + 1 :: Int)+-- >         (P s l) = foldl' sumlen (P 0 0) xs+-- >      in s / fromIntegral l+--+-- The above example is somewhat contrived, some structures keep track of their+-- length internally, and can return it in \(\mathcal{O}(1)\) time, so this+-- particular recipe for averages is not always the most efficient.  In+-- general, composite aggregate functions of large structures benefit from+-- single-pass reduction.  This is especially the case when reuse of a list and+-- memoisation of its elements is thereby avoided,++--------------++-- $laws+--+-- @Foldable@ instances are expected to satisfy the following laws:+--+-- > foldr f z t = appEndo (foldMap (Endo . f) t ) z+--+-- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+--+-- > fold = foldMap id+--+-- > length = getSum . foldMap (Sum . const 1)+--+-- @sum@, @product@, @maximum@, and @minimum@ should all be essentially+-- equivalent to @foldMap@ forms, such as+--+-- > sum     = getSum     . foldMap' Sum+-- > product = getProduct . foldMap' Product+--+-- but are generally more efficient when defined more directly as:+--+-- > sum = foldl' (+) 0+-- > sum = foldl' (*) 1+--+-- If the type is also a 'Functor' instance, it should satisfy+--+-- > foldMap f = fold . fmap f+--+-- which implies that+--+-- > foldMap f . fmap g = foldMap (f . g)+--++--------------++-- $notes+--+-- #notes#+-- The absence of a 'Functor' superclass allows+-- @Foldable@ structures to impose constraints on their element types.  Thus,+-- Sets are @Foldable@, even though @Set@ imposes an 'Ord' constraint on its+-- elements (this precludes defining a @Functor@ instance for @Set@).+--+-- The @Foldable@ class makes it possible to use idioms familiar from the List+-- type with container structures that are better suited to the task at hand.+-- This allows a user to substitute more appropriate @Foldable@ data types+-- for Lists without requiring new idioms (see [[1\]](#uselistsnot) for when+-- not to use lists).+--+-- The more general methods of the @Foldable@ class are now exported by the+-- "Prelude" in place of the original List-specific methods (see the+-- [FTP Proposal](https://wiki.haskell.org/Foldable_Traversable_In_Prelude)).+-- The List-specific variants are for now still available in "GHC.OldList", but+-- that module is intended only as a transitional aid, and may be removed in+-- the future.+--+-- Surprises can arise from the @Foldable@ instance of the 2-tuple @(a,)@ which+-- now behaves as a 1-element @Foldable@ container in its second slot.  In+-- contexts where a specific monomorphic type is expected, and you want to be+-- able to rely on type errors to guide refactoring, it may make sense to+-- define and use less-polymorphic variants of some of the @Foldable@ methods.+--+-- Below are two examples showing a definition of a reusable less-polymorphic+-- 'sum' and a one-off in-line specialisation of 'length':+--+-- > {-# LANGUAGE TypeApplications #-}+-- >+-- > mySum :: Num a => [a] -> a+-- > mySum = sum+-- >+-- > type SlowVector a = [a]+-- > slowLength :: SlowVector -> Int+-- > slowLength v = length @[] v+--+-- In both cases, if the data type to which the function is applied changes+-- to something other than a list, the call-site will no longer compile until+-- appropriate changes are made.++--------------++-- $also+--+--  * [1] #uselistsnot# \"When You Should Use Lists in Haskell (Mostly, You Should Not)\",+--    by Johannes Waldmann,+--    in arxiv.org, Programming Languages (cs.PL), at+--    <https://arxiv.org/abs/1808.08329>.+--+--  * [2] \"The Essence of the Iterator Pattern\",+--    by Jeremy Gibbons and Bruno Oliveira,+--    in /Mathematically-Structured Functional Programming/, 2006, online at+--    <http://www.cs.ox.ac.uk/people/jeremy.gibbons/publications/#iterator>.

@@ -25,7 +25,7 @@ --  Nothing                 --  (Int -> String) -> Maybe Int -> Maybe String -- --  >>> fmap show [1,2,3]   --  (a   -> b)      -> f a       -> f b---  ["1", "2", "3"]         --  (Int -> String) -> [Int]     -> [String]+--  ["1","2","3"]           --  (Int -> String) -> [Int]     -> [String] -- --  >>> fmap show []        --  (a   -> b)      -> f a       -> f b --  []                      --  (Int -> String) -> [Int]     -> [String]@@ -125,16 +125,6 @@  -- | Flipped version of '<$'. ----- Using @ApplicativeDo@: \'@as '$>' b@\' can be understood as the--- @do@ expression------ @--- do as---    pure b--- @------ with an inferred @Functor@ constraint.--- -- @since 4.7.0.0 -- -- ==== __Examples__@@ -171,17 +161,6 @@  -- | @'void' value@ discards or ignores the result of evaluation, such -- as the return value of an 'System.IO.IO' action.--------- Using @ApplicativeDo@: \'@'void' as@\' can be understood as the--- @do@ expression------ @--- do as---    pure ()--- @------ with an inferred @Functor@ constraint. -- -- ==== __Examples__ --

@@ -71,6 +71,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord (Down(Down)) +import GHC.Tuple (Solo (..)) import GHC.Read (expectP, list, paren)  import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)@@ -499,20 +500,39 @@     liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =         showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' +-- | @since 4.15+instance Eq1 Solo where+  liftEq eq (Solo a) (Solo b) = a `eq` b+ -- | @since 4.9.0.0 instance (Eq a) => Eq1 ((,) a) where     liftEq = liftEq2 (==) +-- | @since 4.15+instance Ord1 Solo where+  liftCompare cmp (Solo a) (Solo b) = cmp a b+ -- | @since 4.9.0.0 instance (Ord a) => Ord1 ((,) a) where     liftCompare = liftCompare2 compare +-- | @since 4.15+instance Read1 Solo where+    liftReadPrec rp _ = readData (readUnaryWith rp "Solo" Solo)++    liftReadListPrec = liftReadListPrecDefault+    liftReadList     = liftReadListDefault+ -- | @since 4.9.0.0 instance (Read a) => Read1 ((,) a) where     liftReadPrec = liftReadPrec2 readPrec readListPrec      liftReadListPrec = liftReadListPrecDefault     liftReadList     = liftReadListDefault++-- | @since 4.15+instance Show1 Solo where+    liftShowsPrec sp _ d (Solo x) = showsUnaryWith sp "Solo" d x  -- | @since 4.9.0.0 instance (Show a) => Show1 ((,) a) where

@@ -1,5 +1,8 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-}@@ -53,11 +56,11 @@ import Data.Functor.Sum import Data.Functor.Compose -import Data.Monoid (Alt(..))+import Data.Monoid (Alt(..), All(..)) import Data.Proxy import GHC.Generics -import Prelude hiding ((.),id)+import Prelude hiding ((.), id)  -- | The class of contravariant functors. --@@ -76,6 +79,7 @@ -- newtype Predicate a = Predicate { getPredicate :: a -> Bool } -- -- instance Contravariant Predicate where+--   contramap :: (a' -> a) -> (Predicate a -> Predicate a') --   contramap f (Predicate p) = Predicate (p . f) --                                          |   `- First, map the input... --                                          `----- then apply the predicate.@@ -86,7 +90,7 @@ -- -- Any instance should be subject to the following laws: ----- [Identity]    @'contramap' 'id' = 'id'@+-- [Identity]    @'contramap' 'id'      = 'id'@ -- [Composition] @'contramap' (g . f) = 'contramap' f . 'contramap' g@ -- -- Note, that the second law follows from the free theorem of the type of@@ -94,7 +98,7 @@ -- condition holds.  class Contravariant f where-  contramap :: (a -> b) -> f b -> f a+  contramap :: (a' -> a) -> (f a -> f a')    -- | Replace all locations in the output with the same value.   -- The default definition is @'contramap' . 'const'@, but this may be@@ -110,7 +114,7 @@ -- lawful we have the following laws: -- -- @--- 'fmap' f ≡ 'phantom'+-- 'fmap'      f ≡ 'phantom' -- 'contramap' f ≡ 'phantom' -- @ phantom :: (Functor f, Contravariant f) => f a -> f b@@ -123,79 +127,134 @@ ($<) = flip (>$)  -- | This is an infix alias for 'contramap'.-(>$<) :: Contravariant f => (a -> b) -> f b -> f a+(>$<) :: Contravariant f => (a -> b) -> (f b -> f a) (>$<) = contramap  -- | This is an infix version of 'contramap' with the arguments flipped. (>$$<) :: Contravariant f => f b -> (a -> b) -> f a (>$$<) = flip contramap -deriving instance Contravariant f => Contravariant (Alt f)-deriving instance Contravariant f => Contravariant (Rec1 f)-deriving instance Contravariant f => Contravariant (M1 i c f)+deriving newtype instance Contravariant f => Contravariant (Alt f)+deriving newtype instance Contravariant f => Contravariant (Rec1 f)+deriving newtype instance Contravariant f => Contravariant (M1 i c f)  instance Contravariant V1 where+  contramap :: (a' -> a) -> (V1 a -> V1 a')   contramap _ x = case x of  instance Contravariant U1 where+  contramap :: (a' -> a) -> (U1 a -> U1 a')   contramap _ _ = U1  instance Contravariant (K1 i c) where+  contramap :: (a' -> a) -> (K1 i c a -> K1 i c a')   contramap _ (K1 c) = K1 c  instance (Contravariant f, Contravariant g) => Contravariant (f :*: g) where+  contramap :: (a' -> a) -> ((f :*: g) a -> (f :*: g) a')   contramap f (xs :*: ys) = contramap f xs :*: contramap f ys  instance (Functor f, Contravariant g) => Contravariant (f :.: g) where+  contramap :: (a' -> a) -> ((f :.: g) a -> (f :.: g) a')   contramap f (Comp1 fg) = Comp1 (fmap (contramap f) fg)  instance (Contravariant f, Contravariant g) => Contravariant (f :+: g) where+  contramap :: (a' -> a) -> ((f :+: g) a -> (f :+: g) a')   contramap f (L1 xs) = L1 (contramap f xs)   contramap f (R1 ys) = R1 (contramap f ys)  instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where+  contramap :: (a' -> a) -> (Sum f g a -> Sum f g a')   contramap f (InL xs) = InL (contramap f xs)   contramap f (InR ys) = InR (contramap f ys)  instance (Contravariant f, Contravariant g)-  => Contravariant (Product f g) where-    contramap f (Pair a b) = Pair (contramap f a) (contramap f b)+      => Contravariant (Product f g) where+  contramap :: (a' -> a) -> (Product f g a -> Product f g a')+  contramap f (Pair a b) = Pair (contramap f a) (contramap f b)  instance Contravariant (Const a) where+  contramap :: (b' -> b) -> (Const a b -> Const a b')   contramap _ (Const a) = Const a  instance (Functor f, Contravariant g) => Contravariant (Compose f g) where+  contramap :: (a' -> a) -> (Compose f g a -> Compose f g a')   contramap f (Compose fga) = Compose (fmap (contramap f) fga)  instance Contravariant Proxy where+  contramap :: (a' -> a) -> (Proxy a -> Proxy a')   contramap _ _ = Proxy  newtype Predicate a = Predicate { getPredicate :: a -> Bool }---- | A 'Predicate' is a 'Contravariant' 'Functor', because 'contramap' can--- apply its function argument to the input of the predicate.-instance Contravariant Predicate where-  contramap f g = Predicate $ getPredicate g . f--instance Semigroup (Predicate a) where-  Predicate p <> Predicate q = Predicate $ \a -> p a && q a+  deriving+    ( -- | @('<>')@ on predicates uses logical conjunction @('&&')@ on+      -- the results. Without newtypes this equals @'liftA2' (&&)@.+      --+      -- @+      -- (<>) :: Predicate a -> Predicate a -> Predicate a+      -- Predicate pred <> Predicate pred' = Predicate \a ->+      --   pred a && pred' a+      -- @+      Semigroup+    , -- | @'mempty'@ on predicates always returns @True@. Without+      -- newtypes this equals @'pure' True@.+      --+      -- @+      -- mempty :: Predicate a+      -- mempty = \_ -> True+      -- @+      Monoid+    )+  via a -> All -instance Monoid (Predicate a) where-  mempty = Predicate $ const True+  deriving+    ( -- | A 'Predicate' is a 'Contravariant' 'Functor', because+      -- 'contramap' can apply its function argument to the input of+      -- the predicate.+      --+      -- Without newtypes @'contramap' f@ equals precomposing with @f@+      -- (= @(. f)@).+      --+      -- @+      -- contramap :: (a' -> a) -> (Predicate a -> Predicate a')+      -- contramap f (Predicate g) = Predicate (g . f)+      -- @+      Contravariant+    )+  via Op Bool  -- | Defines a total ordering on a type as per 'compare'. -- -- This condition is not checked by the types. You must ensure that the -- supplied values are valid total orderings yourself. newtype Comparison a = Comparison { getComparison :: a -> a -> Ordering }--deriving instance Semigroup (Comparison a)-deriving instance Monoid (Comparison a)+  deriving+  newtype+    ( -- | @('<>')@ on comparisons combines results with @('<>')+      -- \@Ordering@. Without newtypes this equals @'liftA2' ('liftA2'+      -- ('<>'))@.+      --+      -- @+      -- (<>) :: Comparison a -> Comparison a -> Comparison a+      -- Comparison cmp <> Comparison cmp' = Comparison \a a' ->+      --   cmp a a' <> cmp a a'+      -- @+      Semigroup+    , -- | @'mempty'@ on comparisons always returns @EQ@. Without+      -- newtypes this equals @'pure' ('pure' EQ)@.+      --+      -- @+      -- mempty :: Comparison a+      -- mempty = Comparison \_ _ -> EQ+      -- @+      Monoid+    )  -- | A 'Comparison' is a 'Contravariant' 'Functor', because 'contramap' can -- apply its function argument to each input of the comparison function. instance Contravariant Comparison where-  contramap f g = Comparison $ on (getComparison g) f+  contramap :: (a' -> a) -> (Comparison a -> Comparison a')+  contramap f (Comparison g) = Comparison (on g f)  -- | Compare using 'compare'. defaultComparison :: Ord a => Comparison a@@ -214,18 +273,34 @@ -- The types alone do not enforce these laws, so you'll have to check them -- yourself. newtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool }+  deriving+    ( -- | @('<>')@ on equivalences uses logical conjunction @('&&')@+      -- on the results. Without newtypes this equals @'liftA2'+      -- ('liftA2' (&&))@.+      --+      -- @+      -- (<>) :: Equivalence a -> Equivalence a -> Equivalence a+      -- Equivalence equiv <> Equivalence equiv' = Equivalence \a b ->+      --   equiv a b && equiv a b+      -- @+      Semigroup+    , -- | @'mempty'@ on equivalences always returns @True@. Without+      -- newtypes this equals @'pure' ('pure' True)@.+      --+      -- @+      -- mempty :: Equivalence a+      -- mempty = Equivalence \_ _ -> True+      -- @+      Monoid+    )+  via a -> a -> All  -- | Equivalence relations are 'Contravariant', because you can -- apply the contramapped function to each input to the equivalence -- relation. instance Contravariant Equivalence where-  contramap f g = Equivalence $ on (getEquivalence g) f--instance Semigroup (Equivalence a) where-  Equivalence p <> Equivalence q = Equivalence $ \a b -> p a b && q a b--instance Monoid (Equivalence a) where-  mempty = Equivalence (\_ _ -> True)+  contramap :: (a' -> a) -> (Equivalence a -> Equivalence a')+  contramap f (Equivalence g) = Equivalence (on g f)  -- | Check for equivalence with '=='. --@@ -238,15 +313,36 @@  -- | Dual function arrows. newtype Op a b = Op { getOp :: b -> a }--deriving instance Semigroup a => Semigroup (Op a b)-deriving instance Monoid a => Monoid (Op a b)+  deriving+  newtype+    ( -- | @('<>') \@(Op a b)@ without newtypes is @('<>') \@(b->a)@ =+      -- @liftA2 ('<>')@. This lifts the 'Semigroup' operation+      -- @('<>')@ over the output of @a@.+      --+      -- @+      -- (<>) :: Op a b -> Op a b -> Op a b+      -- Op f <> Op g = Op \a -> f a <> g a+      -- @+      Semigroup+    , -- | @'mempty' \@(Op a b)@ without newtypes is @mempty \@(b->a)@+      -- = @\_ -> mempty@.+      --+      -- @+      -- mempty :: Op a b+      -- mempty = Op \_ -> mempty+      -- @+      Monoid+    )  instance Category Op where+  id :: Op a a   id = Op id++  (.) :: Op b c -> Op a b -> Op a c   Op f . Op g = Op (g . f)  instance Contravariant (Op a) where+  contramap :: (b' -> b) -> (Op a b -> Op a b')   contramap f g = Op (getOp g . f)  instance Num a => Num (Op a b) where

@@ -49,7 +49,7 @@ -- |Mutate the contents of an 'IORef'. -- -- Be warned that 'modifyIORef' does not apply the function strictly.  This--- means if the program calls 'modifyIORef' many times, but seldomly uses the+-- means if the program calls 'modifyIORef' many times, but seldom uses the -- value, thunks will pile up in memory resulting in a space leak.  This is a -- common mistake made when using an IORef as a counter.  For example, the -- following will likely produce a stack overflow:

@@ -14,6 +14,7 @@ -- @since 4.9.0.0 ----------------------------------------------------------------------------- -module Data.Kind ( Type, Constraint ) where+module Data.Kind ( Type, Constraint, FUN ) where +import GHC.Prim import GHC.Types

@@ -25,6 +25,7 @@    , tail    , init    , uncons+   , singleton    , null    , length 

@@ -42,6 +42,7 @@    , tail        -- :: NonEmpty a -> [a]    , last        -- :: NonEmpty a -> a    , init        -- :: NonEmpty a -> [a]+   , singleton   -- :: a -> NonEmpty a    , (<|), cons  -- :: a -> NonEmpty a -> NonEmpty a    , uncons      -- :: NonEmpty a -> (a, Maybe (NonEmpty a))    , unfoldr     -- :: (a -> (b, Maybe a)) -> a -> NonEmpty b@@ -167,6 +168,12 @@ -- | Extract everything except the last element of the stream. init :: NonEmpty a -> [a] init ~(a :| as) = List.init (a : as)++-- | Construct a 'NonEmpty' list from a single element.+--+-- @since 4.15+singleton :: a -> NonEmpty a+singleton a = a :| []  -- | Prepend an element to the stream. (<|) :: a -> NonEmpty a -> NonEmpty a

@@ -148,8 +148,8 @@ fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x --- | The 'fromMaybe' function takes a default value and and 'Maybe'--- value.  If the 'Maybe' is 'Nothing', it returns the default values;+-- | The 'fromMaybe' function takes a default value and a 'Maybe'+-- value.  If the 'Maybe' is 'Nothing', it returns the default value; -- otherwise, it returns the value contained in the 'Maybe'. -- -- ==== __Examples__

@@ -129,16 +129,6 @@ -- -- >>> getFirst (First (Just "hello") <> First Nothing <> First (Just "world")) -- Just "hello"------ Use of this type is discouraged. Note the following equivalence:------ > Data.Monoid.First x === Maybe (Data.Semigroup.First x)------ In addition to being equivalent in the structural sense, the two--- also have 'Monoid' instances that behave the same. This type will--- be marked deprecated in GHC 8.8, and removed in GHC 8.10.--- Users are advised to use the variant from "Data.Semigroup" and wrap--- it in 'Maybe'. newtype First a = First { getFirst :: Maybe a }         deriving ( Eq          -- ^ @since 2.01                  , Ord         -- ^ @since 2.01@@ -168,16 +158,6 @@ -- -- >>> getLast (Last (Just "hello") <> Last Nothing <> Last (Just "world")) -- Just "world"------ Use of this type is discouraged. Note the following equivalence:------ > Data.Monoid.Last x === Maybe (Data.Semigroup.Last x)------ In addition to being equivalent in the structural sense, the two--- also have 'Monoid' instances that behave the same. This type will--- be marked deprecated in GHC 8.8, and removed in GHC 8.10.--- Users are advised to use the variant from "Data.Semigroup" and wrap--- it in 'Maybe'. newtype Last a = Last { getLast :: Maybe a }         deriving ( Eq          -- ^ @since 2.01                  , Ord         -- ^ @since 2.01@@ -233,7 +213,33 @@   minBound = pure minBound   maxBound = pure maxBound --- | @since 4.12.0.0+-- | Note that even if the underlying 'Num' and 'Applicative' instances are+-- lawful, for most 'Applicative's, this instance will not be lawful. If you use+-- this instance with the list 'Applicative', the following customary laws will+-- not hold:+--+-- Commutativity:+--+-- >>> Ap [10,20] + Ap [1,2]+-- Ap {getAp = [11,12,21,22]}+-- >>> Ap [1,2] + Ap [10,20]+-- Ap {getAp = [11,21,12,22]}+--+-- Additive inverse:+--+-- >>> Ap [] + negate (Ap [])+-- Ap {getAp = []}+-- >>> fromInteger 0 :: Ap [] Int+-- Ap {getAp = [0]}+--+-- Distributivity:+--+-- >>> Ap [1,2] * (3 + 4)+-- Ap {getAp = [7,14]}+-- >>> (Ap [1,2] * 3) + (Ap [1,2] * 4)+-- Ap {getAp = [7,11,10,14]}+--+-- @since 4.12.0.0 instance (Applicative f, Num a) => Num (Ap f a) where   (+)         = liftA2 (+)   (*)         = liftA2 (*)

@@ -26,6 +26,7 @@    , tail    , init    , uncons+   , singleton    , null    , length @@ -1258,7 +1259,7 @@ -- input list.  This is called the decorate-sort-undecorate paradigm, or -- Schwartzian transform. ----- Elements are arranged from from lowest to highest, keeping duplicates in+-- Elements are arranged from lowest to highest, keeping duplicates in -- the order they appeared in the input. -- -- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")]@@ -1268,6 +1269,16 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f =   map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))++-- | Produce singleton list.+--+-- >>> singleton True+-- [True]+--+-- @since 4.14.0.0+--+singleton :: a -> [a]+singleton x = [x]  -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr' -- reduces a list to a summary value, 'unfoldr' builds a list from

@@ -27,11 +27,11 @@ import Foreign.Storable (Storable) import GHC.Ix (Ix) import GHC.Base-import GHC.Enum (Bounded, Enum)+import GHC.Enum (Bounded(..)) import GHC.Float (Floating, RealFloat) import GHC.Num import GHC.Read-import GHC.Real (Fractional, Integral, Real, RealFrac)+import GHC.Real (Fractional, Real, RealFrac) import GHC.Show  -- |@@ -46,11 +46,30 @@  -- | The 'Down' type allows you to reverse sort order conveniently.  A value of type -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).+-- -- If @a@ has an @'Ord'@ instance associated with it then comparing two -- values thus wrapped will give you the opposite of their normal sort order. -- This is particularly useful when sorting in generalised list comprehensions,--- as in: @then sortWith by 'Down' x@+-- as in: @then sortWith by 'Down' x@. --+-- >>> compare True False+-- GT+--+-- >>> compare (Down True) (Down False)+-- LT+--+-- If @a@ has a @'Bounded'@ instance then the wrapped instance also respects+-- the reversed ordering by exchanging the values of @'minBound'@ and+-- @'maxBound'@.+--+-- >>> minBound :: Int+-- -9223372036854775808+--+-- >>> minBound :: Down Int+-- Down 9223372036854775807+--+-- All other instances of @'Down' a@ behave as they do for @a@.+-- -- @since 4.6.0.0 newtype Down a = Down     { getDown :: a -- ^ @since 4.14.0.0@@ -61,12 +80,9 @@       , Semigroup -- ^ @since 4.11.0.0       , Monoid    -- ^ @since 4.11.0.0       , Bits       -- ^ @since 4.14.0.0-      , Bounded    -- ^ @since 4.14.0.0-      , Enum       -- ^ @since 4.14.0.0       , FiniteBits -- ^ @since 4.14.0.0       , Floating   -- ^ @since 4.14.0.0       , Fractional -- ^ @since 4.14.0.0-      , Integral   -- ^ @since 4.14.0.0       , Ix         -- ^ @since 4.14.0.0       , Real       -- ^ @since 4.14.0.0       , RealFrac   -- ^ @since 4.14.0.0@@ -93,6 +109,13 @@ -- | @since 4.6.0.0 instance Ord a => Ord (Down a) where     compare (Down x) (Down y) = y `compare` x++-- | Swaps @'minBound'@ and @'maxBound'@ of the underlying type.+--+-- @since 4.14.0.0+instance Bounded a => Bounded (Down a) where+    minBound = Down maxBound+    maxBound = Down minBound  -- | @since 4.11.0.0 instance Functor Down where

@@ -40,7 +40,7 @@ -- "Hello, world!" -- -- Be warned that 'modifySTRef' does not apply the function strictly.  This--- means if the program calls 'modifySTRef' many times, but seldomly uses the+-- means if the program calls 'modifySTRef' many times, but seldom uses the -- value, thunks will pile up in memory resulting in a space leak.  This is a -- common mistake made when using an 'STRef' as a counter.  For example, the -- following will leak memory and may produce a stack overflow:

@@ -125,6 +125,21 @@ cycle1 xs = xs' where xs' = xs <> xs'  -- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.+--+-- === __Example:__+-- >>> let hello = diff "Hello, "+-- >>> appEndo hello "World!"+-- "Hello, World!"+-- >>> appEndo (hello <> mempty) "World!"+-- "Hello, World!"+-- >>> appEndo (mempty <> hello) "World!"+-- "Hello, World!"+-- >>> let world = diff "World"+-- >>> let excl = diff "!"+-- >>> appEndo (hello <> (world <> excl)) mempty+-- "Hello, World!"+-- >>> appEndo ((hello <> world) <> excl) mempty+-- "Hello, World!" diff :: Semigroup m => m -> Endo m diff = Endo . (<>) @@ -271,7 +286,15 @@  -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max.-data Arg a b = Arg a b deriving+--+-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ]+-- Arg 0 0+data Arg a b = Arg+  a+  -- ^ The argument used for comparisons in 'Eq' and 'Ord'.+  b+  -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances.+  deriving   ( Show     -- ^ @since 4.9.0.0   , Read     -- ^ @since 4.9.0.0   , Data     -- ^ @since 4.9.0.0@@ -279,7 +302,14 @@   , Generic1 -- ^ @since 4.9.0.0   ) +-- |+-- >>> Min (Arg 0 ()) <> Min (Arg 1 ())+-- Min {getMin = Arg 0 ()} type ArgMin a b = Min (Arg a b)++-- |+-- >>> Max (Arg 0 ()) <> Max (Arg 1 ())+-- Max {getMax = Arg 1 ()} type ArgMax a b = Max (Arg a b)  -- | @since 4.9.0.0@@ -320,8 +350,6 @@ instance Bitraversable Arg where   bitraverse f g (Arg a b) = Arg <$> f a <*> g b --- | Use @'Option' ('First' a)@ to get the behavior of--- 'Data.Monoid.First' from "Data.Monoid". newtype First a = First { getFirst :: a }   deriving ( Bounded  -- ^ @since 4.9.0.0            , Eq       -- ^ @since 4.9.0.0@@ -378,8 +406,6 @@ instance MonadFix First where   mfix f = fix (f . getFirst) --- | Use @'Option' ('Last' a)@ to get the behavior of--- 'Data.Monoid.Last' from "Data.Monoid" newtype Last a = Last { getLast :: a }   deriving ( Bounded  -- ^ @since 4.9.0.0            , Eq       -- ^ @since 4.9.0.0@@ -484,6 +510,8 @@   | n == 0    = mempty   | otherwise = unwrapMonoid (stimes n (WrapMonoid x)) +{-# DEPRECATED Option, option "will be removed in GHC 9.2; use 'Maybe' instead." #-}+ -- | 'Option' is effectively 'Maybe' with a better instance of -- 'Monoid', built off of an underlying 'Semigroup' instead of an -- underlying 'Monoid'.@@ -493,8 +521,7 @@ -- -- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been -- corrected to lift a 'Semigroup' instance instead of a 'Monoid'--- instance. Consequently, this type is no longer useful. It will be--- marked deprecated in GHC 8.8 and removed in GHC 8.10.+-- instance. Consequently, this type is no longer useful. newtype Option a = Option { getOption :: Maybe a }   deriving ( Eq       -- ^ @since 4.9.0.0            , Ord      -- ^ @since 4.9.0.0

@@ -4,7 +4,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Auxilary definitions for 'Semigroup'+-- | Auxiliary definitions for 'Semigroup' -- -- This module provides some @newtype@ wrappers and helpers which are -- reexported from the "Data.Semigroup" module or imported directly

@@ -4,7 +4,7 @@  import {-# SOURCE #-} GHC.Real (Integral) import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe)-import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base+import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base  stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a 

@@ -18,24 +18,6 @@ -- -- Class of data structures that can be traversed from left to right, -- performing an action on each element.------ See also------  * \"Applicative Programming with Effects\",---    by Conor McBride and Ross Paterson,---    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at---    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.------  * \"The Essence of the Iterator Pattern\",---    by Jeremy Gibbons and Bruno Oliveira,---    in /Mathematically-Structured Functional Programming/, 2006, online at---    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.------  * \"An Investigation of the Laws of Traversals\",---    by Mauro Jaskelioff and Ondrej Rypacek,---    in /Mathematically-Structured Functional Programming/, 2012, online at---    <http://arxiv.org/pdf/1202.2919>.--- -----------------------------------------------------------------------------  module Data.Traversable (@@ -49,6 +31,32 @@     -- * General definitions for superclass methods     fmapDefault,     foldMapDefault,++    -- * Overview+    -- $overview++    -- ** The 'traverse' and 'mapM' methods+    -- $traverse++    -- ** Validation use-case+    -- $validation++    -- ** The 'sequenceA' and 'sequence' methods+    -- $sequence++    -- ** Sample instance+    -- $sample_instance++    -- ** Construction+    --+    -- $construction++    -- * Laws+    --+    -- $laws++    -- * See also+    -- $also     ) where  -- It is convenient to use 'Const' here but this means we must@@ -56,7 +64,7 @@ import Control.Applicative ( Const(..), ZipList(..) ) import Data.Coerce import Data.Either ( Either(..) )-import Data.Foldable ( Foldable )+import Data.Foldable import Data.Functor import Data.Functor.Identity ( Identity(..) ) import Data.Functor.Utils ( StateL(..), StateR(..) )@@ -70,89 +78,58 @@                   ($), (.), id, flip ) import GHC.Generics import qualified GHC.List as List ( foldr )+import GHC.Tuple (Solo (..)) +-- $setup+-- >>> import Prelude+-- >>> import Data.Maybe (catMaybes, mapMaybe)+-- >>> import Data.Either (rights)+-- >>> import Data.Foldable (traverse_)++-- XXX: Missing haddock feature.  Links to anchors in other modules+-- don't have a sensible way to name the link within the module itself.+-- Thus, the below "Data.Traversable#overview" works well when shown as+-- @Data.Traversable@ from other modules, but in the home module it should+-- be possible to specify alternative link text. :-(+ -- | Functors representing data structures that can be traversed from--- left to right.------ A definition of 'traverse' must satisfy the following laws:------ [Naturality]---   @t . 'traverse' f = 'traverse' (t . f)@---   for every applicative transformation @t@------ [Identity]---   @'traverse' 'Identity' = 'Identity'@------ [Composition]---   @'traverse' ('Data.Functor.Compose.Compose' . 'fmap' g . f)---     = 'Data.Functor.Compose.Compose' . 'fmap' ('traverse' g) . 'traverse' f@------ A definition of 'sequenceA' must satisfy the following laws:------ [Naturality]---   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@---   for every applicative transformation @t@------ [Identity]---   @'sequenceA' . 'fmap' 'Identity' = 'Identity'@------ [Composition]---   @'sequenceA' . 'fmap' 'Data.Functor.Compose.Compose'---     = 'Data.Functor.Compose.Compose' . 'fmap' 'sequenceA' . 'sequenceA'@------ where an /applicative transformation/ is a function------ @t :: (Applicative f, Applicative g) => f a -> g a@------ preserving the 'Applicative' operations, i.e.------ @--- t ('pure' x) = 'pure' x--- t (f '<*>' x) = t f '<*>' t x--- @------ and the identity functor 'Identity' and composition functors--- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and--- "Data.Functor.Compose".------ A result of the naturality law is a purity law for 'traverse'------ @'traverse' 'pure' = 'pure'@------ (The naturality law is implied by parametricity and thus so is the--- purity law [1, p15].)------ Instances are similar to 'Functor', e.g. given a data type------ > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)------ a suitable instance would be------ > instance Traversable Tree where--- >    traverse f Empty = pure Empty--- >    traverse f (Leaf x) = Leaf <$> f x--- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r------ This is suitable even for abstract types, as the laws for '<*>'--- imply a form of associativity.------ The superclass instances should satisfy the following:------  * In the 'Functor' instance, 'fmap' should be equivalent to traversal---    with the identity applicative functor ('fmapDefault').+-- left to right, performing an action on each element. -----  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be---    equivalent to traversal with a constant applicative functor---    ('foldMapDefault').+-- A more detailed description can be found in the overview section of+-- "Data.Traversable#overview". ----- References:--- [1] The Essence of the Iterator Pattern, Jeremy Gibbons and Bruno C. d. S. Oliveira class (Functor t, Foldable t) => Traversable t where     {-# MINIMAL traverse | sequenceA #-}      -- | Map each element of a structure to an action, evaluate these actions     -- from left to right, and collect the results. For a version that ignores     -- the results see 'Data.Foldable.traverse_'.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- In the first two examples we show each evaluated action mapping to the+    -- output structure.+    --+    -- >>> traverse Just [1,2,3,4]+    -- Just [1,2,3,4]+    --+    -- >>> traverse id [Right 1, Right 2, Right 3, Right 4]+    -- Right [1,2,3,4]+    --+    -- In the next examples, we show that 'Nothing' and 'Left' values short+    -- circuit the created structure.+    --+    -- >>> traverse (const Nothing) [1,2,3,4]+    -- Nothing+    --+    -- >>> traverse (\x -> if odd x then Just x else Nothing)  [1,2,3,4]+    -- Nothing+    --+    -- >>> traverse id [Right 1, Right 2, Right 3, Right 4, Left 0]+    -- Left 0+    --     traverse :: Applicative f => (a -> f b) -> t a -> f (t b)     {-# INLINE traverse #-}  -- See Note [Inline default methods]     traverse f = sequenceA . fmap f@@ -160,6 +137,30 @@     -- | Evaluate each action in the structure from left to right, and     -- collect the results. For a version that ignores the results     -- see 'Data.Foldable.sequenceA_'.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- For the first two examples we show sequenceA fully evaluating a+    -- a structure and collecting the results.+    --+    -- >>> sequenceA [Just 1, Just 2, Just 3]+    -- Just [1,2,3]+    --+    -- >>> sequenceA [Right 1, Right 2, Right 3]+    -- Right [1,2,3]+    --+    -- The next two example show 'Nothing' and 'Just' will short circuit+    -- the resulting structure if present in the input. For more context,+    -- check the 'Traversable' instances for 'Either' and 'Maybe'.+    --+    -- >>> sequenceA [Just 1, Just 2, Just 3, Nothing]+    -- Nothing+    --+    -- >>> sequenceA [Right 1, Right 2, Right 3, Left 4]+    -- Left 4+    --     sequenceA :: Applicative f => t (f a) -> f (t a)     {-# INLINE sequenceA #-}  -- See Note [Inline default methods]     sequenceA = traverse id@@ -167,6 +168,13 @@     -- | Map each element of a structure to a monadic action, evaluate     -- these actions from left to right, and collect the results. For     -- a version that ignores the results see 'Data.Foldable.mapM_'.+    --+    -- ==== __Examples__+    --+    -- 'mapM' is literally a 'traverse' with a type signature restricted+    -- to 'Monad'. Its implementation may be more efficient due to additional+    -- power of 'Monad'.+    --     mapM :: Monad m => (a -> m b) -> t a -> m (t b)     {-# INLINE mapM #-}  -- See Note [Inline default methods]     mapM = traverse@@ -174,6 +182,29 @@     -- | Evaluate each monadic action in the structure from left to     -- right, and collect the results. For a version that ignores the     -- results see 'Data.Foldable.sequence_'.+    --+    -- ==== __Examples__+    --+    -- Basic usage:+    --+    -- The first two examples are instances where the input and+    -- and output of 'sequence' are isomorphic.+    --+    -- >>> sequence $ Right [1,2,3,4]+    -- [Right 1,Right 2,Right 3,Right 4]+    --+    -- >>> sequence $ [Right 1,Right 2,Right 3,Right 4]+    -- Right [1,2,3,4]+    --+    -- The following examples demonstrate short circuit behavior+    -- for 'sequence'.+    --+    -- >>> sequence $ Left [1,2,3,4]+    -- Left [1,2,3,4]+    --+    -- >>> sequence $ [Left 0, Right 1,Right 2,Right 3,Right 4]+    -- Left 0+    --     sequence :: Monad m => t (m a) -> m (t a)     {-# INLINE sequence #-}  -- See Note [Inline default methods]     sequence = sequenceA@@ -241,6 +272,9 @@     traverse _ (Left x) = pure (Left x)     traverse f (Right y) = Right <$> f y +-- | @since 4.15+deriving instance Traversable Solo+ -- | @since 4.7.0.0 instance Traversable ((,) a) where     traverse f (x, y) = (,) x <$> f y@@ -376,6 +410,17 @@ -- and 'Data.Foldable.foldl'; it applies a function to each element of a structure, -- passing an accumulating parameter from left to right, and returning -- a final value of this accumulator together with the new structure.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> mapAccumL (\a b -> (a + b, a)) 0 [1..10]+-- (55,[0,1,3,6,10,15,21,28,36,45])+--+-- >>> mapAccumL (\a b -> (a <> show b, a)) "0" [1..5]+-- ("012345",["0","01","012","0123","01234"])+-- mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s @@ -383,6 +428,17 @@ -- and 'Data.Foldable.foldr'; it applies a function to each element of a structure, -- passing an accumulating parameter from right to left, and returning -- a final value of this accumulator together with the new structure.+--+-- ==== __Examples__+--+-- Basic usage:+--+-- >>> mapAccumR (\a b -> (a + b, a)) 0 [1..10]+-- (55,[54,52,49,45,40,34,27,19,10,0])+--+-- >>> mapAccumR (\a b -> (a <> show b, a)) "0" [1..5]+-- ("054321",["05432","0543","054","05","0"])+-- mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s @@ -411,3 +467,410 @@ {-# INLINE foldMapDefault #-} -- See Note [Function coercion] in Data.Functor.Utils. foldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ()))++------------------++-- $overview+--+-- #overview#+-- Traversable functors can be thought of as polymorphic containers that+-- support mapping of applicative (or monadic) effects over the container+-- (element-wise) to create a new container of __the same shape__, with the+-- effects sequenced in a natural order for the container type in question.+--+-- The 'Functor' base class means that the container cannot impose any+-- constraints on the element type, so containers that require elements to+-- be comparable, or hashable, etc., cannot be instances of the @Traversable@+-- class.++------------------++-- $traverse+-- For an 'Applicative' functor __@f@__ and a Traversable functor __@t@__, the+-- type signatures of 'traverse' and 'fmap' are rather similar:+--+-- > fmap     :: (a -> f b) -> t a -> t (f b)+-- > traverse :: (a -> f b) -> t a -> f (t b)+--+-- with one crucial difference: 'fmap' produces a container of effects, while+-- traverse produces an aggregate container-valued effect.  For example, when+-- __@f@__ is the __@IO@__ monad, and __@t@__ is the List functor, while 'fmap'+-- returns a list of pending IO actions 'traverse' returns an IO action that+-- evaluates to a list of the return values of the individual actions performed+-- left-to-right.+--+-- More concretely, if @nameAndLineCount@ counts the number of lines in a file,+-- returning a pair with input filename and the line count, then traversal+-- over a list of file names produces an IO action that evaluates to a list+-- of __@(fileName, lineCount)@__ pairs:+--+-- @+-- nameAndLineCount :: FilePath -> IO (FilePath, Int)+-- nameAndLineCount fn = ...+-- @+--+-- Then @traverse nameAndLineCount ["/etc/passwd","/etc/hosts"]@+-- could return+--+-- @+-- [("/etc/passwd",56),("/etc/hosts",32)]+-- @+--+-- The specialisation of 'traverse' to the case when __@f@__ is a monad is+-- called 'mapM'.  The two are otherwise generally identical:+--+-- > traverse :: (Applicative f, Traversable t) => (a -> f b) -> t a -> f (t b)+-- > mapM     :: (Monad       m, Traversable t) => (a -> m b) -> t a -> m (t b)+--+-- The behaviour of 'traverse' and 'mapM' can be at first surprising when the+-- applicative functor __@f@__ is __@[]@__ (i.e. the List monad).  The List+-- monad is said to be /non-deterministic/, by which is meant that applying a+-- list of __@n@__ functions __@[a -> b]@__ to a list of __@k@__ values+-- __@[a]@__ produces a list of __@n*k@__ values of each function applied to+-- each input value.+--+-- As a result, traversal with a function __@f :: a -> [b]@__, over an input+-- container __@t a@__, yields a list __@[t b]@__, whose length is the product+-- of the lengths of the lists that the function returns for each element of+-- the input container!  The individual elements __@a@__ of the container are+-- replaced by each element of __@f a@__ in turn:+--+-- >>> mapM (\n -> [0..n]) $ Just 2+-- [Just 0,Just 1,Just 2]+-- >>> mapM (\n -> [0..n]) [0..2]+-- [[0,0,0],[0,0,1],[0,0,2],[0,1,0],[0,1,1],[0,1,2]]+--+-- If any element of the container is mapped to an empty list, then the+-- aggregate result is empty (no value is available to fill one of the+-- slots of the output container).+--+-- >>> traverse (const []) $ Just 0+-- []+--+-- When however the traversed container is empty, the result is always a+-- singleton of the empty container, the function is never evaluated+-- as there are no input values for it to be applied to.+--+-- >>> traverse (const []) Nothing+-- [Nothing]+--+-- The result of 'traverse' is all-or-nothing, either containers of exactly the+-- same shape as the input or a failure ('Nothing', 'Left', empty list, etc.).+-- The 'traverse' function does not perform selective filtering as with e.g.+-- 'Data.Maybe.mapMaybe':+--+-- >>> let incOdd n = if odd n then Just $ n + 1 else Nothing+-- >>> traverse incOdd [1, 2, 3]+-- Nothing+-- >>> mapMaybe incOdd [1, 2, 3]+-- [2,4]++------------------++-- $validation+--+-- #validation#+-- A hypothetical application of the above is to validate a structure:+--+-- >>> :{+-- validate :: Int -> Either (String, Int) Int+-- validate i = if odd i then Left ("That's odd", i) else Right i+-- :}+--+-- >>> traverse validate [2,4,6,8,10]+-- Right [2,4,6,8,10]+-- >>> traverse validate [2,4,6,8,9]+-- Left ("That's odd",9)+--+-- Since 'Nothing' is an empty structure, none of its elements are odd.+--+-- >>> traverse validate Nothing+-- Right Nothing+-- >>> traverse validate (Just 42)+-- Right (Just 42)+-- >>> traverse validate (Just 17)+-- Left ("That's odd",17)+--+-- However, this is not terribly efficient, because we pay the cost of+-- reconstructing the entire structure as a side effect of validation.+-- It is generally cheaper to just check all the elements and then use+-- the original structure if it is valid.  This can be done via the+-- methods of the 'Foldable' superclass, which perform only the+-- side effects without generating a new structure:+--+-- >>> traverse_ validate [2,4,6,8,10]+-- Right ()+-- >>> traverse_ validate [2,4,6,8,9]+-- Left ("That's odd",9)+--+-- The 'Foldable' instance should be defined in a manner that avoids+-- construction of an unnecesary copy of the container.+--+-- The @Foldable@ method 'mapM_' and its flipped version 'forM_' can be used+-- to sequence IO actions over all the elements of a @Traversable@ container+-- (just for their side-effects, ignoring any results) .  One special+-- case is a 'Maybe' container that optionally holds a value. Given:+--+-- > action :: a -> IO ()+-- > mvalue :: Maybe a+--+-- if you want to evaluate the __@action@__ in the @Just@ case, and do+-- nothing otherwise, you can write the more concise and more general:+--+-- > mapM_ action mvalue+--+-- rather than+--+-- > maybe (return ()) action mvalue+--+-- The 'mapM_' form works verbatim if the type of __@mvalue@__ is later+-- refactored from __@Maybe a@__ to __@Either e a@__ (assuming it remains+-- OK to silently do nothing in the error case).+--+-- There's even a generic way to handle empty values ('Nothing', 'Left', etc.):+--+-- > case traverse_ (const Nothing) mvalue of+-- >     Nothing -> mapM_ action mvalue -- mvalue is non-empty+-- >     Just () -> ... handle empty mvalue ...++------------------++-- $sequence+-- The 'sequenceA' and 'sequence' methods are useful when what you have is a+-- container of applicative or, respectively, monadic actions, and you want to+-- evaluate them left-to-right to obtain a container of the computed values.+--+-- > sequenceA :: (Applicative f, Traversable t) => t (f a) -> f (t a)+-- > sequence  :: (Monad       m, Traversable t) => t (m a) -> m (t a)+-- > sequenceA = traverse id+-- > sequence  = mapM id+--+-- When the monad __@m@__ is 'System.IO.IO', applying 'sequence' to a list of+-- IO actions, performs each in turn, returning a list of the results:+--+-- > sequence [putStr "Hello ", putStrLn "World!"]+-- >     = (\a b -> [a,b]) <$> putStr "Hello " <*> putStrLn "World!"+-- >     = do u1 <- putStr "Hello "+-- >          u2 <- putStrLn "World!"+-- >          return (u1, u2)+--+-- For 'sequenceA', the /non-deterministic/ behaviour of @List@ is most easily+-- seen in the case of a list of lists (of elements of some common fixed type).+-- The result is a cross-product of all the sublists:+--+-- >>> sequenceA [[0, 1, 2], [30, 40], [500]]+-- [[0,30,500],[0,40,500],[1,30,500],[1,40,500],[2,30,500],[2,40,500]]+--+-- When the monad __@m@__ is 'Maybe' or 'Either', the effect in question is to+-- short-circuit the computation on encountering 'Nothing' or 'Left'.+--+-- >>> sequence [Just 1,Just 2,Just 3]+-- Just [1,2,3]+-- >>> sequence [Just 1,Nothing,Just 3]+-- Nothing+-- >>> sequence [Right 1,Right 2,Right 3]+-- Right [1,2,3]+-- >>> sequence [Right 1,Left "sorry",Right 3]+-- Left "sorry"+--+-- The result of 'sequence' is all-or-nothing, either containers of exactly the+-- same shape as the input or a failure ('Nothing', 'Left', empty list, etc.).+-- The 'sequence' function does not perform selective filtering as with e.g.+-- 'Data.Maybe.catMaybes' or 'Data.Either.rights':+--+-- >>> catMaybes [Just 1,Nothing,Just 3]+-- [1,3]+-- >>> rights [Right 1,Left "sorry",Right 3]+-- [1,3]++------------------++-- $sample_instance+--+-- Instances are similar to 'Functor', e.g. given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Traversable Tree where+-- >    traverse f Empty = pure Empty+-- >    traverse f (Leaf x) = Leaf <$> f x+-- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r+--+-- This definition works for any applicative functor in the co-domain of @f@,+-- as the laws for '<*>' imply a form of associativity.++------------------++-- $construction+--+-- How do @Traversable@ functors manage to construct a new container of the+-- same shape by sequencing effects over their elements?  Well, left-to-right+-- traversal with sequencing of effects suggests induction from a base case, so+-- the first question is what is the base case?  A @Traversable@ container with+-- elements of type __@a@__ generally has some minimal form that is either+-- "empty" or has just a single element (think "Data.List" vs.+-- "Data.List.Nonempty").+--+-- * If the base case is empty (no associated first value of __@a@__) then+--   traversal just reproduces the empty structure with no side effects,+--   so we have:+--+--     > traverse _ empty = pure empty+--+--     With the List monad, "empty" is __@[]@__, while with 'Maybe' it is+--     'Nothing'.  With __@Either e a@__ we have an /empty/ case for each+--     value of __@e@__.+--+-- * If the base case is a __@singleton a@__, then 'traverse' can take that+--   __@a@__, apply __@f :: a -> F b@__ getting an __@F b@__, then+--   __@fmap singleton@__ over that, getting __@F (singleton b)@__:+--+--     > traverse f (singleton a) = singleton <$> f a+--+-- Since 'Maybe' and 'Either' are either empty or singletons, we have+--+-- > traverse _ Nothing = pure Nothing+-- > traverse f (Just a) = Just <$> f a+--+-- > traverse _ (Left e) = pure (Left e)+-- > traverse f (Right a) = Right <$> f a+--+-- Similarly, for List, we have:+--+-- > traverse f [] = pure []+-- > traverse f [a] = fmap (:[]) (f a) = (:) <$> f a <*> pure []+--+-- What remains to be done is an inductive step beyond the empty and singleton+-- cases.  For a concrete @Traversable@ functor @T@ we need to be able to+-- extend our structure incrementally by filling in holes.  We can view a+-- partially built structure __@t0 :: T a@__ as a function+-- __@append :: a -> T a@__ that takes one more element __@a@__ to insert into+-- the container to the right of the existing elements to produce a larger+-- structure.  Conversely, we can view an element @a@ as a function+-- __@prepend :: T a -> T a@__ of a partially built structure that inserts the+-- element to the left of the existing elements.+--+-- Assuming that 'traverse' has already been defined on the partially built+-- structure:+--+-- > f0 = traverse f t0 :: F (T b)+--+-- we aim to define __@traverse f (append t0 a)@__ and/or+-- __@traverse f (prepend a t0)@__.+--+-- We can lift @append@ and apply it to @f0@ to get:+--+-- > append <$> f0 :: F (b -> T b)+--+-- and from the /next/ element __@a@__ we can obtain __@f a :: F b@__, and+-- this is where we'll make use of the applicative instance of @F@.  Adding+-- one more element on the right is then:+--+-- > traverse f (append t0 a) = append <$> traverse f t0 <*> f a+--+-- while prepending an element on the left is:+--+-- > traverse f (prepend a t0) = prepend <$> f a <*> traverse f t0+--+-- The (binary) @Tree@ instance example makes use of both, after defining the+-- @Empty@ base case and the singleton @Leaf@ node case, non-empty internal+-- nodes introduce both a prepended child node on the left and an appended+-- child node on the right:+--+-- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r+--+-- The above definitions sequence the 'Applicative' effects of __@F@__ in the+-- expected order while producing results of the expected shape __@T@__.+--+-- For lists we get the natural order of effects by using+-- __@(prepend \<$\> f a)@__ as the operator and __@(traverse f as)@__ as the+-- operand (the actual definition is written as an equivalent right fold+-- in order to enable /fusion/ rules):+--+-- > traverse f [] = pure []+-- > traverse f (a:as) = (:) <$> f a <*> traverse f as+--+-- The origin of the combinatorial product when __@F@__ is __@[]@__ should now+-- be apparent, the /non-deterministic/ definition of @\<*\>@ for @List@ makes+-- multiple independent choices for each element of the structure.++------------------++-- $laws+-- A definition of 'traverse' must satisfy the following laws:+--+-- [Naturality]+--   @t . 'traverse' f = 'traverse' (t . f)@+--   for every applicative transformation @t@+--+-- [Identity]+--   @'traverse' 'Identity' = 'Identity'@+--+-- [Composition]+--   @'traverse' ('Data.Functor.Compose.Compose' . 'fmap' g . f)+--     = 'Data.Functor.Compose.Compose' . 'fmap' ('traverse' g) . 'traverse' f@+--+-- A definition of 'sequenceA' must satisfy the following laws:+--+-- [Naturality]+--   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@+--   for every applicative transformation @t@+--+-- [Identity]+--   @'sequenceA' . 'fmap' 'Identity' = 'Identity'@+--+-- [Composition]+--   @'sequenceA' . 'fmap' 'Data.Functor.Compose.Compose'+--     = 'Data.Functor.Compose.Compose' . 'fmap' 'sequenceA' . 'sequenceA'@+--+-- where an /applicative transformation/ is a function+--+-- @t :: (Applicative f, Applicative g) => f a -> g a@+--+-- preserving the 'Applicative' operations, i.e.+--+-- @+-- t ('pure' x) = 'pure' x+-- t (f '<*>' x) = t f '<*>' t x+-- @+--+-- and the identity functor 'Identity' and composition functors+-- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and+-- "Data.Functor.Compose".+--+-- A result of the naturality law is a purity law for 'traverse'+--+-- @'traverse' 'pure' = 'pure'@+--+-- (The naturality law is implied by parametricity and thus so is the+-- purity law [1, p15].)+--+-- The superclass instances should satisfy the following:+--+--  * In the 'Functor' instance, 'fmap' should be equivalent to traversal+--    with the identity applicative functor ('fmapDefault').+--+--  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be+--    equivalent to traversal with a constant applicative functor+--    ('foldMapDefault').++------------------++-- $also+--+--  * [1] \"The Essence of the Iterator Pattern\",+--    by Jeremy Gibbons and Bruno Oliveira,+--    in /Mathematically-Structured Functional Programming/, 2006, online at+--    <http://www.cs.ox.ac.uk/people/jeremy.gibbons/publications/#iterator>.+--+--  * \"Applicative Programming with Effects\",+--    by Conor McBride and Ross Paterson,+--    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at+--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.+--+--  * \"An Investigation of the Laws of Traversals\",+--    by Mauro Jaskelioff and Ondrej Rypacek,+--    in /Mathematically-Structured Functional Programming/, 2012, online at+--    <http://arxiv.org/pdf/1202.2919>.

@@ -62,7 +62,7 @@ -- in the body of the pattern-match, the compiler knows that @a ~ b@. -- -- @since 4.7.0.0-data a :~: b where  -- See Note [The equality types story] in TysPrim+data a :~: b where  -- See Note [The equality types story] in GHC.Builtin.Types.Prim   Refl :: a :~: a  -- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van

@@ -19,6 +19,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE LinearTypes #-}  ----------------------------------------------------------------------------- -- |@@ -81,9 +82,10 @@     typeSymbolTypeRep, typeNatTypeRep,   ) where +import GHC.Prim ( FUN ) import GHC.Base import qualified GHC.Arr as A-import GHC.Types ( TYPE )+import GHC.Types ( TYPE, Multiplicity (Many) ) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word@@ -209,18 +211,19 @@                , trAppKind :: !(TypeRep k2) }   -- See Note [Kind caching]             -> TypeRep (a b) -    -- | @TrFun fpr a b@ represents a function type @a -> b@. We use this for+    -- | @TrFun fpr m a b@ represents a function type @a # m -> b@. We use this for     -- the sake of efficiency as functions are quite ubiquitous.-    TrFun   :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+    TrFun   :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)                       (a :: TYPE r1) (b :: TYPE r2).                { -- See Note [TypeRep fingerprints]                  trFunFingerprint :: {-# UNPACK #-} !Fingerprint                   -- The TypeRep represents a function from trFunArg to                  -- trFunRes.+               , trFunMul :: !(TypeRep m)                , trFunArg :: !(TypeRep a)                , trFunRes :: !(TypeRep b) }-            -> TypeRep (a -> b)+            -> TypeRep (FUN m a b)  {- Note [TypeRep fingerprints]    ~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -308,7 +311,7 @@  -- | A non-indexed type representation. data SomeTypeRep where-    SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep+    SomeTypeRep :: forall k (a :: k). !(TypeRep a) %1 -> SomeTypeRep  instance Eq SomeTypeRep where   SomeTypeRep a == SomeTypeRep b =@@ -335,8 +338,8 @@             => TypeRep arg             -> TypeRep res             -> TypeRep fun-pattern Fun arg res <- TrFun {trFunArg = arg, trFunRes = res}-  where Fun arg res = mkTrFun arg res+pattern Fun arg res <- TrFun {trFunArg = arg, trFunRes = res, trFunMul = (eqTypeRep trMany -> Just HRefl)}+  where Fun arg res = mkTrFun trMany arg res  -- | Observe the 'Fingerprint' of a type representation --@@ -383,6 +386,9 @@ trLiftedRep :: TypeRep 'LiftedRep trLiftedRep = typeRep +trMany :: TypeRep 'Many+trMany = typeRep+ -- | Construct a representation for a type application that is -- NOT a saturated arrow type. This is not checked! @@ -426,7 +432,7 @@   , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)   , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry                   $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep-  = mkTrFun x y+  = mkTrFun trMany x y mkTrAppChecked a b = mkTrApp a b  -- | A type application.@@ -455,9 +461,9 @@  data AppOrCon (a :: k) where     IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()-          => TypeRep f -> TypeRep x -> AppOrCon (f x)+          => TypeRep f %1 -> TypeRep x %1 -> AppOrCon (f x)     -- See Note [Con evidence]-    IsCon :: IsApplication a ~ "" => TyCon -> [SomeTypeRep] -> AppOrCon a+    IsCon :: IsApplication a ~ "" => TyCon %1 -> [SomeTypeRep] %1 -> AppOrCon a  type family IsApplication (x :: k) :: Symbol where   IsApplication (_ _) = "An error message about this unifying with \"\" "@@ -565,7 +571,7 @@ eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).              TypeRep a -> TypeRep b -> Maybe (a :~~: b) eqTypeRep a b-  | sameTypeRep a b = Just (unsafeCoerce# HRefl)+  | sameTypeRep a b = Just (unsafeCoerce HRefl)   | otherwise       = Nothing -- We want GHC to inline eqTypeRep to get rid of the Maybe -- in the usual case that it is scrutinized immediately. We@@ -616,7 +622,7 @@     go (KindRepApp f a)       = SomeTypeRep $ mkTrApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a)     go (KindRepFun a b)-      = SomeTypeRep $ mkTrFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)+      = SomeTypeRep $ mkTrFun trMany (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)     go (KindRepTYPE LiftedRep) = SomeTypeRep TrType     go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r     go (KindRepTypeLitS sort s)@@ -634,7 +640,7 @@  data SomeKindedTypeRep k where     SomeKindedTypeRep :: forall k (a :: k). TypeRep a-                      -> SomeKindedTypeRep k+                      %1 -> SomeKindedTypeRep k  kApp :: SomeKindedTypeRep (k -> k')      -> SomeKindedTypeRep k@@ -712,19 +718,19 @@     rep :: forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem     rep = kindedTypeRep @VecElem @a -bareArrow :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+bareArrow :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)                     (a :: TYPE r1) (b :: TYPE r2). ()-          => TypeRep (a -> b)-          -> TypeRep ((->) :: TYPE r1 -> TYPE r2 -> Type)-bareArrow (TrFun _ a b) =-    mkTrCon funTyCon [SomeTypeRep rep1, SomeTypeRep rep2]+          => TypeRep (FUN m a b)+          -> TypeRep (FUN m :: TYPE r1 -> TYPE r2 -> Type)+bareArrow (TrFun _ m a b) =+    mkTrCon funTyCon [SomeTypeRep m, SomeTypeRep rep1, SomeTypeRep rep2]   where     rep1 = getRuntimeRep $ typeRepKind a :: TypeRep r1     rep2 = getRuntimeRep $ typeRepKind b :: TypeRep r2 bareArrow _ = error "Data.Typeable.Internal.bareArrow: impossible"  data IsTYPE (a :: Type) where-    IsTYPE :: forall (r :: RuntimeRep). TypeRep r -> IsTYPE (TYPE r)+    IsTYPE :: forall (r :: RuntimeRep). TypeRep r %1 -> IsTYPE (TYPE r)  -- | Is a type of the form @TYPE rep@? isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a)@@ -816,8 +822,9 @@       = (tc, xs)     go xs (TrApp {trAppFun = f, trAppArg = x})       = go (SomeTypeRep x : xs) f-    go [] (TrFun {trFunArg = a, trFunRes = b})-      = (funTyCon, [SomeTypeRep a, SomeTypeRep b])+    go [] (TrFun {trFunArg = a, trFunRes = b, trFunMul = mul})+      | Just HRefl <- eqTypeRep trMany mul = (funTyCon, [SomeTypeRep a, SomeTypeRep b])+      | otherwise = errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Only unrestricted functions are supported"     go _  (TrFun {})       = errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible 1"     go [] TrType = (tyConTYPE, [SomeTypeRep trLiftedRep])@@ -934,7 +941,7 @@                                      (unpackCStringUtf8# name)  -- it is extremely important that this fingerprint computation--- remains in sync with that in TcTypeable to ensure that type+-- remains in sync with that in GHC.Tc.Instance.Typeable to ensure that type -- equality is correct.  -- | Exquisitely unsafe.@@ -954,7 +961,7 @@     fingerprint :: Fingerprint     fingerprint = mkTyConFingerprint pkg modl name --- This must match the computation done in TcTypeable.mkTyConRepTyConRHS.+-- This must match the computation done in GHC.Tc.Instance.Typeable.mkTyConRepTyConRHS. mkTyConFingerprint :: String -- ^ package name                    -> String -- ^ module name                    -> String -- ^ tycon name@@ -983,7 +990,7 @@ mkTypeLitFromString TypeLitSymbol s =     SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Symbol) mkTypeLitFromString TypeLitNat s =-    SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Nat)+    SomeTypeRep $ (typeLitTypeRep s tcNat :: TypeRep Nat)  tcSymbol :: TyCon tcSymbol = typeRepTyCon (typeRep @Symbol)@@ -997,14 +1004,16 @@ typeLitTypeRep nm kind_tycon = mkTrCon (mkTypeLitTyCon nm kind_tycon) []  -- | For compiler use.-mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+mkTrFun :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)                   (a :: TYPE r1) (b :: TYPE r2).-           TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type)-mkTrFun arg res = TrFun+           TypeRep m -> TypeRep a -> TypeRep b -> TypeRep ((FUN m a b) :: Type)+mkTrFun mul arg res = TrFun     { trFunFingerprint = fpr+    , trFunMul = mul     , trFunArg = arg     , trFunRes = res }-  where fpr = fingerprintFingerprints [ typeRepFingerprint arg+  where fpr = fingerprintFingerprints [ typeRepFingerprint mul+                                      , typeRepFingerprint arg                                       , typeRepFingerprint res]  {- $kind_instantiation

@@ -24,7 +24,6 @@  import System.IO.Unsafe (unsafePerformIO) -import GHC.Base import GHC.Num import Data.IORef @@ -77,4 +76,4 @@ -- same value, although in practice this is unlikely.  The 'Int' -- returned makes a good hash key. hashUnique :: Unique -> Int-hashUnique (Unique i) = I# (hashInteger i)+hashUnique (Unique i) = integerToInt i

@@ -0,0 +1,12 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Version+  ( Version+  , makeVersion+  ) where++import GHC.Base++data Version++makeVersion :: [Int] -> Version

@@ -78,16 +78,7 @@  -- | If 'Void' is uninhabited then any 'Functor' that holds only -- values of type 'Void' is holding no values.------ Using @ApplicativeDo@: \'@'vacuous' theVoid@\' can be understood as the--- @do@ expression------ @--- do void <- theVoid---    pure (absurd void)--- @------ with an inferred @Functor@ constraint.+-- It is implemented in terms of @fmap absurd@. -- -- @since 4.8.0.0 vacuous :: Functor f => f Void -> f a

@@ -66,31 +66,6 @@        addForeignPtrFinalizer finalizer fObj        return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b--- ^This is a way to look at the pointer living inside a--- foreign object.  This function takes a function which is--- applied to that pointer. The resulting 'IO' action is then--- executed. The foreign object is kept alive at least during--- the whole action, even if it is not used directly--- inside. Note that it is not safe to return the pointer from--- the action and use it after the action completes. All uses--- of the pointer should be inside the--- 'withForeignPtr' bracket.  The reason for--- this unsafeness is the same as for--- 'unsafeForeignPtrToPtr' below: the finalizer--- may run earlier than expected, because the compiler can only--- track usage of the 'ForeignPtr' object, not--- a 'Ptr' object made from it.------ This function is normally used for marshalling data to--- or from the object pointed to by the--- 'ForeignPtr', using the operations from the--- 'Storable' class.-withForeignPtr fo io-  = do r <- io (unsafeForeignPtrToPtr fo)-       touchForeignPtr fo-       return r- -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer.  The environment -- that will be passed to the finalizer is fixed by the second argument to

@@ -116,19 +116,6 @@ alloca  =   allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) --- Note [NOINLINE for touch#]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~--- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously--- fragile in the presence of simplification (see #14346). In particular, the--- simplifier may drop the continuation containing the touch# if it can prove--- that the action passed to allocaBytes will not return. The hack introduced to--- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the--- simplifier can't see the divergence.------ These can be removed once #14375 is fixed, which suggests that we instead do--- away with touch# in favor of a primitive that will capture the scoping left--- implicit in the case of touch#.- -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic@@ -143,12 +130,8 @@      case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->      let addr = Ptr (byteArrayContents# barr#) in      case action addr     of { IO action' ->-     case action' s2      of { (# s3, r #) ->-     case touch# barr# s3 of { s4 ->-     (# s4, r #)-  }}}}}--- See Note [NOINLINE for touch#]-{-# NOINLINE allocaBytes #-}+     keepAlive# barr# s2 action'+  }}}  allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->@@ -156,12 +139,8 @@      case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->      let addr = Ptr (byteArrayContents# barr#) in      case action addr     of { IO action' ->-     case action' s2      of { (# s3, r #) ->-     case touch# barr# s3 of { s4 ->-     (# s4, r #)-  }}}}}--- See Note [NOINLINE for touch#]-{-# NOINLINE allocaBytesAligned #-}+     keepAlive# barr# s2 action'+  }}}  -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b@.  The returned pointer

@@ -6,7 +6,7 @@ -- Module      :  Foreign.Marshal.Utils -- Copyright   :  (c) The FFI task force 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  ffi@haskell.org -- Stability   :  provisional -- Portability :  portable@@ -72,8 +72,8 @@ -- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required. -- new     :: Storable a => a -> IO (Ptr a)-new val  = -  do +new val  =+  do     ptr <- malloc     poke ptr val     return ptr@@ -122,12 +122,12 @@ -- |Converts a @withXXX@ combinator into one marshalling a value wrapped -- into a 'Maybe', using 'nullPtr' to represent 'Nothing'. ---maybeWith :: (      a -> (Ptr b -> IO c) -> IO c) +maybeWith :: (      a -> (Ptr b -> IO c) -> IO c)           -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybeWith  = maybe ($ nullPtr)  -- |Convert a peek combinator into a one returning 'Nothing' if applied to a--- 'nullPtr' +-- 'nullPtr' -- maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b) maybePeek peek ptr | ptr == nullPtr  = return Nothing@@ -155,16 +155,26 @@ -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas may /not/ overlap ---copyBytes               :: Ptr a -> Ptr a -> Int -> IO ()-copyBytes dest src size  = do _ <- memcpy dest src (fromIntegral size)-                              return ()+copyBytes+  :: Ptr a -- ^ Destination+  -> Ptr a -- ^ Source+  -> Int -- ^ Size in bytes+  -> IO ()+copyBytes dest src size = do+  _ <- memcpy dest src (fromIntegral size)+  return ()  -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas /may/ overlap ---moveBytes               :: Ptr a -> Ptr a -> Int -> IO ()-moveBytes dest src size  = do _ <- memmove dest src (fromIntegral size)-                              return ()+moveBytes+  :: Ptr a -- ^ Destination+  -> Ptr a -- ^ Source+  -> Int -- ^ Size in bytes+  -> IO ()+moveBytes dest src size = do+  _ <- memmove dest src (fromIntegral size)+  return ()  -- Filling up memory area with required values -- -------------------------------------------

@@ -1,17 +1,5 @@ {- -NOTA BENE: Do NOT use ($) anywhere in this module! The type of ($) is-slightly magical (it can return unlifted types), and it is wired in.-But, it is also *defined* in this module, with a non-magical type.-GHC gets terribly confused (and *hangs*) if you try to use ($) in this-module, because it has different types in different scenarios.--This is not a problem in general, because the type ($), being wired in, is not-written out to the interface file, so importing files don't get confused.-The problem is only if ($) is used here. So don't!------------------------------------------------ The overall structure of the GHC Prelude is a bit tricky.    a) We want to avoid "orphan modules", i.e. ones with instance@@ -132,9 +120,8 @@ import GHC.Maybe import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) -import GHC.Tuple ()              -- Note [Depend on GHC.Tuple]-import GHC.Integer ()            -- Note [Depend on GHC.Integer]-import GHC.Natural ()            -- Note [Depend on GHC.Natural]+import GHC.Tuple (Solo (..))     -- Note [Depend on GHC.Tuple]+import GHC.Num.Integer ()        -- Note [Depend on GHC.Num.Integer]  -- for 'class Semigroup' import {-# SOURCE #-} GHC.Real (Integral)@@ -144,6 +131,9 @@                                               , stimesIdempotentMonoid                                               ) +-- $setup+-- >>> import GHC.Num+ infixr 9  . infixr 5  ++ infixl 4  <$@@ -156,30 +146,33 @@ default ()              -- Double isn't available yet  {--Note [Depend on GHC.Integer]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The Integer type is special because TidyPgm uses-GHC.Integer.Type.mkInteger to construct Integer literal values-Currently it reads the interface file whether or not the current-module *has* any Integer literals, so it's important that-GHC.Integer.Type (in package integer-gmp or integer-simple) is-compiled before any other module.  (There's a hack in GHC to disable-this for packages ghc-prim, integer-gmp, integer-simple, which aren't-allowed to contain any Integer literals.)+Note [Depend on GHC.Num.Integer]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Likewise we implicitly need Integer when deriving things like Eq-instances.+The Integer type is special because GHC.Iface.Tidy uses constructors in+GHC.Num.Integer to construct Integer literal values. Currently it reads the+interface file whether or not the current module *has* any Integer literals, so+it's important that GHC.Num.Integer is compiled before any other module. +(There's a hack in GHC to disable this for packages ghc-prim and ghc-bignum+which aren't allowed to contain any Integer literals.)++Likewise we implicitly need Integer when deriving things like Eq instances.+ The danger is that if the build system doesn't know about the dependency-on Integer, it'll compile some base module before GHC.Integer.Type,+on Integer, it'll compile some base module before GHC.Num.Integer, resulting in:-  Failed to load interface for ‘GHC.Integer.Type’-    There are files missing in the ‘integer-gmp’ package,+  Failed to load interface for ‘GHC.Num.Integer’+    There are files missing in the ‘ghc-bignum’ package, -Bottom line: we make GHC.Base depend on GHC.Integer; and everything+Bottom line: we make GHC.Base depend on GHC.Num.Integer; and everything else either depends on GHC.Base, or does not have NoImplicitPrelude (and hence depends on Prelude). +Note: this is only a problem with the make-based build system. Hadrian doesn't+seem to interleave compilation of modules from separate packages and respects+the dependency between `base` and `ghc-bignum`.+ Note [Depend on GHC.Tuple] ~~~~~~~~~~~~~~~~~~~~~~~~~~ Similarly, tuple syntax (or ()) creates an implicit dependency on@@ -187,9 +180,6 @@ GHC.Integer] --- to explain this to the build system.  We make GHC.Base depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude. -Note [Depend on GHC.Natural]-~~~~~~~~~~~~~~~~~~~~~~~~~~-Similar to GHC.Integer. -}  #if 0@@ -231,7 +221,7 @@         -- The default definition should be sufficient, but this can be         -- overridden for efficiency.         ---        -- >>> import Data.List.NonEmpty+        -- >>> import Data.List.NonEmpty (NonEmpty (..))         -- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"]         -- "Hello Haskell!"         sconcat :: NonEmpty a -> a@@ -300,8 +290,9 @@         -- >>> mconcat ["Hello", " ", "Haskell", "!"]         -- "Hello Haskell!"         mconcat :: [a] -> a-        {-# INLINE mconcat #-}         mconcat = foldr mappend mempty+        {-# INLINE mconcat #-}+        -- INLINE in the hope of fusion with mconcat's argument (see !4890)  -- | @since 4.9.0.0 instance Semigroup [a] where@@ -332,7 +323,7 @@ We mark them INLINE because the inliner is not generally too keen to inline build forms such as the ones these desugar to without our insistence.  Defining these using list comprehensions instead of foldr has an additional potential-benefit, as described in compiler/deSugar/DsListComp.hs: if optimizations+benefit, as described in compiler/GHC/HsToCore/ListComp.hs: if optimizations needed to make foldr/build forms efficient are turned off, we'll get reasonably efficient translations anyway. -}@@ -362,6 +353,15 @@         mempty        = ()         mconcat _     = () +-- | @since 4.15+instance Semigroup a => Semigroup (Solo a) where+  Solo a <> Solo b = Solo (a <> b)+  stimes n (Solo a) = Solo (stimes n a)++-- | @since 4.15+instance Monoid a => Monoid (Solo a) where+  mempty = Solo mempty+ -- | @since 4.9.0.0 instance (Semigroup a, Semigroup b) => Semigroup (a, b) where         (a,b) <> (a',b') = (a<>a',b<>b')@@ -436,6 +436,20 @@ instance Semigroup a => Monoid (Maybe a) where     mempty = Nothing +-- | @since 4.15+instance Applicative Solo where+  pure = Solo++  -- Note: we really want to match strictly here. This lets us write,+  -- for example,+  --+  -- forceSpine :: Foldable f => f a -> ()+  -- forceSpine xs+  --   | Solo r <- traverse_ Solo xs+  --   = r+  Solo f <*> Solo x = Solo (f x)+  liftA2 f (Solo x) (Solo y) = Solo (f x y)+ -- | For tuples, the 'Monoid' constraint on @a@ determines -- how the first values merge. -- For example, 'String's concatenate:@@ -449,6 +463,10 @@     (u, f) <*> (v, x) = (u <> v, f x)     liftA2 f (u, x) (v, y) = (u <> v, f x y) +-- | @since 4.15+instance Monad Solo where+  Solo x >>= f = f x+ -- | @since 4.9.0.0 instance Monoid a => Monad ((,) a) where     (u, a) >>= k = case k a of (v, b) -> (u <> v, b)@@ -498,31 +516,61 @@ the first law, so you need only check that the former condition holds. -} -class  Functor f  where-    -- | Using @ApplicativeDo@: \'@'fmap' f as@\' can be understood as-    -- the @do@ expression+class Functor f where+    -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@,+    -- where f is a functor, to produce a value of type @f b@.+    -- Note that for any type constructor with more than one parameter (e.g., `Either`),+    -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`).     ---    -- @-    -- do a <- as-    --    pure (f a)-    -- @+    -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows+    -- both the last and the penultimate parameters to be mapped over.+    -- ==== __Examples__     ---    -- with an inferred @Functor@ constraint.+    -- Convert from a @'Data.Maybe.Maybe' Int@ to a @Maybe String@+    -- using 'Prelude.show':+    --+    -- >>> fmap show Nothing+    -- Nothing+    -- >>> fmap show (Just 3)+    -- Just "3"+    --+    -- Convert from an @'Data.Either.Either' Int Int@ to an+    -- @Either Int String@ using 'Prelude.show':+    --+    -- >>> fmap show (Left 17)+    -- Left 17+    -- >>> fmap show (Right 17)+    -- Right "17"+    --+    -- Double each element of a list:+    --+    -- >>> fmap (*2) [1,2,3]+    -- [2,4,6]+    --+    -- Apply 'Prelude.even' to the second element of a pair:+    --+    -- >>> fmap even (2,2)+    -- (2,True)+    --+    -- It may seem surprising that the function is only applied to the last element of the tuple+    -- compared to the list example above which applies it to every element in the list.+    -- To understand, remember that tuples are type constructors with multiple type parameters:+    -- a tuple of 3 elements `(a,b,c)` can also be written `(,,) a b c` and its `Functor` instance+    -- is defined for `Functor ((,,) a b)` (i.e., only the third parameter is free to be mapped over+    -- with `fmap`).+    --+    -- It explains why `fmap` can be used with tuples containing values of different types as in the+    -- following example:+    --+    -- >>> fmap even ("hello", 1.0, 4)+    -- ("hello",1.0,True)+     fmap        :: (a -> b) -> f a -> f b      -- | Replace all locations in the input with the same value.     -- The default definition is @'fmap' . 'const'@, but this may be     -- overridden with a more efficient version.     ---    -- Using @ApplicativeDo@: \'@a '<$' bs@\' can be understood as the-    -- @do@ expression-    ---    -- @-    -- do bs-    --    pure a-    -- @-    ---    -- with an inferred @Functor@ constraint.     (<$)        :: a -> f b -> f a     (<$)        =  fmap . const @@ -600,14 +648,18 @@     -- A few functors support an implementation of '<*>' that is more     -- efficient than the default one.     ---    -- Using @ApplicativeDo@: \'@fs '<*>' as@\' can be understood as-    -- the @do@ expression+    -- ==== __Example__+    -- Used in combination with @('<$>')@, @('<*>')@ can be used to build a record.     ---    -- @-    -- do f <- fs-    --    a <- as-    --    pure (f a)-    -- @+    -- >>> data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz}+    --+    -- >>> produceFoo :: Applicative f => f Foo+    --+    -- >>> produceBar :: Applicative f => f Bar+    -- >>> produceBaz :: Applicative f => f Baz+    --+    -- >>> mkState :: Applicative f => f MyState+    -- >>> mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz     (<*>) :: f (a -> b) -> f a -> f b     (<*>) = liftA2 id @@ -621,38 +673,38 @@     -- This became a typeclass method in 4.10.0.0. Prior to that, it was     -- a function defined in terms of '<*>' and 'fmap'.     ---    -- Using @ApplicativeDo@: \'@'liftA2' f as bs@\' can be understood-    -- as the @do@ expression-    ---    -- @-    -- do a <- as-    --    b <- bs-    --    pure (f a b)-    -- @+    -- ==== __Example__+    -- >>> liftA2 (,) (Just 3) (Just 5)+    -- Just (3,5)      liftA2 :: (a -> b -> c) -> f a -> f b -> f c     liftA2 f x = (<*>) (fmap f x)      -- | Sequence actions, discarding the value of the first argument.     ---    -- \'@as '*>' bs@\' can be understood as the @do@ expression+    -- ==== __Examples__+    -- If used in conjunction with the Applicative instance for 'Maybe',+    -- you can chain Maybe computations, with a possible "early return"+    -- in case of 'Nothing'.     ---    -- @-    -- do as-    --    bs-    -- @+    -- >>> Just 2 *> Just 3+    -- Just 3     ---    -- This is a tad complicated for our @ApplicativeDo@ extension-    -- which will give it a @Monad@ constraint. For an @Applicative@-    -- constraint we write it of the form+    -- >>> Nothing *> Just 3+    -- Nothing     ---    -- @-    -- do _ <- as-    --    b <- bs-    --    pure b-    -- @+    -- Of course a more interesting use case would be to have effectful+    -- computations instead of just returning pure values.+    --+    -- >>> import Data.Char+    -- >>> import Text.ParserCombinators.ReadP+    -- >>> let p = string "my name is " *> munch1 isAlpha <* eof+    -- >>> readP_to_S p "my name is Simon"+    -- [("Simon","")]+     (*>) :: f a -> f b -> f b     a1 *> a2 = (id <$ a1) <*> a2+     -- This is essentially the same as liftA2 (flip const), but if the     -- Functor instance has an optimized (<$), it may be better to use     -- that instead. Before liftA2 became a method, this definition@@ -664,60 +716,40 @@      -- | Sequence actions, discarding the value of the second argument.     ---    -- Using @ApplicativeDo@: \'@as '<*' bs@\' can be understood as-    -- the @do@ expression-    ---    -- @-    -- do a <- as-    --    bs-    --    pure a-    -- @     (<*) :: f a -> f b -> f a     (<*) = liftA2 const  -- | A variant of '<*>' with the arguments reversed. ----- Using @ApplicativeDo@: \'@as '<**>' fs@\' can be understood as the--- @do@ expression------ @--- do a <- as---    f <- fs---    pure (f a)--- @ (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (\a f -> f a) -- Don't use $ here, see the note at the top of the page  -- | Lift a function to actions.--- This function may be used as a value for `fmap` in a `Functor` instance.+-- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods:+-- `liftA f a = pure f <*> a` ----- | Using @ApplicativeDo@: \'@'liftA' f as@\' can be understood as the--- @do@ expression+-- As such this function may be used to implement a `Functor` instance from an `Applicative` one.+ --+-- ==== __Examples__+-- Using the Applicative instance for Lists: ----- @--- do a <- as---    pure (f a)--- @+-- >>> liftA (+1) [1, 2]+-- [2,3] ----- with an inferred @Functor@ constraint, weaker than @Applicative@.+-- Or the Applicative instance for 'Maybe'+--+-- >>> liftA (+1) (Just 3)+-- Just 4+ liftA :: Applicative f => (a -> b) -> f a -> f b liftA f a = pure f <*> a -- Caution: since this may be used for `fmap`, we can't use the obvious -- definition of liftA = fmap.  -- | Lift a ternary function to actions.------ Using @ApplicativeDo@: \'@'liftA3' f as bs cs@\' can be understood--- as the @do@ expression------ @--- do a <- as---    b <- bs---    c <- cs---    pure (f a b c)--- @+ liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d liftA3 f a b c = liftA2 f a b <*> c @@ -980,6 +1012,15 @@ instance Monad ((->) r) where     f >>= k = \ r -> k (f r) r +-- | @since 4.15+instance Functor Solo where+  fmap f (Solo a) = Solo (f a)++  -- Being strict in the `Solo` argument here seems most consistent+  -- with the concept behind `Solo`: always strict in the wrapper and lazy+  -- in the contents.+  x <$ Solo _ = Solo x+ -- | @since 2.01 instance Functor ((,) a) where     fmap f (x,y) = (x, f y)@@ -1252,8 +1293,7 @@ -- > map f [x1, x2, ...] == [f x1, f x2, ...] -- -- >>> map (+1) [1, 2, 3]---- [2,3,4]-+-- [2,3,4] map :: (a -> b) -> [a] -> [b] {-# NOINLINE [0] map #-}   -- We want the RULEs "map" and "map/coerce" to fire first.@@ -1314,6 +1354,7 @@ --   http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf  {-# RULES "map/coerce" [1] map coerce = coerce #-}+-- See Note [Getting the map/coerce RULE to work] in CoreOpt  ---------------------------------------------- --              append@@ -1371,7 +1412,7 @@ eqString _        _        = False  {-# RULES "eqString" (==) = eqString #-}--- eqString also has a BuiltInRule in PrelRules.hs:+-- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold: --      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2  @@ -1637,7 +1678,13 @@ "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n --- There's a built-in rule (in PrelRules.hs) for+"unpack-utf8"       [~1] forall a   . unpackCStringUtf8# a             = build (unpackFoldrCStringUtf8# a)+"unpack-list-utf8"  [1]  forall a   . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a+"unpack-append-utf8"     forall a n . unpackFoldrCStringUtf8# a (:) n  = unpackAppendCStringUtf8# a n++-- There's a built-in rule (in GHC.Core.Op.ConstantFold) for --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n++-- See also the Note [String literals in GHC] in CString.hs    #-}

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}  ----------------------------------------------------------------------------- -- |@@ -20,6 +21,8 @@ -- Required for WORDS_BIGENDIAN #include <ghcautoconf.h> +import GHC.Generics (Generic)+ -- | Byte ordering. data ByteOrder     = BigEndian    -- ^ most-significant-byte occurs in lowest address.@@ -30,6 +33,7 @@              , Enum    -- ^ @since 4.11.0.0              , Read    -- ^ @since 4.11.0.0              , Show    -- ^ @since 4.11.0.0+             , Generic -- ^ @since 4.15.0.0              )  -- | The byte ordering of the target machine.

@@ -4,7 +4,6 @@            , MagicHash            , UnboxedTuples   #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-}  -----------------------------------------------------------------------------@@ -29,6 +28,7 @@ module GHC.Conc.IO         ( ensureIOManagerIsRunning         , ioManagerCapabilitiesChanged+        , interruptIOManager          -- * Waiting         , threadDelay@@ -61,6 +61,7 @@  #if defined(mingw32_HOST_OS) import qualified GHC.Conc.Windows as Windows+import GHC.IO.SubSystem import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,                          asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,                          toWin32ConsoleEvent)@@ -75,6 +76,17 @@ ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning #endif +-- | Interrupts the current wait of the I/O manager if it is currently blocked.+-- This instructs it to re-read how much it should wait and to process any+-- pending events.+-- @since 4.15+interruptIOManager :: IO ()+#if !defined(mingw32_HOST_OS)+interruptIOManager = return ()+#else+interruptIOManager = Windows.interruptIOManager+#endif+ ioManagerCapabilitiesChanged :: IO () #if !defined(mingw32_HOST_OS) ioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged@@ -179,11 +191,12 @@ threadDelay :: Int -> IO () threadDelay time #if defined(mingw32_HOST_OS)-  | threaded  = Windows.threadDelay time+  | isWindowsNativeIO = Windows.threadDelay time+  | threaded          = Windows.threadDelay time #else-  | threaded  = Event.threadDelay time+  | threaded          = Event.threadDelay time #endif-  | otherwise = IO $ \s ->+  | otherwise         = IO $ \s ->         case time of { I# time# ->         case delay# time# s of { s' -> (# s', () #)         }}@@ -195,10 +208,11 @@ registerDelay :: Int -> IO (TVar Bool) registerDelay usecs #if defined(mingw32_HOST_OS)-  | threaded = Windows.registerDelay usecs+  | isWindowsNativeIO = Windows.registerDelay usecs+  | threaded          = Windows.registerDelay usecs #else-  | threaded = Event.registerDelay usecs+  | threaded          = Event.registerDelay usecs #endif-  | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"+  | otherwise         = errorWithoutStackTrace "registerDelay: requires -threaded"  foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool

@@ -0,0 +1,305 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# OPTIONS_HADDOCK not-home #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Conc.POSIX+-- Copyright   :  (c) The University of Glasgow, 1994-2002+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- Windows I/O manager+--+-- This is the I/O manager based on posix FDs for windows.+-- When using the winio manager these functions may not+-- be used as they will behave in unexpected ways.+--+-- TODO: This manager is currently the default. But we will eventually+-- switch to use winio instead.+--+-----------------------------------------------------------------------------++-- #not-home+module GHC.Conc.POSIX+       ( ensureIOManagerIsRunning+       , interruptIOManager++       -- * Waiting+       , threadDelay+       , registerDelay++       -- * Miscellaneous+       , asyncRead+       , asyncWrite+       , asyncDoProc++       , asyncReadBA+       , asyncWriteBA++       , module GHC.Event.Windows.ConsoleEvent+       ) where+++#include "windows_cconv.h"++import Data.Bits (shiftR)+import GHC.Base+import GHC.Conc.Sync+import GHC.Conc.POSIX.Const+import GHC.Event.Windows.ConsoleEvent+import GHC.IO (unsafePerformIO)+import GHC.IORef+import GHC.MVar+import GHC.Num (Num(..))+import GHC.Ptr+import GHC.Real (div, fromIntegral)+import GHC.Word (Word32, Word64)+import GHC.Windows+import Unsafe.Coerce ( unsafeCoerceUnlifted )++-- ----------------------------------------------------------------------------+-- Thread waiting++-- Note: threadWaitRead and threadWaitWrite aren't really functional+-- on Win32, but left in there because lib code (still) uses them (the manner+-- in which they're used doesn't cause problems on a Win32 platform though.)++asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)+asyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) =+  IO $ \s -> case asyncRead# fd isSock len buf s of+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)++asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)+asyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) =+  IO $ \s -> case asyncWrite# fd isSock len buf s of+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)++asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int+asyncDoProc (FunPtr proc) (Ptr param) =+    -- the 'length' value is ignored; simplifies implementation of+    -- the async*# primops to have them all return the same result.+  IO $ \s -> case asyncDoProc# proc param s  of+               (# s', _len#, err# #) -> (# s', I# err# #)++-- to aid the use of these primops by the IO Handle implementation,+-- provide the following convenience funs:++-- this better be a pinned byte array!+asyncReadBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)+asyncReadBA fd isSock len off bufB =+  asyncRead fd isSock len ((Ptr (byteArrayContents# (unsafeCoerceUnlifted bufB))) `plusPtr` off)++asyncWriteBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)+asyncWriteBA fd isSock len off bufB =+  asyncWrite fd isSock len ((Ptr (byteArrayContents# (unsafeCoerceUnlifted bufB))) `plusPtr` off)++-- ----------------------------------------------------------------------------+-- Threaded RTS implementation of threadDelay++-- | Suspends the current thread for a given number of microseconds+-- (GHC only).+--+-- There is no guarantee that the thread will be rescheduled promptly+-- when the delay has expired, but the thread will never continue to+-- run /earlier/ than specified.+--+threadDelay :: Int -> IO ()+threadDelay time+  | threaded  = waitForDelayEvent time+  | otherwise = IO $ \s ->+        case time of { I# time# ->+        case delay# time# s of { s' -> (# s', () #)+        }}++-- | Set the value of returned TVar to True after a given number of+-- microseconds. The caveats associated with threadDelay also apply.+--+registerDelay :: Int -> IO (TVar Bool)+registerDelay usecs+  | threaded = waitForDelayEventSTM usecs+  | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded"++foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool++waitForDelayEvent :: Int -> IO ()+waitForDelayEvent usecs = do+  m <- newEmptyMVar+  target <- calculateTarget usecs+  _ <- atomicModifyIORef'_ pendingDelays (\xs -> Delay target m : xs)+  prodServiceThread+  takeMVar m++-- Delays for use in STM+waitForDelayEventSTM :: Int -> IO (TVar Bool)+waitForDelayEventSTM usecs = do+   t <- atomically $ newTVar False+   target <- calculateTarget usecs+   _ <- atomicModifyIORef'_ pendingDelays (\xs -> DelaySTM target t : xs)+   prodServiceThread+   return t++calculateTarget :: Int -> IO USecs+calculateTarget usecs = do+    now <- getMonotonicUSec+    return $ now + (fromIntegral usecs)++data DelayReq+  = Delay    {-# UNPACK #-} !USecs {-# UNPACK #-} !(MVar ())+  | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool)++{-# NOINLINE pendingDelays #-}+pendingDelays :: IORef [DelayReq]+pendingDelays = unsafePerformIO $ do+   m <- newIORef []+   sharedCAF m getOrSetGHCConcWindowsPendingDelaysStore++foreign import ccall unsafe "getOrSetGHCConcWindowsPendingDelaysStore"+    getOrSetGHCConcWindowsPendingDelaysStore :: Ptr a -> IO (Ptr a)++{-# NOINLINE ioManagerThread #-}+ioManagerThread :: MVar (Maybe ThreadId)+ioManagerThread = unsafePerformIO $ do+   m <- newMVar Nothing+   sharedCAF m getOrSetGHCConcWindowsIOManagerThreadStore++foreign import ccall unsafe "getOrSetGHCConcWindowsIOManagerThreadStore"+    getOrSetGHCConcWindowsIOManagerThreadStore :: Ptr a -> IO (Ptr a)++ensureIOManagerIsRunning :: IO ()+ensureIOManagerIsRunning+  | threaded  = startIOManagerThread+  | otherwise = return ()++interruptIOManager :: IO ()+interruptIOManager = return ()++startIOManagerThread :: IO ()+startIOManagerThread = do+  modifyMVar_ ioManagerThread $ \old -> do+    let create = do t <- forkIO ioManager;+                    labelThread t "IOManagerThread";+                    return (Just t)+    case old of+      Nothing -> create+      Just t  -> do+        s <- threadStatus t+        case s of+          ThreadFinished -> create+          ThreadDied     -> create+          _other         -> return (Just t)++insertDelay :: DelayReq -> [DelayReq] -> [DelayReq]+insertDelay d [] = [d]+insertDelay d1 ds@(d2 : rest)+  | delayTime d1 <= delayTime d2 = d1 : ds+  | otherwise                    = d2 : insertDelay d1 rest++delayTime :: DelayReq -> USecs+delayTime (Delay t _) = t+delayTime (DelaySTM t _) = t++type USecs = Word64+type NSecs = Word64++foreign import ccall unsafe "getMonotonicNSec"+  getMonotonicNSec :: IO NSecs++getMonotonicUSec :: IO USecs+getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec++{-# NOINLINE prodding #-}+prodding :: IORef Bool+prodding = unsafePerformIO $ do+   r <- newIORef False+   sharedCAF r getOrSetGHCConcWindowsProddingStore++foreign import ccall unsafe "getOrSetGHCConcWindowsProddingStore"+    getOrSetGHCConcWindowsProddingStore :: Ptr a -> IO (Ptr a)++prodServiceThread :: IO ()+prodServiceThread = do+  -- NB. use atomicSwapIORef here, otherwise there are race+  -- conditions in which prodding is left at True but the server is+  -- blocked in select().+  was_set <- atomicSwapIORef prodding True+  when (not was_set) wakeupIOManager++-- ----------------------------------------------------------------------------+-- Windows IO manager thread++ioManager :: IO ()+ioManager = do+  wakeup <- c_getIOManagerEvent+  service_loop wakeup []++service_loop :: HANDLE          -- read end of pipe+             -> [DelayReq]      -- current delay requests+             -> IO ()++service_loop wakeup old_delays = do+  -- pick up new delay requests+  new_delays <- atomicSwapIORef pendingDelays []+  let  delays = foldr insertDelay old_delays new_delays++  now <- getMonotonicUSec+  (delays', timeout) <- getDelay now delays++  r <- c_WaitForSingleObject wakeup timeout+  case r of+    0xffffffff -> do throwGetLastError "service_loop"+    0 -> do+        r2 <- c_readIOManagerEvent+        exit <-+              case r2 of+                _ | r2 == io_MANAGER_WAKEUP -> return False+                _ | r2 == io_MANAGER_DIE    -> return True+                0 -> return False -- spurious wakeup+                _ -> do start_console_handler (r2 `shiftR` 1); return False+        when (not exit) $ service_cont wakeup delays'++    _other -> service_cont wakeup delays' -- probably timeout++service_cont :: HANDLE -> [DelayReq] -> IO ()+service_cont wakeup delays = do+  _ <- atomicSwapIORef prodding False+  service_loop wakeup delays++wakeupIOManager :: IO ()+wakeupIOManager = c_sendIOManagerEvent io_MANAGER_WAKEUP++-- Walk the queue of pending delays, waking up any that have passed+-- and return the smallest delay to wait for.  The queue of pending+-- delays is kept ordered.+getDelay :: USecs -> [DelayReq] -> IO ([DelayReq], DWORD)+getDelay _   [] = return ([], iNFINITE)+getDelay now all@(d : rest)+  = case d of+     Delay time m | now >= time -> do+        putMVar m ()+        getDelay now rest+     DelaySTM time t | now >= time -> do+        atomically $ writeTVar t True+        getDelay now rest+     _otherwise ->+        -- delay is in millisecs for WaitForSingleObject+        let micro_seconds = delayTime d - now+            milli_seconds = (micro_seconds + 999) `div` 1000+        in return (all, fromIntegral milli_seconds)++foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)+  c_getIOManagerEvent :: IO HANDLE++foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c)+  c_readIOManagerEvent :: IO Word32++foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c)+  c_sendIOManagerEvent :: Word32 -> IO ()++foreign import WINDOWS_CCONV "WaitForSingleObject"+   c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD+