Commit b4efac59 authored by Joachim Breitner's avatar Joachim Breitner

Trim Call Arity

to not accidentially invalidate a strictness signature with a Diverges
result info. This seems to fix #10176.

Differential Revision: https://phabricator.haskell.org/D747
parent 5119e097
......@@ -18,6 +18,7 @@ import CoreArity ( typeArity )
import CoreUtils ( exprIsHNF )
--import Outputable
import UnVarGraph
import Demand
import Control.Arrow ( first, second )
......@@ -360,6 +361,28 @@ to them. The plan is as follows: Treat the top-level binds as nested lets around
a body representing “all external calls”, which returns a pessimistic
CallArityRes (the co-call graph is the complete graph, all arityies 0).
Note [Trimming arity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In the Call Arity papers, we are working on an untyped lambda calculus with no
other id annotations, where eta-expansion is always possible. But this is not
the case for Core!
1. We need to ensure the invariant
callArity e <= typeArity (exprType e)
for the same reasons that exprArity needs this invariant (see Note
[exprArity invariant] in CoreArity).
If we are not doing that, a too-high arity annotation will be stored with
the id, confusing the simplifier later on.
2. Eta-expanding a right hand side might invalidate existing annotations. In
particular, if an id has a strictness annotation of <...><...>b, then
passing one argument to it will definitely bottom out, so the simplifier
will throw away additional parameters. This conflicts with Call Arity! So
we ensure that we never eta-expand such a value beyond the number of
arguments mentioned in the strictness signature.
See #10176 for a real-world-example.
-}
-- Main entry point
......@@ -506,15 +529,19 @@ callArityBind ae_body int (NonRec v rhs)
safe_arity | called_once = arity
| is_thunk = 0 -- A thunk! Do not eta-expand
| otherwise = arity
(ae_rhs, rhs') = callArityAnal safe_arity int rhs
-- See Note [Trimming arity]
trimmed_arity = trimArity v safe_arity
(ae_rhs, rhs') = callArityAnal trimmed_arity int rhs
ae_rhs'| called_once = ae_rhs
| safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
| otherwise = calledMultipleTimes ae_rhs
final_ae = callArityNonRecEnv v ae_rhs' ae_body
v' = v `setIdCallArity` safe_arity
v' = v `setIdCallArity` trimmed_arity
-- Recursive let. See Note [Recursion and fixpointing]
......@@ -558,19 +585,33 @@ callArityBind ae_body int b@(Rec binds)
safe_arity | is_thunk = 0 -- See Note [Thunks in recursive groups]
| otherwise = new_arity
(ae_rhs, rhs') = callArityAnal safe_arity int_body rhs
-- See Note [Trimming arity]
trimmed_arity = trimArity i safe_arity
(ae_rhs, rhs') = callArityAnal trimmed_arity int_body rhs
ae_rhs' | called_once = ae_rhs
| safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
| otherwise = calledMultipleTimes ae_rhs
in (True, (i `setIdCallArity` safe_arity, Just (called_once, new_arity, ae_rhs'), rhs'))
in (True, (i `setIdCallArity` trimmed_arity, Just (called_once, new_arity, ae_rhs'), rhs'))
where
(new_arity, called_once) = lookupCallArityRes ae i
(changes, ann_binds') = unzip $ map rerun ann_binds
any_change = or changes
-- See Note [Trimming arity]
trimArity :: Id -> Arity -> Arity
trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig]
where
max_arity_by_type = length (typeArity (idType v))
max_arity_by_strsig
| isBotRes result_info = length demands
| otherwise = a
(demands, result_info) = splitStrictSig (idStrictness v)
-- Combining the results from body and rhs, non-recursive case
-- See Note [Analysis II: The Co-Called analysis]
callArityNonRecEnv :: Var -> CallArityRes -> CallArityRes -> CallArityRes
......
......@@ -211,4 +211,4 @@ test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniq
test('T9583', only_ways(['optasm']), compile, [''])
test('T9565', only_ways(['optasm']), compile, [''])
test('T5821', only_ways(['optasm']), compile, [''])
test('T10176', [only_ways(['optasm']), expect_broken(10176)], compile, [''])
test('T10176', only_ways(['optasm']), 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