Fix utterly bogus TagToEnum rule in caseRules

In prelRules we had:

  tx_con_tte :: DynFlags -> AltCon -> AltCon
  tx_con_tte _      DEFAULT      = DEFAULT
  tx_con_tte dflags (DataAlt dc)
    | tag == 0  = DEFAULT   -- See Note [caseRules for tagToEnum]
    | otherwise = LitAlt (mkMachInt dflags (toInteger tag))

The tag==0 case is totally wrong, and led directly to Trac #14768.

See "Beware" in Note [caseRules for tagToEnum] (in the patch).

Easily fixed, though!

3 files changed, 52 insertions, 17 deletions

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index e83f8392d2..b0d2ac35c1 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -1123,7 +1123,7 @@ checkCaseAlts e ty alts =
   where
     (con_alts, maybe_deflt) = findDefault alts
 
-        -- Check that successive alternatives have increasing tags
+        -- Check that successive alternatives have strictly increasing tags
     increasing_tag (alt1 : rest@( alt2 : _)) = alt1 `ltAlt` alt2 && increasing_tag rest
     increasing_tag _                         = True
 
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index 49cd9fa153..c9a3bc78aa 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -1500,13 +1500,10 @@ adjustUnary op
          _         -> Nothing
 
 tx_con_tte :: DynFlags -> AltCon -> AltCon
-tx_con_tte _      DEFAULT      = DEFAULT
-tx_con_tte dflags (DataAlt dc)
-  | tag == 0  = DEFAULT   -- See Note [caseRules for tagToEnum]
-  | otherwise = LitAlt (mkMachInt dflags (toInteger tag))
-  where
-    tag = dataConTagZ dc
-tx_con_tte _      alt          = pprPanic "caseRules" (ppr alt)
+tx_con_tte _      DEFAULT         = DEFAULT
+tx_con_tte _      alt@(LitAlt {}) = pprPanic "caseRules" (ppr alt)
+tx_con_tte dflags (DataAlt dc)  -- See Note [caseRules for tagToEnum]
+  = LitAlt $ mkMachInt dflags $ toInteger $ dataConTagZ dc
 
 tx_con_dtt :: Type -> AltCon -> AltCon
 tx_con_dtt _  DEFAULT              = DEFAULT
@@ -1525,18 +1522,34 @@ We want to transform
 into
    case x of
      0# -> e1
-     1# -> e1
+     1# -> e2
 
 This rule eliminates a lot of boilerplate. For
-  if (x>y) then e1 else e2
+  if (x>y) then e2 else e1
 we generate
   case tagToEnum (x ># y) of
-    False -> e2
-    True  -> e1
+    False -> e1
+    True  -> e2
 and it is nice to then get rid of the tagToEnum.
 
-NB: in SimplUtils, where we invoke caseRules,
-    we convert that 0# to DEFAULT
+Beware (Trac #14768): avoid the temptation to map constructor 0 to
+DEFAULT, in the hope of getting this
+  case (x ># y) of
+    DEFAULT -> e1
+    1#      -> e2
+That fails utterly in the case of
+   data Colour = Red | Green | Blue
+   case tagToEnum x of
+      DEFAULT -> e1
+      Red     -> e2
+
+We don't want to get this!
+   case x of
+      DEFAULT -> e1
+      DEFAULT -> e2
+
+Instead, we deal with turning one branch into DEAFULT in SimplUtils
+(add_default in mkCase3).
 
 Note [caseRules for dataToTag]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index d86adbb1c4..cc72f7aa2a 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -2165,12 +2165,34 @@ mkCase2 dflags scrut bndr alts_ty alts
     re_sort alts = sortBy cmpAlt alts  -- preserve the #case_invariants#
 
     add_default :: [CoreAlt] -> [CoreAlt]
-    -- TagToEnum may change a boolean True/False set of alternatives
-    -- to LitAlt 0#/1# alternatives.  But literal alternatives always
-    -- have a DEFAULT (I think).  So add it.
+    -- See Note [Literal cases]
     add_default ((LitAlt {}, bs, rhs) : alts) = (DEFAULT, bs, rhs) : alts
     add_default alts                          = alts
 
+{- Note [Literal cases]
+~~~~~~~~~~~~~~~~~~~~~~~
+If we have
+  case tagToEnum (a ># b) of
+     False -> e1
+     True  -> e2
+
+then caseRules for TagToEnum will turn it into
+  case tagToEnum (a ># b) of
+     0# -> e1
+     1# -> e2
+
+Since the case is exhaustive (all cases are) we can convert it to
+  case tagToEnum (a ># b) of
+     DEFAULT -> e1
+     1#      -> e2
+
+This may generate sligthtly better code (although it should not, since
+all cases are exhaustive) and/or optimise better.  I'm not certain that
+it's necessary, but currenty we do make this change.  We do it here,
+NOT in the TagToEnum rules (see "Beware" in Note [caseRules for tagToEnum]
+in PrelRules)
+-}
+
 --------------------------------------------------
 --      Catch-all
 --------------------------------------------------