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 /compiler | |
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
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/simplCore/CallArity.hs | 2 | ||||
-rw-r--r-- | compiler/utils/UnVarGraph.hs | 8 |
2 files changed, 9 insertions, 1 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) |