X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTimeout.hs;h=f27a936ed29edb9a984c7088bd40c8ccde5c3a3b;hb=b5c54282dc54cc861277ae532224775076a4818e;hp=0e82704a850b9996b5fa6ea7529349ca4ea57145;hpb=a2bcd1899dea9b266b7c795e391f658985deda2e;p=ghc-base.git diff --git a/System/Timeout.hs b/System/Timeout.hs index 0e82704..f27a936 100644 --- a/System/Timeout.hs +++ b/System/Timeout.hs @@ -12,24 +12,22 @@ -- ------------------------------------------------------------------------------- +#ifdef __GLASGOW_HASKELL__ #include "Typeable.h" +#endif module System.Timeout ( timeout ) where -#if __NHC__ -timeout :: Int -> IO a -> IO (Maybe a) -timeout n f = fmap Just f -#else - +#ifdef __GLASGOW_HASKELL__ import Prelude (Show(show), IO, Ord((<)), Eq((==)), Int, - (.), otherwise, fmap) + otherwise, fmap) import Data.Maybe (Maybe(..)) -import Control.Monad (Monad(..), guard) +import Control.Monad (Monad(..)) import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread) import Control.Exception (Exception, handleJust, throwTo, bracket) -import Data.Dynamic (Typeable, fromDynamic) import Data.Typeable import Data.Unique (Unique, newUnique) +import GHC.Num -- An internal type that is thrown as a dynamic exception to -- interrupt the running IO computation when the timeout has @@ -42,6 +40,7 @@ instance Show Timeout where show _ = "<>" instance Exception Timeout +#endif /* !__GLASGOW_HASKELL__ */ -- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result -- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result @@ -73,6 +72,7 @@ instance Exception Timeout -- I\/O or file I\/O using this combinator. timeout :: Int -> IO a -> IO (Maybe a) +#ifdef __GLASGOW_HASKELL__ timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing @@ -84,4 +84,6 @@ timeout n f (bracket (forkIO (threadDelay n >> throwTo pid ex)) (killThread) (\_ -> fmap Just f)) -#endif +#else +timeout n f = fmap Just f +#endif /* !__GLASGOW_HASKELL__ */