[commit: base] master: Fix build on Windows (b3387ab)

Ian Lynagh igloo at earth.li
Sun Apr 28 01:44:40 CEST 2013


Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

https://github.com/ghc/packages-base/commit/b3387abfbc94b69e977c232386acad4dde7597e8

>---------------------------------------------------------------

commit b3387abfbc94b69e977c232386acad4dde7597e8
Author: Ian Lynagh <igloo at earth.li>
Date:   Sat Apr 27 23:43:08 2013 +0100

    Fix build on Windows

>---------------------------------------------------------------

 System/Timeout.hs |    9 +++++++--
 1 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/System/Timeout.hs b/System/Timeout.hs
index f17f4f9..559ca42 100644
--- a/System/Timeout.hs
+++ b/System/Timeout.hs
@@ -25,16 +25,19 @@
 module System.Timeout ( timeout ) where
 
 #ifdef __GLASGOW_HASKELL__
-import Control.Concurrent
+#ifndef mingw32_HOST_OS
+import Control.Monad
 import GHC.Event           (getSystemTimerManager,
                             registerTimeout, unregisterTimeout)
+#endif
+
+import Control.Concurrent
 import Control.Exception   (Exception(..), handleJust, bracket,
                             uninterruptibleMask_,
                             asyncExceptionToException,
                             asyncExceptionFromException)
 import Data.Typeable
 import Data.Unique         (Unique, newUnique)
-import Control.Monad
 
 -- An internal type that is thrown as a dynamic exception to
 -- interrupt the running IO computation when the timeout has
@@ -87,6 +90,7 @@ timeout :: Int -> IO a -> IO (Maybe a)
 timeout n f
     | n <  0    = fmap Just f
     | n == 0    = return Nothing
+#ifndef mingw32_HOST_OS
     | rtsSupportsBoundThreads = do
         -- In the threaded RTS, we use the Timer Manager to delay the
         -- (fairly expensive) 'forkIO' call until the timeout has expired.
@@ -116,6 +120,7 @@ timeout n f
                    (bracket (registerTimeout tm n handleTimeout)
                             cleanupTimeout
                             (\_ -> fmap Just f))
+#endif
     | otherwise = do
         pid <- myThreadId
         ex  <- fmap Timeout newUnique





More information about the ghc-commits mailing list