Commit d8a0e6d3 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari
Browse files

Don't apply dataToTag's caseRules for data families

Commit 193664d4 added a
special caseRule for `dataToTag`, but this transformation completely
broke when `dataToTag` was applied to somewith with a type headed by
a data family, leading to #14680. For now at least, the simplest
solution is to simply not apply this transformation when the type is
headed by a data family.

Test Plan: make test TEST=T14680

Reviewers: simonpj, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14680

Differential Revision: https://phabricator.haskell.org/D4371
parent 217e4170
......@@ -37,8 +37,8 @@ import CoreOpt ( exprIsLiteral_maybe )
import PrimOp ( PrimOp(..), tagToEnumKey )
import TysWiredIn
import TysPrim
import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon
, unwrapNewTyCon_maybe, tyConDataCons )
import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
, isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons )
import DataCon ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId )
import CoreUtils ( cheapEqExpr, exprIsHNF, exprType )
import CoreUnfold ( exprIsConApp_maybe )
......@@ -1449,6 +1449,8 @@ caseRules dflags (App (App (Var f) type_arg) v)
-- See Note [caseRules for dataToTag]
caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x
| Just DataToTagOp <- isPrimOpId_maybe f
, Just (tc, _) <- tcSplitTyConApp_maybe ty
, isAlgTyCon tc
= Just (v, tx_con_dtt ty
, \v -> App (App (Var f) (Type ty)) (Var v))
......@@ -1549,4 +1551,10 @@ into
Note the need for some wildcard binders in
the 'cons' case.
For the time, we only apply this transformation when the type of `x` is a type
headed by a normal tycon. In particular, we do not apply this in the case of a
data family tycon, since that would require carefully applying coercion(s)
between the data family and the data family instance's representation type,
which caseRules isn't currently engineered to handle (#14680).
-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -O1 #-}
module T14680 where
import GHC.Base (getTag)
import GHC.Exts (Int(..), tagToEnum#)
data family TyFamilyEnum
data instance TyFamilyEnum = TyFamilyEnum1 | TyFamilyEnum2 | TyFamilyEnum3
suc :: TyFamilyEnum -> TyFamilyEnum
suc a_aaf8
= case getTag a_aaf8 of
a_aaf9
-> if 2 == I# a_aaf9
then error "succ{TyFamilyEnum}: tried to take `succ' of last tag in enumeration"
else case I# a_aaf9 + 1 of
I# i_aafa -> tagToEnum# i_aafa :: TyFamilyEnum
......@@ -272,3 +272,4 @@ test('T14131', normal, compile, [''])
test('T14162', normal, compile, [''])
test('T14237', normal, compile, [''])
test('T14554', normal, compile, [''])
test('T14680', normal, compile, [''])
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