X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FConc%2FWindows.hs;h=fecbb20d3a4c0d9d843867e04f1c4894cd8f43e1;hb=509f28cc93b980d30aca37008cbe66c677a0d6f6;hp=14139b76e2e5ccf91b8e938a748fcd75c0099bfc;hpb=9520c5735e69668a33013c36f85152a1ef656b8d;p=ghc-base.git

diff --git a/GHC/Conc/Windows.hs b/GHC/Conc/Windows.hs
index 14139b7..fecbb20 100644
--- a/GHC/Conc/Windows.hs
+++ b/GHC/Conc/Windows.hs
@@ -1,6 +1,8 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, ForeignFunctionInterface,
+             DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_HADDOCK not-home #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Conc.Windows
@@ -40,7 +42,6 @@ import Control.Monad
 import Data.Bits (shiftR)
 import Data.Maybe (Maybe(..))
 import Data.Typeable
-import Foreign.C.Error (throwErrno)
 import GHC.Base
 import GHC.Conc.Sync
 import GHC.Enum (Enum)
@@ -53,6 +54,7 @@ import GHC.Read (Read)
 import GHC.Real (div, fromIntegral)
 import GHC.Show (Show)
 import GHC.Word (Word32, Word64)
+import GHC.Windows
 
 -- ----------------------------------------------------------------------------
 -- Thread waiting
@@ -104,7 +106,7 @@ threadDelay :: Int -> IO ()
 threadDelay time
   | threaded  = waitForDelayEvent time
   | otherwise = IO $ \s ->
-        case fromIntegral time of { I# time# ->
+        case time of { I# time# ->
         case delay# time# s of { s' -> (# s', () #)
         }}
 
@@ -234,7 +236,7 @@ service_loop wakeup old_delays = do
 
   r <- c_WaitForSingleObject wakeup timeout
   case r of
-    0xffffffff -> do c_maperrno; throwErrno "service_loop"
+    0xffffffff -> do throwGetLastError "service_loop"
     0 -> do
         r2 <- c_readIOManagerEvent
         exit <-
@@ -310,15 +312,6 @@ getDelay now all@(d : rest)
             milli_seconds = (micro_seconds + 999) `div` 1000
         in return (all, fromIntegral milli_seconds)
 
--- ToDo: this just duplicates part of System.Win32.Types, which isn't
--- available yet.  We should move some Win32 functionality down here,
--- maybe as part of the grand reorganisation of the base package...
-type HANDLE       = Ptr ()
-type DWORD        = Word32
-
-iNFINITE :: DWORD
-iNFINITE = 0xFFFFFFFF -- urgh
-
 foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)
   c_getIOManagerEvent :: IO HANDLE
 
@@ -328,8 +321,5 @@ foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c)
 foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c)
   c_sendIOManagerEvent :: Word32 -> IO ()
 
-foreign import ccall unsafe "maperrno"             -- in Win32Utils.c
-   c_maperrno :: IO ()
-
 foreign import stdcall "WaitForSingleObject"
    c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD