[GHC] #14998: Sort out the strictness mess for exceptions

[GHC]

#14998: Sort out the strictness mess for exceptions
-------------------------------------+-------------------------------------
        Reporter:  simonpj           |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.4.3
       Component:  Compiler          |              Version:  8.2.2
      Resolution:                    |             Keywords:  Exceptions
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by sgraf):

 Item 2 no longer regresses in performance and passes `./validate` with
 this diff:

 {{{
 diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
 index 05ad277127..f9dbfef71b 100644
 --- a/libraries/base/GHC/IO.hs
 +++ b/libraries/base/GHC/IO.hs
 @@ -142,7 +142,7 @@ have to work around that in the definition of catch
 below).
  -- @catchException undefined b == _|_ at . See #exceptions_and_strictness#
  -- for details.
  catchException :: Exception e => IO a -> (e -> IO a) -> IO a
 -catchException !io handler = 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
 @@ -194,7 +194,7 @@ catch (IO io) handler = IO $ catch# io handler'
  -- @catchAny 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'
 +catchAny (IO io) handler = IO $ catch# io handler'
      where handler' (SomeException e) = unIO (handler e)

  -- Using catchException here means that if `m` throws an
 diff --git a/libraries/base/GHC/IO/Handle/Internals.hs
 b/libraries/base/GHC/IO/Handle/Internals.hs
 index 48ece1dc5e..3d58f3d3bc 100644
 --- a/libraries/base/GHC/IO/Handle/Internals.hs
 +++ b/libraries/base/GHC/IO/Handle/Internals.hs
 @@ -163,7 +163,8 @@ do_operation :: String -> Handle -> (Handle__ -> IO a)
 -> MVar Handle__ -> IO a
  do_operation fun h act m = do
    h_ <- takeMVar m
    checkHandleInvariants h_
 -  act h_ `catchException` handler h_
 +  let !io = act h_
 +  io `catchException` handler h_
    where
      handler h_ e = do
        putMVar m h_
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14998#comment:12>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler