#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 == _|_@. 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 == _|_@. 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