RE: how to implement timeouts for IO operations?

23 Apr 2001

      The correct way to implement timeout in GHC 5.00 is below.  This should
really be in a library somewhere.

This implementation works for GHC's current "blocking" semantics for
throwTo, but if we change the semantics of throwTo to match the
asynchronous exceptions paper
(http://www.haskell.org/~simonmar/papers/async.ps.gz) then a different
implementation of timeout will be needed.

Cheers,
	Simon

------------------------------------------------------------------------
-----
import Dynamic
import Unique
import Exception
import Concurrent

data TimeOut = TimeOut Unique

timeOutTc = mkTyCon "TimeOut";
instance Typeable TimeOut where { typeOf _ = mkAppTy timeOutTc [] }

timeout secs on_timeout action
  = do {
       parent  <- myThreadId;
       i       <- newUnique;
       block (do
          timeout <- forkIO (timeout_thread secs parent i);
          Exception.catchDyn
            ( unblock (
                do {
                   result <- action;
                   killThread timeout;
                   return result;
                   }
              )
            )
            ( \exception -> 
                case exception of
                    TimeOut u | u == i -> unblock on_timeout
                    other -> do { 
                                killThread timeout;
                                throwDyn exception 
                                }
            )
         )
       }

timeout_thread secs parent i
  = do { 
       threadDelay (secs * 1000000);
       throwTo parent (DynException (toDyn (TimeOut i)))
       }

RE: how to implement timeouts for IO operations?

Simon Marlow