[commit: ghc] master: Fixes for OccurAnal bugs (#13221) (795bc49)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/795bc49ceb12cecf46e0c53a570809c3df85ab9a/ghc

>---------------------------------------------------------------

commit 795bc49ceb12cecf46e0c53a570809c3df85ab9a
Author: Luke Maurer <maurerl at cs.uoregon.edu>
Date:   Sun Feb 5 20:32:20 2017 -0500

    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


>---------------------------------------------------------------

795bc49ceb12cecf46e0c53a570809c3df85ab9a
 compiler/simplCore/OccurAnal.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index b02ddc9..80eca71 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]
 ~~~~~~~~~~~~~~~~~~~~~~~~