From b106d6412e354f2944a64f1fa135cb439ba2965f Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Mon, 26 Apr 1999 10:16:25 +0000
Subject: [PATCH] [project @ 1999-04-26 10:16:25 by simonm] Reduce (dataToTag#
 x) where x is bound to a known constructor.

---
 ghc/compiler/simplCore/ConFold.lhs |   10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/ghc/compiler/simplCore/ConFold.lhs b/ghc/compiler/simplCore/ConFold.lhs
index 07c1cba..1af5fbf 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}
-- 
1.7.10.4