X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTimeout.hs;h=df33625c8d4cca3f8b51052c4c87492481d4cd5f;hb=HEAD;hp=0e82704a850b9996b5fa6ea7529349ca4ea57145;hpb=a2bcd1899dea9b266b7c795e391f658985deda2e;p=ghc-base.git diff --git a/System/Timeout.hs b/System/Timeout.hs index 0e82704..df33625 100644 --- a/System/Timeout.hs +++ b/System/Timeout.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE CPP #-} +#ifdef __GLASGOW_HASKELL__ +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +#endif + ------------------------------------------------------------------------------- -- | -- Module : System.Timeout @@ -12,22 +17,19 @@ -- ------------------------------------------------------------------------------- +#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) @@ -35,13 +37,14 @@ import Data.Unique (Unique, newUnique) -- interrupt the running IO computation when the timeout has -- expired. -data Timeout = Timeout Unique deriving Eq +newtype Timeout = Timeout Unique deriving Eq INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout") 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 +76,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 +88,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__ */