projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't use "deriving Typeable" (for portability reasons)
[ghc-base.git]
/
System
/
Timeout.hs
diff --git
a/System/Timeout.hs
b/System/Timeout.hs
index
ce487b5
..
0e82704
100644
(file)
--- a/
System/Timeout.hs
+++ b/
System/Timeout.hs
@@
-12,6
+12,8
@@
--
-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------
+#include "Typeable.h"
+
module System.Timeout ( timeout ) where
#if __NHC__
module System.Timeout ( timeout ) where
#if __NHC__
@@
-19,19
+21,27
@@
timeout :: Int -> IO a -> IO (Maybe a)
timeout n f = fmap Just f
#else
timeout n f = fmap Just f
#else
-import Prelude (IO, Ord((<)), Eq((==)), Int, (.), otherwise, fmap)
+import Prelude (Show(show), IO, Ord((<)), Eq((==)), Int,
+ (.), otherwise, fmap)
import Data.Maybe (Maybe(..))
import Control.Monad (Monad(..), guard)
import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
import Data.Maybe (Maybe(..))
import Control.Monad (Monad(..), guard)
import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
-import Control.Exception (handleJust, throwDynTo, dynExceptions, bracket)
+import Control.Exception (Exception, handleJust, throwTo, bracket)
import Data.Dynamic (Typeable, fromDynamic)
import Data.Dynamic (Typeable, fromDynamic)
+import Data.Typeable
import Data.Unique (Unique, newUnique)
-- An internal type that is thrown as a dynamic exception to
-- interrupt the running IO computation when the timeout has
-- expired.
import Data.Unique (Unique, newUnique)
-- 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 _ = "<<timeout>>"
+
+instance Exception Timeout
-- |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
-- |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,9
+79,9
@@
timeout n f
| otherwise = do
pid <- myThreadId
ex <- fmap Timeout newUnique
| otherwise = do
pid <- myThreadId
ex <- fmap Timeout newUnique
- handleJust (\e -> dynExceptions e >>= fromDynamic >>= guard . (ex ==))
+ handleJust (\e -> if e == ex then Just () else Nothing)
(\_ -> return Nothing)
(\_ -> return Nothing)
- (bracket (forkIO (threadDelay n >> throwDynTo pid ex))
+ (bracket (forkIO (threadDelay n >> throwTo pid ex))
(killThread)
(\_ -> fmap Just f))
#endif
(killThread)
(\_ -> fmap Just f))
#endif