diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-01-04 12:32:13 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-01-04 16:15:18 +0000 |
| commit | 954cbc7c106a20639960f55ebb85c5c972652d41 (patch) | |
| tree | f7911596036333cbe9d091aa8728695a058b03f8 /compiler/typecheck/TcEvidence.hs | |
| parent | 6c34824434a67baa34e4ee2ddb753708eb61c5bc (diff) | |
| download | haskell-954cbc7c106a20639960f55ebb85c5c972652d41.tar.gz | |
Drop dead Given bindings in setImplicationStatus
Trac #13032 pointed out that we sometimes generate unused
bindings for Givens, and (worse still) we can't always discard
them later (we don't drop a case binding unless we can prove
that the scrutinee is non-bottom.
It looks as if this may be a major reason for the performace
problems in #14338 (see comment:29).
This patch fixes the problem at source, by pruning away all the
dead Givens. See Note [Delete dead Given evidence bindings]
Remarkably, compiler allocation falls by 23% in
perf/compiler/T12227!
I have not confirmed whether this change actualy helps with
Diffstat (limited to 'compiler/typecheck/TcEvidence.hs')
| -rw-r--r-- | compiler/typecheck/TcEvidence.hs | 7 |
1 files changed, 6 insertions, 1 deletions
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 0287818b44..249362dde5 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -13,7 +13,8 @@ module TcEvidence ( -- Evidence bindings TcEvBinds(..), EvBindsVar(..), EvBindMap(..), emptyEvBindMap, extendEvBinds, - lookupEvBind, evBindMapBinds, foldEvBindMap, isEmptyEvBindMap, + lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap, + isEmptyEvBindMap, EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind, sccEvBinds, evBindVar, EvTerm(..), mkEvCast, evVarsOfTerm, mkEvScSelectors, @@ -442,6 +443,10 @@ evBindMapBinds = foldEvBindMap consBag emptyBag foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs) +filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap +filterEvBindMap k (EvBindMap { ev_bind_varenv = env }) + = EvBindMap { ev_bind_varenv = filterDVarEnv k env } + instance Outputable EvBindMap where ppr (EvBindMap m) = ppr m |