Improve performance of CallArity
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 21 May 2018 15:24:05 +0000 (11:24 -0400)
committerJoachim Breitner <mail@joachim-breitner.de>
Tue, 22 May 2018 16:50:12 +0000 (12:50 -0400)
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

compiler/simplCore/CallArity.hs
compiler/utils/UnVarGraph.hs
testsuite/tests/perf/compiler/all.T

index 64684f3..ed9fc90 100644 (file)
@@ -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
index a540132..35ae405 100644 (file)
@@ -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)
index 0f912d2..f652415 100644 (file)
@@ -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,