Commit 28638dfe authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

primops: Mark actions evaluated by `catch*` as lazy

There is something very peculiar about the `catch` family of operations
with respect to strictness analysis: they turn divergence into
non-divergence. For this reason, it isn't safe to mark them as strict in
the expression whose exceptions they are catching. The reason is this:

Consider,

    let r = \st -> raiseIO# blah st
    in catch (\st -> ...(r st)..) handler st

If we give the first argument of catch a strict signature, we'll get a
demand 'C(S)' for 'r'; that is, 'r' is definitely called with one
argument, which indeed it is. The trouble comes when we feed 'C(S)' into
'r's RHS as the demand of the body as this will lead us to conclude that
the whole 'let' will diverge; clearly this isn't right.

This is essentially the problem in #10712, which arose when
7c0fff41 marked the `catch*` primops as
being strict in the thing to be evaluated. Here I've partially reverted
this commit, again marking the first argument of these primops as lazy.

Fixes #10712.

Test Plan: Validate checking `exceptionsrun001`

Reviewers: simonpj, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1616

GHC Trac Issues: #10712, #11222
parent a701694b
...@@ -1946,17 +1946,27 @@ necessarily the second. Hence strictApply1Dmd and lazyApply1Dmd ...@@ -1946,17 +1946,27 @@ necessarily the second. Hence strictApply1Dmd and lazyApply1Dmd
Howver, consider Howver, consider
catch# (\st -> case x of ...) (..handler..) st catch# (\st -> case x of ...) (..handler..) st
We'll see that the entire thing is strict in 'x', so 'x' may be evaluated We'll see that the entire thing is strict in 'x', so 'x' may be evaluated
before the catch#. So fi evaluting 'x' causes a divide-by-zero exception, before the catch#. So if evaluting 'x' causes a divide-by-zero exception,
it won't be caught. This seems acceptable: it won't be caught. This seems acceptable:
- x might be evaluated somewhere else outside the catch# anyway - x might be evaluated somewhere else outside the catch# anyway
- It's an imprecise eception anyway. Synchronous exceptions (in the - It's an imprecise eception anyway. Synchronous exceptions (in the
IO monad) will never move in this way. IO monad) will never move in this way.
There was originally a comment
"Catch is actually strict in its first argument Unfortunately, there is a tricky wrinkle here, as pointed out in #10712.
but we don't want to tell the strictness Consider,
analyser about that, so that exceptions stay inside it."
but tracing it back through the commit logs did not give any let r = \st -> raiseIO# blah st
rationale. And making catch# lazy has performance costs for everyone. in catch (\st -> ...(r st)..) handler st
If we give the first argument of catch a strict signature, we'll get
a demand 'C(S)' for 'r'; that is, 'r' is definitely called with one
argument, which indeed it is. The trouble comes when we feed 'C(S)'
into 'r's RHS as the demand of the body as this will lead us to conclude that
the whole 'let' will diverge; clearly this isn't right.
There's something very special about catch: it turns divergence into
non-divergence.
-} -}
primop CatchOp "catch#" GenPrimOp primop CatchOp "catch#" GenPrimOp
...@@ -1965,7 +1975,7 @@ primop CatchOp "catch#" GenPrimOp ...@@ -1965,7 +1975,7 @@ primop CatchOp "catch#" GenPrimOp
-> State# RealWorld -> State# RealWorld
-> (# State# RealWorld, a #) -> (# State# RealWorld, a #)
with with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply2Dmd,topDmd] topRes } strictness = { \ _arity -> mkClosedStrictSig [lazyApply1Dmd,lazyApply2Dmd,topDmd] topRes }
-- See Note [Strictness for mask/unmask/catch] -- See Note [Strictness for mask/unmask/catch]
out_of_line = True out_of_line = True
has_side_effects = True has_side_effects = True
...@@ -2069,7 +2079,7 @@ primop CatchRetryOp "catchRetry#" GenPrimOp ...@@ -2069,7 +2079,7 @@ primop CatchRetryOp "catchRetry#" GenPrimOp
-> (State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) )
with with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply1Dmd,topDmd] topRes } strictness = { \ _arity -> mkClosedStrictSig [lazyApply1Dmd,lazyApply1Dmd,topDmd] topRes }
-- See Note [Strictness for mask/unmask/catch] -- See Note [Strictness for mask/unmask/catch]
out_of_line = True out_of_line = True
has_side_effects = True has_side_effects = True
...@@ -2079,7 +2089,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp ...@@ -2079,7 +2089,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp
-> (b -> State# RealWorld -> (# State# RealWorld, a #) ) -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) )
with with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,lazyApply2Dmd,topDmd] topRes } strictness = { \ _arity -> mkClosedStrictSig [lazyApply1Dmd,lazyApply2Dmd,topDmd] topRes }
-- See Note [Strictness for mask/unmask/catch] -- See Note [Strictness for mask/unmask/catch]
out_of_line = True out_of_line = True
has_side_effects = True has_side_effects = True
......
...@@ -53,12 +53,13 @@ test('lazy-bs-alloc', ...@@ -53,12 +53,13 @@ test('lazy-bs-alloc',
[stats_num_field('peak_megabytes_allocated', (2, 1)), [stats_num_field('peak_megabytes_allocated', (2, 1)),
# expected value: 2 (amd64/Linux) # expected value: 2 (amd64/Linux)
stats_num_field('bytes allocated', stats_num_field('bytes allocated',
[(wordsize(64), 431500, 3), [(wordsize(64), 444720, 3),
# 489776 (amd64/Linux) # 489776 (amd64/Linux)
# 2013-02-07: 429744 (amd64/Linux) # 2013-02-07: 429744 (amd64/Linux)
# 2013-12-12: 425400 (amd64/Linux) # 2013-12-12: 425400 (amd64/Linux)
# 2015-04-04: Widen 1->3% (amd64/Windows was failing) # 2015-04-04: Widen 1->3% (amd64/Windows was failing)
# 2015-08-15: 431500 (Windows not good enough. avg of Windows&Linux) # 2015-08-15: 431500 (Windows not good enough. avg of Windows&Linux)
# 2015-12-15: 444720 (amd64/Linux, D1616)
(wordsize(32), 411500, 2)]), (wordsize(32), 411500, 2)]),
# 2013-02-10: 421296 (x86/Windows) # 2013-02-10: 421296 (x86/Windows)
# 2013-02-10: 414180 (x86/OSX) # 2013-02-10: 414180 (x86/OSX)
......
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