Fix quadratic behavior of prepareAlts
authorBartosz Nitka <niteria@gmail.com>
Sat, 13 Jan 2018 02:02:22 +0000 (02:02 +0000)
committerBartosz Nitka <niteria@gmail.com>
Mon, 15 Jan 2018 20:35:58 +0000 (20:35 +0000)
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

compiler/coreSyn/CoreUtils.hs

index fbe7ebd..5e32dc6 100644 (file)
@@ -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: