Fixes for OccurAnal bugs (#13221)
authorLuke Maurer <maurerl@cs.uoregon.edu>
Mon, 6 Feb 2017 01:32:20 +0000 (20:32 -0500)
committerBen Gamari <ben@smart-cactus.org>
Mon, 6 Feb 2017 01:32:30 +0000 (20:32 -0500)
- 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

compiler/simplCore/OccurAnal.hs

index b02ddc9..80eca71 100644 (file)
@@ -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]
 ~~~~~~~~~~~~~~~~~~~~~~~~