[commit: ghc] master: Fix quadratic behavior of prepareAlts (cf2c029)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cf2c029ccdb967441c85ffb66073974fbdb20c20/ghc

>---------------------------------------------------------------

commit cf2c029ccdb967441c85ffb66073974fbdb20c20
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Sat Jan 13 02:02:22 2018 +0000

    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


>---------------------------------------------------------------

cf2c029ccdb967441c85ffb66073974fbdb20c20
 compiler/coreSyn/CoreUtils.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index fbe7ebd..5e32dc6 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: