[commit: ghc] master: Model divergence of retry# as ThrowsExn, not Diverges (10a1a47)

[git at git.haskell.org]

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

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

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

commit 10a1a4781c646f81ca9e2ef7a2585df2cbe3a014
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Sep 13 12:22:27 2017 -0400

    Model divergence of retry# as ThrowsExn, not Diverges
    
    The demand signature of the retry# primop previously had a Diverges
    result.  However, this caused the demand analyser to conclude that a
    program of the shape,
    
        catchRetry# (... >> retry#)
    
    would diverge. Of course, this is plainly wrong; catchRetry#'s sole
    reason to exist is to "catch" the "exception" thrown by retry#. While
    catchRetry#'s demand signature correctly had the ExnStr flag set on its
    first argument, indicating that it should catch divergence, the logic
    associated with this flag doesn't apply to Diverges results. This
    resulted in #14171.
    
    The solution here is to treat the divergence of retry# as an exception.
    Namely, give it a result type of ThrowsExn rather than Diverges.
    
    Updates stm submodule for tests.
    
    Test Plan: Validate with T14171
    
    Reviewers: simonpj, austin
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14171, #8091
    
    Differential Revision: https://phabricator.haskell.org/D3919


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

10a1a4781c646f81ca9e2ef7a2585df2cbe3a014
 compiler/basicTypes/Demand.hs   | 1 +
 compiler/prelude/primops.txt.pp | 7 +++++--
 libraries/stm                   | 2 +-
 3 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index dfff0a2..3a83cd9 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -1440,6 +1440,7 @@ postProcessDmdType du@(JD { sd = ss }) (DmdType fv _ res_ty)
 postProcessDmdResult :: Str () -> DmdResult -> DmdResult
 postProcessDmdResult Lazy           _         = topRes
 postProcessDmdResult (Str ExnStr _) ThrowsExn = topRes  -- Key point!
+-- Note that only ThrowsExn results can be caught, not Diverges
 postProcessDmdResult _              res       = res
 
 postProcessDmdEnv :: DmdShell -> DmdEnv -> DmdEnv
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 8e020c4..f2c02ec 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2094,7 +2094,7 @@ primop  AtomicallyOp "atomically#" GenPrimOp
    out_of_line = True
    has_side_effects = True
 
--- NB: retry#'s strictness information specifies it to return bottom.
+-- NB: retry#'s strictness information specifies it to throw an exception
 -- This lets the compiler perform some extra simplifications, since retry#
 -- will technically never return.
 --
@@ -2104,10 +2104,13 @@ primop  AtomicallyOp "atomically#" GenPrimOp
 -- with:
 --   retry# s1
 -- where 'e' would be unreachable anyway.  See Trac #8091.
+--
+-- Note that it *does not* return botRes as the "exception" that is throw may be
+-- "caught" by catchRetry#. This mistake caused #14171.
 primop  RetryOp "retry#" GenPrimOp
    State# RealWorld -> (# State# RealWorld, a #)
    with
-   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botRes }
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] exnRes }
    out_of_line = True
    has_side_effects = True
 
diff --git a/libraries/stm b/libraries/stm
index 9c3c3bb..b6e863e 160000
--- a/libraries/stm
+++ b/libraries/stm
@@ -1 +1 @@
-Subproject commit 9c3c3bb28834d1ba9574be7f887c8914afd4232c
+Subproject commit b6e863e517bdcc3c5de1fbcb776a3fd7e6fe2103