base 4.11.1.0 → 4.12.0.0

raw patch · 119 files changed

+3696/−1174 lines, 119 filesdep ~ghc-primdep ~integer-gmpdep ~integer-simplePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-prim, integer-gmp, integer-simple, rts

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +16/−4
• Control/Concurrent.hs +7/−7
• Control/Concurrent/Chan.hs +2/−11
• Control/Concurrent/QSem.hs +1/−1
• Control/Concurrent/QSemN.hs +1/−1
• Control/Exception/Base.hs +7/−4
• Control/Monad.hs +46/−9
• Control/Monad/Fix.hs +14/−2
• Control/Monad/ST/Imp.hs +53/−3
• Control/Monad/Zip.hs +7/−0
• Data/Bits.hs +72/−0
• Data/Complex.hs +14/−2
• Data/Data.hs +21/−7
• Data/Either.hs +5/−2
• Data/Fixed.hs +4/−2
• Data/Foldable.hs +58/−3
• Data/Function.hs +7/−7
• Data/Functor/Classes.hs +19/−0
• Data/Functor/Compose.hs +4/−1
• Data/Functor/Const.hs +20/−3
• Data/Functor/Contravariant.hs +295/−0
• Data/Functor/Identity.hs +20/−3
• Data/Functor/Product.hs +4/−1
• Data/Functor/Sum.hs +4/−1
• Data/Kind.hs +1/−1
• Data/Monoid.hs +93/−11
• Data/Ord.hs +5/−5
• Data/Proxy.hs +3/−3
• Data/Semigroup.hs +67/−10
• Data/Semigroup/Internal.hs +56/−8
• Data/Semigroup/Internal.hs-boot +1/−0
• Data/String.hs +2/−0
• Data/Traversable.hs +45/−2
• Data/Type/Coercion.hs +5/−0
• Data/Type/Equality.hs +7/−2
• Data/Typeable.hs +14/−12
• Data/Typeable/Internal.hs +41/−11
• Data/Version.hs +4/−1
• Foreign/C/Types.hs +5/−1
• Foreign/Marshal/Alloc.hs +29/−23
• GHC/Arr.hs +61/−16
• GHC/Base.hs +51/−21
• GHC/Base.hs-boot +2/−3
• GHC/ByteOrder.hs +8/−1
• GHC/Conc.hs +0/−2
• GHC/Conc/IO.hs +3/−2
• GHC/Conc/Sync.hs +13/−45
• GHC/Conc/Windows.hs +6/−1
• GHC/Enum.hs +115/−4
• GHC/Err.hs +7/−8
• GHC/Event/Control.hs +3/−1
• GHC/Event/EPoll.hsc +6/−1
• GHC/Event/Internal.hs +10/−6
• GHC/Event/KQueue.hsc +20/−5
• GHC/Event/Manager.hs +6/−2
• GHC/Event/PSQ.hs +2/−17
• GHC/Event/Poll.hsc +8/−2
• GHC/Event/TimerManager.hs +23/−9
• GHC/Event/Unique.hs +4/−1
• GHC/Exception.hs +14/−157
• GHC/Exception.hs-boot +7/−9
• GHC/Exception/Type.hs +183/−0
• GHC/Exception/Type.hs-boot +16/−0
• GHC/Exts.hs +3/−1
• GHC/Fingerprint/Type.hs +3/−1
• GHC/Float.hs +62/−3
• GHC/Generics.hs +280/−46
• GHC/IO.hs +4/−2
• GHC/IO.hs-boot +1/−0
• GHC/IO/Buffer.hs +2/−1
• GHC/IO/Device.hs +9/−2
• GHC/IO/Encoding/Failure.hs +2/−1
• GHC/IO/Encoding/Types.hs +3/−1
• GHC/IO/Exception.hs +6/−2
• GHC/IO/FD.hs +35/−20
• GHC/IO/Handle/Lock.hsc +2/−1
• GHC/IO/Handle/Text.hs +1/−0
• GHC/IO/Handle/Types.hs +15/−3
• GHC/IO/IOMode.hs +7/−1
• GHC/IORef.hs +1/−1
• GHC/Int.hs +30/−0
• GHC/List.hs +8/−2
• GHC/MVar.hs +1/−1
• GHC/Maybe.hs +31/−0
• GHC/Natural.hs +332/−402
• GHC/Num.hs +64/−2
• GHC/PArr.hs +0/−37
• GHC/Ptr.hs +4/−1
• GHC/RTS/Flags.hsc +31/−14
• GHC/Read.hs +17/−1
• GHC/Real.hs +150/−4
• GHC/ResponseFile.hs +159/−0
• GHC/ST.hs +2/−13
• GHC/Show.hs +22/−0
• GHC/Stable.hs +1/−1
• GHC/StableName.hs +106/−0
• GHC/Stack/Types.hs +2/−1
• GHC/StaticPtr.hs +1/−1
• GHC/Stats.hsc +19/−4
• GHC/TypeNats.hs +1/−0
• GHC/Unicode.hs +13/−7
• GHC/Weak.hs +3/−2
• GHC/Word.hs +30/−0
• System/Environment/Blank.hsc +12/−15
• System/Environment/ExecutablePath.hsc +2/−1
• System/Mem/StableName.hs +2/−73
• System/Timeout.hs +2/−2
• Text/ParserCombinators/ReadP.hs +1/−1
• Text/Read/Lex.hs +7/−3
• Type/Reflection/Unsafe.hs +1/−1
• Unsafe/Coerce.hs +1/−0
• base.cabal +17/−7
• cbits/CastFloatWord.cmm +69/−0
• cbits/Win32Utils.c +2/−0
• cbits/fs.c +293/−0
• cbits/inputReady.c +80/−11
• changelog.md +44/−0
• include/HsBase.h +17/−4
• include/fs.h +36/−0

@@ -64,7 +64,10 @@ import GHC.Show (Show)  newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }-                         deriving (Generic, Generic1, Monad)+                         deriving ( Generic  -- ^ @since 4.7.0.0+                                  , Generic1 -- ^ @since 4.7.0.0+                                  , Monad    -- ^ @since 4.7.0.0+                                  )  -- | @since 2.01 instance Monad m => Functor (WrappedMonad m) where@@ -82,7 +85,9 @@     WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)  newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }-                           deriving (Generic, Generic1)+                           deriving ( Generic  -- ^ @since 4.7.0.0+                                    , Generic1 -- ^ @since 4.7.0.0+                                    )  -- | @since 2.01 instance Arrow a => Functor (WrappedArrow a b) where@@ -101,8 +106,15 @@  -- | Lists, but with an 'Applicative' functor based on zipping. newtype ZipList a = ZipList { getZipList :: [a] }-                  deriving ( Show, Eq, Ord, Read, Functor-                           , Foldable, Generic, Generic1)+                  deriving ( Show     -- ^ @since 4.7.0.0+                           , Eq       -- ^ @since 4.7.0.0+                           , Ord      -- ^ @since 4.7.0.0+                           , Read     -- ^ @since 4.7.0.0+                           , Functor  -- ^ @since 2.01+                           , Foldable -- ^ @since 4.9.0.0+                           , Generic  -- ^ @since 4.7.0.0+                           , Generic1 -- ^ @since 4.7.0.0+                           ) -- See Data.Traversable for Traversable instance due to import loops  -- |

@@ -407,7 +407,7 @@   -- fdReady does the right thing, but we have to call it in a   -- separate thread, otherwise threadWaitRead won't be interruptible,   -- and this only works with -threaded.-  | threaded  = withThread (waitFd fd 0)+  | threaded  = withThread (waitFd fd False)   | otherwise = case fd of                   0 -> do _ <- hWaitForInput stdin (-1)                           return ()@@ -428,7 +428,7 @@ threadWaitWrite :: Fd -> IO () threadWaitWrite fd #if defined(mingw32_HOST_OS)-  | threaded  = withThread (waitFd fd 1)+  | threaded  = withThread (waitFd fd True)   | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows" #else   = GHC.Conc.threadWaitWrite fd@@ -444,7 +444,7 @@ threadWaitReadSTM fd #if defined(mingw32_HOST_OS)   | threaded = do v <- newTVarIO Nothing-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 0)+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd False)                                              atomically (writeTVar v $ Just result)                   let waitAction = do result <- readTVar v                                       case result of@@ -468,7 +468,7 @@ threadWaitWriteSTM fd #if defined(mingw32_HOST_OS)   | threaded = do v <- newTVarIO Nothing-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 1)+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd True)                                              atomically (writeTVar v $ Just result)                   let waitAction = do result <- readTVar v                                       case result of@@ -494,13 +494,13 @@     Right a -> return a     Left e  -> throwIO (e :: IOException) -waitFd :: Fd -> CInt -> IO ()+waitFd :: Fd -> Bool -> IO () waitFd fd write = do    throwErrnoIfMinus1_ "fdReady" $-        fdReady (fromIntegral fd) write (-1) 0+        fdReady (fromIntegral fd) (if write then 1 else 0) (-1) 0  foreign import ccall safe "fdReady"-  fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt+  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt #endif  -- ---------------------------------------------------------------------------

@@ -50,7 +50,7 @@ data Chan a  = Chan _UPK_(MVar (Stream a))         _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar-   deriving (Eq)+   deriving Eq -- ^ @since 4.4.0.0  type Stream a = MVar (ChItem a) @@ -106,20 +106,11 @@ -- thread holds a reference to the channel. readChan :: Chan a -> IO a readChan (Chan readVar _) = do-  modifyMVarMasked readVar $ \read_end -> do -- Note [modifyMVarMasked]+  modifyMVar readVar $ \read_end -> do     (ChItem val new_read_end) <- readMVar read_end         -- Use readMVar here, not takeMVar,         -- else dupChan doesn't work     return (new_read_end, val)---- Note [modifyMVarMasked]--- This prevents a theoretical deadlock if an asynchronous exception--- happens during the readMVar while the MVar is empty.  In that case--- the read_end MVar will be left empty, and subsequent readers will--- deadlock.  Using modifyMVarMasked prevents this.  The deadlock can--- be reproduced, but only by expanding readMVar and inserting an--- artificial yield between its takeMVar and putMVar operations.-  -- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to -- either channel from then on will be available from both.  Hence this creates

@@ -29,7 +29,7 @@ import Control.Exception import Data.Maybe --- | 'QSem' is a quantity semaphore in which the resource is aqcuired+-- | 'QSem' is a quantity semaphore in which the resource is acquired -- and released in units of one. It provides guaranteed FIFO ordering -- for satisfying blocked `waitQSem` calls. --

@@ -31,7 +31,7 @@ import Control.Exception import Data.Maybe --- | 'QSemN' is a quantity semaphore in which the resource is aqcuired+-- | 'QSemN' is a quantity semaphore in which the resource is acquired -- and released in units of one. It provides guaranteed FIFO ordering -- for satisfying blocked `waitQSemN` calls. --

@@ -93,9 +93,9 @@         finally,          -- * Calls for GHC runtime-        recSelError, recConError, irrefutPatError, runtimeError,+        recSelError, recConError, runtimeError,         nonExhaustiveGuardsError, patError, noMethodBindingError,-        absentError, typeError,+        absentError, absentSumFieldError, typeError,         nonTermination, nestedAtomically,   ) where @@ -375,7 +375,7 @@  ----- -recSelError, recConError, irrefutPatError, runtimeError,+recSelError, recConError, runtimeError,   nonExhaustiveGuardsError, patError, noMethodBindingError,   absentError, typeError         :: Addr# -> a   -- All take a UTF8-encoded C string@@ -386,7 +386,6 @@ absentError              s = errorWithoutStackTrace ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)  nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))-irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern")) recConError              s = throw (RecConError      (untangle s "Missing field in record construction")) noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation")) patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))@@ -399,3 +398,7 @@ -- 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."#

@@ -139,11 +139,12 @@  infixr 1 <=<, >=> --- | Left-to-right Kleisli composition of monads.+-- | Left-to-right composition of Kleisli arrows. (>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) f >=> g     = \x -> f x >>= g --- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped.+-- | Right-to-left composition of Kleisli arrows. @('>=>')@, with the arguments+-- flipped. -- -- Note how this operator resembles function composition @('.')@: --@@ -152,7 +153,30 @@ (<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<)       = flip (>=>) --- | @'forever' act@ repeats the action infinitely.+-- | Repeat an action indefinitely.+--+-- ==== __Examples__+--+-- A common use of 'forever' is to process input from network sockets,+-- 'System.IO.Handle's, and channels+-- (e.g. 'Control.Concurrent.MVar.MVar' and+-- 'Control.Concurrent.Chan.Chan').+--+-- For example, here is how we might implement an [echo+-- server](https://en.wikipedia.org/wiki/Echo_Protocol), using+-- 'forever' both to listen for client connections on a network socket+-- and to echo client input on client connection handles:+--+-- @+-- echoServer :: Socket -> IO ()+-- echoServer socket = 'forever' $ do+--   client <- accept socket+--   'Control.Concurrent.forkFinally' (echo client) (\\_ -> hClose client)+--   where+--     echo :: Handle -> IO ()+--     echo client = 'forever' $+--       hGetLine client >>= hPutStrLn client+-- @ forever     :: (Applicative f) => f a -> f b {-# INLINE forever #-} forever a   = let a' = a *> a' in a'@@ -283,12 +307,25 @@ -- ----------------------------------------------------------------------------- -- Other MonadPlus functions --- | Direct 'MonadPlus' equivalent of 'filter'--- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@--- applicable to any 'MonadPlus', for example--- @mfilter odd (Just 1) == Just 1@--- @mfilter odd (Just 2) == Nothing@-+-- | Direct 'MonadPlus' equivalent of 'Data.List.filter'.+--+-- ==== __Examples__+--+-- The 'Data.List.filter' function is just 'mfilter' specialized to+-- the list monad:+--+-- @+-- 'Data.List.filter' = ( 'mfilter' :: (a -> Bool) -> [a] -> [a] )+-- @+--+-- An example using 'mfilter' with the 'Maybe' monad:+--+-- @+-- >>> mfilter odd (Just 1)+-- Just 1+-- >>> mfilter odd (Just 2)+-- Nothing+-- @ mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a {-# INLINABLE mfilter #-} mfilter p ma = do

@@ -28,11 +28,12 @@ import Data.Function ( fix ) import Data.Maybe import Data.Monoid ( Dual(..), Sum(..), Product(..)-                   , First(..), Last(..), Alt(..) )+                   , First(..), Last(..), Alt(..), Ap(..) )+import Data.Ord ( Down(..) ) import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail )-import GHC.ST+import Control.Monad.ST.Imp import System.IO  -- | Monads having fixed points with a \'knot-tying\' semantics.@@ -126,6 +127,10 @@ instance MonadFix f => MonadFix (Alt f) where     mfix f   = Alt (mfix (getAlt . f)) +-- | @since 4.12.0.0+instance MonadFix f => MonadFix (Ap f) where+    mfix f   = Ap (mfix (getAp . f))+ -- Instances for GHC.Generics -- | @since 4.9.0.0 instance MonadFix Par1 where@@ -145,3 +150,10 @@       where         fstP (a :*: _) = a         sndP (_ :*: b) = b++-- Instances for Data.Ord++-- | @since 4.12.0.0+instance MonadFix Down where+    mfix f = Down (fix (getDown . f))+      where getDown (Down x) = x

@@ -1,3 +1,4 @@+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK hide #-} @@ -34,7 +35,56 @@         unsafeSTToIO     ) where -import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST+import GHC.ST           ( ST, runST, unsafeInterleaveST                         , unsafeDupableInterleaveST )-import GHC.Base         ( RealWorld )-import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO )+import GHC.Base         ( RealWorld, ($), return )+import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO+                        , unsafeDupableInterleaveIO )+import GHC.MVar         ( readMVar, putMVar, newEmptyMVar )+import Control.Exception.Base+                        ( catch, throwIO, NonTermination (..)+                        , BlockedIndefinitelyOnMVar (..) )++-- | Allow the result of a state transformer computation to be used (lazily)+-- inside the computation.+--+-- Note that if @f@ is strict, @'fixST' f = _|_@.+fixST :: (a -> ST s a) -> ST s a+-- See Note [fixST]+fixST k = unsafeIOToST $ do+    m <- newEmptyMVar+    ans <- unsafeDupableInterleaveIO+             (readMVar m `catch` \BlockedIndefinitelyOnMVar ->+                                    throwIO NonTermination)+    result <- unsafeSTToIO (k ans)+    putMVar m result+    return result++{- Note [fixST]+   ~~~~~~~~~~~~++For many years, we implemented fixST much like a pure fixpoint,+using liftST:++  fixST :: (a -> ST s a) -> ST s a+  fixST k = ST $ \ s ->+      let ans       = liftST (k r) s+          STret _ r = ans+      in+      case ans of STret s' x -> (# s', x #)++We knew that lazy blackholing could cause the computation to be re-run if the+result was demanded strictly, but we thought that would be okay in the case of+ST. However, that is not the case (see Trac #15349). Notably, the first time+the computation is executed, it may mutate variables that cause it to behave+*differently* the second time it's run. That may allow it to terminate when it+should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived+example ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html )+demonstrating that it can break reasonable assumptions in "trustworthy" code,+causing a memory safety violation. So now we implement fixST much like we do+fixIO. See also the implementation notes for fixIO. Simon Marlow wondered+whether we could get away with an IORef instead of an MVar. I believe we+cannot. The function passed to fixST may spark a parallel computation that+demands the final result. Such a computation should block until the final+result is available.+-}

@@ -21,6 +21,7 @@ import Control.Monad (liftM, liftM2) import Data.Functor.Identity import Data.Monoid+import Data.Ord ( Down(..) ) import Data.Proxy import qualified Data.List.NonEmpty as NE import GHC.Generics@@ -124,3 +125,9 @@ -- | @since 4.9.0.0 instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where     mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2++-- instances for Data.Ord++-- | @since 4.12.0.0+instance MonadZip Down where+    mzipWith = liftM2

@@ -190,8 +190,12 @@     {-| Return the number of bits in the type of the argument.  The actual         value of the argument is ignored.  The function 'bitSize' is         undefined for types that do not have a fixed bitsize, like 'Integer'.++        Default implementation based upon 'bitSizeMaybe' provided since+        4.12.0.0.         -}     bitSize           :: a -> Int+    bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b)      {-| Return 'True' if the argument is a signed type.  The actual         value of the argument is ignored -}@@ -535,6 +539,74 @@    bitSizeMaybe _ = Nothing    bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"    isSigned _ = True++#if defined(MIN_VERSION_integer_gmp)+-- | @since 4.8.0+instance Bits Natural where+   (.&.) = andNatural+   (.|.) = orNatural+   xor = xorNatural+   complement _ = errorWithoutStackTrace+                    "Bits.complement: Natural complement undefined"+   shift x i+     | i >= 0    = shiftLNatural x i+     | otherwise = shiftRNatural x (negate i)+   testBit x i   = testBitNatural x i+   zeroBits      = wordToNaturalBase 0##+   clearBit x i  = x `xor` (bit i .&. x)++   bit (I# i#) = bitNatural i#+   popCount x  = popCountNatural x++   rotate x i = shift x i   -- since an Natural never wraps around++   bitSizeMaybe _ = Nothing+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"+   isSigned _ = False+#else+-- | @since 4.8.0.0+instance Bits Natural where+  Natural n .&. Natural m = Natural (n .&. m)+  {-# INLINE (.&.) #-}+  Natural n .|. Natural m = Natural (n .|. m)+  {-# INLINE (.|.) #-}+  xor (Natural n) (Natural m) = Natural (xor n m)+  {-# INLINE xor #-}+  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"+  {-# INLINE complement #-}+  shift (Natural n) = Natural . shift n+  {-# INLINE shift #-}+  rotate (Natural n) = Natural . rotate n+  {-# INLINE rotate #-}+  bit = Natural . bit+  {-# INLINE bit #-}+  setBit (Natural n) = Natural . setBit n+  {-# INLINE setBit #-}+  clearBit (Natural n) = Natural . clearBit n+  {-# INLINE clearBit #-}+  complementBit (Natural n) = Natural . complementBit n+  {-# INLINE complementBit #-}+  testBit (Natural n) = testBit n+  {-# INLINE testBit #-}+  bitSizeMaybe _ = Nothing+  {-# INLINE bitSizeMaybe #-}+  bitSize = errorWithoutStackTrace "Natural: bitSize"+  {-# INLINE bitSize #-}+  isSigned _ = False+  {-# INLINE isSigned #-}+  shiftL (Natural n) = Natural . shiftL n+  {-# INLINE shiftL #-}+  shiftR (Natural n) = Natural . shiftR n+  {-# INLINE shiftR #-}+  rotateL (Natural n) = Natural . rotateL n+  {-# INLINE rotateL #-}+  rotateR (Natural n) = Natural . rotateR n+  {-# INLINE rotateR #-}+  popCount (Natural n) = popCount n+  {-# INLINE popCount #-}+  zeroBits = Natural 0++#endif  ----------------------------------------------------------------------------- 

@@ -55,11 +55,23 @@ -- has the phase of @z@, but unit magnitude. -- -- The 'Foldable' and 'Traversable' instances traverse the real part first.+--+-- Note that `Complex`'s instances inherit the deficiencies from the type+-- parameter's. For example, @Complex Float@'s 'Ord' instance has similar+-- problems to `Float`'s. data Complex a   = !a :+ !a    -- ^ forms a complex number from its real and imaginary                 -- rectangular components.-        deriving (Eq, Show, Read, Data, Generic, Generic1-                , Functor, Foldable, Traversable)+        deriving ( Eq          -- ^ @since 2.01+                 , Show        -- ^ @since 2.01+                 , Read        -- ^ @since 2.01+                 , Data        -- ^ @since 2.01+                 , Generic     -- ^ @since 4.9.0.0+                 , Generic1    -- ^ @since 4.9.0.0+                 , Functor     -- ^ @since 4.9.0.0+                 , Foldable    -- ^ @since 4.9.0.0+                 , Traversable -- ^ @since 4.9.0.0+                 )  -- ----------------------------------------------------------------------------- -- Functions over Complex

@@ -4,12 +4,12 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-}  -----------------------------------------------------------------------------@@ -126,7 +126,6 @@ import GHC.Base hiding (Any, IntRep, FloatRep) import GHC.List import GHC.Num-import GHC.Natural import GHC.Read import GHC.Show import Text.Read( reads )@@ -511,7 +510,7 @@                         , datarep :: DataRep                         } -              deriving Show+              deriving Show -- ^ @since 4.0.0.0  -- | Representation of constructors. Note that equality on constructors -- with different types may not work -- i.e. the constructors for 'False' and@@ -543,7 +542,9 @@              | CharRep              | NoRep -            deriving (Eq,Show)+            deriving ( Eq   -- ^ @since 4.0.0.0+                     , Show -- ^ @since 4.0.0.0+                     ) -- The list of constructors could be an array, a balanced tree, or others.  @@ -553,7 +554,9 @@                | FloatConstr  Rational                | CharConstr   Char -               deriving (Eq,Show)+               deriving ( Eq   -- ^ @since 4.0.0.0+                        , Show -- ^ @since 4.0.0.0+                        )   -- | Unique index for datatype constructors,@@ -565,7 +568,9 @@ data Fixity = Prefix             | Infix     -- Later: add associativity and precedence -            deriving (Eq,Show)+            deriving ( Eq   -- ^ @since 4.0.0.0+                     , Show -- ^ @since 4.0.0.0+                     )   ------------------------------------------------------------------------------@@ -1277,6 +1282,9 @@ -- | @since 4.8.0.0 deriving instance (Data (f a), Data a, Typeable f) => Data (Alt f a) +-- | @since 4.12.0.0+deriving instance (Data (f a), Data a, Typeable f) => Data (Ap f a)+ ---------------------------------------------------------------------------- -- Data instances for GHC.Generics representations @@ -1301,7 +1309,7 @@     => Data ((f :+: g) p)  -- | @since 4.9.0.0-deriving instance (Typeable (f :: * -> *), Typeable (g :: * -> *),+deriving instance (Typeable (f :: Type -> Type), Typeable (g :: Type -> Type),           Data p, Data (f (g p)))     => Data ((f :.: g) p) @@ -1326,3 +1334,9 @@  -- | @since 4.9.0.0 deriving instance Data DecidedStrictness++----------------------------------------------------------------------------+-- Data instances for Data.Ord++-- | @since 4.12.0.0+deriving instance Data a => Data (Down a)

@@ -123,7 +123,11 @@  -} data  Either a b  =  Left a | Right b-  deriving (Eq, Ord, Read, Show)+  deriving ( Eq   -- ^ @since 2.01+           , Ord  -- ^ @since 2.01+           , Read -- ^ @since 3.0+           , Show -- ^ @since 3.0+           )  -- | @since 3.0 instance Functor (Either a) where@@ -336,4 +340,3 @@ prop_partitionEithers x =   partitionEithers x == (lefts x, rights x) -}-

@@ -57,8 +57,10 @@     f = div' n d  -- | The type parameter should be an instance of 'HasResolution'.-newtype Fixed a = MkFixed Integer -- ^ @since 4.7.0.0-        deriving (Eq,Ord)+newtype Fixed a = MkFixed Integer+        deriving ( Eq  -- ^ @since 2.01+                 , Ord -- ^ @since 2.01+                 )  -- We do this because the automatically derived Data instance requires (Data a) context. -- Our manual instance has the more general (Typeable a) context.

@@ -299,11 +299,27 @@ -- | @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+  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-  length (_ :| as) = 1 + List.length as   toList ~(a :| as) = a : as  -- | @since 4.7.0.0@@ -420,6 +436,14 @@ 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@@ -439,20 +463,51 @@     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.

@@ -50,18 +50,21 @@ fix :: (a -> a) -> a fix f = let x = f x in x --- | @((==) \`on\` f) x y = f x == f y@+-- | @'on' b u x y@ runs the binary function `b` /on/ the results of applying unary function `u` to two arguments `x` and `y`. From the opposite perspective, it transforms two inputs and combines the outputs. --+-- @((+) \``on`\` f) x y = f x + f y@+-- -- Typical usage: @'Data.List.sortBy' ('compare' \`on\` 'fst')@.-+-- -- Algebraic properties: ----- * @(*) \`on\` 'id' = (*)@ (if @(*) ∉ {⊥, 'const' ⊥}@)+-- * @(*) \`on\` 'id' = (*) -- (if (*) ∉ {⊥, 'const' ⊥})@ -- -- * @((*) \`on\` f) \`on\` g = (*) \`on\` (f . g)@ -- -- * @'flip' on f . 'flip' on g = 'flip' on (g . f)@-+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c+(.*.) `on` f = \x y -> f x .*. f y -- Proofs (so that I don't have to edit the test-suite):  --   (*) `on` id@@ -101,9 +104,6 @@ --   (\h (*) -> (*) `on` h) (g . f) -- = --   flip on (g . f)--on :: (b -> b -> c) -> (a -> b) -> a -> a -> c-(.*.) `on` f = \x y -> f x .*. f y   -- | '&' is a reverse application operator.  This provides notational

@@ -70,6 +70,7 @@ import Data.Proxy (Proxy(Proxy)) import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid (mappend)+import Data.Ord (Down(Down))  import GHC.Read (expectP, list, paren) @@ -643,6 +644,24 @@    liftReadListPrec = liftReadListPrecDefault   liftReadList     = liftReadListDefault++-- | @since 4.12.0.0+instance Eq1 Down where+    liftEq eq (Down x) (Down y) = eq x y++-- | @since 4.12.0.0+instance Ord1 Down where+    liftCompare comp (Down x) (Down y) = comp x y++-- | @since 4.12.0.0+instance Read1 Down where+    liftReadsPrec rp _ = readsData $+         readsUnaryWith rp "Down" Down++-- | @since 4.12.0.0+instance Show1 Down where+    liftShowsPrec sp _ d (Down x) = showsUnaryWith sp "Down" d x+  -- Building blocks 

@@ -38,7 +38,10 @@ -- The composition of applicative functors is always applicative, -- but the composition of monads is not always a monad. newtype Compose f g a = Compose { getCompose :: f (g a) }-  deriving (Data, Generic, Generic1)+  deriving ( Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- Instances of lifted Prelude classes 

@@ -37,9 +37,26 @@  -- | The 'Const' functor. newtype Const a b = Const { getConst :: a }-    deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional-             , Generic, Generic1, Integral, Ix, Semigroup, Monoid, Num, Ord-             , Real, RealFrac, RealFloat, Storable)+    deriving ( Bits       -- ^ @since 4.9.0.0+             , Bounded    -- ^ @since 4.9.0.0+             , Enum       -- ^ @since 4.9.0.0+             , Eq         -- ^ @since 4.9.0.0+             , FiniteBits -- ^ @since 4.9.0.0+             , Floating   -- ^ @since 4.9.0.0+             , Fractional -- ^ @since 4.9.0.0+             , Generic    -- ^ @since 4.9.0.0+             , Generic1   -- ^ @since 4.9.0.0+             , Integral   -- ^ @since 4.9.0.0+             , Ix         -- ^ @since 4.9.0.0+             , Semigroup  -- ^ @since 4.9.0.0+             , Monoid     -- ^ @since 4.9.0.0+             , Num        -- ^ @since 4.9.0.0+             , Ord        -- ^ @since 4.9.0.0+             , Real       -- ^ @since 4.9.0.0+             , RealFrac   -- ^ @since 4.9.0.0+             , RealFloat  -- ^ @since 4.9.0.0+             , Storable   -- ^ @since 4.9.0.0+             )  -- | This instance would be equivalent to the derived instances of the -- 'Const' newtype if the 'runConst' field were removed

@@ -0,0 +1,295 @@+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Contravariant+-- Copyright   :  (C) 2007-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- 'Contravariant' functors, sometimes referred to colloquially as @Cofunctor@,+-- even though the dual of a 'Functor' is just a 'Functor'. As with 'Functor'+-- the definition of 'Contravariant' for a given ADT is unambiguous.+--+-- @since 4.12.0.0+----------------------------------------------------------------------------++module Data.Functor.Contravariant (+  -- * Contravariant Functors+    Contravariant(..)+  , phantom++  -- * Operators+  , (>$<), (>$$<), ($<)++  -- * Predicates+  , Predicate(..)++  -- * Comparisons+  , Comparison(..)+  , defaultComparison++  -- * Equivalence Relations+  , Equivalence(..)+  , defaultEquivalence+  , comparisonEquivalence++  -- * Dual arrows+  , Op(..)+  ) where++import Control.Applicative+import Control.Category+import Data.Function (on)++import Data.Functor.Product+import Data.Functor.Sum+import Data.Functor.Compose++import Data.Monoid (Alt(..))+import Data.Semigroup (Semigroup(..))+import Data.Proxy+import GHC.Generics++import Prelude hiding ((.),id)++-- | The class of contravariant functors.+--+-- Whereas in Haskell, one can think of a 'Functor' as containing or producing+-- values, a contravariant functor is a functor that can be thought of as+-- /consuming/ values.+--+-- As an example, consider the type of predicate functions  @a -> Bool@. One+-- such predicate might be @negative x = x < 0@, which+-- classifies integers as to whether they are negative. However, given this+-- predicate, we can re-use it in other situations, providing we have a way to+-- map values /to/ integers. For instance, we can use the @negative@ predicate+-- on a person's bank balance to work out if they are currently overdrawn:+--+-- @+-- newtype Predicate a = Predicate { getPredicate :: a -> Bool }+--+-- instance Contravariant Predicate where+--   contramap f (Predicate p) = Predicate (p . f)+--                                          |   `- First, map the input...+--                                          `----- then apply the predicate.+--+-- overdrawn :: Predicate Person+-- overdrawn = contramap personBankBalance negative+-- @+--+-- Any instance should be subject to the following laws:+--+-- > contramap id = id+-- > contramap f . contramap g = contramap (g . f)+--+-- Note, that the second law follows from the free theorem of the type of+-- 'contramap' and the first law, so you need only check that the former+-- condition holds.++class Contravariant f where+  contramap :: (a -> b) -> f b -> f a++  -- | Replace all locations in the output with the same value.+  -- The default definition is @'contramap' . 'const'@, but this may be+  -- overridden with a more efficient version.+  (>$) :: b -> f b -> f a+  (>$) = contramap . const++-- | If 'f' is both 'Functor' and 'Contravariant' then by the time you factor+-- in the laws of each of those classes, it can't actually use its argument in+-- any meaningful capacity.+--+-- This method is surprisingly useful. Where both instances exist and are+-- lawful we have the following laws:+--+-- @+-- 'fmap' f ≡ 'phantom'+-- 'contramap' f ≡ 'phantom'+-- @+phantom :: (Functor f, Contravariant f) => f a -> f b+phantom x = () <$ x $< ()++infixl 4 >$, $<, >$<, >$$<++-- | This is '>$' with its arguments flipped.+($<) :: Contravariant f => f b -> b -> f a+($<) = flip (>$)++-- | This is an infix alias for 'contramap'.+(>$<) :: 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)++instance Contravariant V1 where+  contramap _ x = case x of++instance Contravariant U1 where+  contramap _ _ = U1++instance Contravariant (K1 i c) where+  contramap _ (K1 c) = K1 c++instance (Contravariant f, Contravariant g) => Contravariant (f :*: g) where+  contramap f (xs :*: ys) = contramap f xs :*: contramap f ys++instance (Functor f, Contravariant g) => Contravariant (f :.: g) where+  contramap f (Comp1 fg) = Comp1 (fmap (contramap f) fg)++instance (Contravariant f, Contravariant g) => Contravariant (f :+: g) where+  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 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)++instance Contravariant (Const a) where+  contramap _ (Const a) = Const a++instance (Functor f, Contravariant g) => Contravariant (Compose f g) where+  contramap f (Compose fga) = Compose (fmap (contramap f) fga)++instance Contravariant Proxy where+  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++instance Monoid (Predicate a) where+  mempty = Predicate $ const True++-- | 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)++-- | 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++-- | Compare using 'compare'.+defaultComparison :: Ord a => Comparison a+defaultComparison = Comparison compare++-- | This data type represents an equivalence relation.+--+-- Equivalence relations are expected to satisfy three laws:+--+-- __Reflexivity__:+--+-- @+-- 'getEquivalence' f a a = True+-- @+--+-- __Symmetry__:+--+-- @+-- 'getEquivalence' f a b = 'getEquivalence' f b a+-- @+--+-- __Transitivity__:+--+-- If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'+-- then so is @'getEquivalence' f a c@.+--+-- The types alone do not enforce these laws, so you'll have to check them+-- yourself.+newtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool }++-- | 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)++-- | Check for equivalence with '=='.+--+-- Note: The instances for 'Double' and 'Float' violate reflexivity for @NaN@.+defaultEquivalence :: Eq a => Equivalence a+defaultEquivalence = Equivalence (==)++comparisonEquivalence :: Comparison a -> Equivalence a+comparisonEquivalence (Comparison p) = Equivalence $ \a b -> p a b == EQ++-- | 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)++instance Category Op where+  id = Op id+  Op f . Op g = Op (g . f)++instance Contravariant (Op a) where+  contramap f g = Op (getOp g . f)++instance Num a => Num (Op a b) where+  Op f + Op g = Op $ \a -> f a + g a+  Op f * Op g = Op $ \a -> f a * g a+  Op f - Op g = Op $ \a -> f a - g a+  abs (Op f) = Op $ abs . f+  signum (Op f) = Op $ signum . f+  fromInteger = Op . const . fromInteger++instance Fractional a => Fractional (Op a b) where+  Op f / Op g = Op $ \a -> f a / g a+  recip (Op f) = Op $ recip . f+  fromRational = Op . const . fromRational++instance Floating a => Floating (Op a b) where+  pi = Op $ const pi+  exp (Op f) = Op $ exp . f+  sqrt (Op f) = Op $ sqrt . f+  log (Op f) = Op $ log . f+  sin (Op f) = Op $ sin . f+  tan (Op f) = Op $ tan . f+  cos (Op f) = Op $ cos . f+  asin (Op f) = Op $ asin . f+  atan (Op f) = Op $ atan . f+  acos (Op f) = Op $ acos . f+  sinh (Op f) = Op $ sinh . f+  tanh (Op f) = Op $ tanh . f+  cosh (Op f) = Op $ cosh . f+  asinh (Op f) = Op $ asinh . f+  atanh (Op f) = Op $ atanh . f+  acosh (Op f) = Op $ acosh . f+  Op f ** Op g = Op $ \a -> f a ** g a+  logBase (Op f) (Op g) = Op $ \a -> logBase (f a) (g a)

@@ -57,9 +57,26 @@ -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a }-    deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional-             , Generic, Generic1, Integral, Ix, Semigroup, Monoid, Num, Ord-             , Real, RealFrac, RealFloat, Storable)+    deriving ( Bits       -- ^ @since 4.9.0.0+             , Bounded    -- ^ @since 4.9.0.0+             , Enum       -- ^ @since 4.9.0.0+             , Eq         -- ^ @since 4.8.0.0+             , FiniteBits -- ^ @since 4.9.0.0+             , Floating   -- ^ @since 4.9.0.0+             , Fractional -- ^ @since 4.9.0.0+             , Generic    -- ^ @since 4.8.0.0+             , Generic1   -- ^ @since 4.8.0.0+             , Integral   -- ^ @since 4.9.0.0+             , Ix         -- ^ @since 4.9.0.0+             , Semigroup  -- ^ @since 4.9.0.0+             , Monoid     -- ^ @since 4.9.0.0+             , Num        -- ^ @since 4.9.0.0+             , Ord        -- ^ @since 4.8.0.0+             , Real       -- ^ @since 4.9.0.0+             , RealFrac   -- ^ @since 4.9.0.0+             , RealFloat  -- ^ @since 4.9.0.0+             , Storable   -- ^ @since 4.9.0.0+             )  -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed

@@ -35,7 +35,10 @@  -- | Lifted product of functors. data Product f g a = Pair (f a) (g a)-  deriving (Data, Generic, Generic1)+  deriving ( Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where

@@ -31,7 +31,10 @@  -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a)-  deriving (Data, Generic, Generic1)+  deriving ( Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where

@@ -14,6 +14,6 @@ -- @since 4.9.0.0 ----------------------------------------------------------------------------- -module Data.Kind ( Type, Constraint, type (*), type (★) ) where+module Data.Kind ( Type, Constraint ) where  import GHC.Types

@@ -1,9 +1,9 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE Trustworthy                #-}  ----------------------------------------------------------------------------- -- |@@ -38,15 +38,21 @@         First(..),         Last(..),         -- * 'Alternative' wrapper-        Alt (..)+        Alt(..),+        -- * 'Applicative' wrapper+        Ap(..)   ) where  -- Push down the module in the dependency hierarchy. import GHC.Base hiding (Any)+import GHC.Enum+import GHC.Generics+import GHC.Num import GHC.Read import GHC.Show-import GHC.Generics +import Control.Monad.Fail (MonadFail)+ import Data.Semigroup.Internal  -- $MaybeExamples@@ -88,9 +94,27 @@ -- -- >>> 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, Ord, Read, Show, Generic, Generic1,-                  Functor, Applicative, Monad)+        deriving ( Eq          -- ^ @since 2.01+                 , Ord         -- ^ @since 2.01+                 , Read        -- ^ @since 2.01+                 , Show        -- ^ @since 2.01+                 , Generic     -- ^ @since 4.7.0.0+                 , Generic1    -- ^ @since 4.7.0.0+                 , Functor     -- ^ @since 4.8.0.0+                 , Applicative -- ^ @since 4.8.0.0+                 , Monad       -- ^ @since 4.8.0.0+                 )  -- | @since 4.9.0.0 instance Semigroup (First a) where@@ -109,9 +133,27 @@ -- -- >>> 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, Ord, Read, Show, Generic, Generic1,-                  Functor, Applicative, Monad)+        deriving ( Eq          -- ^ @since 2.01+                 , Ord         -- ^ @since 2.01+                 , Read        -- ^ @since 2.01+                 , Show        -- ^ @since 2.01+                 , Generic     -- ^ @since 4.7.0.0+                 , Generic1    -- ^ @since 4.7.0.0+                 , Functor     -- ^ @since 4.8.0.0+                 , Applicative -- ^ @since 4.8.0.0+                 , Monad       -- ^ @since 4.8.0.0+                 )  -- | @since 4.9.0.0 instance Semigroup (Last a) where@@ -123,7 +165,47 @@ instance Monoid (Last a) where         mempty = Last Nothing +-- | This data type witnesses the lifting of a 'Monoid' into an+-- 'Applicative' pointwise.+--+-- @since 4.12.0.0+newtype Ap f a = Ap { getAp :: f a }+        deriving ( Alternative -- ^ @since 4.12.0.0+                 , Applicative -- ^ @since 4.12.0.0+                 , Enum        -- ^ @since 4.12.0.0+                 , Eq          -- ^ @since 4.12.0.0+                 , Functor     -- ^ @since 4.12.0.0+                 , Generic     -- ^ @since 4.12.0.0+                 , Generic1    -- ^ @since 4.12.0.0+                 , Monad       -- ^ @since 4.12.0.0+                 , MonadFail   -- ^ @since 4.12.0.0+                 , MonadPlus   -- ^ @since 4.12.0.0+                 , Ord         -- ^ @since 4.12.0.0+                 , Read        -- ^ @since 4.12.0.0+                 , Show        -- ^ @since 4.12.0.0+                 ) +-- | @since 4.12.0.0+instance (Applicative f, Semigroup a) => Semigroup (Ap f a) where+        (Ap x) <> (Ap y) = Ap $ liftA2 (<>) x y++-- | @since 4.12.0.0+instance (Applicative f, Monoid a) => Monoid (Ap f a) where+        mempty = Ap $ pure mempty++-- | @since 4.12.0.0+instance (Applicative f, Bounded a) => Bounded (Ap f a) where+  minBound = pure minBound+  maxBound = pure maxBound++-- | @since 4.12.0.0+instance (Applicative f, Num a) => Num (Ap f a) where+  (+)         = liftA2 (+)+  (*)         = liftA2 (*)+  negate      = fmap negate+  fromInteger = pure . fromInteger+  abs         = fmap abs+  signum      = fmap signum  {- {--------------------------------------------------------------------

@@ -48,12 +48,12 @@ -- @since 4.6.0.0 newtype Down a = Down a     deriving-      ( Eq-      , Show -- ^ @since 4.7.0.0-      , Read -- ^ @since 4.7.0.0-      , Num -- ^ @since 4.11.0.0+      ( Eq        -- ^ @since 4.6.0.0+      , Show      -- ^ @since 4.7.0.0+      , Read      -- ^ @since 4.7.0.0+      , Num       -- ^ @since 4.11.0.0       , Semigroup -- ^ @since 4.11.0.0-      , Monoid -- ^ @since 4.11.0.0+      , Monoid    -- ^ @since 4.11.0.0       )  -- | @since 4.6.0.0

@@ -53,13 +53,13 @@ -- -- >>> Proxy :: Proxy complicatedStructure -- Proxy-data Proxy t = Proxy deriving ( Bounded-                              , Read -- ^ @since 4.7.0.0+data Proxy t = Proxy deriving ( Bounded -- ^ @since 4.7.0.0+                              , Read    -- ^ @since 4.7.0.0                               )  -- | A concrete, promotable proxy type, for use at the kind level -- There are no instances for this because it is intended at the kind level only-data KProxy (t :: *) = KProxy+data KProxy (t :: Type) = KProxy  -- It's common to use (undefined :: Proxy t) and (Proxy :: Proxy t) -- interchangeably, so all of these instances are hand-written to be

@@ -95,7 +95,15 @@ diff = Endo . (<>)  newtype Min a = Min { getMin :: a }-  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)+  deriving ( Bounded  -- ^ @since 4.9.0.0+           , Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Enum a => Enum (Min a) where@@ -158,7 +166,15 @@   fromInteger    = Min . fromInteger  newtype Max a = Max { getMax :: a }-  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)+  deriving ( Bounded  -- ^ @since 4.9.0.0+           , Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Enum a => Enum (Max a) where@@ -222,7 +238,12 @@ -- | '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-  (Show, Read, Data, Generic, Generic1)+  ( Show     -- ^ @since 4.9.0.0+  , Read     -- ^ @since 4.9.0.0+  , Data     -- ^ @since 4.9.0.0+  , Generic  -- ^ @since 4.9.0.0+  , Generic1 -- ^ @since 4.9.0.0+  )  type ArgMin a b = Min (Arg a b) type ArgMax a b = Max (Arg a b)@@ -267,8 +288,16 @@  -- | Use @'Option' ('First' a)@ to get the behavior of -- 'Data.Monoid.First' from "Data.Monoid".-newtype First a = First { getFirst :: a } deriving-  (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)+newtype First a = First { getFirst :: a }+  deriving ( Bounded  -- ^ @since 4.9.0.0+           , Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Enum a => Enum (First a) where@@ -317,8 +346,16 @@  -- | Use @'Option' ('Last' a)@ to get the behavior of -- 'Data.Monoid.Last' from "Data.Monoid"-newtype Last a = Last { getLast :: a } deriving-  (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)+newtype Last a = Last { getLast :: a }+  deriving ( Bounded  -- ^ @since 4.9.0.0+           , Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Enum a => Enum (Last a) where@@ -371,7 +408,15 @@ -- __NOTE__: This is not needed anymore since 'Semigroup' became a superclass of -- 'Monoid' in /base-4.11/ and this newtype be deprecated at some point in the future. newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }-  deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)+  deriving ( Bounded  -- ^ @since 4.9.0.0+           , Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Monoid m => Semigroup (WrappedMonoid m) where@@ -410,9 +455,21 @@ -- underlying 'Monoid'. -- -- Ideally, this type would not exist at all and we would just fix the--- 'Monoid' instance of 'Maybe'+-- 'Monoid' instance of 'Maybe'.+--+-- 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. newtype Option a = Option { getOption :: Maybe a }-  deriving (Eq, Ord, Show, Read, Data, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Read     -- ^ @since 4.9.0.0+           , Data     -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Functor Option where

@@ -108,7 +108,14 @@ -- >>> getDual (mappend (Dual "Hello") (Dual "World")) -- "WorldHello" newtype Dual a = Dual { getDual :: a }-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)+        deriving ( Eq       -- ^ @since 2.01+                 , Ord      -- ^ @since 2.01+                 , Read     -- ^ @since 2.01+                 , Show     -- ^ @since 2.01+                 , Bounded  -- ^ @since 2.01+                 , Generic  -- ^ @since 4.7.0.0+                 , Generic1 -- ^ @since 4.7.0.0+                 )  -- | @since 4.9.0.0 instance Semigroup a => Semigroup (Dual a) where@@ -138,7 +145,8 @@ -- >>> appEndo computation "Haskell" -- "Hello, Haskell!" newtype Endo a = Endo { appEndo :: a -> a }-               deriving (Generic)+               deriving ( Generic -- ^ @since 4.7.0.0+                        )  -- | @since 4.9.0.0 instance Semigroup (Endo a) where@@ -157,7 +165,13 @@ -- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8])) -- False newtype All = All { getAll :: Bool }-        deriving (Eq, Ord, Read, Show, Bounded, Generic)+        deriving ( Eq      -- ^ @since 2.01+                 , Ord     -- ^ @since 2.01+                 , Read    -- ^ @since 2.01+                 , Show    -- ^ @since 2.01+                 , Bounded -- ^ @since 2.01+                 , Generic -- ^ @since 4.7.0.0+                 )  -- | @since 4.9.0.0 instance Semigroup All where@@ -176,7 +190,13 @@ -- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8])) -- True newtype Any = Any { getAny :: Bool }-        deriving (Eq, Ord, Read, Show, Bounded, Generic)+        deriving ( Eq      -- ^ @since 2.01+                 , Ord     -- ^ @since 2.01+                 , Read    -- ^ @since 2.01+                 , Show    -- ^ @since 2.01+                 , Bounded -- ^ @since 2.01+                 , Generic -- ^ @since 4.7.0.0+                 )  -- | @since 4.9.0.0 instance Semigroup Any where@@ -192,7 +212,15 @@ -- >>> getSum (Sum 1 <> Sum 2 <> mempty) -- 3 newtype Sum a = Sum { getSum :: a }-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)+        deriving ( Eq       -- ^ @since 2.01+                 , Ord      -- ^ @since 2.01+                 , Read     -- ^ @since 2.01+                 , Show     -- ^ @since 2.01+                 , Bounded  -- ^ @since 2.01+                 , Generic  -- ^ @since 4.7.0.0+                 , Generic1 -- ^ @since 4.7.0.0+                 , Num      -- ^ @since 4.7.0.0+                 )  -- | @since 4.9.0.0 instance Num a => Semigroup (Sum a) where@@ -221,7 +249,15 @@ -- >>> getProduct (Product 3 <> Product 4 <> mempty) -- 12 newtype Product a = Product { getProduct :: a }-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)+        deriving ( Eq       -- ^ @since 2.01+                 , Ord      -- ^ @since 2.01+                 , Read     -- ^ @since 2.01+                 , Show     -- ^ @since 2.01+                 , Bounded  -- ^ @since 2.01+                 , Generic  -- ^ @since 4.7.0.0+                 , Generic1 -- ^ @since 4.7.0.0+                 , Num      -- ^ @since 4.7.0.0+                 )  -- | @since 4.9.0.0 instance Num a => Semigroup (Product a) where@@ -251,8 +287,20 @@ -- -- @since 4.8.0.0 newtype Alt f a = Alt {getAlt :: f a}-  deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,-            Monad, MonadPlus, Applicative, Alternative, Functor)+  deriving ( Generic     -- ^ @since 4.8.0.0+           , Generic1    -- ^ @since 4.8.0.0+           , Read        -- ^ @since 4.8.0.0+           , Show        -- ^ @since 4.8.0.0+           , Eq          -- ^ @since 4.8.0.0+           , Ord         -- ^ @since 4.8.0.0+           , Num         -- ^ @since 4.8.0.0+           , Enum        -- ^ @since 4.8.0.0+           , Monad       -- ^ @since 4.8.0.0+           , MonadPlus   -- ^ @since 4.8.0.0+           , Applicative -- ^ @since 4.8.0.0+           , Alternative -- ^ @since 4.8.0.0+           , Functor     -- ^ @since 4.8.0.0+           )  -- | @since 4.9.0.0 instance Alternative f => Semigroup (Alt f a) where

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

@@ -88,4 +88,6 @@  -- | @since 4.9.0.0 deriving instance IsString a => IsString (Const a b)++-- | @since 4.9.0.0 deriving instance IsString a => IsString (Identity a)

@@ -60,7 +60,9 @@ import Data.Functor import Data.Functor.Identity ( Identity(..) ) import Data.Functor.Utils ( StateL(..), StateR(..) )-import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) )+import Data.Monoid ( Dual(..), Sum(..), Product(..),+                     First(..), Last(..), Alt(..), Ap(..) )+import Data.Ord ( Down(..) ) import Data.Proxy ( Proxy(..) )  import GHC.Arr@@ -163,7 +165,7 @@     traverse f = sequenceA . fmap f      -- | Evaluate each action in the structure from left to right, and-    -- and collect the results. For a version that ignores the results+    -- collect the results. For a version that ignores the results     -- see 'Data.Foldable.sequenceA_'.     sequenceA :: Applicative f => t (f a) -> f (t a)     {-# INLINE sequenceA #-}  -- See Note [Inline default methods]@@ -289,12 +291,22 @@ instance Traversable Last where     traverse f (Last x) = Last <$> traverse f x +-- | @since 4.12.0.0+instance (Traversable f) => Traversable (Alt f) where+    traverse f (Alt x) = Alt <$> traverse f x++-- | @since 4.12.0.0+instance (Traversable f) => Traversable (Ap f) where+    traverse f (Ap x) = Ap <$> traverse f x+ -- | @since 4.9.0.0 instance Traversable ZipList where     traverse f (ZipList x) = ZipList <$> traverse f x +-- | @since 4.9.0.0 deriving instance Traversable Identity + -- Instances for GHC.Generics -- | @since 4.9.0.0 instance Traversable U1 where@@ -307,20 +319,51 @@     sequence _ = pure U1     {-# INLINE sequence #-} +-- | @since 4.9.0.0 deriving instance Traversable V1++-- | @since 4.9.0.0 deriving instance Traversable Par1++-- | @since 4.9.0.0 deriving instance Traversable f => Traversable (Rec1 f)++-- | @since 4.9.0.0 deriving instance Traversable (K1 i c)++-- | @since 4.9.0.0 deriving instance Traversable f => Traversable (M1 i c f)++-- | @since 4.9.0.0 deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)++-- | @since 4.9.0.0 deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)++-- | @since 4.9.0.0 deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)++-- | @since 4.9.0.0 deriving instance Traversable UAddr++-- | @since 4.9.0.0 deriving instance Traversable UChar++-- | @since 4.9.0.0 deriving instance Traversable UDouble++-- | @since 4.9.0.0 deriving instance Traversable UFloat++-- | @since 4.9.0.0 deriving instance Traversable UInt++-- | @since 4.9.0.0 deriving instance Traversable UWord++-- Instance for Data.Ord+-- | @since 4.12.0.0+deriving instance Traversable Down  -- general functions 

@@ -76,8 +76,13 @@ repr :: (a Eq.:~: b) -> Coercion a b repr Eq.Refl = Coercion +-- | @since 4.7.0.0 deriving instance Eq   (Coercion a b)++-- | @since 4.7.0.0 deriving instance Show (Coercion a b)++-- | @since 4.7.0.0 deriving instance Ord  (Coercion a b)  -- | @since 4.7.0.0

@@ -5,13 +5,13 @@ {-# LANGUAGE StandaloneDeriving     #-} {-# LANGUAGE NoImplicitPrelude      #-} {-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE TypeInType             #-} {-# LANGUAGE TypeFamilies           #-} {-# LANGUAGE UndecidableInstances   #-} {-# LANGUAGE ExplicitNamespaces     #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE PolyKinds              #-} {-# LANGUAGE Trustworthy            #-}  -----------------------------------------------------------------------------@@ -120,8 +120,13 @@ outer :: (f a :~: g b) -> (f :~: g) outer Refl = Refl +-- | @since 4.7.0.0 deriving instance Eq   (a :~: b)++-- | @since 4.7.0.0 deriving instance Show (a :~: b)++-- | @since 4.7.0.0 deriving instance Ord  (a :~: b)  -- | @since 4.7.0.0

@@ -198,28 +198,30 @@   -- Keeping backwards-compatibility-typeOf1 :: forall t (a :: *). Typeable t => t a -> TypeRep+typeOf1 :: forall t (a :: Type). Typeable t => t a -> TypeRep typeOf1 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep+typeOf2 :: forall t (a :: Type) (b :: Type). Typeable t => t a b -> TypeRep typeOf2 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t-        => t a b c -> TypeRep+typeOf3 :: forall t (a :: Type) (b :: Type) (c :: Type).+           Typeable t => t a b c -> TypeRep typeOf3 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t-        => t a b c d -> TypeRep+typeOf4 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type).+           Typeable t => t a b c d -> TypeRep typeOf4 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t-        => t a b c d e -> TypeRep+typeOf5 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type) (e :: Type).+           Typeable t => t a b c d e -> TypeRep typeOf5 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *).-                Typeable t => t a b c d e f -> TypeRep+typeOf6 :: forall t (a :: Type) (b :: Type) (c :: Type)+                    (d :: Type) (e :: Type) (f :: Type).+           Typeable t => t a b c d e f -> TypeRep typeOf6 _ = I.someTypeRep (Proxy :: Proxy t) -typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)-                (g :: *). Typeable t => t a b c d e f g -> TypeRep+typeOf7 :: forall t (a :: Type) (b :: Type) (c :: Type)+                    (d :: Type) (e :: Type) (f :: Type) (g :: Type).+           Typeable t => t a b c d e f g -> TypeRep typeOf7 _ = I.someTypeRep (Proxy :: Proxy t)

@@ -1,6 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE BangPatterns #-}@@ -85,7 +84,7 @@ import qualified GHC.Arr as A import GHC.Types ( TYPE ) import Data.Type.Equality-import GHC.List ( splitAt, foldl' )+import GHC.List ( splitAt, foldl', elem ) import GHC.Word import GHC.Show import GHC.TypeLits ( KnownSymbol, symbolVal', AppendSymbol )@@ -477,7 +476,7 @@       Refl -> IsCon con kinds  -- | Use a 'TypeRep' as 'Typeable' evidence.-withTypeable :: forall (a :: k) (r :: TYPE rep). ()+withTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()              => TypeRep a -> (Typeable a => r) -> r withTypeable rep k = unsafeCoerce k' rep   where k' :: Gift a r@@ -564,9 +563,17 @@ eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).              TypeRep a -> TypeRep b -> Maybe (a :~~: b) eqTypeRep a b-  | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce HRefl)-  | otherwise                                    = Nothing+  | 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+-- split eqTypeRep into a worker and wrapper because otherwise+-- it's much larger than anything we'd want to inline.+{-# INLINABLE eqTypeRep #-} +sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2).+               TypeRep a -> TypeRep b -> Bool+sameTypeRep a b = typeRepFingerprint a == typeRepFingerprint b  ------------------------------------------------------------- --@@ -624,7 +631,7 @@ unkindedTypeRep (SomeKindedTypeRep x) = SomeTypeRep x  data SomeKindedTypeRep k where-    SomeKindedTypeRep :: forall (a :: k). TypeRep a+    SomeKindedTypeRep :: forall k (a :: k). TypeRep a                       -> SomeKindedTypeRep k  kApp :: SomeKindedTypeRep (k -> k')@@ -633,7 +640,7 @@ kApp (SomeKindedTypeRep f) (SomeKindedTypeRep a) =     SomeKindedTypeRep (mkTrApp f a) -kindedTypeRep :: forall (a :: k). Typeable a => SomeKindedTypeRep k+kindedTypeRep :: forall k (a :: k). Typeable a => SomeKindedTypeRep k kindedTypeRep = SomeKindedTypeRep (typeRep @a)  buildList :: forall k. Typeable k@@ -769,11 +776,11 @@   | isTupleTyCon tc =     showChar '(' . showArgs (showChar ',') tys . showChar ')'   where (tc, tys) = splitApps rep-showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = []})-  = showsPrec p tycon+showTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []})+  = showTyCon tycon showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = args})   = showParen (p > 9) $-    showsPrec p tycon .+    showTyCon tycon .     showChar ' ' .     showArgs (showChar ' ') args showTypeable p (TrFun {trFunArg = x, trFunRes = r})@@ -833,6 +840,28 @@   | ('(':',':_) <- tyConName tc = True   | otherwise                   = False +-- This is only an approximation. We don't have the general+-- character-classification machinery here, so we just do our best.+-- This should work for promoted Haskell 98 data constructors and+-- for TypeOperators type constructors that begin with ASCII+-- characters, but it will miss Unicode operators.+--+-- If we wanted to catch Unicode as well, we ought to consider moving+-- GHC.Lexeme from ghc-boot-th to base. Then we could just say:+--+--   startsVarSym symb || startsConSym symb+--+-- But this is a fair deal of work just for one corner case, so I think I'll+-- leave it like this unless someone shouts.+isOperatorTyCon :: TyCon -> Bool+isOperatorTyCon tc+  | symb : _ <- tyConName tc+  , symb `elem` "!#$%&*+./<=>?@\\^|-~:" = True+  | otherwise                           = False++showTyCon :: TyCon -> ShowS+showTyCon tycon = showParen (isOperatorTyCon tycon) (shows tycon)+ showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _   []     = id showArgs _   [a]    = showsPrec 10 a@@ -951,7 +980,8 @@ tcNat = typeRepTyCon (typeRep @Nat)  -- | An internal function, to make representations for type literals.-typeLitTypeRep :: forall (a :: k). (Typeable k) => String -> TyCon -> TypeRep a+typeLitTypeRep :: forall k (a :: k). (Typeable k) =>+                  String -> TyCon -> TypeRep a typeLitTypeRep nm kind_tycon = mkTrCon (mkTypeLitTyCon nm kind_tycon) []  -- | For compiler use.

@@ -94,7 +94,10 @@                 -- The interpretation of the list of tags is entirely dependent                 -- on the entity that this version applies to.         }-  deriving (Read,Show,Generic)+  deriving ( Read    -- ^ @since 2.01+           , Show    -- ^ @since 2.01+           , Generic -- ^ @since 4.9.0.0+           ) {-# DEPRECATED versionTags "See GHC ticket #2496" #-} -- TODO. Remove all references to versionTags in GHC 8.0 release. 

@@ -68,7 +68,11 @@           -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',           -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',           -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating',-          -- 'Prelude.RealFrac' and 'Prelude.RealFloat'.+          -- 'Prelude.RealFrac' and 'Prelude.RealFloat'. That does mean+          -- that `CFloat`'s (respectively `CDouble`'s) instances of+          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num' and+          -- 'Prelude.Fractional' are as badly behaved as `Prelude.Float`'s+          -- (respectively `Prelude.Double`'s).         , CFloat(..),   CDouble(..)         -- XXX GHC doesn't support CLDouble yet         -- , CLDouble(..)

@@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples,+             ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -79,20 +80,14 @@ -- no longer required. -- {-# INLINE malloc #-}-malloc :: Storable a => IO (Ptr a)-malloc  = doMalloc undefined-  where-    doMalloc       :: Storable b => b -> IO (Ptr b)-    doMalloc dummy  = mallocBytes (sizeOf dummy)+malloc :: forall a . Storable a => IO (Ptr a)+malloc  = mallocBytes (sizeOf (undefined :: a))  -- |Like 'malloc' but memory is filled with bytes of value zero. -- {-# INLINE calloc #-}-calloc :: Storable a => IO (Ptr a)-calloc = doCalloc undefined-  where-    doCalloc       :: Storable b => b -> IO (Ptr b)-    doCalloc dummy = callocBytes (sizeOf dummy)+calloc :: forall a . Storable a => IO (Ptr a)+calloc = callocBytes (sizeOf (undefined :: a))  -- |Allocate a block of memory of the given number of bytes. -- The block of memory is sufficiently aligned for any of the basic@@ -117,12 +112,23 @@ -- exception), so the pointer passed to @f@ must /not/ be used after this. -- {-# INLINE alloca #-}-alloca :: Storable a => (Ptr a -> IO b) -> IO b-alloca  = doAlloca undefined-  where-    doAlloca       :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'-    doAlloca dummy  = allocaBytesAligned (sizeOf dummy) (alignment dummy)+alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b+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@@ -141,6 +147,8 @@      case touch# barr# s3 of { s4 ->      (# s4, r #)   }}}}}+-- See Note [NOINLINE for touch#]+{-# NOINLINE allocaBytes #-}  allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->@@ -152,6 +160,8 @@      case touch# barr# s3 of { s4 ->      (# s4, r #)   }}}}}+-- See Note [NOINLINE for touch#]+{-# NOINLINE allocaBytesAligned #-}  -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b@.  The returned pointer@@ -163,14 +173,10 @@ -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like -- 'malloc'. ---realloc :: Storable b => Ptr a -> IO (Ptr b)-realloc  = doRealloc undefined+realloc :: forall a b . Storable b => Ptr a -> IO (Ptr b)+realloc ptr = failWhenNULL "realloc" (_realloc ptr size)   where-    doRealloc           :: Storable b' => b' -> Ptr a' -> IO (Ptr b')-    doRealloc dummy ptr  = let-                             size = fromIntegral (sizeOf dummy)-                           in-                           failWhenNULL "realloc" (_realloc ptr size)+    size = fromIntegral (sizeOf (undefined :: b))  -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the given size.  The returned pointer may refer to an entirely

@@ -1,5 +1,6 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RoleAnnotations #-}+{-# LANGUAGE BangPatterns #-} {-# OPTIONS_HADDOCK hide #-}  -----------------------------------------------------------------------------@@ -239,6 +240,15 @@     inRange (m,n) i     =  m <= i && i <= n  ----------------------------------------------------------------------+-- | @since 4.8.0.0+instance Ix Natural where+    range (m,n) = [m..n]+    inRange (m,n) i = m <= i && i <= n+    unsafeIndex (m,_) i = fromIntegral (i-m)+    index b i | inRange b i = unsafeIndex b i+              | otherwise   = indexError b i "Natural"++---------------------------------------------------------------------- -- | @since 2.01 instance Ix Bool where -- as derived     {-# INLINE range #-}@@ -505,8 +515,12 @@ -- | The value at the given index in an array. {-# INLINE (!) #-} (!) :: Ix i => Array i e -> i -> e-arr@(Array l u n _) ! i = unsafeAt arr $ safeIndex (l,u) n i+(!) arr@(Array l u n _) i = unsafeAt arr $ safeIndex (l,u) n i +{-# INLINE (!#) #-}+(!#) :: Ix i => Array i e -> i -> (# e #)+(!#) arr@(Array l u n _) i = unsafeAt# arr $ safeIndex (l,u) n i+ {-# INLINE safeRangeSize #-} safeRangeSize :: Ix i => (i, i) -> Int safeRangeSize (l,u) = let r = rangeSize (l, u)@@ -550,6 +564,15 @@ unsafeAt (Array _ _ _ arr#) (I# i#) =     case indexArray# arr# i# of (# e #) -> e +-- | Look up an element in an array without forcing it+unsafeAt# :: Array i e -> Int -> (# e #)+unsafeAt# (Array _ _ _ arr#) (I# i#) = indexArray# arr# i#++-- | A convenient version of unsafeAt#+unsafeAtA :: Applicative f+          => Array i e -> Int -> f e+unsafeAtA ary i = case unsafeAt# ary i of (# e #) -> pure e+ -- | The bounds with which an array was constructed. {-# INLINE bounds #-} bounds :: Array i e -> (i,i)@@ -569,7 +592,7 @@ {-# INLINE elems #-} elems :: Array i e -> [e] elems arr@(Array _ _ n _) =-    [unsafeAt arr i | i <- [0 .. n - 1]]+    [e | i <- [0 .. n - 1], e <- unsafeAtA arr i]  -- | A right fold over the elements {-# INLINABLE foldrElems #-}@@ -577,7 +600,8 @@ foldrElems f b0 = \ arr@(Array _ _ n _) ->   let     go i | i == n    = b0-         | otherwise = f (unsafeAt arr i) (go (i+1))+         | (# e #) <- unsafeAt# arr i+         = f e (go (i+1))   in go 0  -- | A left fold over the elements@@ -586,7 +610,8 @@ foldlElems f b0 = \ arr@(Array _ _ n _) ->   let     go i | i == (-1) = b0-         | otherwise = f (go (i-1)) (unsafeAt arr i)+         | (# e #) <- unsafeAt# arr i+         = f (go (i-1)) e   in go (n-1)  -- | A strict right fold over the elements@@ -595,7 +620,8 @@ foldrElems' f b0 = \ arr@(Array _ _ n _) ->   let     go i a | i == (-1) = a-           | otherwise = go (i-1) (f (unsafeAt arr i) $! a)+           | (# e #) <- unsafeAt# arr i+           = go (i-1) (f e $! a)   in go (n-1) b0  -- | A strict left fold over the elements@@ -604,7 +630,8 @@ foldlElems' f b0 = \ arr@(Array _ _ n _) ->   let     go i a | i == n    = a-           | otherwise = go (i+1) (a `seq` f a (unsafeAt arr i))+           | (# e #) <- unsafeAt# arr i+           = go (i+1) (a `seq` f a e)   in go 0 b0  -- | A left fold over the elements with no starting value@@ -613,7 +640,8 @@ foldl1Elems f = \ arr@(Array _ _ n _) ->   let     go i | i == 0    = unsafeAt arr 0-         | otherwise = f (go (i-1)) (unsafeAt arr i)+         | (# e #) <- unsafeAt# arr i+         = f (go (i-1)) e   in     if n == 0 then errorWithoutStackTrace "foldl1: empty Array" else go (n-1) @@ -623,7 +651,8 @@ foldr1Elems f = \ arr@(Array _ _ n _) ->   let     go i | i == n-1  = unsafeAt arr i-         | otherwise = f (unsafeAt arr i) (go (i + 1))+         | (# e #) <- unsafeAt# arr i+         = f e (go (i + 1))   in     if n == 0 then errorWithoutStackTrace "foldr1: empty Array" else go 0 @@ -631,11 +660,12 @@ {-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _ _) =-    [(i, arr ! i) | i <- range (l,u)]+    [(i, e) | i <- range (l,u), let !(# e #) = arr !# i]  -- | The 'accumArray' function deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of -- associations with the same index.+-- -- For example, given a list of values of some index type, @hist@ -- produces a histogram of the number of occurrences of each index within -- a specified range:@@ -643,10 +673,10 @@ -- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b -- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i] ----- If the accumulating function is strict, then 'accumArray' is strict in--- the values, as well as the indices, in the association list.  Thus,--- unlike ordinary arrays built with 'array', accumulated arrays should--- not in general be recursive.+-- @accumArray@ is strict in each result of applying the accumulating+-- function, although it is lazy in the initial value. Thus, unlike+-- arrays built with 'array', accumulated arrays should not in general+-- be recursive. {-# INLINE accumArray #-} accumArray :: Ix i         => (e -> a -> e)        -- ^ accumulating function@@ -667,7 +697,7 @@ unsafeAccumArray' :: (e -> a -> e) -> e -> (i,i) -> Int -> [(Int, a)] -> Array i e unsafeAccumArray' f initial (l,u) n@(I# n#) ies = runST (ST $ \s1# ->     case newArray# n# initial s1#          of { (# s2#, marr# #) ->-    foldr (adjust f marr#) (done l u n marr#) ies s2# })+    foldr (adjust' f marr#) (done l u n marr#) ies s2# })  {-# INLINE adjust #-} adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b@@ -678,6 +708,18 @@                     case writeArray# marr# i# (f old new) s2# of                         s3# -> next s3# +{-# INLINE adjust' #-}+adjust' :: (e -> a -> e)+        -> MutableArray# s e+        -> (Int, a)+        -> STRep s b -> STRep s b+adjust' f marr# (I# i#, new) next+  = \s1# -> case readArray# marr# i# s1# of+                (# s2#, old #) ->+                    let !combined = f old new+                    in next (writeArray# marr# i# combined s2#)++ -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then@@ -706,6 +748,8 @@ -- -- > accumArray f z b = accum f (array b [(i, z) | i <- range b]) --+-- @accum@ is strict in all the results of applying the accumulation.+-- However, it is lazy in the initial values of the array. {-# INLINE accum #-} accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e accum f arr@(Array l u n _) ies =@@ -715,7 +759,7 @@ unsafeAccum :: (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e unsafeAccum f arr ies = runST (do     STArray l u n marr# <- thawSTArray arr-    ST (foldr (adjust f marr#) (done l u n marr#) ies))+    ST (foldr (adjust' f marr#) (done l u n marr#) ies))  {-# INLINE [1] amap #-}  -- See Note [amap] amap :: (a -> b) -> Array i a -> Array i b@@ -724,7 +768,8 @@         (# s2#, marr# #) ->           let go i s#                 | i == n    = done l u n marr# s#-                | otherwise = fill marr# (i, f (unsafeAt arr i)) (go (i+1)) s#+                | (# e #) <- unsafeAt# arr i+                = fill marr# (i, f e) (go (i+1)) s#           in go 0 s2# )  {- Note [amap]

@@ -83,6 +83,9 @@            , UnboxedTuples            , ExistentialQuantification            , RankNTypes+           , KindSignatures+           , PolyKinds+           , DataKinds   #-} -- -Wno-orphans is needed for things like: -- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0@@ -114,7 +117,8 @@         module GHC.Types,         module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,                                 -- to avoid lots of people having to-        module GHC.Err          -- import it explicitly+        module GHC.Err,         -- import it explicitly+        module GHC.Maybe   )         where @@ -124,10 +128,12 @@ import GHC.Magic import GHC.Prim import GHC.Err+import GHC.Maybe import {-# SOURCE #-} GHC.IO (failIO,mplusIO) -import GHC.Tuple ()     -- Note [Depend on GHC.Tuple]-import GHC.Integer ()   -- Note [Depend on GHC.Integer]+import GHC.Tuple ()              -- Note [Depend on GHC.Tuple]+import GHC.Integer ()            -- Note [Depend on GHC.Integer]+import GHC.Natural ()            -- Note [Depend on GHC.Natural]  -- for 'class Semigroup' import {-# SOURCE #-} GHC.Real (Integral)@@ -179,6 +185,10 @@ GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on 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@@ -199,19 +209,6 @@ foldr = errorWithoutStackTrace "urk" #endif --- | The 'Maybe' type encapsulates an optional value.  A value of type--- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@),--- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to--- deal with errors or exceptional cases without resorting to drastic--- measures such as 'error'.------ The 'Maybe' type is also a monad.  It is a simple kind of error--- monad, where all errors are represented by 'Nothing'.  A richer--- error monad can be built using the 'Data.Either.Either' type.----data  Maybe a  =  Nothing | Just a-  deriving (Eq, Ord)- infixr 6 <>  -- | The class of semigroups (types with an associative binary operation).@@ -595,6 +592,33 @@ -- | The 'join' function is the conventional monad join operator. It -- is used to remove one level of monadic structure, projecting its -- bound argument into the outer level.+--+-- ==== __Examples__+--+-- A common use of 'join' is to run an 'IO' computation returned from+-- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions+-- can't perform 'IO' directly. Recall that+--+-- @+-- 'GHC.Conc.atomically' :: STM a -> IO a+-- @+--+-- is used to run 'GHC.Conc.STM' transactions atomically. So, by+-- specializing the types of 'GHC.Conc.atomically' and 'join' to+--+-- @+-- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b)+-- 'join'       :: IO (IO b)  -> IO b+-- @+--+-- we can compose them as+--+-- @+-- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b+-- @+--+-- to run an 'GHC.Conc.STM' transaction and the 'IO' action it+-- returns. join              :: (Monad m) => m (m a) -> m a join x            =  x >>= id @@ -913,7 +937,9 @@ -- -- @since 4.9.0.0 data NonEmpty a = a :| [a]-  deriving (Eq, Ord)+  deriving ( Eq  -- ^ @since 4.9.0.0+           , Ord -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Functor NonEmpty where@@ -1287,16 +1313,20 @@ -- -- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@, -- or @'Data.List.zipWith' ('$') fs xs@.+--+-- Note that @($)@ is levity-polymorphic in its result type, so that+--     foo $ True    where  foo :: Bool -> Int#+-- is well-typed {-# INLINE ($) #-}-($)                     :: (a -> b) -> a -> b-f $ x                   =  f x+($) :: forall r a (b :: TYPE r). (a -> b) -> a -> b+f $ x =  f x  -- | Strict (call-by-value) application operator. It takes a function and an -- argument, evaluates the argument to weak head normal form (WHNF), then calls -- the function with that value. -($!)                    :: (a -> b) -> a -> b-f $! x                  = let !vx = x in f vx  -- see #2273+($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b+f $! x = let !vx = x in f vx  -- see #2273  -- | @'until' p f@ yields the result of applying @f@ until @p@ holds. until                   :: (a -> Bool) -> (a -> a) -> a -> a

@@ -1,10 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Base where+module GHC.Base (Maybe, Semigroup, Monoid) where +import GHC.Maybe (Maybe) import GHC.Types ()  class Semigroup a class Monoid a--data Maybe a = Nothing | Just a

@@ -12,6 +12,7 @@ -- -- Target byte ordering. --+-- @since 4.11.0.0 -----------------------------------------------------------------------------  module GHC.ByteOrder where@@ -20,7 +21,13 @@ data ByteOrder     = BigEndian    -- ^ most-significant-byte occurs in lowest address.     | LittleEndian -- ^ least-significant-byte occurs in lowest address.-    deriving (Eq, Ord, Bounded, Enum, Read, Show)+    deriving ( Eq      -- ^ @since 4.11.0.0+             , Ord     -- ^ @since 4.11.0.0+             , Bounded -- ^ @since 4.11.0.0+             , Enum    -- ^ @since 4.11.0.0+             , Read    -- ^ @since 4.11.0.0+             , Show    -- ^ @since 4.11.0.0+             )  -- | The byte ordering of the target machine. targetByteOrder :: ByteOrder

@@ -74,8 +74,6 @@         , orElse         , throwSTM         , catchSTM-        , alwaysSucceeds-        , always         , TVar(..)         , newTVar         , newTVarIO

@@ -188,8 +188,9 @@         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.+-- | Switch the value of returned 'TVar' from initial value 'False' to 'True'+-- after a given number of microseconds. The caveats associated with+-- 'threadDelay' also apply. -- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs

@@ -74,8 +74,6 @@         , orElse         , throwSTM         , catchSTM-        , alwaysSucceeds-        , always         , TVar(..)         , newTVar         , newTVarIO@@ -105,6 +103,7 @@ import GHC.Base import {-# SOURCE #-} GHC.IO.Handle ( hFlush ) import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )+import GHC.Int import GHC.IO import GHC.IO.Encoding.UTF8 import GHC.IO.Exception@@ -194,18 +193,16 @@ -- -- @since 4.8.0.0 setAllocationCounter :: Int64 -> IO ()-setAllocationCounter i = do-  ThreadId t <- myThreadId-  rts_setThreadAllocationCounter t i+setAllocationCounter (I64# i) = IO $ \s ->+  case setThreadAllocationCounter# i s of s' -> (# s', () #)  -- | Return the current value of the allocation counter for the -- current thread. -- -- @since 4.8.0.0 getAllocationCounter :: IO Int64-getAllocationCounter = do-  ThreadId t <- myThreadId-  rts_getThreadAllocationCounter t+getAllocationCounter = IO $ \s ->+  case getThreadAllocationCounter# s of (# s', ctr #) -> (# s', I64# ctr #)  -- | Enables the allocation counter to be treated as a limit for the -- current thread.  When the allocation limit is enabled, if the@@ -242,16 +239,6 @@   ThreadId t <- myThreadId   rts_disableThreadAllocationLimit t --- We cannot do these operations safely on another thread, because on--- a 32-bit machine we cannot do atomic operations on a 64-bit value.--- Therefore, we only expose APIs that allow getting and setting the--- limit of the current thread.-foreign import ccall unsafe "rts_setThreadAllocationCounter"-  rts_setThreadAllocationCounter :: ThreadId# -> Int64 -> IO ()--foreign import ccall unsafe "rts_getThreadAllocationCounter"-  rts_getThreadAllocationCounter :: ThreadId# -> IO Int64- foreign import ccall unsafe "rts_enableThreadAllocationLimit"   rts_enableThreadAllocationLimit :: ThreadId# -> IO () @@ -558,7 +545,10 @@         -- ^blocked on some other resource.  Without @-threaded@,         -- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@         -- they show up as 'BlockedOnMVar'.-  deriving (Eq,Ord,Show)+  deriving ( Eq   -- ^ @since 4.3.0.0+           , Ord  -- ^ @since 4.3.0.0+           , Show -- ^ @since 4.3.0.0+           )  -- | The current status of a thread data ThreadStatus@@ -570,7 +560,10 @@         -- ^the thread is blocked on some resource   | ThreadDied         -- ^the thread received an uncaught exception-  deriving (Eq,Ord,Show)+  deriving ( Eq   -- ^ @since 4.3.0.0+           , Ord  -- ^ @since 4.3.0.0+           , Show -- ^ @since 4.3.0.0+           )  threadStatus :: ThreadId -> IO ThreadStatus threadStatus (ThreadId t) = IO $ \s ->@@ -781,31 +774,6 @@       handler' e = case fromException e of                      Just e' -> unSTM (handler e')                      Nothing -> raiseIO# e---- | Low-level primitive on which 'always' and 'alwaysSucceeds' are built.--- 'checkInv' differs from these in that,------ 1. the invariant is not checked when 'checkInv' is called, only at the end of--- this and subsequent transactions--- 2. the invariant failure is indicated by raising an exception.-checkInv :: STM a -> STM ()-checkInv (STM m) = STM (\s -> case (check# m) s of s' -> (# s', () #))---- | 'alwaysSucceeds' adds a new invariant that must be true when passed--- to 'alwaysSucceeds', at the end of the current transaction, and at--- the end of every subsequent transaction.  If it fails at any--- of those points then the transaction violating it is aborted--- and the exception raised by the invariant is propagated.-alwaysSucceeds :: STM a -> STM ()-alwaysSucceeds i = do ( i >> retry ) `orElse` ( return () )-                      checkInv i---- | 'always' is a variant of 'alwaysSucceeds' in which the invariant is--- expressed as an @STM Bool@ action that must return @True@.  Returning--- @False@ or raising an exception are both treated as invariant failures.-always :: STM Bool -> STM ()-always i = alwaysSucceeds ( do v <- i-                               if (v) then return () else ( errorWithoutStackTrace "Transactional invariant violation" ) )  -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a)

@@ -278,7 +278,12 @@     -- these are sent to Services only.  | Logoff  | Shutdown- deriving (Eq, Ord, Enum, Show, Read)+ deriving ( Eq   -- ^ @since 4.3.0.0+          , Ord  -- ^ @since 4.3.0.0+          , Enum -- ^ @since 4.3.0.0+          , Show -- ^ @since 4.3.0.0+          , Read -- ^ @since 4.3.0.0+          )  start_console_handler :: Word32 -> IO () start_console_handler r =

@@ -92,13 +92,51 @@     -- applied to a value that is too large to fit in an 'Int'.     fromEnum            :: a -> Int -    -- | Used in Haskell's translation of @[n..]@.+    -- | Used in Haskell's translation of @[n..]@ with @[n..] = enumFrom n@,+    --   a possible implementation being @enumFrom n = n : enumFrom (succ n)@.+    --   For example:+    --+    --     * @enumFrom 4 :: [Integer] = [4,5,6,7,...]@+    --     * @enumFrom 6 :: [Int] = [6,7,8,9,...,maxBound :: Int]@     enumFrom            :: a -> [a]-    -- | Used in Haskell's translation of @[n,n'..]@.+    -- | Used in Haskell's translation of @[n,n'..]@+    --   with @[n,n'..] = enumFromThen n n'@, a possible implementation being+    --   @enumFromThen n n' = n : n' : worker (f x) (f x n')@,+    --   @worker s v = v : worker s (s v)@, @x = fromEnum n' - fromEnum n@ and+    --   @f n y+    --     | n > 0 = f (n - 1) (succ y)+    --     | n < 0 = f (n + 1) (pred y)+    --     | otherwise = y@+    --   For example:+    --+    --     * @enumFromThen 4 6 :: [Integer] = [4,6,8,10...]@+    --     * @enumFromThen 6 2 :: [Int] = [6,2,-2,-6,...,minBound :: Int]@     enumFromThen        :: a -> a -> [a]-    -- | Used in Haskell's translation of @[n..m]@.+    -- | Used in Haskell's translation of @[n..m]@ with+    --   @[n..m] = enumFromTo n m@, a possible implementation being+    --   @enumFromTo n m+    --      | n <= m = n : enumFromTo (succ n) m+    --      | otherwise = []@.+    --   For example:+    --+    --     * @enumFromTo 6 10 :: [Int] = [6,7,8,9,10]@+    --     * @enumFromTo 42 1 :: [Integer] = []@     enumFromTo          :: a -> a -> [a]-    -- | Used in Haskell's translation of @[n,n'..m]@.+    -- | Used in Haskell's translation of @[n,n'..m]@ with+    --   @[n,n'..m] = enumFromThenTo n n' m@, a possible implementation+    --   being @enumFromThenTo n n' m = worker (f x) (c x) n m@,+    --   @x = fromEnum n' - fromEnum n@, @c x = bool (>=) (<=) (x > 0)@+    --   @f n y+    --      | n > 0 = f (n - 1) (succ y)+    --      | n < 0 = f (n + 1) (pred y)+    --      | otherwise = y@ and+    --   @worker s c v m+    --      | c v m = v : worker s c (s v) m+    --      | otherwise = []@+    --   For example:+    --+    --     * @enumFromThenTo 4 2 -6 :: [Integer] = [4,2,0,-2,-4,-6]@+    --     * @enumFromThenTo 6 8 2 :: [Int] = []@     enumFromThenTo      :: a -> a -> a -> [a]      succ                   = toEnum . (+ 1)  . fromEnum@@ -876,6 +914,79 @@                     where                         go x | x < lim   = []                              | otherwise = x : go (x+delta)++------------------------------------------------------------------------+-- Natural+------------------------------------------------------------------------++#if defined(MIN_VERSION_integer_gmp)+-- | @since 4.8.0.0+instance Enum Natural where+    succ n = n `plusNatural`  wordToNaturalBase 1##+    pred n = n `minusNatural` wordToNaturalBase 1##++    toEnum = intToNatural++    fromEnum (NatS# w)+      | i >= 0    = i+      | otherwise = errorWithoutStackTrace "fromEnum: out of Int range"+      where+        i = I# (word2Int# w)+    fromEnum n = fromEnum (naturalToInteger n)++    enumFrom x        = enumDeltaNatural      x (wordToNaturalBase 1##)+    enumFromThen x y+      | x <= y        = enumDeltaNatural      x (y-x)+      | otherwise     = enumNegDeltaToNatural x (x-y) (wordToNaturalBase 0##)++    enumFromTo x lim  = enumDeltaToNatural    x (wordToNaturalBase 1##) lim+    enumFromThenTo x y lim+      | x <= y        = enumDeltaToNatural    x (y-x) lim+      | otherwise     = enumNegDeltaToNatural x (x-y) lim++-- Helpers for 'Enum Natural'; TODO: optimise & make fusion work++enumDeltaNatural :: Natural -> Natural -> [Natural]+enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d++enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]+enumDeltaToNatural x0 delta lim = go x0+  where+    go x | x > lim   = []+         | otherwise = x : go (x+delta)++enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]+enumNegDeltaToNatural x0 ndelta lim = go x0+  where+    go x | x < lim     = []+         | x >= ndelta = x : go (x-ndelta)+         | otherwise   = [x]++#else++-- | @since 4.8.0.0+instance Enum Natural where+  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"+  pred (Natural n) = Natural (pred n)+  {-# INLINE pred #-}+  succ (Natural n) = Natural (succ n)+  {-# INLINE succ #-}+  fromEnum (Natural n) = fromEnum n+  {-# INLINE fromEnum #-}+  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"+           | otherwise = Natural (toEnum n)+  {-# INLINE toEnum #-}++  enumFrom     = coerce (enumFrom     :: Integer -> [Integer])+  enumFromThen x y+    | x <= y    = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y+    | otherwise = enumFromThenTo x y (wordToNaturalBase 0##)++  enumFromTo   = coerce (enumFromTo   :: Integer -> Integer -> [Integer])+  enumFromThenTo+    = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])++#endif  -- Instances from GHC.Types 

@@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}-{-# LANGUAGE RankNTypes, TypeInType #-}+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-} {-# OPTIONS_HADDOCK hide #-}  -----------------------------------------------------------------------------@@ -27,10 +27,12 @@ import GHC.Types (Char, RuntimeRep) import GHC.Stack.Types import GHC.Prim-import GHC.Integer ()   -- Make sure Integer is compiled first-                        -- because GHC depends on it in a wired-in way+import GHC.Integer ()   -- Make sure Integer and Natural are compiled first+import GHC.Natural ()   -- because GHC depends on it in a wired-in way                         -- so the build system doesn't see the dependency-import {-# SOURCE #-} GHC.Exception( errorCallWithCallStackException )+import {-# SOURCE #-} GHC.Exception+  ( errorCallWithCallStackException+  , errorCallException )  -- | 'error' stops execution and displays an error message. error :: forall (r :: RuntimeRep). forall (a :: TYPE r).@@ -46,10 +48,7 @@ -- @since 4.9.0.0 errorWithoutStackTrace :: forall (r :: RuntimeRep). forall (a :: TYPE r).                           [Char] -> a-errorWithoutStackTrace s =-  -- we don't have withFrozenCallStack yet, so we just inline the definition-  let ?callStack = freezeCallStack emptyCallStack-  in error s+errorWithoutStackTrace s = raise# (errorCallException s)   -- Note [Errors in base]

@@ -57,7 +57,9 @@                     | CMsgDie                     | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)                                  {-# UNPACK #-} !Signal-    deriving (Eq, Show)+    deriving ( Eq   -- ^ @since 4.4.0.0+             , Show -- ^ @since 4.4.0.0+             )  -- | The structure used to tell the IO manager thread what to do. data Control = W {

@@ -161,7 +161,12 @@  newtype EventType = EventType {       unEventType :: Word32-    } deriving (Show, Eq, Num, Bits, FiniteBits)+    } deriving ( Show       -- ^ @since 4.4.0.0+               , Eq         -- ^ @since 4.4.0.0+               , Num        -- ^ @since 4.4.0.0+               , Bits       -- ^ @since 4.4.0.0+               , FiniteBits -- ^ @since 4.7.0.0+               )  #{enum EventType, EventType  , epollIn  = EPOLLIN

@@ -40,7 +40,7 @@  -- | An I\/O event. newtype Event = Event Int-    deriving (Eq)+    deriving Eq -- ^ @since 4.4.0.0  evtNothing :: Event evtNothing = Event 0@@ -64,7 +64,7 @@ eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 --- | @since 4.3.1.0+-- | @since 4.4.0.0 instance Show Event where     show e = '[' : (intercalate "," . filter (not . null) $                     [evtRead `so` "evtRead",@@ -78,7 +78,7 @@     (<>)    = evtCombine     stimes  = stimesMonoid --- | @since 4.3.1.0+-- | @since 4.4.0.0 instance Monoid Event where     mempty  = evtNothing     mconcat = evtConcat@@ -97,7 +97,9 @@ data Lifetime = OneShot   -- ^ the registration will be active for only one                           -- event               | MultiShot -- ^ the registration will trigger multiple times-              deriving (Show, Eq)+              deriving ( Show -- ^ @since 4.8.1.0+                       , Eq   -- ^ @since 4.8.1.0+                       )  -- | The longer of two lifetimes. elSupremum :: Lifetime -> Lifetime -> Lifetime@@ -121,7 +123,9 @@ -- Here we encode the event in the bottom three bits and the lifetime -- in the fourth bit. newtype EventLifetime = EL Int-                      deriving (Show, Eq)+                      deriving ( Show -- ^ @since 4.8.0.0+                               , Eq   -- ^ @since 4.8.0.0+                               )  -- | @since 4.11.0.0 instance Semigroup EventLifetime where@@ -149,7 +153,7 @@ -- | A type alias for timeouts, specified in nanoseconds. data Timeout = Timeout {-# UNPACK #-} !Word64              | Forever-               deriving (Show)+               deriving Show -- ^ @since 4.4.0.0  -- | Event notification backend. data Backend = forall a. Backend {

@@ -124,7 +124,9 @@  newtype KQueueFd = KQueueFd {       fromKQueueFd :: CInt-    } deriving (Eq, Show)+    } deriving ( Eq   -- ^ @since 4.4.0.0+               , Show -- ^ @since 4.4.0.0+               )  data Event = KEvent {       ident  :: {-# UNPACK #-} !CUIntPtr@@ -137,7 +139,7 @@     , data_  :: {-# UNPACK #-} !CIntPtr #endif     , udata  :: {-# UNPACK #-} !(Ptr ())-    } deriving Show+    } deriving Show -- ^ @since 4.4.0.0  toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event] toEvents fd flts flag fflag = map (\filt -> KEvent (fromIntegral fd) filt flag fflag 0 nullPtr) flts@@ -167,7 +169,10 @@         #{poke struct kevent, udata} ptr (udata ev)  newtype FFlag = FFlag Word32-    deriving (Eq, Show, Storable)+    deriving ( Eq       -- ^ @since 4.4.0.0+             , Show     -- ^ @since 4.4.0.0+             , Storable -- ^ @since 4.4.0.0+             )  #{enum FFlag, FFlag  , noteEOF = NOTE_EOF@@ -178,7 +183,13 @@ #else newtype Flag = Flag Word16 #endif-    deriving (Bits, FiniteBits, Eq, Num, Show, Storable)+    deriving ( Bits       -- ^ @since 4.7.0.0+             , FiniteBits -- ^ @since 4.7.0.0+             , Eq         -- ^ @since 4.4.0.0+             , Num        -- ^ @since 4.7.0.0+             , Show       -- ^ @since 4.4.0.0+             , Storable   -- ^ @since 4.4.0.0+             )  #{enum Flag, Flag  , flagAdd     = EV_ADD@@ -191,7 +202,11 @@ #else newtype Filter = Filter Int16 #endif-    deriving (Eq, Num, Show, Storable)+    deriving ( Eq       -- ^ @since 4.4.0.0+             , Num      -- ^ @since 4.4.0.0+             , Show     -- ^ @since 4.4.0.0+             , Storable -- ^ @since 4.4.0.0+             )  filterRead :: Filter filterRead = Filter (#const EVFILT_READ)

@@ -110,7 +110,9 @@ data FdKey = FdKey {       keyFd     :: {-# UNPACK #-} !Fd     , keyUnique :: {-# UNPACK #-} !Unique-    } deriving (Eq, Show)+    } deriving ( Eq   -- ^ @since 4.4.0.0+               , Show -- ^ @since 4.4.0.0+               )  -- | Callback invoked on I/O events. type IOCallback = FdKey -> Event -> IO ()@@ -120,7 +122,9 @@            | Dying            | Releasing            | Finished-             deriving (Eq, Show)+             deriving ( Eq   -- ^ @since 4.4.0.0+                      , Show -- ^ @since 4.4.0.0+                      )  -- | The event manager state. data EventManager = EventManager

@@ -28,7 +28,7 @@     , singleton      -- * Insertion-    , insert+    , unsafeInsertNew      -- * Delete/Update     , delete@@ -36,7 +36,6 @@      -- * Conversion     , toList-    , fromList      -- * Min     , findMin@@ -213,14 +212,7 @@ -- Insertion ------------------------------------------------------------------------------ --- | /O(min(n,W))/ Insert a new key, priority and value into the queue. If the key--- is already present in the queue, the associated priority and value are--- replaced with the supplied priority and value.-insert :: Key -> Prio -> v -> IntPSQ v -> IntPSQ v-insert k p x t0 = unsafeInsertNew k p x (delete k t0)---- | Internal function to insert a key that is *not* present in the priority--- queue.+-- | /O(min(n,W))/ Insert a new key that is *not* present in the priority queue. {-# INLINABLE unsafeInsertNew #-} unsafeInsertNew :: Key -> Prio -> v -> IntPSQ v -> IntPSQ v unsafeInsertNew k p x = go@@ -339,13 +331,6 @@ ------------------------------------------------------------------------------ -- Lists ---------------------------------------------------------------------------------- | /O(n*min(n,W))/ Build a queue from a list of (key, priority, value) tuples.--- If the list contains more than one priority and value for the same key, the--- last priority and value for the key is retained.-{-# INLINABLE fromList #-}-fromList :: [Elem v] -> IntPSQ v-fromList = foldr (\(E k p x) im -> insert k p x im) empty  -- | /O(n)/ Convert a queue to a list of (key, priority, value) tuples. The -- order of the list is not specified.

@@ -151,10 +151,16 @@       pfdFd      :: {-# UNPACK #-} !Fd     , pfdEvents  :: {-# UNPACK #-} !Event     , pfdRevents :: {-# UNPACK #-} !Event-    } deriving (Show)+    } deriving Show -- ^ @since 4.4.0.0  newtype Event = Event CShort-    deriving (Eq, Show, Num, Storable, Bits, FiniteBits)+    deriving ( Eq         -- ^ @since 4.4.0.0+             , Show       -- ^ @since 4.4.0.0+             , Num        -- ^ @since 4.4.0.0+             , Storable   -- ^ @since 4.4.0.0+             , Bits       -- ^ @since 4.4.0.0+             , FiniteBits -- ^ @since 4.7.0.0+             )  -- We have to duplicate the whole enum like this in order for the -- hsc2hs cross-compilation mode to work

@@ -45,8 +45,9 @@ import GHC.Base import GHC.Clock (getMonotonicTimeNSec) import GHC.Conc.Signal (runHandlers)+import GHC.Enum (maxBound) import GHC.Num (Num(..))-import GHC.Real (fromIntegral)+import GHC.Real (quot, fromIntegral) import GHC.Show (Show(..)) import GHC.Event.Control import GHC.Event.Internal (Backend, Event, evtRead, Timeout(..))@@ -67,7 +68,7 @@  -- | A timeout registration cookie. newtype TimeoutKey   = TK Unique-    deriving (Eq)+    deriving Eq -- ^ @since 4.7.0.0  -- | Callback invoked on timeout events. type TimeoutCallback = IO ()@@ -76,7 +77,9 @@            | Running            | Dying            | Finished-             deriving (Eq, Show)+             deriving ( Eq   -- ^ @since 4.7.0.0+                      , Show -- ^ @since 4.7.0.0+                      )  -- | A priority search queue, with timeouts as priorities. type TimeoutQueue = Q.PSQ TimeoutCallback@@ -206,6 +209,18 @@ ------------------------------------------------------------------------ -- Registering interest in timeout events +expirationTime :: Int -> IO Q.Prio+expirationTime us = do+    now <- getMonotonicTimeNSec+    let expTime+          -- Currently we treat overflows by clamping to maxBound. If humanity+          -- still exists in 2500 CE we will ned to be a bit more careful here.+          -- See #15158.+          | (maxBound - now) `quot` 1000 < fromIntegral us  = maxBound+          | otherwise                                       = now + ns+          where ns = 1000 * fromIntegral us+    return expTime+ -- | Register a timeout in the given number of microseconds.  The -- returned 'TimeoutKey' can be used to later unregister or update the -- timeout.  The timeout is automatically unregistered after the given@@ -215,10 +230,11 @@   !key <- newUnique (emUniqueSource mgr)   if us <= 0 then cb     else do-      now <- getMonotonicTimeNSec-      let expTime = fromIntegral us * 1000 + now+      expTime <- expirationTime us -      editTimeouts mgr (Q.insert key expTime cb)+      -- "unsafeInsertNew" is safe - the key must not exist in the PSQ. It+      -- doesn't because we just generated it from a unique supply.+      editTimeouts mgr (Q.unsafeInsertNew key expTime cb)   return $ TK key  -- | Unregister an active timeout.@@ -230,9 +246,7 @@ -- microseconds. updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO () updateTimeout mgr (TK key) us = do-  now <- getMonotonicTimeNSec-  let expTime = fromIntegral us * 1000 + now-+  expTime <- expirationTime us   editTimeouts mgr (Q.adjust (const expTime) key)  editTimeouts :: TimerManager -> TimeoutEdit -> IO ()

@@ -19,7 +19,10 @@ data UniqueSource = US (MutableByteArray# RealWorld)  newtype Unique = Unique { asInt :: Int }-    deriving (Eq, Ord, Num)+    deriving ( Eq  -- ^ @since 4.4.0.0+             , Ord -- ^ @since 4.4.0.0+             , Num -- ^ @since 4.4.0.0+             )  -- | @since 4.3.1.0 instance Show Unique where

@@ -5,6 +5,7 @@            , RecordWildCards            , PatternSynonyms   #-}+{-# LANGUAGE TypeInType #-} {-# OPTIONS_HADDOCK hide #-}  -----------------------------------------------------------------------------@@ -22,155 +23,38 @@ -----------------------------------------------------------------------------  module GHC.Exception-       ( Exception(..)    -- Class+       ( module GHC.Exception.Type        , throw-       , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)-       , divZeroException, overflowException, ratioZeroDenomException-       , underflowException-       , errorCallException, errorCallWithCallStackException+       , ErrorCall(..,ErrorCall)+       , errorCallException+       , errorCallWithCallStackException          -- re-export CallStack and SrcLoc from GHC.Types        , CallStack, fromCallSiteList, getCallStack, prettyCallStack        , prettyCallStackLines, showCCSStack        , SrcLoc(..), prettySrcLoc        ) where -import Data.Maybe-import Data.Typeable (Typeable, cast)-   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show import GHC.Stack.Types import GHC.OldList+import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS--{- |-The @SomeException@ type is the root of the exception type hierarchy.-When an exception of type @e@ is thrown, behind the scenes it is-encapsulated in a @SomeException@.--}-data SomeException = forall e . Exception e => SomeException e---- | @since 3.0-instance Show SomeException where-    showsPrec p (SomeException e) = showsPrec p e--{- |-Any type that you wish to throw or catch as an exception must be an-instance of the @Exception@ class. The simplest case is a new exception-type directly below the root:--> data MyException = ThisException | ThatException->     deriving Show->-> instance Exception MyException--The default method definitions in the @Exception@ class do what we need-in this case. You can now throw and catch @ThisException@ and-@ThatException@ as exceptions:--@-*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))-Caught ThisException-@--In more complicated examples, you may wish to define a whole hierarchy-of exceptions:--> ----------------------------------------------------------------------> -- Make the root exception type for all the exceptions in a compiler->-> data SomeCompilerException = forall e . Exception e => SomeCompilerException e->-> instance Show SomeCompilerException where->     show (SomeCompilerException e) = show e->-> instance Exception SomeCompilerException->-> compilerExceptionToException :: Exception e => e -> SomeException-> compilerExceptionToException = toException . SomeCompilerException->-> compilerExceptionFromException :: Exception e => SomeException -> Maybe e-> compilerExceptionFromException x = do->     SomeCompilerException a <- fromException x->     cast a->-> ----------------------------------------------------------------------> -- Make a subhierarchy for exceptions in the frontend of the compiler->-> data SomeFrontendException = forall e . Exception e => SomeFrontendException e->-> instance Show SomeFrontendException where->     show (SomeFrontendException e) = show e->-> instance Exception SomeFrontendException where->     toException = compilerExceptionToException->     fromException = compilerExceptionFromException->-> frontendExceptionToException :: Exception e => e -> SomeException-> frontendExceptionToException = toException . SomeFrontendException->-> frontendExceptionFromException :: Exception e => SomeException -> Maybe e-> frontendExceptionFromException x = do->     SomeFrontendException a <- fromException x->     cast a->-> ----------------------------------------------------------------------> -- Make an exception type for a particular frontend compiler exception->-> data MismatchedParentheses = MismatchedParentheses->     deriving Show->-> instance Exception MismatchedParentheses where->     toException   = frontendExceptionToException->     fromException = frontendExceptionFromException--We can now catch a @MismatchedParentheses@ exception as-@MismatchedParentheses@, @SomeFrontendException@ or-@SomeCompilerException@, but not other types, e.g. @IOException@:--@-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))-Caught MismatchedParentheses-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))-Caught MismatchedParentheses-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))-Caught MismatchedParentheses-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))-*** Exception: MismatchedParentheses-@---}-class (Typeable e, Show e) => Exception e where-    toException   :: e -> SomeException-    fromException :: SomeException -> Maybe e--    toException = SomeException-    fromException (SomeException e) = cast e--    -- | Render this exception value in a human-friendly manner.-    ---    -- Default implementation: @'show'@.-    ---    -- @since 4.8.0.0-    displayException :: e -> String-    displayException = show---- | @since 3.0-instance Exception SomeException where-    toException se = se-    fromException = Just-    displayException (SomeException e) = displayException e+import GHC.Exception.Type  -- | Throw an exception.  Exceptions may be thrown from purely -- functional code, but may only be caught within the 'IO' monad.-throw :: Exception e => e -> a+throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.+         Exception e => e -> a throw e = raise# (toException e)  -- | This is thrown when the user calls 'error'. The first @String@ is the -- argument given to 'error', second @String@ is the location. data ErrorCall = ErrorCallWithLocation String String-    deriving (Eq, Ord)+    deriving ( Eq  -- ^ @since 4.7.0.0+             , Ord -- ^ @since 4.7.0.0+             )  pattern ErrorCall :: String -> ErrorCall pattern ErrorCall err <- ErrorCallWithLocation err _ where@@ -184,7 +68,8 @@ -- | @since 4.0.0.0 instance Show ErrorCall where   showsPrec _ (ErrorCallWithLocation err "") = showString err-  showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc)+  showsPrec _ (ErrorCallWithLocation err loc) =+      showString err . showChar '\n' . showString loc  errorCallException :: String -> SomeException errorCallException s = toException (ErrorCall s)@@ -230,31 +115,3 @@        : map (("  " ++) . prettyCallSite) stk   where     prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc---- |Arithmetic exceptions.-data ArithException-  = Overflow-  | Underflow-  | LossOfPrecision-  | DivideByZero-  | Denormal-  | RatioZeroDenominator -- ^ @since 4.6.0.0-  deriving (Eq, Ord)--divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException-divZeroException        = toException DivideByZero-overflowException       = toException Overflow-ratioZeroDenomException = toException RatioZeroDenominator-underflowException      = toException Underflow---- | @since 4.0.0.0-instance Exception ArithException---- | @since 4.0.0.0-instance Show ArithException where-  showsPrec _ Overflow        = showString "arithmetic overflow"-  showsPrec _ Underflow       = showString "arithmetic underflow"-  showsPrec _ LossOfPrecision = showString "loss of precision"-  showsPrec _ DivideByZero    = showString "divide by zero"-  showsPrec _ Denormal        = showString "denormal"-  showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"

@@ -24,17 +24,15 @@ to get a visibly-bottom value. -} -module GHC.Exception ( SomeException, errorCallException,-                       errorCallWithCallStackException,-                       divZeroException, overflowException, ratioZeroDenomException,-                       underflowException-    ) where+module GHC.Exception+  ( module GHC.Exception.Type+  , errorCallException+  , errorCallWithCallStackException+  ) where++import {-# SOURCE #-} GHC.Exception.Type import GHC.Types ( Char ) import GHC.Stack.Types ( CallStack )--data SomeException-divZeroException, overflowException, ratioZeroDenomException  :: SomeException-underflowException :: SomeException  errorCallException :: [Char] -> SomeException errorCallWithCallStackException :: [Char] -> CallStack -> SomeException

@@ -0,0 +1,183 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , ExistentialQuantification+           , MagicHash+           , RecordWildCards+           , PatternSynonyms+  #-}+{-# OPTIONS_HADDOCK hide #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Exception.Type+-- Copyright   :  (c) The University of Glasgow, 1998-2002+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- Exceptions and exception-handling functions.+--+-----------------------------------------------------------------------------++module GHC.Exception.Type+       ( Exception(..)    -- Class+       , SomeException(..), ArithException(..)+       , divZeroException, overflowException, ratioZeroDenomException+       , underflowException+       ) where++import Data.Maybe+import Data.Typeable (Typeable, cast)+   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception+import GHC.Base+import GHC.Show++{- |+The @SomeException@ type is the root of the exception type hierarchy.+When an exception of type @e@ is thrown, behind the scenes it is+encapsulated in a @SomeException@.+-}+data SomeException = forall e . Exception e => SomeException e++-- | @since 3.0+instance Show SomeException where+    showsPrec p (SomeException e) = showsPrec p e++{- |+Any type that you wish to throw or catch as an exception must be an+instance of the @Exception@ class. The simplest case is a new exception+type directly below the root:++> data MyException = ThisException | ThatException+>     deriving Show+>+> instance Exception MyException++The default method definitions in the @Exception@ class do what we need+in this case. You can now throw and catch @ThisException@ and+@ThatException@ as exceptions:++@+*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))+Caught ThisException+@++In more complicated examples, you may wish to define a whole hierarchy+of exceptions:++> ---------------------------------------------------------------------+> -- Make the root exception type for all the exceptions in a compiler+>+> data SomeCompilerException = forall e . Exception e => SomeCompilerException e+>+> instance Show SomeCompilerException where+>     show (SomeCompilerException e) = show e+>+> instance Exception SomeCompilerException+>+> compilerExceptionToException :: Exception e => e -> SomeException+> compilerExceptionToException = toException . SomeCompilerException+>+> compilerExceptionFromException :: Exception e => SomeException -> Maybe e+> compilerExceptionFromException x = do+>     SomeCompilerException a <- fromException x+>     cast a+>+> ---------------------------------------------------------------------+> -- Make a subhierarchy for exceptions in the frontend of the compiler+>+> data SomeFrontendException = forall e . Exception e => SomeFrontendException e+>+> instance Show SomeFrontendException where+>     show (SomeFrontendException e) = show e+>+> instance Exception SomeFrontendException where+>     toException = compilerExceptionToException+>     fromException = compilerExceptionFromException+>+> frontendExceptionToException :: Exception e => e -> SomeException+> frontendExceptionToException = toException . SomeFrontendException+>+> frontendExceptionFromException :: Exception e => SomeException -> Maybe e+> frontendExceptionFromException x = do+>     SomeFrontendException a <- fromException x+>     cast a+>+> ---------------------------------------------------------------------+> -- Make an exception type for a particular frontend compiler exception+>+> data MismatchedParentheses = MismatchedParentheses+>     deriving Show+>+> instance Exception MismatchedParentheses where+>     toException   = frontendExceptionToException+>     fromException = frontendExceptionFromException++We can now catch a @MismatchedParentheses@ exception as+@MismatchedParentheses@, @SomeFrontendException@ or+@SomeCompilerException@, but not other types, e.g. @IOException@:++@+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))+Caught MismatchedParentheses+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))+Caught MismatchedParentheses+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))+Caught MismatchedParentheses+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))+*** Exception: MismatchedParentheses+@++-}+class (Typeable e, Show e) => Exception e where+    toException   :: e -> SomeException+    fromException :: SomeException -> Maybe e++    toException = SomeException+    fromException (SomeException e) = cast e++    -- | Render this exception value in a human-friendly manner.+    --+    -- Default implementation: @'show'@.+    --+    -- @since 4.8.0.0+    displayException :: e -> String+    displayException = show++-- | @since 3.0+instance Exception SomeException where+    toException se = se+    fromException = Just+    displayException (SomeException e) = displayException e++-- |Arithmetic exceptions.+data ArithException+  = Overflow+  | Underflow+  | LossOfPrecision+  | DivideByZero+  | Denormal+  | RatioZeroDenominator -- ^ @since 4.6.0.0+  deriving ( Eq  -- ^ @since 3.0+           , Ord -- ^ @since 3.0+           )++divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException+divZeroException        = toException DivideByZero+overflowException       = toException Overflow+ratioZeroDenomException = toException RatioZeroDenominator+underflowException      = toException Underflow++-- | @since 4.0.0.0+instance Exception ArithException++-- | @since 4.0.0.0+instance Show ArithException where+  showsPrec _ Overflow        = showString "arithmetic overflow"+  showsPrec _ Underflow       = showString "arithmetic underflow"+  showsPrec _ LossOfPrecision = showString "loss of precision"+  showsPrec _ DivideByZero    = showString "divide by zero"+  showsPrec _ Denormal        = showString "denormal"+  showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"

@@ -0,0 +1,16 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}++module GHC.Exception.Type+  ( SomeException+  , divZeroException+  , overflowException+  , ratioZeroDenomException+  , underflowException+  ) where++import GHC.Types ()++data SomeException+divZeroException, overflowException,+  ratioZeroDenomException, underflowException :: SomeException

@@ -154,7 +154,9 @@ -- entire ghc package at runtime  data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr-                deriving( Data, Eq )+                deriving ( Data -- ^ @since 4.3.0.0+                         , Eq   -- ^ @since 4.3.0.0+                         )   {- **********************************************************************

@@ -22,7 +22,9 @@ -- Using 128-bit MD5 fingerprints for now.  data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64-  deriving (Eq, Ord)+  deriving ( Eq  -- ^ @since 4.4.0.0+           , Ord -- ^ @since 4.4.0.0+           )  -- | @since 4.7.0.0 instance Show Fingerprint where

@@ -64,6 +64,13 @@ ------------------------------------------------------------------------  -- | Trigonometric and hyperbolic functions and related functions.+--+-- The Haskell Report defines no laws for 'Floating'. However, '(+)', '(*)'+-- and 'exp' are customarily expected to define an exponential field and have+-- the following properties:+--+-- * @exp (a + b)@ = @exp a * exp b+-- * @exp (fromInteger 0)@ = @fromInteger 1@ class  (Fractional a) => Floating a  where     pi                  :: a     exp, log, sqrt      :: a -> a@@ -245,7 +252,18 @@ ------------------------------------------------------------------------  -- | @since 2.01-instance  Num Float  where+-- Note that due to the presence of @NaN@, not all elements of 'Float' have an+-- additive inverse.+--+-- >>> 0/0 + (negate 0/0 :: Float)+-- NaN+--+-- Also note that due to the presence of -0, `Float`'s 'Num' instance doesn't+-- have an additive identity+--+-- >>> 0 + (-0 :: Float)+-- 0.0+instance Num Float where     (+)         x y     =  plusFloat x y     (-)         x y     =  minusFloat x y     negate      x       =  negateFloat x@@ -272,6 +290,11 @@                     smallInteger m# :% shiftLInteger 1 (negateInt# e#)  -- | @since 2.01+-- Note that due to the presence of @NaN@, not all elements of 'Float' have an+-- multiplicative inverse.+--+-- >>> 0/0 * (recip 0/0 :: Float)+-- NaN instance  Fractional Float  where     (/) x y             =  divideFloat x y     {-# INLINE fromRational #-}@@ -367,7 +390,11 @@     (**) x y            =  powerFloat x y     logBase x y         =  log y / log x -    asinh x = log (x + sqrt (1.0+x*x))+    asinh x+      | x > huge   = log 2 + log x+      | x < 0      = -asinh (-x)+      | otherwise  = log (x + sqrt (1 + x*x))+     where huge = 1e10     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))     atanh x = 0.5 * log ((1.0+x) / (1.0-x)) @@ -425,6 +452,17 @@ ------------------------------------------------------------------------  -- | @since 2.01+-- Note that due to the presence of @NaN@, not all elements of 'Double' have an+-- additive inverse.+--+-- >>> 0/0 + (negate 0/0 :: Double)+-- NaN+--+-- Also note that due to the presence of -0, `Double`'s 'Num' instance doesn't+-- have an additive identity+--+-- >>> 0 + (-0 :: Double)+-- 0.0 instance  Num Double  where     (+)         x y     =  plusDouble x y     (-)         x y     =  minusDouble x y@@ -454,6 +492,11 @@                 m :% shiftLInteger 1 (negateInt# e#)  -- | @since 2.01+-- Note that due to the presence of @NaN@, not all elements of 'Double' have an+-- multiplicative inverse.+--+-- >>> 0/0 * (recip 0/0 :: Double)+-- NaN instance  Fractional Double  where     (/) x y             =  divideDouble x y     {-# INLINE fromRational #-}@@ -492,7 +535,11 @@     (**) x y            =  powerDouble x y     logBase x y         =  log y / log x -    asinh x = log (x + sqrt (1.0+x*x))+    asinh x+      | x > huge   = log 2 + log x+      | x < 0      = -asinh (-x)+      | otherwise  = log (x + sqrt (1 + x*x))+     where huge = 1e20     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))     atanh x = 0.5 * log ((1.0+x) / (1.0-x)) @@ -682,6 +729,18 @@           [d]     -> d : ".0e" ++ show_e'           (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'           []      -> errorWithoutStackTrace "formatRealFloat/doFmt/FFExponent: []"+       Just d | d <= 0 ->+        -- handle this case specifically since we need to omit the+        -- decimal point as well (#15115).+        -- Note that this handles negative precisions as well for consistency+        -- (see #15509).+        case is of+          [0] -> "0e0"+          _ ->+           let+             (ei,is') = roundTo base 1 is+             n:_ = map intToDigit (if ei > 0 then init is' else is')+           in n : 'e' : show (e-1+ei)        Just dec ->         let dec' = max dec 1 in         case is of

@@ -15,7 +15,6 @@ {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE Trustworthy                #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeInType                 #-} {-# LANGUAGE TypeOperators              #-} {-# LANGUAGE TypeSynonymInstances       #-} {-# LANGUAGE UndecidableInstances       #-}@@ -732,6 +731,7 @@ -- We use some base types import Data.Either ( Either (..) ) import Data.Maybe  ( Maybe(..), fromMaybe )+import Data.Ord    ( Down(..) ) import GHC.Integer ( Integer, integerToInt ) import GHC.Prim    ( Addr#, Char#, Double#, Float#, Int#, Word# ) import GHC.Ptr     ( Ptr )@@ -740,7 +740,8 @@ -- Needed for instances import GHC.Arr     ( Ix ) import GHC.Base    ( Alternative(..), Applicative(..), Functor(..)-                   , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce )+                   , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce+                   , Semigroup(..), Monoid(..) ) import GHC.Classes ( Eq(..), Ord(..) ) import GHC.Enum    ( Bounded, Enum ) import GHC.Read    ( Read(..) )@@ -765,15 +766,21 @@            , Generic1 -- ^ @since 4.9.0.0            ) +-- | @since 4.12.0.0+instance Semigroup (V1 p) where+  v <> _ = v+ -- | Unit: used for constructors without arguments data U1 (p :: k) = U1-  deriving (Generic, Generic1)+  deriving ( Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Eq (U1 p) where   _ == _ = True --- | @since 4.9.0.0+-- | @since 4.7.0.0 instance Ord (U1 p) where   compare _ _ = EQ @@ -806,9 +813,24 @@ -- | @since 4.9.0.0 instance MonadPlus U1 +-- | @since 4.12.0.0+instance Semigroup (U1 p) where+  _ <> _ = U1++-- | @since 4.12.0.0+instance Monoid (U1 p) where+  mempty = U1+ -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p }-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance Applicative Par1 where@@ -820,10 +842,23 @@ instance Monad Par1 where   Par1 x >>= f = f x +-- | @since 4.12.0.0+deriving instance Semigroup p => Semigroup (Par1 p)++-- | @since 4.12.0.0+deriving instance Monoid p => Monoid (Par1 p)+ -- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ -- is enabled)-newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+newtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p }+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 deriving instance Applicative f => Applicative (Rec1 f)@@ -838,10 +873,35 @@ -- | @since 4.9.0.0 deriving instance MonadPlus f => MonadPlus (Rec1 f) +-- | @since 4.12.0.0+deriving instance Semigroup (f p) => Semigroup (Rec1 f p)++-- | @since 4.12.0.0+deriving instance Monoid (f p) => Monoid (Rec1 f p)+ -- | Constants, additional parameters and recursion of kind @*@-newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+newtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c }+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           ) +-- | @since 4.12.0.0+instance Monoid c => Applicative (K1 i c) where+  pure _ = K1 mempty+  liftA2 = \_ -> coerce (mappend :: c -> c -> c)+  (<*>) = coerce (mappend :: c -> c -> c)++-- | @since 4.12.0.0+deriving instance Semigroup c => Semigroup (K1 i c p)++-- | @since 4.12.0.0+deriving instance Monoid c => Monoid (K1 i c p)+ -- | @since 4.9.0.0 deriving instance Applicative f => Applicative (M1 i c f) @@ -854,19 +914,47 @@ -- | @since 4.9.0.0 deriving instance MonadPlus f => MonadPlus (M1 i c f) +-- | @since 4.12.0.0+deriving instance Semigroup (f p) => Semigroup (M1 i c f p)++-- | @since 4.12.0.0+deriving instance Monoid (f p) => Monoid (M1 i c f p)+ -- | Meta-information (constructor names, etc.)-newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) =+    M1 { unM1 :: f p }+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Sums: encode choice between constructors infixr 5 :+:-data (:+:) (f :: k -> *) (g :: k -> *) (p :: k) = L1 (f p) | R1 (g p)-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p)+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Products: encode multiple arguments to constructors infixr 6 :*:-data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+data (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :*: g) where@@ -889,11 +977,26 @@ -- | @since 4.9.0.0 instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) +-- | @since 4.12.0.0+instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where+  (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2)++-- | @since 4.12.0.0+instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where+  mempty = mempty :*: mempty+ -- | Composition of functors infixr 7 :.:-newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =+newtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) =     Comp1 { unComp1 :: f (g p) }-  deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.7.0.0+           , Ord      -- ^ @since 4.7.0.0+           , Read     -- ^ @since 4.7.0.0+           , Show     -- ^ @since 4.7.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :.: g) where@@ -907,46 +1010,85 @@   (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) ::     forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a +-- | @since 4.12.0.0+deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p)++-- | @since 4.12.0.0+deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p)+ -- | Constants of unlifted kinds -- -- @since 4.9.0.0-data family URec (a :: *) (p :: k)+data family URec (a :: Type) (p :: k)  -- | Used for marking occurrences of 'Addr#' -- -- @since 4.9.0.0 data instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# }-  deriving (Eq, Ord, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Used for marking occurrences of 'Char#' -- -- @since 4.9.0.0 data instance URec Char (p :: k) = UChar { uChar# :: Char# }-  deriving (Eq, Ord, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Used for marking occurrences of 'Double#' -- -- @since 4.9.0.0 data instance URec Double (p :: k) = UDouble { uDouble# :: Double# }-  deriving (Eq, Ord, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Used for marking occurrences of 'Float#' -- -- @since 4.9.0.0 data instance URec Float (p :: k) = UFloat { uFloat# :: Float# }-  deriving (Eq, Ord, Show, Functor, Generic, Generic1)+  deriving ( Eq, Ord, Show+           , Functor  -- ^ @since 4.9.0.0+           , Generic+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Used for marking occurrences of 'Int#' -- -- @since 4.9.0.0 data instance URec Int (p :: k) = UInt { uInt# :: Int# }-  deriving (Eq, Ord, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Used for marking occurrences of 'Word#' -- -- @since 4.9.0.0 data instance URec Word (p :: k) = UWord { uWord# :: Word# }-  deriving (Eq, Ord, Show, Functor, Generic, Generic1)+  deriving ( Eq       -- ^ @since 4.9.0.0+           , Ord      -- ^ @since 4.9.0.0+           , Show     -- ^ @since 4.9.0.0+           , Functor  -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.9.0.0+           , Generic1 -- ^ @since 4.9.0.0+           )  -- | Type synonym for @'URec' 'Addr#'@ --@@ -977,10 +1119,10 @@ -- @since 4.9.0.0 type UWord   = URec Word --- | Tag for K1: recursion (of kind @*@)+-- | Tag for K1: recursion (of kind @Type@) data R --- | Type synonym for encoding recursion (of kind @*@)+-- | Type synonym for encoding recursion (of kind @Type@) type Rec0  = K1 R  -- | Tag for M1: datatype@@ -1002,17 +1144,17 @@ -- | Class for datatypes that represent datatypes class Datatype d where   -- | The name of the datatype (unqualified)-  datatypeName :: t d (f :: k -> *) (a :: k) -> [Char]+  datatypeName :: t d (f :: k -> Type) (a :: k) -> [Char]   -- | The fully-qualified name of the module where the type is declared-  moduleName   :: t d (f :: k -> *) (a :: k) -> [Char]+  moduleName   :: t d (f :: k -> Type) (a :: k) -> [Char]   -- | The package name of the module where the type is declared   --   -- @since 4.9.0.0-  packageName :: t d (f :: k -> *) (a :: k) -> [Char]+  packageName :: t d (f :: k -> Type) (a :: k) -> [Char]   -- | Marks if the datatype is actually a newtype   --   -- @since 4.7.0.0-  isNewtype    :: t d (f :: k -> *) (a :: k) -> Bool+  isNewtype    :: t d (f :: k -> Type) (a :: k) -> Bool   isNewtype _ = False  -- | @since 4.9.0.0@@ -1026,14 +1168,14 @@ -- | Class for datatypes that represent data constructors class Constructor c where   -- | The name of the constructor-  conName :: t c (f :: k -> *) (a :: k) -> [Char]+  conName :: t c (f :: k -> Type) (a :: k) -> [Char]    -- | The fixity of the constructor-  conFixity :: t c (f :: k -> *) (a :: k) -> Fixity+  conFixity :: t c (f :: k -> Type) (a :: k) -> Fixity   conFixity _ = Prefix    -- | Marks if this constructor is a record-  conIsRecord :: t c (f :: k -> *) (a :: k) -> Bool+  conIsRecord :: t c (f :: k -> Type) (a :: k) -> Bool   conIsRecord _ = False  -- | @since 4.9.0.0@@ -1046,7 +1188,12 @@ -- | Datatype to represent the fixity of a constructor. An infix -- | declaration directly corresponds to an application of 'Infix'. data Fixity = Prefix | Infix Associativity Int-  deriving (Eq, Show, Ord, Read, Generic)+  deriving ( Eq       -- ^ @since 4.6.0.0+           , Show     -- ^ @since 4.6.0.0+           , Ord      -- ^ @since 4.6.0.0+           , Read     -- ^ @since 4.6.0.0+           , Generic  -- ^ @since 4.7.0.0+           )  -- | This variant of 'Fixity' appears at the type level. --@@ -1062,7 +1209,15 @@ data Associativity = LeftAssociative                    | RightAssociative                    | NotAssociative-  deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)+  deriving ( Eq       -- ^ @since 4.6.0.0+           , Show     -- ^ @since 4.6.0.0+           , Ord      -- ^ @since 4.6.0.0+           , Read     -- ^ @since 4.6.0.0+           , Enum     -- ^ @since 4.9.0.0+           , Bounded  -- ^ @since 4.9.0.0+           , Ix       -- ^ @since 4.9.0.0+           , Generic  -- ^ @since 4.7.0.0+           )  -- | The unpackedness of a field as the user wrote it in the source code. For -- example, in the following data type:@@ -1080,7 +1235,15 @@ data SourceUnpackedness = NoSourceUnpackedness                         | SourceNoUnpack                         | SourceUnpack-  deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)+  deriving ( Eq      -- ^ @since 4.9.0.0+           , Show    -- ^ @since 4.9.0.0+           , Ord     -- ^ @since 4.9.0.0+           , Read    -- ^ @since 4.9.0.0+           , Enum    -- ^ @since 4.9.0.0+           , Bounded -- ^ @since 4.9.0.0+           , Ix      -- ^ @since 4.9.0.0+           , Generic -- ^ @since 4.9.0.0+           )  -- | The strictness of a field as the user wrote it in the source code. For -- example, in the following data type:@@ -1096,7 +1259,15 @@ data SourceStrictness = NoSourceStrictness                       | SourceLazy                       | SourceStrict-  deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)+  deriving ( Eq      -- ^ @since 4.9.0.0+           , Show    -- ^ @since 4.9.0.0+           , Ord     -- ^ @since 4.9.0.0+           , Read    -- ^ @since 4.9.0.0+           , Enum    -- ^ @since 4.9.0.0+           , Bounded -- ^ @since 4.9.0.0+           , Ix      -- ^ @since 4.9.0.0+           , Generic -- ^ @since 4.9.0.0+           )  -- | The strictness that GHC infers for a field during compilation. Whereas -- there are nine different combinations of 'SourceUnpackedness' and@@ -1123,24 +1294,32 @@ data DecidedStrictness = DecidedLazy                        | DecidedStrict                        | DecidedUnpack-  deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)+  deriving ( Eq      -- ^ @since 4.9.0.0+           , Show    -- ^ @since 4.9.0.0+           , Ord     -- ^ @since 4.9.0.0+           , Read    -- ^ @since 4.9.0.0+           , Enum    -- ^ @since 4.9.0.0+           , Bounded -- ^ @since 4.9.0.0+           , Ix      -- ^ @since 4.9.0.0+           , Generic -- ^ @since 4.9.0.0+           )  -- | Class for datatypes that represent records class Selector s where   -- | The name of the selector-  selName :: t s (f :: k -> *) (a :: k) -> [Char]+  selName :: t s (f :: k -> Type) (a :: k) -> [Char]   -- | The selector's unpackedness annotation (if any)   --   -- @since 4.9.0.0-  selSourceUnpackedness :: t s (f :: k -> *) (a :: k) -> SourceUnpackedness+  selSourceUnpackedness :: t s (f :: k -> Type) (a :: k) -> SourceUnpackedness   -- | The selector's strictness annotation (if any)   --   -- @since 4.9.0.0-  selSourceStrictness :: t s (f :: k -> *) (a :: k) -> SourceStrictness+  selSourceStrictness :: t s (f :: k -> Type) (a :: k) -> SourceStrictness   -- | The strictness that the compiler inferred for the selector   --   -- @since 4.9.0.0-  selDecidedStrictness :: t s (f :: k -> *) (a :: k) -> DecidedStrictness+  selDecidedStrictness :: t s (f :: k -> Type) (a :: k) -> DecidedStrictness  -- | @since 4.9.0.0 instance (SingI mn, SingI su, SingI ss, SingI ds)@@ -1161,7 +1340,7 @@ -- @ class Generic a where   -- | Generic representation type-  type Rep a :: * -> *+  type Rep a :: Type -> Type   -- | Convert from the datatype to its representation   from  :: a -> (Rep a) x   -- | Convert from the representation to the datatype@@ -1178,9 +1357,9 @@ -- 'from1' . 'to1' ≡ 'id' -- 'to1' . 'from1' ≡ 'id' -- @-class Generic1 (f :: k -> *) where+class Generic1 (f :: k -> Type) where   -- | Generic representation type-  type Rep1 f :: k -> *+  type Rep1 f :: k -> Type   -- | Convert from the datatype to its representation   from1  :: f a -> (Rep1 f) a   -- | Convert from the representation to the datatype@@ -1215,33 +1394,88 @@ -- Derived instances -------------------------------------------------------------------------------- +-- | @since 4.6.0.0 deriving instance Generic [a]++-- | @since 4.6.0.0 deriving instance Generic (NonEmpty a)++-- | @since 4.6.0.0 deriving instance Generic (Maybe a)++-- | @since 4.6.0.0 deriving instance Generic (Either a b)++-- | @since 4.6.0.0 deriving instance Generic Bool++-- | @since 4.6.0.0 deriving instance Generic Ordering++-- | @since 4.6.0.0 deriving instance Generic (Proxy t)++-- | @since 4.6.0.0 deriving instance Generic ()++-- | @since 4.6.0.0 deriving instance Generic ((,) a b)++-- | @since 4.6.0.0 deriving instance Generic ((,,) a b c)++-- | @since 4.6.0.0 deriving instance Generic ((,,,) a b c d)++-- | @since 4.6.0.0 deriving instance Generic ((,,,,) a b c d e)++-- | @since 4.6.0.0 deriving instance Generic ((,,,,,) a b c d e f)++-- | @since 4.6.0.0 deriving instance Generic ((,,,,,,) a b c d e f g) +-- | @since 4.12.0.0+deriving instance Generic (Down a)+++-- | @since 4.6.0.0 deriving instance Generic1 []++-- | @since 4.6.0.0 deriving instance Generic1 NonEmpty++-- | @since 4.6.0.0 deriving instance Generic1 Maybe++-- | @since 4.6.0.0 deriving instance Generic1 (Either a)++-- | @since 4.6.0.0 deriving instance Generic1 Proxy++-- | @since 4.6.0.0 deriving instance Generic1 ((,) a)++-- | @since 4.6.0.0 deriving instance Generic1 ((,,) a b)++-- | @since 4.6.0.0 deriving instance Generic1 ((,,,) a b c)++-- | @since 4.6.0.0 deriving instance Generic1 ((,,,,) a b c d)++-- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,) a b c d e)++-- | @since 4.6.0.0 deriving instance Generic1 ((,,,,,,) a b c d e f) +-- | @since 4.12.0.0+deriving instance Generic1 Down+ -------------------------------------------------------------------------------- -- Copied from the singletons package --------------------------------------------------------------------------------@@ -1263,7 +1497,7 @@ class SingKind k where   -- | Get a base type from a proxy for the promoted kind. For example,   -- @DemoteRep Bool@ will be the type @Bool@.-  type DemoteRep k :: *+  type DemoteRep k :: Type    -- | Convert a singleton to its unrefined version.   fromSing :: Sing (a :: k) -> DemoteRep k

@@ -279,7 +279,9 @@       -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted   | MaskedUninterruptible       -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted- deriving (Eq,Show)+ deriving ( Eq   -- ^ @since 4.3.0.0+          , Show -- ^ @since 4.3.0.0+          )  -- | Returns the 'MaskingState' for the current thread. getMaskingState :: IO MaskingState@@ -334,7 +336,7 @@ -- 'MaskedInterruptible' state, -- use @mask_ $ forkIO ...@.  This is particularly useful if you need -- to establish an exception handler in the forked thread before any--- asynchronous exceptions are received.  To create a a new thread in+-- asynchronous exceptions are received.  To create a new thread in -- an unmasked state use 'Control.Concurrent.forkIOWithUnmask'. -- mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b

@@ -4,6 +4,7 @@ module GHC.IO where  import GHC.Types+import GHC.Integer () -- see Note [Depend upon GHC.Integer] in libraries/base/GHC/Base.hs  failIO :: [Char] -> IO a mplusIO :: IO a -> IO a -> IO a

@@ -192,7 +192,8 @@ type CharBuffer = Buffer Char #endif -data BufferState = ReadBuffer | WriteBuffer deriving (Eq)+data BufferState = ReadBuffer | WriteBuffer+  deriving Eq -- ^ @since 4.2.0.0  withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f

@@ -154,7 +154,8 @@               -- read and write operations and may be seekable only               -- to positions of certain granularity (block-               -- aligned).-  deriving (Eq)+  deriving ( Eq -- ^ @since 4.2.0.0+           )  -- ----------------------------------------------------------------------------- -- SeekMode type@@ -166,5 +167,11 @@                         -- from the current position.   | SeekFromEnd         -- ^ the position of @hdl@ is set to offset @i@                         -- from the end of the file.-    deriving (Eq, Ord, Ix, Enum, Read, Show)+    deriving ( Eq   -- ^ @since 4.2.0.0+             , Ord  -- ^ @since 4.2.0.0+             , Ix   -- ^ @since 4.2.0.0+             , Enum -- ^ @since 4.2.0.0+             , Read -- ^ @since 4.2.0.0+             , Show -- ^ @since 4.2.0.0+             ) 

@@ -48,7 +48,8 @@   | RoundtripFailure        -- ^ Use the private-use escape mechanism to attempt to allow        -- illegal sequences to be roundtripped.-  deriving (Show)+  deriving ( Show -- ^ @since 4.4.0.0+           )        -- This will only work properly for those encodings which are        -- strict supersets of ASCII in the sense that valid ASCII data        -- is also valid in that encoding. This is not true for

@@ -129,5 +129,7 @@                     | InvalidSequence -- ^ Stopped because there are sufficient free elements in the output                                       -- to output at least one encoded ASCII character, but the input contains                                       -- an invalid or unrepresentable sequence-                    deriving (Eq, Show)+                    deriving ( Eq   -- ^ @since 4.4.0.0+                             , Show -- ^ @since 4.4.0.0+                             ) 

@@ -226,7 +226,9 @@         -- ^This exception is raised by default in the main thread of         -- the program when the user requests to terminate the program         -- via the usual mechanism(s) (e.g. Control-C in the console).-  deriving (Eq, Ord)+  deriving ( Eq  -- ^ @since 4.2.0.0+           , Ord -- ^ @since 4.2.0.0+           )  -- | @since 4.7.0.0 instance Exception AsyncException where@@ -241,7 +243,9 @@   | UndefinedElement    String         -- ^An attempt was made to evaluate an element of an         -- array that had not been initialized.-  deriving (Eq, Ord)+  deriving ( Eq  -- ^ @since 4.2.0.0+           , Ord -- ^ @since 4.2.0.0+           )  -- | @since 4.1.0.0 instance Exception ArrayException

@@ -45,6 +45,7 @@ import GHC.IO.Exception #if defined(mingw32_HOST_OS) import GHC.Windows+import Data.Bool #endif  import Foreign@@ -401,7 +402,7 @@   return (toEnum (fromIntegral r))  foreign import ccall safe "fdReady"-  fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt+  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt  -- --------------------------------------------------------------------------- -- Terminal-related stuff@@ -562,7 +563,7 @@ isNonBlocking fd = fdIsNonBlocking fd /= 0  foreign import ccall unsafe "fdReady"-  unsafe_fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt+  unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt  #else /* mingw32_HOST_OS.... */ @@ -589,8 +590,10 @@     (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd)                         (fromIntegral len) (buf `plusPtr` off)     if l == (-1)-      then-        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)+      then let sock_errno = c_maperrno_func (fromIntegral rc)+               non_sock_errno = Errno (fromIntegral rc)+               errno = bool non_sock_errno sock_errno (fdIsSocket fd)+           in  ioError (errnoToIOError loc errno Nothing Nothing)       else return (fromIntegral l)  asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt@@ -598,34 +601,46 @@     (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)                   (fromIntegral len) (buf `plusPtr` off)     if l == (-1)-      then-        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)+      then let sock_errno = c_maperrno_func (fromIntegral rc)+               non_sock_errno = Errno (fromIntegral rc)+               errno = bool non_sock_errno sock_errno (fdIsSocket fd)+           in  ioError (errnoToIOError loc errno Nothing Nothing)       else return (fromIntegral l)  -- Blocking versions of the read/write primitives, for the threaded RTS  blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt blockingReadRawBufferPtr loc !fd !buf !off !len-  = throwErrnoIfMinus1Retry loc $-        if fdIsSocket fd-           then c_safe_recv (fdFD fd) (buf `plusPtr` off) (fromIntegral len) 0-           else c_safe_read (fdFD fd) (buf `plusPtr` off) (fromIntegral len)+  = throwErrnoIfMinus1Retry loc $ do+        let start_ptr = buf `plusPtr` off+            recv_ret = c_safe_recv (fdFD fd) start_ptr (fromIntegral len) 0+            read_ret = c_safe_read (fdFD fd) start_ptr (fromIntegral len)+        r <- bool read_ret recv_ret (fdIsSocket fd)+        when ((fdIsSocket fd) && (r == -1)) c_maperrno+        return r+      -- We trust read() to give us the correct errno but recv(), as a+      -- Winsock function, doesn't do the errno conversion so if the fd+      -- is for a socket, we do it from GetLastError() ourselves.  blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt blockingWriteRawBufferPtr loc !fd !buf !off !len-  = throwErrnoIfMinus1Retry loc $-        if fdIsSocket fd-           then c_safe_send  (fdFD fd) (buf `plusPtr` off) (fromIntegral len) 0-           else do-             r <- c_safe_write (fdFD fd) (buf `plusPtr` off) (fromIntegral len)-             when (r == -1) c_maperrno-             return r-      -- we don't trust write() to give us the correct errno, and+  = throwErrnoIfMinus1Retry loc $ do+        let start_ptr = buf `plusPtr` off+            send_ret = c_safe_send  (fdFD fd) start_ptr (fromIntegral len) 0+            write_ret = c_safe_write (fdFD fd) start_ptr (fromIntegral len)+        r <- bool write_ret send_ret (fdIsSocket fd)+        when (r == -1) c_maperrno+        return r+      -- We don't trust write() to give us the correct errno, and       -- instead do the errno conversion from GetLastError()-      -- ourselves.  The main reason is that we treat ERROR_NO_DATA+      -- ourselves. The main reason is that we treat ERROR_NO_DATA       -- (pipe is closing) as EPIPE, whereas write() returns EINVAL-      -- for this case.  We need to detect EPIPE correctly, because it+      -- for this case. We need to detect EPIPE correctly, because it       -- shouldn't be reported as an error when it happens on stdout.+      -- As for send()'s case, Winsock functions don't do errno+      -- conversion in any case so we have to do it ourselves.+      -- That means we're doing the errno conversion no matter if the+      -- fd is from a socket or not.  -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok.

@@ -63,8 +63,9 @@ -- | Exception thrown by 'hLock' on non-Windows platforms that don't support -- 'flock'. data FileLockingNotSupported = FileLockingNotSupported-  deriving Show+  deriving Show -- ^ @since 4.10.0.0 +-- ^ @since 4.10.0.0 instance Exception FileLockingNotSupported  -- | Indicates a mode in which a file should be locked.

@@ -537,6 +537,7 @@   -- overhead of a single putChar '\n', which is quite high now that we   -- have to encode eagerly. +{-# NOINLINE hPutStr' #-} hPutStr' :: Handle -> String -> Bool -> IO () hPutStr' handle str add_nl =   do

@@ -247,7 +247,11 @@                 -- ^ block-buffering should be enabled if possible.                 -- The size of the buffer is @n@ items if the argument                 -- is 'Just' @n@ and is otherwise implementation-dependent.-   deriving (Eq, Ord, Read, Show)+   deriving ( Eq   -- ^ @since 4.2.0.0+            , Ord  -- ^ @since 4.2.0.0+            , Read -- ^ @since 4.2.0.0+            , Show -- ^ @since 4.2.0.0+            )  {- [note Buffering Implementation]@@ -349,7 +353,11 @@ -- | The representation of a newline in the external file or stream. data Newline = LF    -- ^ '\n'              | CRLF  -- ^ '\r\n'-             deriving (Eq, Ord, Read, Show)+             deriving ( Eq   -- ^ @since 4.2.0.0+                      , Ord  -- ^ @since 4.3.0.0+                      , Read -- ^ @since 4.3.0.0+                      , Show -- ^ @since 4.3.0.0+                      )  -- | Specifies the translation, if any, of newline characters between -- internal Strings and the external file or stream.  Haskell Strings@@ -362,7 +370,11 @@                   outputNL :: Newline                     -- ^ the representation of newlines on output                  }-             deriving (Eq, Ord, Read, Show)+             deriving ( Eq   -- ^ @since 4.2.0.0+                      , Ord  -- ^ @since 4.3.0.0+                      , Read -- ^ @since 4.3.0.0+                      , Show -- ^ @since 4.3.0.0+                      )  -- | The native newline representation for the current platform: 'LF' -- on Unix systems, 'CRLF' on Windows.

@@ -26,5 +26,11 @@  -- | See 'System.IO.openFile' data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode-                    deriving (Eq, Ord, Ix, Enum, Read, Show)+                    deriving ( Eq   -- ^ @since 4.2.0.0+                             , Ord  -- ^ @since 4.2.0.0+                             , Ix   -- ^ @since 4.2.0.0+                             , Enum -- ^ @since 4.2.0.0+                             , Read -- ^ @since 4.2.0.0+                             , Show -- ^ @since 4.2.0.0+                             ) 

@@ -31,7 +31,7 @@  -- |A mutable variable in the 'IO' monad newtype IORef a = IORef (STRef RealWorld a)-  deriving Eq+  deriving Eq -- ^ @since 4.2.0.0   -- ^ Pointer equality.   --   -- @since 4.1.0.0

@@ -1082,6 +1082,36 @@     unsafeIndex (m,_) i = fromIntegral i - fromIntegral m     inRange (m,n) i     = m <= i && i <= n +-------------------------------------------------------------------------------++{-# RULES+"fromIntegral/Natural->Int8"+    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt+"fromIntegral/Natural->Int16"+    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt+"fromIntegral/Natural->Int32"+    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt+  #-}++{-# RULES+"fromIntegral/Int8->Natural"+    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)+"fromIntegral/Int16->Natural"+    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)+"fromIntegral/Int32->Natural"+    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)+  #-}++#if WORD_SIZE_IN_BITS == 64+-- these RULES are valid for Word==Word64 & Int==Int64+{-# RULES+"fromIntegral/Natural->Int64"+    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt+"fromIntegral/Int64->Natural"+    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)+  #-}+#endif+  {- Note [Order of tests] ~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -1,7 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# LANGUAGE BangPatterns #-}-{-# OPTIONS_HADDOCK hide #-}  ----------------------------------------------------------------------------- -- |@@ -947,12 +946,19 @@  ---------------------------------------------- -- | 'zip' takes two lists and returns a list of corresponding pairs.+--+-- > zip [1, 2] ['a', 'b'] = [(1, 'a'), (2, 'b')]+-- -- If one input list is short, excess elements of the longer list are--- discarded.+-- discarded: --+-- > zip [1] ['a', 'b'] = [(1, 'a')]+-- > zip [1, 2] ['a'] = [(1, 'a')]+-- -- 'zip' is right-lazy: -- -- > zip [] _|_ = []+-- > zip _|_ [] = _|_ {-# NOINLINE [1] zip #-} zip :: [a] -> [b] -> [(a,b)] zip []     _bs    = []

@@ -38,7 +38,7 @@ {- ^ An 'MVar' (pronounced \"em-var\") is a synchronising variable, used for communication between concurrent threads.  It can be thought of-as a a box, which may be empty or full.+as a box, which may be empty or full. -}  -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module

@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | Maybe type+module GHC.Maybe+   ( Maybe (..)+   )+where++import GHC.Integer () -- for build order+import GHC.Classes++default ()++-------------------------------------------------------------------------------+-- Maybe type+-------------------------------------------------------------------------------++-- | The 'Maybe' type encapsulates an optional value.  A value of type+-- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@),+-- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to+-- deal with errors or exceptional cases without resorting to drastic+-- measures such as 'error'.+--+-- The 'Maybe' type is also a monad.  It is a simple kind of error+-- monad, where all errors are represented by 'Nothing'.  A richer+-- error monad can be built using the 'Data.Either.Either' type.+--+data  Maybe a  =  Nothing | Just a+  deriving ( Eq  -- ^ @since 2.01+           , Ord -- ^ @since 2.01+           )

@@ -1,13 +1,9 @@+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE Unsafe #-} -{-# OPTIONS_HADDOCK not-home #-}- ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Natural@@ -34,38 +30,76 @@       -- (i.e. which constructors are available) depends on the       -- 'Integer' backend used!       Natural(..)+    , mkNatural     , isValidNatural+      -- * Arithmetic+    , plusNatural+    , minusNatural+    , minusNaturalMaybe+    , timesNatural+    , negateNatural+    , signumNatural+    , quotRemNatural+    , quotNatural+    , remNatural+#if defined(MIN_VERSION_integer_gmp)+    , gcdNatural+    , lcmNatural+#endif+      -- * Bits+    , andNatural+    , orNatural+    , xorNatural+    , bitNatural+    , testBitNatural+#if defined(MIN_VERSION_integer_gmp)+    , popCountNatural+#endif+    , shiftLNatural+    , shiftRNatural       -- * Conversions+    , naturalToInteger+    , naturalToWord+    , naturalToInt     , naturalFromInteger     , wordToNatural+    , intToNatural     , naturalToWordMaybe-      -- * Checked subtraction-    , minusNaturalMaybe+    , wordToNatural#+    , wordToNaturalBase       -- * Modular arithmetic     , powModNatural     ) where  #include "MachDeps.h" -import GHC.Arr-import GHC.Base-import {-# SOURCE #-} GHC.Exception (underflowException)+import GHC.Classes+import GHC.Maybe+import GHC.Types+import GHC.Prim+import {-# SOURCE #-} GHC.Exception.Type (underflowException, divZeroException) #if defined(MIN_VERSION_integer_gmp) import GHC.Integer.GMP.Internals-import Data.Word-import Data.Int+#else+import GHC.Integer #endif-import GHC.Num-import GHC.Real-import GHC.Read-import GHC.Show-import GHC.Enum-import GHC.List -import Data.Bits- default () +-- Most high-level operations need to be marked `NOINLINE` as+-- otherwise GHC doesn't recognize them and fails to apply constant+-- folding to `Natural`-typed expression.+--+-- To this end, the CPP hack below allows to write the pseudo-pragma+--+--   {-# CONSTANT_FOLDED plusNatural #-}+--+-- which is simply expanded into a+--+--   {-# NOINLINE plusNatural #-}+--+#define CONSTANT_FOLDED NOINLINE+ ------------------------------------------------------------------------------- -- Arithmetic underflow -------------------------------------------------------------------------------@@ -77,6 +111,10 @@ underflowError :: a underflowError = raise# underflowException +{-# NOINLINE divZeroError #-}+divZeroError :: a+divZeroError = raise# divZeroException+ ------------------------------------------------------------------------------- -- Natural type -------------------------------------------------------------------------------@@ -86,7 +124,7 @@  -- | Type representing arbitrary-precision non-negative integers. ----- >>> 2^20 :: Natural+-- >>> 2^100 :: Natural -- 1267650600228229401496703205376 -- -- Operations whose result would be negative @'throw' ('Underflow' :: 'ArithException')@,@@ -101,9 +139,13 @@                                               -- __Invariant__: 'NatJ#' is used                                               -- /iff/ value doesn't fit in                                               -- 'NatS#' constructor.-             deriving (Eq,Ord) -- NB: Order of constructors *must*+                               -- NB: Order of constructors *must*                                -- coincide with 'Ord' relation+             deriving ( Eq  -- ^ @since 4.8.0.0+                      , Ord -- ^ @since 4.8.0.0+                      ) + -- | Test whether all internal invariants are satisfied by 'Natural' value -- -- This operation is mostly useful for test-suites and/or code which@@ -113,107 +155,32 @@ isValidNatural :: Natural -> Bool isValidNatural (NatS# _)  = True isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)-                            && I# (sizeofBigNat# bn) > 0--{-# RULES-"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural-"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer-"fromIntegral/Natural->Word"     fromIntegral = naturalToWord-"fromIntegral/Natural->Word8"-    fromIntegral = (fromIntegral :: Word -> Word8)  . naturalToWord-"fromIntegral/Natural->Word16"-    fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord-"fromIntegral/Natural->Word32"-    fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord-"fromIntegral/Natural->Int8"-    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt-"fromIntegral/Natural->Int16"-    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt-"fromIntegral/Natural->Int32"-    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt-  #-}--{-# RULES-"fromIntegral/Word->Natural"     fromIntegral = wordToNatural-"fromIntegral/Word8->Natural"-    fromIntegral = wordToNatural . (fromIntegral :: Word8  -> Word)-"fromIntegral/Word16->Natural"-    fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)-"fromIntegral/Word32->Natural"-    fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)-"fromIntegral/Int->Natural"     fromIntegral = intToNatural-"fromIntegral/Int8->Natural"-    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)-"fromIntegral/Int16->Natural"-    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)-"fromIntegral/Int32->Natural"-    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)-  #-}--#if WORD_SIZE_IN_BITS == 64--- these RULES are valid for Word==Word64 & Int==Int64-{-# RULES-"fromIntegral/Natural->Word64"-    fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord-"fromIntegral/Natural->Int64"-    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt-"fromIntegral/Word64->Natural"-    fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)-"fromIntegral/Int64->Natural"-    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)-  #-}-#endif---- | @since 4.8.0.0-instance Show Natural where-    showsPrec p (NatS# w#)  = showsPrec p (W# w#)-    showsPrec p (NatJ# bn)  = showsPrec p (Jp# bn)---- | @since 4.8.0.0-instance Read Natural where-    readsPrec d = map (\(n, s) -> (fromInteger n, s))-                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d---- | @since 4.8.0.0-instance Num Natural where-    fromInteger          = naturalFromInteger--    (+) = plusNatural-    (*) = timesNatural-    (-) = minusNatural--    abs                  = id+                            && isTrue# (sizeofBigNat# bn ># 0#) -    signum (NatS# 0##)   = NatS# 0##-    signum _             = NatS# 1##+signumNatural :: Natural -> Natural+signumNatural (NatS# 0##) = NatS# 0##+signumNatural _           = NatS# 1##+{-# CONSTANT_FOLDED signumNatural #-} -    negate (NatS# 0##)   = NatS# 0##-    negate _             = underflowError+negateNatural :: Natural -> Natural+negateNatural (NatS# 0##) = NatS# 0##+negateNatural _           = underflowError+{-# CONSTANT_FOLDED negateNatural #-}  -- | @since 4.10.0.0 naturalFromInteger :: Integer -> Natural-naturalFromInteger (S# i#) | I# i# >= 0  = NatS# (int2Word# i#)-naturalFromInteger (Jp# bn)              = bigNatToNatural bn-naturalFromInteger _                     = underflowError-{-# INLINE naturalFromInteger #-}---- | @since 4.8.0.0-instance Real Natural where-    toRational (NatS# w)  = toRational (W# w)-    toRational (NatJ# bn) = toRational (Jp# bn)--#if OPTIMISE_INTEGER_GCD_LCM-{-# RULES-"gcd/Natural->Natural->Natural" gcd = gcdNatural-"lcm/Natural->Natural->Natural" lcm = lcmNatural-  #-}+naturalFromInteger (S# i#)+  | isTrue# (i# >=# 0#)     = NatS# (int2Word# i#)+naturalFromInteger (Jp# bn) = bigNatToNatural bn+naturalFromInteger _        = underflowError+{-# CONSTANT_FOLDED naturalFromInteger #-}  -- | Compute greatest common divisor. gcdNatural :: Natural -> Natural -> Natural gcdNatural (NatS# 0##) y       = y gcdNatural x       (NatS# 0##) = x-gcdNatural (NatS# 1##) _       = (NatS# 1##)-gcdNatural _       (NatS# 1##) = (NatS# 1##)+gcdNatural (NatS# 1##) _       = NatS# 1##+gcdNatural _       (NatS# 1##) = NatS# 1## gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y) gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y) gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)@@ -221,162 +188,107 @@  -- | compute least common multiplier. lcmNatural :: Natural -> Natural -> Natural-lcmNatural (NatS# 0##) _ = (NatS# 0##)-lcmNatural _ (NatS# 0##) = (NatS# 0##)+lcmNatural (NatS# 0##) _ = NatS# 0##+lcmNatural _ (NatS# 0##) = NatS# 0## lcmNatural (NatS# 1##) y = y lcmNatural x (NatS# 1##) = x-lcmNatural x y           = (x `quot` (gcdNatural x y)) * y--#endif---- | @since 4.8.0.0-instance Enum Natural where-    succ n = n `plusNatural`  NatS# 1##-    pred n = n `minusNatural` NatS# 1##--    toEnum = intToNatural--    fromEnum (NatS# w) | i >= 0 = i-      where-        i = fromIntegral (W# w)-    fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"--    enumFrom x        = enumDeltaNatural      x (NatS# 1##)-    enumFromThen x y-      | x <= y        = enumDeltaNatural      x (y-x)-      | otherwise     = enumNegDeltaToNatural x (x-y) (NatS# 0##)--    enumFromTo x lim  = enumDeltaToNatural    x (NatS# 1##) lim-    enumFromThenTo x y lim-      | x <= y        = enumDeltaToNatural    x (y-x) lim-      | otherwise     = enumNegDeltaToNatural x (x-y) lim--------------------------------------------------------------------------------- Helpers for 'Enum Natural'; TODO: optimise & make fusion work--enumDeltaNatural :: Natural -> Natural -> [Natural]-enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d--enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]-enumDeltaToNatural x0 delta lim = go x0-  where-    go x | x > lim   = []-         | otherwise = x : go (x+delta)--enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]-enumNegDeltaToNatural x0 ndelta lim = go x0-  where-    go x | x < lim     = []-         | x >= ndelta = x : go (x-ndelta)-         | otherwise   = [x]+lcmNatural x y           = (x `quotNatural` (gcdNatural x y)) `timesNatural` y  ---------------------------------------------------------------------------- --- | @since 4.8.0.0-instance Integral Natural where-    toInteger (NatS# w)  = wordToInteger w-    toInteger (NatJ# bn) = Jp# bn--    divMod = quotRem-    div    = quot-    mod    = rem--    quotRem _ (NatS# 0##) = divZeroError-    quotRem n (NatS# 1##) = (n,NatS# 0##)-    quotRem n@(NatS# _) (NatJ# _) = (NatS# 0##, n)-    quotRem (NatS# n) (NatS# d) = case quotRem (W# n) (W# d) of-        (q,r) -> (wordToNatural q, wordToNatural r)-    quotRem (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of-        (# q,r #) -> (bigNatToNatural q, NatS# r)-    quotRem (NatJ# n) (NatJ# d) = case quotRemBigNat n d of-        (# q,r #) -> (bigNatToNatural q, bigNatToNatural r)--    quot _       (NatS# 0##) = divZeroError-    quot n       (NatS# 1##) = n-    quot (NatS# _) (NatJ# _) = NatS# 0##-    quot (NatS# n) (NatS# d) = wordToNatural (quot (W# n) (W# d))-    quot (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)-    quot (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)--    rem _         (NatS# 0##) = divZeroError-    rem _         (NatS# 1##) = NatS# 0##-    rem n@(NatS# _) (NatJ# _) = n-    rem   (NatS# n) (NatS# d) = wordToNatural (rem (W# n) (W# d))-    rem   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)-    rem   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)---- | @since 4.8.0.0-instance Ix Natural where-    range (m,n) = [m..n]-    inRange (m,n) i = m <= i && i <= n-    unsafeIndex (m,_) i = fromIntegral (i-m)-    index b i | inRange b i = unsafeIndex b i-              | otherwise   = indexError b i "Natural"----- | @since 4.8.0.0-instance Bits Natural where-    NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m)-    NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m))-    NatJ# n .&. NatS# m = wordToNatural (W# (bigNatToWord n) .&. W# m)-    NatJ# n .&. NatJ# m = bigNatToNatural (andBigNat n m)--    NatS# n .|. NatS# m = wordToNatural (W# n .|. W# m)-    NatS# n .|. NatJ# m = NatJ# (orBigNat (wordToBigNat n) m)-    NatJ# n .|. NatS# m = NatJ# (orBigNat n (wordToBigNat m))-    NatJ# n .|. NatJ# m = NatJ# (orBigNat n m)--    NatS# n `xor` NatS# m = wordToNatural (W# n `xor` W# m)-    NatS# n `xor` NatJ# m = NatJ# (xorBigNat (wordToBigNat n) m)-    NatJ# n `xor` NatS# m = NatJ# (xorBigNat n (wordToBigNat m))-    NatJ# n `xor` NatJ# m = bigNatToNatural (xorBigNat n m)--    complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"+quotRemNatural :: Natural -> Natural -> (Natural, Natural)+quotRemNatural _ (NatS# 0##) = divZeroError+quotRemNatural n (NatS# 1##) = (n,NatS# 0##)+quotRemNatural n@(NatS# _) (NatJ# _) = (NatS# 0##, n)+quotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of+    (# q, r #) -> (NatS# q, NatS# r)+quotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of+    (# q, r #) -> (bigNatToNatural q, NatS# r)+quotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of+    (# q, r #) -> (bigNatToNatural q, bigNatToNatural r)+{-# CONSTANT_FOLDED quotRemNatural #-} -    bitSizeMaybe _ = Nothing-    bitSize = errorWithoutStackTrace "Natural: bitSize"-    isSigned _ = False+quotNatural :: Natural -> Natural -> Natural+quotNatural _       (NatS# 0##) = divZeroError+quotNatural n       (NatS# 1##) = n+quotNatural (NatS# _) (NatJ# _) = NatS# 0##+quotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d)+quotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)+quotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)+{-# CONSTANT_FOLDED quotNatural #-} -    bit i@(I# i#) | i < finiteBitSize (0::Word) = wordToNatural (bit i)-                  | otherwise                   = NatJ# (bitBigNat i#)+remNatural :: Natural -> Natural -> Natural+remNatural _         (NatS# 0##) = divZeroError+remNatural _         (NatS# 1##) = NatS# 0##+remNatural n@(NatS# _) (NatJ# _) = n+remNatural   (NatS# n) (NatS# d) = NatS# (remWord# n d)+remNatural   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)+remNatural   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)+{-# CONSTANT_FOLDED remNatural #-} -    testBit (NatS# w) i = testBit (W# w) i-    testBit (NatJ# bn) (I# i#) = testBitBigNat bn i#+-- | @since 4.X.0.0+naturalToInteger :: Natural -> Integer+naturalToInteger (NatS# w)  = wordToInteger w+naturalToInteger (NatJ# bn) = Jp# bn+{-# CONSTANT_FOLDED naturalToInteger #-} -    clearBit n@(NatS# w#) i-        | i < finiteBitSize (0::Word) = let !(W# w2#) = clearBit (W# w#) i in NatS# w2#-        | otherwise                   = n-    clearBit (NatJ# bn) (I# i#) = bigNatToNatural (clearBitBigNat bn i#)+andNatural :: Natural -> Natural -> Natural+andNatural (NatS# n) (NatS# m) = NatS# (n `and#` m)+andNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m)+andNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m)+andNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m)+{-# CONSTANT_FOLDED andNatural #-} -    setBit (NatS# w#) i@(I# i#)-        | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2#-        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)-    setBit (NatJ# bn) (I# i#) = bigNatToNatural (setBitBigNat bn i#)+orNatural :: Natural -> Natural -> Natural+orNatural (NatS# n) (NatS# m) = NatS# (n `or#` m)+orNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m)+orNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m))+orNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m)+{-# CONSTANT_FOLDED orNatural #-} -    complementBit (NatS# w#) i@(I# i#)-        | i < finiteBitSize (0::Word) = let !(W# w2#) = complementBit (W# w#) i in NatS# w2#-        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)-    complementBit (NatJ# bn) (I# i#) = bigNatToNatural (complementBitBigNat bn i#)+xorNatural :: Natural -> Natural -> Natural+xorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m)+xorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m)+xorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m))+xorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m)+{-# CONSTANT_FOLDED xorNatural #-} -    shiftL n           0 = n-    shiftL (NatS# 0##) _ = NatS# 0##-    shiftL (NatS# 1##) i = bit i-    shiftL (NatS# w) (I# i#)-        = bigNatToNatural $ shiftLBigNat (wordToBigNat w) i#-    shiftL (NatJ# bn) (I# i#)-        = bigNatToNatural $ shiftLBigNat bn i#+bitNatural :: Int# -> Natural+bitNatural i#+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)+  | True                               = NatJ# (bitBigNat i#)+{-# CONSTANT_FOLDED bitNatural #-} -    shiftR n          0       = n-    shiftR (NatS# w)  i       = wordToNatural $ shiftR (W# w) i-    shiftR (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)+testBitNatural :: Natural -> Int -> Bool+testBitNatural (NatS# w) (I# i#)+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) =+      isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##)+  | True                               = False+testBitNatural (NatJ# bn) (I# i#)      = testBitBigNat bn i#+{-# CONSTANT_FOLDED testBitNatural #-} -    rotateL = shiftL-    rotateR = shiftR+popCountNatural :: Natural -> Int+popCountNatural (NatS# w)  = I# (word2Int# (popCnt# w))+popCountNatural (NatJ# bn) = I# (popCountBigNat bn)+{-# CONSTANT_FOLDED popCountNatural #-} -    popCount (NatS# w)  = popCount (W# w)-    popCount (NatJ# bn) = I# (popCountBigNat bn)+shiftLNatural :: Natural -> Int -> Natural+shiftLNatural n           (I# 0#) = n+shiftLNatural (NatS# 0##) _       = NatS# 0##+shiftLNatural (NatS# 1##) (I# i#) = bitNatural i#+shiftLNatural (NatS# w) (I# i#)+    = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#)+shiftLNatural (NatJ# bn) (I# i#)+    = bigNatToNatural (shiftLBigNat bn i#)+{-# CONSTANT_FOLDED shiftLNatural #-} -    zeroBits = NatS# 0##+shiftRNatural :: Natural -> Int -> Natural+shiftRNatural n          (I# 0#) = n+shiftRNatural (NatS# w)  (I# i#)+      | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = NatS# 0##+      | True = NatS# (w `uncheckedShiftRL#` i#)+shiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)+{-# CONSTANT_FOLDED shiftRNatural #-}  ---------------------------------------------------------------------------- @@ -391,6 +303,7 @@ plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x) plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y) plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat     x y)+{-# CONSTANT_FOLDED plusNatural #-}  -- | 'Natural' multiplication timesNatural :: Natural -> Natural -> Natural@@ -401,10 +314,11 @@ timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of     (# 0##, 0## #) -> NatS# 0##     (# 0##, xy  #) -> NatS# xy-    (# h  , l   #) -> NatJ# $ wordToBigNat2 h l-timesNatural (NatS# x) (NatJ# y) = NatJ# $ timesBigNatWord y x-timesNatural (NatJ# x) (NatS# y) = NatJ# $ timesBigNatWord x y-timesNatural (NatJ# x) (NatJ# y) = NatJ# $ timesBigNat     x y+    (# h  , l   #) -> NatJ# (wordToBigNat2 h l)+timesNatural (NatS# x) (NatJ# y) = NatJ# (timesBigNatWord y x)+timesNatural (NatJ# x) (NatS# y) = NatJ# (timesBigNatWord x y)+timesNatural (NatJ# x) (NatJ# y) = NatJ# (timesBigNat     x y)+{-# CONSTANT_FOLDED timesNatural #-}  -- | 'Natural' subtraction. May @'throw' 'Underflow'@. minusNatural :: Natural -> Natural -> Natural@@ -414,9 +328,10 @@     _           -> underflowError minusNatural (NatS# _) (NatJ# _) = underflowError minusNatural (NatJ# x) (NatS# y)-    = bigNatToNatural $ minusBigNatWord x y+    = bigNatToNatural (minusBigNatWord x y) minusNatural (NatJ# x) (NatJ# y)-    = bigNatToNatural $ minusBigNat     x y+    = bigNatToNatural (minusBigNat     x y)+{-# CONSTANT_FOLDED minusNatural #-}  -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. --@@ -426,13 +341,12 @@ minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of     (# l, 0# #) -> Just (NatS# l)     _           -> Nothing-  where minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing minusNaturalMaybe (NatJ# x) (NatS# y)-    = Just $ bigNatToNatural $ minusBigNatWord x y+    = Just (bigNatToNatural (minusBigNatWord x y)) minusNaturalMaybe (NatJ# x) (NatJ# y)   | isTrue# (isNullBigNat# res) = Nothing-  | otherwise = Just (bigNatToNatural res)+  | True                        = Just (bigNatToNatural res)   where     res = minusBigNat x y @@ -442,18 +356,12 @@ bigNatToNatural bn   | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)   | isTrue# (isNullBigNat# bn)        = underflowError-  | otherwise                         = NatJ# bn+  | True                              = NatJ# bn  naturalToBigNat :: Natural -> BigNat naturalToBigNat (NatS# w#) = wordToBigNat w# naturalToBigNat (NatJ# bn) = bn --- | Convert 'Int' to 'Natural'.--- Throws 'Underflow' when passed a negative 'Int'.-intToNatural :: Int -> Natural-intToNatural i | i<0 = underflowError-intToNatural (I# i#) = NatS# (int2Word# i#)- naturalToWord :: Natural -> Word naturalToWord (NatS# w#) = W# w# naturalToWord (NatJ# bn) = W# (bigNatToWord bn)@@ -462,6 +370,23 @@ naturalToInt (NatS# w#) = I# (word2Int# w#) naturalToInt (NatJ# bn) = I# (bigNatToInt bn) +----------------------------------------------------------------------------++-- | Convert a Word# into a Natural+--+-- Built-in rule ensures that applications of this function to literal Word# are+-- lifted into Natural literals.+wordToNatural# :: Word# -> Natural+wordToNatural# w# = NatS# w#+{-# CONSTANT_FOLDED wordToNatural# #-}++-- | Convert a Word# into a Natural+--+-- In base we can't use wordToNatural# as built-in rules transform some of them+-- into Natural literals. Use this function instead.+wordToNaturalBase :: Word# -> Natural+wordToNaturalBase w# = NatS# w#+ #else /* !defined(MIN_VERSION_integer_gmp) */ ---------------------------------------------------------------------------- -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package@@ -473,156 +398,141 @@ -- -- @since 4.8.0.0 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'-                deriving (Eq,Ord,Ix)+                  deriving (Eq,Ord) + -- | Test whether all internal invariants are satisfied by 'Natural' value -- -- This operation is mostly useful for test-suites and/or code which--- constructs 'Integer' values directly.+-- constructs 'Natural' values directly. -- -- @since 4.8.0.0 isValidNatural :: Natural -> Bool-isValidNatural (Natural i) = i >= 0---- | @since 4.8.0.0-instance Read Natural where-    readsPrec d = map (\(n, s) -> (Natural n, s))-                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d+isValidNatural (Natural i) = i >= wordToInteger 0## --- | @since 4.8.0.0-instance Show Natural where-    showsPrec d (Natural i) = showsPrec d i+-- | Convert a Word# into a Natural+--+-- Built-in rule ensures that applications of this function to literal Word# are+-- lifted into Natural literals.+wordToNatural# :: Word# -> Natural+wordToNatural# w## = Natural (wordToInteger w##)+{-# CONSTANT_FOLDED wordToNatural# #-} --- | @since 4.8.0.0-instance Num Natural where-  Natural n + Natural m = Natural (n + m)-  {-# INLINE (+) #-}-  Natural n * Natural m = Natural (n * m)-  {-# INLINE (*) #-}-  Natural n - Natural m | result < 0 = underflowError-                        | otherwise  = Natural result-    where result = n - m-  {-# INLINE (-) #-}-  abs (Natural n) = Natural n-  {-# INLINE abs #-}-  signum (Natural n) = Natural (signum n)-  {-# INLINE signum #-}-  fromInteger = naturalFromInteger-  {-# INLINE fromInteger #-}+-- | Convert a Word# into a Natural+--+-- In base we can't use wordToNatural# as built-in rules transform some of them+-- into Natural literals. Use this function instead.+wordToNaturalBase :: Word# -> Natural+wordToNaturalBase w## = Natural (wordToInteger w##)  -- | @since 4.10.0.0 naturalFromInteger :: Integer -> Natural naturalFromInteger n-  | n >= 0 = Natural n-  | otherwise = underflowError+  | n >= wordToInteger 0## = Natural n+  | True                   = underflowError {-# INLINE naturalFromInteger #-}  -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. -- -- @since 4.8.0.0 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural-minusNaturalMaybe x y-  | x >= y    = Just (x - y)-  | otherwise = Nothing+minusNaturalMaybe (Natural x) (Natural y)+  | x >= y  = Just (Natural (x `minusInteger` y))+  | True    = Nothing --- | @since 4.8.0.0-instance Bits Natural where-  Natural n .&. Natural m = Natural (n .&. m)-  {-# INLINE (.&.) #-}-  Natural n .|. Natural m = Natural (n .|. m)-  {-# INLINE (.|.) #-}-  xor (Natural n) (Natural m) = Natural (xor n m)-  {-# INLINE xor #-}-  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"-  {-# INLINE complement #-}-  shift (Natural n) = Natural . shift n-  {-# INLINE shift #-}-  rotate (Natural n) = Natural . rotate n-  {-# INLINE rotate #-}-  bit = Natural . bit-  {-# INLINE bit #-}-  setBit (Natural n) = Natural . setBit n-  {-# INLINE setBit #-}-  clearBit (Natural n) = Natural . clearBit n-  {-# INLINE clearBit #-}-  complementBit (Natural n) = Natural . complementBit n-  {-# INLINE complementBit #-}-  testBit (Natural n) = testBit n-  {-# INLINE testBit #-}-  bitSizeMaybe _ = Nothing-  {-# INLINE bitSizeMaybe #-}-  bitSize = errorWithoutStackTrace "Natural: bitSize"-  {-# INLINE bitSize #-}-  isSigned _ = False-  {-# INLINE isSigned #-}-  shiftL (Natural n) = Natural . shiftL n-  {-# INLINE shiftL #-}-  shiftR (Natural n) = Natural . shiftR n-  {-# INLINE shiftR #-}-  rotateL (Natural n) = Natural . rotateL n-  {-# INLINE rotateL #-}-  rotateR (Natural n) = Natural . rotateR n-  {-# INLINE rotateR #-}-  popCount (Natural n) = popCount n-  {-# INLINE popCount #-}-  zeroBits = Natural 0+shiftLNatural :: Natural -> Int -> Natural+shiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)+{-# CONSTANT_FOLDED shiftLNatural #-} --- | @since 4.8.0.0-instance Real Natural where-  toRational (Natural a) = toRational a-  {-# INLINE toRational #-}+shiftRNatural :: Natural -> Int -> Natural+shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)+{-# CONSTANT_FOLDED shiftRNatural #-} --- | @since 4.8.0.0-instance Enum Natural where-  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"-  pred (Natural n) = Natural (pred n)-  {-# INLINE pred #-}-  succ (Natural n) = Natural (succ n)-  {-# INLINE succ #-}-  fromEnum (Natural n) = fromEnum n-  {-# INLINE fromEnum #-}-  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"-           | otherwise = Natural (toEnum n)-  {-# INLINE toEnum #-}+plusNatural :: Natural -> Natural -> Natural+plusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)+{-# CONSTANT_FOLDED plusNatural #-} -  enumFrom     = coerce (enumFrom     :: Integer -> [Integer])-  enumFromThen x y-    | x <= y    = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y-    | otherwise = enumFromThenTo x y 0+minusNatural :: Natural -> Natural -> Natural+minusNatural (Natural x) (Natural y) = Natural (x `minusInteger` y)+{-# CONSTANT_FOLDED minusNatural #-} -  enumFromTo   = coerce (enumFromTo   :: Integer -> Integer -> [Integer])-  enumFromThenTo-    = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])+timesNatural :: Natural -> Natural -> Natural+timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)+{-# CONSTANT_FOLDED timesNatural #-} --- | @since 4.8.0.0-instance Integral Natural where-  quot (Natural a) (Natural b) = Natural (quot a b)-  {-# INLINE quot #-}-  rem (Natural a) (Natural b) = Natural (rem a b)-  {-# INLINE rem #-}-  div (Natural a) (Natural b) = Natural (div a b)-  {-# INLINE div #-}-  mod (Natural a) (Natural b) = Natural (mod a b)-  {-# INLINE mod #-}-  divMod (Natural a) (Natural b) = (Natural q, Natural r)-    where (q,r) = divMod a b-  {-# INLINE divMod #-}-  quotRem (Natural a) (Natural b) = (Natural q, Natural r)-    where (q,r) = quotRem a b-  {-# INLINE quotRem #-}-  toInteger (Natural a) = a-  {-# INLINE toInteger #-}+orNatural :: Natural -> Natural -> Natural+orNatural (Natural x) (Natural y) = Natural (x `orInteger` y)+{-# CONSTANT_FOLDED orNatural #-}++xorNatural :: Natural -> Natural -> Natural+xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)+{-# CONSTANT_FOLDED xorNatural #-}++andNatural :: Natural -> Natural -> Natural+andNatural (Natural x) (Natural y) = Natural (x `andInteger` y)+{-# CONSTANT_FOLDED andNatural #-}++naturalToInt :: Natural -> Int+naturalToInt (Natural i) = I# (integerToInt i)++naturalToWord :: Natural -> Word+naturalToWord (Natural i) = W# (integerToWord i)++naturalToInteger :: Natural -> Integer+naturalToInteger (Natural i) = i+{-# CONSTANT_FOLDED naturalToInteger #-}++testBitNatural :: Natural -> Int -> Bool+testBitNatural (Natural n) (I# i) = testBitInteger n i+{-# CONSTANT_FOLDED testBitNatural #-}++bitNatural :: Int# -> Natural+bitNatural i#+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)+  | True                               = Natural (1 `shiftLInteger` i#)+{-# CONSTANT_FOLDED bitNatural #-}++quotNatural :: Natural -> Natural -> Natural+quotNatural n@(Natural x) (Natural y)+   | y == wordToInteger 0## = divZeroError+   | y == wordToInteger 1## = n+   | True                   = Natural (x `quotInteger` y)+{-# CONSTANT_FOLDED quotNatural #-}++remNatural :: Natural -> Natural -> Natural+remNatural (Natural x) (Natural y)+   | y == wordToInteger 0## = divZeroError+   | y == wordToInteger 1## = wordToNaturalBase 0##+   | True                   = Natural (x `remInteger` y)+{-# CONSTANT_FOLDED remNatural #-}++quotRemNatural :: Natural -> Natural -> (Natural, Natural)+quotRemNatural n@(Natural x) (Natural y)+   | y == wordToInteger 0## = divZeroError+   | y == wordToInteger 1## = (n,wordToNaturalBase 0##)+   | True                   = case quotRemInteger x y of+      (# k, r #) -> (Natural k, Natural r)+{-# CONSTANT_FOLDED quotRemNatural #-}++signumNatural :: Natural -> Natural+signumNatural (Natural x)+   | x == wordToInteger 0## = wordToNaturalBase 0##+   | True                   = wordToNaturalBase 1##+{-# CONSTANT_FOLDED signumNatural #-}++negateNatural :: Natural -> Natural+negateNatural (Natural x)+   | x == wordToInteger 0## = wordToNaturalBase 0##+   | True                   = underflowError+{-# CONSTANT_FOLDED negateNatural #-}+ #endif  -- | Construct 'Natural' from 'Word' value. -- -- @since 4.8.0.0 wordToNatural :: Word -> Natural-#if defined(MIN_VERSION_integer_gmp)-wordToNatural (W# w#) = NatS# w#-#else-wordToNatural w = Natural (fromIntegral w)-#endif+wordToNatural (W# w#) = wordToNatural# w#  -- | Try downcasting 'Natural' to 'Word' value. -- Returns 'Nothing' if value doesn't fit in 'Word'.@@ -634,10 +544,10 @@ naturalToWordMaybe (NatJ# _)  = Nothing #else naturalToWordMaybe (Natural i)-  | i <= maxw  = Just (fromIntegral i)-  | otherwise  = Nothing+  | i < maxw  = Just (W# (integerToWord i))+  | True      = Nothing   where-    maxw = toInteger (maxBound :: Word)+    maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS# #endif  -- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to@@ -658,18 +568,38 @@   = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m) #else -- Portable reference fallback implementation-powModNatural _ _ 0 = divZeroError-powModNatural _ _ 1 = 0-powModNatural _ 0 _ = 1-powModNatural 0 _ _ = 0-powModNatural 1 _ _ = 1-powModNatural b0 e0 m = go b0 e0 1+powModNatural (Natural b0) (Natural e0) (Natural m)+   | m  == wordToInteger 0## = divZeroError+   | m  == wordToInteger 1## = wordToNaturalBase 0##+   | e0 == wordToInteger 0## = wordToNaturalBase 1##+   | b0 == wordToInteger 0## = wordToNaturalBase 0##+   | b0 == wordToInteger 1## = wordToNaturalBase 1##+   | True    = go b0 e0 (wordToInteger 1##)   where     go !b e !r-      | odd e     = go b' e' (r*b `mod` m)-      | e == 0    = r-      | otherwise = go b' e' r+      | e `testBitInteger` 0#  = go b' e' ((r `timesInteger` b) `modInteger` m)+      | e == wordToInteger 0## = naturalFromInteger r+      | True                   = go b' e' r       where-        b' = b*b `mod` m-        e' = e   `unsafeShiftR` 1 -- slightly faster than "e `div` 2"+        b' = (b `timesInteger` b) `modInteger` m+        e' = e `shiftRInteger` 1# -- slightly faster than "e `div` 2" #endif+++-- | Construct 'Natural' value from list of 'Word's.+--+-- This function is used by GHC for constructing 'Natural' literals.+mkNatural :: [Word]  -- ^ value expressed in 32 bit chunks, least+                     --   significant first+          -> Natural+mkNatural [] = wordToNaturalBase 0##+mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural`+                         shiftLNatural (mkNatural is') 32+{-# CONSTANT_FOLDED mkNatural #-}++-- | Convert 'Int' to 'Natural'.+-- Throws 'Underflow' when passed a negative 'Int'.+intToNatural :: Int -> Natural+intToNatural (I# i#)+  | isTrue# (i# <# 0#) = underflowError+  | True               = wordToNaturalBase (int2Word# i#)

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-}  -----------------------------------------------------------------------------@@ -16,10 +16,17 @@ -- ----------------------------------------------------------------------------- -module GHC.Num (module GHC.Num, module GHC.Integer) where +module GHC.Num (module GHC.Num, module GHC.Integer, module GHC.Natural) where++#include "MachDeps.h"+ import GHC.Base import GHC.Integer+import GHC.Natural+#if !defined(MIN_VERSION_integer_gmp)+import {-# SOURCE #-} GHC.Exception.Type (underflowException)+#endif  infixl 7  * infixl 6  +, -@@ -28,6 +35,23 @@                         -- and we shouldn't be using defaults anyway  -- | Basic numeric class.+--+-- The Haskell Report defines no laws for 'Num'. However, '(+)' and '(*)' are+-- customarily expected to define a ring and have the following properties:+--+-- [__Associativity of (+)__]: @(x + y) + z@ = @x + (y + z)@+-- [__Commutativity of (+)__]: @x + y@ = @y + x@+-- [__@fromInteger 0@ is the additive identity__]: @x + fromInteger 0@ = @x@+-- [__'negate' gives the additive inverse__]: @x + negate x@ = @fromInteger 0@+-- [__Associativity of (*)__]: @(x * y) * z@ = @x * (y * z)@+-- [__@fromInteger 1@ is the multiplicative identity__]:+-- @x * fromInteger 1@ = @x@ and @fromInteger 1 * x@ = @x@+-- [__Distributivity of (*) with respect to (+)__]:+-- @a * (b + c)@ = @(a * b) + (a * c)@ and @(b + c) * a@ = @(b * a) + (c * a)@+--+-- Note that it /isn't/ customarily expected that a type instance of both 'Num'+-- and 'Ord' implement an ordered ring. Indeed, in 'base' only 'Integer' and+-- 'Rational' do. class  Num a  where     {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-} @@ -100,3 +124,41 @@      abs = absInteger     signum = signumInteger++#if defined(MIN_VERSION_integer_gmp)+-- | Note that `Natural`'s 'Num' instance isn't a ring: no element but 0 has an+-- additive inverse. It is a semiring though.+--+-- @since 4.8.0.0+instance  Num Natural  where+    (+) = plusNatural+    (-) = minusNatural+    (*) = timesNatural+    negate      = negateNatural+    fromInteger = naturalFromInteger++    abs = id+    signum = signumNatural++#else+-- | Note that `Natural`'s 'Num' instance isn't a ring: no element but 0 has an+-- additive inverse. It is a semiring though.+--+-- @since 4.8.0.0+instance Num Natural where+  Natural n + Natural m = Natural (n + m)+  {-# INLINE (+) #-}+  Natural n * Natural m = Natural (n * m)+  {-# INLINE (*) #-}+  Natural n - Natural m+      | m > n     = raise# underflowException+      | otherwise = Natural (n - m)+  {-# INLINE (-) #-}+  abs (Natural n) = Natural n+  {-# INLINE abs #-}+  signum (Natural n) = Natural (signum n)+  {-# INLINE signum #-}+  fromInteger = naturalFromInteger+  {-# INLINE fromInteger #-}++#endif

@@ -1,37 +0,0 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ParallelArrays, MagicHash #-}-{-# OPTIONS_GHC -funbox-strict-fields #-}-{-# OPTIONS_HADDOCK hide #-}---------------------------------------------------------------------------------- |--- Module      :  GHC.PArr--- Copyright   :  (c) 2001-2011 The Data Parallel Haskell team--- License     :  see libraries/base/LICENSE--- --- Maintainer  :  cvs-ghc@haskell.org--- Stability   :  internal--- Portability :  non-portable (GHC Extensions)------ BIG UGLY HACK: The desugarer special cases this module.  Despite the uses of '-XParallelArrays',---                the desugarer does not load 'Data.Array.Parallel' into its global state. (Hence,---                the present module may not use any other piece of '-XParallelArray' syntax.)------                This will be cleaned up when we change the internal represention of '[::]' to not---                rely on a wired-in type constructor.--module GHC.PArr where--import GHC.Base---- Representation of parallel arrays------ Vanilla representation of parallel Haskell based on standard GHC arrays that is used if the--- vectorised is /not/ used.------ NB: This definition *must* be kept in sync with `TysWiredIn.parrTyCon'!----data [::] e = PArr !Int (Array# e)--type PArr = [::]   -- this synonym is to get access to '[::]' without using the special syntax

@@ -42,7 +42,10 @@  -- redundant role annotation checks that this doesn't change type role Ptr phantom-data Ptr a = Ptr Addr# deriving (Eq, Ord)+data Ptr a = Ptr Addr#+  deriving ( Eq  -- ^ @since 2.01+           , Ord -- ^ @since 2.01+           ) -- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an -- array of objects, which may be marshalled to or from Haskell values -- of type @a@.

@@ -66,7 +66,8 @@     | OneLineGCStats     | SummaryGCStats     | VerboseGCStats-    deriving (Show)+    deriving ( Show -- ^ @since 4.8.0.0+             )  -- | @since 4.8.0.0 instance Enum GiveGCStats where@@ -115,7 +116,8 @@     , allocLimitGrace       :: Word     , numa                  :: Bool     , numaMask              :: Word-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Parameters concerning context switching --@@ -123,7 +125,8 @@ data ConcFlags = ConcFlags     { ctxtSwitchTime  :: RtsTime     , ctxtSwitchTicks :: Int-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Miscellaneous parameters --@@ -135,9 +138,11 @@     , generateCrashDumpFile :: Bool     , generateStackTrace    :: Bool     , machineReadable       :: Bool+    , internalCounters      :: Bool     , linkerMemBase         :: Word       -- ^ address to ask the OS for memory for the linker, 0 ==> off-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Flags to control debugging output & extra checking in various -- subsystems.@@ -159,7 +164,8 @@     , squeeze     :: Bool -- ^ 'z' stack squeezing & lazy blackholing     , hpc         :: Bool -- ^ 'c' coverage     , sparks      :: Bool -- ^ 'r'-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Should the RTS produce a cost-center summary? --@@ -170,7 +176,8 @@     | CostCentresVerbose     | CostCentresAll     | CostCentresJSON-    deriving (Show)+    deriving ( Show -- ^ @since 4.8.0.0+             )  -- | @since 4.8.0.0 instance Enum DoCostCentres where@@ -194,7 +201,8 @@     { doCostCentres :: DoCostCentres     , profilerTicks :: Int     , msecsPerTick  :: Int-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | What sort of heap profile are we collecting? --@@ -208,7 +216,8 @@     | HeapByRetainer     | HeapByLDV     | HeapByClosureType-    deriving (Show)+    deriving ( Show -- ^ @since 4.8.0.0+             )  -- | @since 4.8.0.0 instance Enum DoHeapProfile where@@ -249,7 +258,8 @@     , ccsSelector              :: Maybe String     , retainerSelector         :: Maybe String     , bioSelector              :: Maybe String-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Is event tracing enabled? --@@ -258,7 +268,8 @@     = TraceNone      -- ^ no tracing     | TraceEventLog  -- ^ send tracing events to the event log     | TraceStderr    -- ^ send tracing events to @stderr@-    deriving (Show)+    deriving ( Show -- ^ @since 4.8.0.0+             )  -- | @since 4.8.0.0 instance Enum DoTrace where@@ -282,7 +293,8 @@     , sparksSampled  :: Bool -- ^ trace spark events by a sampled method     , sparksFull     :: Bool -- ^ trace spark events 100% accurately     , user           :: Bool -- ^ trace user events (emitted from Haskell code)-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Parameters pertaining to ticky-ticky profiler --@@ -290,7 +302,8 @@ data TickyFlags = TickyFlags     { showTickyStats :: Bool     , tickyFile      :: Maybe FilePath-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  -- | Parameters pertaining to parallelism --@@ -307,7 +320,8 @@     , parGcThreads :: Word32     , setAffinity :: Bool     }-    deriving (Show)+    deriving ( Show -- ^ @since 4.8.0.0+             )  -- | Parameters of the runtime system --@@ -322,7 +336,8 @@     , traceFlags      :: TraceFlags     , tickyFlags      :: TickyFlags     , parFlags        :: ParFlags-    } deriving (Show)+    } deriving ( Show -- ^ @since 4.8.0.0+               )  foreign import ccall "&RtsFlags" rtsFlagsPtr :: Ptr RTSFlags @@ -427,6 +442,8 @@                   (#{peek MISC_FLAGS, generate_stack_trace} ptr :: IO CBool))             <*> (toBool <$>                   (#{peek MISC_FLAGS, machineReadable} ptr :: IO CBool))+            <*> (toBool <$>+                  (#{peek MISC_FLAGS, internalCounters} ptr :: IO CBool))             <*> #{peek MISC_FLAGS, linkerMemBase} ptr  getDebugFlags :: IO DebugFlags

@@ -72,6 +72,7 @@ import GHC.Base import GHC.Arr import GHC.Word+import GHC.List (filter)   -- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with@@ -409,7 +410,7 @@  -- Note [Why readField] ----- Previousy, the code for automatically deriving Read instance (in+-- Previously, the code for automatically deriving Read instance (in -- typecheck/TcGenDeriv.hs) would generate inline code for parsing fields; -- this, however, turned out to produce massive amounts of intermediate code, -- and produced a considerable performance hit in the code generator.@@ -426,6 +427,7 @@ -- Simple instances of Read -------------------------------------------------------------- +-- | @since 2.01 deriving instance Read GeneralCategory  -- | @since 2.01@@ -475,6 +477,7 @@   readListPrec = readListPrecDefault   readList     = readListDefault +-- | @since 4.11.0.0 deriving instance Read a => Read (NonEmpty a)  --------------------------------------------------------------@@ -613,6 +616,19 @@   readPrec     = readNumber convertInt   readListPrec = readListPrecDefault   readList     = readListDefault+++#if defined(MIN_VERSION_integer_gmp)+-- | @since 4.8.0.0+instance Read Natural where+  readsPrec d = map (\(n, s) -> (fromInteger n, s))+                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d+#else+-- | @since 4.8.0.0+instance Read Natural where+    readsPrec d = map (\(n, s) -> (Natural n, s))+                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d+#endif  -- | @since 2.01 instance Read Float where

@@ -20,12 +20,16 @@  module GHC.Real where +#include "MachDeps.h"+ import GHC.Base import GHC.Num import GHC.List import GHC.Enum import GHC.Show-import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException, ratioZeroDenomException )+import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException+                                   , underflowException+                                   , ratioZeroDenomException )  #if defined(OPTIMISE_INTEGER_GCD_LCM) # if defined(MIN_VERSION_integer_gmp)@@ -61,12 +65,21 @@ overflowError :: a overflowError = raise# overflowException +{-# NOINLINE underflowError #-}+underflowError :: a+underflowError = raise# underflowException++ -------------------------------------------------------------- -- The Ratio and Rational types --------------------------------------------------------------  -- | Rational numbers, with numerator and denominator of some 'Integral' type.-data  Ratio a = !a :% !a  deriving (Eq)+--+-- Note that `Ratio`'s instances inherit the deficiencies from the type+-- parameter's. For example, @Ratio Natural@'s 'Num' instance has similar+-- problems to `Numeric.Natural.Natural`'s.+data  Ratio a = !a :% !a  deriving Eq -- ^ @since 2.01  -- | Arbitrary-precision rational numbers, represented as a ratio of -- two 'Integer' values.  A rational number may be constructed using@@ -122,6 +135,19 @@     toRational          ::  a -> Rational  -- | Integral numbers, supporting integer division.+--+-- The Haskell Report defines no laws for 'Integral'. However, 'Integral'+-- instances are customarily expected to define a Euclidean domain and have the+-- following properties for the 'div'/'mod' and 'quot'/'rem' pairs, given+-- suitable Euclidean functions @f@ and @g@:+--+-- * @x@ = @y * quot x y + rem x y@ with @rem x y@ = @fromInteger 0@ or+-- @g (rem x y)@ < @g y@+-- * @x@ = @y * div x y + mod x y@ with @mod x y@ = @fromInteger 0@ or+-- @f (mod x y)@ < @f y@+--+-- An example of a suitable Euclidean function, for `Integer`'s instance, is+-- 'abs'. class  (Real a, Enum a) => Integral a  where     -- | integer division truncated toward zero     quot                :: a -> a -> a@@ -155,6 +181,16 @@                            where qr@(q,r) = quotRem n d  -- | Fractional numbers, supporting real division.+--+-- The Haskell Report defines no laws for 'Fractional'. However, '(+)' and+-- '(*)' are customarily expected to define a division ring and have the+-- following properties:+--+-- [__'recip' gives the multiplicative inverse__]:+-- @x * recip x@ = @recip x * x@ = @fromInteger 1@+--+-- Note that it /isn't/ customarily expected that a type instance of+-- 'Fractional' implement a field. However, all instances in 'base' do. class  (Num a) => Fractional a  where     {-# MINIMAL fromRational, (recip | (/)) #-} @@ -216,10 +252,19 @@ -- These 'numeric' enumerations come straight from the Report  numericEnumFrom         :: (Fractional a) => a -> [a]-numericEnumFrom n       =  n `seq` (n : numericEnumFrom (n + 1))+numericEnumFrom n       = go 0+  where+    -- See Note [Numeric Stability of Enumerating Floating Numbers]+    go !k = let !n' = n + k+             in n' : go (k + 1)  numericEnumFromThen     :: (Fractional a) => a -> a -> [a]-numericEnumFromThen n m = n `seq` m `seq` (n : numericEnumFromThen m (m+m-n))+numericEnumFromThen n m = go 0+  where+    step = m - n+    -- See Note [Numeric Stability of Enumerating Floating Numbers]+    go !k = let !n' = n + k * step+             in n' : go (k + 1)  numericEnumFromTo       :: (Ord a, Fractional a) => a -> a -> [a] numericEnumFromTo n m   = takeWhile (<= m + 1/2) (numericEnumFrom n)@@ -232,6 +277,49 @@                                  predicate | e2 >= e1  = (<= e3 + mid)                                            | otherwise = (>= e3 + mid) +{- Note [Numeric Stability of Enumerating Floating Numbers]+-----------------------------------------------------------+When enumerate floating numbers, we could add the increment to the last number+at every run (as what we did previously):++    numericEnumFrom n =  n `seq` (n : numericEnumFrom (n + 1))++This approach is concise and really fast, only needs an addition operation.+However when a floating number is large enough, for `n`, `n` and `n+1` will+have the same binary representation. For example (all number has type+`Double`):++    9007199254740990                 is: 0x433ffffffffffffe+    9007199254740990 + 1             is: 0x433fffffffffffff+    (9007199254740990 + 1) + 1       is: 0x4340000000000000+    ((9007199254740990 + 1) + 1) + 1 is: 0x4340000000000000++When we evaluate ([9007199254740990..9007199254740991] :: Double), we would+never reach the condition in `numericEnumFromTo`++    9007199254740990 + 1 + 1 + ... > 9007199254740991 + 1/2++We would fall into infinite loop (as reported in Trac #15081).++To remedy the situation, we record the number of `1` that needed to be added+to the start number, rather than increasing `1` at every time. This approach+can improvement the numeric stability greatly at the cost of a multiplication.++Furthermore, we use the type of the enumerated number, `Fractional a => a`,+as the type of multiplier. In rare situations, the multiplier could be very+large and will lead to the enumeration to infinite loop, too, which should+be very rare. Consider the following example:++    [1..9007199254740994]++We could fix that by using an Integer as multiplier but we don't do that.+The benchmark on T7954.hs shows that this approach leads to significant+degeneration on performance (33% increase allocation and 300% increase on+elapsed time).++See Trac #15081 and Phab:D4650 for the related discussion about this problem.+-}+ -------------------------------------------------------------- -- Instances for Int --------------------------------------------------------------@@ -324,6 +412,18 @@ instance  Real Integer  where     toRational x        =  x :% 1 +#if defined(MIN_VERSION_integer_gmp)+-- | @since 4.8.0.0+instance Real Natural where+    toRational (NatS# w)  = toRational (W# w)+    toRational (NatJ# bn) = toRational (Jp# bn)+#else+-- | @since 4.8.0.0+instance Real Natural where+  toRational (Natural a) = toRational a+  {-# INLINE toRational #-}+#endif+ -- Note [Integer division constant folding] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --@@ -366,6 +466,39 @@     n `quotRem` d = case n `quotRemInteger` d of                       (# q, r #) -> (q, r) +#if defined(MIN_VERSION_integer_gmp)+-- | @since 4.8.0.0+instance Integral Natural where+    toInteger = naturalToInteger++    divMod = quotRemNatural+    div    = quotNatural+    mod    = remNatural++    quotRem = quotRemNatural+    quot    = quotNatural+    rem     = remNatural+#else+-- | @since 4.8.0.0+instance Integral Natural where+  quot (Natural a) (Natural b) = Natural (quot a b)+  {-# INLINE quot #-}+  rem (Natural a) (Natural b) = Natural (rem a b)+  {-# INLINE rem #-}+  div (Natural a) (Natural b) = Natural (div a b)+  {-# INLINE div #-}+  mod (Natural a) (Natural b) = Natural (mod a b)+  {-# INLINE mod #-}+  divMod (Natural a) (Natural b) = (Natural q, Natural r)+    where (q,r) = divMod a b+  {-# INLINE divMod #-}+  quotRem (Natural a) (Natural b) = (Natural q, Natural r)+    where (q,r) = quotRem a b+  {-# INLINE quotRem #-}+  toInteger (Natural a) = a+  {-# INLINE toInteger #-}+#endif+ -------------------------------------------------------------- -- Instances for @Ratio@ --------------------------------------------------------------@@ -454,6 +587,17 @@ "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word     #-} +{-# RULES+"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural+"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer+"fromIntegral/Natural->Word"     fromIntegral = naturalToWord+  #-}++{-# RULES+"fromIntegral/Word->Natural"     fromIntegral = wordToNatural+"fromIntegral/Int->Natural"     fromIntegral = intToNatural+  #-}+ -- | general coercion to fractional types realToFrac :: (Real a, Fractional b) => a -> b {-# NOINLINE [1] realToFrac #-}@@ -646,6 +790,8 @@ "gcd/Int->Int->Int"             gcd = gcdInt' "gcd/Integer->Integer->Integer" gcd = gcdInteger "lcm/Integer->Integer->Integer" lcm = lcmInteger+"gcd/Natural->Natural->Natural" gcd = gcdNatural+"lcm/Natural->Natural->Natural" lcm = lcmNatural  #-}  gcdInt' :: Int -> Int -> Int

@@ -0,0 +1,159 @@+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.ResponseFile+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  internal+-- Portability :  portable+--+-- GCC style response files.+--+-- @since 4.12.0.0+----------------------------------------------------------------------------++-- Migrated from Haddock.++module GHC.ResponseFile (+    getArgsWithResponseFiles,+    unescapeArgs,+    escapeArgs,+    expandResponse+  ) where++import Control.Exception+import Data.Char          (isSpace)+import Data.Foldable      (foldl')+import System.Environment (getArgs)+import System.Exit        (exitFailure)+import System.IO++{-|+Like 'getArgs', but can also read arguments supplied via response files.+++For example, consider a program @foo@:++@+main :: IO ()+main = do+  args <- getArgsWithResponseFiles+  putStrLn (show args)+@+++And a response file @args.txt@:++@+--one 1+--'two' 2+--"three" 3+@++Then the result of invoking @foo@ with @args.txt@ is:++> > ./foo @args.txt+> ["--one","1","--two","2","--three","3"]++-}+getArgsWithResponseFiles :: IO [String]+getArgsWithResponseFiles = getArgs >>= expandResponse++-- | Given a string of concatenated strings, separate each by removing+-- a layer of /quoting/ and\/or /escaping/ of certain characters.+--+-- These characters are: any whitespace, single quote, double quote,+-- and the backslash character.  The backslash character always+-- escapes (i.e., passes through without further consideration) the+-- character which follows.  Characters can also be escaped in blocks+-- by quoting (i.e., surrounding the blocks with matching pairs of+-- either single- or double-quotes which are not themselves escaped).+--+-- Any whitespace which appears outside of either of the quoting and+-- escaping mechanisms, is interpreted as having been added by this+-- special concatenation process to designate where the boundaries+-- are between the original, un-concatenated list of strings.  These+-- added whitespace characters are removed from the output.+--+-- > unescapeArgs "hello\\ \\\"world\\\"\n" == escapeArgs "hello \"world\""+unescapeArgs :: String -> [String]+unescapeArgs = filter (not . null) . unescape++-- | Given a list of strings, concatenate them into a single string+-- with escaping of certain characters, and the addition of a newline+-- between each string.  The escaping is done by adding a single+-- backslash character before any whitespace, single quote, double+-- quote, or backslash character, so this escaping character must be+-- removed.  Unescaped whitespace (in this case, newline) is part+-- of this "transport" format to indicate the end of the previous+-- string and the start of a new string.+--+-- While 'unescapeArgs' allows using quoting (i.e., convenient+-- escaping of many characters) by having matching sets of single- or+-- double-quotes,'escapeArgs' does not use the quoting mechasnism,+-- and thus will always escape any whitespace, quotes, and+-- backslashes.+--+-- > unescapeArgs "hello\\ \\\"world\\\"\\n" == escapeArgs "hello \"world\""+escapeArgs :: [String] -> String+escapeArgs = unlines . map escapeArg++-- | Arguments which look like '@foo' will be replaced with the+-- contents of file @foo@. A gcc-like syntax for response files arguments+-- is expected.  This must re-constitute the argument list by doing an+-- inverse of the escaping mechanism done by the calling-program side.+--+-- We quit if the file is not found or reading somehow fails.+-- (A convenience routine for haddock or possibly other clients)+expandResponse :: [String] -> IO [String]+expandResponse = fmap concat . mapM expand+  where+    expand :: String -> IO [String]+    expand ('@':f) = readFileExc f >>= return . unescapeArgs+    expand x = return [x]++    readFileExc f =+      readFile f `catch` \(e :: IOException) -> do+        hPutStrLn stderr $ "Error while expanding response file: " ++ show e+        exitFailure++data Quoting = NoneQ | SngQ | DblQ++unescape :: String -> [String]+unescape args = reverse . map reverse $ go args NoneQ False [] []+    where+      -- n.b., the order of these cases matters; these are cribbed from gcc+      -- case 1: end of input+      go []     _q    _bs   a as = a:as+      -- case 2: back-slash escape in progress+      go (c:cs) q     True  a as = go cs q     False (c:a) as+      -- case 3: no back-slash escape in progress, but got a back-slash+      go (c:cs) q     False a as+        | '\\' == c              = go cs q     True  a     as+      -- case 4: single-quote escaping in progress+      go (c:cs) SngQ  False a as+        | '\'' == c              = go cs NoneQ False a     as+        | otherwise              = go cs SngQ  False (c:a) as+      -- case 5: double-quote escaping in progress+      go (c:cs) DblQ  False a as+        | '"' == c               = go cs NoneQ False a     as+        | otherwise              = go cs DblQ  False (c:a) as+      -- case 6: no escaping is in progress+      go (c:cs) NoneQ False a as+        | isSpace c              = go cs NoneQ False []    (a:as)+        | '\'' == c              = go cs SngQ  False a     as+        | '"'  == c              = go cs DblQ  False a     as+        | otherwise              = go cs NoneQ False (c:a) as++escapeArg :: String -> String+escapeArg = reverse . foldl' escape []++escape :: String -> Char -> String+escape cs c+  |    isSpace c+    || '\\' == c+    || '\'' == c+    || '"'  == c = c:'\\':cs -- n.b., our caller must reverse the result+  | otherwise    = c:cs