add forkOnIO :: Int -> IO () -> IO ThreadId

[ghc-base.git] / GHC / Conc.lhs

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 896df03..d36f95f 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -25,6 +25,7 @@ module GHC.Conc
 
        -- Forking and suchlike
        , forkIO        -- :: IO a -> IO ThreadId
+       , forkOnIO      -- :: Int -> IO a -> IO ThreadId
        , childHandler  -- :: Exception -> IO ()
        , myThreadId    -- :: IO ThreadId
        , killThread    -- :: ThreadId -> IO ()
@@ -146,6 +147,12 @@ forkIO action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
+forkOnIO :: Int -> IO () -> IO ThreadId
+forkOnIO (I# cpu) action = IO $ \ s -> 
+   case (forkOn# cpu action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
+ where
+  action_plus = catchException action childHandler
+
 childHandler :: Exception -> IO ()
 childHandler err = catchException (real_handler err) childHandler