{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
module Control.Prim.Concurrent
( module Control.Prim.Concurrent
) where
import qualified Control.Exception as GHC
import qualified GHC.Conc as GHC
import Control.Prim.Exception
import Control.Prim.Monad.Internal
import GHC.Exts
import System.Posix.Types
import Foreign.C.Types
spark :: MonadPrim s m => a -> m a
spark a = prim (spark# a)
numSparks :: MonadPrim s m => m Int
numSparks =
prim $ \s ->
case numSparks# s of
(# s', n# #) -> (# s', I# n# #)
runSparks :: MonadPrim s m => m ()
runSparks = prim_ loop
where
loop s =
case getSpark# s of
(# s', n#, p #) ->
if isTrue# (n# ==# 0#)
then s'
else p `seq` loop s'
delay :: MonadPrim s m => Int -> m ()
delay (I# i#) = prim_ (delay# i#)
waitRead :: MonadPrim s m => Fd -> m ()
waitRead fd =
case fromIntegral fd of
I# i# -> prim_ (waitRead# i#)
waitWrite :: MonadPrim s m => Fd -> m ()
waitWrite fd =
case fromIntegral fd of
I# i# -> prim_ (waitWrite# i#)
fork :: MonadPrim RW m => m () -> m GHC.ThreadId
fork action =
prim $ \s ->
case fork# action s of
(# s', tid# #) -> (# s', GHC.ThreadId tid# #)
forkOn :: MonadPrim RW m => Int -> m () -> m GHC.ThreadId
forkOn (I# cap#) action =
prim $ \s ->
case forkOn# cap# action s of
(# s', tid# #) -> (# s', GHC.ThreadId tid# #)
killThread :: MonadPrim RW m => GHC.ThreadId -> m ()
killThread tid = throwTo tid GHC.ThreadKilled
yield :: MonadPrim RW m => m ()
yield = prim_ yield#
myThreadId :: MonadPrim RW m => m GHC.ThreadId
myThreadId =
prim $ \s ->
case myThreadId# s of
(# s', tid# #) -> (# s', GHC.ThreadId tid# #)
labelThread :: MonadPrim RW m => GHC.ThreadId -> Ptr a -> m ()
labelThread (GHC.ThreadId tid#) (Ptr addr#) = prim_ (labelThread# tid# addr#)
isCurrentThreadBoundPrim :: MonadPrim RW m => m Bool
isCurrentThreadBoundPrim =
prim $ \s ->
case isCurrentThreadBound# s of
(# s', bool# #) -> (# s', isTrue# bool# #)
threadStatus :: MonadPrim RW m => GHC.ThreadId -> m GHC.ThreadStatus
threadStatus = liftPrimBase . GHC.threadStatus
threadCapability :: MonadPrim RW m => GHC.ThreadId -> m (Int, Bool)
threadCapability = liftPrimBase . GHC.threadCapability
threadIdToCInt :: GHC.ThreadId -> CInt
threadIdToCInt tid = getThreadId (id2TSO tid)
id2TSO :: GHC.ThreadId -> ThreadId#
id2TSO (GHC.ThreadId t) = t
foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt