From 10a1a4781c646f81ca9e2ef7a2585df2cbe3a014 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 13 Sep 2017 12:22:27 -0400 Subject: 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 --- compiler/basicTypes/Demand.hs | 1 + compiler/prelude/primops.txt.pp | 7 +++++-- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'compiler') diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index dfff0a2c92..3a83cd9fd5 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 8e020c44d1..f2c02ec2f1 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 -- cgit v1.2.1