{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Exts
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- GHC Extensions: this is the Approved Way to get at GHC-specific extensions.
--
-- Note: no other base module should import this module.
-----------------------------------------------------------------------------

module GHC.Exts
       (
        -- ** Pointer types
        Ptr(..), FunPtr(..),

        -- ** Other primitive types
        module GHC.Types,

        -- ** Legacy interface for arrays of arrays
        module GHC.ArrayArray,

        -- * Primitive operations

        module GHC.Prim,
        module GHC.Prim.Ext,

        -- ** Running 'RealWorld' state thread
        runRW#,

        -- ** Bit shift operations
        shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,

        -- ** 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
        --
        -- | Resizing arrays of boxed elements is currently handled in
        -- library space (rather than being a primop) since there is not
        -- an efficient way to grow arrays. However, resize operations
        -- may become primops in a future release of GHC.
        resizeSmallMutableArray#,

        -- ** Fusion
        build, augment,

        -- * Overloaded lists
        IsList(..),

        -- * Transform comprehensions
        Down(..), groupWith, sortWith, the,

        -- * Strings
        -- ** Overloaded string literals
        IsString(..),

        -- ** CString
        unpackCString#,
        unpackAppendCString#,
        unpackFoldrCString#,
        unpackCStringUtf8#,
        unpackNBytes#,
        cstringLength#,

        -- * Debugging
        -- ** Breakpoints
        breakpoint, breakpointCond,

        -- ** Event logging
        traceEvent,

        -- ** The call stack
        currentCallStack,

        -- * Ids with special behaviour
        inline, noinline, lazy, oneShot, considerAccessible,

        -- * SpecConstr annotations
        SpecConstrAnnotation(..), SPEC (..),

        -- * Coercions
        -- ** Safe coercions
        --
        -- | These are available from the /Trustworthy/ module "Data.Coerce" as well.
        --
        -- @since 4.7.0.0
        Data.Coerce.coerce,

        -- ** Very unsafe coercion
        unsafeCoerce#,

        -- ** Casting class dictionaries with single methods
        --
        --   @since 4.17.0.0
        WithDict(..),

        -- * The maximum tuple size
        maxTupleSize,
       ) where

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 qualified Debug.Trace
import Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export

-- XXX This should really be in Data.Tuple, where the definitions are
maxTupleSize :: Int
maxTupleSize :: Int
maxTupleSize = Int
64

-- | 'the' ensures that all the elements of the list are identical
-- and then returns that unique element
the :: Eq a => [a] -> a
the :: forall a. Eq a => [a] -> a
the (a
x:[a]
xs)
  | (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
xs = a
x
  | Bool
otherwise     = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"GHC.Exts.the: non-identical elements"
the []            = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"GHC.Exts.the: empty list"

-- | 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 :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\a
x a
y -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> b
f a
x) (a -> b
f a
y))

-- | The 'groupWith' function uses the user supplied function which
-- projects an element out of every list element in order to first sort the
-- input list and then to form groups by equality on these projected elements
{-# INLINE groupWith #-}
groupWith :: Ord b => (a -> b) -> [a] -> [[a]]
groupWith :: forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith a -> b
f [a]
xs = (forall b. ([a] -> b -> b) -> b -> b) -> [[a]]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\[a] -> b -> b
c b
n -> ([a] -> b -> b) -> b -> (a -> a -> Bool) -> [a] -> b
forall a lst.
([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
groupByFB [a] -> b -> b
c b
n (\a
x a
y -> a -> b
f a
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== a -> b
f a
y) ((a -> b) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith a -> b
f [a]
xs))

{-# INLINE [0] groupByFB #-} -- See Note [Inline FB functions] in GHC.List
groupByFB :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
groupByFB :: forall a lst.
([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
groupByFB [a] -> lst -> lst
c lst
n a -> a -> Bool
eq [a]
xs0 = [a] -> lst
groupByFBCore [a]
xs0
  where groupByFBCore :: [a] -> lst
groupByFBCore [] = lst
n
        groupByFBCore (a
x:[a]
xs) = [a] -> lst -> lst
c (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) ([a] -> lst
groupByFBCore [a]
zs)
            where ([a]
ys, [a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
eq a
x) [a]
xs


-- -----------------------------------------------------------------------------
-- tracing

traceEvent :: String -> IO ()
traceEvent :: [Char] -> IO ()
traceEvent = [Char] -> IO ()
Debug.Trace.traceEventIO
{-# DEPRECATED traceEvent "Use 'Debug.Trace.traceEvent' or 'Debug.Trace.traceEventIO'" #-} -- deprecated in 7.4


{- **********************************************************************
*                                                                       *
*              SpecConstr annotation                                    *
*                                                                       *
********************************************************************** -}

-- Annotating a type with NoSpecConstr will make SpecConstr
-- not specialise for arguments of that type.

-- This data type is defined here, rather than in the SpecConstr module
-- itself, so that importing it doesn't force stupidly linking the
-- entire ghc package at runtime

data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr
                deriving ( Typeable SpecConstrAnnotation
Typeable SpecConstrAnnotation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SpecConstrAnnotation
    -> c SpecConstrAnnotation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SpecConstrAnnotation)
-> (SpecConstrAnnotation -> Constr)
-> (SpecConstrAnnotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SpecConstrAnnotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SpecConstrAnnotation))
-> ((forall b. Data b => b -> b)
    -> SpecConstrAnnotation -> SpecConstrAnnotation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SpecConstrAnnotation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SpecConstrAnnotation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SpecConstrAnnotation -> m SpecConstrAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SpecConstrAnnotation -> m SpecConstrAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SpecConstrAnnotation -> m SpecConstrAnnotation)
-> Data SpecConstrAnnotation
SpecConstrAnnotation -> Constr
SpecConstrAnnotation -> DataType
(forall b. Data b => b -> b)
-> SpecConstrAnnotation -> SpecConstrAnnotation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SpecConstrAnnotation -> u
forall u.
(forall d. Data d => d -> u) -> SpecConstrAnnotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecConstrAnnotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SpecConstrAnnotation
-> c SpecConstrAnnotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecConstrAnnotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecConstrAnnotation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SpecConstrAnnotation
-> c SpecConstrAnnotation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SpecConstrAnnotation
-> c SpecConstrAnnotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecConstrAnnotation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecConstrAnnotation
$ctoConstr :: SpecConstrAnnotation -> Constr
toConstr :: SpecConstrAnnotation -> Constr
$cdataTypeOf :: SpecConstrAnnotation -> DataType
dataTypeOf :: SpecConstrAnnotation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecConstrAnnotation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecConstrAnnotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecConstrAnnotation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecConstrAnnotation)
$cgmapT :: (forall b. Data b => b -> b)
-> SpecConstrAnnotation -> SpecConstrAnnotation
gmapT :: (forall b. Data b => b -> b)
-> SpecConstrAnnotation -> SpecConstrAnnotation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecConstrAnnotation -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SpecConstrAnnotation -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SpecConstrAnnotation -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SpecConstrAnnotation -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SpecConstrAnnotation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecConstrAnnotation -> m SpecConstrAnnotation
Data -- ^ @since 4.3.0.0
                         , SpecConstrAnnotation -> SpecConstrAnnotation -> Bool
(SpecConstrAnnotation -> SpecConstrAnnotation -> Bool)
-> (SpecConstrAnnotation -> SpecConstrAnnotation -> Bool)
-> Eq SpecConstrAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecConstrAnnotation -> SpecConstrAnnotation -> Bool
== :: SpecConstrAnnotation -> SpecConstrAnnotation -> Bool
$c/= :: SpecConstrAnnotation -> SpecConstrAnnotation -> Bool
/= :: SpecConstrAnnotation -> SpecConstrAnnotation -> Bool
Eq   -- ^ @since 4.3.0.0
                         )



-- | An implementation of the old @atomicModifyMutVar#@ primop in
-- terms of the new 'atomicModifyMutVar2#' primop, for backwards
-- compatibility. The type of this function is a bit bogus. It's
-- best to think of it as having type
--
-- @
-- atomicModifyMutVar#
--   :: MutVar# s a
--   -> (a -> (a, b))
--   -> State# s
--   -> (# State# s, b #)
-- @
--
-- but there may be code that uses this with other two-field record
-- types.
atomicModifyMutVar#
  :: MutVar# s a
  -> (a -> b)
  -> State# s
  -> (# State# s, c #)
atomicModifyMutVar# :: forall s a b c.
MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
atomicModifyMutVar# MutVar# s a
mv a -> b
f State# s
s =
  case (# State# s, a, b #) -> (# State# s, Any, (Any, c) #)
forall a b. a -> b
unsafeCoerce# (MutVar# s a -> (a -> b) -> State# s -> (# State# s, a, b #)
forall d a c.
MutVar# d a -> (a -> c) -> State# d -> (# State# d, a, c #)
atomicModifyMutVar2# MutVar# s a
mv a -> b
f State# s
s) of
    (# State# s
s', Any
_, ~(Any
_, c
res) #) -> (# State# s
s', c
res #)

-- | Resize a mutable array to new specified size. The returned
-- 'SmallMutableArray#' is either the original 'SmallMutableArray#'
-- resized in-place or, if not possible, a newly allocated
-- 'SmallMutableArray#' with the original content copied over.
--
-- To avoid undefined behaviour, the original 'SmallMutableArray#' shall
-- not be accessed anymore after a 'resizeSmallMutableArray#' has been
-- performed. Moreover, no reference to the old one should be kept in order
-- to allow garbage collection of the original 'SmallMutableArray#'  in
-- case a new 'SmallMutableArray#' had to be allocated.
--
-- @since 4.14.0.0
resizeSmallMutableArray#
  :: SmallMutableArray# s a -- ^ Array to resize
  -> Int# -- ^ New size of array
  -> a
     -- ^ Newly created slots initialized to this element.
     -- Only used when array is grown.
  -> State# s
  -> (# State# s, SmallMutableArray# s a #)
resizeSmallMutableArray# :: forall s a.
SmallMutableArray# s a
-> Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
resizeSmallMutableArray# SmallMutableArray# s a
arr0 Int#
szNew a
a State# s
s0 =
  case SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
getSizeofSmallMutableArray# SmallMutableArray# s a
arr0 State# s
s0 of
    (# State# s
s1, Int#
szOld #) -> if Int# -> Bool
isTrue# (Int#
szNew Int# -> Int# -> Int#
<# Int#
szOld)
      then case SmallMutableArray# s a -> Int# -> State# s -> State# s
forall d a. SmallMutableArray# d a -> Int# -> State# d -> State# d
shrinkSmallMutableArray# SmallMutableArray# s a
arr0 Int#
szNew State# s
s1 of
        State# s
s2 -> (# State# s
s2, SmallMutableArray# s a
arr0 #)
      else if Int# -> Bool
isTrue# (Int#
szNew Int# -> Int# -> Int#
># Int#
szOld)
        then case Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
szNew a
a State# s
s1 of
          (# State# s
s2, SmallMutableArray# s a
arr1 #) -> case SmallMutableArray# s a
-> Int#
-> SmallMutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallMutableArray# SmallMutableArray# s a
arr0 Int#
0# SmallMutableArray# s a
arr1 Int#
0# Int#
szOld State# s
s2 of
            State# s
s3 -> (# State# s
s3, SmallMutableArray# s a
arr1 #)
        else (# State# s
s1, SmallMutableArray# s a
arr0 #)

-- | Semantically, @considerAccessible = True@. But it has special meaning
-- to the pattern-match checker, which will never flag the clause in which
-- 'considerAccessible' occurs as a guard as redundant or inaccessible.
-- Example:
--
-- > case (x, x) of
-- >   (True,  True)  -> 1
-- >   (False, False) -> 2
-- >   (True,  False) -> 3 -- Warning: redundant
--
-- The pattern-match checker will warn here that the third clause is redundant.
-- It will stop doing so if the clause is adorned with 'considerAccessible':
--
-- > case (x, x) of
-- >   (True,  True)  -> 1
-- >   (False, False) -> 2
-- >   (True,  False) | considerAccessible -> 3 -- No warning
--
-- Put 'considerAccessible' as the last statement of the guard to avoid get
-- confusing results from the pattern-match checker, which takes \"consider
-- accessible\" by word.
considerAccessible :: Bool
considerAccessible :: Bool
considerAccessible = Bool
True