[project @ 1999-04-23 13:53:28 by simonm]

Support for

	dataToTag# :: a -> Int#  (if a is a data type)

and (partial) support for

	tagToEnum# :: Int# -> a  (if a is an enumerated type)

The con2tag functions generated by derived Eq,Ord and Enum instances
are now replaced by dataToTag# for data types with a large number of
constructors.

ghc/compiler/codeGen/CgCase.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.25 1999/03/22 16:57:10 simonm Exp $
+% $Id: CgCase.lhs,v 1.26 1999/04/23 13:53:28 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -27,12 +27,12 @@ import AbsCUtils	( mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
 			)
 import CoreSyn		( isDeadBinder )
 import CgUpdate		( reserveSeqFrame )
-import CgBindery	( getVolatileRegs, getArgAmodes,
+import CgBindery	( getVolatileRegs, getArgAmodes, getArgAmode,
 			  bindNewToReg, bindNewToTemp,
 			  bindNewPrimToAmode,
 			  rebindToStack, getCAddrMode,
 			  getCAddrModeAndInfo, getCAddrModeIfVolatile,
-			  buildContLivenessMask, nukeDeadBindings
+			  buildContLivenessMask, nukeDeadBindings,
 			)
 import CgCon		( bindConArgs, bindUnboxedTupleComponents )
 import CgHeapery	( altHeapCheck, yield )
@@ -62,8 +62,9 @@ import PrimRep		( getPrimRepSize, retPrimRepSize, PrimRep(..)
 import TyCon		( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
 			  isNewTyCon, isAlgTyCon, isFunTyCon, isPrimTyCon,
 			  tyConDataCons, tyConFamilySize )
-import Type		( Type, typePrimRep, splitAlgTyConApp, splitTyConApp_maybe,
-			  splitFunTys, applyTys )
+import Type		( Type, typePrimRep, splitAlgTyConApp, 
+			  splitTyConApp_maybe,
+			   splitFunTys, applyTys )
 import Unique           ( Unique, Uniquable(..) )
 import Maybes		( maybeToBool )
 import Outputable
@@ -116,14 +117,6 @@ Against:
 
 	This never hurts us if there is only one alternative.
 
-
-*** NOT YET DONE ***  The difficulty is that \tr{!B!}, \tr{!C!} need
-to take account of what is live, and that includes all live volatile
-variables, even if they also have stable analogues.  Furthermore, the
-stack pointers must be lined up properly so that GC sees tidy stacks.
-If these things are done, then the heap checks can be done at \tr{!B!} and
-\tr{!C!} without a full save-volatile-vars sequence.
-
 \begin{code}
 cgCase	:: StgExpr
 	-> StgLiveVars
@@ -137,7 +130,26 @@ cgCase	:: StgExpr
 Several special cases for inline primitive operations.
 
 \begin{code}
-cgCase (StgCon (PrimOp op) args res_ty) live_in_whole_case live_in_alts bndr srt alts
+cgCase (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
+         live_in_whole_case live_in_alts bndr srt alts
+  | isEnumerationTyCon tycon
+  = getArgAmode arg `thenFC` \amode ->
+    let
+	[res] = getPrimAppResultAmodes (getUnique bndr) alts
+    in
+    absC (CAssign res (CTableEntry 
+		     	(CLbl (mkClosureTblLabel tycon) PtrRep)
+		      	amode PtrRep)) `thenC`
+
+	-- Scrutinise the result
+    cgInlineAlts bndr alts
+
+  | otherwise = panic "cgCase: tagToEnum# of non-enumerated type"
+   where
+	(Just (tycon,_)) = splitTyConApp_maybe res_ty
+
+cgCase (StgCon (PrimOp op) args res_ty) 
+	live_in_whole_case live_in_alts bndr srt alts
   | not (primOpOutOfLine op)
   =
 	-- Get amodes for the arguments and results
@@ -338,22 +350,22 @@ getPrimAppResultAmodes
 	-> [CAddrMode]
 \end{code}
 
-\begin{code}
--- If there's an StgBindDefault which does use the bound
--- variable, then we can only handle it if the type involved is
--- an enumeration type.   That's important in the case
--- of comparisions:
---
---	case x ># y of
---	  r -> f r
---
--- The only reason for the restriction to *enumeration* types is our
--- inability to invent suitable temporaries to hold the results;
--- Elaborating the CTemp addr mode to have a second uniq field
--- (which would simply count from 1) would solve the problem.
--- Anyway, cgInlineAlts is now capable of handling all cases;
--- it's only this function which is being wimpish.
+If there's an StgBindDefault which does use the bound
+variable, then we can only handle it if the type involved is
+an enumeration type.   That's important in the case
+of comparisions:
 
+	case x ># y of
+	  r -> f r
+
+The only reason for the restriction to *enumeration* types is our
+inability to invent suitable temporaries to hold the results;
+Elaborating the CTemp addr mode to have a second uniq field
+(which would simply count from 1) would solve the problem.
+Anyway, cgInlineAlts is now capable of handling all cases;
+it's only this function which is being wimpish.
+
+\begin{code}
 getPrimAppResultAmodes uniq (StgAlgAlts ty alts 
 				(StgBindDefault rhs))
   | isEnumerationTyCon spec_tycon = [tag_amode]

ghc/compiler/codeGen/CgConTbls.lhs

@@ -20,7 +20,7 @@ import ClosureInfo	( layOutStaticClosure, layOutDynCon,
 			)
 import CostCentre	( dontCareCCS )
 import FiniteMap	( fmToList, FiniteMap )
-import DataCon		( DataCon, dataConTag, dataConName, dataConRawArgTys )
+import DataCon		( DataCon, dataConName, dataConRawArgTys )
 import Const		( Con(..) )
 import Name		( getOccString )
 import PrimRep		( getPrimRepSize, PrimRep(..) )
@@ -142,8 +142,6 @@ genConInfo comp_info tycon data_con
 
     static_code  = CClosureInfoAndCode static_ci body Nothing con_descr
 
-    tag	    	 = dataConTag data_con
-
     cost_centre  = mkCCostCentreStack dontCareCCS -- not worried about static data costs
 
     -- For zero-arity data constructors, or, more accurately,

ghc/compiler/codeGen/CgExpr.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.22 1999/03/25 13:13:51 simonm Exp $
+% $Id: CgExpr.lhs,v 1.23 1999/04/23 13:53:29 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -22,7 +22,7 @@ import AbsCUtils	( mkAbstractCs )
 import CLabel		( mkClosureTblLabel )
 
 import SMRep		( fixedHdrSize )
-import CgBindery	( getArgAmodes, CgIdInfo, nukeDeadBindings )
+import CgBindery	( getArgAmodes, getArgAmode, CgIdInfo, nukeDeadBindings)
 import CgCase		( cgCase, saveVolatileVarsAndRegs, 
 			  restoreCurrentCostCentre, freeCostCentreSlot,
 			  splitTyConAppThroughNewTypes )
@@ -48,7 +48,7 @@ import PrimOp		( primOpOutOfLine,
 import PrimRep		( getPrimRepSize, PrimRep(..), isFollowableRep )
 import TyCon		( maybeTyConSingleCon,
 			  isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type		( Type, typePrimRep )
+import Type		( Type, typePrimRep, splitTyConApp_maybe )
 import Maybes		( assocMaybe, maybeToBool )
 import Unique		( mkBuiltinUnique )
 import BasicTypes	( TopLevelFlag(..), RecFlag(..) )
@@ -116,12 +116,30 @@ NOTE about _ccall_GC_:
 A _ccall_GC_ is treated as an out-of-line primop for the case
 expression code, because we want a proper stack frame on the stack
 when we perform it.  When we get here, however, we need to actually
-perform the call, so we treat it an an inline primop.
+perform the call, so we treat it as an inline primop.
 
 \begin{code}
 cgExpr (StgCon (PrimOp op@(CCallOp _ _ may_gc@True _)) args res_ty)
   = primRetUnboxedTuple op args res_ty
 
+-- tagToEnum# is special: we need to pull the constructor out of the table,
+-- and perform an appropriate return.
+
+cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty) 
+  | isEnumerationTyCon tycon =
+	getArgAmode arg `thenFC` \amode ->
+	performReturn (CAssign (CReg node) 
+			(CTableEntry 
+		          (CLbl (mkClosureTblLabel tycon) PtrRep)
+		          amode PtrRep))
+		  (\ sequel -> mkDynamicAlgReturnCode tycon amode sequel)
+
+  | otherwise = panic "cgExpr: tagToEnum# of non-enumerated type"
+
+   where
+	(Just (tycon,_)) = splitTyConApp_maybe res_ty
+
+
 cgExpr x@(StgCon (PrimOp op) args res_ty)
   | primOpOutOfLine op = tailCallPrimOp op args
   | otherwise
@@ -144,7 +162,6 @@ cgExpr x@(StgCon (PrimOp op) args res_ty)
 	ReturnsAlg tycon
 	    | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
 
-
 	    | isEnumerationTyCon  tycon ->
 	     	performReturn
 	      	     (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])

ghc/compiler/prelude/PrelInfo.lhs

@@ -51,7 +51,7 @@ module PrelInfo (
 	ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, 
 	ltH_Int_RDR, geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR,
 	and_RDR, not_RDR, append_RDR, map_RDR, compose_RDR, mkInt_RDR,
-	error_RDR, assertErr_RDR,
+	error_RDR, assertErr_RDR, dataToTagH_RDR,
 	showString_RDR, showParen_RDR, readParen_RDR, lex_RDR,
 	showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
 
@@ -566,6 +566,7 @@ ltH_Int_RDR	= prelude_primop IntLtOp
 geH_RDR		= prelude_primop IntGeOp
 leH_RDR		= prelude_primop IntLeOp
 minusH_RDR	= prelude_primop IntSubOp
+dataToTagH_RDR  = prelude_primop DataToTagOp
 \end{code}
 
 \begin{code}

ghc/compiler/prelude/PrimOp.lhs

@@ -172,17 +172,21 @@ data PrimOp
     | CatchOp
     | RaiseOp
 
+    -- foreign objects
     | MakeForeignObjOp
     | WriteForeignObjOp
 
+    -- weak pointers
     | MkWeakOp
     | DeRefWeakOp
     | FinalizeWeakOp
 
+    -- stable names
     | MakeStableNameOp
     | EqStableNameOp
     | StableNameToIntOp
 
+    -- stable pointers
     | MakeStablePtrOp
     | DeRefStablePtrOp
     | EqStablePtrOp
@@ -280,6 +284,7 @@ about using it this way?? ADR)
     | WaitReadOp
     | WaitWriteOp
 
+    -- more parallel stuff
     | ParGlobalOp	-- named global par
     | ParLocalOp	-- named local par
     | ParAtOp		-- specifies destination of local par
@@ -288,6 +293,10 @@ about using it this way?? ADR)
     | ParAtForNowOp	-- specifies initial destination of global par
     | CopyableOp	-- marks copyable code
     | NoFollowOp	-- marks non-followup expression
+
+    -- tag-related
+    | DataToTagOp
+    | TagToEnumOp
 \end{code}
 
 Used for the Ord instance
@@ -546,6 +555,8 @@ tagOf_PrimOp WriteMutVarOp		      = ILIT(239)
 tagOf_PrimOp SameMutVarOp		      = ILIT(240)
 tagOf_PrimOp CatchOp			      = ILIT(241)
 tagOf_PrimOp RaiseOp			      = ILIT(242)
+tagOf_PrimOp DataToTagOp		      = ILIT(243)
+tagOf_PrimOp TagToEnumOp		      = ILIT(244)
 
 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
 --panic# "tagOf_PrimOp: pattern-match"
@@ -810,7 +821,9 @@ allThePrimOps
 	MyThreadIdOp,
 	DelayOp,
 	WaitReadOp,
-	WaitWriteOp
+	WaitWriteOp,
+	DataToTagOp,
+	TagToEnumOp
     ]
 \end{code}
 
@@ -909,6 +922,8 @@ primOpStrictness MkWeakOp	  = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
 primOpStrictness MakeStablePtrOp  = ([wwLazy, wwPrim], False)
 
+primOpStrictness DataToTagOp      = ([wwLazy], False)
+
 	-- The rest all have primitive-typed arguments
 primOpStrictness other		  = (repeat wwPrim, False)
 \end{code}
@@ -1837,11 +1852,40 @@ primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
   where
     (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
 -}
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
+%*									*
+%************************************************************************
+
+These primops are pretty wierd.
+
+	dataToTag# :: a -> Int    (arg must be an evaluated data type)
+	tagToEnum# :: Int -> a    (result type must be an enumerated type)
+
+The constraints aren't currently checked by the front end, but the
+code generator will fall over if they aren't satisfied.
+
+\begin{code}
+primOpInfo DataToTagOp
+  = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
+
+primOpInfo TagToEnumOp
+  = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
+
 #ifdef DEBUG
 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
 #endif
 \end{code}
 
+%************************************************************************
+%*									*
+\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
+%*									*
+%************************************************************************
+
 Some PrimOps need to be called out-of-line because they either need to
 perform a heap check or they block.
 
@@ -2066,12 +2110,11 @@ data PrimOpResultInfo
 -- be out of line, or the code generator won't work.
 
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
-
 getPrimOpResultInfo op
   = case (primOpInfo op) of
       Dyadic  _ ty		 -> ReturnsPrim (typePrimRep ty)
       Monadic _ ty		 -> ReturnsPrim (typePrimRep ty)
-      Compare _ ty		 -> ReturnsAlg  boolTyCon
+      Compare _ ty		 -> ReturnsAlg boolTyCon
       GenPrimOp _ _ _ ty	 -> 
 	let rep = typePrimRep ty in
 	case rep of
@@ -2081,7 +2124,6 @@ getPrimOpResultInfo op
 	   other -> ReturnsPrim other
 
 isCompareOp :: PrimOp -> Bool
-
 isCompareOp op
   = case primOpInfo op of
       Compare _ _ -> True

ghc/compiler/simplCore/ConFold.lhs

@@ -18,6 +18,9 @@ import Const		( mkMachInt, mkMachWord, Literal(..), Con(..) )
 import PrimOp		( PrimOp(..) )
 import SimplMonad
 import TysWiredIn	( trueDataCon, falseDataCon )
+import TyCon		( tyConDataCons, isEnumerationTyCon )
+import DataCon		( dataConTag, fIRST_TAG )
+import Type		( splitTyConApp_maybe )
 
 import Char		( ord, chr )
 import Outputable
@@ -93,6 +96,19 @@ tryPrimOp SeqOp args@[Type ty, Var var]
   | otherwise			     = Nothing 					-- var not eval'd
 \end{code}
 
+\begin{code}
+tryPrimOp TagToEnumOp [Type ty, Con (Literal (MachInt i _)) _]
+  | isEnumerationTyCon tycon = Just (Con (DataCon dc) [])
+  | otherwise = panic "tryPrimOp: tagToEnum# on non-enumeration type"
+    where tag = fromInteger i
+	  constrs = tyConDataCons tycon
+	  (dc:_) = [ dc | dc <- constrs, tag == dataConTag dc ]
+	  (Just (tycon,_)) = splitTyConApp_maybe ty
+
+tryPrimOp DataToTagOp [Type ty, Con (DataCon dc) _]
+  = Just (Con (Literal (mkMachInt (toInteger (dataConTag dc - fIRST_TAG)))) [])
+\end{code}
+
 \begin{code}
 tryPrimOp op args
   = case args of

ghc/compiler/stgSyn/CoreToStg.lhs

@@ -31,6 +31,7 @@ import VarEnv
 import Const		( Con(..), isWHNFCon, Literal(..) )
 import PrimOp		( PrimOp(..) )
 import Type		( isUnLiftedType, isUnboxedTupleType, Type )
+import TysPrim		( intPrimTy )
 import Unique		( Unique, Uniquable(..) )
 import UniqSupply	-- all of it, really
 import Outputable
@@ -72,6 +73,10 @@ invariant any longer.)
 
 \begin{code}
 type StgEnv = IdEnv Id
+
+data StgFloatBind
+   = LetBind Id StgExpr
+   | CaseBind Id StgExpr
 \end{code}
 
 No free/live variable information is pinned on in this pass; it's added
@@ -229,8 +234,7 @@ isDynName nm =
 %************************************************************************
 
 \begin{code}
-coreArgsToStg :: StgEnv -> [CoreArg]
-	      -> UniqSM ([(Id,StgExpr)], [StgArg])
+coreArgsToStg :: StgEnv -> [CoreArg] -> UniqSM ([StgFloatBind], [StgArg])
 
 coreArgsToStg env []
   = returnUs ([], [])
@@ -245,7 +249,7 @@ coreArgsToStg env (a:as)
 
 -- This is where we arrange that a non-trivial argument is let-bound
 
-coreArgToStg :: StgEnv -> CoreArg -> UniqSM ([(Id,StgExpr)], StgArg)
+coreArgToStg :: StgEnv -> CoreArg -> UniqSM ([StgFloatBind], StgArg)
 
 coreArgToStg env arg
   = coreExprToStgFloat env arg	`thenUs` \ (binds, arg') ->
@@ -254,7 +258,7 @@ coreArgToStg env arg
 	([], StgApp v [])		      -> returnUs ([], StgVarArg v)
 
 	-- A non-trivial argument: we must let (or case-bind)
-	-- We don't do the case part here... we leave that to mkStgLets
+	-- We don't do the case part here... we leave that to mkStgBinds
 
 	-- Further complication: if we're converting this binding into
 	-- a case,  then try to avoid generating any case-of-case
@@ -262,8 +266,8 @@ coreArgToStg env arg
 	(_, other) ->
 		 newStgVar ty	`thenUs` \ v ->
 		 if isUnLiftedType ty
-		   then returnUs (binds ++ [(v,arg')], StgVarArg v)
-		   else returnUs ([(v, mkStgLets binds arg')], StgVarArg v)
+		   then returnUs (binds ++ [CaseBind v arg'], StgVarArg v)
+		   else returnUs ([LetBind v (mkStgBinds binds arg')], StgVarArg v)
 	  where 
 		ty = coreExprType arg
 
@@ -369,7 +373,7 @@ The rest are handled by coreExprStgFloat.
 \begin{code}
 coreExprToStg env expr
   = coreExprToStgFloat env expr  `thenUs` \ (binds,stg_expr) ->
-    returnUs (mkStgLets binds stg_expr)
+    returnUs (mkStgBinds binds stg_expr)
 \end{code}
 
 %************************************************************************
@@ -433,6 +437,16 @@ coreExprToStgFloat env expr@(Con (PrimOp (CCallOp (Right _) a b c)) args)
     let con' = PrimOp (CCallOp (Right u) a b c) in
     returnUs (binds, StgCon con' stg_atoms (coreExprType expr))
 
+-- for dataToTag#, we need to make sure the argument is evaluated first.
+coreExprToStgFloat env expr@(Con op@(PrimOp DataToTagOp) [Type ty, a])
+  = newStgVar ty		`thenUs` \ v ->
+    coreArgToStg env a		`thenUs` \ (binds, arg) ->
+    let e = case arg of
+		StgVarArg v -> StgApp v []
+		StgConArg c -> StgCon c [] (coreExprType a)
+    in
+    returnUs (binds ++ [CaseBind v e], StgCon op [StgVarArg v] (coreExprType expr))
+
 coreExprToStgFloat env expr@(Con con args)
   = coreArgsToStg env args	`thenUs` \ (binds, stg_atoms) ->
     returnUs (binds, StgCon con stg_atoms (coreExprType expr))
@@ -541,12 +555,20 @@ newLocalIds env (b:bs)
 
 
 \begin{code}
-mkStgLets :: [(Id,StgExpr)] -> StgExpr -> StgExpr
-mkStgLets binds body = foldr mkStgLet body binds
+mkStgBinds :: [StgFloatBind] -> StgExpr -> StgExpr
+mkStgBinds binds body = foldr mkStgBind body binds
+
+mkStgBind (CaseBind bndr rhs) body
+  | isUnLiftedType bndr_ty
+  = mkStgCase rhs bndr (StgPrimAlts bndr_ty [] (StgBindDefault body))
+  | otherwise
+  = mkStgCase rhs bndr (StgAlgAlts bndr_ty [] (StgBindDefault body))
+  where
+    bndr_ty = idType bndr
 
-mkStgLet (bndr, rhs) body
+mkStgBind (LetBind bndr rhs) body
   | isUnboxedTupleType bndr_ty
-  = panic "mkStgLets: unboxed tuple"
+  = panic "mkStgBinds: unboxed tuple"
   | isUnLiftedType bndr_ty
   = mkStgCase rhs bndr (StgPrimAlts bndr_ty [] (StgBindDefault body))
 

ghc/compiler/typecheck/TcGenDeriv.lhs

@@ -49,7 +49,7 @@ import PrimOp		( PrimOp(..) )
 import PrelInfo		-- Lots of RdrNames
 import SrcLoc		( mkGeneratedSrcLoc, SrcLoc )
 import TyCon		( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
-			  maybeTyConSingleCon
+			  maybeTyConSingleCon, tyConFamilySize
 			)
 import Type		( isUnLiftedType, isUnboxedType, Type )
 import TysPrim		( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
@@ -59,6 +59,7 @@ import Util		( mapAccumL, zipEqual, zipWithEqual,
 			  zipWith3Equal, nOfThem )
 import Panic		( panic, assertPanic )
 import Maybes		( maybeToBool, assocMaybe )
+import Constants
 import List		( partition, intersperse )
 \end{code}
 
@@ -1063,16 +1064,25 @@ gen_tag_n_con_monobind
     -> RdrNameMonoBinds
 
 gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
+  | lots_of_constructors
+  = mk_FunMonoBind (getSrcLoc tycon) rdr_name 
+	[([VarPatIn a_RDR], HsApp dataToTag_Expr a_Expr)]
+
+  | otherwise
   = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
+
   where
-    mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
+    lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
 
+    mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
     mk_stuff var
       = ([pat], HsLit (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG))))
       where
 	pat    = ConPatIn var_RDR (nOfThem (argFieldCount var) WildPatIn)
 	var_RDR = qual_orig_name var
 
+
+
 gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
   = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon) ++ 
 							     [([WildPatIn], impossible_Expr)])
@@ -1351,6 +1361,7 @@ gtTag_Expr	= HsVar gtTag_RDR
 false_Expr	= HsVar false_RDR
 true_Expr	= HsVar true_RDR
 
+dataToTag_Expr  = HsVar dataToTagH_RDR
 con2tag_Expr tycon = HsVar (con2tag_RDR tycon)
 
 a_Pat		= VarPatIn a_RDR
@@ -1358,7 +1369,7 @@ b_Pat		= VarPatIn b_RDR
 c_Pat		= VarPatIn c_RDR
 d_Pat		= VarPatIn d_RDR
 
-con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
+tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
 
 con2tag_RDR tycon = varUnqual (_PK_ ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
 tag2con_RDR tycon = varUnqual (_PK_ ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))