[commit: ghc] wip/T14068: zap RecursiveTailCalled in zapTailCallInfo as well (03ea626)

[git at git.haskell.org]

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

On branch  : wip/T14068
Link       : http://ghc.haskell.org/trac/ghc/changeset/03ea62602e550973301243025f3625681c21b157/ghc

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

commit 03ea62602e550973301243025f3625681c21b157
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Aug 1 18:26:36 2017 -0400

    zap RecursiveTailCalled in zapTailCallInfo as well


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

03ea62602e550973301243025f3625681c21b157
 compiler/basicTypes/BasicTypes.hs | 8 +++++++-
 compiler/basicTypes/IdInfo.hs     | 4 ++--
 compiler/simplCore/OccurAnal.hs   | 3 +--
 3 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 284ddfe..a88ae59 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -72,7 +72,7 @@ module BasicTypes(
         OneBranch, oneBranch, notOneBranch,
         InterestingCxt,
         TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
-        isAlwaysTailCalled,
+        isAlwaysTailCalled, isSometimesTailCalled,
 
         EP(..),
 
@@ -953,6 +953,12 @@ isAlwaysTailCalled occ
                              RecursiveTailCalled {} -> False
                              NoTailCallInfo         -> False
 
+isSometimesTailCalled :: OccInfo -> Bool
+isSometimesTailCalled occ
+  = case tailCallInfo occ of AlwaysTailCalled{}     -> True
+                             RecursiveTailCalled {} -> True
+                             NoTailCallInfo         -> False
+
 instance Outputable TailCallInfo where
   ppr (AlwaysTailCalled ar)    = sep [ text "Tail", int ar ]
   ppr (RecursiveTailCalled ar) = sep [ text "Tail(rec)", int ar ]
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index bd6ec8f..380f2f9 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -548,8 +548,8 @@ zapFragileUnfolding unf
 zapTailCallInfo :: IdInfo -> Maybe IdInfo
 zapTailCallInfo info
   = case occInfo info of
-      occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ)
-          | otherwise              -> Nothing
+      occ | isSometimesTailCalled occ -> Just (info `setOccInfo` safe_occ)
+          | otherwise                 -> Nothing
         where
           safe_occ = occ { occ_tail = NoTailCallInfo }
 
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 4742b41..024782d 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -2660,7 +2660,7 @@ tagRecBinders lvl body_uds triples
 
      -- 4. Tag each binder with its adjusted details
      bndrs'
-        -- 4a. If this is the only one function, not a join-point already
+        -- 4a. If this is the only function, not a join-point already
         --     and the _recursive calls_ are all tail calls, then the simplifier
         --     can loopify it with a local joinrec. Mark it as such.
         | not will_be_joins
@@ -2681,7 +2681,6 @@ tagRecBinders lvl body_uds triples
      -- 5. Drop the binders from the adjusted details and return
      usage'    = adj_uds `delDetailsList` bndrs
    in
-   pprTrace "tagRecBinders" (ppr bndrs <+> ppr (map idOccInfo bndrs') <+> ppr unadj_uds_rhss) $
    (usage', bndrs')
 
 setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr