X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FConc.lhs;h=cfb370ce86bd0110621d1943d7046f93857ef6cb;hb=f0d03cbf416d6c3beb984b313f0c7196ec32a929;hp=03ec10b6c341ff52618945f40ac18b8ebdb7bb02;hpb=75ea0fa2485c169f0546d5d40477d2f6747efe29;p=ghc-base.git

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 03ec10b..cfb370c 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -47,6 +47,7 @@ module GHC.Conc
 #ifdef mingw32_TARGET_OS
 	, asyncRead     -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
 	, asyncWrite    -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
+	, asyncDoProc   -- :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO ()
 
 	, asyncReadBA   -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
 	, asyncWriteBA  -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int)
@@ -62,7 +63,7 @@ import GHC.Real		( fromIntegral )
 import GHC.Base		( Int(..) )
 import GHC.Exception    ( Exception(..), AsyncException(..) )
 import GHC.Pack		( packCString# )
-import GHC.Ptr          ( Ptr(..), plusPtr )
+import GHC.Ptr          ( Ptr(..), plusPtr, FunPtr(..) )
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -331,6 +332,13 @@ asyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) =
   IO $ \s -> case asyncWrite# fd isSock len buf s  of 
   	       (# s, len#, err# #) -> (# s, (I# len#, I# err#) #)
 
+asyncDoProc :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO ()
+asyncDoProc (FunPtr proc) (Ptr param) = 
+    -- the return values are ignored; simplifies implementation of
+    -- the async*# primops to have them all return the same result.
+  IO $ \s -> case asyncDoProc# proc param s  of 
+  	       (# s, len#, err# #) -> (# s, () #)
+
 -- to aid the use of these primops by the IO Handle implementation,
 -- provide the following convenience funs: