diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2018-05-21 11:24:05 -0400 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2018-05-22 12:50:12 -0400 |
| commit | db6085b84139f4454cebf34f887cb5560a4fbc7b (patch) | |
| tree | de4dc76862957b977da59d83b62c34043224d817 | |
| parent | 97121b62bada0206e1b79137ade04f859a6eee5e (diff) | |
| download | haskell-db6085b84139f4454cebf34f887cb5560a4fbc7b.tar.gz | |
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
| -rw-r--r-- | compiler/simplCore/CallArity.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/UnVarGraph.hs | 8 | ||||
| -rw-r--r-- | 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 64684f3c44..ed9fc9083f 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 a540132bb7..35ae4055ac 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 0f912d2770..f65241585d 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, |