Fix test T4235 with -O

The tag2Enum rule wasn't doing the right thing for
enumerations with a phantom type parameter, like
   data T a = A | B

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 59562a2..7a8a42e 100644 (file)
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -450,25 +450,21 @@ and emits a warning.
 
 \begin{code}
 tagToEnumRule :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Expr CoreBndr)
 
 \begin{code}
 tagToEnumRule :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Expr CoreBndr)

-tagToEnumRule _ [Type ty, _]
-  | not (is_enum_ty ty)          -- See Note [tagToEnum#]
-  = WARN( True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty )
-    Just (mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type")
-  where
-    is_enum_ty ty = case splitTyConApp_maybe ty of
-                       Just (tc, _) -> isEnumerationTyCon tc
-                      Nothing      -> False
-
+-- If     data T a = A | B | C
+-- then   tag2Enum# (T ty) 2# -->  B ty

 tagToEnumRule _ [Type ty, Lit (MachInt i)]
 tagToEnumRule _ [Type ty, Lit (MachInt i)]

-  = ASSERT( isEnumerationTyCon tycon ) 
-    case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of
+  | Just (tycon, tc_args) <- splitTyConApp_maybe ty
+  , isEnumerationTyCon tycon
+  = case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of

        []        -> Nothing    -- Abstract type
        (dc:rest) -> ASSERT( null rest )
        []        -> Nothing    -- Abstract type
        (dc:rest) -> ASSERT( null rest )

-                    Just (Var (dataConWorkId dc))
+                    Just (mkTyApps (Var (dataConWorkId dc)) tc_args)
+  | otherwise    -- See Note [tagToEnum#]
+  = WARN( True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty )
+    Just (mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type")

   where 
     correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
   where 
     correct_tag dc = (dataConTag dc - fIRST_TAG) == tag

-    tag   = fromInteger i
-    tycon = tyConAppTyCon ty
+    tag = fromInteger i

 
 tagToEnumRule _ _ = Nothing
 \end{code}
 
 tagToEnumRule _ _ = Nothing
 \end{code}