X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FConc.lhs;h=b19f520e0aa47fd92f25d702d775eb8930f72479;hb=9875b3cf1ada084cfa3e6c516b11e946f1d6234e;hp=f2875bea1cfb3c7508c7bc25ebf2c22ba51330c1;hpb=c1f3c4852894174a3f7b855b29e8a42f60d4c019;p=ghc-base.git

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index f2875be..b19f520 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -1,5 +1,6 @@
 \begin{code}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_HADDOCK not-home #-}
 -----------------------------------------------------------------------------
 -- |
@@ -265,6 +266,7 @@ terms of 'throwTo':
 
 > killThread tid = throwTo tid ThreadKilled
 
+Killthread is a no-op if the target thread has already completed.
 -}
 killThread :: ThreadId -> IO ()
 killThread tid = throwTo tid ThreadKilled
@@ -690,19 +692,19 @@ withMVar m io =
 asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
 asyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) =
   IO $ \s -> case asyncRead# fd isSock len buf s of 
-               (# s, len#, err# #) -> (# s, (I# len#, I# err#) #)
+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)
 
 asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
 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#) #)
+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)
 
 asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
 asyncDoProc (FunPtr proc) (Ptr param) = 
     -- the 'length' value is 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, I# err# #)
+               (# s', _len#, err# #) -> (# s', I# err# #)
 
 -- to aid the use of these primops by the IO Handle implementation,
 -- provide the following convenience funs:
@@ -910,26 +912,28 @@ service_loop wakeup old_delays = do
   case r of
     0xffffffff -> do c_maperrno; throwErrno "service_loop"
     0 -> do
-        r <- c_readIOManagerEvent
+        r2 <- c_readIOManagerEvent
         exit <- 
-              case r of
-                _ | r == io_MANAGER_WAKEUP -> return False
-                _ | r == io_MANAGER_DIE    -> return True
+              case r2 of
+                _ | r2 == io_MANAGER_WAKEUP -> return False
+                _ | r2 == io_MANAGER_DIE    -> return True
                 0 -> return False -- spurious wakeup
-                r -> do start_console_handler (r `shiftR` 1); return False
+                _ -> do start_console_handler (r2 `shiftR` 1); return False
         if exit
           then return ()
           else service_cont wakeup delays'
 
     _other -> service_cont wakeup delays' -- probably timeout        
 
+service_cont :: HANDLE -> [DelayReq] -> IO ()
 service_cont wakeup delays = do
   atomicModifyIORef prodding (\_ -> (False,False))
   service_loop wakeup delays
 
 -- must agree with rts/win32/ThrIOManager.c
-io_MANAGER_WAKEUP = 0xffffffff :: Word32
-io_MANAGER_DIE    = 0xfffffffe :: Word32
+io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word32
+io_MANAGER_WAKEUP = 0xffffffff
+io_MANAGER_DIE    = 0xfffffffe
 
 data ConsoleEvent
  = ControlC
@@ -948,6 +952,7 @@ start_console_handler r =
                     return ()
      Nothing -> return ()
 
+toWin32ConsoleEvent :: Num a => a -> Maybe ConsoleEvent
 toWin32ConsoleEvent ev = 
    case ev of
        0 {- CTRL_C_EVENT-}        -> Just ControlC
@@ -960,19 +965,21 @@ toWin32ConsoleEvent ev =
 win32ConsoleHandler :: MVar (ConsoleEvent -> IO ())
 win32ConsoleHandler = unsafePerformIO (newMVar (error "win32ConsoleHandler"))
 
+-- XXX Is this actually needed?
 stick :: IORef HANDLE
 {-# NOINLINE stick #-}
 stick = unsafePerformIO (newIORef nullPtr)
 
+wakeupIOManager :: IO ()
 wakeupIOManager = do 
-  hdl <- readIORef stick
+  _hdl <- readIORef stick
   c_sendIOManagerEvent io_MANAGER_WAKEUP
 
 -- Walk the queue of pending delays, waking up any that have passed
 -- and return the smallest delay to wait for.  The queue of pending
 -- delays is kept ordered.
 getDelay :: USecs -> [DelayReq] -> IO ([DelayReq], DWORD)
-getDelay now [] = return ([], iNFINITE)
+getDelay _   [] = return ([], iNFINITE)
 getDelay now all@(d : rest) 
   = case d of
      Delay time m | now >= time -> do
@@ -993,7 +1000,8 @@ getDelay now all@(d : rest)
 type HANDLE       = Ptr ()
 type DWORD        = Word32
 
-iNFINITE = 0xFFFFFFFF :: DWORD -- urgh
+iNFINITE :: DWORD
+iNFINITE = 0xFFFFFFFF -- urgh
 
 foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)
   c_getIOManagerEvent :: IO HANDLE