content: {-# LANGUAGE MagicHash #-}
  -- !!! test tryTakeMVar
  
  import Control.Concurrent
  import Control.Exception
  
  import GHC.Exts		( fork# )
  import GHC.IO    	( IO(..) )
  import GHC.Conc		( ThreadId(..) )
  
  main = do
    m <- newEmptyMVar
    r <- timeout 5 (tryTakeMVar m) (putStrLn "timed out!" >> return Nothing)
    print (r :: Maybe Int)
  
    m <- newMVar True
    r <- timeout 5 (tryTakeMVar m) (putStrLn "timed out!" >> return Nothing)
    print r
  
  timeout
     :: Int	-- secs
     -> IO a	-- action to run
     -> IO a	-- action to run on timeout
     -> IO a
  
  timeout secs action on_timeout 
    = do
      threadid <- myThreadId
      timeout <- forkIO $ do threadDelay (secs * 1000000)
                             throwTo threadid (ErrorCall "__timeout")
      ( do result <- action
  	 killThread timeout
  	 return result
        ) 
        `Control.Exception.catch`
          \exception -> case fromException exception of
  		       Just (ErrorCall "__timeout") -> on_timeout
  		       _other -> do killThread timeout
                                      throw exception
  
  