X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTimeout.hs;h=f27a936ed29edb9a984c7088bd40c8ccde5c3a3b;hb=7b2cb5626544e89431b8fbc42ab3eca072913b23;hp=634b3548afcc156e6156a1af8c7318b14a531b05;hpb=8e9892cd14b7558649fcd9ba0597805eb57505b3;p=ghc-base.git diff --git a/System/Timeout.hs b/System/Timeout.hs index 634b354..f27a936 100644 --- a/System/Timeout.hs +++ b/System/Timeout.hs @@ -12,32 +12,35 @@ -- ------------------------------------------------------------------------------- -module System.Timeout ( timeout ) where +#ifdef __GLASGOW_HASKELL__ +#include "Typeable.h" +#endif -#if __NHC__ -timeout :: Int -> IO a -> IO (Maybe a) -timeout n f = fmap Just f -#else +module System.Timeout ( timeout ) where +#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 -- expired. -data Timeout = Timeout Unique deriving (Eq, Typeable) +data 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 @@ -69,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 @@ -80,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__ */