summaryrefslogtreecommitdiff
path: root/compiler/coreSyn
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2018-01-13 02:02:22 +0000
committerBartosz Nitka <niteria@gmail.com>2018-01-15 20:35:58 +0000
commitcf2c029ccdb967441c85ffb66073974fbdb20c20 (patch)
tree482348d44a33f174a8d152bb5830e404e1f9c87f /compiler/coreSyn
parent8de8930520dce26ffa4fa1e67a977213de667e16 (diff)
downloadhaskell-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.hs15
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: