[commit: ghc] master: Improve performance of CallArity (db6085b)

[git at git.haskell.org]

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

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

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

commit db6085b84139f4454cebf34f887cb5560a4fbc7b
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon May 21 11:24:05 2018 -0400

    Improve performance of CallArity
    
    the hot path contained a call to
    
        v `elemUnVarSet` (neighbors g v)
    
    and creating the set of neighbors just to check if `v` is inside
    accounted for half the allocations of the test case of #15164.
    
    By introducing a non-allocating function `hasLoopAt` for this we shave
    off half the allocations. This brings the total cost of Call Arity down
    to 20% of time and 23% of allocations, according to a profiled run. Not
    amazing, but still much better.
    
    Differential Revision: https://phabricator.haskell.org/D4718


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

db6085b84139f4454cebf34f887cb5560a4fbc7b
 compiler/simplCore/CallArity.hs     | 2 +-
 compiler/utils/UnVarGraph.hs        | 8 ++++++++
 testsuite/tests/perf/compiler/all.T | 4 +++-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index 64684f3..ed9fc90 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -735,7 +735,7 @@ domRes (_, ae) = varEnvDom ae
 lookupCallArityRes :: CallArityRes -> Var -> (Arity, Bool)
 lookupCallArityRes (g, ae) v
     = case lookupVarEnv ae v of
-        Just a -> (a, not (v `elemUnVarSet` (neighbors g v)))
+        Just a -> (a, not (g `hasLoopAt` v))
         Nothing -> (0, False)
 
 calledWith :: CallArityRes -> Var -> UnVarSet
diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs
index a540132..35ae405 100644
--- a/compiler/utils/UnVarGraph.hs
+++ b/compiler/utils/UnVarGraph.hs
@@ -24,6 +24,7 @@ module UnVarGraph
     , unionUnVarGraph, unionUnVarGraphs
     , completeGraph, completeBipartiteGraph
     , neighbors
+    , hasLoopAt
     , delNode
     ) where
 
@@ -121,6 +122,13 @@ neighbors (UnVarGraph g) v = unionUnVarSets $ concatMap go $ bagToList g
         go (CBPG s1 s2) = (if v `elemUnVarSet` s1 then [s2] else []) ++
                           (if v `elemUnVarSet` s2 then [s1] else [])
 
+-- hasLoopAt G v <=> v--v ∈ G
+hasLoopAt :: UnVarGraph -> Var -> Bool
+hasLoopAt (UnVarGraph g) v = any go $ bagToList g
+  where go (CG s)       = v `elemUnVarSet` s
+        go (CBPG s1 s2) = v `elemUnVarSet` s1 && v `elemUnVarSet` s2
+
+
 delNode :: UnVarGraph -> Var -> UnVarGraph
 delNode (UnVarGraph g) v = prune $ UnVarGraph $ mapBag go g
   where go (CG s)       = CG (s `delUnVarSet` v)
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 0f912d2..f652415 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1287,7 +1287,9 @@ test ('T9630',
 
 test ('T15164',
       [ compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 3423873408, 10)
+          [(wordsize(64), 1945564312, 10)
+          # initial:      3423873408
+          # 2018-05-22:   1945564312   Fix bottleneck in CallArity
           ])
       ],
       compile,