forkIO,
#ifdef __GLASGOW_HASKELL__
+ forkIOUnmasked,
killThread,
throwTo,
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Exception
import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield,
- threadDelay, forkIO, childHandler )
+ threadDelay, forkIO, forkIOUnmasked, childHandler )
import qualified GHC.Conc
-import GHC.IO ( IO(..), unsafeInterleaveIO )
+import GHC.IO ( IO(..), unsafeInterleaveIO, unsafeUnmask )
import GHC.IORef ( newIORef, readIORef, writeIORef )
import GHC.Base
forkOS action0
| rtsSupportsBoundThreads = do
mv <- newEmptyMVar
- b <- Exception.blocked
+ b <- Exception.getMaskingState
let
- -- async exceptions are blocked in the child if they are blocked
+ -- async exceptions are masked in the child if they are masked
-- in the parent, as for forkIO (see #1048). forkOS_createThread
- -- creates a thread with exceptions blocked by default.
- action1 | b = action0
- | otherwise = unblock action0
+ -- creates a thread with exceptions masked by default.
+ action1 = case b of
+ Unmasked -> unsafeUnmask action0
+ MaskedInterruptible -> action0
+ MaskedUninterruptible -> uninterruptibleMask_ action0
action_plus = Exception.catch action1 childHandler
then do
mv <- newEmptyMVar
b <- blocked
- _ <- block $ forkIO $
- Exception.try (if b then action else unblock action) >>=
+ _ <- mask $ \restore -> forkIO $
+ Exception.try (if b then action else restore action) >>=
putMVar mv
takeMVar mv >>= \ei -> case ei of
Left exception -> Exception.throw (exception :: SomeException)
withThread :: IO a -> IO a
withThread io = do
m <- newEmptyMVar
- _ <- block $ forkIO $ try io >>= putMVar m
+ _ <- mask_ $ forkIO $ try io >>= putMVar m
x <- takeMVar m
case x of
Right a -> return a
-}
readMVar :: MVar a -> IO a
readMVar m =
- block $ do
+ mask_ $ do
a <- takeMVar m
putMVar m a
return a
-}
swapMVar :: MVar a -> a -> IO a
swapMVar mvar new =
- block $ do
+ mask_ $ do
old <- takeMVar mvar
putMVar mvar new
return old
-- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar m io =
- block $ do
+ mask $ \restore -> do
a <- takeMVar m
- b <- unblock (io a) `onException` putMVar m a
+ b <- restore (io a) `onException` putMVar m a
putMVar m a
return b
{-# INLINE modifyMVar_ #-}
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ m io =
- block $ do
+ mask $ \restore -> do
a <- takeMVar m
- a' <- unblock (io a) `onException` putMVar m a
+ a' <- restore (io a) `onException` putMVar m a
putMVar m a'
{-|
{-# INLINE modifyMVar #-}
modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
modifyMVar m io =
- block $ do
+ mask $ \restore -> do
a <- takeMVar m
- (a',b) <- unblock (io a) `onException` putMVar m a
+ (a',b) <- restore (io a) `onException` putMVar m a
putMVar m a'
return b
import Prelude
import Control.Concurrent.MVar
-import Control.Exception ( block )
+import Control.Exception ( mask_ )
import Data.Typeable
#include "Typeable.h"
-- |Wait for a unit to become available
waitQSem :: QSem -> IO ()
-waitQSem (QSem sem) = block $ do
+waitQSem (QSem sem) = mask_ $ do
(avail,blocked) <- takeMVar sem -- gain ex. access
if avail > 0 then
let avail' = avail-1
-- |Signal that a unit of the 'QSem' is available
signalQSem :: QSem -> IO ()
-signalQSem (QSem sem) = block $ do
+signalQSem (QSem sem) = mask_ $ do
(avail,blocked) <- takeMVar sem
case blocked of
[] -> let avail' = avail+1
import Prelude
import Control.Concurrent.MVar
-import Control.Exception ( block )
+import Control.Exception ( mask_ )
import Data.Typeable
#include "Typeable.h"
-- |Wait for the specified quantity to become available
waitQSemN :: QSemN -> Int -> IO ()
-waitQSemN (QSemN sem) sz = block $ do
+waitQSemN (QSemN sem) sz = mask_ $ do
(avail,blocked) <- takeMVar sem -- gain ex. access
let remaining = avail - sz
if remaining >= 0 then
-- |Signal that a given quantity is now available from the 'QSemN'.
signalQSemN :: QSemN -> Int -> IO ()
-signalQSemN (QSemN sem) n = block $ do
+signalQSemN (QSemN sem) n = mask_ $ do
(avail,blocked) <- takeMVar sem
(avail',blocked') <- free (avail+n) blocked
avail' `seq` putMVar sem (avail',blocked')
import Control.Concurrent.MVar
-import Control.Exception ( block )
+import Control.Exception ( mask_ )
import Data.Functor ( (<$>) )
-- |If the SampleVar is full, leave it empty. Otherwise, do nothing.
emptySampleVar :: SampleVar a -> IO ()
-emptySampleVar (SampleVar v) = block $ do
- s@(readers, var) <- block $ takeMVar v
+emptySampleVar (SampleVar v) = mask_ $ do
+ s@(readers, var) <- takeMVar v
if readers > 0 then do
_ <- takeMVar var
putMVar v (0,var)
-- |Wait for a value to become available, then take it and return.
readSampleVar :: SampleVar a -> IO a
-readSampleVar (SampleVar svar) = block $ do
+readSampleVar (SampleVar svar) = mask_ $ do
--
-- filled => make empty and grab sample
-- not filled => try to grab value, empty when read val.
-- |Write a value into the 'SampleVar', overwriting any previous value that
-- was there.
writeSampleVar :: SampleVar a -> a -> IO ()
-writeSampleVar (SampleVar svar) v = block $ do
+writeSampleVar (SampleVar svar) v = mask_ $ do
--
-- filled => overwrite
-- not filled => fill, write val
-- ** Asynchronous exception control
- -- |The following two functions allow a thread to control delivery of
+ -- |The following functions allow a thread to control delivery of
-- asynchronous exceptions during a critical region.
+ mask,
+ mask_,
+ uninterruptibleMask,
+ uninterruptibleMask_,
+ MaskingState(..),
+ getMaskingState,
+
+ -- ** (deprecated) Asynchronous exception control
+
block,
unblock,
blocked,
#ifdef __GLASGOW_HASKELL__
import GHC.Base
--- import GHC.IO hiding ( onException, finally )
import Data.Maybe
#else
import Prelude hiding (catch)
-}
{- $block_handler
-There\'s an implied 'block' around every exception handler in a call
+There\'s an implied 'mask' around every exception handler in a call
to one of the 'catch' family of functions. This is because that is
what you want most of the time - it eliminates a common race condition
in starting an exception handler, because there may be no exception
before being interrupted. If this weren\'t the default, one would have
to write something like
-> block (
-> catch (unblock (...))
-> (\e -> handler)
-> )
+> block $ \restore ->
+> catch (restore (...))
+> (\e -> handler)
If you need to unblock asynchronous exceptions again in the exception
handler, just use 'unblock' as normal.
{- $interruptible
+ #interruptible#
Some operations are /interruptible/, which means that they can receive
asynchronous exceptions even in the scope of a 'block'. Any function
which may itself block is defined as interruptible; this includes
some I\/O with the outside world. The reason for having
interruptible operations is so that we can write things like
-> block (
+> mask $ \restore -> do
> a <- takeMVar m
-> catch (unblock (...))
+> catch (restore (...))
> (\e -> ...)
-> )
if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
then this particular
-- ** Asynchronous exception control
+ mask,
+ mask_,
+ uninterruptibleMask,
+ uninterruptibleMask_,
+ MaskingState(..),
+ getMaskingState,
+
+ -- ** (deprecated) Asynchronous exception control
+
block,
unblock,
blocked,
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracket before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- r <- unblock (thing a) `onException` after a
+ r <- restore (thing a) `onException` after a
_ <- after a
return r
- )
#endif
-- | A specialised variant of 'bracket' with just a computation to run
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
- r <- unblock a `onException` sequel
+ mask $ \restore -> do
+ r <- restore a `onException` sequel
_ <- sequel
return r
- )
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- unblock (thing a) `onException` after a
- )
+ restore (thing a) `onException` after a
#if !(__GLASGOW_HASKELL__ || __NHC__)
assert :: Bool -> a -> a
#endif
import qualified Control.Exception as New
-import Control.Exception ( toException, fromException, throw, block, unblock, evaluate, throwIO )
+import Control.Exception ( toException, fromException, throw, block, unblock, mask, evaluate, throwIO )
import System.IO.Error hiding ( catch, try )
import System.IO.Unsafe (unsafePerformIO)
import Data.Dynamic
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracket before after thing =
- block (do
+ mask $ \restore -> do
a <- before
r <- catch
- (unblock (thing a))
+ (restore (thing a))
(\e -> do { _ <- after a; throw e })
_ <- after a
return r
- )
#endif
-- | A specialised variant of 'bracket' with just a computation to run
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
+ mask $ \restore -> do
r <- catch
- (unblock a)
+ (restore a)
(\e -> do { _ <- sequel; throw e })
_ <- sequel
return r
- )
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
- block (do
+ mask $ \restore -> do
a <- before
catch
- (unblock (thing a))
+ (restore (thing a))
(\e -> do { _ <- after a; throw e })
- )
-- -----------------------------------------------------------------------------
-- Asynchronous exceptions
-}
{- $block_handler
-There\'s an implied 'block' around every exception handler in a call
+There\'s an implied 'mask_' around every exception handler in a call
to one of the 'catch' family of functions. This is because that is
what you want most of the time - it eliminates a common race condition
in starting an exception handler, because there may be no exception
before being interrupted. If this weren\'t the default, one would have
to write something like
-> block (
-> catch (unblock (...))
+> mask $ \restore ->
+> catch (restore (...))
> (\e -> handler)
-> )
If you need to unblock asynchronous exceptions again in the exception
handler, just use 'unblock' as normal.
Note that 'try' and friends /do not/ have a similar default, because
there is no exception handler in this case. If you want to use 'try'
in an asynchronous-exception-safe way, you will need to use
-'block'.
+'mask'.
-}
{- $interruptible
Some operations are /interruptible/, which means that they can receive
-asynchronous exceptions even in the scope of a 'block'. Any function
+asynchronous exceptions even in the scope of a 'mask'. Any function
which may itself block is defined as interruptible; this includes
'Control.Concurrent.MVar.takeMVar'
(but not 'Control.Concurrent.MVar.tryTakeMVar'),
some I\/O with the outside world. The reason for having
interruptible operations is so that we can write things like
-> block (
+> mask $ \restore -> do
> a <- takeMVar m
-> catch (unblock (...))
+> catch (restore (...))
> (\e -> ...)
-> )
if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
then this particular
-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
-- |
import GHC.Num (Integer, fromInteger, (+))
import GHC.Real ( rem, Ratio )
import GHC.IORef (IORef,newIORef)
-import GHC.IO (unsafePerformIO,block)
+import GHC.IO (unsafePerformIO,mask_)
-- These imports are so we can define Typeable instances
-- It'd be better to give Typeable instances in the modules themselves
tc_tbl = empty_tc_tbl,
ap_tbl = empty_ap_tbl }
#ifdef __GLASGOW_HASKELL__
- block $ do
+ mask_ $ do
stable_ref <- newStablePtr ret
let ref = castStablePtrToPtr stable_ref
ref2 <- getOrSetTypeableStore ref
import GHC.Base ( Int, Monad(..), (.), not )
import GHC.Err ( undefined )
import GHC.Exception ( throw )
-import GHC.IO ( IO, block, unblock, catchAny )
+import GHC.IO ( IO, mask, catchAny )
import GHC.IORef ( IORef, newIORef, readIORef, writeIORef )
import GHC.List ( elem, length )
import GHC.Num ( Num(..) )
withPool :: (Pool -> IO b) -> IO b
#ifdef __GLASGOW_HASKELL__
withPool act = -- ATTENTION: cut-n-paste from Control.Exception below!
- block (do
+ mask (\restore -> do
pool <- newPool
val <- catchAny
- (unblock (act pool))
+ (restore (act pool))
(\e -> do freePool pool; throw e)
freePool pool
return val)
-- * Forking and suchlike
, forkIO -- :: IO a -> IO ThreadId
+ , forkIOUnmasked
, forkOnIO -- :: Int -> IO a -> IO ThreadId
+ , forkOnIOUnmasked
, numCapabilities -- :: Int
, childHandler -- :: Exception -> IO ()
, myThreadId -- :: IO ThreadId
The new thread will be a lightweight thread; if you want to use a foreign
library that uses thread-local storage, use 'Control.Concurrent.forkOS' instead.
-GHC note: the new thread inherits the /blocked/ state of the parent
-(see 'Control.Exception.block').
+GHC note: the new thread inherits the /masked/ state of the parent
+(see 'Control.Exception.mask').
The newly created thread has an exception handler that discards the
exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and
where
action_plus = catchException action childHandler
+-- | Like 'forkIO', but the child thread is created with asynchronous exceptions
+-- unmasked (see 'Control.Exception.mask').
+forkIOUnmasked :: IO () -> IO ThreadId
+forkIOUnmasked io = forkIO (unsafeUnmask io)
+
{- |
Like 'forkIO', but lets you specify on which CPU the thread is
created. Unlike a `forkIO` thread, a thread created by `forkOnIO`
where
action_plus = catchException action childHandler
+-- | Like 'forkOnIO', but the child thread is created with
+-- asynchronous exceptions unmasked (see 'Control.Exception.mask').
+forkOnIOUnmasked :: Int -> IO () -> IO ThreadId
+forkOnIOUnmasked cpu io = forkOnIO cpu (unsafeUnmask io)
+
-- | the value passed to the @+RTS -N@ flag. This is the number of
-- Haskell threads that can run truly simultaneously at any given
-- time, and is typically set to the number of physical CPU cores on
If the target thread is currently making a foreign call, then the
exception will not be raised (and hence 'throwTo' will not return)
until the call has completed. This is the case regardless of whether
-the call is inside a 'block' or not.
+the call is inside a 'mask' or not.
Important note: the behaviour of 'throwTo' differs from that described in
the paper \"Asynchronous exceptions in Haskell\"
\begin{code}
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar m io =
- block $ do
+ mask $ \restore -> do
a <- takeMVar m
- b <- catchAny (unblock (io a))
+ b <- catchAny (restore (io a))
(\e -> do putMVar m a; throw e)
putMVar m a
return b
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ m io =
- block $ do
+ mask $ \restore -> do
a <- takeMVar m
- a' <- catchAny (unblock (io a))
+ a' <- catchAny (restore (io a))
(\e -> do putMVar m a; throw e)
putMVar m a'
return ()
--
sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
sharedCAF a get_or_set =
- block $ do
+ mask_ $ do
stable_ref <- newStablePtr a
let ref = castPtr (castStablePtrToPtr stable_ref)
ref2 <- get_or_set ref
-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields -XBangPatterns #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, RankNTypes #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
FilePath,
catchException, catchAny, throwIO,
- block, unblock, blocked,
+ mask, mask_, uninterruptibleMask, uninterruptibleMask_,
+ MaskingState(..), getMaskingState,
+ block, unblock, blocked, unsafeUnmask,
onException, finally, evaluate
) where
import GHC.Base
import GHC.ST
import GHC.Exception
+import GHC.Show
import Data.Maybe
import {-# SOURCE #-} GHC.IO.Exception ( userError )
-- -----------------------------------------------------------------------------
-- Controlling asynchronous exception delivery
--- | Applying 'block' to a computation will
+{-# DEPRECATED block "use Control.Exception.mask instead" #-}
+-- | Note: this function is deprecated, please use 'mask' instead.
+--
+-- Applying 'block' to a computation will
-- execute that computation with asynchronous exceptions
-- /blocked/. That is, any thread which
-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
--- blocked until asynchronous exceptions are enabled again. There\'s
+-- blocked until asynchronous exceptions are unblocked again. There\'s
-- no need to worry about re-enabling asynchronous exceptions; that is
-- done automatically on exiting the scope of
-- 'block'.
-- establish an exception handler in the forked thread before any
-- asynchronous exceptions are received.
block :: IO a -> IO a
+block (IO io) = IO $ maskAsyncExceptions# io
--- | To re-enable asynchronous exceptions inside the scope of
+{-# DEPRECATED unblock "use Control.Exception.mask instead" #-}
+-- | Note: this function is deprecated, please use 'mask' instead.
+--
+-- To re-enable asynchronous exceptions inside the scope of
-- 'block', 'unblock' can be
-- used. It scopes in exactly the same way, so on exit from
-- 'unblock' asynchronous exception delivery will
-- be disabled again.
unblock :: IO a -> IO a
-
-block (IO io) = IO $ blockAsyncExceptions# io
-unblock (IO io) = IO $ unblockAsyncExceptions# io
+unblock = unsafeUnmask
+
+unsafeUnmask :: IO a -> IO a
+unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
+
+blockUninterruptible :: IO a -> IO a
+blockUninterruptible (IO io) = IO $ maskUninterruptible# io
+
+-- | Describes the behaviour of a thread when an asynchronous
+-- exception is received.
+data MaskingState
+ = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
+ | MaskedInterruptible
+ -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
+ | MaskedUninterruptible
+ -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
+ deriving (Eq,Show)
+
+-- | Returns the 'MaskingState' for the current thread.
+getMaskingState :: IO MaskingState
+getMaskingState = IO $ \s ->
+ case getMaskingState# s of
+ (# s', i #) -> (# s', case i of
+ 0# -> Unmasked
+ 1# -> MaskedUninterruptible
+ _ -> MaskedInterruptible #)
-- | returns True if asynchronous exceptions are blocked in the
-- current thread.
blocked :: IO Bool
-blocked = IO $ \s -> case asyncExceptionsBlocked# s of
- (# s', i #) -> (# s', i /=# 0# #)
+blocked = fmap (/= Unmasked) getMaskingState
onException :: IO a -> IO b -> IO a
onException io what = io `catchException` \e -> do _ <- what
throw (e :: SomeException)
+-- | Executes an IO computation with asynchronous
+-- exceptions /masked/. That is, any thread which attempts to raise
+-- an exception in the current thread with 'Control.Exception.throwTo'
+-- will be blocked until asynchronous exceptions are unmasked again.
+--
+-- The argument passed to 'mask' is a function that takes as its
+-- argument another function, which can be used to restore the
+-- prevailing masking state within the context of the masked
+-- computation. For example, a common way to use 'mask' is to protect
+-- the acquisition of a resource:
+--
+-- > mask $ \restore -> do
+-- > x <- acquire
+-- > restore (do_something_with x) `onException` release
+-- > release
+--
+-- This code guarantees that @acquire@ is paired with @release@, by masking
+-- asynchronous exceptions for the critical parts. (Rather than write
+-- this code yourself, it would be better to use
+-- 'Control.Exception.bracket' which abstracts the general pattern).
+--
+-- Note that the @restore@ action passed to the argument to 'mask'
+-- does not necessarily unmask asynchronous exceptions, it just
+-- restores the masking state to that of the enclosing context. Thus
+-- if asynchronous exceptions are already masked, 'mask' cannot be used
+-- to unmask exceptions again. This is so that if you call a library function
+-- with exceptions masked, you can be sure that the library call will not be
+-- able to unmask exceptions again. If you are writing library code and need
+-- to use asynchronous exceptions, the only way is to create a new thread;
+-- see 'Control.Concurrent.forkIOUnmasked'.
+--
+-- Asynchronous exceptions may still be received while in the masked
+-- state if the masked thread /blocks/ in certain ways; see
+-- "Control.Exception#interruptible".
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the masked
+-- state from the parent; that is, to start a thread in blocked mode,
+-- use @mask_ $ forkIO ...@. This is particularly useful if you need
+-- to establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received. To create a a new thread in
+-- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
+--
+mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'mask', but does not pass a @restore@ action to the argument.
+mask_ :: IO a -> IO a
+
+-- | Like 'mask', but the masked computation is not interruptible (see
+-- "Control.Exception#interruptible"). THIS SHOULD BE USED WITH
+-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
+-- blocks for any reason, then the thread (and possibly the program,
+-- if this is the main thread) will be unresponsive and unkillable.
+-- This function should only be necessary if you need to mask
+-- exceptions around an interruptible operation, and you can guarantee
+-- that the interruptible operation will only block for a short period
+-- of time.
+--
+uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'uninterruptibleMask', but does not pass a @restore@ action
+-- to the argument.
+uninterruptibleMask_ :: IO a -> IO a
+
+mask_ io = mask $ \_ -> io
+
+mask io = do
+ b <- getMaskingState
+ case b of
+ Unmasked -> block $ io unblock
+ _ -> io id
+
+uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
+
+uninterruptibleMask io = do
+ b <- getMaskingState
+ case b of
+ Unmasked -> blockUninterruptible $ io unblock
+ MaskedInterruptible -> blockUninterruptible $ io block
+ MaskedUninterruptible -> io id
+
finally :: IO a -- ^ computation to run first
-> IO b -- ^ computation to run afterward (even if an exception
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
- r <- unblock a `onException` sequel
+ mask $ \restore -> do
+ r <- restore a `onException` sequel
_ <- sequel
return r
- )
-- | Forces its argument to be evaluated to weak head normal form when
-- the resultant 'IO' action is executed. It can be used to order
withHandle' :: String -> Handle -> MVar Handle__
-> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle' fun h m act =
- block $ do
+ mask_ $ do
(h',v) <- do_operation fun h act m
checkHandleInvariants h'
putMVar m h'
withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
-> IO ()
withHandle__' fun h m act =
- block $ do
+ mask_ $ do
h' <- do_operation fun h act m
checkHandleInvariants h'
putMVar m h'
projects / ghc-base.git / commitdiff