Re: Interruptible exception wormholes kill modularity

2016-07-04 Thread Simon Marlow
On 2 July 2016 at 17:25, Edward Z. Yang  wrote:

> Excerpts from Simon Marlow's message of 2016-07-02 05:58:14 -0400:
> > > Claim 1: Here is some code which reimplements 'unblock':
> > >
> > > import Control.Exception
> > > import Control.Concurrent
> > > import Control.Concurrent.MVar
> > >
> > > unblock :: IO a -> IO a
> > > unblock io = do
> > > m <- newEmptyMVar
> > > _ <- forkIO (io >>= putMVar m)
> > > takeMVar m
> > >
> > >
> > This isn't really an implementation of unblock, because it doesn't enable
> > fully-asynchronous exceptions inside io.  If a stack overflow occurs, it
> > won't be thrown, for example.  Also, io will not be interrupted by an
> > asynchronous exception thrown to the current thread.
>
> Oh, that's true. I suppose you could work around this by passing
> on an asynchronous exception to a child thread that is unmasked
> using forkIOWithUnmask, although maybe you would consider that
> cheating?
>

Yes, you can use forkIOWithUnmask as a way to break out of mask.  Perhaps
for that reason it should have "unsafe" in the name, but I think it's hard
to use it by accident.

I actually do agree with you that the "modularity" provided by mask isn't
really useful.  But my reasoning is a bit different.

The caller of mask is saying "I want asynchronous exceptions to only occur
at known places.".  Those known places are interruptible operations, and
library code (because we can't know whether library code performs an
interruptible operation or not).  From the point of view of the caller of
mask, they cannot tell the difference between library code that invokes an
interruptible operation, and library code that calls "unblock".  So it
would be perfectly fine to provide an "unblock" that re-enables fully
asynchronous exceptions.

(indeed I think this was kind of what I had in mind with the original
block/unblock, but I didn't articulate the argument clearly enough when
everyone was asking for "mask")

However, things are a bit different with uninterruptibleMask.  Here the
caller is saying "I don't expect to see *any* asynchronous exceptions,
either in my code or from library code".  So clearly an unblock cannot undo
an uninterruptibleMask.

Having said all this, I don't think the current API is necessarily bad, it
just provides more guarantees than we really need, and perhaps it's a bit
less efficient than it could be, due to the need to pass the IO action to
mask.  But we would still need to do this for uninterruptibleMask, and
having the API of uninterruptibleMask be the same as mask is good.


> We already have a way to allow asynchronous exceptions to be thrown within
> > a mask, it's called allowInterrupt:
> >
> http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Exception.html#v:allowInterrupt
>
> Well, it's different, right?  allowInterrupt allows asynchronous
> exceptions to
> be thrown at a specific point of execution; unblock allows asynchronous
> exceptions to be thrown at any point while the inner IO action is
> executing.  I don't see why you would allow the former without the
> latter.
>

Ok, so the point I was trying to make was that the idea of blocking to
allow asynchronous exceptions to be thrown inside a mask is fully
sanctioned, and we made an API for it.  But you're quite right that it's
not exactly the same as unblock.


> > > You could very well argue that interruptible actions are a design flaw.
> > >
> >
> > I disagree - it's impossible to define withMVar without interruptible
> mask.
>
> What about this version of withMVar using uninterruptible? (Assume
> no other producers.)
>
> withMVarUninterruptible :: MVar a -> (a -> IO b) -> IO b
> withMVarUninterruptible m io =
>   uninterruptibleMask $ \restore -> do
> a <- restore (takeMVar m)
> b <- restore (io a) `onException` putMVar m a
> putMVar m a
> return b
>
> I don't think it is quite right, as there is race between when
> takeMVar unblocks, and when the uninterruptible mask is restored.
> But perhaps the primary utility of interruptible masks is to
> let you eliminate this race.
>

Exactly!  This race condition is the reason for interruptible operations.

[snip]

>
> Edward
>

Cheers
Simon
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Interruptible exception wormholes kill modularity

2016-07-02 Thread Yuras Shumovich
On Sat, 2016-07-02 at 12:29 -0400, Edward Z. Yang wrote:
> Excerpts from Yuras Shumovich's message of 2016-07-02 09:06:59 -0400:
> > On Sat, 2016-07-02 at 00:49 -0400, Edward Z. Yang wrote:
> > > 
> > > P.P.S. I have some speculations about using uninterruptibleMask
> > > more
> > > frequently: it seems to me that there ought to be a variant of
> > > uninterruptibleMask that immediately raises an exception if
> > > the "uninterruptible" action blocks.  This would probably of
> > > great assistance of noticing and eliminating blocking in
> > > uninterruptible code.
> > 
> > 
> > Could you please elaborate where it is useful. Any particular
> > example?
> 
> You would use it in any situation you use an uninterruptibleMask.
> The point is that uninterruptible code is not supposed to take
> too long (the program is unresponsive in the meantime), so it's
> fairly bad news if inside uninterruptible code you block.  The
> block = exception variant would help you find out when this occurred.

Hmm, ununterruptibleMask is used when the code can block, but you don't
want it to throw (async) exception. waitQSem is an example:
https://hackage.haskell.org/package/base-4.9.0.0/docs/src/Control.Concurrent.QSem.html#waitQSem

Basically, there are cases where code can block, yet you don't want it
to be interrupted. Why to you need uninterruptibleMask when the code
can't block anyway? It is a no-op in that case.

> 
> Arguably, it would be more Haskelly if there was a static type
> discipline for distinguishing blocking and non-blocking IO
> operations.
> But some operations are only known to be (non-)blocking at runtime,
> e.g., takeMVar/putMVar, so a dynamic discipline is necessary.

That is correct. In theory it would be useful to encode on type level
whether IO operations can block, or can be iterrupted by async
exception, or can fail with sync exception. Unfortunately it depends on
runtime, so in practice it is less useful.

> 
> > I'm interested because few years ago I proposed similar function,
> > but
> > in a bit different context. I needed it to make interruptible
> > cleanup
> > actions safe to use.
> 
> Could you elaborate more / post a link?

Sorry, I thought I added the link. I'm talking about this:
http://blog.haskell-exists.com/yuras/posts/handling-async-exceptions-in-haskell-pushing-bracket-to-the-limits.html#example-6-pushing-to-the-limits

The idea is to disable external async exceptions, but interrupt any
interruptable operation on the way. The article describes the reason I
need it.

Thanks,
Yuras.

___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Interruptible exception wormholes kill modularity

2016-07-02 Thread Edward Z. Yang
Excerpts from Yuras Shumovich's message of 2016-07-02 09:06:59 -0400:
> On Sat, 2016-07-02 at 00:49 -0400, Edward Z. Yang wrote:
> > 
> > P.P.S. I have some speculations about using uninterruptibleMask more
> > frequently: it seems to me that there ought to be a variant of
> > uninterruptibleMask that immediately raises an exception if
> > the "uninterruptible" action blocks.  This would probably of
> > great assistance of noticing and eliminating blocking in
> > uninterruptible code.
> 
> 
> Could you please elaborate where it is useful. Any particular example?

You would use it in any situation you use an uninterruptibleMask.
The point is that uninterruptible code is not supposed to take
too long (the program is unresponsive in the meantime), so it's
fairly bad news if inside uninterruptible code you block.  The
block = exception variant would help you find out when this occurred.

Arguably, it would be more Haskelly if there was a static type
discipline for distinguishing blocking and non-blocking IO operations.
But some operations are only known to be (non-)blocking at runtime,
e.g., takeMVar/putMVar, so a dynamic discipline is necessary.

> I'm interested because few years ago I proposed similar function, but
> in a bit different context. I needed it to make interruptible cleanup
> actions safe to use.

Could you elaborate more / post a link?

Cheers,
Edward
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Interruptible exception wormholes kill modularity

2016-07-02 Thread Edward Z. Yang
Excerpts from Simon Marlow's message of 2016-07-02 05:58:14 -0400:
> > Claim 1: Here is some code which reimplements 'unblock':
> >
> > import Control.Exception
> > import Control.Concurrent
> > import Control.Concurrent.MVar
> >
> > unblock :: IO a -> IO a
> > unblock io = do
> > m <- newEmptyMVar
> > _ <- forkIO (io >>= putMVar m)
> > takeMVar m
> >
> >
> This isn't really an implementation of unblock, because it doesn't enable
> fully-asynchronous exceptions inside io.  If a stack overflow occurs, it
> won't be thrown, for example.  Also, io will not be interrupted by an
> asynchronous exception thrown to the current thread.

Oh, that's true. I suppose you could work around this by passing
on an asynchronous exception to a child thread that is unmasked
using forkIOWithUnmask, although maybe you would consider that
cheating?

> We already have a way to allow asynchronous exceptions to be thrown within
> a mask, it's called allowInterrupt:
> http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Exception.html#v:allowInterrupt

Well, it's different, right?  allowInterrupt allows asynchronous exceptions to
be thrown at a specific point of execution; unblock allows asynchronous
exceptions to be thrown at any point while the inner IO action is
executing.  I don't see why you would allow the former without the
latter.

> I don't buy the claim that this breaks "modularity".  The way to think
> about mask is that it disables fully-asynchronous exceptions, only allowing
> them to be thrown at certain well-defined points.  This makes them
> tractable, it means you can write code without worrying that an async
> exception will pop up at any point.  Inside a mask, the only way to get
> back to the state of fully asynchronous exceptions is to use the unblock
> action that mask gives you (provided you weren't already inside a mask).

I suppose what I don't understand, then, is that if interruptible
points are modular, I don't see why unblock isn't modular either;
it's just a more convenient way of inserting allowInterrupt between
every indivisible IO operation in user code.

> > You could very well argue that interruptible actions are a design flaw.
> >
> 
> I disagree - it's impossible to define withMVar without interruptible mask.

What about this version of withMVar using uninterruptible? (Assume
no other producers.)

withMVarUninterruptible :: MVar a -> (a -> IO b) -> IO b
withMVarUninterruptible m io =
  uninterruptibleMask $ \restore -> do
a <- restore (takeMVar m)
b <- restore (io a) `onException` putMVar m a
putMVar m a
return b

I don't think it is quite right, as there is race between when
takeMVar unblocks, and when the uninterruptible mask is restored.
But perhaps the primary utility of interruptible masks is to
let you eliminate this race.

> > Then you should use 'uninterruptibleMask' instead, which effectively
> > removes the concept of interruptibility--and is thus modular.  Indeed,
> > Eyal Lotem proposed [2] that 'bracket' should instead use
> > 'uninterruptibleMask', for precisely the reason that it is too easy to
> > reenable asynchronous exceptions in 'mask'.
> 
> 
> The problem he was talking about was to do with the interruptibility of the
> cleanup action in bracket, not the acquire, which really needs
> interruptible mask. The interruptibility of the cleanup is a complex issue
> with arguments on both sides.  Michael Snoyman recently brought it up again
> in the context of his safe-exceptions library.  We might yet change that -
> perhaps at the very least we should implement a catchUninterruptible# that
> behaves like catch# but applies uninterruptibleMask to the handler, and
> appropriate user-level wrappers.

Yes, it is complex, and I won't claim to know the right answer here.

> > But assuming that
> > interruptible masks are a good idea (Simon Marlow has defended them
> > as "a way avoid reasoning about asynchronous exceptions except
> > at specific points, i.e., where you might block"), there should
> > be an 'unblock' for this type of mask.
> >
> > It should be said that the absence of 'unblock' for
> > 'uninterruptibleMask' only implies that a passed in IO action (e.g., the
> > cleanup action in bracket) does not have access to the exceptions thrown
> > to the current thread; it doesn't actually guarantee uninterruptibility,
> > since the passed in IO action could always raise a normal exception.
> > Haskell's type system is not up to the task of enforcing such
> > invariants.
> >
> > Cheers,
> > Edward
> >
> > [1]
> > https://mail.haskell.org/pipermail/libraries/2010-March/013310.html
> > https://mail.haskell.org/pipermail/libraries/2010-April/013420.html
> >
> > [2]
> > https://mail.haskell.org/pipermail/libraries/2014-September/0
> > 
> > Cheers,
> > Simon
> >
> > 23675.html
> > 

Re: Interruptible exception wormholes kill modularity

2016-07-02 Thread Yuras Shumovich
On Sat, 2016-07-02 at 00:49 -0400, Edward Z. Yang wrote:
> 
> P.P.S. I have some speculations about using uninterruptibleMask more
> frequently: it seems to me that there ought to be a variant of
> uninterruptibleMask that immediately raises an exception if
> the "uninterruptible" action blocks.  This would probably of
> great assistance of noticing and eliminating blocking in
> uninterruptible code.


Could you please elaborate where it is useful. Any particular example?

I'm interested because few years ago I proposed similar function, but
in a bit different context. I needed it to make interruptible cleanup
actions safe to use.

Thanks,
Yuras.
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Interruptible exception wormholes kill modularity

2016-07-02 Thread Simon Marlow
Hi Edward,

On 2 July 2016 at 05:49, Edward Z. Yang  wrote:

> In 2010, in the thread "Asynchronous exception wormholes kill modularity"
> [1],
> Bas van Dijk observed that 'unblock :: IO a -> IO a' broke modularity,
> as the sequence of calls 'block . block . unblock $ io' would result in
> 'io' being run with asynchronous exceptions unblocked, despite the outer
> 'block' "expecting" that asynchronous exceptions cannot be thrown.
>
> I would like to make two claims:
>
> 1. The new mask/restore interface is insufficient to "solve"
> this modularity problem, as *interruptible* operations can
> still be used to catch asynchronous exceptions.
>
> 2. Thus, we should provide an unblock combinator which
> can be used to catch asynchronous exceptions from a 'mask'
> (though not an 'uninterruptibleMask')--though it is
> doubtful if anyone should ever use 'mask' in the first
> place.
>
> Claim 1: Here is some code which reimplements 'unblock':
>
> import Control.Exception
> import Control.Concurrent
> import Control.Concurrent.MVar
>
> unblock :: IO a -> IO a
> unblock io = do
> m <- newEmptyMVar
> _ <- forkIO (io >>= putMVar m)
> takeMVar m
>
>
This isn't really an implementation of unblock, because it doesn't enable
fully-asynchronous exceptions inside io.  If a stack overflow occurs, it
won't be thrown, for example.  Also, io will not be interrupted by an
asynchronous exception thrown to the current thread.

We already have a way to allow asynchronous exceptions to be thrown within
a mask, it's called allowInterrupt:
http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Exception.html#v:allowInterrupt

I don't buy the claim that this breaks "modularity".  The way to think
about mask is that it disables fully-asynchronous exceptions, only allowing
them to be thrown at certain well-defined points.  This makes them
tractable, it means you can write code without worrying that an async
exception will pop up at any point.  Inside a mask, the only way to get
back to the state of fully asynchronous exceptions is to use the unblock
action that mask gives you (provided you weren't already inside a mask).


> The main idea is that 'takeMVar' is an interruptible operation:
> when it blocks, the thread can now receive asynchronous exceptions.
> In general, a thread can unmask exceptions by blocking.  Here
> is a simple test-case:
>
> main = do
> let x = 1000 -- Just do a bit of work
> tid <- myThreadId
> forkIO $ (threadDelay 1 >> killThread tid)
> r <- mask $ \restore -> do
> -- restore $ do
> -- unblock $ do
> -- do something non-blocking
> evaluate (f x [])
> -- If the exception is delivered in a timely manner,
> -- shouldn't get here.
> print r
>
> f 0 r = r
> f n r = f (n-1) (n:r)
>
> With both restore and unblock commented, the ThreadKilled
> exception is delayed; uncommenting either restore or unblock
> causes the exception to be delivered.
>
> This admonition does not apply to uninterruptibleMask, for
> which there are no interruptible exceptions.
>
> Claim 2:  Thus, I come to the conclusion that we were wrong
> to remove 'unblock', and that it is no worse than the
> ability for interruptible actions to catch asynchronous
> exceptions.
>
>
I don't think your argument undermines mask.


> You could very well argue that interruptible actions are a design flaw.
>

I disagree - it's impossible to define withMVar without interruptible mask.


> Then you should use 'uninterruptibleMask' instead, which effectively
> removes the concept of interruptibility--and is thus modular.  Indeed,
> Eyal Lotem proposed [2] that 'bracket' should instead use
> 'uninterruptibleMask', for precisely the reason that it is too easy to
> reenable asynchronous exceptions in 'mask'.


The problem he was talking about was to do with the interruptibility of the
cleanup action in bracket, not the acquire, which really needs
interruptible mask.  The interruptibility of the cleanup is a complex issue
with arguments on both sides.  Michael Snoyman recently brought it up again
in the context of his safe-exceptions library.  We might yet change that -
perhaps at the very least we should implement a catchUninterruptible# that
behaves like catch# but applies uninterruptibleMask to the handler, and
appropriate user-level wrappers.


> But assuming that
> interruptible masks are a good idea (Simon Marlow has defended them
> as "a way avoid reasoning about asynchronous exceptions except
> at specific points, i.e., where you might block"), there should
> be an 'unblock' for this type of mask.
>
> It should be said that the absence of 'unblock' for
> 'uninterruptibleMask' only implies that a passed in IO action (e.g., the
> cleanup action in bracket) does not have access to the exceptions thrown
> to the current thread; it doesn't 

Interruptible exception wormholes kill modularity

2016-07-01 Thread Edward Z. Yang
In 2010, in the thread "Asynchronous exception wormholes kill modularity" [1],
Bas van Dijk observed that 'unblock :: IO a -> IO a' broke modularity,
as the sequence of calls 'block . block . unblock $ io' would result in
'io' being run with asynchronous exceptions unblocked, despite the outer
'block' "expecting" that asynchronous exceptions cannot be thrown.

I would like to make two claims:

1. The new mask/restore interface is insufficient to "solve"
this modularity problem, as *interruptible* operations can
still be used to catch asynchronous exceptions.

2. Thus, we should provide an unblock combinator which
can be used to catch asynchronous exceptions from a 'mask'
(though not an 'uninterruptibleMask')--though it is
doubtful if anyone should ever use 'mask' in the first
place.

Claim 1: Here is some code which reimplements 'unblock':

import Control.Exception
import Control.Concurrent
import Control.Concurrent.MVar

unblock :: IO a -> IO a
unblock io = do
m <- newEmptyMVar
_ <- forkIO (io >>= putMVar m)
takeMVar m

The main idea is that 'takeMVar' is an interruptible operation:
when it blocks, the thread can now receive asynchronous exceptions.
In general, a thread can unmask exceptions by blocking.  Here
is a simple test-case:

main = do
let x = 1000 -- Just do a bit of work
tid <- myThreadId
forkIO $ (threadDelay 1 >> killThread tid)
r <- mask $ \restore -> do
-- restore $ do
-- unblock $ do
-- do something non-blocking
evaluate (f x [])
-- If the exception is delivered in a timely manner,
-- shouldn't get here.
print r

f 0 r = r
f n r = f (n-1) (n:r)

With both restore and unblock commented, the ThreadKilled
exception is delayed; uncommenting either restore or unblock
causes the exception to be delivered.

This admonition does not apply to uninterruptibleMask, for
which there are no interruptible exceptions.

Claim 2:  Thus, I come to the conclusion that we were wrong
to remove 'unblock', and that it is no worse than the
ability for interruptible actions to catch asynchronous
exceptions.

You could very well argue that interruptible actions are a design flaw.
Then you should use 'uninterruptibleMask' instead, which effectively
removes the concept of interruptibility--and is thus modular.  Indeed,
Eyal Lotem proposed [2] that 'bracket' should instead use
'uninterruptibleMask', for precisely the reason that it is too easy to
reenable asynchronous exceptions in 'mask'.  But assuming that
interruptible masks are a good idea (Simon Marlow has defended them
as "a way avoid reasoning about asynchronous exceptions except
at specific points, i.e., where you might block"), there should
be an 'unblock' for this type of mask.

It should be said that the absence of 'unblock' for
'uninterruptibleMask' only implies that a passed in IO action (e.g., the
cleanup action in bracket) does not have access to the exceptions thrown
to the current thread; it doesn't actually guarantee uninterruptibility,
since the passed in IO action could always raise a normal exception.
Haskell's type system is not up to the task of enforcing such
invariants.

Cheers,
Edward

[1]
https://mail.haskell.org/pipermail/libraries/2010-March/013310.html
https://mail.haskell.org/pipermail/libraries/2010-April/013420.html

[2]
https://mail.haskell.org/pipermail/libraries/2014-September/023675.html

P.S. You were CC'ed to this mail because you participated in the original
"Asynchronous exception wormholes kill modularity" discussion.

P.P.S. I have some speculations about using uninterruptibleMask more
frequently: it seems to me that there ought to be a variant of
uninterruptibleMask that immediately raises an exception if
the "uninterruptible" action blocks.  This would probably of
great assistance of noticing and eliminating blocking in
uninterruptible code.
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs