[commit: ghc] wip/T14068: Loopification: Preserver Invariant 4, polymorphism rule (34a0e05)

[git at git.haskell.org]

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

On branch  : wip/T14068
Link       : http://ghc.haskell.org/trac/ghc/changeset/34a0e054c60a442bb8b520450f1792a138145af6/ghc

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

commit 34a0e054c60a442bb8b520450f1792a138145af6
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Aug 1 12:23:38 2017 -0400

    Loopification: Preserver Invariant 4, polymorphism rule


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

34a0e054c60a442bb8b520450f1792a138145af6
 compiler/simplCore/OccurAnal.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index a16b761..4742b41 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -2667,6 +2667,8 @@ tagRecBinders lvl body_uds triples
         , [bndr] <- bndrs
         , let occ_rhs = lookupDetails unadj_uds_rhss bndr
         , AlwaysTailCalled arity <- tailCallInfo occ_rhs
+         --  Could do better, see note [Excess polymorphism and join points]
+        , isValidJoinPointType arity (idType bndr)
         = let occ   = lookupDetails adj_uds bndr
               occ'  = markRecursiveTailCalled arity occ
               bndr' = setIdOccInfo bndr occ'