{-# LANGUAGE Unsafe #-}
{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, DeriveDataTypeable,
             MultiParamTypeClasses, FlexibleInstances, NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- 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
       (
        -- * Representations of some basic types
        Int(..),Word(..),Float(..),Double(..),
        Char(..),
        Ptr(..), FunPtr(..),

        -- * The maximum tuple size
        maxTupleSize,

        -- * Primitive operations
        module GHC.Prim,
        shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
        uncheckedShiftL64#, uncheckedShiftRL64#,
        uncheckedIShiftL64#, uncheckedIShiftRA64#,
        isTrue#,

        -- * Compat wrapper
        atomicModifyMutVar#,

        -- * Fusion
        build, augment,

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

        -- * Debugging
        breakpoint, breakpointCond,

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

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

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

        -- * Equality
        type (~~),

        -- * Representation polymorphism
        GHC.Prim.TYPE, RuntimeRep(..), 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,

        -- * Overloaded lists
        IsList(..)
       ) where

import GHC.Prim hiding ( coerce, TYPE )
import qualified GHC.Prim
import GHC.Base hiding ( coerce )
import GHC.Word
import GHC.Int
import GHC.Ptr
import GHC.Stack

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

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

-- | 'the' ensures that all the elements of the list are identical
-- and then returns that unique element
the :: Eq a => [a] -> a
the :: [a] -> a
the (x :: a
x:xs :: [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 "GHC.Exts.the: non-identical elements"
the []            = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "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
sortWith :: Ord b => (a -> b) -> [a] -> [a]
sortWith :: (a -> b) -> [a] -> [a]
sortWith f :: a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\x :: a
x y :: 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 :: (a -> b) -> [a] -> [[a]]
groupWith f :: a -> b
f xs :: [a]
xs = (forall b. ([a] -> b -> b) -> b -> b) -> [[a]]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\c :: [a] -> b -> b
c n :: 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 (\x :: a
x y :: 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 :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
groupByFB c :: [a] -> lst -> lst
c n :: lst
n eq :: a -> a -> Bool
eq xs0 :: [a]
xs0 = [a] -> lst
groupByFBCore [a]
xs0
  where groupByFBCore :: [a] -> lst
groupByFBCore [] = lst
n
        groupByFBCore (x :: a
x:xs :: [a]
xs) = [a] -> lst -> lst
c (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) ([a] -> lst
groupByFBCore [a]
zs)
            where (ys :: [a]
ys, zs :: [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 ( Data -- ^ @since 4.3.0.0
                         , Eq   -- ^ @since 4.3.0.0
                         )


{- **********************************************************************
*                                                                       *
*              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 as a hint. Its
  --   behaviour should be equivalent to 'fromList'. The hint can be used to
  --   construct the structure @l@ more efficiently compared to 'fromList'. If
  --   the given hint does not equal to the input list's length the behaviour of
  --   'fromListN' is not specified.
  fromListN :: Int -> [Item l] -> l
  fromListN _ = [Item l] -> l
forall l. IsList l => [Item l] -> l
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 :: [Item [a]] -> [a]
fromList = [Item [a]] -> [a]
forall a. a -> a
id
  toList :: [a] -> [Item [a]]
toList = [a] -> [Item [a]]
forall a. a -> a
id

-- | @since 4.9.0.0
instance IsList (NonEmpty a) where
  type Item (NonEmpty a) = a

  fromList :: [Item (NonEmpty a)] -> NonEmpty a
fromList (a :: Item (NonEmpty a)
a:as :: [Item (NonEmpty a)]
as) = a
Item (NonEmpty a)
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
[Item (NonEmpty a)]
as
  fromList [] = [Char] -> NonEmpty a
forall a. [Char] -> a
errorWithoutStackTrace "NonEmpty.fromList: empty list"

  toList :: NonEmpty a -> [Item (NonEmpty a)]
toList ~(a :: a
a :| as :: [a]
as) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as

-- | @since 4.8.0.0
instance IsList Version where
  type (Item Version) = Int
  fromList :: [Item Version] -> Version
fromList = [Int] -> Version
[Item Version] -> Version
makeVersion
  toList :: Version -> [Item Version]
toList = Version -> [Int]
Version -> [Item Version]
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 :: [Item CallStack] -> CallStack
fromList = [([Char], SrcLoc)] -> CallStack
[Item CallStack] -> CallStack
fromCallSiteList
  toList :: CallStack -> [Item CallStack]
toList   = CallStack -> [([Char], SrcLoc)]
CallStack -> [Item CallStack]
getCallStack

-- | 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# :: MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
atomicModifyMutVar# mv :: MutVar# s a
mv f :: a -> b
f s :: State# s
s =
  case (# State# s, a, b #) -> (# State# s, Any, (Any, c) #)
unsafeCoerce# (MutVar# s a -> (a -> b) -> State# s -> (# State# s, a, b #)
forall d a b.
MutVar# d a -> (a -> b) -> State# d -> (# State# d, a, b #)
atomicModifyMutVar2# MutVar# s a
mv a -> b
f State# s
s) of
    (# s' :: State# s
s', _, ~(_, res :: c
res) #) -> (# State# s
s', c
res #)