[commit: ghc] ghc-7.10: Call Arity: Trade precision for performance in large mutually recursive groups (97bd6d6)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/97bd6d6b70273e221b6d03aa865a5ed84953aca7/ghc

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

commit 97bd6d6b70273e221b6d03aa865a5ed84953aca7
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Apr 15 16:25:13 2015 +0200

    Call Arity: Trade precision for performance in large mutually recursive groups
    
    Sometimes (especial with derived Data instances, it seems), one can have
    very large mutually recursive bindings. Calculating the Call Arity
    analysis result with full precision is an expensive operation in these
    case. So above a certain threshold (25, for no good reason besides
    intuition), skip this calculation and assume the recursion is not
    linear, which is a conservative result.
    
    With this, the Call Arity analysis accounts for 3.7% of the compile time
    of haskell-src-exts. Fixes #10293
    
    Differential Revision: https://phabricator.haskell.org/D843
    
    (cherry picked from commit 9654a7cf8580bc3a027bf8b39c06d916050c446d)


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

97bd6d6b70273e221b6d03aa865a5ed84953aca7
 compiler/simplCore/CallArity.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index 3007d70..c606ece 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -632,6 +632,9 @@ callArityRecEnv any_boring ae_rhss ae_body
     cross_calls
         -- See Note [Taking boring variables into account]
         | any_boring          = completeGraph (domRes ae_combined)
+        -- Also, calculating cross_calls is expensive. Simply be conservative
+        -- if the mutually recursive group becomes too large.
+        | length ae_rhss > 25 = completeGraph (domRes ae_combined)
         | otherwise           = unionUnVarGraphs $ map cross_call ae_rhss
     cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
       where