X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FConc.lhs;h=0d174578a65b55bb9f64c02ee77a0ad5da47b9e5;hb=0bf2fdab482da7a287ef09f18e7656abe62256d0;hp=d676a1a7ae7c1f6ec672d7a24e68492ee8956ec9;hpb=c497471bb7fc204afb546f3116ad116f8569e452;p=ghc-base.git

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index d676a1a..0d17457 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -33,6 +33,7 @@ module GHC.Conc
         , forkOnIO      -- :: Int -> IO a -> IO ThreadId
         , forkOnIOUnmasked
         , numCapabilities -- :: Int
+        , numSparks      -- :: IO Int
         , childHandler  -- :: Exception -> IO ()
         , myThreadId    -- :: IO ThreadId
         , killThread    -- :: ThreadId -> IO ()
@@ -265,6 +266,10 @@ numCapabilities = unsafePerformIO $  do
                     n <- peek n_capabilities
                     return (fromIntegral n)
 
+-- | Returns the number of sparks currently in the local spark pool
+numSparks :: IO Int
+numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)
+
 #if defined(mingw32_HOST_OS) && defined(__PIC__)
 foreign import ccall "_imp__n_capabilities" n_capabilities :: Ptr CInt
 #else