diff options
| author | Peter Wortmann <Peter.Wortmann@googlemail.com> | 2017-02-04 15:14:31 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-04 16:16:50 -0500 |
| commit | 29122312cc7b8f9890eb53f92d76ecdd8ded24ee (patch) | |
| tree | 241b7a2dfb8e65e4c1ce7c07a377d2208e38f44a | |
| parent | 157a46fb17a28e0923a3498ce8609f24ed554a1a (diff) | |
| download | haskell-29122312cc7b8f9890eb53f92d76ecdd8ded24ee.tar.gz | |
Improve wrapTicks performance with lots of redundant source notes
The old version had O(n^3) performance for n non-overlapping source
notes and let floats each, which is exactly what happens with -g if we
compile a list literal of length n.
The idea here is simply to establish early which source notes will
actually survive (e.g. use a left fold). The new code should be O(n) for
list literals.
Reviewers: austin, dfeuer, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3037
GHC Trac Issues: #11095
| -rw-r--r-- | compiler/coreSyn/CorePrep.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 74de5af82d..ab64449386 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1565,11 +1565,20 @@ newVar ty -- | Like wrapFloats, but only wraps tick floats wrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr) -wrapTicks (Floats flag floats0) expr = (Floats flag floats1, expr') - where (floats1, expr') = foldrOL go (nilOL, expr) floats0 - go (FloatTick t) (fs, e) = ASSERT(tickishPlace t == PlaceNonLam) - (mapOL (wrap t) fs, mkTick t e) - go other (fs, e) = (other `consOL` fs, e) +wrapTicks (Floats flag floats0) expr = + (Floats flag (toOL $ reverse floats1), foldr mkTick expr (reverse ticks1)) + where (floats1, ticks1) = foldlOL go ([], []) $ floats0 + -- Deeply nested constructors will produce long lists of + -- redundant source note floats here. We need to eliminate + -- those early, as relying on mkTick to spot it after the fact + -- can yield O(n^3) complexity [#11095] + go (floats, ticks) (FloatTick t) + = ASSERT(tickishPlace t == PlaceNonLam) + (floats, if any (flip tickishContains t) ticks + then ticks else t:ticks) + go (floats, ticks) f + = (foldr wrap f (reverse ticks):floats, ticks) + wrap t (FloatLet bind) = FloatLet (wrapBind t bind) wrap t (FloatCase b r ok) = FloatCase b (mkTick t r) ok wrap _ other = pprPanic "wrapTicks: unexpected float!" |