On 16/02/2011 23:27, Bas van Dijk wrote:
On 16 February 2011 20:26, Bas van Dijk<v.dijk....@gmail.com> wrote:
The patch and benchmarks attached to the ticket are updated. Hopefully
this is the last change I had to make so I can stop spamming.
And the spamming continues...
I started working on a hopefully even more efficient timeout that uses
the new GHC event manager.
The idea is that instead of forking a thread which delays for the
timeout period after which it throws a Timeout exception, I register a
timeout with the event manager. When the timeout fires the event
manager will throw the Timeout exception.
I haven't gotten around testing and benchmarking this yet. I hope to
do that tomorrow evening.
The code is currently living in the System.Event.Thread module:
module System.Event.Thread where
...
import Data.Typeable
import Text.Show (Show, show)
import GHC.Conc.Sync (myThreadId, throwTo)
import GHC.IO (throwIO,unsafePerformIO )
import GHC.Exception (Exception, fromException)
import Control.Exception.Base (catch)
-- I'm currently using the Unique from System.Event
-- because I got a circular import error when using Data.Unique:
import System.Event.Unique (UniqueSource, newSource, Unique, newUnique)
uniqSource :: UniqueSource
uniqSource = unsafePerformIO newSource
{-# NOINLINE uniqSource #-}
newtype Timeout = Timeout Unique deriving Eq
INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout")
instance Show Timeout where
show _ = "<<timeout>>"
instance Exception Timeout
timeout :: Int -> IO a -> IO (Maybe a)
timeout usecs f
| usecs< 0 = fmap Just f
| usecs == 0 = return Nothing
| otherwise = do
myTid<- myThreadId
uniq<- newUnique uniqSource
let timeoutEx = Timeout uniq
Just mgr<- readIORef eventManager
mask $ \restore -> do
reg<- registerTimeout mgr usecs (throwTo myTid timeoutEx)
let unregTimeout = M.unregisterTimeout mgr reg
(restore (fmap Just f)>>= \mb -> unregTimeout>> return mb)
`catch` \e ->
case fromException e of
Just timeoutEx' | timeoutEx' == timeoutEx -> return Nothing
_ -> unregTimeout>> throwIO e
If this version works, it's definitely preferable to your first
proposal. It relies on unregisterTimeout not being interruptible -
otherwise you're back to uninterruptibleMask again.
Cheers,
Simon
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
