[commit: ghc] ghc-8.0: Make `catch` lazy in the action (2e0ef45)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/2e0ef457d085255f2fff117713f896972105d288/ghc

>---------------------------------------------------------------

commit 2e0ef457d085255f2fff117713f896972105d288
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Fri Mar 11 10:38:10 2016 +0100

    Make `catch` lazy in the action
    
    Previously
    ```lang=haskell
    catch (error "uh oh") (\(_ :: SomeException) -> print "it failed")
    ```
    would unexpectedly fail with "uh oh" instead of the handler being run
    due to the strictness of `catch` in its first argument. See #11555 for
    details.
    
    Test Plan: Validate
    
    Reviewers: austin, hvr, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, thomie
    
    Differential Revision: https://phabricator.haskell.org/D1973
    
    GHC Trac Issues: #11555
    
    (cherry picked from commit 30ee9102db2f16894912e19b9d16156824611bbb)


>---------------------------------------------------------------

2e0ef457d085255f2fff117713f896972105d288
 libraries/base/Control/Exception/Base.hs |  2 +-
 libraries/base/GHC/IO.hs                 | 39 ++++++++++++++++++++++++++++++++
 libraries/base/tests/.gitignore          |  1 +
 libraries/base/tests/T11555.hs           |  9 ++++++++
 libraries/base/tests/T11555.stdout       |  1 +
 libraries/base/tests/all.T               |  1 +
 6 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs
index 351771b..5b3d47c 100644
--- a/libraries/base/Control/Exception/Base.hs
+++ b/libraries/base/Control/Exception/Base.hs
@@ -147,7 +147,7 @@ catch   :: Exception e
         => IO a         -- ^ The computation to run
         -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
         -> IO a
-catch = catchException
+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
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
index 186f6c6..52a333a 100644
--- a/libraries/base/GHC/IO.hs
+++ b/libraries/base/GHC/IO.hs
@@ -126,12 +126,22 @@ Now catch# has type
 have to work around that in the definition of catchException below).
 -}
 
+-- | Catch an exception in the 'IO' monad.
+--
+-- Note that this function is /strict/ in the action. That is,
+-- @catchException undefined b == _|_ at . See #exceptions_and_strictness#
+-- for details.
 catchException :: Exception e => IO a -> (e -> IO a) -> IO a
 catchException (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 == _|_ at . 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'
     where handler' (SomeException e) = unIO (handler e)
@@ -373,3 +383,32 @@ a `finally` sequel =
 -- use @'return' '$!' x at .
 evaluate :: a -> IO a
 evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
+
+{- $exceptions_and_strictness
+
+Laziness can interact with @catch at -like operations in non-obvious ways (see,
+e.g. GHC Trac #11555). 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
+ at 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.
+
+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.
+
+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.
+-}
diff --git a/libraries/base/tests/.gitignore b/libraries/base/tests/.gitignore
index a430bd7..32b9d10 100644
--- a/libraries/base/tests/.gitignore
+++ b/libraries/base/tests/.gitignore
@@ -273,3 +273,4 @@
 /weak001
 /T9395
 /T9532
+/T11555
diff --git a/libraries/base/tests/T11555.hs b/libraries/base/tests/T11555.hs
new file mode 100644
index 0000000..ce5b961
--- /dev/null
+++ b/libraries/base/tests/T11555.hs
@@ -0,0 +1,9 @@
+import Control.Exception
+
+-- Ensure that catch catches exceptions thrown during the evaluation of the
+-- action-to-be-executed. This should output "it failed".
+main :: IO ()
+main = catch (error "uh oh") handler
+
+handler :: SomeException -> IO ()
+handler _ = putStrLn "it failed"
diff --git a/libraries/base/tests/T11555.stdout b/libraries/base/tests/T11555.stdout
new file mode 100644
index 0000000..2f1c27e
--- /dev/null
+++ b/libraries/base/tests/T11555.stdout
@@ -0,0 +1 @@
+it failed
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 06ef3bb..574aba6 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -212,3 +212,4 @@ test('T9848',
       ['-O'])
 test('T10149', normal, compile_and_run, [''])
 test('T11334', normal, compile_and_run, [''])
+test('T11555', normal, compile_and_run, [''])
\ No newline at end of file