{-# LANGUAGE ForeignFunctionInterface #-}
-- | A variant of 'Control.Concurrent.setNumCapabilities' that automatically
-- detects the number of processors in the system.
module GF.System.Concurrency(
  -- * Controlling parallelism
  setNumCapabilities,getNumberOfProcessors) where
import qualified Control.Concurrent as C
import Foreign.C.Types(CInt(..))




-- | Set parallelism to a given number, or use the number of processors.
-- Returns 'False' if compiled with GHC<7.6 and the desired number of threads
-- hasn't already been set with @+RTS -N/n/ -RTS@.
setNumCapabilities :: Maybe Int -> IO Bool
setNumCapabilities Maybe Int
opt_n =
  do Int
n <- IO Int -> (Int -> IO Int) -> Maybe Int -> IO Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Int
getNumberOfProcessors Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
opt_n
     Int -> IO ()
C.setNumCapabilities Int
n
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Returns the number of processors in the system.
getNumberOfProcessors :: IO Int
getNumberOfProcessors = (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum IO CInt
c_getNumberOfProcessors

-- | According to comments in cabal-install cbits/getnumprocessors.c
-- this function is part of the RTS of GHC>=6.12.
foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt