Commit d20317a2 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

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
parent 310c0049
......@@ -450,25 +450,21 @@ and emits a warning.
\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)]
= 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 )
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
tag = fromInteger i
tycon = tyConAppTyCon ty
tag = fromInteger i
tagToEnumRule _ _ = Nothing
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment