diff options
| -rw-r--r-- | compiler/GHC/Core/Op/Simplify/Utils.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Types/Demand.hs | 48 | ||||
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 21 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_run/T17676.hs | 18 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_run/all.T | 3 |
5 files changed, 77 insertions, 22 deletions
diff --git a/compiler/GHC/Core/Op/Simplify/Utils.hs b/compiler/GHC/Core/Op/Simplify/Utils.hs index 1b8c21f81b..17f2a73416 100644 --- a/compiler/GHC/Core/Op/Simplify/Utils.hs +++ b/compiler/GHC/Core/Op/Simplify/Utils.hs @@ -56,12 +56,13 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Var import GHC.Types.Demand +import GHC.Types.Var.Set +import GHC.Types.Basic +import PrimOp import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) -import GHC.Types.Var.Set -import GHC.Types.Basic import Util import OrdList ( isNilOL ) import MonadUtils @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs index f9ca821872..fe82d473b2 100644 --- a/compiler/GHC/Types/Demand.hs +++ b/compiler/GHC/Types/Demand.hs @@ -931,6 +931,54 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise vs imprecise exceptions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of nontermination, such as genuine +divergence or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See also the wiki page on precise exceptions: +https://gitlab.haskell.org/ghc/ghc/wikis/exceptions/precise-exceptions +Section 5 of "Tackling the awkward squad" talks about semantic concerns. +Imprecise exceptions are actually more interesting than precise ones (which are +fairly standard) from the perspective of semantics. See the paper "A Semantics +for Imprecise Exceptions" for more details. + +Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# raises a *precise* exception, in contrast to raise# which +raise an *imprecise* exception. See Note [Precise vs imprecise exceptions] +in XXXX. + +Unlike raise# (which returns botDiv), we want raiseIO# to return topDiv. +Here's why. Consider this example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, (f 42 (error "boom")) +turns from throwing the precise Exc to throwing the imprecise user error +"boom". So, the defaultDmd of raiseIO# should be lazy (topDmd), which can be +achieved by giving it divergence topDiv. + +But if it returns topDiv, the simplifier will fail to discard raiseIO#'s +continuation in + case raiseIO# x s of { (# s', r #) -> <BIG> } +which we'd like to optimise to + raiseIO# x s +Temporary hack solution: special treatment for raiseIO# in +Simplifier.Utils.mkArgInfo. For the non-hack solution, see +https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#replacing-hacks-by-principled-program-analyses +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index e5ad02d01b..a29fbf48d7 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True diff --git a/testsuite/tests/stranal/should_run/T17676.hs b/testsuite/tests/stranal/should_run/T17676.hs new file mode 100644 index 0000000000..d0fa4cf661 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T17676.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 278b91b292..d822e482dd 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) test('T14171', [expect_broken(14171), exit_code(1)], compile_and_run, ['']) test('T14290', normal, compile_and_run, ['']) test('T14285', normal, multimod_compile_and_run, ['T14285', '']) +test('T17676', normal, compile_and_run, ['']) |