Commit 5205b85a authored by Sebastian Graf's avatar Sebastian Graf

DmdAnal: Recognise precise exceptions from case alternatives (#18086)

Consider

```hs
m :: IO ()
m = do
  putStrLn "foo"
  error "bar"
```

`m` (from #18086) always throws a (precise or imprecise) exception or
diverges. Yet demand analysis infers `<L,A>` as demand signature instead
of `<L,A>x` for it.

That's because the demand analyser sees `putStrLn` occuring in a case
scrutinee and decides that it has to `deferAfterPreciseException`,
because `putStrLn` throws a precise exception on some control flow
paths. This will mask the `botDiv` `Divergence`of the single case alt
containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself,
the final `Divergence` is `topDiv`.

This is easily fixed: `deferAfterPreciseException` works by `lub`ing
with the demand type of a virtual case branch denoting the precise
exceptional control flow. We used `nopDmdType` before, but we can be
more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`.

Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv`
instead of `topDiv`, which combines with the result from the scrutinee
to `exnDiv`, and all is well.

Fixes #18086.
parent 566cc73f
......@@ -1055,11 +1055,19 @@ Is this strict in 'y'? Often not! If @foo x s@ might throw a precise exception
(ultimately via raiseIO#), then we must not force 'y', which may fail to
terminate or throw an imprecise exception, until we have performed @foo x s@.
So we have to 'Demand.deferAfterPreciseException' (which just 'lub's with
'nopDmdType' to model the exceptional control flow) when @foo x s@
may throw a precise exception. Motivated by T13380{d,e,f}.
So we have to 'deferAfterPreciseException' (which 'lub's with 'exnDmdType' to
model the exceptional control flow) when @foo x s@ may throw a precise
exception. Motivated by T13380{d,e,f}.
See Note [Which scrutinees may throw precise exceptions] in DmdAnal.
We have to be careful not to discard dead-end Divergence from case
alternatives, though (#18086):
m = putStrLn "foo" >> error "bar"
'm' should still have 'exnDiv', which is why it is not sufficient to lub with
'nopDmdType' (which has 'topDiv') in 'deferAfterPreciseException'.
Historical Note: This used to be called the "IO hack". But that term is rather
a bad fit because
1. It's easily confused with the "State hack", which also affects IO.
......@@ -1261,6 +1269,11 @@ isTopDmdType :: DmdType -> Bool
isTopDmdType (DmdType env args div)
= div == topDiv && null args && isEmptyVarEnv env
-- | The demand type of an unspecified expression that is guaranteed to
-- throw a (precise or imprecise) exception or diverge.
exnDmdType :: DmdType
exnDmdType = DmdType emptyDmdEnv [] exnDiv
dmdTypeDepth :: DmdType -> Arity
dmdTypeDepth (DmdType _ ds _) = length ds
......@@ -1303,13 +1316,17 @@ splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
splitDmdTy ty@(DmdType _ [] res_ty) = (defaultArgDmd res_ty, ty)
-- | When e is evaluated after executing an IO action that may throw a precise
-- exception, and d is e's demand, then what of this demand should we consider?
-- * We have to kill all strictness demands (i.e. lub with a lazy demand)
-- * We can keep usage information (i.e. lub with an absent demand)
-- * We have to kill definite divergence
-- exception, we act as if there is an additional control flow path that is
-- taken if e throws a precise exception. The demand type of this control flow
-- path
-- * is lazy and absent ('topDmd') in all free variables and arguments
-- * has 'exnDiv' 'Divergence' result
-- So we can simply take a variant of 'nopDmdType', 'exnDmdType'.
-- Why not 'nopDmdType'? Because then the result of 'e' can never be 'exnDiv'!
-- That means failure to drop dead-ends, see #18086.
-- See Note [Precise exceptions and strictness analysis]
deferAfterPreciseException :: DmdType -> DmdType
deferAfterPreciseException d = lubDmdType d nopDmdType
deferAfterPreciseException = lubDmdType exnDmdType
strictenDmd :: Demand -> CleanDemand
strictenDmd (JD { sd = s, ud = u})
......
{-# OPTIONS_GHC -O2 -fforce-recomp #-}
module T18086 where
-- Should have strictness signature <L,U>x, emphasis on the exceptional
-- divergence result.
m :: IO ()
m = do
putStrLn "foo"
error "bar"
==================== Strictness signatures ====================
T18086.$trModule:
T18086.m: <L,U>x
==================== Cpr signatures ====================
T18086.$trModule:
T18086.m: b
==================== Strictness signatures ====================
T18086.$trModule:
T18086.m: <L,U>x
......@@ -22,3 +22,4 @@ test('T5075', normal, compile, [''])
test('T17932', normal, compile, [''])
test('T13380c', expect_broken('!3014'), compile, [''])
test('T13380f', normal, compile, [''])
test('T18086', normal, compile, [''])
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