base 4.16.4.0 → 4.17.0.0

raw patch · 142 files changed

+36225/−39303 lines, 142 filesdep ~ghc-primPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-prim

API changes (from Hackage documentation)

Files

• Control/Applicative.hs +7/−3
• Control/Arrow.hs +1/−1
• Control/Category.hs +1/−1
• Control/Concurrent.hs +1/−1
• Control/Concurrent.hs-boot +1/−1
• Control/Concurrent/Chan.hs +1/−1
• Control/Concurrent/MVar.hs +14/−6
• Control/Concurrent/QSem.hs +2/−2
• Control/Concurrent/QSemN.hs +1/−1
• Control/Exception.hs +1/−1
• Control/Exception/Base.hs +1/−1
• Control/Monad.hs +1/−2
• Control/Monad/Fix.hs +1/−1
• Control/Monad/IO/Class.hs +1/−1
• Control/Monad/ST.hs +1/−1
• Control/Monad/ST/Imp.hs +1/−2
• Control/Monad/ST/Lazy/Imp.hs +2/−6
• Control/Monad/ST/Safe.hs +1/−1
• Control/Monad/ST/Unsafe.hs +1/−1
• Control/Monad/Zip.hs +1/−1
• Data/Array/Byte.hs +272/−0
• Data/Bitraversable.hs +0/−1
• Data/Bits.hs +60/−1
• Data/Bool.hs +1/−1
• Data/Data.hs +1/−1
• Data/Dynamic.hs +1/−9
• Data/Either.hs +1/−1
• Data/Fixed.hs +2/−2
• Data/Foldable.hs +59/−19
• Data/Function.hs +3/−1
• Data/Functor/Classes.hs +19/−3
• Data/Functor/Compose.hs +1/−1
• Data/Functor/Const.hs +1/−1
• Data/Functor/Contravariant.hs +1/−1
• Data/Functor/Identity.hs +1/−1
• Data/Functor/Product.hs +1/−1
• Data/Functor/Sum.hs +1/−1
• Data/Functor/Utils.hs +9/−0
• Data/IORef.hs +1/−1
• Data/Int.hs +1/−1
• Data/Kind.hs +1/−1
• Data/List/NonEmpty.hs +5/−4
• Data/Maybe.hs +1/−0
• Data/Monoid.hs +1/−1
• Data/OldList.hs +41/−16
• Data/Proxy.hs +1/−1
• Data/STRef.hs +1/−1
• Data/STRef/Lazy.hs +1/−1
• Data/Semigroup.hs +34/−3
• Data/Semigroup/Internal.hs +9/−0
• Data/String.hs +2/−1
• Data/Traversable.hs +2/−5
• Data/Tuple.hs +1/−1
• Data/Type/Bool.hs +1/−1
• Data/Type/Coercion.hs +1/−1
• Data/Type/Equality.hs +20/−4
• Data/Type/Ord.hs +12/−8
• Data/Typeable.hs +1/−1
• Data/Typeable/Internal.hs +71/−45
• Data/Unique.hs +1/−1
• Data/Version.hs +1/−1
• Data/Word.hs +1/−1
• Foreign/Marshal/Alloc.hs +5/−0
• GHC/Arr.hs +12/−2
• GHC/ArrayArray.hs +155/−0
• GHC/Base.hs +118/−35
• GHC/Bits.hs +14/−9
• GHC/Conc/Sync.hs +20/−7
• GHC/Enum.hs +23/−11
• GHC/Err.hs +13/−11
• GHC/Event/Internal/Types.hs +1/−1
• GHC/Event/Thread.hs +19/−75
• GHC/Event/TimeOut.hs +1/−1
• GHC/Event/Windows.hsc +6/−6
• GHC/Event/Windows/FFI.hsc +5/−3
• GHC/Event/Windows/ManagedThreadPool.hs +1/−1
• GHC/Exception.hs +3/−1
• GHC/ExecutionStack/Internal.hsc +1/−1
• GHC/Exts.hs +73/−119
• GHC/Float.hs +191/−85
• GHC/Float/RealFracMethods.hs +3/−1
• GHC/Foreign.hs +0/−1
• GHC/ForeignPtr.hs +4/−2
• GHC/Generics.hs +156/−6
• GHC/IO.hs +22/−4
• GHC/IO/Encoding.hs +3/−1
• GHC/IO/Encoding/Failure.hs +12/−9
• GHC/IO/FD.hs +16/−47
• GHC/IO/Handle.hs +8/−1
• GHC/IO/Handle/Internals.hs +1/−2
• GHC/IO/Handle/Text.hs +40/−33
• GHC/IO/Unsafe.hs +7/−2
• GHC/IO/Windows/Handle.hsc +23/−32
• GHC/IORef.hs +0/−1
• GHC/Int.hs +129/−262
• GHC/Integer.hs +178/−2
• GHC/IsList.hs +87/−0
• GHC/List.hs +138/−41
• GHC/OldList.hs +1/−1
• GHC/OverloadedLabels.hs +3/−3
• GHC/Read.hs +1/−1
• GHC/Real.hs +145/−87
• GHC/ResponseFile.hs +2/−2
• GHC/ST.hs +0/−5
• GHC/Show.hs +5/−3
• GHC/Stable.hs +1/−1
• GHC/StableName.hs +1/−1
• GHC/Stack/CCS.hsc +42/−22
• GHC/Stack/CloneStack.hs +264/−0
• GHC/StaticPtr.hs +8/−9
• GHC/TopHandler.hs +4/−5
• GHC/TypeError.hs +141/−0
• GHC/TypeLits.hs +12/−61
• GHC/TypeNats.hs +12/−11
• GHC/Weak.hs +7/−8
• GHC/Word.hs +133/−287
• Numeric.hs +7/−7
• Prelude.hs +3/−0
• System/CPUTime/Posix/ClockGetTime.hsc +5/−4
• System/Console/GetOpt.hs +4/−4
• System/Environment.hs +1/−0
• System/Environment/ExecutablePath.hsc +77/−6
• System/IO.hs +3/−2
• System/Info.hs +1/−1
• System/Mem/StableName.hs +1/−1
• System/Mem/Weak.hs +1/−1
• System/Timeout.hs +1/−1
• Text/Printf.hs +1/−1
• Type/Reflection.hs +3/−3
• Unsafe/Coerce.hs +19/−8
• aclocal.m4 +19/−3
• base.cabal +13/−8
• cbits/StackCloningDecoding.cmm +26/−0
• cbits/inputReady.c +3/−3
• changelog.md +75/−17
• config.guess +0/−1754
• config.sub +0/−1890
• configure +32974/−34002
• configure.ac +3/−1
• include/HsBase.h +2/−2
• include/HsBaseConfig.h.in +26/−81
• include/winio_structs.h +1/−1

@@ -10,7 +10,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- This module describes a structure intermediate between a functor and@@ -60,7 +60,7 @@  import GHC.Base import GHC.Generics-import GHC.List (repeat, zipWith, drop)+import GHC.List (repeat, zipWith) import GHC.Read (Read) import GHC.Show (Show) @@ -140,7 +140,11 @@ -- | @since 4.11.0.0 instance Alternative ZipList where    empty = ZipList []-   ZipList xs <|> ZipList ys = ZipList (xs ++ drop (length xs) ys)+   ZipList xs0 <|> ZipList ys0 = ZipList $ go xs0 ys0+     where+       go (x:xs) (_:ys) = x : go xs ys+       go    []     ys  = ys+       go    xs      _  = xs  -- extra functions 

@@ -205,7 +205,7 @@  -- | The identity arrow, which plays the role of 'return' in arrow notation. returnA :: Arrow a => a b b-returnA = arr id+returnA = id  -- | Precomposition with a pure function. (^>>) :: Arrow a => (b -> c) -> a c d -> a b d

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  ashley@semantic.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable  -- https://gitlab.haskell.org/ghc/ghc/issues/1773

@@ -16,7 +16,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- A common interface to a collection of useful concurrency

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- A common interface to a collection of useful concurrency

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- Unbounded channels.

@@ -6,9 +6,9 @@ -- Module      :  Control.Concurrent.MVar -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- An @'MVar' t@ is mutable location that is either empty or contains a@@ -45,7 +45,7 @@ -- 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply -- the composition of a 'takeMVar' followed by a 'putMVar' with -- exception safety.--- These only have atomicity guarantees if all other threads+-- These have atomicity guarantees only if all other threads -- perform a 'takeMVar' before a 'putMVar' as well;  otherwise, they may -- block. --@@ -162,7 +162,10 @@ {-|   Take a value from an 'MVar', put a new value into the 'MVar' and   return the value taken. This function is atomic only if there are-  no other producers for this 'MVar'.+  no other producers for this 'MVar'. In other words, it cannot guarantee+  that, by the time 'swapMVar' gets the chance to write to the MVar,+  the value of the MVar has not been altered+  by a write operation from another thread. -} swapMVar :: MVar a -> a -> IO a swapMVar mvar new =@@ -176,7 +179,10 @@   of an 'MVar'.  This operation is exception-safe: it will replace the   original contents of the 'MVar' if an exception is raised (see   "Control.Exception").  However, it is only atomic if there are no-  other producers for this 'MVar'.+  other producers for this 'MVar'. In other words, it cannot guarantee+  that, by the time 'withMVar' gets the chance to write to the MVar,+  the value of the MVar has not been altered+  by a write operation from another thread. -} {-# INLINE withMVar #-} -- inlining has been reported to have dramatic effects; see@@ -209,7 +215,9 @@   Like 'withMVar', 'modifyMVar' will replace the original contents of   the 'MVar' if an exception is raised during the operation.  This   function is only atomic if there are no other producers for this-  'MVar'.+  'MVar'. In other words, it cannot guarantee that, by the time+  'modifyMVar_' gets the chance to write to the MVar, the value+  of the MVar has not been altered by a write operation from another thread. -} {-# INLINE modifyMVar_ #-} modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- Simple quantity semaphores.@@ -100,7 +100,7 @@     putMVar m r'  -- Note [signal uninterruptible]---+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --   If we have -- --      bracket waitQSem signalQSem (...)

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (concurrency) -- -- Quantity semaphores in which each thread may wait for an arbitrary

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (extended exceptions) -- -- This module provides support for raising and catching both built-in

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (extended exceptions) -- -- Extensible exceptions, except for multiple handlers.

@@ -222,7 +222,7 @@ zipWithM_         :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m () {-# INLINE zipWithM_ #-} -- Inline so that fusion with zipWith and sequenceA have a chance to fire--- See Note [Fusion for zipN/zipWithN] in List.hs]+-- See Note [Fusion for zipN/zipWithN] in List.hs. zipWithM_ f xs ys =  sequenceA_ (zipWith f xs ys)  {- | The 'foldM' function is analogous to 'Data.Foldable.foldl', except that its result is@@ -262,7 +262,6 @@ {- Note [Worker/wrapper transform on replicateM/replicateM_] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- The implementations of replicateM and replicateM_ both leverage the worker/wrapper transform. The simpler implementation of replicateM_, as an example, would be:

@@ -9,7 +9,7 @@ --                (c) Oregon Graduate Institute of Science and Technology, 2002 -- License     :  BSD-style (see the file libraries/base/LICENSE) -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Monadic fixpoints.

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  R.Paterson@city.ac.uk--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Class of monads based on @IO@.

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (requires universal quantification for runST) -- -- This library provides support for /strict/ state threads, as

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (requires universal quantification for runST) -- -- This library provides support for /strict/ state threads, as@@ -62,7 +62,6 @@  {- Note [fixST]    ~~~~~~~~~~~~- For many years, we implemented fixST much like a pure fixpoint, using liftST: 

@@ -68,7 +68,7 @@ data State s = S# (State# s)  {- Note [Lazy ST and multithreading]-+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to imagine that passing a polymorphic state token was all that we needed to keep state threads separate (see Launchbury and Peyton Jones, 1994: https://www.microsoft.com/en-us/research/publication/lazy-functional-state-threads/).@@ -87,7 +87,7 @@ thin air. -}  {- Note [Lazy ST: not producing lazy pairs]-+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The fixST and strictToLazyST functions used to construct functions that produced lazy pairs. Why don't we need that laziness? The ST type is kept abstract, so no one outside this module can ever get their hands on a (result,@@ -189,10 +189,6 @@          (r,new_s) = res        in          unST (k r) new_s---- | @since 4.10-instance MonadFail (ST s) where-    fail s = errorWithoutStackTrace s  -- | Return the value computed by an 'ST' computation. -- The @forall@ ensures that the internal state used by the 'ST'

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (requires universal quantification for runST) -- -- This library provides support for /strict/ state threads, as

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (requires universal quantification for runST) -- -- This library provides support for /strict/ state threads, as

@@ -9,7 +9,7 @@ --                (c) University Tuebingen 2011 -- License     :  BSD-style (see the file libraries/base/LICENSE) -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Monadic zipping (used for monad comprehensions)

@@ -0,0 +1,272 @@+-- |+-- Module      : Data.Array.Byte+-- Copyright   : (c) Roman Leshchinskiy 2009-2012+-- License     : BSD-style+--+-- Maintainer  : libraries@haskell.org+-- Portability : non-portable+--+-- Derived from @primitive@ package.++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE UnboxedTuples #-}++module Data.Array.Byte (+  ByteArray(..),+  MutableByteArray(..),+) where++import Data.Bits ((.&.), unsafeShiftR)+import Data.Data (mkNoRepType, Data(..), Typeable)+import qualified Data.Foldable as F+import Data.Semigroup+import GHC.Show (intToDigit)+import GHC.Exts+import GHC.ST (ST(..), runST)+import GHC.Word (Word8(..))++-- | Boxed wrapper for 'ByteArray#'.+--+-- Since 'ByteArray#' is an unlifted type and not a member of kind 'Data.Kind.Type',+-- things like @[ByteArray#]@ or @IO ByteArray#@ are ill-typed. To work around this+-- inconvenience this module provides a standard boxed wrapper, inhabiting 'Data.Kind.Type'.+-- Clients are expected to use 'ByteArray' in higher-level APIs,+-- but wrap and unwrap 'ByteArray' internally as they please+-- and use functions from "GHC.Exts".+--+-- @since 4.17.0.0+data ByteArray = ByteArray ByteArray#++-- | Boxed wrapper for 'MutableByteArray#'.+--+-- Since 'MutableByteArray#' is an unlifted type and not a member of kind 'Data.Kind.Type',+-- things like @[MutableByteArray#]@ or @IO MutableByteArray#@ are ill-typed. To work around this+-- inconvenience this module provides a standard boxed wrapper, inhabiting 'Data.Kind.Type'.+-- Clients are expected to use 'MutableByteArray' in higher-level APIs,+-- but wrap and unwrap 'MutableByteArray' internally as they please+-- and use functions from "GHC.Exts".+--+-- @since 4.17.0.0+data MutableByteArray s = MutableByteArray (MutableByteArray# s)++-- | Create a new mutable byte array of the specified size in bytes.+--+-- /Note:/ this function does not check if the input is non-negative.+newByteArray :: Int -> ST s (MutableByteArray s)+{-# INLINE newByteArray #-}+newByteArray (I# n#) =+  ST (\s# -> case newByteArray# n# s# of+    (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #))++-- | Convert a mutable byte array to an immutable one without copying. The+-- array should not be modified after the conversion.+unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray+{-# INLINE unsafeFreezeByteArray #-}+unsafeFreezeByteArray (MutableByteArray arr#) =+  ST (\s# -> case unsafeFreezeByteArray# arr# s# of+    (# s'#, arr'# #) -> (# s'#, ByteArray arr'# #))++-- | Size of the byte array in bytes.+sizeofByteArray :: ByteArray -> Int+{-# INLINE sizeofByteArray #-}+sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#)++-- | Read byte at specific index.+indexByteArray :: ByteArray -> Int -> Word8+{-# INLINE indexByteArray #-}+indexByteArray (ByteArray arr#) (I# i#) = W8# (indexWord8Array# arr# i#)++-- | Write byte at specific index.+writeByteArray :: MutableByteArray s -> Int -> Word8 -> ST s ()+{-# INLINE writeByteArray #-}+writeByteArray (MutableByteArray arr#) (I# i#) (W8# x#) =+  ST (\s# -> case writeWord8Array# arr# i# x# s# of+    s'# -> (# s'#, () #))++-- | Explode 'ByteArray' into a list of bytes.+byteArrayToList :: ByteArray -> [Word8]+{-# INLINE byteArrayToList #-}+byteArrayToList arr = go 0+  where+    go i+      | i < maxI  = indexByteArray arr i : go (i+1)+      | otherwise = []+    maxI = sizeofByteArray arr++-- | Create a 'ByteArray' from a list of a known length. If the length+--   of the list does not match the given length, this throws an exception.+byteArrayFromListN :: Int -> [Word8] -> ByteArray+byteArrayFromListN n ys = runST $ do+    marr <- newByteArray n+    let go !ix [] = if ix == n+          then return ()+          else error $ "Data.Array.Byte.byteArrayFromListN: list length less than specified size"+        go !ix (x : xs) = if ix < n+          then do+            writeByteArray marr ix x+            go (ix + 1) xs+          else error $ "Data.Array.Byte.byteArrayFromListN: list length greater than specified size"+    go 0 ys+    unsafeFreezeByteArray marr++-- | Copy a slice of an immutable byte array to a mutable byte array.+--+-- /Note:/ this function does not do bounds or overlap checking.+copyByteArray+  :: MutableByteArray s -- ^ destination array+  -> Int                -- ^ offset into destination array+  -> ByteArray          -- ^ source array+  -> Int                -- ^ offset into source array+  -> Int                -- ^ number of bytes to copy+  -> ST s ()+{-# INLINE copyByteArray #-}+copyByteArray (MutableByteArray dst#) (I# doff#) (ByteArray src#) (I# soff#) (I# sz#) =+  ST (\s# -> case copyByteArray# src# soff# dst# doff# sz# s# of+    s'# -> (# s'#, () #))++-- | @since 4.17.0.0+instance Data ByteArray where+  toConstr _ = error "toConstr"+  gunfold _ _ = error "gunfold"+  dataTypeOf _ = mkNoRepType "Data.Array.Byte.ByteArray"++-- | @since 4.17.0.0+instance Typeable s => Data (MutableByteArray s) where+  toConstr _ = error "toConstr"+  gunfold _ _ = error "gunfold"+  dataTypeOf _ = mkNoRepType "Data.Array.Byte.MutableByteArray"++-- | @since 4.17.0.0+instance Show ByteArray where+  showsPrec _ ba =+      showString "[" . go 0+    where+      showW8 :: Word8 -> String -> String+      showW8 !w s =+          '0'+        : 'x'+        : intToDigit (fromIntegral (unsafeShiftR w 4))+        : intToDigit (fromIntegral (w .&. 0x0F))+        : s+      go i+        | i < sizeofByteArray ba = comma . showW8 (indexByteArray ba i :: Word8) . go (i+1)+        | otherwise              = showChar ']'+        where+          comma | i == 0    = id+                | otherwise = showString ", "++-- | Compare prefixes of given length.+compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering+{-# INLINE compareByteArraysFromBeginning #-}+compareByteArraysFromBeginning (ByteArray ba1#) (ByteArray ba2#) (I# n#)+  = compare (I# (compareByteArrays# ba1# 0# ba2# 0# n#)) 0++-- | Do two byte arrays share the same pointer?+sameByteArray :: ByteArray# -> ByteArray# -> Bool+sameByteArray ba1 ba2 =+    case reallyUnsafePtrEquality# (unsafeCoerce# ba1 :: ()) (unsafeCoerce# ba2 :: ()) of+      r -> isTrue# r++-- | @since 4.17.0.0+instance Eq ByteArray where+  ba1@(ByteArray ba1#) == ba2@(ByteArray ba2#)+    | sameByteArray ba1# ba2# = True+    | n1 /= n2 = False+    | otherwise = compareByteArraysFromBeginning ba1 ba2 n1 == EQ+    where+      n1 = sizeofByteArray ba1+      n2 = sizeofByteArray ba2++-- | @since 4.17.0.0+instance Eq (MutableByteArray s) where+  (==) (MutableByteArray arr#) (MutableByteArray brr#)+    = isTrue# (sameMutableByteArray# arr# brr#)++-- | Non-lexicographic ordering. This compares the lengths of+-- the byte arrays first and uses a lexicographic ordering if+-- the lengths are equal. Subject to change between major versions.+-- @since 4.17.0.0+instance Ord ByteArray where+  ba1@(ByteArray ba1#) `compare` ba2@(ByteArray ba2#)+    | sameByteArray ba1# ba2# = EQ+    | n1 /= n2 = n1 `compare` n2+    | otherwise = compareByteArraysFromBeginning ba1 ba2 n1+    where+      n1 = sizeofByteArray ba1+      n2 = sizeofByteArray ba2+-- The primop compareByteArrays# (invoked from 'compareByteArraysFromBeginning')+-- performs a check for pointer equality as well. However, it+-- is included here because it is likely better to check for pointer equality+-- before checking for length equality. Getting the length requires deferencing+-- the pointers, which could cause accesses to memory that is not in the cache.+-- By contrast, a pointer equality check is always extremely cheap.++-- | Append two byte arrays.+appendByteArray :: ByteArray -> ByteArray -> ByteArray+appendByteArray a b = runST $ do+  marr <- newByteArray (sizeofByteArray a + sizeofByteArray b)+  copyByteArray marr 0 a 0 (sizeofByteArray a)+  copyByteArray marr (sizeofByteArray a) b 0 (sizeofByteArray b)+  unsafeFreezeByteArray marr++-- | Concatenate a list of 'ByteArray's.+concatByteArray :: [ByteArray] -> ByteArray+concatByteArray arrs = runST $ do+  let len = calcLength arrs 0+  marr <- newByteArray len+  pasteByteArrays marr 0 arrs+  unsafeFreezeByteArray marr++-- | Dump immutable 'ByteArray's into a mutable one, starting from a given offset.+pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()+pasteByteArrays !_ !_ [] = return ()+pasteByteArrays !marr !ix (x : xs) = do+  copyByteArray marr ix x 0 (sizeofByteArray x)+  pasteByteArrays marr (ix + sizeofByteArray x) xs++-- | Compute total length of 'ByteArray's, increased by accumulator.+calcLength :: [ByteArray] -> Int -> Int+calcLength [] !n = n+calcLength (x : xs) !n = calcLength xs (sizeofByteArray x + n)++-- | An array of zero length.+emptyByteArray :: ByteArray+emptyByteArray = runST (newByteArray 0 >>= unsafeFreezeByteArray)++-- | Replicate 'ByteArray' given number of times and concatenate all together.+replicateByteArray :: Int -> ByteArray -> ByteArray+replicateByteArray n arr = runST $ do+  marr <- newByteArray (n * sizeofByteArray arr)+  let go i = if i < n+        then do+          copyByteArray marr (i * sizeofByteArray arr) arr 0 (sizeofByteArray arr)+          go (i + 1)+        else return ()+  go 0+  unsafeFreezeByteArray marr++-- | @since 4.17.0.0+instance Semigroup ByteArray where+  (<>) = appendByteArray+  sconcat = mconcat . F.toList+  stimes i arr+    | itgr < 1 = emptyByteArray+    | itgr <= (fromIntegral (maxBound :: Int)) = replicateByteArray (fromIntegral itgr) arr+    | otherwise = error "Data.Array.Byte#stimes: cannot allocate the requested amount of memory"+    where itgr = toInteger i :: Integer++-- | @since 4.17.0.0+instance Monoid ByteArray where+  mempty = emptyByteArray+  mconcat = concatByteArray++-- | @since 4.17.0.0+instance IsList ByteArray where+  type Item ByteArray = Word8++  toList = byteArrayToList+  fromList xs = byteArrayFromListN (length xs) xs+  fromListN = byteArrayFromListN

@@ -127,7 +127,6 @@   --   -- @since 4.10.0.0   bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)-  bitraverse f g = bisequenceA . bimap f g  -- | Alias for 'bisequence'. --

@@ -10,7 +10,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- This module defines bitwise operations for signed and unsigned@@ -53,6 +53,8 @@   popCountDefault,   toIntegralSized,   oneBits,+  (.^.),+  (.>>.), (.<<.), (!>>.), (!<<.),   -- * Newtypes   And(..), Ior(..), Xor(..), Iff(..)  ) where@@ -60,6 +62,7 @@ import GHC.Base import GHC.Bits import GHC.Enum+import qualified GHC.List as List import GHC.Read import GHC.Show @@ -86,6 +89,46 @@ oneBits = complement zeroBits {-# INLINE oneBits #-} +-- | Infix version of 'xor'.+--+-- @since 4.17+(.^.) :: (Bits a) => a -> a -> a+(.^.) = xor++infixl 6 .^.++-- | Infix version of 'shiftR'.+--+-- @since 4.17+(.>>.) :: (Bits a) => a -> Int -> a+(.>>.) = shiftR++infixl 8 .>>.++-- | Infix version of 'shiftL'.+--+-- @since 4.17+(.<<.) :: (Bits a) => a -> Int -> a+(.<<.) = shiftL++infixl 8 .<<.++-- | Infix version of 'unsafeShiftR'.+--+-- @since 4.17+(!>>.) :: (Bits a) => a -> Int -> a+(!>>.) = unsafeShiftR++infixl 8 !>>.++-- | Infix version of 'unsafeShiftL'.+--+-- @since 4.17+(!<<.) :: (Bits a) => a -> Int -> a+(!<<.) = unsafeShiftL++infixl 8 !<<.+ -- | Monoid under bitwise AND. -- -- >>> getAnd (And 0xab <> And 0x12) :: Word8@@ -116,6 +159,10 @@ -- @since 4.16 instance (FiniteBits a) => Monoid (And a) where   mempty = And oneBits+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}  -- | Monoid under bitwise inclusive OR. --@@ -143,6 +190,10 @@ -- | @since 4.16 instance (Bits a) => Monoid (Ior a) where   mempty = Ior zeroBits+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}  -- | Monoid under bitwise XOR. --@@ -170,6 +221,10 @@ -- | @since 4.16 instance (Bits a) => Monoid (Xor a) where   mempty = Xor zeroBits+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}  -- | Monoid under bitwise \'equality\'; defined as @1@ if the corresponding -- bits match, and @0@ otherwise.@@ -206,3 +261,7 @@ -- @since 4.16 instance (FiniteBits a) => Monoid (Iff a) where   mempty = Iff oneBits+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The 'Bool' type and related functions.

@@ -18,7 +18,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (local universal quantification) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell.  See

@@ -11,7 +11,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The Dynamic interface provides basic support for dynamic types.@@ -83,14 +83,6 @@ -- here so that it isn't an orphan: -- | @since 4.0.0.0 instance Exception Dynamic-- -- Use GHC's primitive 'Any' type to hold the dynamically typed value.- --- -- In GHC's new eval/apply execution model this type must not look- -- like a data type.  If it did, GHC would use the constructor convention- -- when evaluating it, and this will go wrong if the object is really a- -- function.  Using Any forces GHC to use- -- a fallback convention for evaluating it that works for all types.  -- | Converts an arbitrary value into an object of type 'Dynamic'. --

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The Either type, and associated operations.

@@ -10,7 +10,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  Ashley Yakeley <ashley@semantic.org>--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- This module defines a \"Fixed\" type for fixed-precision arithmetic.@@ -103,7 +103,7 @@ -- resolution @10^-3@ of @type Milli = Fixed E3@, -- -- @---   succ (0.000 :: Milli) == 1.001+--   succ (0.000 :: Milli) == 0.001 -- @ -- --

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Class of data structures that can be folded to a summary value.@@ -189,6 +189,7 @@     -- 2666668666666     --     fold :: Monoid m => t m -> m+    {-# INLINE fold #-}     fold = foldMap id      -- | Map each element of the structure into a monoid, and combine the@@ -316,13 +317,28 @@     foldr :: (a -> b -> b) -> b -> t a -> b     foldr f z t = appEndo (foldMap (Endo #. f) t) z -    -- | Right-associative fold of a structure, strict in the accumulator.-    -- This is rarely what you want.+    -- | 'foldr'' is a variant of 'foldr' that performs strict reduction from+    -- right to left, i.e. starting with the right-most element.  The input+    -- structure /must/ be finite, otherwise 'foldr'' runs out of space+    -- (/diverges/).     --+    -- If you want a strict right fold in constant space, you need a structure+    -- that supports faster than /O(n)/ access to the right-most element, such+    -- as @Seq@ from the @containers@ package.+    --+    -- This method does not run in constant space for structures such as lists+    -- that don't support efficient right-to-left iteration and so require+    -- /O(n)/ space to perform right-to-left reduction.  Use of this method+    -- with such a structure is a hint that the chosen structure may be a poor+    -- fit for the task at hand.  If the order in which the elements are+    -- combined is not important, use 'foldl'' instead.+    --     -- @since 4.6.0.0     foldr' :: (a -> b -> b) -> b -> t a -> b-    foldr' f z0 xs = foldl f' id xs z0-      where f' k x z = k $! f x z+    foldr' f z0 = \ xs ->+        foldl (\ (k::b->b) (x::a) -> oneShot (\ (z::b) -> z `seq` k (f x z)))+              (id::b->b) xs z0+    -- Mirror image of 'foldl''.      -- | Left-associative fold of a structure, lazy in the accumulator.  This     -- is rarely what you want, but can work well for structures with efficient@@ -343,8 +359,8 @@     -- 'foldl'' instead of 'foldl'.  The reason for this is that the latter     -- does not force the /inner/ results (e.g. @z \`f\` x1@ in the above     -- example) before applying them to the operator (e.g. to @(\`f\` x2)@).-    -- This results in a thunk chain \(\mathcal{O}(n)\) elements long, which-    -- then must be evaluated from the outside-in.+    -- This results in a thunk chain /O(n)/ elements long, which then must be+    -- evaluated from the outside-in.     --     -- For a general 'Foldable' structure this should be semantically identical     -- to:@@ -394,8 +410,16 @@     --     -- @since 4.6.0.0     foldl' :: (b -> a -> b) -> b -> t a -> b-    foldl' f z0 xs = foldr f' id xs z0-      where f' x k z = k $! f z x+    {-# INLINE foldl' #-}+    foldl' f z0 = \ xs ->+        foldr (\ (x::a) (k::b->b) -> oneShot (\ (z::b) -> z `seq` k (f z x)))+              (id::b->b) xs z0+    --+    -- We now force the accumulator `z` rather than the value computed by the+    -- operator `k`, this matches the documented strictness.+    --+    -- For the rationale for the arity reduction from 3 to 2, inlining, etc.+    -- see Note [Definition of foldl'] in GHC.List.      -- | A variant of 'foldr' that has no base case,     -- and thus may only be applied to non-empty structures.@@ -713,7 +737,10 @@     foldl'  = List.foldl'     foldl1  = List.foldl1     foldr   = List.foldr+    foldr'  = List.foldr'     foldr1  = List.foldr1+    foldMap = (mconcat .) . map -- See Note [Monoidal list folds]+    fold    = mconcat           -- See Note [Monoidal list folds]     length  = List.length     maximum = List.maximum     minimum = List.minimum@@ -1494,6 +1521,19 @@ https://gitlab.haskell.org/ghc/ghc/-/issues/17867 for more context. -} +{-+Note [Monoidal list folds]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Folds of lists of monoid elements should generally use 'mconcat', rather than+@foldr mappend mempty@.  This allows specialized mconcat implementations an+opportunity to combine elements efficiently.  For example, `mappend` of strict+`Text` and `ByteString` values typically needs to reallocate and copy the+existing data, making incremental construction expensive (likely quadratic in+the number of elements combined).  The `mconcat` implementations for `Text` and+`ByteString` preallocate the required storage, and then combine all the list+elements in a single pass.+-}+ --------------  -- $overview@@ -2328,11 +2368,11 @@ -- >      in s / fromIntegral l -- -- The above example is somewhat contrived, some structures keep track of their--- length internally, and can return it in \(\mathcal{O}(1)\) time, so this--- particular recipe for averages is not always the most efficient.  In--- general, composite aggregate functions of large structures benefit from--- single-pass reduction.  This is especially the case when reuse of a list and--- memoisation of its elements is thereby avoided,+-- length internally, and can return it in /O(1)/ time, so this particular+-- recipe for averages is not always the most efficient.  In general, composite+-- aggregate functions of large structures benefit from single-pass reduction.+-- This is especially the case when reuse of a list and memoisation of its+-- elements is thereby avoided.  -------------- @@ -2456,12 +2496,12 @@ -- $linear -- -- It is perhaps worth noting that since the __`elem`__ function in the--- Foldable class carries only an __`Eq`__ constraint on the element type,+-- 'Foldable' class carries only an __`Eq`__ constraint on the element type, -- search for the presence or absence of an element in the structure generally--- takes \(\mathcal{O}(n)\) time, even for ordered structures like __@Set@__--- that are potentially capable of performing the search faster.  (The @member@--- function of the @Set@ module carries an `Ord` constraint, and can perform--- the search in \(\mathcal{O}(log\ n)\) time).+-- takes /O(n)/ time, even for ordered structures like __@Set@__ that are+-- potentially capable of performing the search faster.  (The @member@ function+-- of the @Set@ module carries an `Ord` constraint, and can perform the search+-- in /O(log n)/ time). -- -- An alternative to Foldable's __`elem`__ method is required in order to -- abstract potentially faster than linear search over general container

@@ -1,5 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}+  -- Show the levity-polymorphic signature of '$'  ----------------------------------------------------------------------------- -- |@@ -9,7 +11,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Simple combinators working solely on and with functions.

@@ -1,4 +1,7 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE InstanceSigs         #-}+{-# LANGUAGE Safe                 #-}+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Classes@@ -6,7 +9,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to@@ -72,6 +75,7 @@ import Data.Ord (Down(Down)) import Data.Complex (Complex((:+))) +import GHC.Generics (Generic1(..), Generically1(..)) import GHC.Tuple (Solo (..)) import GHC.Read (expectP, list, paren) @@ -688,7 +692,16 @@ instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where     liftShowsPrec = liftShowsPrec2 showsPrec showList +-- | @since 4.17.0.0+instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where+  liftEq :: (a1 -> a2 -> Bool) -> (Generically1 f a1 -> Generically1 f a2 -> Bool)+  liftEq (===) (Generically1 as1) (Generically1 as2) = liftEq (===) (from1 as1) (from1 as2) +-- | @since 4.17.0.0+instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where+  liftCompare :: (a1 -> a2 -> Ordering) -> (Generically1 f a1 -> Generically1 f a2 -> Ordering)+  liftCompare cmp (Generically1 as1) (Generically1 as2) = liftCompare cmp (from1 as1) (from1 as2)+ -- | @since 4.9.0.0 instance Eq2 Either where     liftEq2 e1 _ (Left x) (Left y) = e1 x y@@ -821,7 +834,10 @@  -- | @since 4.12.0.0 instance Ord1 Down where-    liftCompare comp (Down x) (Down y) = comp x y+    liftCompare comp (Down x) (Down y) = case comp x y of+        LT -> GT+        EQ -> EQ+        GT -> LT  -- | @since 4.12.0.0 instance Read1 Down where

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Composition of functors.

@@ -12,7 +12,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable  -- The 'Const' functor.

@@ -280,7 +280,7 @@       -- @       -- (<>) :: Equivalence a -> Equivalence a -> Equivalence a       -- Equivalence equiv <> Equivalence equiv' = Equivalence \a b ->-      --   equiv a b && equiv a b+      --   equiv a b && equiv' a b       -- @       Semigroup     , -- | @'mempty'@ on equivalences always returns @True@. Without

@@ -11,7 +11,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  ross@soi.city.ac.uk--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The identity functor and monad.

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Products, lifted to functors.

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Sums, lifted to functors.

@@ -12,6 +12,7 @@ import Data.Coerce (Coercible, coerce) import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)                 , Semigroup(..), ($), otherwise )+import qualified GHC.List as List  -- We don't expose Max and Min because, as Edward Kmett pointed out to me, -- there are two reasonable ways to define them. One way is to use Maybe, as we@@ -34,6 +35,10 @@ -- | @since 4.8.0.0 instance Ord a => Monoid (Max a) where     mempty = Max Nothing+    -- By default, we would get a lazy right fold. This forces the use of a strict+    -- left fold instead.+    mconcat = List.foldl' (<>) mempty+    {-# INLINE mconcat #-}  -- | @since 4.11.0.0 instance Ord a => Semigroup (Min a) where@@ -47,6 +52,10 @@ -- | @since 4.8.0.0 instance Ord a => Monoid (Min a) where     mempty = Min Nothing+    -- By default, we would get a lazy right fold. This forces the use of a strict+    -- left fold instead.+    mconcat = List.foldl' (<>) mempty+    {-# INLINE mconcat #-}  -- left-to-right state-transforming monad newtype StateL s a = StateL { runStateL :: s -> (s, a) }

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Mutable references in the IO monad.

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Signed integer types

@@ -6,7 +6,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  not portable -- -- Basic kinds

@@ -110,6 +110,7 @@ import qualified Data.List           as List import           Data.Ord            (comparing) import           GHC.Base            (NonEmpty(..))+import           GHC.Stack.Types     (HasCallStack)  infixr 5 <| @@ -194,9 +195,9 @@ -- | Converts a normal list to a 'NonEmpty' stream. -- -- Raises an error if given an empty list.-fromList :: [a] -> NonEmpty a+fromList :: HasCallStack => [a] -> NonEmpty a fromList (a:as) = a :| as-fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"+fromList [] = error "NonEmpty.fromList: empty list"  -- | Convert a stream to a normal list efficiently. toList :: NonEmpty a -> [a]@@ -401,11 +402,11 @@ -- @n@. Note that the head of the stream has index 0. -- -- /Beware/: a negative or out-of-bounds index will cause an error.-(!!) :: NonEmpty a -> Int -> a+(!!) :: HasCallStack => NonEmpty a -> Int -> a (!!) ~(x :| xs) n   | n == 0 = x   | n > 0  = xs List.!! (n - 1)-  | otherwise = errorWithoutStackTrace "NonEmpty.!! negative argument"+  | otherwise = error "NonEmpty.!! negative index" infixl 9 !!  -- | The 'zip' function takes two streams and returns a stream of

@@ -145,6 +145,7 @@ -- *** Exception: Maybe.fromJust: Nothing -- ... --+-- WARNING: This function is partial. You can use case-matching instead. fromJust          :: HasCallStack => Maybe a -> a fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- A type @a@ is a 'Monoid' if it provides an associative function ('<>')

@@ -722,8 +722,20 @@ -- 3 -- >>> genericLength [1, 2, 3] :: Float -- 3.0+--+-- Users should take care to pick a return type that is wide enough to contain+-- the full length of the list. If the width is insufficient, the overflow+-- behaviour will depend on the @(+)@ implementation in the selected 'Num'+-- instance. The following example overflows because the actual list length+-- of 200 lies outside of the 'Int8' range of @-128..127@.+--+-- >>> genericLength [1..200] :: Int8+-- -56 genericLength           :: (Num i) => [a] -> i-{-# NOINLINE [1] genericLength #-}+{-# NOINLINE [2] genericLength #-}+    -- Give time for the RULEs for (++) to fire in InitialPhase+    -- It's recursive, so won't inline anyway,+    -- but saying so is more explicit genericLength []        =  0 genericLength (_:l)     =  1 + genericLength l @@ -1349,6 +1361,7 @@ --  -- Note [INLINE unfoldr]+-- ~~~~~~~~~~~~~~~~~~~~~ -- We treat unfoldr a little differently from some other forms for list fusion -- for two reasons: --@@ -1383,35 +1396,40 @@ -- ----------------------------------------------------------------------------- -- Functions on strings --- | 'lines' breaks a string up into a list of strings at newline--- characters.  The resulting strings do not contain newlines.+-- | Splits the argument into a list of /lines/ stripped of their terminating+-- @\n@ characters.  The @\n@ terminator is optional in a final non-empty+-- line of the argument string. ----- Note that after splitting the string at newline characters, the--- last part of the string is considered a line even if it doesn't end--- with a newline. For example,+-- For example: ----- >>> lines ""+-- >>> lines ""           -- empty input contains no lines -- [] ----- >>> lines "\n"+-- >>> lines "\n"         -- single empty line -- [""] ----- >>> lines "one"+-- >>> lines "one"        -- single unterminated line -- ["one"] ----- >>> lines "one\n"+-- >>> lines "one\n"      -- single non-empty line -- ["one"] ----- >>> lines "one\n\n"+-- >>> lines "one\n\n"    -- second line is empty -- ["one",""] ----- >>> lines "one\ntwo"+-- >>> lines "one\ntwo"   -- second line is unterminated -- ["one","two"] ----- >>> lines "one\ntwo\n"+-- >>> lines "one\ntwo\n" -- two non-empty lines -- ["one","two"] ----- Thus @'lines' s@ contains at least as many elements as newlines in @s@.+-- When the argument string is empty, or ends in a @\n@ character, it can be+-- recovered by passing the result of 'lines' to the 'unlines' function.+-- Otherwise, 'unlines' appends the missing terminating @\n@.  This makes+-- @unlines . lines@ /idempotent/:+--+-- > (unlines . lines) . (unlines . lines) = (unlines . lines)+-- lines                   :: String -> [String] lines ""                =  [] -- Somehow GHC doesn't detect the selector thunks in the below code,@@ -1425,11 +1443,18 @@   where     cons ~(h, t)        =  h : t --- | 'unlines' is an inverse operation to 'lines'.--- It joins lines, after appending a terminating newline to each.+-- | Appends a @\n@ character to each input string, then concatenates the+-- results. Equivalent to @'foldMap' (\s -> s '++' "\n")@. -- -- >>> unlines ["Hello", "World", "!"] -- "Hello\nWorld\n!\n"+--+-- = Note+--+-- @'unlines' '.' 'lines' '/=' 'id'@ when the input is not @\n@-terminated:+--+-- >>> unlines . lines $ "foo\nbar"+-- "foo\nbar\n" unlines                 :: [String] -> String #if defined(USE_REPORT_PRELUDE) unlines                 =  concatMap (++ "\n")

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Definition of a Proxy type (poly-kinded in GHC)

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (uses Control.Monad.ST) -- -- Mutable references in the (strict) ST monad.

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) --  -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (uses Control.Monad.ST.Lazy) -- -- Mutable references in the lazy ST monad.

@@ -112,6 +112,7 @@ import           Data.Coerce import           Data.Data import           GHC.Generics+import qualified GHC.List as List  -- $setup -- >>> import Prelude@@ -172,6 +173,10 @@ -- | @since 4.9.0.0 instance (Ord a, Bounded a) => Monoid (Min a) where   mempty = maxBound+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}  -- | @since 4.9.0.0 instance Functor Min where@@ -242,6 +247,10 @@ -- | @since 4.9.0.0 instance (Ord a, Bounded a) => Monoid (Max a) where   mempty = minBound+  -- By default, we would get a lazy right fold. This forces the use of a strict+  -- left fold instead.+  mconcat = List.foldl' (<>) mempty+  {-# INLINE mconcat #-}  -- | @since 4.9.0.0 instance Functor Max where@@ -483,6 +492,9 @@ -- | @since 4.9.0.0 instance Monoid m => Monoid (WrappedMonoid m) where   mempty = WrapMonoid mempty+  -- This ensures that we use whatever mconcat is defined for the wrapped+  -- Monoid.+  mconcat = coerce (mconcat :: [m] -> m)  -- | @since 4.9.0.0 instance Enum a => Enum (WrappedMonoid a) where@@ -500,10 +512,29 @@ -- -- > mtimesDefault n a = a <> a <> ... <> a  -- using <> (n-1) times ----- Implemented using 'stimes' and 'mempty'.+-- In many cases, `stimes 0 a` for a `Monoid` will produce `mempty`.+-- However, there are situations when it cannot do so. In particular,+-- the following situation is fairly common: ----- This is a suitable definition for an 'mtimes' member of 'Monoid'.+-- @+-- data T a = ...+--+-- class Constraint1 a+-- class Constraint1 a => Constraint2 a+--+-- @+-- instance Constraint1 a => 'Semigroup' (T a)+-- instance Constraint2 a => 'Monoid' (T a)+-- @+--+-- Since @Constraint1@ is insufficient to implement 'mempty',+-- 'stimes' for @T a@ cannot do so.+--+-- When working with such a type, or when working polymorphically with+-- 'Semigroup' instances, @mtimesDefault@ should be used when the+-- multiplier might be zero. It is implemented using 'stimes' when+-- the multiplier is nonzero and 'mempty' when it is zero. mtimesDefault :: (Integral b, Monoid a) => b -> a -> a mtimesDefault n x   | n == 0    = mempty-  | otherwise = unwrapMonoid (stimes n (WrapMonoid x))+  | otherwise = stimes n x

@@ -22,6 +22,7 @@  import GHC.Base hiding (Any) import GHC.Enum+import qualified GHC.List as List import GHC.Num import GHC.Read import GHC.Show@@ -230,6 +231,10 @@ -- | @since 2.01 instance Num a => Monoid (Sum a) where         mempty = Sum 0+        -- By default, we would get a lazy right fold. This forces the use of a strict+        -- left fold instead.+        mconcat = List.foldl' (<>) mempty+        {-# INLINE mconcat #-}  -- | @since 4.8.0.0 instance Functor Sum where@@ -268,6 +273,10 @@ -- | @since 2.01 instance Num a => Monoid (Product a) where         mempty = Product 1+        -- By default, we would get a lazy right fold. This forces the use of a strict+        -- left fold instead.+        mconcat = List.foldl' (<>) mempty+        {-# INLINE mconcat #-}  -- | @since 4.8.0.0 instance Functor Product where

@@ -5,6 +5,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -13,7 +14,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The @String@ type and associated operations.

@@ -14,7 +14,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Class of data structures that can be traversed from left to right,@@ -1492,9 +1492,6 @@ -- -- @'traverse' 'pure' = 'pure'@ ----- (The naturality law is implied by parametricity and thus so is the--- purity law [1, p15].)--- -- The superclass instances should satisfy the following: -- --  * In the 'Functor' instance, 'fmap' should be equivalent to traversal@@ -1513,7 +1510,7 @@  -- $also -----  * [1] \"The Essence of the Iterator Pattern\",+--  * \"The Essence of the Iterator Pattern\", --    by Jeremy Gibbons and Bruno Oliveira, --    in /Mathematically-Structured Functional Programming/, 2006, online at --    <http://www.cs.ox.ac.uk/people/jeremy.gibbons/publications/#iterator>.

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Functions associated with the tuple data types.

@@ -11,7 +11,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  not portable -- -- Basic operations on type-level Booleans.

@@ -14,7 +14,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  not portable -- -- Definition of representational equality ('Coercion').

@@ -18,7 +18,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  not portable -- -- Definition of propositional equality @(':~:')@. Pattern-matching on a variable@@ -31,7 +31,9 @@  module Data.Type.Equality (   -- * The equality types-  (:~:)(..), type (~~),+  type (~),+  type (~~),+  (:~:)(..),   (:~~:)(..),    -- * Working with equality@@ -145,8 +147,22 @@ deriving instance a ~~ b => Bounded (a :~~: b)  -- | This class contains types where you can learn the equality of two types--- from information contained in /terms/. Typically, only singleton types should--- inhabit this class.+-- from information contained in /terms/.+--+-- The result should be @Just Refl@ if and only if the types applied to @f@ are+-- equal:+--+-- @TestEquality (x :: f a) (y :: f b) = Just Refl ⟺ a = b@+--+-- Typically, only singleton types should inhabit this class. In that case type+-- argument equality coincides with term equality:+--+-- @TestEquality (x :: f a) (y :: f b) = Just Refl ⟺ a = b ⟺ x = y@+--+-- @isJust (TestEquality x y) = x == y@+--+-- Singleton types are not required, however, and so the latter two would-be+-- laws are not in fact valid in general. class TestEquality f where   -- | Conditionally prove the equality of @a@ and @b@.   testEquality :: f a -> f b -> Maybe (a :~: b)

@@ -3,7 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeFamilies #-}@@ -16,7 +16,7 @@ -- License     :  BSD-style (see the LICENSE file in the distribution) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  not portable -- -- Basic operations on type-level Orderings.@@ -35,8 +35,10 @@   ) where  import GHC.Show(Show(..))+import GHC.TypeError import GHC.TypeLits.Internal import GHC.TypeNats.Internal+import GHC.Types (type (~)) import Data.Bool import Data.Char(Char) import Data.Eq@@ -64,29 +66,31 @@ deriving instance Show (OrderingI a b) deriving instance Eq   (OrderingI a b) - infix 4 <=?, <=, >=?, >=, <?, <, >?, >  -- | Comparison (<=) of comparable types, as a constraint. -- -- @since 4.16.0.0-type x <= y = (x <=? y) ~ 'True+type x <= y = Assert (x <=? y) (LeErrMsg x y)+type LeErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " <= " ':<>: 'ShowType y)  -- | Comparison (>=) of comparable types, as a constraint. -- -- @since 4.16.0.0-type x >= y = (x >=? y) ~ 'True+type x >= y = Assert (x >=? y) (GeErrMsg x y)+type GeErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " >= " ':<>: 'ShowType y)  -- | Comparison (<) of comparable types, as a constraint. -- -- @since 4.16.0.0-type x < y = (x <? y) ~ 'True+type x < y = Assert (x <? y) (LtErrMsg x y)+type LtErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " < " ':<>: 'ShowType y)  -- | Comparison (>) of comparable types, as a constraint. -- -- @since 4.16.0.0-type x > y = (x >? y) ~ 'True-+type x > y = Assert (x >? y) (GtErrMsg x y)+type GtErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " > " ':<>: 'ShowType y)  -- | Comparison (<=) of comparable types, as a function. --

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- The 'Typeable' class reifies types to some extent by associating type

@@ -15,7 +15,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}@@ -59,6 +58,7 @@      -- * TypeRep     TypeRep,+    pattern TypeRep,     pattern App, pattern Con, pattern Con', pattern Fun,     typeRep,     typeOf,@@ -86,15 +86,14 @@     trLiftedRep   ) where -import GHC.Prim ( FUN ) import GHC.Base import qualified GHC.Arr as A-import GHC.Types ( TYPE, Multiplicity (Many) ) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word import GHC.Show-import GHC.TypeLits ( KnownChar, charVal', KnownSymbol, symbolVal', AppendSymbol )+import GHC.TypeLits ( KnownChar, charVal', KnownSymbol, symbolVal'+                    , TypeError, ErrorMessage(..) ) import GHC.TypeNats ( KnownNat, Nat, natVal' ) import Unsafe.Coerce ( unsafeCoerce ) @@ -229,6 +228,41 @@                , trFunRes :: !(TypeRep b) }             -> TypeRep (FUN m a b) +-- | A 'TypeableInstance' wraps up a 'Typeable' instance for explicit+-- handling. For internal use: for defining 'TypeRep' pattern.+type TypeableInstance :: forall k. k -> Type+data TypeableInstance a where+ TypeableInstance :: Typeable a => TypeableInstance a++-- | Get a reified 'Typeable' instance from an explicit 'TypeRep'.+--+-- For internal use: for defining 'TypeRep' pattern.+typeableInstance :: forall {k :: Type} (a :: k). TypeRep a -> TypeableInstance a+typeableInstance rep = withTypeable rep TypeableInstance++-- | A explicitly bidirectional pattern synonym to construct a+-- concrete representation of a type.+--+-- As an __expression__: Constructs a singleton @TypeRep a@ given a+-- implicit 'Typeable a' constraint:+--+-- @+-- TypeRep @a :: Typeable a => TypeRep a+-- @+--+-- As a __pattern__: Matches on an explicit @TypeRep a@ witness bringing+-- an implicit @Typeable a@ constraint into scope.+--+-- @+-- f :: TypeRep a -> ..+-- f TypeRep = {- Typeable a in scope -}+-- @+--+-- @since 4.17.0.0+pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a+pattern TypeRep <- (typeableInstance -> TypeableInstance)+  where TypeRep = typeRep+ {- Note [TypeRep fingerprints]    ~~~~~~~~~~~~~~~~~~~~~~~~~~~ We store a Fingerprint of each TypeRep in its constructor. This allows@@ -238,7 +272,6 @@  {- Note [Kind caching]    ~~~~~~~~~~~~~~~~~~~- We cache the kind of the TypeRep in each TrTyCon and TrApp constructor. This is necessary to ensure that typeRepKind (which is used, at least, in deserialization and dynApply) is cheap. There are two reasons for this:@@ -433,14 +466,13 @@                   TypeRep (a :: k1 -> k2)                -> TypeRep (b :: k1)                -> TypeRep (a b)-mkTrAppChecked rep@(TrApp {trAppFun = p, trAppArg = x :: TypeRep x})+mkTrAppChecked rep@(TrApp {trAppFun = p, trAppArg = x@TypeRep :: TypeRep x})                (y :: TypeRep y)   | TrTyCon {trTyCon=con} <- p   , con == funTyCon  -- cheap check first-  , Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x)-  , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)-  , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry-                  $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep+  , Just (IsTYPE TypeRep) <- isTYPE (typeRepKind x)+  , Just (IsTYPE (TypeRep :: TypeRep ry)) <- isTYPE (typeRepKind y)+  , Just HRefl <- typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep   = mkTrFun trMany x y mkTrAppChecked a b = mkTrApp a b @@ -472,14 +504,16 @@     IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()           => TypeRep f %1 -> TypeRep x %1 -> AppOrCon (f x)     -- See Note [Con evidence]-    IsCon :: IsApplication a ~ "" => TyCon %1 -> [SomeTypeRep] %1 -> AppOrCon a+    IsCon :: NotApplication a => TyCon %1 -> [SomeTypeRep] %1 -> AppOrCon a -type family IsApplication (x :: k) :: Symbol where-  IsApplication (_ _) = "An error message about this unifying with \"\" "-     `AppendSymbol` "means that you tried to match a TypeRep with Con or "-     `AppendSymbol` "Con' when the represented type was known to be an "-     `AppendSymbol` "application."-  IsApplication _ = ""+type family NotApplication (x :: k) :: Constraint where+  NotApplication (f a)+    = TypeError+      (     'Text "Cannot match this TypeRep with Con or Con': it is an application:"+      ':$$: 'Text "  " ':<>: 'ShowType (f a)+      )+  NotApplication _+    = ()  splitApp :: forall k (a :: k). ()          => TypeRep a@@ -489,22 +523,28 @@ splitApp rep@(TrFun {trFunArg=a, trFunRes=b}) = IsApp (mkTrApp arr a) b   where arr = bareArrow rep splitApp (TrTyCon{trTyCon = con, trKindVars = kinds})-  = case unsafeCoerce Refl :: IsApplication a :~: "" of+  = case unsafeCoerce Refl :: NotApplication a :~: (() :: Constraint) of       Refl -> IsCon con kinds  -- | Use a 'TypeRep' as 'Typeable' evidence.+--+-- The 'TypeRep' pattern synonym brings a 'Typeable' constraint into+-- scope and can be used in place of 'withTypeable'.+--+-- @+-- f :: TypeRep a -> ..+-- f rep = withTypeable {- Typeable a in scope -}+--+-- f :: TypeRep a -> ..+-- f TypeRep = {- Typeable a in scope -}+-- @ 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-        k' = Gift k---- | A helper to satisfy the type checker in 'withTypeable'.-newtype Gift a (r :: TYPE rep) = Gift (Typeable a => r)+withTypeable rep k = withDict @(Typeable a) rep k  -- | Pattern match on a type constructor pattern Con :: forall k (a :: k). ()-            => IsApplication a ~ "" -- See Note [Con evidence]+            => NotApplication a -- See Note [Con evidence]             => TyCon -> TypeRep a pattern Con con <- (splitApp -> IsCon con _) @@ -526,39 +566,25 @@ -- @ -- pattern Con' :: forall k (a :: k). ()-             => IsApplication a ~ "" -- See Note [Con evidence]+             => NotApplication a -- See Note [Con evidence]              => TyCon -> [SomeTypeRep] -> TypeRep a pattern Con' con ks <- (splitApp -> IsCon con ks) --- TODO: Remove Fun when #14253 is fixed-{-# COMPLETE Fun, App, Con  #-}-{-# COMPLETE Fun, App, Con' #-}+{-# COMPLETE App, Con  #-}+{-# COMPLETE App, Con' #-}  {- Note [Con evidence]-    ~~~~~~~~~~~~~~~~~~~--Matching TypeRep t on Con or Con' fakes up evidence that--  IsApplication t ~ "".+~~~~~~~~~~~~~~~~~~~~~~+Matching TypeRep t on Con or Con' fakes up evidence of NotApplication t.  Why should anyone care about the value of strange internal type family? Well, almost nobody cares about it, but the pattern checker does! For example, suppose we have TypeRep (f x) and we want to get TypeRep f and TypeRep x. There is no chance that the Con constructor will match, because (f x) is not a constructor, but without the-IsApplication evidence, omitting it will lead to an incomplete pattern+NotApplication evidence, omitting it will lead to an incomplete pattern warning. With the evidence, the pattern checker will see that Con wouldn't typecheck, so everything works out as it should.--Why do we use Symbols? We would really like to use something like--  type family NotApplication (t :: k) :: Constraint where-    NotApplication (f a) = TypeError ...-    NotApplication _ = ()--Unfortunately, #11503 means that the pattern checker and type checker-will fail to actually reject the mistaken patterns. So we describe the-error in the result type. It's a horrible hack. -}  ----------------- Observation ---------------------

@@ -7,7 +7,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- An abstract interface to a unique symbol generator.

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable (local universal quantification in ReadP) -- -- A general library for representation and manipulation of versions.

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- Unsigned integer types.

@@ -37,6 +37,11 @@ -- aligned for that type. Array allocation routines need to obey the same -- alignment constraints for each array element. --+-- The underlying implementation is wrapping the @<stdlib.h>@+-- @malloc@, @realloc@, and @free@.+-- In other words it should be safe to allocate using C-@malloc@,+-- and free memory with 'free' from this module.+-- -----------------------------------------------------------------------------  module Foreign.Marshal.Alloc (

@@ -231,7 +231,16 @@ lessSafeIndex (l,u) _ i = index (l,u) i  -- Don't inline this long error message everywhere!!-badSafeIndex :: Int -> Int -> Int+-- | Used to throw exceptions in array bounds-checking functions.+--+--   ⚠ This function throws 'SomeException' in all cases.+--+-- ==== __Examples__+-- >>> badSafeIndex 2 5+-- *** Exception: Error in array index; 2 not in range [0..5)+badSafeIndex :: Int -- ^ Index searched for.+             -> Int -- ^ Max bound of the array.+             -> Int -- ^ This isn't an Int. It's an exception. badSafeIndex i' n = errorWithoutStackTrace ("Error in array index; " ++ show i' ++                         " not in range [0.." ++ show n ++ ")") @@ -497,7 +506,8 @@     l1 == l2 && u1 == u2 &&     and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]] -{-# INLINE [1] cmpArray #-}+{-# INLINE [2] cmpArray #-}+-- See Note [Allow time for type-specialisation rules to fire] in GHC.Real cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2) 

@@ -0,0 +1,155 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedNewtypes #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.ArrayArray+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC Extensions)+--+-- Legacy interface for arrays of arrays.+-- Deprecated, because the 'Array#' type can now store arrays directly.+-- Consider simply using 'Array#' instead of 'ArrayArray#'.+--+-- Use GHC.Exts instead of importing this module directly.+--+----------------------------------------------------------------------------++module GHC.ArrayArray+  ( ArrayArray#(..), MutableArrayArray#(..)+  , newArrayArray#+  , unsafeFreezeArrayArray#+  , sizeofArrayArray#+  , sizeofMutableArrayArray#+  , indexByteArrayArray#+  , indexArrayArrayArray#+  , readByteArrayArray#+  , readMutableByteArrayArray#+  , readArrayArrayArray#+  , readMutableArrayArrayArray#+  , writeByteArrayArray#+  , writeMutableByteArrayArray#+  , writeArrayArrayArray#+  , writeMutableArrayArrayArray#+  , copyArrayArray#+  , copyMutableArrayArray#+  , sameArrayArray#+  , sameMutableArrayArray#+  )+  where++import GHC.Prim+import GHC.Types ( Type, UnliftedType, isTrue# )+import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted )+default ()++{- **********************************************************************+*                                                                       *+*                 Arrays of arrays (legacy interface)                    *+*                                                                       *+********************************************************************** -}++type ArrayArray# :: UnliftedType+newtype ArrayArray# = ArrayArray# (Array# ByteArray#)++type MutableArrayArray# :: Type -> UnliftedType+newtype MutableArrayArray# s = MutableArrayArray# (MutableArray# s ByteArray#)++-- | Create a new mutable array of arrays with the specified number of elements,+--   in the specified state thread, with each element recursively referring to the+--   newly created array.+newArrayArray# :: Int# -> State# s -> (# State# s, MutableArrayArray# s #)+newArrayArray# sz s1 =+  -- Create a placeholder ByteArray to initialise the underlying MutableArray#.+  case newByteArray# 0# s1 of+    (# s2, placeholder #) ->+      -- Create a new MutableArray# holding the placeholder ByteArray# value.+      case newArray# sz (unsafeCoerceUnlifted placeholder) s2 of+        (# s3, arr #) ->+          -- Now update the MutableArray# so that the elements refer back+          -- to the mutable array itself.+          case write_array_to_array arr 0# s3 of+            s4 -> (# s4, MutableArrayArray# (unsafeCoerceUnlifted arr) #)++  where+    write_array_to_array :: MutableArray# s ByteArray# -> Int# -> State# s -> State# s+    write_array_to_array _ i s+      | isTrue# (i >=# sz)+      = s+    write_array_to_array arr i s+      = case writeArray# arr i (unsafeCoerceUnlifted arr) s of+          s' -> write_array_to_array arr (i +# 1#) s'++-- | Make a mutable array of arrays immutable, without copying.+unsafeFreezeArrayArray# :: MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)+unsafeFreezeArrayArray# = unsafeCoerce unsafeFreezeArray#++-- | Return the number of elements in the array.+sizeofArrayArray# :: ArrayArray# -> Int#+sizeofArrayArray# = unsafeCoerce sizeofArray#++-- | Return the number of elements in the array.+sizeofMutableArrayArray# :: MutableArrayArray# s -> Int#+sizeofMutableArrayArray# = unsafeCoerce sizeofMutableArray#++indexByteArrayArray# :: ArrayArray# -> Int# -> ByteArray#+indexByteArrayArray# = unsafeCoerce indexArray#++indexArrayArrayArray# :: ArrayArray# -> Int# -> ArrayArray#+indexArrayArrayArray# = unsafeCoerce indexArray#++readByteArrayArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #)+readByteArrayArray# = unsafeCoerce readArray#++readMutableByteArrayArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+readMutableByteArrayArray# = unsafeCoerce readArray#++readArrayArrayArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #)+readArrayArrayArray# = unsafeCoerce readArray#++readMutableArrayArrayArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)+readMutableArrayArrayArray# = unsafeCoerce readArray#++writeByteArrayArray# :: MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s+writeByteArrayArray# = unsafeCoerce writeArray#++writeMutableByteArrayArray# :: MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s+writeMutableByteArrayArray# = unsafeCoerce writeArray#++writeArrayArrayArray# :: MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s+writeArrayArrayArray# = unsafeCoerce writeArray#++writeMutableArrayArrayArray# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s+writeMutableArrayArrayArray# = unsafeCoerce writeArray#++-- | Copy a range of the 'ArrayArray#' to the specified region in the 'MutableArrayArray#'.+--   Both arrays must fully contain the specified ranges, but this is not checked.+--   The two arrays must not be the same array in different states, but this is not checked either.+copyArrayArray# :: ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s+copyArrayArray# = unsafeCoerce copyArray#++-- | Copy a range of the first MutableArrayArray# to the specified region in the second+--   MutableArrayArray#.+--   Both arrays must fully contain the specified ranges, but this is not checked.+--   The regions are allowed to overlap, although this is only possible when the same+--   array is provided as both the source and the destination.+copyMutableArrayArray# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s+copyMutableArrayArray# = unsafeCoerce copyMutableArray#++-- | Compare the underlying pointers of two arrays of arrays.+sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int#+sameArrayArray# (ArrayArray# arr1) (ArrayArray# arr2) = reallyUnsafePtrEquality# arr1 arr2++-- | Compare the underlying pointers of two mutable arrays of arrays.+sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Int#+sameMutableArrayArray# (MutableArrayArray# marr1) (MutableArrayArray# marr2 ) = reallyUnsafePtrEquality# marr1 marr2

@@ -100,10 +100,12 @@         module GHC.Classes,         module GHC.CString,         module GHC.Magic,+        module GHC.Magic.Dict,         module GHC.Types,-        module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,-        module GHC.Prim.Ext,    -- to avoid lots of people having to-        module GHC.Err,         -- import it explicitly+        module GHC.Prim,        -- Re-export GHC.Prim, GHC.Prim.Ext,+        module GHC.Prim.Ext,    -- GHC.Prim.PtrEq and [boot] GHC.Err+        module GHC.Prim.PtrEq,  -- to avoid lots of people having to+        module GHC.Err,         -- import these modules explicitly         module GHC.Maybe   )         where@@ -112,8 +114,10 @@ import GHC.Classes import GHC.CString import GHC.Magic+import GHC.Magic.Dict import GHC.Prim import GHC.Prim.Ext+import GHC.Prim.PtrEq import GHC.Err import GHC.Maybe import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO)@@ -146,7 +150,6 @@ {- Note [Depend on GHC.Num.Integer] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- The Integer type is special because GHC.CoreToStg.Prep.mkConvertNumLiteral lookups names in ghc-bignum interfaces to construct Integer literal values. Currently it reads the interface file whether or not the current module *has*@@ -340,6 +343,11 @@ -- | @since 2.01 instance Monoid b => Monoid (a -> b) where         mempty _ = mempty+        -- If `b` has a specialised mconcat, use that, rather than the default+        -- mconcat, which can be much less efficient.  Inline in the hope that+        -- it may result in list fusion.+        mconcat = \fs x -> mconcat $ map (\f -> f x) fs+        {-# INLINE mconcat #-}  -- | @since 4.9.0.0 instance Semigroup () where@@ -514,6 +522,9 @@  Note, that the second law follows from the free theorem of the type 'fmap' and the first law, so you need only check that the former condition holds.+See <https://www.schoolofhaskell.com/user/edwardk/snippets/fmap> or+<https://github.com/quchen/articles/blob/master/second_functor_law.md>+for an explanation. -}  class Functor f where@@ -633,7 +644,7 @@ -- --   * @'pure' = 'return'@ -----   * @m1 '<*>' m2 = m1 '>>=' (\x1 -> m2 '>>=' (\x2 -> 'return' (x1 x2)))@+--   * @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ -- --   * @('*>') = ('>>')@ --@@ -820,7 +831,7 @@ Furthermore, the 'Monad' and 'Applicative' operations should relate as follows:  * @'pure' = 'return'@-* @m1 '<*>' m2 = m1 '>>=' (\x1 -> m2 '>>=' (\x2 -> 'return' (x1 x2)))@+* @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@  The above laws imply: @@ -1355,7 +1366,7 @@ --   http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf  {-# RULES "map/coerce" [1] map coerce = coerce #-}--- See Note [Getting the map/coerce RULE to work] in CoreOpt+-- See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt  ---------------------------------------------- --              append@@ -1367,15 +1378,23 @@ -- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] -- -- If the first list is not finite, the result is the first list.+--+-- WARNING: This function takes linear time in the number of elements of the+-- first list.  (++) :: [a] -> [a] -> [a]-{-# NOINLINE [1] (++) #-}    -- We want the RULE to fire first.-                             -- It's recursive, so won't inline anyway,-                             -- but saying so is more explicit+{-# NOINLINE [2] (++) #-}+  -- Give time for the RULEs for (++) to fire in InitialPhase+  -- It's recursive, so won't inline anyway,+  -- but saying so is more explicit (++) []     ys = ys (++) (x:xs) ys = x : xs ++ ys  {-# RULES+"++/literal"      forall x. (++) (unpackCString# x)     = unpackAppendCString# x+"++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-}++{-# RULES "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys   #-} @@ -1473,7 +1492,7 @@ breakpointCond _ r = r  data Opaque = forall a. O a--- | @const x@ is a unary function which evaluates to @x@ for all inputs.+-- | @const x y@ always evaluates to @x@, ignoring its second argument. -- -- >>> const 42 "hello" -- 42@@ -1507,7 +1526,7 @@ -- 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+-- Note that @('$')@ is representation-polymorphic in its result type, so that -- @foo '$' True@ where @foo :: Bool -> Int#@ is well-typed. {-# INLINE ($) #-} ($) :: forall r a (b :: TYPE r). (a -> b) -> a -> b@@ -1609,32 +1628,87 @@ {-# INLINE quotRemInt #-} {-# INLINE divModInt #-} -quotInt, remInt, divInt, modInt :: Int -> Int -> Int+-- | Used to implement `quot` for the `Integral` typeclass.+--   This performs integer division on its two parameters, truncated towards zero.+--+-- ==== __Example__+-- >>> quotInt 10 2+-- 5+--+-- >>> quot 10 2+-- 5+quotInt :: Int -> Int -> Int (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)+-- | Used to implement `rem` for the `Integral` typeclass.+--   This gives the remainder after integer division of its two parameters, satisfying+--+-- > ((x `quot` y) * y) + (x `rem` y) == x+--+-- ==== __Example__+-- >>> remInt 3 2+-- 1+--+-- >>> rem 3 2+-- 1+remInt  :: Int -> Int -> Int (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)+-- | Used to implement `div` for the `Integral` typeclass.+--   This performs integer division on its two parameters, truncated towards negative infinity.+--+-- ==== __Example__+-- >>> 10 `divInt` 2+-- 5+--+-- >>> 10 `div` 2+-- 5+divInt  :: Int -> Int -> Int (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)+-- | Used to implement `mod` for the `Integral` typeclass.+--   This performs the modulo operation, satisfying+--+-- > ((x `div` y) * y) + (x `mod` y) == x+--+-- ==== __Example__+-- >>> 7 `modInt` 3+-- 1+--+-- >>> 7 `mod` 3+-- 1+modInt  :: Int -> Int -> Int (I# x) `modInt`   (I# y) = I# (x `modInt#`  y) ++-- | Used to implement `quotRem` for the `Integral` typeclass.+--   This gives a tuple equivalent to+--+-- > (quot x y, mod x y)+--+-- ==== __Example__+-- >>> quotRemInt 10 2+-- (5,0)+--+-- >>> quotRem 10 2+-- (5,0) quotRemInt :: Int -> Int -> (Int, Int) (I# x) `quotRemInt` (I# y) = case x `quotRemInt#` y of                              (# q, r #) ->                                  (I# q, I# r) +-- | Used to implement `divMod` for the `Integral` typeclass.+--   This gives a tuple equivalent to+--+-- > (div x y, mod x y)+--+-- ==== __Example__+-- >>> divModInt 10 2+-- (5,0)+--+-- >>> divMod 10 2+-- (5,0) divModInt :: Int -> Int -> (Int, Int) (I# x) `divModInt` (I# y) = case x `divModInt#` y of                             (# q, r #) -> (I# q, I# r) -divModInt# :: Int# -> Int# -> (# Int#, Int# #)-x# `divModInt#` y#- | isTrue# (x# ># 0#) && isTrue# (y# <# 0#) =-                                    case (x# -# 1#) `quotRemInt#` y# of-                                      (# q, r #) -> (# q -# 1#, r +# y# +# 1# #)- | isTrue# (x# <# 0#) && isTrue# (y# ># 0#) =-                                    case (x# +# 1#) `quotRemInt#` y# of-                                      (# q, r #) -> (# q -# 1#, r +# y# -# 1# #)- | otherwise                                =-                                    x# `quotRemInt#` y#- {- Note [INLINE division wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Int division functions such as 'quotRemInt' and 'divModInt' have@@ -1654,51 +1728,60 @@ -- Note that these wrappers still produce undefined results when the -- second argument (the shift amount) is negative. +-- | This function is used to implement branchless shifts. If the number of bits+-- to shift is greater than or equal to the type size in bits, then the shift+-- must return 0.  Instead of doing a test, we use a mask obtained via this+-- function which is branchless too.+--+--    shift_mask m b+--      | b < m     = 0xFF..FF+--      | otherwise = 0+--+shift_mask :: Int# -> Int# -> Int#+{-# INLINE shift_mask #-}+shift_mask m b = negateInt# (b <# m)+ -- | Shift the argument left by the specified number of bits -- (which must be non-negative). shiftL# :: Word# -> Int# -> Word#-a `shiftL#` b   | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##-                | otherwise                          = a `uncheckedShiftL#` b+a `shiftL#` b = (a `uncheckedShiftL#` b) `and#` int2Word# (shift_mask WORD_SIZE_IN_BITS# b)  -- | Shift the argument right by the specified number of bits -- (which must be non-negative). -- The "RL" means "right, logical" (as opposed to RA for arithmetic) -- (although an arithmetic right shift wouldn't make sense for Word#) shiftRL# :: Word# -> Int# -> Word#-a `shiftRL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##-                | otherwise                          = a `uncheckedShiftRL#` b+a `shiftRL#` b = (a `uncheckedShiftRL#` b) `and#` int2Word# (shift_mask WORD_SIZE_IN_BITS# b)  -- | Shift the argument left by the specified number of bits -- (which must be non-negative). iShiftL# :: Int# -> Int# -> Int#-a `iShiftL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#-                | otherwise                          = a `uncheckedIShiftL#` b+a `iShiftL#` b = (a `uncheckedIShiftL#` b) `andI#` shift_mask WORD_SIZE_IN_BITS# b  -- | Shift the argument right (signed) by the specified number of bits -- (which must be non-negative). -- The "RA" means "right, arithmetic" (as opposed to RL for logical) iShiftRA# :: Int# -> Int# -> Int#-a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#)-                                                          then (-1#)-                                                          else 0#+a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = negateInt# (a <# 0#)                 | otherwise                          = a `uncheckedIShiftRA#` b  -- | Shift the argument right (unsigned) by the specified number of bits -- (which must be non-negative). -- The "RL" means "right, logical" (as opposed to RA for arithmetic) iShiftRL# :: Int# -> Int# -> Int#-a `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#-                | otherwise                          = a `uncheckedIShiftRL#` b+a `iShiftRL#` b = (a `uncheckedIShiftRL#` b) `andI#` shift_mask WORD_SIZE_IN_BITS# b  -- Rules for C strings (the functions themselves are now in GHC.CString) {-# RULES "unpack"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a) "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n+"unpack-append-nil" forall a   . unpackAppendCString# a []    = unpackCString# a  "unpack-utf8"       [~1] forall a   . unpackCStringUtf8# a             = build (unpackFoldrCStringUtf8# a) "unpack-list-utf8"  [1]  forall a   . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a "unpack-append-utf8"     forall a n . unpackFoldrCStringUtf8# a (:) n  = unpackAppendCStringUtf8# a n+"unpack-append-nil-utf8" forall a   . unpackAppendCStringUtf8# a []    = unpackCStringUtf8# a  -- There's a built-in rule (in GHC.Core.Op.ConstantFold) for --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n

@@ -4,6 +4,8 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_HADDOCK not-home #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Bits@@ -11,7 +13,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- This module defines bitwise operations for signed and unsigned@@ -579,9 +581,11 @@    shift x i      | i >= 0    = naturalShiftL x (fromIntegral i)      | otherwise = naturalShiftR x (fromIntegral (negate i))-   testBit x i   = naturalTestBit x (fromIntegral i)-   zeroBits      = naturalZero-   clearBit x i  = x `xor` (bit i .&. x)+   testBit x i       = naturalTestBit x (fromIntegral i)+   zeroBits          = naturalZero+   setBit x i        = naturalSetBit x (fromIntegral i)+   clearBit x i      = naturalClearBit x (fromIntegral i)+   complementBit x i = naturalComplementBit x (fromIntegral i)     bit (I# i)  = naturalBit# (int2Word# i)    popCount x  = I# (word2Int# (naturalPopCount# x))@@ -601,10 +605,10 @@ -- -- > toIntegral :: (Integral a, Integral b) => a -> Maybe b -- > toIntegral x--- >   | toInteger x == y = Just (fromInteger y)--- >   | otherwise        = Nothing+-- >   | toInteger x == toInteger y = Just y+-- >   | otherwise                  = Nothing -- >   where--- >     y = toInteger x+-- >     y = fromIntegral x -- -- This version requires going through 'Integer', which can be inefficient. -- However, @toIntegralSized@ is optimized to allow GHC to statically determine@@ -668,8 +672,9 @@     ySigned = isSigned     y {-# INLINE isBitSubType #-} -{-      Note [Constant folding for rotate]-        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{-+Note [Constant folding for rotate]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The INLINE on the Int instance of rotate enables it to be constant folded.  For example:      sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)

@@ -152,7 +152,7 @@ showThreadId :: ThreadId -> String showThreadId = show -foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CULLong  id2TSO :: ThreadId -> ThreadId# id2TSO (ThreadId t) = t@@ -260,10 +260,15 @@ exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and 'ThreadKilled', and passes all other exceptions to the uncaught exception handler.++WARNING: Exceptions in the new thread will not be rethrown in the thread that+created it. This means that you might be completely unaware of the problem+if/when this happens.  You may want to use the+<hackage.haskell.org/package/async async> library instead. -} forkIO :: IO () -> IO ThreadId forkIO action = IO $ \ s ->-   case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)+   case (fork# (unIO action_plus) s) of (# s1, tid #) -> (# s1, ThreadId tid #)  where   -- We must use 'catch' rather than 'catchException' because the action   -- could be bottom. #13330@@ -313,7 +318,7 @@ -} forkOn :: Int -> IO () -> IO ThreadId forkOn (I# cpu) action = IO $ \ s ->-   case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)+   case (forkOn# cpu (unIO action_plus) s) of (# s1, tid #) -> (# s1, ThreadId tid #)  where   -- We must use 'catch' rather than 'catchException' because the action   -- could be bottom. #13330@@ -568,7 +573,7 @@    case threadStatus# t s of     (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #)    where-        -- NB. keep these in sync with includes/rts/Constants.h+        -- NB. keep these in sync with rts/include/rts/Constants.h      mk_stat 0  = ThreadRunning      mk_stat 1  = ThreadBlocked BlockedOnMVar      mk_stat 2  = ThreadBlocked BlockedOnBlackHole@@ -621,12 +626,12 @@ -- @hs_try_putmvar()@.  The RTS wants a 'StablePtr' to the underlying -- 'MVar#', but a 'StablePtr#' can only refer to lifted types, so we -- have to cheat by coercing.-newStablePtrPrimMVar :: MVar () -> IO (StablePtr PrimMVar)+newStablePtrPrimMVar :: MVar a -> IO (StablePtr PrimMVar) newStablePtrPrimMVar (MVar m) = IO $ \s0 ->   case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of-    -- Coerce unlifted  m :: MVar# RealWorld ()+    -- Coerce unlifted  m :: MVar# RealWorld a     --     to lifted    PrimMVar-    -- apparently because mkStablePtr is not levity-polymorphic+    -- apparently because mkStablePtr is not representation-polymorphic     (# s1, sp #) -> (# s1, StablePtr sp #)  -----------------------------------------------------------------------------@@ -661,6 +666,14 @@     {-# INLINE (>>=)  #-}     m >>= k     = bindSTM m k     (>>) = (*>)++-- | @since 4.17.0.0+instance Semigroup a => Semigroup (STM a) where+    (<>) = liftA2 (<>)++-- | @since 4.17.0.0+instance Monoid a => Monoid (STM a) where+    mempty = pure mempty  bindSTM :: STM a -> (a -> STM b) -> STM b bindSTM (STM m) k = STM ( \s ->

@@ -179,7 +179,6 @@ {- Note [Stable Unfolding for list producers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- The INLINABLE/INLINE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. -}@@ -422,7 +421,7 @@                     go x | isTrue# (x ># y) = n                          | otherwise        = C# (chr# x) `c` go (x +# 1#) -{-# NOINLINE [1] eftChar #-}+{-# NOINLINE [1] eftChar #-} -- Inline after rule "eftChar" is inactive eftChar :: Int# -> Int# -> String eftChar x y | isTrue# (x ># y ) = []             | otherwise         = C# (chr# x) : eftChar (x +# 1#) y@@ -437,7 +436,7 @@   where     !delta = x2 -# x1 -{-# NOINLINE [1] efdChar #-}+{-# NOINLINE [1] efdChar #-} -- Inline after rule "efdChar" is inactive efdChar :: Int# -> Int# -> String efdChar x1 x2   | isTrue# (delta >=# 0#) = go_up_char_list x1 delta 0x10FFFF#@@ -453,7 +452,7 @@   where     !delta = x2 -# x1 -{-# NOINLINE [1] efdtChar #-}+{-# NOINLINE [1] efdtChar #-} -- Inline after rule "efdtChar" is inactive efdtChar :: Int# -> Int# -> Int# -> String efdtChar x1 x2 lim   | isTrue# (delta >=# 0#) = go_up_char_list x1 delta lim@@ -892,6 +891,7 @@  #-}  {- Note [Enum Integer rules for literal 1]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The "1" rules above specialise for the common case where delta = 1, so that we can avoid the delta>=0 test in enumDeltaToIntegerFB. Then enumDeltaToInteger1FB is nice and small and can be inlined,@@ -910,7 +910,7 @@ enumDeltaIntegerFB c x0 d = go x0   where go x = x `seq` (x `c` go (x+d)) -{-# NOINLINE [1] enumDeltaInteger #-}+{-# NOINLINE [1] enumDeltaInteger #-} -- Inline after rule "enumDeltaInteger" is inactive enumDeltaInteger :: Integer -> Integer -> [Integer] enumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d) -- strict accumulator, so@@ -936,13 +936,13 @@                         go x | x > lim   = n                              | otherwise = x `c` go (x+1) -{-# NOINLINE [1] enumDeltaToInteger #-}+{-# NOINLINE [1] enumDeltaToInteger #-} -- Inline after rule "efdtInteger" is inactive enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] enumDeltaToInteger x delta lim   | delta >= 0 = up_list x delta lim   | otherwise  = dn_list x delta lim -{-# NOINLINE [1] enumDeltaToInteger1 #-}+{-# NOINLINE [1] enumDeltaToInteger1 #-} -- Inline after rule "efdtInteger1" is inactive enumDeltaToInteger1 :: Integer -> Integer -> [Integer] -- Special case for Delta = 1 enumDeltaToInteger1 x0 lim = go (x0 :: Integer)@@ -984,19 +984,27 @@       | i >= 0    = naturalFromWord# (int2Word# i#)       | otherwise = errorWithoutStackTrace "toEnum: unexpected negative Int" -    fromEnum (NS w)-      | i >= 0    = i-      | otherwise = errorWithoutStackTrace "fromEnum: out of Int range"+    fromEnum (NS w) | i >= 0 = i       where         i = I# (word2Int# w)-    fromEnum n = fromEnum (integerFromNatural n)+    fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range" +    -- See Note [Stable Unfolding for list producers]+    {-# INLINE enumFrom #-}     enumFrom x        = enumDeltaNatural      x 1++    -- See Note [Stable Unfolding for list producers]+    {-# INLINE enumFromThen #-}     enumFromThen x y       | x <= y        = enumDeltaNatural      x (y-x)       | otherwise     = enumNegDeltaToNatural x (x-y) 0 +    -- See Note [Stable Unfolding for list producers]+    {-# INLINE enumFromTo #-}     enumFromTo x lim  = enumDeltaToNatural    x 1 lim++    -- See Note [Stable Unfolding for list producers]+    {-# INLINE enumFromThenTo #-}     enumFromThenTo x y lim       | x <= y        = enumDeltaToNatural    x (y-x) lim       | otherwise     = enumNegDeltaToNatural x (x-y) lim@@ -1006,12 +1014,16 @@ enumDeltaNatural :: Natural -> Natural -> [Natural] enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d +-- Inline to specialize+{-# INLINE enumDeltaToNatural #-} enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural] enumDeltaToNatural x0 delta lim = go x0   where     go x | x > lim   = []          | otherwise = x : go (x+delta) +-- Inline to specialize+{-# INLINE enumNegDeltaToNatural #-} enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural] enumNegDeltaToNatural x0 ndelta lim = go x0   where

@@ -54,16 +54,12 @@ -- a partial stack trace, containing the call-site of each function -- with a HasCallStack constraint. ----- In base, however, the only functions that have such constraints are--- error and undefined, so the stack traces from partial functions in--- base will never contain a call-site in user code. Instead we'll--- usually just get the actual call to error. Base functions already--- have a good habit of providing detailed error messages, including the--- name of the offending partial function, so the partial stack-trace--- does not provide any extra information, just noise. Thus, we export--- the callstack-aware error, but within base we use the--- errorWithoutStackTrace variant for more hygienic error messages.-+-- In base, error and undefined were the only functions that had such+-- constraint. Errors like "Prelude.!!: negative index" are good, yet if the+-- code base contains dozens of !! applications (including dependencies,+-- which code is not as easily accessible), pinpointing the bad call is+-- where the stack trace would help.  Therefore we annotate most calls to+-- error, so users have a chance to get a better idea.  -- | A special case of 'error'. -- It is expected that compilers will recognize this and insert error@@ -71,7 +67,13 @@ -- appears. undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r).              HasCallStack => a-undefined =  error "Prelude.undefined"+-- This used to be+--   undefined = error "Prelude.undefined"+-- but that would add an extra call stack entry that is not actually helpful+-- nor wanted (see #19886). We’d like to use withFrozenCallStack, but that+-- is not available in this module yet, and making it so is hard. So let’s just+-- use raise# directly.+undefined = raise# (errorCallWithCallStackException "Prelude.undefined" ?callStack)  -- | Used for compiler-generated error message; -- encoding saves bytes of string junk.

@@ -6,7 +6,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- Abstraction over C Handle types for GHC, Unix wants FD (CInt) while Windows

@@ -18,7 +18,7 @@ -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_)-import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)+import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError)@@ -29,8 +29,7 @@ import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,                       labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,                       getNumCapabilities, threadCapability, myThreadId, forkOn,-                      threadStatus, writeTVar, newTVarIO, readTVar, retry,-                      throwSTM, STM, yield)+                      threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,@@ -42,7 +41,6 @@                              new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM-import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt)@@ -100,45 +98,23 @@ closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.             -> Fd                   -- ^ File descriptor to close.             -> IO ()-closeFdWith close fd = close_loop+closeFdWith close fd = do+  eventManagerArray <- readIORef eventManager+  let (low, high) = boundsIOArray eventManagerArray+  mgrs <- flip mapM [low..high] $ \i -> do+    Just (_,!mgr) <- readIOArray eventManagerArray i+    return mgr+  -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.+  -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have+  -- to use uninterruptible mask.+  uninterruptibleMask_ $ do+    tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd+    cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables+    close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)   where     finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp     zipWithM f xs ys = sequence (zipWith f xs ys)-      -- The array inside 'eventManager' can be swapped out at any time, see-      -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by-      -- checking the array bounds before and after. When such a swap has-      -- happened we cleanup and try again-    close_loop = do-      eventManagerArray <- readIORef eventManager-      let ema_bounds@(low, high) = boundsIOArray eventManagerArray-      mgrs <- flip mapM [low..high] $ \i -> do-        Just (_,!mgr) <- readIOArray eventManagerArray i-        return mgr -      -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time.-      -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have-      -- to use uninterruptible mask.-      join $ uninterruptibleMask_ $ do-        tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd-        new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager-        -- Here we exploit Note [The eventManager Array]-        if new_ema_bounds /= ema_bounds-          then do-            -- the array has been modified.-            -- mgrs still holds the right EventManagers, by the Note.-            -- new_ema_bounds must be larger than ema_bounds, by the note.-            -- return the MVars we took and try again-            sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables-            pure close_loop-          else do-            -- We surely have taken all the appropriate MVars. Even if the array-            -- has been swapped, our mgrs is still correct.-            -- Remove the Fd from all callback tables, close the Fd, and run all-            -- callbacks.-            cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables-            close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)-            pure (pure ())- threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do   m <- newEmptyMVar@@ -201,24 +177,10 @@ getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do   t <- myThreadId-  eventManagerArray <- readIORef eventManager-  let r = boundsIOArray eventManagerArray   (cap, _) <- threadCapability t-  -- It is possible that we've just increased the number of capabilities and the-  -- new EventManager has not yet been constructed by-  -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely.-  -- T21561 exercises this.-  -- Two options to proceed:-  --  1) return the EventManager for capability 0. This is guaranteed to exist,-  --     and "shouldn't" cause any correctness issues.-  --  2) Busy wait, with or without a call to 'yield'. This can't deadlock,-  --     because we must be on a brand capability and there must be a call to-  --     'ioManagerCapabilitiesChanged' pending.-  ---  -- We take the second option, with the yield, judging it the most robust.-  if not (inRange r cap)-    then yield >> getSystemEventManager-    else fmap snd `fmap` readIOArray eventManagerArray cap+  eventManagerArray <- readIORef eventManager+  mmgr <- readIOArray eventManagerArray cap+  return $ fmap snd mmgr  getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do@@ -229,22 +191,6 @@ foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"     getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) --- Note [The eventManager Array]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- A mutable array holding the current EventManager for each capability--- An entry is Nothing only while the eventmanagers are initialised, see--- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'.--- The 'ThreadId' at array position 'cap'  will have been 'forkOn'ed capabality--- 'cap'.--- The array will be swapped with newer arrays when the number of capabilities--- changes(via 'setNumCapabilities'). However:---   * the size of the arrays will never decrease; and---   * The 'EventManager's in the array are not replaced with other---     'EventManager' constructors.------ This is a similar strategy as the rts uses for it's--- capabilities array (n_capabilities is the size of the array,--- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do     numCaps <- getNumCapabilities@@ -405,9 +351,7 @@                 startIOManagerThread new_eventManagerArray                -- update the event manager array reference:-              atomicWriteIORef eventManager new_eventManagerArray-              -- We need an atomic write here because 'eventManager' is accessed-              -- unsynchronized in 'getSystemEventManager' and 'closeFdWith'+              writeIORef eventManager new_eventManagerArray       else when (new_n_caps > numEnabled) $             forM_ [numEnabled..new_n_caps-1] $ \i -> do               Just (_,mgr) <- readIOArray eventManagerArray i

@@ -6,7 +6,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- Common Timer definitions shared between WinIO and RIO.

@@ -14,7 +14,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- WinIO Windows event manager.@@ -481,7 +481,7 @@  -- | A handle value representing an invalid handle. invalidHandle :: HANDLE-invalidHandle = intPtrToPtr (#{const INVALID_HANDLE_VALUE})+invalidHandle = iNVALID_HANDLE_VALUE  -- | Associate a 'HANDLE' with the I/O manager's completion port.  This must be -- done before using the handle with 'withOverlapped'.@@ -495,9 +495,8 @@       FFI.associateHandleWithIOCP mgrIOCP h (fromIntegral $ ptrToWordPtr h)  -{- Note [Why use non-waiting getOverlappedResult requests.]-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-+{- Note [Why use non-waiting getOverlappedResult requests]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   When waiting for a request that is bound to be done soon   we spin inside waitForCompletion. There are multiple reasons   for this.@@ -549,6 +548,7 @@               IOFailed  err -> signalThrow err        -- Note [Memory Management]+      -- ~~~~~~~~~~~~~~~~~~~~~~~~       -- These callback data and especially the overlapped structs have to keep       -- alive throughout the entire lifetime of the requests.   Since this       -- function will block until done so it can call completionCB at the end@@ -750,7 +750,7 @@               -- otherwise the RTS will lock up until we get a result back.               -- In the threaded case it can be beneficial to spin on the haskell               -- side versus-              -- See also Note [Why use non-waiting getOverlappedResult requests.]+              -- See also Note [Why use non-waiting getOverlappedResult requests]               res <- FFI.getOverlappedResult fhndl lpol False               status <- FFI.overlappedIOStatus lpol               case res of

@@ -13,7 +13,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- WinIO Windows API Foreign Function imports@@ -136,6 +136,7 @@                                   -> Ptr ULONG -> DWORD -> BOOL -> IO BOOL  -- | Note [Completion Ports]+--   ~~~~~~~~~~~~~~~~~~~~~~~ -- When an I/O operation has been queued by an operation -- (ReadFile/WriteFile/etc) it is placed in a queue that the driver uses when -- servicing IRQs.  This queue has some important properties:@@ -343,7 +344,8 @@ ------------------------------------------------------------------------ -- Request management --- [Note AsyncHandles]+-- Note [AsyncHandles]+-- ~~~~~~~~~~~~~~~~~~~ -- In `winio` we have designed it to work in asynchronous mode always. -- According to the MSDN documentation[1][2], when a handle is not opened -- in asynchronous mode then the operation would simply work but operate@@ -392,7 +394,7 @@ --    invalid.  This is an issue because to pass `HANDLE`s we have to pass --    the native OS Handle not the Haskell one. i.e. remote-iserv. --- See [Note AsyncHandles]+-- See Note [AsyncHandles] withRequest :: Bool -> Word64 -> HANDLE -> IOCallback             -> (Ptr HASKELL_OVERLAPPED -> Ptr CompletionData -> IO a)             -> IO a

@@ -11,7 +11,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- WinIO Windows Managed Thread pool API.  This thread pool scales dynamically

@@ -38,13 +38,15 @@ import GHC.Show import GHC.Stack.Types import GHC.OldList-import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS import GHC.Exception.Type  -- | Throw an exception.  Exceptions may be thrown from purely -- functional code, but may only be caught within the 'IO' monad.+--+-- WARNING: You may want to use 'throwIO' instead so that your pure code+-- stays exception-free. throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.          Exception e => e -> a throw e = raise# (toException e)

@@ -41,7 +41,7 @@ import Foreign.Storable (Storable(..)) import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO) --- N.B. See includes/rts/Libdw.h for notes on stack representation.+-- N.B. See rts/include/rts/Libdw.h for notes on stack representation.  -- | A location in the original program source. data SrcLoc = SrcLoc { sourceFile   :: String

@@ -6,6 +6,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}  ----------------------------------------------------------------------------- -- |@@ -24,26 +25,45 @@  module GHC.Exts        (-        -- * Representations of some basic types-        Int(..),Word(..),Float(..),Double(..),-        Char(..),+        -- ** Pointer types         Ptr(..), FunPtr(..), -        -- * The maximum tuple size-        maxTupleSize,+        -- ** Other primitive types+        module GHC.Types, +        -- ** Legacy interface for arrays of arrays+        module GHC.ArrayArray,+         -- * Primitive operations-        FUN, -- See https://gitlab.haskell.org/ghc/ghc/issues/18302+         module GHC.Prim,         module GHC.Prim.Ext,++        -- ** Running 'RealWorld' state thread+        runRW#,++        -- ** Bit shift operations         shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,-        isTrue#,-        Void#,  -- Previously exported by GHC.Prim -        -- * Compat wrapper+        -- ** Pointer comparison operations+        -- See `Note [Pointer comparison operations]` in primops.txt.pp+        reallyUnsafePtrEquality,+        eqStableName#,+        sameArray#,+        sameMutableArray#,+        sameSmallArray#,+        sameSmallMutableArray#,+        sameByteArray#,+        sameMutableByteArray#,+        sameMVar#,+        sameMutVar#,+        sameTVar#,+        sameIOPort#,++        -- ** Compat wrapper         atomicModifyMutVar#, -        -- * Resize functions+        -- ** Resize functions         --         -- | Resizing arrays of boxed elements is currently handled in         -- library space (rather than being a primop) since there is not@@ -51,13 +71,20 @@         -- may become primops in a future release of GHC.         resizeSmallMutableArray#, -        -- * Fusion+        -- ** Fusion         build, augment, -        -- * Overloaded string literals+        -- * Overloaded lists+        IsList(..),++        -- * Transform comprehensions+        Down(..), groupWith, sortWith, the,++        -- * Strings+        -- ** Overloaded string literals         IsString(..), -        -- * CString+        -- ** CString         unpackCString#,         unpackAppendCString#,         unpackFoldrCString#,@@ -66,72 +93,61 @@         cstringLength#,          -- * Debugging+        -- ** Breakpoints         breakpoint, breakpointCond, +        -- ** Event logging+        traceEvent,++        -- ** The call stack+        currentCallStack,+         -- * Ids with special behaviour-        inline, noinline, lazy, oneShot, considerAccessible, SPEC (..),+        inline, noinline, lazy, oneShot, considerAccessible, -        -- * Running 'RealWorld' state thread-        runRW#,+        -- * SpecConstr annotations+        SpecConstrAnnotation(..), SPEC (..), -        -- * Safe coercions+        -- * Coercions+        -- ** Safe coercions         ---        -- | These are available from the /Trustworthy/ module "Data.Coerce" as well+        -- | These are available from the /Trustworthy/ module "Data.Coerce" as well.         --         -- @since 4.7.0.0-        Data.Coerce.coerce, Data.Coerce.Coercible,+        Data.Coerce.coerce, -        -- * Very unsafe coercion+        -- ** Very unsafe coercion         unsafeCoerce#, -        -- * Equality-        type (~~),--        -- * Representation polymorphism-        GHC.Prim.TYPE, RuntimeRep(..), Levity(..),-        LiftedRep, UnliftedRep, UnliftedType,-        VecCount(..), VecElem(..),--        -- * Transform comprehensions-        Down(..), groupWith, sortWith, the,--        -- * Event logging-        traceEvent,--        -- * SpecConstr annotations-        SpecConstrAnnotation(..),--        -- * The call stack-        currentCallStack,--        -- * The Constraint kind-        Constraint,--        -- * The Any type-        Any,+        -- ** Casting class dictionaries with single methods+        WithDict(..), -        -- * Overloaded lists-        IsList(..)+        -- * The maximum tuple size+        maxTupleSize,        ) where -import GHC.Prim hiding ( coerce, TYPE )-import qualified GHC.Prim+import GHC.Prim hiding ( coerce )+import GHC.Types+  hiding ( IO   -- Exported from "GHC.IO"+         , Type -- Exported from "Data.Kind"++           -- GHC's internal representation of 'TyCon's, for 'Typeable'+         , Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr ) import qualified GHC.Prim.Ext+import GHC.ArrayArray import GHC.Base hiding ( coerce ) import GHC.Ptr import GHC.Stack+import GHC.IsList (IsList(..)) -- for re-export  import qualified Data.Coerce import Data.String import Data.OldList import Data.Data import Data.Ord-import Data.Version ( Version(..), makeVersion ) import qualified Debug.Trace import Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export -import Control.Applicative (ZipList(..))- -- XXX This should really be in Data.Tuple, where the definitions are maxTupleSize :: Int maxTupleSize = 64@@ -146,6 +162,11 @@  -- | The 'sortWith' function sorts a list of elements using the -- user supplied function to project something out of each element+--+-- In general if the user supplied function is expensive to compute then+-- you should probably be using 'Data.List.sortOn', as it only needs+-- to compute it once for each element. 'sortWith', on the other hand+-- must compute the mapping function for every comparison that it performs. sortWith :: Ord b => (a -> b) -> [a] -> [a] sortWith f = sortBy (\x y -> compare (f x) (f y)) @@ -191,73 +212,6 @@                          )  -{- **********************************************************************-*                                                                       *-*              The IsList class                                         *-*                                                                       *-********************************************************************** -}---- | The 'IsList' class and its methods are intended to be used in---   conjunction with the OverloadedLists extension.------ @since 4.7.0.0-class IsList l where-  -- | The 'Item' type function returns the type of items of the structure-  --   @l@.-  type Item l--  -- | The 'fromList' function constructs the structure @l@ from the given-  --   list of @Item l@-  fromList  :: [Item l] -> l--  -- | The 'fromListN' function takes the input list's length and potentially-  --   uses it to construct the structure @l@ more efficiently compared to-  --   'fromList'. If the given number does not equal to the input list's length-  --   the behaviour of 'fromListN' is not specified.-  ---  --   prop> fromListN (length xs) xs == fromList xs-  fromListN :: Int -> [Item l] -> l-  fromListN _ = fromList--  -- | The 'toList' function extracts a list of @Item l@ from the structure @l@.-  --   It should satisfy fromList . toList = id.-  toList :: l -> [Item l]---- | @since 4.7.0.0-instance IsList [a] where-  type (Item [a]) = a-  fromList = id-  toList = id---- | @since 4.15.0.0-instance IsList (ZipList a) where-  type Item (ZipList a) = a-  fromList = ZipList-  toList = getZipList---- | @since 4.9.0.0-instance IsList (NonEmpty a) where-  type Item (NonEmpty a) = a--  fromList (a:as) = a :| as-  fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"--  toList ~(a :| as) = a : as---- | @since 4.8.0.0-instance IsList Version where-  type (Item Version) = Int-  fromList = makeVersion-  toList = versionBranch---- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's,--- since 'toList' removes frozenness information.------ @since 4.9.0.0-instance IsList CallStack where-  type (Item CallStack) = (String, SrcLoc)-  fromList = fromCallSiteList-  toList   = getCallStack  -- | An implementation of the old @atomicModifyMutVar#@ primop in -- terms of the new 'atomicModifyMutVar2#' primop, for backwards

@@ -355,32 +355,66 @@         minEx       = FLT_MIN_EXP         mantDigs    = FLT_MANT_DIG +-- | @since 2.01+instance  RealFrac Float  where++   properFraction = properFractionFloat+   truncate       = truncateFloat+   round          = roundFloat+   floor          = floorFloat+   ceiling        = ceilingFloat+ -- RULES for Integer and Int+-- Note [Rules for overloaded class methods] {-# RULES-"properFraction/Float->Integer"     properFraction = properFractionFloatInteger-"truncate/Float->Integer"           truncate = truncateFloatInteger-"floor/Float->Integer"              floor = floorFloatInteger-"ceiling/Float->Integer"            ceiling = ceilingFloatInteger-"round/Float->Integer"              round = roundFloatInteger-"properFraction/Float->Int"         properFraction = properFractionFloatInt-"truncate/Float->Int"               truncate = float2Int-"floor/Float->Int"                  floor = floorFloatInt-"ceiling/Float->Int"                ceiling = ceilingFloatInt-"round/Float->Int"                  round = roundFloatInt+"properFraction/Float->Integer"     properFractionFloat = properFractionFloatInteger+"truncate/Float->Integer"           truncateFloat = truncateFloatInteger+"floor/Float->Integer"              floorFloat = floorFloatInteger+"ceiling/Float->Integer"            ceilingFloat = ceilingFloatInteger+"round/Float->Integer"              roundFloat = roundFloatInteger+"properFraction/Float->Int"         properFractionFloat = properFractionFloatInt+"truncate/Float->Int"               truncateFloat = float2Int+"floor/Float->Int"                  floorFloat = floorFloatInt+"ceiling/Float->Int"                ceilingFloat = ceilingFloatInt+"round/Float->Int"                  roundFloat = roundFloatInt   #-}--- | @since 2.01-instance  RealFrac Float  where -        -- ceiling, floor, and truncate are all small-    {-# INLINE [1] ceiling #-}-    {-# INLINE [1] floor #-}-    {-# INLINE [1] truncate #-} +floorFloat :: Integral b => Float -> b+{-# INLINE [1] floorFloat #-}+floorFloat x = case properFractionFloat x of+                    (n,r) -> if r < 0.0 then n - 1 else n++ceilingFloat :: Integral b => Float -> b+{-# INLINE [1] ceilingFloat #-}+ceilingFloat x = case properFraction x of+                    (n,r) -> if r > 0.0 then n + 1 else n++truncateFloat :: Integral b => Float -> b+{-# INLINE [1] truncateFloat #-}+truncateFloat x = case properFractionFloat x of+                     (n,_) -> n++roundFloat :: Integral b => Float -> b+{-# NOINLINE [1] roundFloat #-}+roundFloat x = case properFractionFloat x of+                     (n,r) -> let+                                m         = if r < 0.0 then n - 1 else n + 1+                                half_down = abs r - 0.5+                              in+                              case (compare half_down 0.0) of+                                LT -> n+                                EQ -> if even n then n else m+                                GT -> m++properFractionFloat :: Integral b => Float -> (b,Float)+{-# NOINLINE [1] properFractionFloat #-}+ -- We assume that FLT_RADIX is 2 so that we can use more efficient code #if FLT_RADIX != 2 #error FLT_RADIX must be 2 #endif-    properFraction (F# x#)+properFractionFloat (F# x#)       = case decodeFloat_Int# x# of         (# m#, n# #) ->             let m = I# m#@@ -393,25 +427,8 @@                      f = m - (i `shiftL` negate n)                  in (fromIntegral i, encodeFloat (fromIntegral f) n) -    truncate x  = case properFraction x of-                     (n,_) -> n -    round x     = case properFraction x of-                     (n,r) -> let-                                m         = if r < 0.0 then n - 1 else n + 1-                                half_down = abs r - 0.5-                              in-                              case (compare half_down 0.0) of-                                LT -> n-                                EQ -> if even n then n else m-                                GT -> m -    ceiling x   = case properFraction x of-                    (n,r) -> if r > 0.0 then n + 1 else n--    floor x     = case properFraction x of-                    (n,r) -> if r < 0.0 then n - 1 else n- -- | @since 2.01 instance  Floating Float  where     pi                  =  3.141592653589793238@@ -600,56 +617,119 @@       | otherwise = a     {-# INLINE log1pexp #-} +-- | @since 2.01+instance  RealFrac Double  where+    properFraction = properFractionDouble+    truncate       = truncateDouble+    round          = roundDouble+    ceiling        = ceilingDouble+    floor          = floorDouble+ -- RULES for Integer and Int+-- Note [Rules for overloaded class methods] {-# RULES-"properFraction/Double->Integer"    properFraction = properFractionDoubleInteger-"truncate/Double->Integer"          truncate = truncateDoubleInteger-"floor/Double->Integer"             floor = floorDoubleInteger-"ceiling/Double->Integer"           ceiling = ceilingDoubleInteger-"round/Double->Integer"             round = roundDoubleInteger-"properFraction/Double->Int"        properFraction = properFractionDoubleInt-"truncate/Double->Int"              truncate = double2Int-"floor/Double->Int"                 floor = floorDoubleInt-"ceiling/Double->Int"               ceiling = ceilingDoubleInt-"round/Double->Int"                 round = roundDoubleInt+"properFraction/Double->Integer"    properFractionDouble = properFractionDoubleInteger+"truncate/Double->Integer"          truncateDouble = truncateDoubleInteger+"floor/Double->Integer"             floorDouble = floorDoubleInteger+"ceiling/Double->Integer"           ceilingDouble = ceilingDoubleInteger+"round/Double->Integer"             roundDouble = roundDoubleInteger+"properFraction/Double->Int"        properFractionDouble = properFractionDoubleInt+"truncate/Double->Int"              truncateDouble = double2Int+"floor/Double->Int"                 floorDouble = floorDoubleInt+"ceiling/Double->Int"               ceilingDouble = ceilingDoubleInt+"round/Double->Int"                 roundDouble = roundDoubleInt   #-}--- | @since 2.01-instance  RealFrac Double  where -        -- ceiling, floor, and truncate are all small-    {-# INLINE [1] ceiling #-}-    {-# INLINE [1] floor #-}-    {-# INLINE [1] truncate #-}+floorDouble :: Integral b => Double -> b+{-# INLINE [1] floorDouble #-}+floorDouble x = case properFractionDouble x of+                    (n,r) -> if r < 0.0 then n - 1 else n -    properFraction x-      = case (decodeFloat x)      of { (m,n) ->-        if n >= 0 then-            (fromInteger m * 2 ^ n, 0.0)-        else-            case (quotRem m (2^(negate n))) of { (w,r) ->-            (fromInteger w, encodeFloat r n)-            }-        }+ceilingDouble :: Integral b => Double -> b+{-# INLINE [1] ceilingDouble #-}+ceilingDouble x = case properFractionDouble x of+                    (n,r) -> if r > 0.0 then n + 1 else n -    truncate x  = case properFraction x of+truncateDouble :: Integral b => Double -> b+{-# INLINE [1] truncateDouble #-}+truncateDouble x = case properFractionDouble x of                      (n,_) -> n -    round x     = case properFraction x of-                     (n,r) -> let-                                m         = if r < 0.0 then n - 1 else n + 1-                                half_down = abs r - 0.5-                              in-                              case (compare half_down 0.0) of-                                LT -> n-                                EQ -> if even n then n else m-                                GT -> m+roundDouble :: Integral b => Double -> b+{-# NOINLINE [1] roundDouble #-}+roundDouble x+  = case properFractionDouble x of+      (n,r) -> let+                 m         = if r < 0.0 then n - 1 else n + 1+                 half_down = abs r - 0.5+               in+               case (compare half_down 0.0) of+                 LT -> n+                 EQ -> if even n then n else m+                 GT -> m -    ceiling x   = case properFraction x of-                    (n,r) -> if r > 0.0 then n + 1 else n+properFractionDouble :: Integral b => Double -> (b,Double)+{-# NOINLINE [1] properFractionDouble #-}+properFractionDouble x+  = case (decodeFloat x)      of { (m,n) ->+    if n >= 0 then+        (fromInteger m * 2 ^ n, 0.0)+    else+        case (quotRem m (2^(negate n))) of { (w,r) ->+        (fromInteger w, encodeFloat r n)+        }+    } -    floor x     = case properFraction x of-                    (n,r) -> if r < 0.0 then n - 1 else n+{- Note [Rules for overloaded class methods]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider a method like+    class ... => RealFrac a where+       floor :: Integral b => a -> b +So floor :: forall a. RealFrac a => forall b. Integral b => a -> b++Now suppose we want to hand-write specialised code for+(floor @Double d1 @Int d2). We used to do this:+   RULE "floor/Double->Int" floor = floorDoubleInt+where GHC.Float.RealFracMethods defines+   floorDoubleInt :: Double -> Int++This RULE in full is+   RULE "floor/Double->Int" forall d1 d2.+         floor @Double d1 @Int d2 = floorDoubleInt++But it's best not to write one rule for this entire step. I found cases+(in nofib/real/gamteb/Utils.hs, function fiRem) where we floated+out the (floor @Double d1) part, so the above two-argument rule didn't fire.+Instead the class-op rule fired.  Boo!  See #19582.++Best to define an instance+   instance RealFrac Double where+      floor = floorDouble++   floorDouble :: Integral b => Double -> b+   floorDouble = <code for floorDouble>+   {-# RULE "floorDouble/Int" floorDouble @Int d = floorDoubleInt #-}++Now we rewrite as follows+   floor @Double d1 @Int d2+   --> { ClassOp rule for floor }+       floorDouble @Int d2+   --> { Hand-written RULE "floorDouble/Int" }+       floorDoubleInt++More robust!  This pattern applies for any class method that+has local overloading, in particular:+  * properFraction+  * truncate+  * floor+  * ceiling+  * round++All of this is really stated, in more general form, in the GHC+user manual section "How rules interact with class methods".+-}+ -- | @since 2.01 instance  RealFloat Double  where     floatRadix _        =  FLT_RADIX        -- from float.h@@ -1045,7 +1125,8 @@ "fromRat/Double"    fromRat = (fromRational :: Rational -> Double)   #-} -{-# NOINLINE [1] fromRat #-}+{-# NOINLINE [2] fromRat #-}+-- See Note [Allow time for type-specialisation rules to fire] in GHC.Real fromRat :: (RealFloat a) => Rational -> a  -- Deal with special cases first, delegating the real work to fromRat'@@ -1213,7 +1294,7 @@                  then 2#                  else 1# -roundingMode# (IN bn) t = roundingMode# (IP bn) t -- dummy+roundingMode# (IN _)  _ = errorWithoutStackTrace "roundingMode#: IN" -- See the Assumption roundingMode# (IP bn) t =    let       j = word2Int# (int2Word# t `and#` MMASK##) -- index of relevant bit in word@@ -1421,6 +1502,15 @@ We must have a large enough range to cover the maximum difference of exponents returned by decodeFloat. -}++-- | Used to prevent exponent over/underflow when encoding floating point numbers.+--   This is also the same as+--+--   > \(x,y) -> max (-x) (min x y)+--+-- ==== __Example__+-- >>> clamp (-10) 5+-- 10 clamp :: Int -> Int -> Int clamp bd k = max (-bd) (min bd k) @@ -1441,8 +1531,8 @@ that performs an integer/word operation on a floating-point register, which results in a compile error. -The correct way of implementing `reinterpret_cast` to implement a primpop, but-that requires a unique implementation for all supported archetectures. The next+The correct way of implementing `reinterpret_cast` to implement a primop, but+that requires a unique implementation for all supported architectures. The next best solution is to write the value from the source register to memory and then read it from memory into the destination register and the best way to do that is using CMM.@@ -1485,11 +1575,7 @@ castWord64ToDouble (W64# w) = D# (stgWord64ToDouble w)  foreign import prim "stg_word64ToDoublezh"-#if WORD_SIZE_IN_BITS == 64-    stgWord64ToDouble :: Word# -> Double#-#else     stgWord64ToDouble :: Word64# -> Double#-#endif   -- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value@@ -1502,8 +1588,28 @@ castDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#)  foreign import prim "stg_doubleToWord64zh"-#if WORD_SIZE_IN_BITS == 64-    stgDoubleToWord64 :: Double# -> Word#-#else     stgDoubleToWord64 :: Double# -> Word64#-#endif++++-- See Note [Optimising conversions between numeric types]+-- in GHC.Num.Integer+{-# RULES++"Int# -> Integer -> Float#"+  forall x. integerToFloat# (IS x) = int2Float# x++"Int# -> Integer -> Double#"+  forall x. integerToDouble# (IS x) = int2Double# x++"Word# -> Integer -> Float#"+  forall x. integerToFloat# (integerFromWord# x) = word2Float# x++"Word# -> Integer -> Double#"+  forall x. integerToDouble# (integerFromWord# x) = word2Double# x++"Word# -> Natural -> Float#"+  forall x. naturalToFloat# (NS x) = word2Float# x++"Word# -> Natural -> Double#"+  forall x. naturalToDouble# (NS x) = word2Double# x #-}

@@ -56,10 +56,12 @@  import GHC.Num.Integer -import GHC.Base+import GHC.Base hiding (uncheckedIShiftRA64#, uncheckedIShiftL64#) import GHC.Num ()  #if WORD_SIZE_IN_BITS < 64++import GHC.Base (uncheckedIShiftRA64#, uncheckedIShiftL64#)  #define TO64 integerToInt64# #define FROM64 integerFromInt64#

@@ -295,7 +295,6 @@ {- Note [Check *before* fill in withEncodedCString] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- It's very important that the size check and readjustment peformed by tryFillBuffer happens before the continuation is called. The size check is the part which can fail, the call to the continuation never fails and so the caller should respond

@@ -165,7 +165,7 @@     -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well.  -- Note [Why FinalPtr]---+-- ~~~~~~~~~~~~~~~~~~~ -- FinalPtr exists as an optimization for foreign pointers created -- from Addr# literals. Most commonly, this happens in the bytestring -- library, where the combination of OverloadedStrings and a rewrite@@ -376,7 +376,9 @@   MallocPtr     _ r -> insertCFinalizer r fp 0# nullAddr# p c   _ -> errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer or a final pointer" --- Note [MallocPtr finalizers] (#10904)+-- Note [MallocPtr finalizers]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Ticket: #10904 -- -- When we have C finalizers for a MallocPtr, the memory is -- heap-resident and would normally be recovered by the GC before the

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}+ {-# LANGUAGE CPP                        #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveFunctor              #-}@@ -7,12 +9,15 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-} {-# LANGUAGE MagicHash                  #-} {-# LANGUAGE NoImplicitPrelude          #-} {-# LANGUAGE PolyKinds                  #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE StandaloneKindSignatures   #-} {-# LANGUAGE Trustworthy                #-}+{-# LANGUAGE TypeApplications           #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeOperators              #-} {-# LANGUAGE UndecidableInstances       #-}@@ -720,17 +725,21 @@   , Meta(..)    -- * Generic type classes-  , Generic(..), Generic1(..)+  , Generic(..)+  , Generic1(..) +  -- * Generic wrapper+  , Generically(..)+  , Generically1(..)   ) where  -- We use some base types-import Data.Either ( Either (..) )-import Data.Maybe  ( Maybe(..), fromMaybe )-import Data.Ord    ( Down(..) )+import Data.Either     ( Either (..) )+import Data.Maybe      ( Maybe(..), fromMaybe )+import Data.Ord        ( Down(..) ) import GHC.Num.Integer ( Integer, integerToInt )-import GHC.Prim    ( Addr#, Char#, Double#, Float#, Int#, Word# )-import GHC.Ptr     ( Ptr )+import GHC.Prim        ( Addr#, Char#, Double#, Float#, Int#, Word# )+import GHC.Ptr         ( Ptr ) import GHC.Types  -- Needed for instances@@ -1364,6 +1373,147 @@   from1  :: f a -> (Rep1 f) a   -- | Convert from the representation to the datatype   to1    :: (Rep1 f) a -> f a++--------------------------------------------------------------------------------+-- 'Generic' wrapper+--------------------------------------------------------------------------------++-- | A datatype whose instances are defined generically, using the+-- 'Generic' representation. 'Generically1' is a higher-kinded version+-- of 'Generically' that uses 'Generic1'.+--+-- Generic instances can be derived via @'Generically' A@ using+-- @-XDerivingVia@.+--+-- @+-- {-# LANGUAGE DeriveGeneric      #-}+-- {-# LANGUAGE DerivingStrategies #-}+-- {-# LANGUAGE DerivingVia        #-}+--+-- import GHC.Generics (Generic)+--+-- data V4 a = V4 a a a a+--   deriving stock Generic+--+--   deriving (Semigroup, Monoid)+--   via Generically (V4 a)+-- @+--+-- This corresponds to 'Semigroup' and 'Monoid' instances defined by+-- pointwise lifting:+--+-- @+-- instance Semigroup a => Semigroup (V4 a) where+--   (<>) :: V4 a -> V4 a -> V4 a+--   V4 a1 b1 c1 d1 <> V4 a2 b2 c2 d2 =+--     V4 (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2)+--+-- instance Monoid a => Monoid (V4 a) where+--   mempty :: V4 a+--   mempty = V4 mempty mempty mempty mempty+-- @+--+-- Historically this required modifying the type class to include+-- generic method definitions (@-XDefaultSignatures@) and deriving it+-- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via+-- type/ like 'Generically' decouples the instance from the type+-- class.+--+-- @since 4.17.0.0+newtype Generically a = Generically a++-- | @since 4.17.0.0+instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where+  (<>) :: Generically a -> Generically a -> Generically a+  Generically a <> Generically b = Generically (to (from a <> from b :: Rep a ()))++-- | @since 4.17.0.0+instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where+  mempty :: Generically a+  mempty = Generically (to (mempty :: Rep a ()))++  mappend :: Generically a -> Generically a -> Generically a+  mappend = (<>)++-- | A type whose instances are defined generically, using the+-- 'Generic1' representation. 'Generically1' is a higher-kinded+-- version of 'Generically' that uses 'Generic'.+--+-- Generic instances can be derived for type constructors via+-- @'Generically1' F@ using @-XDerivingVia@.+--+-- @+-- {-# LANGUAGE DeriveGeneric      #-}+-- {-# LANGUAGE DerivingStrategies #-}+-- {-# LANGUAGE DerivingVia        #-}+--+-- import GHC.Generics (Generic)+--+-- data V4 a = V4 a a a a+--   deriving stock (Functor, Generic1)+--+--   deriving Applicative+--   via Generically1 V4+-- @+--+-- This corresponds to 'Applicative' instances defined by pointwise+-- lifting:+--+-- @+-- instance Applicative V4 where+--   pure :: a -> V4 a+--   pure a = V4 a a a a+--+--   liftA2 :: (a -> b -> c) -> (V4 a -> V4 b -> V4 c)+--   liftA2 (·) (V4 a1 b1 c1 d1) (V4 a2 b2 c2 d2) =+--     V4 (a1 · a2) (b1 · b2) (c1 · c2) (d1 · d2)+-- @+--+-- Historically this required modifying the type class to include+-- generic method definitions (@-XDefaultSignatures@) and deriving it+-- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via+-- type/ like 'Generically1' decouples the instance from the type+-- class.+--+-- @since 4.17.0.0+type    Generically1 :: forall k. (k -> Type) -> (k -> Type)+newtype Generically1 f a where+  Generically1 :: forall {k} f a. f a -> Generically1 @k f a++-- | @since 4.17.0.0+instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where+  fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a')+  fmap f (Generically1 as) = Generically1+    (to1 (fmap f (from1 as)))++  (<$) :: a -> Generically1 f b -> Generically1 f a+  a <$ Generically1 as = Generically1+    (to1 (a <$ from1 as))++-- | @since 4.17.0.0+instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where+  pure :: a -> Generically1 f a+  pure a = Generically1+    (to1 (pure a))++  (<*>) :: Generically1 f (a1 -> a2) -> Generically1 f a1 -> Generically1 f a2+  Generically1 fs <*> Generically1 as = Generically1+    (to1 (from1 fs <*> from1 as))++  liftA2 :: (a1 -> a2 -> a3)+         -> (Generically1 f a1 -> Generically1 f a2 -> Generically1 f a3)+  liftA2 (·) (Generically1 as) (Generically1 bs) = Generically1+    (to1 (liftA2 (·) (from1 as) (from1 bs)))++-- | @since 4.17.0.0+instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where+  empty :: Generically1 f a+  empty = Generically1+    (to1 empty)++  (<|>) :: Generically1 f a -> Generically1 f a -> Generically1 f a+  Generically1 as1 <|> Generically1 as2 = Generically1+    (to1 (from1 as1 <|> from1 as2))  -------------------------------------------------------------------------------- -- Meta-data

@@ -207,16 +207,34 @@ -- Although 'throwIO' has a type that is an instance of the type of 'throw', the -- two functions are subtly different: ----- > throw e   `seq` x  ===> throw e--- > throwIO e `seq` x  ===> x+-- > throw e   `seq` ()  ===> throw e+-- > throwIO e `seq` ()  ===> () -- -- The first example will cause the exception @e@ to be raised, -- whereas the second one won\'t.  In fact, 'throwIO' will only cause -- an exception to be raised when it is used within the 'IO' monad.+-- -- The 'throwIO' variant should be used in preference to 'throw' to -- raise an exception within the 'IO' monad because it guarantees--- ordering with respect to other 'IO' operations, whereas 'throw'--- does not.+-- ordering with respect to other operations, whereas 'throw'+-- does not. We say that 'throwIO' throws *precise* exceptions and+-- 'throw', 'error', etc. all throw *imprecise* exceptions.+-- For example+--+-- > throw e + error "boom" ===> error "boom"+-- > throw e + error "boom" ===> throw e+--+-- are both valid reductions and the compiler may pick any (loop, even), whereas+--+-- > throwIO e >> error "boom" ===> throwIO e+--+-- will always throw @e@ when executed.+--+-- See also the+-- [GHC wiki page on precise exceptions](https://gitlab.haskell.org/ghc/ghc/-/wikis/exceptions/precise-exceptions)+-- for a more technical introduction to how GHC optimises around precise vs.+-- imprecise exceptions.+-- throwIO :: Exception e => e -> IO a throwIO e = IO (raiseIO# (toException e)) 

@@ -109,8 +109,10 @@ getLocaleEncoding :: IO TextEncoding {-# NOINLINE getLocaleEncoding #-} --- | The Unicode encoding of the current locale, but allowing arbitrary+-- | The encoding of the current locale, but allowing arbitrary -- undecodable bytes to be round-tripped through it.+--+-- Do not expect the encoding to be Unicode-compatible: it could appear to be ASCII or anything else. -- -- This 'TextEncoding' is used to decode and encode command line arguments -- and environment variables on non-Windows platforms.

@@ -58,7 +58,6 @@  -- Note [Roundtripping] -- ~~~~~~~~~~~~~~~~~~~~--- -- Roundtripping is based on the ideas of PEP383. -- -- We used to use the range of private-use characters from 0xEF80 to@@ -149,7 +148,9 @@                   output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } =  --puts $ "recoverDecode " ++ show ir  case cfm of-  ErrorOnCodingFailure       -> ioe_decodingError+  ErrorOnCodingFailure       -> do+      b <- readWord8Buf iraw ir+      ioe_decodingError b   IgnoreCodingFailure        -> return (input { bufL=ir+1 }, output)   TransliterateCodingFailure -> do       ow' <- writeCharBuf oraw ow unrepresentableChar@@ -190,15 +191,17 @@     RoundtripFailure | Just x <- unescapeRoundtripCharacterSurrogate c -> do         writeWord8Buf oraw ow x         return (input { bufL=ir' }, output { bufR=ow+1 })-    _                          -> ioe_encodingError+    _                          -> ioe_encodingError c -ioe_decodingError :: IO a-ioe_decodingError = ioException+ioe_decodingError :: Word8 -> IO a+ioe_decodingError b = ioException     (IOError Nothing InvalidArgument "recoverDecode"-        "invalid byte sequence" Nothing Nothing)+        ("cannot decode byte sequence starting from " ++ show b) Nothing Nothing) -ioe_encodingError :: IO a-ioe_encodingError = ioException+ioe_encodingError :: Char -> IO a+ioe_encodingError ch = ioException     (IOError Nothing InvalidArgument "recoverEncode"-        "invalid character" Nothing Nothing)+        -- This assumes that @show ch@ escapes non-ASCII symbols+        -- and thus does not cause recursive encoding failures.+        ("cannot encode character " ++ show ch) Nothing Nothing) 

@@ -167,46 +167,6 @@ -- ----------------------------------------------------------------------------- -- opening files --- | A wrapper for 'System.Posix.Internals.c_interruptible_open' that takes--- two actions, @act1@ and @act2@, to perform after opening the file.------ @act1@ is passed a file descriptor for the newly opened file. If--- an exception occurs in @act1@, then the file will be closed.--- @act1@ /must not/ close the file itself. If it does so and then--- receives an exception, then the exception handler will attempt to--- close it again, which is impermissable.------ @act2@ is performed with asynchronous exceptions masked. It is passed a--- function to restore the masking state and the result of @act1@.--- It /must not/ throw an exception (or deliver one via an interruptible--- operation) without first closing the file or arranging for it to be--- closed. @act2@ /may/ close the file, but is not required to do so.--- If @act2@ leaves the file open, then the file will remain open on--- return from `c_interruptible_open_with`.------ Code calling `c_interruptible_open_with` that wishes to install a finalizer--- to close the file should do so in @act2@. Doing so in @act1@ could--- potentially close the file in the finalizer first and then in the--- exception handler.--c_interruptible_open_with-  :: System.Posix.Internals.CFilePath  -- ^ The file to open-  -> CInt -- ^ The flags to pass to open-  -> CMode -- ^ The permission mode to use for file creation-  -> (CInt -> IO r) -- ^ @act1@: An action to perform on the file descriptor-                    -- with the masking state restored and an exception-                    -- handler that closes the file on exception.-  -> ((forall x. IO x -> IO x) -> r -> IO s)-                    -- ^ @act2@: An action to perform with async exceptions-                    -- masked and no exception handler.-  -> IO s-c_interruptible_open_with path oflags mode act1 act2 =-  mask $ \restore -> do-    fd <- throwErrnoIfMinus1Retry "openFile" $-             c_interruptible_open path oflags mode-    r <- restore (act1 fd) `onException` c_close fd-    act2 restore r- -- | Open a file and make an 'FD' for it. Truncates the file to zero size when -- the `IOMode` is `WriteMode`. --@@ -265,24 +225,33 @@       oflags | non_blocking = oflags2 .|. nonblock_flags              | otherwise    = oflags2     in do-      -- We want to be sure all the arguments to c_interruptible_open_with+      -- We want to be sure all the arguments to c_interruptible_open       -- are fully evaluated *before* it slips under a mask (assuming we're       -- not already under a user-imposed mask).       oflags' <- evaluate oflags       -- NB. always use a safe open(), because we don't know whether open()       -- will be fast or not.  It can be slow on NFS and FUSE filesystems,       -- for example.-      c_interruptible_open_with f oflags' 0o666 ( \ fileno -> do++      mask $ \restore -> do+        fileno <- throwErrnoIfMinus1Retry "openFile" $+                c_interruptible_open f oflags' 0o666+         (fD,fd_type) <- mkFD fileno iomode Nothing{-no stat-}                                 False{-not a socket-}-                                non_blocking+                                non_blocking `onException` c_close fileno+         -- we want to truncate() if this is an open in WriteMode, but only         -- if the target is a RegularFile.  ftruncate() fails on special files         -- like /dev/null.+         when (iomode == WriteMode && fd_type == RegularFile) $-          setSize fD 0-        act1 fD fd_type ) act2+          setSize fD 0 `onException` close fD +        carry <- restore (act1 fD fd_type) `onException` close fD++        act2 restore carry+ -- | Open a file and make an 'FD' for it.  Truncates the file to zero -- size when the `IOMode` is `WriteMode`. This function is difficult -- to use without potentially leaking the file descriptor on exception.@@ -568,8 +537,8 @@ #if !defined(mingw32_HOST_OS)  {--NOTE [nonblock]:-+Note [nonblock]+~~~~~~~~~~~~~~~ Unix has broken semantics when it comes to non-blocking I/O: you can set the O_NONBLOCK flag on an FD, but it applies to the all other FDs attached to the same underlying file, pipe or TTY; there's no way to

@@ -563,7 +563,14 @@          _            -> IODevice.getEcho haDevice  -- | Is the handle connected to a terminal?-+--+-- On Windows the result of 'hIsTerminalDevide' might be misleading,+-- because non-native terminals, such as MinTTY used in MSYS and Cygwin environments,+-- are implemented via redirection.+-- Use @System.Win32.Types.withHandleToHANDLE System.Win32.MinTTY.isMinTTYHandle@+-- to recognise it. Also consider @ansi-terminal@ package for crossplatform terminal+-- support.+-- hIsTerminalDevice :: Handle -> IO Bool hIsTerminalDevice handle =     withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do

@@ -188,7 +188,7 @@             throwIO e  -- Note [async]---+-- ~~~~~~~~~~~~ -- If an asynchronous exception is raised during an I/O operation, -- normally it is fine to just re-throw the exception synchronously. -- However, if we are inside an unsafePerformIO or an@@ -644,7 +644,6 @@  {- Note [Making offsets for append]    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-   The WINIO subysstem keeps track of offsets for handles   on the Haskell side of things instead of letting the OS   handle it. This requires us to establish the correct offset

@@ -5,6 +5,7 @@            , BangPatterns            , NondecreasingIndentation            , MagicHash+           , LambdaCase   #-} {-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_HADDOCK not-home #-}@@ -319,7 +320,7 @@                 return (str, w)  -- Note [#5536]---+-- ~~~~~~~~~~~~ -- We originally had -- --    let c' = desurrogatifyRoundtripCharacter c in@@ -550,8 +551,7 @@ --  * 'isPermissionError' if another system resource limit would be exceeded.  hPutChar :: Handle -> Char -> IO ()-hPutChar handle c = do-    c `seq` return ()+hPutChar handle !c =     wantWritableHandle "hPutChar" handle $ \ handle_  ->       hPutcBuffered handle_ c @@ -616,13 +616,15 @@ -- | The same as 'hPutStr', but adds a newline character. hPutStrLn :: Handle -> String -> IO () hPutStrLn handle str = hPutStr' handle str True-  -- An optimisation: we treat hPutStrLn specially, to avoid the-  -- 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 =+  -- An optimisation: hPutStr' takes an additional "add_nl" boolean parameter to+  -- implement hPutStrLn efficiently. When LineBuffering or BlockBuffering modes+  -- are enabled, it performs the encoding of the string and of the new-line+  -- character(s) in the same loop, directly flushing buffers appropriately at+  -- the end if LineBuffering mode is used.   do     (buffer_mode, nl) <-          wantWritableHandle "hPutStr" handle $ \h_ -> do@@ -662,37 +664,42 @@ -- NB. performance-critical code: eyeball the Core. writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO () writeBlocks hdl line_buffered add_nl nl-            buf@Buffer{ bufRaw=raw, bufSize=len } s =-  let-   shoveString :: Int -> [Char] -> [Char] -> IO ()-   shoveString !n [] [] =-        commitBuffer hdl raw len n False{-no flush-} True{-release-}-   shoveString !n [] rest =-        shoveString n rest []-   shoveString !n (c:cs) rest-     -- n+1 so we have enough room to write '\r\n' if necessary-     | n + 1 >= len = do-        commitBuffer hdl raw len n False{-flush-} False-        shoveString 0 (c:cs) rest-     | c == '\n'  =  do-        n' <- if nl == CRLF-              then do-                n1 <- writeCharBuf raw n  '\r'-                writeCharBuf raw n1 '\n'-              else-                writeCharBuf raw n c-        if line_buffered+            buf@Buffer{ bufRaw=raw, bufSize=len } s = shoveString 0 s+  where+   {-# INLINE new_line #-} -- we don't want to allocate a closure for it+   new_line !n = do+     n1 <- case nl of+            CRLF -> writeCharBuf raw n '\r'+            _    -> pure n+     n2 <- writeCharBuf raw n1 '\n'+     if line_buffered         then do           -- end of line, so write and flush-          commitBuffer hdl raw len n' True{-flush-} False-          shoveString 0 cs rest+          commitBuffer hdl raw len n2 True{-flush-} False+          pure 0         else-          shoveString n' cs rest-     | otherwise = do+          pure n2++   shoveString !n = \case+    [] -> if add_nl+            then do+              n' <- new_line n+              commitBuffer hdl raw len n' False{-no flush-} True{-release-}+            else+              commitBuffer hdl raw len n False{-no flush-} True{-release-}++    -- n+1 so we have enough room to write '\r\n' if necessary+    cs | n + 1 >= len -> do+        commitBuffer hdl raw len n False{-flush-} False+        shoveString 0 cs++    ('\n':cs) -> do+        n' <- new_line n+        shoveString n' cs++    (c:cs) -> do         n' <- writeCharBuf raw n c-        shoveString n' cs rest-  in-  shoveString 0 s (if add_nl then "\n" else "")+        shoveString n' cs  -- ----------------------------------------------------------------------------- -- commitBuffer handle buf sz count flush release

@@ -27,8 +27,9 @@  import GHC.Base -{- Note [unsafePerformIO and strictness]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{-+Note [unsafePerformIO and strictness]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this sub-expression (from tests/lib/should_run/memo002)   unsafePerformIO (do { lockMemoTable@@ -117,6 +118,10 @@ once you use 'unsafePerformIO'.  Indeed, it is possible to write @coerce :: a -> b@ with the help of 'unsafePerformIO'.  So be careful!++WARNING: If you're looking for "a way to get a 'String' from an 'IO String'",+then 'unsafePerformIO' is not the way to go.  Learn about do-notation and the+@<-@ syntax element before you proceed. -} unsafePerformIO :: IO a -> a unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)

@@ -529,6 +529,7 @@         | otherwise                        = Mgr.ioFailed err  -- Note [ReadFile/WriteFile]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~ -- The results of these functions are somewhat different when working in an -- asynchronous manner. The returning bool has two meaning. --@@ -575,23 +576,24 @@  consoleRead :: Bool -> Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int consoleRead blocking hwnd ptr _offset bytes-  = alloca $ \res -> do-      cooked <- isCooked hwnd-      -- Cooked input must be handled differently when the STD handles are-      -- attached to a real console handle.  For File based handles we can't do-      -- proper cooked inputs, but since the actions are async you would get-      -- results as soon as available.-      ---      -- For console handles We have to use a lower level API then ReadConsole,-      -- namely we must use ReadConsoleInput which requires us to process-      -- all console message manually.-      ---      -- Do note that MSYS2 shells such as bash don't attach to a real handle,-      -- and instead have by default a pipe/file based std handles.  Which-      -- means the cooked behaviour is best when used in a native Windows-      -- terminal such as cmd, powershell or ConEmu.-      case cooked || not blocking of-        False -> withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr ->  do+  = withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr ->+      alloca $ \res -> do+       cooked <- isCooked hwnd+       -- Cooked input must be handled differently when the STD handles are+       -- attached to a real console handle.  For File based handles we can't do+       -- proper cooked inputs, but since the actions are async you would get+       -- results as soon as available.+       --+       -- For console handles We have to use a lower level API then ReadConsole,+       -- namely we must use ReadConsoleInput which requires us to process+       -- all console message manually.+       --+       -- Do note that MSYS2 shells such as bash don't attach to a real handle,+       -- and instead have by default a pipe/file based std handles.  Which+       -- means the cooked behaviour is best when used in a native Windows+       -- terminal such as cmd, powershell or ConEmu.+       case cooked || not blocking of+        False -> do           debugIO "consoleRead :: un-cooked I/O read."           -- eotControl allows us to handle control characters like EOL           -- without needing a newline, which would sort of defeat the point@@ -626,9 +628,9 @@           -- characters as they are.  Technically this function can handle any           -- console event.  Including mouse, window and virtual key events           -- but for now I'm only interested in key presses.-          let entries = fromIntegral $ bytes `div` (#size INPUT_RECORD)+          let entries = fromIntegral $ reqBytes `div` (#size INPUT_RECORD)           allocaBytes entries $ \p_inputs ->-            maybeReadEvent p_inputs entries res ptr+            maybeReadEvent p_inputs entries res w_ptr            -- Check to see if we have been explicitly asked to do a non-blocking           -- I/O, and if we were, make sure that if we didn't have any console@@ -655,7 +657,6 @@              b_read <- fromIntegral <$> peek res             read <- cobble b_read w_ptr p_inputs-            debugIO $ "readEvent: =" ++ show read             if read > 0                then return $ fromIntegral read                else maybeReadEvent p_inputs entries res w_ptr@@ -664,7 +665,7 @@           -- minimum required to know which key/sequences were pressed.  To do           -- this and prevent having to fully port the PINPUT_RECORD structure           -- in Haskell we use some GCC builtins to find the correct offsets.-          cobble :: Int -> Ptr Word8 -> PINPUT_RECORD -> IO Int+          cobble :: Int -> Ptr Word16 -> PINPUT_RECORD -> IO Int           cobble 0 _ _ = do debugIO "cobble: done."                             return 0           cobble n w_ptr p_inputs =@@ -689,18 +690,8 @@                           debugIO $ "cobble: offset - " ++ show char_offset                           debugIO $ "cobble: show > " ++ show char                           debugIO $ "cobble: repeat: " ++ show repeated-                          -- The documentation here is rather subtle, but-                          -- according to MSDN the uWChar being provided here-                          -- has been "translated".  What this actually means-                          -- is that the surrogate pairs have already been-                          -- translated into byte sequences.  That is, despite-                          -- the Word16 storage type, it's actually a byte-                          -- stream.  This means we shouldn't try to decode-                          -- to UTF-8 again since we'd end up incorrectly-                          -- interpreting two bytes as an extended unicode-                          -- character.                           pokeArray w_ptr $ replicate repeated char-                          (+repeated) <$> cobble n' w_ptr' p_inputs'+                          (+1) <$> cobble n' w_ptr' p_inputs'                   else do debugIO $ "cobble: skip event."                           cobble n' w_ptr p_inputs' 

@@ -127,7 +127,6 @@  -- Note [atomicModifyIORef' definition] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- -- atomicModifyIORef' was historically defined -- --    atomicModifyIORef' ref f = do

@@ -27,6 +27,8 @@ module GHC.Int (         Int(..), Int8(..), Int16(..), Int32(..), Int64(..),         uncheckedIShiftL64#, uncheckedIShiftRA64#,+        shiftRLInt8#, shiftRLInt16#, shiftRLInt32#,+         -- * Equality operators         -- | See GHC.Classes#matching_overloaded_methods_in_rules         eqInt, neInt, gtInt, geInt, ltInt, leInt,@@ -34,16 +36,15 @@         eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16,         eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32,         eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64+     ) where  import Data.Bits import Data.Maybe -#if WORD_SIZE_IN_BITS < 64 import GHC.Prim-#endif- import GHC.Base+ import GHC.Enum import GHC.Num import GHC.Real@@ -96,10 +97,10 @@  -- | @since 2.01 instance Num Int8 where-    (I8# x#) + (I8# y#)    = I8# (intToInt8# ((int8ToInt# x#) +# (int8ToInt# y#)))-    (I8# x#) - (I8# y#)    = I8# (intToInt8# ((int8ToInt# x#) -# (int8ToInt# y#)))-    (I8# x#) * (I8# y#)    = I8# (intToInt8# ((int8ToInt# x#) *# (int8ToInt# y#)))-    negate (I8# x#)        = I8# (intToInt8# (negateInt# (int8ToInt# x#)))+    (I8# x#) + (I8# y#)    = I8# (x# `plusInt8#` y#)+    (I8# x#) - (I8# y#)    = I8# (x# `subInt8#` y#)+    (I8# x#) * (I8# y#)    = I8# (x# `timesInt8#` y#)+    negate (I8# x#)        = I8# (negateInt8# x#)     abs x | x >= 0         = x           | otherwise      = negate x     signum x | x > 0       = 1@@ -136,7 +137,7 @@     quot    x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I8# (intToInt8# ((int8ToInt# x#) `quotInt#` (int8ToInt# y#)))+        | otherwise                  = I8# (x# `quotInt8#` y#)     rem     (I8# x#) y@(I8# y#)         | y == 0                     = divZeroError           -- The quotRem CPU instruction might fail for 'minBound@@ -144,11 +145,11 @@           -- width of signed integer. But, 'minBound `rem` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I8# (intToInt8# ((int8ToInt# x#) `remInt#` (int8ToInt# y#)))+        | otherwise                  = I8# (x# `remInt8#` y#)     div     x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I8# (intToInt8# ((int8ToInt# x#) `divInt#` (int8ToInt# y#)))+        | otherwise                  = I8# (x# `divInt8#` y#)     mod       (I8# x#) y@(I8# y#)         | y == 0                     = divZeroError           -- The divMod CPU instruction might fail for 'minBound@@ -156,23 +157,19 @@           -- width of signed integer. But, 'minBound `mod` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I8# (intToInt8# ((int8ToInt# x#) `modInt#` (int8ToInt# y#)))+        | otherwise                  = I8# (x# `modInt8#` y#)     quotRem x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int8ToInt# x#) `quotRemInt#` (int8ToInt# y#) of-                                       (# q, r #) ->-                                           (I8# (intToInt8# q),-                                            I8# (intToInt8# r))+        | otherwise                  = case x# `quotRemInt8#` y# of+                                       (# q, r #) -> (I8# q, I8# r)     divMod  x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int8ToInt# x#) `divModInt#` (int8ToInt# y#) of-                                       (# d, m #) ->-                                           (I8# (intToInt8# d),-                                            I8# (intToInt8# m))+        | otherwise                  = case  x# `divModInt8#` y# of+                                       (# d, m #) -> (I8# d, I8# m)     toInteger (I8# x#)               = IS (int8ToInt# x#)  -- | @since 2.01@@ -225,8 +222,8 @@     bitSize i                 = finiteBitSize i     isSigned _                = True     popCount (I8# x#)         = I# (word2Int# (popCnt8# (int2Word# (int8ToInt# x#))))-    bit                       = bitDefault-    testBit                   = testBitDefault+    bit i                     = bitDefault i+    testBit a i               = testBitDefault a i  -- | @since 4.6.0.0 instance FiniteBits Int8 where@@ -311,10 +308,10 @@  -- | @since 2.01 instance Num Int16 where-    (I16# x#) + (I16# y#)  = I16# (intToInt16# ((int16ToInt# x#) +# (int16ToInt# y#)))-    (I16# x#) - (I16# y#)  = I16# (intToInt16# ((int16ToInt# x#) -# (int16ToInt# y#)))-    (I16# x#) * (I16# y#)  = I16# (intToInt16# ((int16ToInt# x#) *# (int16ToInt# y#)))-    negate (I16# x#)       = I16# (intToInt16# (negateInt# (int16ToInt# x#)))+    (I16# x#) + (I16# y#)  = I16# (x# `plusInt16#` y#)+    (I16# x#) - (I16# y#)  = I16# (x# `subInt16#` y#)+    (I16# x#) * (I16# y#)  = I16# (x# `timesInt16#` y#)+    negate (I16# x#)       = I16# (negateInt16# x#)     abs x | x >= 0         = x           | otherwise      = negate x     signum x | x > 0       = 1@@ -351,7 +348,7 @@     quot    x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I16# (intToInt16# ((int16ToInt# x#) `quotInt#` (int16ToInt# y#)))+        | otherwise                  = I16# (x# `quotInt16#` y#)     rem       (I16# x#) y@(I16# y#)         | y == 0                     = divZeroError           -- The quotRem CPU instruction might fail for 'minBound@@ -359,11 +356,11 @@           -- width of signed integer. But, 'minBound `rem` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I16# (intToInt16# ((int16ToInt# x#) `remInt#` (int16ToInt# y#)))+        | otherwise                  = I16# (x# `remInt16#` y#)     div     x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I16# (intToInt16# ((int16ToInt# x#) `divInt#` (int16ToInt# y#)))+        | otherwise                  = I16# (x# `divInt16#` y#)     mod       (I16# x#) y@(I16# y#)         | y == 0                     = divZeroError           -- The divMod CPU instruction might fail for 'minBound@@ -371,23 +368,19 @@           -- width of signed integer. But, 'minBound `mod` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I16# (intToInt16# ((int16ToInt# x#) `modInt#` (int16ToInt# y#)))+        | otherwise                  = I16# (x# `modInt16#` y#)     quotRem x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int16ToInt# x#) `quotRemInt#` (int16ToInt# y#) of-                                       (# q, r #) ->-                                           (I16# (intToInt16# q),-                                            I16# (intToInt16# r))+        | otherwise                  = case x# `quotRemInt16#` y# of+                                       (# q, r #) -> (I16# q, I16# r)     divMod  x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int16ToInt# x#) `divModInt#` (int16ToInt# y#) of-                                       (# d, m #) ->-                                           (I16# (intToInt16# d),-                                            I16# (intToInt16# m))+        | otherwise                  = case x# `divModInt16#` y# of+                                       (# d, m #) -> (I16# d, I16# m)     toInteger (I16# x#)              = IS (int16ToInt# x#)  -- | @since 2.01@@ -440,8 +433,8 @@     bitSize i                  = finiteBitSize i     isSigned _                 = True     popCount (I16# x#)         = I# (word2Int# (popCnt16# (int2Word# (int16ToInt# x#))))-    bit                        = bitDefault-    testBit                    = testBitDefault+    bit i                      = bitDefault i+    testBit a i                = testBitDefault a i  -- | @since 4.6.0.0 instance FiniteBits Int16 where@@ -523,10 +516,10 @@  -- | @since 2.01 instance Num Int32 where-    (I32# x#) + (I32# y#)  = I32# (intToInt32# ((int32ToInt# x#) +# (int32ToInt# y#)))-    (I32# x#) - (I32# y#)  = I32# (intToInt32# ((int32ToInt# x#) -# (int32ToInt# y#)))-    (I32# x#) * (I32# y#)  = I32# (intToInt32# ((int32ToInt# x#) *# (int32ToInt# y#)))-    negate (I32# x#)       = I32# (intToInt32# (negateInt# (int32ToInt# x#)))+    (I32# x#) + (I32# y#)  = I32# (x# `plusInt32#` y#)+    (I32# x#) - (I32# y#)  = I32# (x# `subInt32#` y#)+    (I32# x#) * (I32# y#)  = I32# (x# `timesInt32#` y#)+    negate (I32# x#)       = I32# (negateInt32# x#)     abs x | x >= 0         = x           | otherwise      = negate x     signum x | x > 0       = 1@@ -563,7 +556,7 @@     quot    x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I32# (intToInt32# ((int32ToInt# x#) `quotInt#` (int32ToInt# y#)))+        | otherwise                  = I32# (x# `quotInt32#` y#)     rem       (I32# x#) y@(I32# y#)         | y == 0                     = divZeroError           -- The quotRem CPU instruction might fail for 'minBound@@ -571,11 +564,11 @@           -- width of signed integer. But, 'minBound `rem` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I32# (intToInt32# ((int32ToInt# x#) `remInt#` (int32ToInt# y#)))+        | otherwise                  = I32# (x# `remInt32#` y#)     div     x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError         | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I32# (intToInt32# ((int32ToInt# x#) `divInt#` (int32ToInt# y#)))+        | otherwise                  = I32# (x# `divInt32#` y#)     mod       (I32# x#) y@(I32# y#)         | y == 0                     = divZeroError           -- The divMod CPU instruction might fail for 'minBound@@ -583,23 +576,19 @@           -- width of signed integer. But, 'minBound `mod` -1' is           -- well-defined (0). We therefore special-case it.         | y == (-1)                  = 0-        | otherwise                  = I32# (intToInt32# ((int32ToInt# x#) `modInt#` (int32ToInt# y#)))+        | otherwise                  = I32# (x# `modInt32#` y#)     quotRem x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int32ToInt# x#) `quotRemInt#` (int32ToInt# y#) of-                                       (# q, r #) ->-                                           (I32# (intToInt32# q),-                                            I32# (intToInt32# r))+        | otherwise                  = case x# `quotRemInt32#` y# of+                                       (# q, r #) -> (I32# q, I32# r)     divMod  x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case (int32ToInt# x#) `divModInt#` (int32ToInt# y#) of-                                       (# d, m #) ->-                                           (I32# (intToInt32# d),-                                            I32# (intToInt32# m))+        | otherwise                  = case x# `divModInt32#` y# of+                                       (# d, m #) -> (I32# d, I32# m)     toInteger (I32# x#)              = IS (int32ToInt# x#)  -- | @since 2.01@@ -642,8 +631,8 @@     bitSize i                  = finiteBitSize i     isSigned _                 = True     popCount (I32# x#)         = I# (word2Int# (popCnt32# (int2Word# (int32ToInt# x#))))-    bit                        = bitDefault-    testBit                    = testBitDefault+    bit i                      = bitDefault i+    testBit a i                = testBitDefault a i  -- | @since 4.6.0.0 instance FiniteBits Int32 where@@ -702,8 +691,6 @@ -- type Int64 ------------------------------------------------------------------------ -#if WORD_SIZE_IN_BITS < 64- data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# -- ^ 64-bit signed integer type @@ -766,6 +753,7 @@         | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)                         = I# (int64ToInt# x#)         | otherwise     = fromEnumError "Int64" x+#if WORD_SIZE_IN_BITS < 64     -- See Note [Stable Unfolding for list producers] in GHC.Enum     {-# INLINE enumFrom #-}     enumFrom            = integralEnumFrom@@ -778,12 +766,20 @@     -- See Note [Stable Unfolding for list producers] in GHC.Enum     {-# INLINE enumFromThenTo #-}     enumFromThenTo      = integralEnumFromThenTo+#else+    -- See Note [Stable Unfolding for list producers] in GHC.Enum+    {-# INLINE enumFrom #-}+    enumFrom            = boundedEnumFrom+    -- See Note [Stable Unfolding for list producers] in GHC.Enum+    {-# INLINE enumFromThen #-}+    enumFromThen        = boundedEnumFromThen+#endif  -- | @since 2.01 instance Integral Int64 where     quot    x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]+        | y == (-1) && x == minBound = overflowError -- See Note [Order of tests]         | otherwise                  = I64# (x# `quotInt64#` y#)     rem       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError@@ -795,7 +791,7 @@         | otherwise                  = I64# (x# `remInt64#` y#)     div     x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]+        | y == (-1) && x == minBound = overflowError -- See Note [Order of tests]         | otherwise                  = I64# (x# `divInt64#` y#)     mod       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError@@ -807,16 +803,26 @@         | otherwise                  = I64# (x# `modInt64#` y#)     quotRem x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = (I64# (x# `quotInt64#` y#),-                                        I64# (x# `remInt64#` y#))+#if WORD_SIZE_IN_BITS < 64+        -- we don't have quotRemInt64# primop yet+        | otherwise                  = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#))+#else+        | otherwise                  = case quotRemInt# (int64ToInt# x#) (int64ToInt# y#) of+                                        (# q, r #) -> (I64# (intToInt64# q), I64# (intToInt64# r))+#endif     divMod  x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-          -- Note [Order of tests]+          -- See Note [Order of tests]         | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = (I64# (x# `divInt64#` y#),-                                        I64# (x# `modInt64#` y#))+#if WORD_SIZE_IN_BITS < 64+        -- we don't have divModInt64# primop yet+        | otherwise                  = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#))+#else+        | otherwise                  = case divModInt# (int64ToInt# x#) (int64ToInt# y#) of+                                        (# q, r #) -> (I64# (intToInt64# q), I64# (intToInt64# r))+#endif     toInteger (I64# x)               = integerFromInt64# x  @@ -859,14 +865,14 @@     (I64# x#) `xor` (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))     complement (I64# x#)       = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))     (I64# x#) `shift` (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)-        | otherwise            = I64# (x# `iShiftRA64#` negateInt# i#)+        | isTrue# (i# >=# 0#)  = I64# (x# `shiftLInt64#` i#)+        | otherwise            = I64# (x# `shiftRAInt64#` negateInt# i#)     (I64# x#) `shiftL` (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)+        | isTrue# (i# >=# 0#)  = I64# (x# `shiftLInt64#` i#)         | otherwise            = overflowError     (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)     (I64# x#) `shiftR` (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA64#` i#)+        | isTrue# (i# >=# 0#)  = I64# (x# `shiftRAInt64#` i#)         | otherwise            = overflowError     (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)     (I64# x#) `rotate` (I# i#)@@ -883,182 +889,13 @@     isSigned _                 = True     popCount (I64# x#)         =         I# (word2Int# (popCnt64# (int64ToWord64# x#)))-    bit                        = bitDefault-    testBit                    = testBitDefault---- give the 64-bit shift operations the same treatment as the 32-bit--- ones (see GHC.Base), namely we wrap them in tests to catch the--- cases when we're shifting more than 64 bits to avoid unspecified--- behaviour in the C shift operations.--iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#--a `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#-                  | otherwise           = a `uncheckedIShiftL64#` b--a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#))-                                          then intToInt64# (-1#)-                                          else intToInt64# 0#-                  | otherwise = a `uncheckedIShiftRA64#` b+    bit i                      = bitDefault i+    testBit a i                = testBitDefault a i  -- No RULES for RealFrac methods if Int is smaller than Int64, we can't -- go through Int and whether going through Integer is faster is uncertain.-#else --- Int64 is represented in the same way as Int.--- Operations may assume and must ensure that it holds only values--- from its logical range.--data {-# CTYPE "HsInt64" #-} Int64 = I64# Int#--- ^ 64-bit signed integer type---- See GHC.Classes#matching_overloaded_methods_in_rules--- | @since 2.01-instance Eq Int64 where-    (==) = eqInt64-    (/=) = neInt64--eqInt64, neInt64 :: Int64 -> Int64 -> Bool-eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)-neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)-{-# INLINE [1] eqInt64 #-}-{-# INLINE [1] neInt64 #-}---- | @since 2.01-instance Ord Int64 where-    (<)  = ltInt64-    (<=) = leInt64-    (>=) = geInt64-    (>)  = gtInt64--{-# INLINE [1] gtInt64 #-}-{-# INLINE [1] geInt64 #-}-{-# INLINE [1] ltInt64 #-}-{-# INLINE [1] leInt64 #-}-gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool-(I64# x) `gtInt64` (I64# y) = isTrue# (x >#  y)-(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y)-(I64# x) `ltInt64` (I64# y) = isTrue# (x <#  y)-(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y)---- | @since 2.01-instance Show Int64 where-    showsPrec p x = showsPrec p (fromIntegral x :: Int)---- | @since 2.01-instance Num Int64 where-    (I64# x#) + (I64# y#)  = I64# (x# +# y#)-    (I64# x#) - (I64# y#)  = I64# (x# -# y#)-    (I64# x#) * (I64# y#)  = I64# (x# *# y#)-    negate (I64# x#)       = I64# (negateInt# x#)-    abs x | x >= 0         = x-          | otherwise      = negate x-    signum x | x > 0       = 1-    signum 0               = 0-    signum _               = -1-    fromInteger i          = I64# (integerToInt# i)---- | @since 2.01-instance Enum Int64 where-    succ x-        | x /= maxBound = x + 1-        | otherwise     = succError "Int64"-    pred x-        | x /= minBound = x - 1-        | otherwise     = predError "Int64"-    toEnum (I# i#)      = I64# i#-    fromEnum (I64# x#)  = I# x#-    -- See Note [Stable Unfolding for list producers] in GHC.Enum-    {-# INLINE enumFrom #-}-    enumFrom            = boundedEnumFrom-    -- See Note [Stable Unfolding for list producers] in GHC.Enum-    {-# INLINE enumFromThen #-}-    enumFromThen        = boundedEnumFromThen---- | @since 2.01-instance Integral Int64 where-    quot    x@(I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I64# (x# `quotInt#` y#)-    rem       (I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-          -- The quotRem CPU instruction might fail for 'minBound-          -- `quotRem` -1' if it is an instruction for exactly this-          -- width of signed integer. But, 'minBound `rem` -1' is-          -- well-defined (0). We therefore special-case it.-        | y == (-1)                  = 0-        | otherwise                  = I64# (x# `remInt#` y#)-    div     x@(I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]-        | otherwise                  = I64# (x# `divInt#` y#)-    mod       (I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-          -- The divMod CPU instruction might fail for 'minBound-          -- `divMod` -1' if it is an instruction for exactly this-          -- width of signed integer. But, 'minBound `mod` -1' is-          -- well-defined (0). We therefore special-case it.-        | y == (-1)                  = 0-        | otherwise                  = I64# (x# `modInt#` y#)-    quotRem x@(I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-          -- Note [Order of tests]-        | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case x# `quotRemInt#` y# of-                                       (# q, r #) ->-                                           (I64# q, I64# r)-    divMod  x@(I64# x#) y@(I64# y#)-        | y == 0                     = divZeroError-          -- Note [Order of tests]-        | y == (-1) && x == minBound = (overflowError, 0)-        | otherwise                  = case x# `divModInt#` y# of-                                       (# d, m #) ->-                                           (I64# d, I64# m)-    toInteger (I64# x#)              = IS x#---- | @since 2.01-instance Read Int64 where-    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]---- | @since 2.01-instance Bits Int64 where-    {-# INLINE shift #-}-    {-# INLINE bit #-}-    {-# INLINE testBit #-}-    {-# INLINE popCount #-}--    (I64# x#) .&.   (I64# y#)  = I64# (x# `andI#` y#)-    (I64# x#) .|.   (I64# y#)  = I64# (x# `orI#`  y#)-    (I64# x#) `xor` (I64# y#)  = I64# (x# `xorI#` y#)-    complement (I64# x#)       = I64# (notI# x#)-    (I64# x#) `shift` (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)-        | otherwise            = I64# (x# `iShiftRA#` negateInt# i#)-    (I64# x#) `shiftL`       (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)-        | otherwise            = overflowError-    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)-    (I64# x#) `shiftR`       (I# i#)-        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA#` i#)-        | otherwise            = overflowError-    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)-    (I64# x#) `rotate` (I# i#)-        | isTrue# (i'# ==# 0#)-        = I64# x#-        | otherwise-        = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`-                           (x'# `uncheckedShiftRL#` (64# -# i'#))))-        where-        !x'# = int2Word# x#-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitSizeMaybe i             = Just (finiteBitSize i)-    bitSize i                  = finiteBitSize i-    isSigned _                 = True-    popCount (I64# x#)         = I# (word2Int# (popCnt64# (int2Word# x#)))-    bit                        = bitDefault-    testBit                    = testBitDefault-+#if WORD_SIZE_IN_BITS == 64 {-# RULES "properFraction/Float->(Int64,Float)"     properFraction = \x ->@@ -1088,12 +925,6 @@ "round/Double->Int64"     round    = (fromIntegral :: Int -> Int64) . (round  :: Double -> Int)   #-}--uncheckedIShiftL64# :: Int# -> Int# -> Int#-uncheckedIShiftL64#  = uncheckedIShiftL#--uncheckedIShiftRA64# :: Int# -> Int# -> Int#-uncheckedIShiftRA64# = uncheckedIShiftRA# #endif  -- | @since 4.6.0.0@@ -1101,13 +932,8 @@     {-# INLINE countLeadingZeros #-}     {-# INLINE countTrailingZeros #-}     finiteBitSize _ = 64-#if WORD_SIZE_IN_BITS < 64     countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int64ToWord64# x#)))     countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int64ToWord64# x#)))-#else-    countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int2Word# x#)))-    countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#)))-#endif  -- | @since 2.01 instance Real Int64 where@@ -1126,8 +952,9 @@  ------------------------------------------------------------------------------- -{- Note [Order of tests]-~~~~~~~~~~~~~~~~~~~~~~~~~+{-+Note [Order of tests]+~~~~~~~~~~~~~~~~~~~~~ (See #3065, #5161.) Suppose we had a definition like:      quot x y@@ -1248,3 +1075,43 @@     y == (-1) && x == minBound order gives us better code in the common case. -}++-------------------------------------------------------------------------------++-- unchecked shift primops may be lowered into C shift operations which have+-- unspecified behaviour if the amount of bits to shift is greater or equal to the word+-- size in bits.+-- The following safe shift operations wrap unchecked primops to take this into+-- account: 0 is consistently returned when the shift amount is too big.++shiftRLInt8# :: Int8# -> Int# -> Int8#+a `shiftRLInt8#` b = uncheckedShiftRLInt8# a b `andInt8#` intToInt8# (shift_mask 8# b)++shiftRLInt16# :: Int16# -> Int# -> Int16#+a `shiftRLInt16#` b = uncheckedShiftRLInt16# a b `andInt16#` intToInt16# (shift_mask 16# b)++shiftRLInt32# :: Int32# -> Int# -> Int32#+a `shiftRLInt32#` b = uncheckedShiftRLInt32# a b `andInt32#` intToInt32# (shift_mask 32# b)++++shiftLInt64# :: Int64# -> Int# -> Int64#+a `shiftLInt64#` b  = uncheckedIShiftL64# a b `andInt64#` intToInt64# (shift_mask 64# b)+++shiftRAInt64# :: Int64# -> Int# -> Int64#+a `shiftRAInt64#` b | isTrue# (b >=# 64#) = intToInt64# (negateInt# (a `ltInt64#` (intToInt64# 0#)))+                    | otherwise           = a `uncheckedIShiftRA64#` b+++andInt8# :: Int8# -> Int8# -> Int8#+x `andInt8#` y = word8ToInt8# (int8ToWord8# x `andWord8#` int8ToWord8# y)++andInt16# :: Int16# -> Int16# -> Int16#+x `andInt16#` y = word16ToInt16# (int16ToWord16# x `andWord16#` int16ToWord16# y)++andInt32# :: Int32# -> Int32# -> Int32#+x `andInt32#` y = word32ToInt32# (int32ToWord32# x `andWord32#` int32ToWord32# y)++andInt64# :: Int64# -> Int64# -> Int64#+x `andInt64#` y = word64ToInt64# (int64ToWord64# x `and64#` int64ToWord64# y)

@@ -100,62 +100,238 @@ decodeDoubleInteger :: Double# -> (# Integer, Int# #) decodeDoubleInteger = I.integerDecodeDouble# -+-- | Used to implement `(+)` for the `Num` typeclass.+--   This gives the sum of two integers.+--+-- ==== __Example__+-- >>> plusInteger 3 2+-- 5+--+-- >>> (+) 3 2+-- 5 plusInteger :: Integer -> Integer -> Integer plusInteger = I.integerAdd +-- | Used to implement `(-)` for the `Num` typeclass.+--   This gives the difference of two integers.+--+-- ==== __Example__+-- >>> minusInteger 3 2+-- 1+--+-- >>> (-) 3 2+-- 1 minusInteger :: Integer -> Integer -> Integer minusInteger = I.integerSub +-- | Used to implement `(*)` for the `Num` typeclass.+--   This gives the product of two integers.+--+-- ==== __Example__+-- >>> timesInteger 3 2+-- 6+--+-- >>> (*) 3 2+-- 6 timesInteger :: Integer -> Integer -> Integer timesInteger = I.integerMul +-- | Used to implement `negate` for the `Num` typeclass.+--   This changes the sign of whatever integer is passed into it.+--+-- ==== __Example__+-- >>> negateInteger (-6)+-- 6+--+-- >>> negate (-6)+-- 6 negateInteger :: Integer -> Integer negateInteger = I.integerNegate +-- | Used to implement `abs` for the `Num` typeclass.+--   This gives the absolute value of whatever integer is passed into it.+--+-- ==== __Example__+-- >>> absInteger (-6)+-- 6+--+-- >>> abs (-6)+-- 6 absInteger :: Integer -> Integer absInteger = I.integerAbs +-- | Used to implement `signum` for the `Num` typeclass.+--   This gives 1 for a positive integer, and -1 for a negative integer.+--+-- ==== __Example__+-- >>> signumInteger 5+-- 1+--+-- >>> signum 5+-- 1 signumInteger :: Integer -> Integer signumInteger = I.integerSignum +-- | Used to implement `divMod` for the `Integral` typeclass.+--   This gives a tuple equivalent to+--+-- >(div x y, mod x y)+--+-- ==== __Example__+-- >>> divModInteger 10 2+-- (5,0)+--+-- >>> divMod 10 2+-- (5,0) divModInteger :: Integer -> Integer -> (# Integer, Integer #) divModInteger = I.integerDivMod# +-- | Used to implement `div` for the `Integral` typeclass.+--   This performs integer division on its two parameters, truncated towards negative infinity.+--+-- ==== __Example__+-- >>> 10 `divInteger` 2+-- 5+--+-- >>> 10 `div` 2 divInteger :: Integer -> Integer -> Integer divInteger = I.integerDiv +-- | Used to implement `mod` for the `Integral` typeclass.+--   This performs the modulo operation, satisfying+--+-- > ((x `div` y) * y) + (x `mod` y) == x+--+-- ==== __Example__+-- >>> 7 `modInteger` 3+-- 1+--+-- >>> 7 `mod` 3+-- 1 modInteger :: Integer -> Integer -> Integer modInteger = I.integerMod +-- | Used to implement `quotRem` for the `Integral` typeclass.+--   This gives a tuple equivalent to+--+-- > (quot x y, mod x y)+--+-- ==== __Example__+-- >>> quotRemInteger 10 2+-- (5,0)+--+-- >>> quotRem 10 2+-- (5,0) quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) quotRemInteger = I.integerQuotRem# +-- | Used to implement `quot` for the `Integral` typeclass.+--   This performs integer division on its two parameters, truncated towards zero.+--+-- ==== __Example__+-- >>> quotInteger 10 2+-- 5+--+-- >>> quot 10 2+-- 5 quotInteger :: Integer -> Integer -> Integer quotInteger = I.integerQuot +-- | Used to implement `rem` for the `Integral` typeclass.+--   This gives the remainder after integer division of its two parameters, satisfying+--+-- > ((x `quot` y) * y) + (x `rem` y) == x+--+-- ==== __Example__+-- >>> remInteger 3 2+-- 1+--+-- >>> rem 3 2+-- 1 remInteger :: Integer -> Integer -> Integer remInteger = I.integerRem -+-- | Used to implement `(==)` for the `Eq` typeclass.+--   Outputs `True` if two integers are equal to each other.+--+-- ==== __Example__+-- >>> 6 `eqInteger` 6+-- True+--+-- >>> 6 == 6+-- True eqInteger :: Integer -> Integer -> Bool eqInteger = I.integerEq +-- | Used to implement `(/=)` for the `Eq` typeclass.+--   Outputs `True` if two integers are not equal to each other.+--+-- ==== __Example__+-- >>> 6 `neqInteger` 7+-- True+--+-- >>> 6 /= 7+-- True neqInteger :: Integer -> Integer -> Bool neqInteger = I.integerNe +-- | Used to implement `(<=)` for the `Ord` typeclass.+--   Outputs `True` if the first argument is less than or equal to the second.+--+-- ==== __Example__+-- >>> 3 `leInteger` 5+-- True+--+-- >>> 3 <= 5+-- True leInteger :: Integer -> Integer -> Bool leInteger = I.integerLe +-- | Used to implement `(>)` for the `Ord` typeclass.+--   Outputs `True` if the first argument is greater than the second.+--+-- ==== __Example__+-- >>> 5 `gtInteger` 3+-- True+--+-- >>> 5 > 3+-- True gtInteger :: Integer -> Integer -> Bool gtInteger = I.integerGt +-- | Used to implement `(<)` for the `Ord` typeclass.+--   Outputs `True` if the first argument is less than the second.+--+-- ==== __Example__+-- >>> 3 `ltInteger` 5+-- True+--+-- >>> 3 < 5+-- True ltInteger :: Integer -> Integer -> Bool ltInteger = I.integerLt +-- | Used to implement `(>=)` for the `Ord` typeclass.+--   Outputs `True` if the first argument is greater than or equal to the second.+--+-- ==== __Example__+-- >>> 5 `geInteger` 3+-- True+--+-- >>> 5 >= 3+-- True geInteger :: Integer -> Integer -> Bool geInteger = I.integerGe +-- | Used to implement `compare` for the `Integral` typeclass.+--   This takes two integers, and outputs whether the first is less than, equal to, or greater than the second.+--+-- ==== __Example__+-- >>> compareInteger 2 10+-- LT+--+-- >>> compare 2 10+-- LT compareInteger :: Integer -> Integer -> Ordering compareInteger = I.integerCompare 

@@ -0,0 +1,87 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.IsList+-- Copyright   :  (c) The University of Glasgow 2002+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC Extensions)+--+-- @since 4.17.0.0+-----------------------------------------------------------------------------++module GHC.IsList+  ( IsList(..)+  ) where++import GHC.Base+import GHC.Stack+import Data.Version ( Version(..), makeVersion )+import Control.Applicative (ZipList(..))++-- | The 'IsList' class and its methods are intended to be used in+--   conjunction with the OverloadedLists extension.+--+-- @since 4.7.0.0+class IsList l where+  -- | The 'Item' type function returns the type of items of the structure+  --   @l@.+  type Item l++  -- | The 'fromList' function constructs the structure @l@ from the given+  --   list of @Item l@+  fromList  :: [Item l] -> l++  -- | The 'fromListN' function takes the input list's length and potentially+  --   uses it to construct the structure @l@ more efficiently compared to+  --   'fromList'. If the given number does not equal to the input list's length+  --   the behaviour of 'fromListN' is not specified.+  --+  --   prop> fromListN (length xs) xs == fromList xs+  fromListN :: Int -> [Item l] -> l+  fromListN _ = fromList++  -- | The 'toList' function extracts a list of @Item l@ from the structure @l@.+  --   It should satisfy fromList . toList = id.+  toList :: l -> [Item l]++-- | @since 4.7.0.0+instance IsList [a] where+  type (Item [a]) = a+  fromList = id+  toList = id++-- | @since 4.15.0.0+instance IsList (ZipList a) where+  type Item (ZipList a) = a+  fromList = ZipList+  toList = getZipList++-- | @since 4.9.0.0+instance IsList (NonEmpty a) where+  type Item (NonEmpty a) = a++  fromList (a:as) = a :| as+  fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"++  toList ~(a :| as) = a : as++-- | @since 4.8.0.0+instance IsList Version where+  type (Item Version) = Int+  fromList = makeVersion+  toList = versionBranch++-- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's,+-- since 'toList' removes frozenness information.+--+-- @since 4.9.0.0+instance IsList CallStack where+  type (Item CallStack) = (String, SrcLoc)+  fromList = fromCallSiteList+  toList   = getCallStack

@@ -20,23 +20,32 @@ module GHC.List (    -- [] (..),          -- built-in syntax; can't be used in export list -   map, (++), filter, concat,-   head, last, tail, init, uncons, null, length, (!!),-   foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1,-   scanr, scanr1, iterate, iterate', repeat, replicate, cycle,-   take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile,-   span, break, reverse, and, or,-   any, all, elem, notElem, lookup,-   concatMap,+   -- List-monomorphic Foldable methods and misc functions+   foldr, foldr', foldr1,+   foldl, foldl', foldl1,+   null, length, elem, notElem,+   maximum, minimum, sum, product, and, or, any, all,++   -- Other functions+   foldl1', concat, concatMap,+   map, (++), filter, lookup,+   head, last, tail, init, uncons, (!!),+   scanl, scanl1, scanl', scanr, scanr1,+   iterate, iterate', repeat, replicate, cycle,+   take, drop, splitAt, takeWhile, dropWhile, span, break, reverse,    zip, zip3, zipWith, zipWith3, unzip, unzip3,    errorEmptyList, +   -- * GHC List fusion+   augment, build,+  ) where  import Data.Maybe import GHC.Base import GHC.Num (Num(..)) import GHC.Num.Integer (Integer)+import GHC.Stack.Types (HasCallStack)  infixl 9  !! infix  4 `elem`, `notElem`@@ -64,12 +73,15 @@ -- 1 -- >>> head [] -- *** Exception: Prelude.head: empty list-head                    :: [a] -> a+--+-- WARNING: This function is partial. You can use case-matching, 'uncons' or+-- 'listToMaybe' instead.+head                    :: HasCallStack => [a] -> a head (x:_)              =  x head []                 =  badHead {-# NOINLINE [1] head #-} -badHead :: a+badHead :: HasCallStack => a badHead = errorEmptyList "head"  -- This rule is useful in cases like@@ -108,7 +120,10 @@ -- [] -- >>> tail [] -- *** Exception: Prelude.tail: empty list-tail                    :: [a] -> [a]+--+-- WARNING: This function is partial. You can use case-matching or 'uncons'+-- instead.+tail                    :: HasCallStack => [a] -> [a] tail (_:xs)             =  xs tail []                 =  errorEmptyList "tail" @@ -121,7 +136,10 @@ -- * Hangs forever * -- >>> last [] -- *** Exception: Prelude.last: empty list-last                    :: [a] -> a+--+-- WARNING: This function is partial. You can use 'reverse' with case-matching,+-- 'uncons' or 'listToMaybe' instead.+last                    :: HasCallStack => [a] -> a #if defined(USE_REPORT_PRELUDE) last [x]                =  x last (_:xs)             =  last xs@@ -134,7 +152,7 @@ {-# INLINE last #-} -- The inline pragma is required to make GHC remember the implementation via -- foldl.-lastError :: a+lastError :: HasCallStack => a lastError = errorEmptyList "last" #endif @@ -147,7 +165,10 @@ -- [] -- >>> init [] -- *** Exception: Prelude.init: empty list-init                    :: [a] -> [a]+--+-- WARNING: This function is partial. You can use 'reverse' with case-matching+-- or 'uncons' instead.+init                    :: HasCallStack => [a] -> [a] #if defined(USE_REPORT_PRELUDE) init [x]                =  [] init (x:xs)             =  x : init xs@@ -266,7 +287,7 @@  {- Note [Left folds via right fold]-+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Implementing foldl et. al. via foldr is only a good idea if the compiler can optimize the resulting code (eta-expand the recursive "go"). See #7994. We hope that one of the two measure kick in:@@ -291,7 +312,7 @@ * They are higher-order functions and therefore benefit from inlining.  * When the final consumer is a left fold, inlining the FB functions is the only-  way to make arity expansion happen. See Note [Left fold via right fold].+  way to make arity expansion happen. See Note [Left folds via right fold].  For this reason we mark all FB functions INLINE [0]. The [0] phase-specifier ensures that calls to FB functions can be written back to the original form@@ -304,12 +325,52 @@ -- ----------------------------------------------------------------------------  -- | A strict version of 'foldl'.-foldl'           :: forall a b . (b -> a -> b) -> b -> [a] -> b+foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b {-# INLINE foldl' #-}-foldl' k z0 xs =+foldl' k z0 = \xs ->   foldr (\(v::a) (fn::b->b) -> oneShot (\(z::b) -> z `seq` fn (k z v))) (id :: b -> b) xs z0-  -- See Note [Left folds via right fold]+{-+Note [Definition of foldl']+~~~~~~~~~~~~~~~~~~~~~~~~~~~+We want foldl' to be a good consumer, so: +* We define it (rather cunningly) with `foldr`.  That way, the `fold/build`+  rule might fire.  See Note [Left folds via right fold]++* We give it an INLINE pragma, so that it'll inline at its call sites, again+  giving the `fold/build` rule a chance to fire.++* We eta-reduce it so that it has arity 2, not 3.  Reason: consider++     sumlen :: [Float] -> (Float, Int)+     sumlen = foldl' f (0, 0)+        where+          f (!s, !n) !x = (s + x, n + 1)++The RHS of `sumlen` is a partial application of foldl', and is not+eta-expanded (and it isn't, because we don't eta-expand PAPs.  See Note+[Do not eta-expand PAPs] in GHC.Core.Opt.Simplify.Utils)++So foldl' is partially applied to two arguments, /and it won't inline/+if its defn is:++      {-# INLINE foldl' #-}+      foldl' k z xs = ...++because INLINE functions only inline when saturated.++Conclusion: move the `xs` parameter to the RHS, and define it thus++  fold' k z = \xs -> ...++See !5259 for additional discussion.  This may result in partial applications+of 'foldl'' inlining in some functions where they previously did not.  Absent+an INLINE pragam for the calling function, it may become too expensive to+automatically inline, resulting in a loss of previously accidental list+fusion.  Such call sites may now need explicit INLINE or INLINABLE pragmas+to make the desired list fusion robust.+-}+ -- | 'foldl1' is a variant of 'foldl' that has no starting value argument, -- and thus must be applied to non-empty lists. Note that unlike 'foldl', the accumulated value must be of the same type as the list elements. --@@ -325,12 +386,12 @@ -- True -- >>> foldl1 (+) [1..] -- * Hangs forever *-foldl1                  :: (a -> a -> a) -> [a] -> a+foldl1                  :: HasCallStack => (a -> a -> a) -> [a] -> a foldl1 f (x:xs)         =  foldl f x xs foldl1 _ []             =  errorEmptyList "foldl1"  -- | A strict version of 'foldl1'.-foldl1'                  :: (a -> a -> a) -> [a] -> a+foldl1'                  :: HasCallStack => (a -> a -> a) -> [a] -> a foldl1' f (x:xs)         =  foldl' f x xs foldl1' _ []             =  errorEmptyList "foldl1'" @@ -400,7 +461,7 @@                                []   -> []                                x:xs -> scanlGo f (f q x) xs) --- Note [scanl rewrite rules]+-- See Note [scanl rewrite rules] {-# RULES "scanl"  [~1] forall f a bs . scanl f a bs =   build (\c n -> a `c` foldr (scanlFB f c) (constScanl n) bs a)@@ -451,7 +512,7 @@                             []   -> []                             x:xs -> scanlGo' f (f q x) xs) --- Note [scanl rewrite rules]+-- See Note [scanl rewrite rules] {-# RULES "scanl'"  [~1] forall f a bs . scanl' f a bs =   build (\c n -> a `c` foldr (scanlFB' f c) (flipSeqScanl' n) bs a)@@ -471,7 +532,6 @@ {- Note [scanl rewrite rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~- In most cases, when we rewrite a form to one that can fuse, we try to rewrite it back to the original form if it does not fuse. For scanl, we do something a little different. In particular, we rewrite@@ -498,9 +558,37 @@ match on everything past the :, which is just the tail of scanl. -} --- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the+-- foldr, foldr', foldr1, scanr, and scanr1 are the right-to-left duals of the -- above functions. +-- | 'foldr'' is a variant of 'foldr' that begins list reduction from the last+-- element and evaluates the accumulator strictly as it unwinds the stack back+-- to the beginning of the list.  The input list /must/ be finite, otherwise+-- 'foldr'' runs out of space (/diverges/).+--+-- Note that if the function that combines the accumulated value with each+-- element is strict in the accumulator, other than a possible improvement+-- in the constant factor, you get the same \(\mathcal{O}(n)\) space cost+-- as with just 'foldr'.+--+-- If you want a strict right fold in constant space, you need a structure+-- that supports faster than \(\mathcal{O}(n)\) access to the right-most+-- element, such as @Seq@ from the @containers@ package.+--+-- Use of this function is a hint that the @[]@ structure may be a poor fit+-- for the task at hand.  If the order in which the elements are combined is+-- not important, use 'foldl'' instead.+--+-- >>> foldr' (+) [1..4]  -- Use foldl' instead!+-- 10+-- >>> foldr' (&&) [True, False, True, True] -- Use foldr instead!+-- False+-- >>> foldr' (||) [False, False, True, True] -- Use foldr instead!+-- True+foldr' :: (a -> b -> b) -> b -> [a] -> b+foldr' f z0 xs = foldl f' id xs z0+  where f' k x z = k $! f x z+ -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty lists. Note that unlike 'foldr', the accumulated value must be of the same type as the list elements. --@@ -516,7 +604,7 @@ -- True -- >>> force $ foldr1 (+) [1..] -- *** Exception: stack overflow-foldr1                  :: (a -> a -> a) -> [a] -> a+foldr1                  :: HasCallStack => (a -> a -> a) -> [a] -> a foldr1 f = go   where go [x]            =  x         go (x:xs)         =  f x (go xs)@@ -565,7 +653,9 @@                  scanr f q0 ls  #-} -{- Note [scanrFB and evaluation]+{-+Note [scanrFB and evaluation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In a previous Version, the pattern match on the tuple in scanrFB used to be strict. If scanr is called with a build expression, the following would happen: The rule "scanr" would fire, and we obtain@@ -622,7 +712,7 @@ -- 55 -- >>> maximum [1..] -- * Hangs forever *-maximum                 :: (Ord a) => [a] -> a+maximum                 :: (Ord a, HasCallStack) => [a] -> a {-# INLINABLE maximum #-} maximum []              =  errorEmptyList "maximum" maximum xs              =  foldl1' max xs@@ -646,7 +736,7 @@ -- -89 -- >>> minimum [1..] -- * Hangs forever *-minimum                 :: (Ord a) => [a] -> a+minimum                 :: (Ord a, HasCallStack) => [a] -> a {-# INLINABLE minimum #-} minimum []              =  errorEmptyList "minimum" minimum xs              =  foldl1' min xs@@ -751,7 +841,7 @@ -- [42,42,42,42,42,42,42,42,42,42... -- >>> take 20 $ cycle [2, 5, 7] -- [2,5,7,2,5,7,2,5,7,2,5,7...-cycle                   :: [a] -> [a]+cycle                   :: HasCallStack => [a] -> [a] cycle []                = errorEmptyList "cycle" cycle xs                = xs' where xs' = xs ++ xs' @@ -1256,23 +1346,29 @@ -- *** Exception: Prelude.!!: index too large -- >>> ['a', 'b', 'c'] !! (-1) -- *** Exception: Prelude.!!: negative index-(!!)                    :: [a] -> Int -> a+--+-- WARNING: This function is partial. You can use <'atMay'+-- https://hackage.haskell.org/package/safe-0.3.19/docs/Safe.html#v:atMay>+-- instead. #if defined(USE_REPORT_PRELUDE)+(!!)                    :: [a] -> Int -> a xs     !! n | n < 0 =  errorWithoutStackTrace "Prelude.!!: negative index" []     !! _         =  errorWithoutStackTrace "Prelude.!!: index too large" (x:_)  !! 0         =  x (_:xs) !! n         =  xs !! (n-1)+-- Prelude version is without HasCallStack to avoid building linear one #else+(!!)                    :: HasCallStack => [a] -> Int -> a  -- We don't really want the errors to inline with (!!). -- We may want to fuss around a bit with NOINLINE, and -- if so we should be careful not to trip up known-bottom -- optimizations.-tooLarge :: Int -> a-tooLarge _ = errorWithoutStackTrace (prel_list_str ++ "!!: index too large")+tooLarge :: HasCallStack => Int -> a+tooLarge _ = error (prel_list_str ++ "!!: index too large") -negIndex :: a-negIndex = errorWithoutStackTrace $ prel_list_str ++ "!!: negative index"+negIndex :: HasCallStack => a+negIndex = error $ prel_list_str ++ "!!: negative index"  {-# INLINABLE (!!) #-} xs !! n@@ -1325,8 +1421,9 @@                   foldr3 k z (build g) = g (foldr3_left k z) (\_ _ -> z)  #-} -{- Note [Fusion for foldrN]-~~~~~~~~~~~~~~~~~~~~~~~~~~~+{-+Note [Fusion for foldrN]+~~~~~~~~~~~~~~~~~~~~~~~~ We arrange that foldr2, foldr3, etc is a good consumer for its first (left) list argument. Here's how. See below for the second, third etc list arguments@@ -1352,7 +1449,7 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We arrange that zip, zip3, etc, and zipWith, zipWit3 etc, are all good consumers for their first (left) argument, and good producers.-Here's how.  See Note [Fusion for foldr2] for why it can't fuse its+Here's how.  See Note [Fusion for foldrN] for why it can't fuse its second (right) list argument.  NB: Zips for larger tuples are in the List module.@@ -1366,7 +1463,7 @@ * To give this rule a chance to fire, we give zip a NOLINLINE[1]   pragma (although since zip is recursive it might not need it) -* Now the rules for foldr2 (see Note [Fusion for foldr2]) may fire,+* Now the rules for foldr2 (see Note [Fusion for foldrN]) may fire,   or rules that fuse the build-produced output of zip.  * If none of these fire, rule "zipList" (active only in phase 1)@@ -1544,9 +1641,9 @@ -- Common up near identical calls to `error' to reduce the number -- constant strings created when compiled: -errorEmptyList :: String -> a+errorEmptyList :: HasCallStack => String -> a errorEmptyList fun =-  errorWithoutStackTrace (prel_list_str ++ fun ++ ": empty list")+  error (prel_list_str ++ fun ++ ": empty list")  prel_list_str :: String prel_list_str = "Prelude."

@@ -8,7 +8,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  portable -- -- This legacy module provides access to the list-specialised operations

@@ -38,9 +38,9 @@ -- An overloaded label is represented by the 'HsOverLabel' constructor -- of 'HsExpr', which stores the 'FastString' text of the label and an -- optional id for the 'fromLabel' function to use (if--- RebindableSyntax is enabled) .  The type-checker transforms it into--- a call to 'fromLabel'.  See Note [Type-checking overloaded labels]--- in GHC.Tc.Gen.Expr for more details in how type-checking works.+-- RebindableSyntax is enabled) .  The renamer transforms it into+-- a call to 'fromLabel'.+-- See Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr.  module GHC.OverloadedLabels        ( IsLabel(..)

@@ -410,7 +410,7 @@   -- Note [Why readField]---+-- ~~~~~~~~~~~~~~~~~~~~ -- Previously, the code for automatically deriving Read instance (in -- typecheck/GHC.Tc.Deriv.Generate.hs) would generate inline code for parsing fields; -- this, however, turned out to produce massive amounts of intermediate code,

@@ -40,6 +40,17 @@ default ()              -- Double isn't available yet,                         -- and we shouldn't be using defaults anyway +{- Note [Allow time for type-specialisation rules to fire]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  lcm = ...+  {-# RULES "lcm/Integer->Integer->Integer" lcm = integerLcm  #-}++We want to delay inlining `lcm` until the rule (which is a form of manual+type specialisation) has had a chance to fire.  It can fire in InitialPhase,+so INLINE[2] seems sufficient.  c.f. #20709+-}+ ------------------------------------------------------------------------ -- Divide by zero and arithmetic overflow ------------------------------------------------------------------------@@ -144,20 +155,38 @@ -- 'abs'. class  (Real a, Enum a) => Integral a  where     -- | integer division truncated toward zero+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     quot                :: a -> a -> a     -- | integer remainder, satisfying     --     -- > (x `quot` y)*y + (x `rem` y) == x+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     rem                 :: a -> a -> a     -- | integer division truncated toward negative infinity+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     div                 :: a -> a -> a     -- | integer modulus, satisfying     --     -- > (x `div` y)*y + (x `mod` y) == x+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     mod                 :: a -> a -> a     -- | simultaneous 'quot' and 'rem'+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     quotRem             :: a -> a -> (a,a)     -- | simultaneous 'div' and 'mod'+    --+    -- WARNING: This function is partial (because it throws when 0 is passed as+    -- the divisor) for all the integer types in @base@.     divMod              :: a -> a -> (a,a)     -- | conversion to 'Integer'     toInteger           :: a -> Integer@@ -272,7 +301,7 @@                                            | 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): @@ -323,37 +352,43 @@     toRational x        =  toInteger x :% 1  -- | @since 2.0.1-instance  Integral Int  where+instance Integral Int where     toInteger (I# i) = IS i +    {-# INLINE quot #-} -- see Note [INLINE division wrappers] in GHC.Base     a `quot` b      | b == 0                     = divZeroError      | b == (-1) && a == minBound = overflowError -- Note [Order of tests]                                                   -- in GHC.Int      | otherwise                  =  a `quotInt` b +    {-# INLINE rem #-} -- see Note [INLINE division wrappers] in GHC.Base     !a `rem` b -- See Note [Special case of mod and rem is lazy]      | b == 0                     = divZeroError      | b == (-1)                  = 0      | otherwise                  =  a `remInt` b +    {-# INLINE div #-} -- see Note [INLINE division wrappers] in GHC.Base     a `div` b      | b == 0                     = divZeroError      | b == (-1) && a == minBound = overflowError -- Note [Order of tests]                                                   -- in GHC.Int      | otherwise                  =  a `divInt` b +    {-# INLINE mod #-} -- see Note [INLINE division wrappers] in GHC.Base     !a `mod` b -- See Note [Special case of mod and rem is lazy]      | b == 0                     = divZeroError      | b == (-1)                  = 0      | otherwise                  =  a `modInt` b +    {-# INLINE quotRem #-} -- see Note [INLINE division wrappers] in GHC.Base     a `quotRem` b      | b == 0                     = divZeroError        -- Note [Order of tests] in GHC.Int      | b == (-1) && a == minBound = (overflowError, 0)      | otherwise                  =  a `quotRemInt` b +    {-# INLINE divMod #-} -- see Note [INLINE division wrappers] in GHC.Base     a `divMod` b      | b == 0                     = divZeroError        -- Note [Order of tests] in GHC.Int@@ -379,26 +414,32 @@  -- | @since 2.01 instance Integral Word where+    -- see Note [INLINE division wrappers] in GHC.Base+    {-# INLINE quot    #-}+    {-# INLINE rem     #-}+    {-# INLINE quotRem #-}+    {-# INLINE div     #-}+    {-# INLINE mod     #-}+    {-# INLINE divMod  #-}+     quot    (W# x#) y@(W# y#)         | y /= 0                = W# (x# `quotWord#` y#)         | otherwise             = divZeroError+     rem     (W# x#) y@(W# y#)         | y /= 0                = W# (x# `remWord#` y#)         | otherwise             = divZeroError-    div     (W# x#) y@(W# y#)-        | y /= 0                = W# (x# `quotWord#` y#)-        | otherwise             = divZeroError-    mod     (W# x#) y@(W# y#)-        | y /= 0                = W# (x# `remWord#` y#)-        | otherwise             = divZeroError+     quotRem (W# x#) y@(W# y#)         | y /= 0                = case x# `quotRemWord#` y# of                                   (# q, r #) ->                                       (W# q, W# r)         | otherwise             = divZeroError-    divMod  (W# x#) y@(W# y#)-        | y /= 0                = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))-        | otherwise             = divZeroError++    div    x y = quot x y+    mod    x y = rem x y+    divMod x y = quotRem x y+     toInteger (W# x#)           = integerFromWord# x#  --------------------------------------------------------------@@ -426,60 +467,59 @@   -- | @since 2.0.1-instance  Integral Integer where+instance Integral Integer where+    -- see Note [INLINE division wrappers] in GHC.Base+    {-# INLINE quot    #-}+    {-# INLINE rem     #-}+    {-# INLINE quotRem #-}+    {-# INLINE div     #-}+    {-# INLINE mod     #-}+    {-# INLINE divMod  #-}+     toInteger n      = n -    {-# INLINE quot #-}-    _ `quot` 0 = divZeroError-    n `quot` d = n `integerQuot` d+    !_ `quot` 0 = divZeroError+    n  `quot` d = n `integerQuot` d -    {-# INLINE rem #-}-    _ `rem` 0 = divZeroError-    n `rem` d = n `integerRem` d+    !_ `rem` 0 = divZeroError+    n  `rem` d = n `integerRem` d -    {-# INLINE div #-}-    _ `div` 0 = divZeroError-    n `div` d = n `integerDiv` d+    !_ `div` 0 = divZeroError+    n  `div` d = n `integerDiv` d -    {-# INLINE mod #-}-    _ `mod` 0 = divZeroError-    n `mod` d = n `integerMod` d+    !_ `mod` 0 = divZeroError+    n  `mod` d = n `integerMod` d -    {-# INLINE divMod #-}-    _ `divMod` 0 = divZeroError-    n `divMod` d = n `integerDivMod` d+    !_ `divMod` 0 = divZeroError+    n  `divMod` d = n `integerDivMod` d -    {-# INLINE quotRem #-}-    _ `quotRem` 0 = divZeroError-    n `quotRem` d = n `integerQuotRem` d+    !_ `quotRem` 0 = divZeroError+    n  `quotRem` d = n `integerQuotRem` d  -- | @since 4.8.0.0 instance Integral Natural where-    toInteger x = integerFromNatural x--    {-# INLINE quot #-}-    _ `quot` 0 = divZeroError-    n `quot` d = n `naturalQuot` d+    -- see Note [INLINE division wrappers] in GHC.Base+    {-# INLINE quot    #-}+    {-# INLINE rem     #-}+    {-# INLINE quotRem #-}+    {-# INLINE div     #-}+    {-# INLINE mod     #-}+    {-# INLINE divMod  #-} -    {-# INLINE rem #-}-    _ `rem` 0 = divZeroError-    n `rem` d = n `naturalRem` d+    toInteger x = integerFromNatural x -    {-# INLINE div #-}-    _ `div` 0 = divZeroError-    n `div` d = n `naturalQuot` d+    !_ `quot` 0 = divZeroError+    n  `quot` d = n `naturalQuot` d -    {-# INLINE mod #-}-    _ `mod` 0 = divZeroError-    n `mod` d = n `naturalRem` d+    !_ `rem` 0 = divZeroError+    n  `rem` d = n `naturalRem` d -    {-# INLINE divMod #-}-    _ `divMod` 0 = divZeroError-    n `divMod` d = n `naturalQuotRem` d+    !_ `quotRem` 0 = divZeroError+    n  `quotRem` d = n `naturalQuotRem` d -    {-# INLINE quotRem #-}-    _ `quotRem` 0 = divZeroError-    n `quotRem` d = n `naturalQuotRem` d+    div    x y = quot x y+    mod    x y = rem x y+    divMod x y = quotRem x y  -------------------------------------------------------------- -- Instances for @Ratio@@@ -564,7 +604,10 @@ -- Coercions -------------------------------------------------------------- --- | general coercion from integral types+-- | General coercion from 'Integral' types.+--+-- WARNING: This function performs silent truncation if the result type is not+-- at least as big as the argument's type. {-# INLINE fromIntegral #-}   -- Inlined to allow built-in rules to match.   -- See Note [Optimising conversions between numeric types]@@ -572,9 +615,21 @@ fromIntegral :: (Integral a, Num b) => a -> b fromIntegral = fromInteger . toInteger --- | general coercion to fractional types+-- | General coercion to 'Fractional' types.+--+-- WARNING: This function goes through the 'Rational' type, which does not have values for 'NaN' for example.+-- This means it does not round-trip.+--+-- For 'Double' it also behaves differently with or without -O0:+--+-- > Prelude> realToFrac nan -- With -O0+-- > -Infinity+-- > Prelude> realToFrac nan+-- > NaN realToFrac :: (Real a, Fractional b) => a -> b {-# NOINLINE [1] realToFrac #-}+-- See Note [Allow time for type-specialisation rules to fire]+-- These rule actually appear in other modules, e.g. GHC.Float realToFrac = fromRational . toRational  --------------------------------------------------------------@@ -623,47 +678,48 @@ x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))  {- Note [Half of y - 1]-   ~~~~~~~~~~~~~~~~~~~~~-   Since y is guaranteed to be odd and positive here,-   half of y - 1 can be computed as y `quot` 2, optimising subtraction away.--}+~~~~~~~~~~~~~~~~~~~~~~~~+Since y is guaranteed to be odd and positive here,+half of y - 1 can be computed as y `quot` 2, optimising subtraction away. -{- Note [Inlining (^)-   ~~~~~~~~~~~~~~~~~~~~~-   The INLINABLE pragma allows (^) to be specialised at its call sites.-   If it is called repeatedly at the same type, that can make a huge-   difference, because of those constants which can be repeatedly-   calculated.+Note [Inlining (^)+~~~~~~~~~~~~~~~~~~+The INLINABLE pragma allows (^) to be specialised at its call sites.+If it is called repeatedly at the same type, that can make a huge+difference, because of those constants which can be repeatedly+calculated. -   Currently the fromInteger calls are not floated because we get-             \d1 d2 x y -> blah-   after the gentle round of simplification. -}+Currently the fromInteger calls are not floated because we get+          \d1 d2 x y -> blah+after the gentle round of simplification. -{- Rules for powers with known small exponent-    see #5237-    For small exponents, (^) is inefficient compared to manually-    expanding the multiplication tree.-    Here, rules for the most common exponent types are given.-    The range of exponents for which rules are given is quite-    arbitrary and kept small to not unduly increase the number of rules.-    0 and 1 are excluded based on the assumption that nobody would-    write x^0 or x^1 in code and the cases where an exponent could-    be statically resolved to 0 or 1 are rare.+Note [Powers with small exponent]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For small exponents, (^) is inefficient compared to manually+expanding the multiplication tree (see #5237). -    It might be desirable to have corresponding rules also for-    exponents of other types (e. g., Word), but it's doubtful they-    would fire, since the exponents of other types tend to get-    floated out before the rule has a chance to fire.+Here, rules for the most common exponent types are given.+The range of exponents for which rules are given is quite+arbitrary and kept small to not unduly increase the number of rules.+0 and 1 are excluded based on the assumption that nobody would+write x^0 or x^1 in code and the cases where an exponent could+be statically resolved to 0 or 1 are rare. -    Also desirable would be rules for (^^), but I haven't managed-    to get those to fire.+It might be desirable to have corresponding rules also for+exponents of other types (e. g., Word), but it's doubtful they+would fire, since the exponents of other types tend to get+floated out before the rule has a chance to fire. -    Note: Trying to save multiplications by sharing the square for-    exponents 4 and 5 does not save time, indeed, for Double, it is-    up to twice slower, so the rules contain flat sequences of-    multiplications.+Also desirable would be rules for (^^), but I haven't managed+to get those to fire.++Note: Trying to save multiplications by sharing the square for+exponents 4 and 5 does not save time, indeed, for Double, it is+up to twice slower, so the rules contain flat sequences of+multiplications. -} +-- See Note [Powers with small exponent] {-# RULES "^2/Int"        forall x. x ^ (2 :: Int) = let u = x in u*u "^3/Int"        forall x. x ^ (3 :: Int) = let u = x in u*u*u@@ -745,7 +801,9 @@ -- the result may be negative if one of the arguments is @'minBound'@ (and -- necessarily is if the other is @0@ or @'minBound'@) for such types. gcd             :: (Integral a) => a -> a -> a-{-# NOINLINE [1] gcd #-}+{-# SPECIALISE gcd :: Int -> Int -> Int #-}+{-# SPECIALISE gcd :: Word -> Word -> Word #-}+{-# NOINLINE [2] gcd #-} -- See Note [Allow time for type-specialisation rules to fire] gcd x y         =  gcd' (abs x) (abs y)                    where gcd' a 0  =  a                          gcd' a b  =  gcd' b (a `rem` b)@@ -754,7 +812,7 @@ lcm             :: (Integral a) => a -> a -> a {-# SPECIALISE lcm :: Int -> Int -> Int #-} {-# SPECIALISE lcm :: Word -> Word -> Word #-}-{-# NOINLINE [1] lcm #-}+{-# NOINLINE [2] lcm #-} -- See Note [Allow time for type-specialisation rules to fire] lcm _ 0         =  0 lcm 0 _         =  0 lcm x y         =  abs ((x `quot` (gcd x y)) * y)

@@ -77,7 +77,7 @@ -- 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 "hello\\ \\\"world\\\"\n" == ["hello \"world\""] unescapeArgs :: String -> [String] unescapeArgs = filter (not . null) . unescape @@ -96,7 +96,7 @@ -- and thus will always escape any whitespace, quotes, and -- backslashes. ----- > unescapeArgs "hello\\ \\\"world\\\"\\n" == escapeArgs "hello \"world\""+-- > escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n" escapeArgs :: [String] -> String escapeArgs = unlines . map escapeArg 

@@ -26,7 +26,6 @@  import GHC.Base import GHC.Show-import Control.Monad.Fail  default () @@ -77,10 +76,6 @@         case (m s) of { (# new_s, r #) ->         case (k r) of { ST k2 ->         (k2 new_s) }})---- | @since 4.11.0.0-instance MonadFail (ST s) where-    fail s = errorWithoutStackTrace s  -- | @since 4.11.0.0 instance Semigroup a => Semigroup (ST s a) where

@@ -202,9 +202,11 @@ showWord :: Word# -> ShowS showWord w# cs  | isTrue# (w# `ltWord#` 10##) = C# (chr# (ord# '0'# +# word2Int# w#)) : cs- | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of-               c# ->-                   showWord (w# `quotWord#` 10##) (C# c# : cs)+ | otherwise =+    let+      !(# q, r #) = quotRemWord# w# 10##+      !c#         = chr# (ord# '0'# +# word2Int# r)+    in showWord q (C# c# : cs)  -- | @since 2.01 deriving instance Show a => Show (Maybe a)

@@ -81,7 +81,7 @@ -- | -- Coerce a stable pointer to an address. No guarantees are made about -- the resulting value, except that the original stable pointer can be--- recovered by 'castPtrToStablePtr'.  In particular, the address may not+-- recovered by 'castPtrToStablePtr'.  In particular, the address might not -- refer to an accessible memory location and any attempt to pass it to -- the member functions of the class 'Foreign.Storable.Storable' leads to -- undefined behaviour.

@@ -9,7 +9,7 @@ -- License     :  BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer  :  libraries@haskell.org--- Stability   :  experimental+-- Stability   :  stable -- Portability :  non-portable -- -- Stable names are a way of performing fast ( \(\mathcal{O}(1)\) ),

@@ -34,7 +34,11 @@     ccModule,     ccSrcSpan,     ccsToStrings,-    renderStack+    renderStack,+    ipeProv,+    peekInfoProv,+    InfoProv(..),+    InfoProvEnt,   ) where  import Foreign@@ -45,6 +49,7 @@ import GHC.Foreign as GHC import GHC.IO.Encoding import GHC.List ( concatMap, reverse )+import GHC.Show (Show)  #define PROFILING #include "Rts.h"@@ -139,7 +144,14 @@  -- Static Closure Information -data InfoProv+data InfoProv = InfoProv {+  ipName :: String,+  ipDesc :: String,+  ipTyDesc :: String,+  ipLabel :: String,+  ipMod :: String,+  ipLoc :: String+} deriving (Eq, Show) data InfoProvEnt  getIPE :: a -> IO (Ptr InfoProvEnt)@@ -150,25 +162,31 @@ ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv ipeProv p = (#ptr InfoProvEnt, prov) p -ipName, ipDesc, ipLabel, ipModule, ipSrcLoc, ipTyDesc :: Ptr InfoProv -> IO CString-ipName p   =  (# peek InfoProv, table_name) p-ipDesc p   =  (# peek InfoProv, closure_desc) p-ipLabel p  =  (# peek InfoProv, label) p-ipModule p =  (# peek InfoProv, module) p-ipSrcLoc p =  (# peek InfoProv, srcloc) p-ipTyDesc p =  (# peek InfoProv, ty_desc) p+peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString+peekIpName p   =  (# peek InfoProv, table_name) p+peekIpDesc p   =  (# peek InfoProv, closure_desc) p+peekIpLabel p  =  (# peek InfoProv, label) p+peekIpModule p =  (# peek InfoProv, module) p+peekIpSrcLoc p =  (# peek InfoProv, srcloc) p+peekIpTyDesc p =  (# peek InfoProv, ty_desc) p -infoProvToStrings :: Ptr InfoProv -> IO [String]-infoProvToStrings infop = do-  name <- GHC.peekCString utf8 =<< ipName infop-  desc <- GHC.peekCString utf8 =<< ipDesc infop-  ty_desc <- GHC.peekCString utf8 =<< ipTyDesc infop-  label <- GHC.peekCString utf8 =<< ipLabel infop-  mod <- GHC.peekCString utf8 =<< ipModule infop-  loc <- GHC.peekCString utf8 =<< ipSrcLoc infop-  return [name, desc, ty_desc, label, mod, loc]+peekInfoProv :: Ptr InfoProv -> IO InfoProv+peekInfoProv infop = do+  name <- GHC.peekCString utf8 =<< peekIpName infop+  desc <- GHC.peekCString utf8 =<< peekIpDesc infop+  tyDesc <- GHC.peekCString utf8 =<< peekIpTyDesc infop+  label <- GHC.peekCString utf8 =<< peekIpLabel infop+  mod <- GHC.peekCString utf8 =<< peekIpModule infop+  loc <- GHC.peekCString utf8 =<< peekIpSrcLoc infop+  return InfoProv {+      ipName = name,+      ipDesc = desc,+      ipTyDesc = tyDesc,+      ipLabel = label,+      ipMod = mod,+      ipLoc = loc+    } --- TODO: Add structured output of whereFrom -- | Get information about where a value originated from. -- This information is stored statically in a binary when `-finfo-table-map` is -- enabled.  The source positions will be greatly improved by also enabled debug@@ -178,7 +196,7 @@ -- The information is collect by looking at the info table address of a specific closure and -- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think -- the best source position to describe that info table arose from.-whereFrom :: a -> IO [String]+whereFrom :: a -> IO (Maybe InfoProv) whereFrom obj = do   ipe <- getIPE obj   -- The primop returns the null pointer in two situations at the moment@@ -186,5 +204,7 @@   -- 2. -finfo-table-map is not enabled.   -- It would be good to distinguish between these two cases somehow.   if ipe == nullPtr-    then return []-    else infoProvToStrings (ipeProv ipe)+    then return Nothing+    else do+      infoProv <- peekInfoProv (ipeProv ipe)+      return $ Just infoProv

@@ -0,0 +1,264 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes#-}+{-# LANGUAGE GHCForeignImportPrim #-}++-- |+-- This module exposes an interface for capturing the state of a thread's+-- execution stack for diagnostics purposes: 'cloneMyStack',+-- 'cloneThreadStack'.+--+-- Such a "cloned" stack can be decoded with 'decode' to a stack trace, given+-- that the @-finfo-table-map@ is enabled.+--+-- @since 4.17.0.0+module GHC.Stack.CloneStack (+  StackSnapshot(..),+  StackEntry(..),+  cloneMyStack,+  cloneThreadStack,+  decode+  ) where++import Control.Concurrent.MVar+import Data.Maybe (catMaybes)+import Foreign+import GHC.Conc.Sync+import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#)+import GHC.IO (IO (..))+import GHC.Stack.CCS (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv)+import GHC.Stable++-- | A frozen snapshot of the state of an execution stack.+--+-- @since 4.17.0.0+data StackSnapshot = StackSnapshot !StackSnapshot#++foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr InfoProvEnt) #)++foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #)++foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #)++{-+Note [Stack Cloning]+~~~~~~~~~~~~~~~~~~~~+"Cloning" a stack means that it's `StgStack` closure is copied including the+stack memory (`stack[]`). Closures referenced by stack closures are not copied,+i.e. pointer payloads are still referred to by the same pointer.+In other words: Only those parts that are affected by stack evaluation are+"cloned".++The stack pointer (sp) of the clone is adjusted to be valid, i.e. to point into+the cloned stack.++The clone is "offline"/"cold", i.e. it won't be evaluated any further. This is+useful for further analyses like stack unwinding or traversal because all+pointers stay valid.++StackSnapshot#+--------------+A cloned stack is represented in Haskell by `StackSnapshot !StackSnapshot#`.+`StackSnapshot#` is a primitive type, it's value is a pointer to the stack in+RTS (`StgStack*`).++To take advantage of the garbage collector, the representation cannot be `Ptr`+or `StablePtr`:+- Closures referenced by a `Ptr` may be garbage collected at any time (without+  checking if it's still in use).+- `StablePtr` has to be freed explictly, which would introduce nasty state+   handling.++By using a primitive type, the stack closure (and its transitive closures) is+kept and managed by the garbage collector as long as it's in use and+automatically freed later.+As closures referred to by stack closures (e.g. payloads) may be used by other+closures that are not related to stack cloning, the memory has to be managed by+the garbage collector; i.e. one cannot simply call free() in the RTS C code+because it's hard to figure out what to free while the garbage collector is+built to do this job.++RTS interface+-------------+There are two different ways to clone a stack:+1. `cloneMyStack#` - A primop for cloning the active thread's stack.+2. `sendCloneStackMessage#` - A primop for cloning another thread's stack.+   Sends a RTS message (Messages.c) with a MVar to that thread. The cloned+   stack is reveived by taking it out of this MVar.++`cloneMyStack#` has to be a primop, because new primitive types+(`StackSnapshot#`) cannot be marshalled by FFI. Using a `Ptr StackSnapshot` as+FFI return type would not save the snapshot from being garbage collected, as+discussed in the section above.++C API+-------------+`cloneStack` is the function that really clones a given stack and returns+the clone:+`StgStack* cloneStack(Capability* capability, const StgStack* stack)`++It's called directly by `stg_cloneMyStackzh` (`PrimOps.cmm`), the+`cloneMyStack#` primop.++To clone another thread's stack, there's a message passing mechanism such that+the receiver's capability clones its. So, there's no need to stop/pause the+other thread as it's capability will fulfill the cloning request when it's+ready to do so.++The message is defined in `Closures.h`:++```+typedef struct MessageCloneStack_ {+    StgHeader header;+    Message   *link;+    StgMVar   *result;+    StgTSO    *tso;+} MessageCloneStack;+```++The fields are:+- `header`: It's a closure and thus subject to garbage collection (no manual+   memory management needed)+- `link`: Messages form a singly linked list in `Capability`, referred to by+  `capability->inbox`.+- `result`: An `MVar`. When the message is sent it's empty, after cloning the+  `StackSnapshot` is put into it.+- `tso`: `tso->stackobj` is the stack to clone.++The asynchronous flow can be split into sending this message and putting the+cloned stack into the MVar (expecting the sender to get it from there).++Sending:+The public C function to send is+`void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar)`.+It prepares the message for the thread to clone (identified by it's `tso`) and+sets the `result` MVar (pointed to by `mvar`). Then it sends the message by+calling `sendMessage` which puts it into the Capabilities `inbox`.++Receiving:+Inbox processing is part of the big work finding loop in `schedule`. The+function that dispatches messages is `executeMessage`. From there+`void handleCloneStackMessage(MessageCloneStack *msg)` is called.++`handleCloneStackMessage` clones the stack, lifts the result to `StackSnapshot`+(MVar needs a lifted value, no primitive) and puts it into the MVar+(`msg->mvar`).+-}++{-+Note [Stack Decoding]+~~~~~~~~~~~~~~~~~~~~~+A cloned stack is decoded (unwound) by looking up the Info Table Provenance+Entries (IPE) for every stack frame with `lookupIPE` in the RTS.++The IPEs contain source locations and are pulled from the RTS/C world into+Haskell.++RTS interface+-------------++The primop decodeStack# returns an array of IPE pointers that are later+unmarshalled with HSC. If there is no IPE for a return frame (which can easily+happen when a library wasn't compiled with `-finfo-table-map`), it's+represented by a null pointer.++Caveats:+- decodeStack# has to be a primop (not a simple C FFI function), because+  there always has to be at least one active `TSO`. Otherwise, allocating+  memory with the garbage collector for the returned value fails.+- decodeStack# has to be defined outside of `primops.txt.pp` because its+  return type `Array# (Ptr InfoProvEnt)` cannot be defined there:+  `InfoProvEnt` and `Ptr` would have to be imported which seems to be too+  specific for this file.++Notes+-----+The relevant notes are:+  - Note [Mapping Info Tables to Source Positions]+  - Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]+-}++-- | Clone the stack of the executing thread+--+-- @since 4.17.0.0+cloneMyStack :: IO StackSnapshot+cloneMyStack = IO $ \s ->+   case (cloneMyStack# s) of (# s1, stack #) -> (# s1, StackSnapshot stack #)++-- | Clone the stack of a thread identified by its 'ThreadId'+--+-- @since 4.17.0.0+cloneThreadStack :: ThreadId -> IO StackSnapshot+cloneThreadStack (ThreadId tid#) = do+  resultVar <- newEmptyMVar @StackSnapshot+  boxedPtr@(StablePtr ptr) <- newStablePtrPrimMVar resultVar+  -- Use the RTS's "message" mechanism to request that+  -- the thread captures its stack, saving the result+  -- into resultVar.+  IO $ \s -> case sendCloneStackMessage# tid# ptr s of (# s', (# #) #) -> (# s', () #)+  freeStablePtr boxedPtr+  takeMVar resultVar++-- | Represetation for the source location where a return frame was pushed on the stack.+-- This happens every time when a @case ... of@ scrutinee is evaluated.+data StackEntry = StackEntry+  { functionName :: String,+    moduleName :: String,+    srcLoc :: String,+    closureType :: Word+  }+  deriving (Show, Eq)++-- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry').+-- The stack trace is created from return frames with according 'InfoProvEnt'+-- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are+-- no 'InfoProvEnt' entries, an empty list is returned.+--+-- Please note:+--+--   * To gather 'StackEntry' from libraries, these have to be+--     compiled with @-finfo-table-map@, too.+--   * Due to optimizations by GHC (e.g. inlining) the stacktrace may change+--     with different GHC parameters and versions.+--   * The stack trace is empty (by design) if there are no return frames on+--     the stack. (These are pushed every time when a @case ... of@ scrutinee+--     is evaluated.)+--+-- @since 4.17.0.0+decode :: StackSnapshot -> IO [StackEntry]+decode stackSnapshot = do+    stackEntries <- getDecodedStackArray stackSnapshot+    ipes <- mapM unmarshall stackEntries+    return $ catMaybes ipes++    where+      unmarshall :: Ptr InfoProvEnt -> IO (Maybe StackEntry)+      unmarshall ipe = if ipe == nullPtr then+                          pure Nothing+                       else do+                          infoProv <- (peekInfoProv . ipeProv) ipe+                          pure $ Just (toStackEntry infoProv)+      toStackEntry :: InfoProv -> StackEntry+      toStackEntry infoProv =+        StackEntry+        { functionName = ipLabel infoProv,+          moduleName = ipMod infoProv,+          srcLoc = ipLoc infoProv,+          -- read looks dangerous, be we can trust that the closure type is always there.+          closureType = read . ipDesc $ infoProv+        }++getDecodedStackArray :: StackSnapshot -> IO [Ptr InfoProvEnt]+getDecodedStackArray (StackSnapshot s) =+  IO $ \s0 -> case decodeStack# s s0 of+    (# s1, a #) -> (# s1, (go a ((I# (sizeofArray# a)) - 1)) #)+  where+    go :: Array# (Ptr InfoProvEnt) -> Int -> [Ptr InfoProvEnt]+    go stack 0 = [stackEntryAt stack 0]+    go stack i = (stackEntryAt stack i) : go stack (i - 1)++    stackEntryAt :: Array# (Ptr InfoProvEnt) -> Int -> Ptr InfoProvEnt+    stackEntryAt stack (I# i) = case indexArray# stack i of+      (# se #) -> se