diff options
| -rw-r--r-- | ghc/compiler/simplCore/ConFold.lhs | 10 |
1 files changed, 10 insertions, 0 deletions
diff --git a/ghc/compiler/simplCore/ConFold.lhs b/ghc/compiler/simplCore/ConFold.lhs index 07c1cbaa04..1af5fbf652 100644 --- a/ghc/compiler/simplCore/ConFold.lhs +++ b/ghc/compiler/simplCore/ConFold.lhs @@ -107,6 +107,16 @@ tryPrimOp TagToEnumOp [Type ty, Con (Literal (MachInt i _)) _] tryPrimOp DataToTagOp [Type ty, Con (DataCon dc) _] = Just (Con (Literal (mkMachInt (toInteger (dataConTag dc - fIRST_TAG)))) []) +tryPrimOp DataToTagOp [Type ty, Var x] + | unfolding_is_constr + = Just (Con (Literal (mkMachInt (toInteger (dataConTag dc - fIRST_TAG)))) []) + where + unfolding = getIdUnfolding var + CoreUnfolding form guidance unf_template = unfolding + unfolding_is_constr = case unf_template of + Con con@(DataCon _) _ -> conOkForAlt con + other -> False + Con (DataCon dc) con_args = unf_template \end{code} \begin{code} |