Commit 701256df authored by David Feuer's avatar David Feuer Committed by David Feuer

Change catch# demand signature

* Give `catch#` a lazy demand signature, to make it more honest.

* Make `catchException` and `catchAny` force their arguments so they
actually behave as advertised.

* Use `catch` rather than `catchException` in `forkIO`, `forkOn`, and
`forkOS` to avoid losing exceptions.

Fixes #13330

Reviewers: rwbarton, simonpj, simonmar, bgamari, hvr, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3244
parent b86d226f
......@@ -708,7 +708,7 @@ lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd, catchArgDmd :: Demand
strictApply1Dmd = JD { sd = Str VanStr (SCall HeadStr)
, ud = Use Many (UCall One Used) }
-- First argument of catch#:
-- First argument of catchRetry# and catchSTM#:
-- uses its arg once, applies it once
-- and catches exceptions (the ExnStr) part
catchArgDmd = JD { sd = Str ExnStr (SCall HeadStr)
......
......@@ -1965,7 +1965,7 @@ primop CatchOp "catch#" GenPrimOp
-> State# RealWorld
-> (# State# RealWorld, a #)
with
strictness = { \ _arity -> mkClosedStrictSig [ catchArgDmd
strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
, lazyApply2Dmd
, topDmd] topRes }
-- See Note [Strictness for mask/unmask/catch]
......
......@@ -308,7 +308,7 @@ forkOS action0
MaskedInterruptible -> action0
MaskedUninterruptible -> uninterruptibleMask_ action0
action_plus = catchException action1 childHandler
action_plus = catch action1 childHandler
entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
err <- forkOS_createThread entry
......
......@@ -111,45 +111,6 @@ import Data.Either
-----------------------------------------------------------------------------
-- Catching exceptions
-- |This is the simplest of the exception-catching functions. It
-- takes a single argument, runs it, and if an exception is raised
-- the \"handler\" is executed, with the value of the exception passed as an
-- argument. Otherwise, the result is returned as normal. For example:
--
-- > catch (readFile f)
-- > (\e -> do let err = show (e :: IOException)
-- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
-- > return "")
--
-- Note that we have to give a type signature to @e@, or the program
-- will not typecheck as the type is ambiguous. While it is possible
-- to catch exceptions of any type, see the section \"Catching all
-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
--
-- Note that due to Haskell\'s unspecified evaluation order, an
-- expression may throw one of several possible exceptions: consider
-- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
-- the expression throw
-- @ErrorCall \"urk\"@, or @DivideByZero@?
--
-- The answer is \"it might throw either\"; the choice is
-- non-deterministic. If you are catching any type of exception then you
-- might catch either. If you are calling @catch@ with type
-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
-- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
-- exception may be propogated further up. If you call it again, you
-- might get a the opposite behaviour. This is ok, because 'catch' is an
-- 'IO' computation.
--
catch :: Exception e
=> IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
catch act = catchException (lazy act)
-- | The function 'catchJust' is like 'catch', but it takes an extra
-- argument which is an /exception predicate/, a function which
-- selects which type of exceptions we\'re interested in.
......
......@@ -280,7 +280,9 @@ forkIO :: IO () -> IO ThreadId
forkIO action = IO $ \ s ->
case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
where
action_plus = catchException action childHandler
-- We must use 'catch' rather than 'catchException' because the action
-- could be bottom. #13330
action_plus = catch action childHandler
-- | Like 'forkIO', but the child thread is passed a function that can
-- be used to unmask asynchronous exceptions. This function is
......@@ -328,7 +330,9 @@ forkOn :: Int -> IO () -> IO ThreadId
forkOn (I# cpu) action = IO $ \ s ->
case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
where
action_plus = catchException action childHandler
-- We must use 'catch' rather than 'catchException' because the action
-- could be bottom. #13330
action_plus = catch action childHandler
-- | Like 'forkIOWithUnmask', but the child thread is pinned to the
-- given CPU, as with 'forkOn'.
......@@ -396,7 +400,11 @@ numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)
foreign import ccall "&enabled_capabilities" enabled_capabilities :: Ptr CInt
childHandler :: SomeException -> IO ()
childHandler err = catchException (real_handler err) childHandler
childHandler err = catch (real_handler err) childHandler
-- We must use catch here rather than catchException. If the
-- raised exception throws an (imprecise) exception, then real_handler err
-- will do so as well. If we use catchException here, then we could miss
-- that exception.
real_handler :: SomeException -> IO ()
real_handler se
......
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
......@@ -159,7 +161,23 @@ withCStringsLen enc strs f = go [] strs
-- whether or not a character is encodable will, in general, depend on the
-- context in which it occurs.
charIsRepresentable :: TextEncoding -> Char -> IO Bool
charIsRepresentable enc c = withCString enc [c] (fmap (== [c]) . peekCString enc) `catchException` (\e -> let _ = e :: IOException in return False)
-- We force enc explicitly because `catch` is lazy in its
-- first argument. We would probably like to force c as well,
-- but unfortunately worker/wrapper produces very bad code for
-- that.
--
-- TODO If this function is performance-critical, it would probably
-- pay to use a single-character specialization of withCString. That
-- would allow worker/wrapper to actually eliminate Char boxes, and
-- would also get rid of the completely unnecessary cons allocation.
charIsRepresentable !enc c =
withCString enc [c]
(\cstr -> do str <- peekCString enc cstr
case str of
[ch] | ch == c -> pure True
_ -> pure False)
`catch`
\(_ :: IOException) -> pure False
-- auxiliary definitions
-- ----------------------
......
......@@ -3,6 +3,7 @@
, BangPatterns
, RankNTypes
, MagicHash
, ScopedTypeVariables
, UnboxedTuples
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
......@@ -33,7 +34,7 @@ module GHC.IO (
FilePath,
catchException, catchAny, throwIO,
catch, catchException, catchAny, throwIO,
mask, mask_, uninterruptibleMask, uninterruptibleMask_,
MaskingState(..), getMaskingState,
unsafeUnmask, interruptible,
......@@ -113,7 +114,7 @@ type FilePath = String
-- Primitive catch and throwIO
{-
catchException used to handle the passing around of the state to the
catchException/catch used to handle the passing around of the state to the
action and the handler. This turned out to be a bad idea - it meant
that we had to wrap both arguments in thunks so they could be entered
as normal (remember IO returns an unboxed pair...).
......@@ -123,7 +124,7 @@ Now catch# has type
catch# :: IO a -> (b -> IO a) -> IO a
(well almost; the compiler doesn't know about the IO newtype so we
have to work around that in the definition of catchException below).
have to work around that in the definition of catch below).
-}
-- | Catch an exception in the 'IO' monad.
......@@ -132,25 +133,66 @@ have to work around that in the definition of catchException below).
-- @catchException undefined b == _|_@. See #exceptions_and_strictness#
-- for details.
catchException :: Exception e => IO a -> (e -> IO a) -> IO a
catchException (IO io) handler = IO $ catch# io handler'
catchException !io handler = catch io handler
-- | This is the simplest of the exception-catching functions. It
-- takes a single argument, runs it, and if an exception is raised
-- the \"handler\" is executed, with the value of the exception passed as an
-- argument. Otherwise, the result is returned as normal. For example:
--
-- > catch (readFile f)
-- > (\e -> do let err = show (e :: IOException)
-- > hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
-- > return "")
--
-- Note that we have to give a type signature to @e@, or the program
-- will not typecheck as the type is ambiguous. While it is possible
-- to catch exceptions of any type, see the section \"Catching all
-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
--
-- Note that due to Haskell\'s unspecified evaluation order, an
-- expression may throw one of several possible exceptions: consider
-- the expression @(error \"urk\") + (1 \`div\` 0)@. Does
-- the expression throw
-- @ErrorCall \"urk\"@, or @DivideByZero@?
--
-- The answer is \"it might throw either\"; the choice is
-- non-deterministic. If you are catching any type of exception then you
-- might catch either. If you are calling @catch@ with type
-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
-- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
-- exception may be propogated further up. If you call it again, you
-- might get a the opposite behaviour. This is ok, because 'catch' is an
-- 'IO' computation.
--
catch :: Exception e
=> IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
-- See #exceptions_and_strictness#.
catch (IO io) handler = IO $ catch# io handler'
where handler' e = case fromException e of
Just e' -> unIO (handler e')
Nothing -> raiseIO# e
-- | Catch any 'Exception' type in the 'IO' monad.
--
-- Note that this function is /strict/ in the action. That is,
-- @catchException undefined b == _|_@. See #exceptions_and_strictness# for
-- details.
catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny (IO io) handler = IO $ catch# io handler'
catchAny !(IO io) handler = IO $ catch# io handler'
where handler' (SomeException e) = unIO (handler e)
-- Using catchException here means that if `m` throws an
-- 'IOError' /as an imprecise exception/, we will not catch
-- it. No one should really be doing that anyway.
mplusIO :: IO a -> IO a -> IO a
mplusIO m n = m `catchIOError` \ _ -> n
where catchIOError :: IO a -> (IOError -> IO a) -> IO a
catchIOError = catchException
mplusIO m n = m `catchException` \ (_ :: IOError) -> n
-- | A variant of 'throw' that can only be used within the 'IO' monad.
--
......@@ -387,28 +429,20 @@ evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
{- $exceptions_and_strictness
Laziness can interact with @catch@-like operations in non-obvious ways (see,
e.g. GHC Trac #11555). For instance, consider these subtly-different examples,
e.g. GHC Trac #11555 and #13330). For instance, consider these subtly-different
examples:
> test1 = Control.Exception.catch (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
>
> test2 = GHC.IO.catchException (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
While the first case is always guaranteed to print "it failed", the behavior of
@test2@ may vary with optimization level.
The unspecified behavior of @test2@ is due to the fact that GHC may assume that
'catchException' (and the 'catch#' primitive operation which it is built upon)
is strict in its first argument. This assumption allows the compiler to better
optimize @catchException@ calls at the expense of deterministic behavior when
the action may be bottom.
While @test1@ will print "it failed", @test2@ will print "uh oh".
Namely, the assumed strictness means that exceptions thrown while evaluating the
action-to-be-executed may not be caught; only exceptions thrown during execution
of the action will be handled by the exception handler.
When using 'catchException', exceptions thrown while evaluating the
action-to-be-executed will not be caught; only exceptions thrown during
execution of the action will be handled by the exception handler.
Since this strictness is a small optimization and may lead to surprising
results, all of the @catch@ and @handle@ variants offered by "Control.Exception"
are lazy in their first argument. If you are certain that that the action to be
executed won't bottom in performance-sensitive code, you might consider using
'GHC.IO.catchException' or 'GHC.IO.catchAny' for a small speed-up.
use 'catch' rather than 'catchException'.
-}
module Main where
import Control.Concurrent
import Control.Exception
main = forkIO (error "Successful exception") >> threadDelay 100000
T13330: Successful exception
CallStack (from HasCallStack):
error, called at T13330.hs:5:16 in main:Main
......@@ -280,3 +280,6 @@ test('hs_try_putmvar003',
],
compile_and_run,
['hs_try_putmvar003_c.c'])
# Check forkIO exception determinism under optimization
test('T13330', normal, compile_and_run, ['-O'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment