summaryrefslogtreecommitdiff
path: root/compiler/simplCore/OccurAnal.hs
diff options
context:
space:
mode:
authorLuke Maurer <maurerl@cs.uoregon.edu>2017-02-05 20:32:20 -0500
committerBen Gamari <ben@smart-cactus.org>2017-02-05 20:32:30 -0500
commit795bc49ceb12cecf46e0c53a570809c3df85ab9a (patch)
tree15e559ced118dab283eec7e1f558fc064ed4a4b7 /compiler/simplCore/OccurAnal.hs
parent563148cdf6e6560ccf842aa4e2bd6262ea463d66 (diff)
downloadhaskell-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.hs10
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]
~~~~~~~~~~~~~~~~~~~~~~~~