X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=236cee6074c2df0a18f2028140dc0b9dffc12a60;hp=e35d8dbccedfc5547a627815d82f71ea8e32d561;hb=72462499b891d5779c19f3bda03f96e24f9554ae;hpb=ad23a496a860063ab01025051d9c9baf45725a61 diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index e35d8db..236cee6 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -35,7 +35,8 @@ import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn ( boolTy, trueDataConId, falseDataConId ) import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon ) import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG ) -import CoreUtils ( cheapEqExpr, exprIsConApp_maybe ) +import CoreUtils ( cheapEqExpr ) +import CoreUnfold ( exprIsConApp_maybe ) import Type ( tyConAppTyCon, coreEqType ) import OccName ( occNameFS ) import PrelNames ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey, @@ -457,7 +458,7 @@ dataToTagRule [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag] = Just tag -- dataToTag (tagToEnum x) ==> x dataToTagRule [_, val_arg] - | Just (dc,_) <- exprIsConApp_maybe val_arg + | Just (dc,_,_) <- exprIsConApp_maybe val_arg = ASSERT( not (isNewTyCon (dataConTyCon dc)) ) Just (mkIntVal (toInteger (dataConTag dc - fIRST_TAG)))