diff options
author | Bartosz Nitka <niteria@gmail.com> | 2018-01-13 02:02:22 +0000 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2018-01-15 20:35:58 +0000 |
commit | cf2c029ccdb967441c85ffb66073974fbdb20c20 (patch) | |
tree | 482348d44a33f174a8d152bb5830e404e1f9c87f /compiler/coreSyn | |
parent | 8de8930520dce26ffa4fa1e67a977213de667e16 (diff) | |
download | haskell-cf2c029ccdb967441c85ffb66073974fbdb20c20.tar.gz |
Fix quadratic behavior of prepareAlts
Summary:
This code is quadratic and a simple test case I used
managed to tickle it.
The example (same one as #14667) looks like this:
```
module A10000 where
data A = A
| A00001
| A00002
...
| A10000
f :: A -> Int
f A00001 = 19900001
f A00002 = 19900002
...
f A10000 = 19910000
```
Applied on top of a fix for #14667, it gives a 30% compile time
improvement.
Test Plan: ./validate
Reviewers: simonpj, bgamari
Subscribers: rwbarton, thomie, simonmar, carter
Differential Revision: https://phabricator.haskell.org/D4307
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index fbe7ebd9a6..5e32dc6093 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -94,6 +94,8 @@ import Data.Function ( on ) import Data.List import Data.Ord ( comparing ) import OrdList +import qualified Data.Set as Set +import UniqSet {- ************************************************************************ @@ -629,13 +631,15 @@ filterAlts _tycon inst_tys imposs_cons alts trimmed_alts = filterOut (impossible_alt inst_tys) alts_wo_default - imposs_deflt_cons = nub (imposs_cons ++ alt_cons) + imposs_cons_set = Set.fromList imposs_cons + imposs_deflt_cons = + imposs_cons ++ filterOut (`Set.member` imposs_cons_set) alt_cons -- "imposs_deflt_cons" are handled -- EITHER by the context, -- OR by a non-DEFAULT branch in this case expression. impossible_alt :: [Type] -> (AltCon, a, b) -> Bool - impossible_alt _ (con, _, _) | con `elem` imposs_cons = True + impossible_alt _ (con, _, _) | con `Set.member` imposs_cons_set = True impossible_alt inst_tys (DataAlt con, _, _) = dataConCannotMatch inst_tys con impossible_alt _ _ = False @@ -652,8 +656,11 @@ refineDefaultAlt us tycon tys imposs_deflt_cons all_alts -- case x of { DEFAULT -> e } -- and we don't want to fill in a default for them! , Just all_cons <- tyConDataCons_maybe tycon - , let imposs_data_cons = [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type - impossible con = con `elem` imposs_data_cons || dataConCannotMatch tys con + , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] + -- We now know it's a data type, so we can use + -- UniqSet rather than Set (more efficient) + impossible con = con `elementOfUniqSet` imposs_data_cons + || dataConCannotMatch tys con = case filterOut impossible all_cons of -- Eliminate the default alternative -- altogether if it can't match: |