[commit: ghc] master: dmdAnal: Ensure that ExnStr flag isn't dropped inappropriately (c940e3b)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c940e3b92f4527ca59fcae93f36c869de3e7ccb9/ghc

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

commit c940e3b92f4527ca59fcae93f36c869de3e7ccb9
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Jul 19 15:07:52 2017 -0400

    dmdAnal: Ensure that ExnStr flag isn't dropped inappropriately
    
    This fixes #13977 and consequently #13615. Here an optimization in the
    demand analyser was too liberal, causing us to drop the ExnStr flag and
    consequently resulting in incorrect demand signatures. This manifested
    as a segmentation fault in #13615 as we incorrectly concluded that an
    application of catchRetry# would bottom.
    
    Specifically, we had
    
        orElse' :: STM a -> STM a -> STM a
        orElse' x = catchRetry# x y
          where y = {- some action -}
    
    Where the catchRetry# primop places a demand of <xC(S),1*C1(U)> on its
    first argument. However, due to #13977 the demand analyser would assign
    a demand of <C(S),1*C1(U)> on the first argument of orElse'. Note the
    missing `x`.
    
        case orElse' bottomingAction anotherAction of { x -> Just x }
    
    being transformed to,
    
        case orElse' bottomingAction anotherAction of {}
    
    by the simplifier. This would naturally blow up when orElse' returned at
    runtime, causing the segmentation fault described in #13615.
    
    Test Plan: Validate, perhaps add a testcase
    
    Reviewers: austin, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #13977, #13615
    
    Differential Revision: https://phabricator.haskell.org/D3756


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

c940e3b92f4527ca59fcae93f36c869de3e7ccb9
 compiler/basicTypes/Demand.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index b6296f4..0262edc 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -1442,8 +1442,11 @@ postProcessDmdResult _              res       = res
 postProcessDmdEnv :: DmdShell -> DmdEnv -> DmdEnv
 postProcessDmdEnv ds@(JD { sd = ss, ud = us }) env
   | Abs <- us       = emptyDmdEnv
-  | Str _ _   <- ss
-  , Use One _ <- us = env  -- Shell is a no-op
+    -- In this case (postProcessDmd ds) == id; avoid a redundant rebuild
+    -- of the environment. Be careful, bad things will happen if this doesn't
+    -- match postProcessDmd (see #13977).
+  | Str VanStr _ <- ss
+  , Use One _ <- us = env
   | otherwise       = mapVarEnv (postProcessDmd ds) env
   -- For the Absent case just discard all usage information
   -- We only processed the thing at all to analyse the body