Care with impossible-cons in combineIdenticalAlts

This was a nasty, long-standing bug exposed in Trac #10538.
Symptoms were that we had an empty case
   case (x :: Either a) of {}
Core Lint correctly picked this bogus code up.

Here is what happened

* In SimplUtils.prepareAlts, we call
        filterAlts
  then
        combineIdenticalAlts

* We had    case x of { Left _ -> e1; Right _ -> e1 }

* filterAlts did nothing, but correctly retuned imposs_deflt_cons
  saying that 'x' cannot be {Left, Right} in the DEFAULT branch,
  if any (there isn't one.)

* combineIdentialAlts correctly combines the identical alts, to give
     case x of { DEFAULT -> e1 }

* BUT combineIdenticalAlts did no adjust imposs_deft_cons

* Result: when compiling e1 we did so in the belief that 'x'
  could not be {Left,Right}.  Disaster.

Easily fixed.

(It is hard to trigger; I can't construct a simple test case.)

diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 10b2acd..dbb501e 100644 (file)
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -62,6 +62,7 @@ import MonadUtils
 import Outputable
 import FastString
 import Pair
+import ListSetOps       ( minusList )
 
 import Control.Monad    ( when )
 import Data.List        ( partition )
@@ -1672,23 +1673,23 @@ prepareAlts scrut case_bndr' alts
            --   OutId, it has maximum information; this is important.
            --   Test simpl013 is an example
   = do { us <- getUniquesM
-       ; let (imposs_deflt_cons, refined_deflt, alts')
+       ; let (imposs_deflt_cons', refined_deflt, alts')
                 = filterAlts us (varType case_bndr') imposs_cons alts
-       ; when refined_deflt $ tick (FillInCaseDefault case_bndr')
-
-       ; alts'' <- combineIdenticalAlts case_bndr' alts'
-       ; return (imposs_deflt_cons, alts'') }
+             (combining_done, imposs_deflt_cons'', alts'')
+                = combineIdenticalAlts imposs_deflt_cons' alts'
+       ; when refined_deflt  $ tick (FillInCaseDefault case_bndr')
+       ; when combining_done $ tick (AltMerge case_bndr')
+       ; return (imposs_deflt_cons'', alts'') }
   where
     imposs_cons = case scrut of
                     Var v -> otherCons (idUnfolding v)
                     _     -> []
 
-{-
-Note [Combine identical alternatives]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- If several alternatives are identical, merge them into
- a single DEFAULT alternative.  I've occasionally seen this
- making a big difference:
+{- Note [Combine identical alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If several alternatives are identical, merge them into a single
+DEFAULT alternative.  I've occasionally seen this making a big
+difference:
 
      case e of               =====>     case e of
        C _ -> f x                         D v -> ....v....
@@ -1726,23 +1727,49 @@ NB: it's important that all this is done in [InAlt], *before* we work
 on the alternatives themselves, because Simpify.simplAlt may zap the
 occurrence info on the binders in the alternatives, which in turn
 defeats combineIdenticalAlts (see Trac #7360).
+
+Note [Care with impossible-constructors when combining alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have (Trac #10538)
+   data T = A | B | C
+
+   ... case x::T of
+         DEFAULT -> e1
+         A -> e2
+         B -> e1
+
+When calling combineIdentialAlts, we'll have computed that the "impossible
+constructors" for the DEFAULT alt is {A,B}, since if x is A or B we'll
+take the other alternatives.  But suppose we combine B into the DEFAULT,
+to get
+   ... case x::T of
+         DEFAULT -> e1
+         A -> e2
+Then we must be careful to trim the impossible constructors to just {A},
+else we risk compiling 'e1' wrong!
 -}
 
-combineIdenticalAlts :: OutId -> [InAlt] -> SimplM [InAlt]
+
+combineIdenticalAlts :: [AltCon] -> [InAlt] -> (Bool, [AltCon], [InAlt])
 -- See Note [Combine identical alternatives]
-combineIdenticalAlts case_bndr ((_con1,bndrs1,rhs1) : con_alts)
+-- See Note [Care with impossible-constructors when combining alternatives]
+-- True <=> we did some combining, result is a single DEFAULT alternative
+combineIdenticalAlts imposs_cons ((_con1,bndrs1,rhs1) : con_alts)
   | all isDeadBinder bndrs1    -- Remember the default
   , not (null eliminated_alts) -- alternative comes first
-  = do  { tick (AltMerge case_bndr)
-        ; return ((DEFAULT, [], mkTicks (concat tickss) rhs1) : filtered_alts) }
+  = (True, imposs_cons', deflt_alt : filtered_alts)
   where
     (eliminated_alts, filtered_alts) = partition identical_to_alt1 con_alts
+    deflt_alt = (DEFAULT, [], mkTicks (concat tickss) rhs1)
+    imposs_cons' = imposs_cons `minusList` map fstOf3 eliminated_alts
+
     cheapEqTicked e1 e2 = cheapEqExpr' tickishFloatable e1 e2
     identical_to_alt1 (_con,bndrs,rhs)
       = all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1
     tickss = map (stripTicksT tickishFloatable . thirdOf3) eliminated_alts
 
-combineIdenticalAlts _ alts = return alts
+combineIdenticalAlts imposs_cons alts
+  = (False, imposs_cons, alts)
 
 {-
 ************************************************************************