{-# LANGUAGE Unsafe #-}
{-# LANGUAGE CPP
, NoImplicitPrelude
, BangPatterns
, MagicHash
, UnboxedTuples
, UnliftedFFITypes
, StandaloneDeriving
, RankNTypes
#-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Conc.Sync
( ThreadId(..)
, forkIO
, forkIOWithUnmask
, forkOn
, forkOnWithUnmask
, numCapabilities
, getNumCapabilities
, setNumCapabilities
, getNumProcessors
, numSparks
, childHandler
, myThreadId
, killThread
, throwTo
, par
, pseq
, runSparks
, yield
, labelThread
, mkWeakThreadId
, ThreadStatus(..), BlockReason(..)
, threadStatus
, threadCapability
, newStablePtrPrimMVar, PrimMVar
, setAllocationCounter
, getAllocationCounter
, enableAllocationLimit
, disableAllocationLimit
, STM(..)
, atomically
, retry
, orElse
, throwSTM
, catchSTM
, TVar(..)
, newTVar
, newTVarIO
, readTVar
, readTVarIO
, writeTVar
, unsafeIOToSTM
, withMVar
, modifyMVar_
, setUncaughtExceptionHandler
, getUncaughtExceptionHandler
, reportError, reportStackOverflow, reportHeapOverflow
, sharedCAF
) where
import Foreign
import Foreign.C
import Data.Typeable
import Data.Maybe
import GHC.Base
import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
import GHC.Int
import GHC.IO
import GHC.IO.Encoding.UTF8
import GHC.IO.Exception
import GHC.Exception
import qualified GHC.Foreign
import GHC.IORef
import GHC.MVar
import GHC.Ptr
import GHC.Real ( fromIntegral )
import GHC.Show ( Show(..), showString )
import GHC.Stable ( StablePtr(..) )
import GHC.Weak
infixr 0 `par`, `pseq`
data ThreadId = ThreadId ThreadId#
instance Show ThreadId where
showsPrec :: Int -> ThreadId -> ShowS
showsPrec d :: Int
d t :: ThreadId
t =
String -> ShowS
showString "ThreadId " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> CInt -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (ThreadId# -> CInt
getThreadId (ThreadId -> ThreadId#
id2TSO ThreadId
t))
foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt
id2TSO :: ThreadId -> ThreadId#
id2TSO :: ThreadId -> ThreadId#
id2TSO (ThreadId t :: ThreadId#
t) = ThreadId#
t
foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> CInt
cmpThread :: ThreadId -> ThreadId -> Ordering
cmpThread :: ThreadId -> ThreadId -> Ordering
cmpThread t1 :: ThreadId
t1 t2 :: ThreadId
t2 =
case ThreadId# -> ThreadId# -> CInt
cmp_thread (ThreadId -> ThreadId#
id2TSO ThreadId
t1) (ThreadId -> ThreadId#
id2TSO ThreadId
t2) of
-1 -> Ordering
LT
0 -> Ordering
EQ
_ -> Ordering
GT
instance Eq ThreadId where
t1 :: ThreadId
t1 == :: ThreadId -> ThreadId -> Bool
== t2 :: ThreadId
t2 =
case ThreadId
t1 ThreadId -> ThreadId -> Ordering
`cmpThread` ThreadId
t2 of
EQ -> Bool
True
_ -> Bool
False
instance Ord ThreadId where
compare :: ThreadId -> ThreadId -> Ordering
compare = ThreadId -> ThreadId -> Ordering
cmpThread
setAllocationCounter :: Int64 -> IO ()
setAllocationCounter :: Int64 -> IO ()
setAllocationCounter (I64# i :: Int#
i) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case Int# -> State# RealWorld -> State# RealWorld
setThreadAllocationCounter# Int#
i State# RealWorld
s of s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #)
getAllocationCounter :: IO Int64
getAllocationCounter :: IO Int64
getAllocationCounter = (State# RealWorld -> (# State# RealWorld, Int64 #)) -> IO Int64
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int64 #)) -> IO Int64)
-> (State# RealWorld -> (# State# RealWorld, Int64 #)) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case State# RealWorld -> (# State# RealWorld, Int# #)
getThreadAllocationCounter# State# RealWorld
s of (# s' :: State# RealWorld
s', ctr :: Int#
ctr #) -> (# State# RealWorld
s', Int# -> Int64
I64# Int#
ctr #)
enableAllocationLimit :: IO ()
enableAllocationLimit :: IO ()
enableAllocationLimit = do
ThreadId t :: ThreadId#
t <- IO ThreadId
myThreadId
ThreadId# -> IO ()
rts_enableThreadAllocationLimit ThreadId#
t
disableAllocationLimit :: IO ()
disableAllocationLimit :: IO ()
disableAllocationLimit = do
ThreadId t :: ThreadId#
t <- IO ThreadId
myThreadId
ThreadId# -> IO ()
rts_disableThreadAllocationLimit ThreadId#
t
foreign import ccall unsafe "rts_enableThreadAllocationLimit"
rts_enableThreadAllocationLimit :: ThreadId# -> IO ()
foreign import ccall unsafe "rts_disableThreadAllocationLimit"
rts_disableThreadAllocationLimit :: ThreadId# -> IO ()
forkIO :: IO () -> IO ThreadId
forkIO :: IO () -> IO ThreadId
forkIO action :: IO ()
action = (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId)
-> (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \ s :: State# RealWorld
s ->
case (IO () -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
fork# IO ()
action_plus State# RealWorld
s) of (# s1 :: State# RealWorld
s1, tid :: ThreadId#
tid #) -> (# State# RealWorld
s1, ThreadId# -> ThreadId
ThreadId ThreadId#
tid #)
where
action_plus :: IO ()
action_plus = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
action SomeException -> IO ()
childHandler
forkIOWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask io :: (forall a. IO a -> IO a) -> IO ()
io = IO () -> IO ThreadId
forkIO ((forall a. IO a -> IO a) -> IO ()
io forall a. IO a -> IO a
unsafeUnmask)
forkOn :: Int -> IO () -> IO ThreadId
forkOn :: Int -> IO () -> IO ThreadId
forkOn (I# cpu :: Int#
cpu) action :: IO ()
action = (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId)
-> (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \ s :: State# RealWorld
s ->
case (Int#
-> IO () -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
forall a.
Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
forkOn# Int#
cpu IO ()
action_plus State# RealWorld
s) of (# s1 :: State# RealWorld
s1, tid :: ThreadId#
tid #) -> (# State# RealWorld
s1, ThreadId# -> ThreadId
ThreadId ThreadId#
tid #)
where
action_plus :: IO ()
action_plus = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
action SomeException -> IO ()
childHandler
forkOnWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
forkOnWithUnmask :: Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkOnWithUnmask cpu :: Int
cpu io :: (forall a. IO a -> IO a) -> IO ()
io = Int -> IO () -> IO ThreadId
forkOn Int
cpu ((forall a. IO a -> IO a) -> IO ()
io forall a. IO a -> IO a
unsafeUnmask)
numCapabilities :: Int
numCapabilities :: Int
numCapabilities = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ IO Int
getNumCapabilities
getNumCapabilities :: IO Int
getNumCapabilities :: IO Int
getNumCapabilities = do
CInt
n <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
enabled_capabilities
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)
setNumCapabilities :: Int -> IO ()
setNumCapabilities :: Int -> IO ()
setNumCapabilities i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = String -> IO ()
forall a. String -> IO a
failIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "setNumCapabilities: Capability count ("String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
iString -> ShowS
forall a. [a] -> [a] -> [a]
++") must be positive"
| Bool
otherwise = CUInt -> IO ()
c_setNumCapabilities (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
foreign import ccall safe "setNumCapabilities"
c_setNumCapabilities :: CUInt -> IO ()
getNumProcessors :: IO Int
getNumProcessors :: IO Int
getNumProcessors = (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral IO CUInt
c_getNumberOfProcessors
foreign import ccall unsafe "getNumberOfProcessors"
c_getNumberOfProcessors :: IO CUInt
numSparks :: IO Int
numSparks :: IO Int
numSparks = (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, Int# #)
forall d. State# d -> (# State# d, Int# #)
numSparks# State# RealWorld
s of (# s' :: State# RealWorld
s', n :: Int#
n #) -> (# State# RealWorld
s', Int# -> Int
I# Int#
n #)
foreign import ccall "&enabled_capabilities" enabled_capabilities :: Ptr CInt
childHandler :: SomeException -> IO ()
childHandler :: SomeException -> IO ()
childHandler err :: SomeException
err = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (SomeException -> IO ()
real_handler SomeException
err) SomeException -> IO ()
childHandler
real_handler :: SomeException -> IO ()
real_handler :: SomeException -> IO ()
real_handler se :: SomeException
se
| Just BlockedIndefinitelyOnMVar <- SomeException -> Maybe BlockedIndefinitelyOnMVar
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just BlockedIndefinitelyOnSTM <- SomeException -> Maybe BlockedIndefinitelyOnSTM
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just ThreadKilled <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just StackOverflow <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = IO ()
reportStackOverflow
| Bool
otherwise = SomeException -> IO ()
reportError SomeException
se
killThread :: ThreadId -> IO ()
killThread :: ThreadId -> IO ()
killThread tid :: ThreadId
tid = ThreadId -> AsyncException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
tid AsyncException
ThreadKilled
throwTo :: Exception e => ThreadId -> e -> IO ()
throwTo :: ThreadId -> e -> IO ()
throwTo (ThreadId tid :: ThreadId#
tid) ex :: e
ex = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ s :: State# RealWorld
s ->
case (ThreadId# -> SomeException -> State# RealWorld -> State# RealWorld
forall a. ThreadId# -> a -> State# RealWorld -> State# RealWorld
killThread# ThreadId#
tid (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
ex) State# RealWorld
s) of s1 :: State# RealWorld
s1 -> (# State# RealWorld
s1, () #)
myThreadId :: IO ThreadId
myThreadId :: IO ThreadId
myThreadId = (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId)
-> (State# RealWorld -> (# State# RealWorld, ThreadId #))
-> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case (State# RealWorld -> (# State# RealWorld, ThreadId# #)
myThreadId# State# RealWorld
s) of (# s1 :: State# RealWorld
s1, tid :: ThreadId#
tid #) -> (# State# RealWorld
s1, ThreadId# -> ThreadId
ThreadId ThreadId#
tid #)
yield :: IO ()
yield :: IO ()
yield = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case (State# RealWorld -> State# RealWorld
yield# State# RealWorld
s) of s1 :: State# RealWorld
s1 -> (# State# RealWorld
s1, () #)
labelThread :: ThreadId -> String -> IO ()
labelThread :: ThreadId -> String -> IO ()
labelThread (ThreadId t :: ThreadId#
t) str :: String
str =
TextEncoding -> String -> (CString -> IO ()) -> IO ()
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
GHC.Foreign.withCString TextEncoding
utf8 String
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr p :: Addr#
p) ->
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ s :: State# RealWorld
s ->
case ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld
labelThread# ThreadId#
t Addr#
p State# RealWorld
s of s1 :: State# RealWorld
s1 -> (# State# RealWorld
s1, () #)
{-# INLINE pseq #-}
pseq :: a -> b -> b
pseq :: a -> b -> b
pseq x :: a
x y :: b
y = a
x a -> b -> b
forall a b. a -> b -> b
`seq` b -> b
forall a. a -> a
lazy b
y
{-# INLINE par #-}
par :: a -> b -> b
par :: a -> b -> b
par x :: a
x y :: b
y = case (a -> Int#
forall a. a -> Int#
par# a
x) of { _ -> b -> b
forall a. a -> a
lazy b
y }
runSparks :: IO ()
runSparks :: IO ()
runSparks = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO State# RealWorld -> (# State# RealWorld, () #)
forall d. State# d -> (# State# d, () #)
loop
where loop :: State# d -> (# State# d, () #)
loop s :: State# d
s = case State# d -> (# State# d, Int#, Any #)
forall d a. State# d -> (# State# d, Int#, a #)
getSpark# State# d
s of
(# s' :: State# d
s', n :: Int#
n, p :: Any
p #) ->
if Int# -> Bool
isTrue# (Int#
n Int# -> Int# -> Int#
==# 0#)
then (# State# d
s', () #)
else Any
p Any -> (# State# d, () #) -> (# State# d, () #)
forall a b. a -> b -> b
`seq` State# d -> (# State# d, () #)
loop State# d
s'
data BlockReason
= BlockedOnMVar
| BlockedOnBlackHole
| BlockedOnException
| BlockedOnSTM
| BlockedOnForeignCall
| BlockedOnOther
deriving ( Eq
, Ord
, Show
)
data ThreadStatus
= ThreadRunning
| ThreadFinished
| ThreadBlocked BlockReason
| ThreadDied
deriving ( Eq
, Ord
, Show
)
threadStatus :: ThreadId -> IO ThreadStatus
threadStatus :: ThreadId -> IO ThreadStatus
threadStatus (ThreadId t :: ThreadId#
t) = (State# RealWorld -> (# State# RealWorld, ThreadStatus #))
-> IO ThreadStatus
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ThreadStatus #))
-> IO ThreadStatus)
-> (State# RealWorld -> (# State# RealWorld, ThreadStatus #))
-> IO ThreadStatus
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case ThreadId#
-> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #)
threadStatus# ThreadId#
t State# RealWorld
s of
(# s' :: State# RealWorld
s', stat :: Int#
stat, _cap :: Int#
_cap, _locked :: Int#
_locked #) -> (# State# RealWorld
s', Int -> ThreadStatus
forall a. (Eq a, Num a) => a -> ThreadStatus
mk_stat (Int# -> Int
I# Int#
stat) #)
where
mk_stat :: a -> ThreadStatus
mk_stat 0 = ThreadStatus
ThreadRunning
mk_stat 1 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnMVar
mk_stat 2 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnBlackHole
mk_stat 6 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnSTM
mk_stat 10 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnForeignCall
mk_stat 11 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnForeignCall
mk_stat 12 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnException
mk_stat 14 = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnMVar
mk_stat 16 = ThreadStatus
ThreadFinished
mk_stat 17 = ThreadStatus
ThreadDied
mk_stat _ = BlockReason -> ThreadStatus
ThreadBlocked BlockReason
BlockedOnOther
threadCapability :: ThreadId -> IO (Int, Bool)
threadCapability :: ThreadId -> IO (Int, Bool)
threadCapability (ThreadId t :: ThreadId#
t) = (State# RealWorld -> (# State# RealWorld, (Int, Bool) #))
-> IO (Int, Bool)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, (Int, Bool) #))
-> IO (Int, Bool))
-> (State# RealWorld -> (# State# RealWorld, (Int, Bool) #))
-> IO (Int, Bool)
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case ThreadId#
-> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #)
threadStatus# ThreadId#
t State# RealWorld
s of
(# s' :: State# RealWorld
s', _, cap# :: Int#
cap#, locked# :: Int#
locked# #) -> (# State# RealWorld
s', (Int# -> Int
I# Int#
cap#, Int# -> Bool
isTrue# (Int#
locked# Int# -> Int# -> Int#
/=# 0#)) #)
mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
mkWeakThreadId t :: ThreadId
t@(ThreadId t# :: ThreadId#
t#) = (State# RealWorld -> (# State# RealWorld, Weak ThreadId #))
-> IO (Weak ThreadId)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Weak ThreadId #))
-> IO (Weak ThreadId))
-> (State# RealWorld -> (# State# RealWorld, Weak ThreadId #))
-> IO (Weak ThreadId)
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case ThreadId#
-> ThreadId
-> State# RealWorld
-> (# State# RealWorld, Weak# ThreadId #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# ThreadId#
t# ThreadId
t State# RealWorld
s of
(# s1 :: State# RealWorld
s1, w :: Weak# ThreadId
w #) -> (# State# RealWorld
s1, Weak# ThreadId -> Weak ThreadId
forall v. Weak# v -> Weak v
Weak Weak# ThreadId
w #)
data PrimMVar
newStablePtrPrimMVar :: MVar () -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar :: MVar () -> IO (StablePtr PrimMVar)
newStablePtrPrimMVar (MVar m :: MVar# RealWorld ()
m) = (State# RealWorld -> (# State# RealWorld, StablePtr PrimMVar #))
-> IO (StablePtr PrimMVar)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, StablePtr PrimMVar #))
-> IO (StablePtr PrimMVar))
-> (State# RealWorld -> (# State# RealWorld, StablePtr PrimMVar #))
-> IO (StablePtr PrimMVar)
forall a b. (a -> b) -> a -> b
$ \s0 :: State# RealWorld
s0 ->
case PrimMVar
-> State# RealWorld -> (# State# RealWorld, StablePtr# PrimMVar #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
makeStablePtr# (MVar# RealWorld () -> PrimMVar
unsafeCoerce# MVar# RealWorld ()
m :: PrimMVar) State# RealWorld
s0 of
(# s1 :: State# RealWorld
s1, sp :: StablePtr# PrimMVar
sp #) -> (# State# RealWorld
s1, StablePtr# PrimMVar -> StablePtr PrimMVar
forall a. StablePtr# a -> StablePtr a
StablePtr StablePtr# PrimMVar
sp #)
newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
unSTM :: STM a -> State# RealWorld -> (# State# RealWorld, a #)
unSTM (STM a :: State# RealWorld -> (# State# RealWorld, a #)
a) = State# RealWorld -> (# State# RealWorld, a #)
a
instance Functor STM where
fmap :: (a -> b) -> STM a -> STM b
fmap f :: a -> b
f x :: STM a
x = STM a
x STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> STM b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> STM b) -> (a -> b) -> a -> STM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance Applicative STM where
{-# INLINE pure #-}
{-# INLINE (*>) #-}
{-# INLINE liftA2 #-}
pure :: a -> STM a
pure x :: a
x = a -> STM a
forall a. a -> STM a
returnSTM a
x
<*> :: STM (a -> b) -> STM a -> STM b
(<*>) = STM (a -> b) -> STM a -> STM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
liftA2 :: (a -> b -> c) -> STM a -> STM b -> STM c
liftA2 = (a -> b -> c) -> STM a -> STM b -> STM c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
m :: STM a
m *> :: STM a -> STM b -> STM b
*> k :: STM b
k = STM a -> STM b -> STM b
forall a b. STM a -> STM b -> STM b
thenSTM STM a
m STM b
k
instance Monad STM where
{-# INLINE (>>=) #-}
m :: STM a
m >>= :: STM a -> (a -> STM b) -> STM b
>>= k :: a -> STM b
k = STM a -> (a -> STM b) -> STM b
forall a b. STM a -> (a -> STM b) -> STM b
bindSTM STM a
m a -> STM b
k
>> :: STM a -> STM b -> STM b
(>>) = STM a -> STM b -> STM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
bindSTM :: STM a -> (a -> STM b) -> STM b
bindSTM :: STM a -> (a -> STM b) -> STM b
bindSTM (STM m :: State# RealWorld -> (# State# RealWorld, a #)
m) k :: a -> STM b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> STM b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ( \s :: State# RealWorld
s ->
case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of
(# new_s :: State# RealWorld
new_s, a :: a
a #) -> STM b -> State# RealWorld -> (# State# RealWorld, b #)
forall a. STM a -> State# RealWorld -> (# State# RealWorld, a #)
unSTM (a -> STM b
k a
a) State# RealWorld
new_s
)
thenSTM :: STM a -> STM b -> STM b
thenSTM :: STM a -> STM b -> STM b
thenSTM (STM m :: State# RealWorld -> (# State# RealWorld, a #)
m) k :: STM b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> STM b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ( \s :: State# RealWorld
s ->
case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of
(# new_s :: State# RealWorld
new_s, _ #) -> STM b -> State# RealWorld -> (# State# RealWorld, b #)
forall a. STM a -> State# RealWorld -> (# State# RealWorld, a #)
unSTM STM b
k State# RealWorld
new_s
)
returnSTM :: a -> STM a
returnSTM :: a -> STM a
returnSTM x :: a
x = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM (\s :: State# RealWorld
s -> (# State# RealWorld
s, a
x #))
instance Alternative STM where
empty :: STM a
empty = STM a
forall a. STM a
retry
<|> :: STM a -> STM a -> STM a
(<|>) = STM a -> STM a -> STM a
forall a. STM a -> STM a -> STM a
orElse
instance MonadPlus STM
unsafeIOToSTM :: IO a -> STM a
unsafeIOToSTM :: IO a -> STM a
unsafeIOToSTM (IO m :: State# RealWorld -> (# State# RealWorld, a #)
m) = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM State# RealWorld -> (# State# RealWorld, a #)
m
atomically :: STM a -> IO a
atomically :: STM a -> IO a
atomically (STM m :: State# RealWorld -> (# State# RealWorld, a #)
m) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\s :: State# RealWorld
s -> ((State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
atomically# State# RealWorld -> (# State# RealWorld, a #)
m) State# RealWorld
s )
retry :: STM a
retry :: STM a
retry = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, a #)) -> STM a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a b. (a -> b) -> a -> b
$ \s# :: State# RealWorld
s# -> State# RealWorld -> (# State# RealWorld, a #)
forall a. State# RealWorld -> (# State# RealWorld, a #)
retry# State# RealWorld
s#
orElse :: STM a -> STM a -> STM a
orElse :: STM a -> STM a -> STM a
orElse (STM m :: State# RealWorld -> (# State# RealWorld, a #)
m) e :: STM a
e = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, a #)) -> STM a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s -> (State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catchRetry# State# RealWorld -> (# State# RealWorld, a #)
m (STM a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. STM a -> State# RealWorld -> (# State# RealWorld, a #)
unSTM STM a
e) State# RealWorld
s
throwSTM :: Exception e => e -> STM a
throwSTM :: e -> STM a
throwSTM e :: e
e = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, a #)) -> STM a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a b. (a -> b) -> a -> b
$ SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e)
catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
catchSTM :: STM a -> (e -> STM a) -> STM a
catchSTM (STM m :: State# RealWorld -> (# State# RealWorld, a #)
m) handler :: e -> STM a
handler = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, a #)) -> STM a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> (SomeException -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
forall a b.
(State# RealWorld -> (# State# RealWorld, a #))
-> (b -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
catchSTM# State# RealWorld -> (# State# RealWorld, a #)
m SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler'
where
handler' :: SomeException -> State# RealWorld -> (# State# RealWorld, a #)
handler' e :: SomeException
e = case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just e' :: e
e' -> STM a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. STM a -> State# RealWorld -> (# State# RealWorld, a #)
unSTM (e -> STM a
handler e
e')
Nothing -> SomeException -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> State# RealWorld -> (# State# RealWorld, b #)
raiseIO# SomeException
e
data TVar a = TVar (TVar# RealWorld a)
instance Eq (TVar a) where
(TVar tvar1# :: TVar# RealWorld a
tvar1#) == :: TVar a -> TVar a -> Bool
== (TVar tvar2# :: TVar# RealWorld a
tvar2#) = Int# -> Bool
isTrue# (TVar# RealWorld a -> TVar# RealWorld a -> Int#
forall d a. TVar# d a -> TVar# d a -> Int#
sameTVar# TVar# RealWorld a
tvar1# TVar# RealWorld a
tvar2#)
newTVar :: a -> STM (TVar a)
newTVar :: a -> STM (TVar a)
newTVar val :: a
val = (State# RealWorld -> (# State# RealWorld, TVar a #))
-> STM (TVar a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, TVar a #))
-> STM (TVar a))
-> (State# RealWorld -> (# State# RealWorld, TVar a #))
-> STM (TVar a)
forall a b. (a -> b) -> a -> b
$ \s1# :: State# RealWorld
s1# ->
case a -> State# RealWorld -> (# State# RealWorld, TVar# RealWorld a #)
forall a d. a -> State# d -> (# State# d, TVar# d a #)
newTVar# a
val State# RealWorld
s1# of
(# s2# :: State# RealWorld
s2#, tvar# :: TVar# RealWorld a
tvar# #) -> (# State# RealWorld
s2#, TVar# RealWorld a -> TVar a
forall a. TVar# RealWorld a -> TVar a
TVar TVar# RealWorld a
tvar# #)
newTVarIO :: a -> IO (TVar a)
newTVarIO :: a -> IO (TVar a)
newTVarIO val :: a
val = (State# RealWorld -> (# State# RealWorld, TVar a #)) -> IO (TVar a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, TVar a #))
-> IO (TVar a))
-> (State# RealWorld -> (# State# RealWorld, TVar a #))
-> IO (TVar a)
forall a b. (a -> b) -> a -> b
$ \s1# :: State# RealWorld
s1# ->
case a -> State# RealWorld -> (# State# RealWorld, TVar# RealWorld a #)
forall a d. a -> State# d -> (# State# d, TVar# d a #)
newTVar# a
val State# RealWorld
s1# of
(# s2# :: State# RealWorld
s2#, tvar# :: TVar# RealWorld a
tvar# #) -> (# State# RealWorld
s2#, TVar# RealWorld a -> TVar a
forall a. TVar# RealWorld a -> TVar a
TVar TVar# RealWorld a
tvar# #)
readTVarIO :: TVar a -> IO a
readTVarIO :: TVar a -> IO a
readTVarIO (TVar tvar# :: TVar# RealWorld a
tvar#) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \s# :: State# RealWorld
s# -> TVar# RealWorld a -> State# RealWorld -> (# State# RealWorld, a #)
forall d a. TVar# d a -> State# d -> (# State# d, a #)
readTVarIO# TVar# RealWorld a
tvar# State# RealWorld
s#
readTVar :: TVar a -> STM a
readTVar :: TVar a -> STM a
readTVar (TVar tvar# :: TVar# RealWorld a
tvar#) = (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, a #)) -> STM a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
forall a b. (a -> b) -> a -> b
$ \s# :: State# RealWorld
s# -> TVar# RealWorld a -> State# RealWorld -> (# State# RealWorld, a #)
forall d a. TVar# d a -> State# d -> (# State# d, a #)
readTVar# TVar# RealWorld a
tvar# State# RealWorld
s#
writeTVar :: TVar a -> a -> STM ()
writeTVar :: TVar a -> a -> STM ()
writeTVar (TVar tvar# :: TVar# RealWorld a
tvar#) val :: a
val = (State# RealWorld -> (# State# RealWorld, () #)) -> STM ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> STM a
STM ((State# RealWorld -> (# State# RealWorld, () #)) -> STM ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> STM ()
forall a b. (a -> b) -> a -> b
$ \s1# :: State# RealWorld
s1# ->
case TVar# RealWorld a -> a -> State# RealWorld -> State# RealWorld
forall d a. TVar# d a -> a -> State# d -> State# d
writeTVar# TVar# RealWorld a
tvar# a
val State# RealWorld
s1# of
s2# :: State# RealWorld
s2# -> (# State# RealWorld
s2#, () #)
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar m :: MVar a
m io :: a -> IO b
io =
((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
b
b <- IO b -> (forall e. Exception e => e -> IO b) -> IO b
forall a. IO a -> (forall e. Exception e => e -> IO a) -> IO a
catchAny (IO b -> IO b
forall a. IO a -> IO a
restore (a -> IO b
io a
a))
(\e :: e
e -> do MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a; e -> IO b
forall a e. Exception e => e -> a
throw e
e)
MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ m :: MVar a
m io :: a -> IO a
io =
((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
a
a' <- IO a -> (forall e. Exception e => e -> IO a) -> IO a
forall a. IO a -> (forall e. Exception e => e -> IO a) -> IO a
catchAny (IO a -> IO a
forall a. IO a -> IO a
restore (a -> IO a
io a
a))
(\e :: e
e -> do MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a; e -> IO a
forall a e. Exception e => e -> a
throw e
e)
MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
m a
a'
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
sharedCAF a :: a
a get_or_set :: Ptr a -> IO (Ptr a)
get_or_set =
IO a -> IO a
forall a. IO a -> IO a
mask_ (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
StablePtr a
stable_ref <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
a
let ref :: Ptr b
ref = Ptr () -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
stable_ref)
Ptr a
ref2 <- Ptr a -> IO (Ptr a)
get_or_set Ptr a
forall b. Ptr b
ref
if Ptr a
forall b. Ptr b
refPtr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr a
ref2
then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
else do StablePtr a -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr a
stable_ref
StablePtr a -> IO a
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ref2))
reportStackOverflow :: IO ()
reportStackOverflow :: IO ()
reportStackOverflow = do
ThreadId tid :: ThreadId#
tid <- IO ThreadId
myThreadId
ThreadId# -> IO ()
c_reportStackOverflow ThreadId#
tid
reportError :: SomeException -> IO ()
reportError :: SomeException -> IO ()
reportError ex :: SomeException
ex = do
SomeException -> IO ()
handler <- IO (SomeException -> IO ())
getUncaughtExceptionHandler
SomeException -> IO ()
handler SomeException
ex
foreign import ccall unsafe "reportStackOverflow"
c_reportStackOverflow :: ThreadId# -> IO ()
foreign import ccall unsafe "reportHeapOverflow"
reportHeapOverflow :: IO ()
{-# NOINLINE uncaughtExceptionHandler #-}
uncaughtExceptionHandler :: IORef (SomeException -> IO ())
uncaughtExceptionHandler :: IORef (SomeException -> IO ())
uncaughtExceptionHandler = IO (IORef (SomeException -> IO ()))
-> IORef (SomeException -> IO ())
forall a. IO a -> a
unsafePerformIO ((SomeException -> IO ()) -> IO (IORef (SomeException -> IO ()))
forall a. a -> IO (IORef a)
newIORef SomeException -> IO ()
defaultHandler)
where
defaultHandler :: SomeException -> IO ()
defaultHandler :: SomeException -> IO ()
defaultHandler se :: SomeException
se@(SomeException ex :: e
ex) = do
(Handle -> IO ()
hFlush Handle
stdout) IO () -> (forall e. Exception e => e -> IO ()) -> IO ()
forall a. IO a -> (forall e. Exception e => e -> IO a) -> IO a
`catchAny` (\ _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
let msg :: String
msg = case e -> Maybe Deadlock
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
ex of
Just Deadlock -> "no threads to run: infinite loop or deadlock?"
_ -> Int -> SomeException -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 SomeException
se ""
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString "%s" ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cfmt :: CString
cfmt ->
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
msg ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cmsg :: CString
cmsg ->
CString -> CString -> IO ()
errorBelch CString
cfmt CString
cmsg
foreign import ccall unsafe "HsBase.h errorBelch2"
errorBelch :: CString -> CString -> IO ()
setUncaughtExceptionHandler :: (SomeException -> IO ()) -> IO ()
setUncaughtExceptionHandler :: (SomeException -> IO ()) -> IO ()
setUncaughtExceptionHandler = IORef (SomeException -> IO ()) -> (SomeException -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SomeException -> IO ())
uncaughtExceptionHandler
getUncaughtExceptionHandler :: IO (SomeException -> IO ())
getUncaughtExceptionHandler :: IO (SomeException -> IO ())
getUncaughtExceptionHandler = IORef (SomeException -> IO ()) -> IO (SomeException -> IO ())
forall a. IORef a -> IO a
readIORef IORef (SomeException -> IO ())
uncaughtExceptionHandler