projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
For GHC, implement the Typeable.hs macros using standalone deriving
[ghc-base.git]
/
System
/
Timeout.hs
diff --git
a/System/Timeout.hs
b/System/Timeout.hs
index
959e1a2
..
df33625
100644
(file)
--- a/
System/Timeout.hs
+++ b/
System/Timeout.hs
@@
-1,3
+1,8
@@
+{-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
+
-------------------------------------------------------------------------------
-- |
-- Module : System.Timeout
-------------------------------------------------------------------------------
-- |
-- Module : System.Timeout
@@
-12,22
+17,19
@@
--
-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------
+#ifdef __GLASGOW_HASKELL__
#include "Typeable.h"
#include "Typeable.h"
+#endif
module System.Timeout ( timeout ) where
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,
import Prelude (Show(show), IO, Ord((<)), Eq((==)), Int,
- (.), otherwise, fmap)
+ otherwise, fmap)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
-import Control.Monad (Monad(..), guard)
+import Control.Monad (Monad(..))
import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
-import Control.Exception.Base (Exception, handleJust, throwTo, bracket)
-import Data.Dynamic (Typeable, fromDynamic)
+import Control.Exception (Exception, handleJust, throwTo, bracket)
import Data.Typeable
import Data.Unique (Unique, newUnique)
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.
-- 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 _ = "<<timeout>>"
instance Exception Timeout
INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout")
instance Show Timeout where
show _ = "<<timeout>>"
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
-- |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)
-- 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
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))
(bracket (forkIO (threadDelay n >> throwTo pid ex))
(killThread)
(\_ -> fmap Just f))
-#endif
+#else
+timeout n f = fmap Just f
+#endif /* !__GLASGOW_HASKELL__ */