diff options
author | Luke Maurer <maurerl@cs.uoregon.edu> | 2017-02-05 20:32:20 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-05 20:32:30 -0500 |
commit | 795bc49ceb12cecf46e0c53a570809c3df85ab9a (patch) | |
tree | 15e559ced118dab283eec7e1f558fc064ed4a4b7 /compiler/simplCore/OccurAnal.hs | |
parent | 563148cdf6e6560ccf842aa4e2bd6262ea463d66 (diff) | |
download | haskell-795bc49ceb12cecf46e0c53a570809c3df85ab9a.tar.gz |
Fixes for OccurAnal bugs (#13221)
- OccurAnal: When checking tail calls, count rule's LHS args, not bndrs
Pretty obvious error in retrospect:
```
let $sj = \y ys -> ...
{-# RULES "SC:j" forall y ys. j (y:ys) = $sj y ys #-}
j = \xs -> ...
in ...
```
A jump on the RHS of a rule for a join point is only okay if the rule's
LHS is
saturated - in this case, since the LHS is j (y:ys) and j takes one
argument,
both j and $sj can become join points. See Note [Rules and join points]
in
OccurAnal. By mistake, OccAnal was counting the rule's binders (y and
ys) rather
than the args in its LHS, so $sj wasn't being made a join point.
- Don't zap tail calls in unfoldings
This was causing T7796 to squeal about join points not being
rediscovered.
Reviewers: bgamari, austin
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3080
Diffstat (limited to 'compiler/simplCore/OccurAnal.hs')
-rw-r--r-- | compiler/simplCore/OccurAnal.hs | 10 |
1 files changed, 5 insertions, 5 deletions
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index b02ddc9540..80eca71563 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -1574,7 +1574,7 @@ occAnalUnfolding env rec_flag id | not (isStableSource src) -> Nothing | otherwise - -> Just $ zapDetails usage + -> Just $ markAllMany usage where (bndrs, body) = collectBinders rhs (usage, _, _) = occAnalRhs env rec_flag id bndrs body @@ -1608,15 +1608,15 @@ occAnalRules env mb_expected_join_arity rec_flag id (rhs_uds, _, _) = occAnalRhs env rec_flag id rhs_bndrs rhs_body -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - final_rhs_uds = adjust_tail_info bndrs $ markAllMany $ + final_rhs_uds = adjust_tail_info args $ markAllMany $ (rhs_uds `delDetailsList` bndrs) occ_anal_rule _ = (emptyDetails, emptyDetails) - adjust_tail_info bndrs uds -- see Note [Rules and join points] + adjust_tail_info args uds -- see Note [Rules and join points] = case mb_expected_join_arity of - Just ar | bndrs `lengthIs` ar -> uds - _ -> markAllNonTailCalled uds + Just ar | args `lengthIs` ar -> uds + _ -> markAllNonTailCalled uds {- Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ |