diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index d3f3d65aca8267b4f7dfb11c9d8608f6dfcd6aa8..436856037e75343b2b2098d2d7782bcbf5a6f5af 100644
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.24 1999/03/02 16:44:26 sof Exp $
+% $Id: CLabel.lhs,v 1.25 1999/04/27 12:34:49 simonm Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -173,6 +173,7 @@ data CLabelType
   = InfoTblType
   | ClosureType
   | VecTblType
+  | ClosureTblType
   | CodeType
   | DataType
 \end{code}
@@ -248,9 +249,9 @@ needsCDecl (IdLabel _ _)		= True
 needsCDecl (CaseLabel _ CaseReturnPt)	= True
 needsCDecl (DataConLabel _ _)		= True
 needsCDecl (CaseLabel _ _)		= False
+needsCDecl (TyConLabel _)		= True
 
 needsCDecl (AsmTempLabel _)		= False
-needsCDecl (TyConLabel _)		= False
 needsCDecl (RtsLabel _)			= False
 needsCDecl (CC_Label _)			= False
 needsCDecl (CCS_Label _)		= False
@@ -304,6 +305,7 @@ labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
 labelType (CaseLabel _ CaseReturnInfo)        = InfoTblType
 labelType (CaseLabel _ CaseReturnPt)	      = CodeType
 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
+labelType (TyConLabel _)		      = ClosureTblType
 
 labelType (IdLabel _ info) = 
   case info of
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 721a1215ed69eb38ae4aa476afc8cc12092995c2..b17536be87b75b9c2ff66d92e5159da0196693f5 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -227,15 +227,15 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _
     	the_op = ppr_op_call non_void_results non_void_args
 		-- liveness mask is *in* the non_void_args
     in
-    case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) ->
     if primOpNeedsWrapper op then
+    	case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) ->
     	vcat [  pp_saves,
     	    	the_op,
     	    	pp_restores
     	     ]
+	}
     else
     	the_op
-    }
   where
     ppr_op_call results args
       = hcat [ pprPrimOp op, lparen,
@@ -555,10 +555,11 @@ ppLocalnessMacro include_dyn_prefix clabel =
         visiblity_prefix,
 	dyn_prefix,
         case label_type of
-	  ClosureType -> ptext SLIT("C_")
-	  CodeType    -> ptext SLIT("F_")
-	  InfoTblType -> ptext SLIT("I_")
-	  DataType    -> ptext SLIT("D_") <>
+	  ClosureType    -> ptext SLIT("C_")
+	  CodeType       -> ptext SLIT("F_")
+	  InfoTblType    -> ptext SLIT("I_")
+	  ClosureTblType -> ptext SLIT("CP_")
+	  DataType       -> ptext SLIT("D_") <>
 				   if isReadOnly clabel 
 				      then ptext SLIT("RO_") 
 				      else empty 
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 2182c17b8d8b15de5fec0f49d51fc5d2bb01b705..a99a8fe7542a6884cad3306838cb55e5e37ffc22 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.26 1999/04/23 13:53:28 simonm Exp $
+% $Id: CgCase.lhs,v 1.27 1999/04/27 12:34:52 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -65,8 +65,9 @@ import TyCon		( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
 import Type		( Type, typePrimRep, splitAlgTyConApp, 
 			  splitTyConApp_maybe,
 			   splitFunTys, applyTys )
-import Unique           ( Unique, Uniquable(..) )
+import Unique           ( Unique, Uniquable(..), mkBuiltinUnique )
 import Maybes		( maybeToBool )
+import Util
 import Outputable
 \end{code}
 
@@ -127,27 +128,71 @@ cgCase	:: StgExpr
 	-> Code
 \end{code}
 
-Several special cases for inline primitive operations.
+Special case #1:  PrimOps returning enumeration types.
+
+For enumeration types, we invent a temporary (builtin-unique 1) to
+hold the tag, and cross our fingers that this doesn't clash with
+anything else.  Builtin-unique 0 is used for a similar reason when
+compiling enumerated-type primops in CgExpr.lhs.  We can't use the
+unique from the case binder, because this is used to hold the actual
+closure (when the case binder is live, that is).
+
+There is an extra special case for
+
+	case tagToEnum# x of
+		...
+
+which generates no code for the primop, unless x is used in the
+alternatives (in which case we lookup the tag in the relevant closure
+table to get the closure).
 
 \begin{code}
-cgCase (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
-         live_in_whole_case live_in_alts bndr srt alts
+cgCase (StgCon (PrimOp op) args res_ty)
+         live_in_whole_case live_in_alts bndr srt (StgAlgAlts ty alts deflt)
   | isEnumerationTyCon tycon
-  = getArgAmode arg `thenFC` \amode ->
-    let
-	[res] = getPrimAppResultAmodes (getUnique bndr) alts
+  = getArgAmodes args `thenFC` \ arg_amodes ->
+
+    let tag_amode = case op of 
+			TagToEnumOp -> only arg_amodes
+			_ -> CTemp (mkBuiltinUnique 1) IntRep
+
+	closure = CTableEntry (CLbl (mkClosureTblLabel tycon) PtrRep) tag_amode PtrRep
     in
-    absC (CAssign res (CTableEntry 
-		     	(CLbl (mkClosureTblLabel tycon) PtrRep)
-		      	amode PtrRep)) `thenC`
 
-	-- Scrutinise the result
-    cgInlineAlts bndr alts
+    case op of {
+	TagToEnumOp -> nopC;  -- no code!
+
+	_ -> 	-- Perform the operation
+	       getVolatileRegs live_in_alts     `thenFC` \ vol_regs ->
+
+ 	       absC (COpStmt [tag_amode] op
+		 arg_amodes -- note: no liveness arg
+		 vol_regs)
+    } 						`thenC`
+
+ 	-- bind the default binder if necessary
+    (if (isDeadBinder bndr)
+	then nopC
+	else bindNewToTemp bndr 		`thenFC` \ bndr_amode ->
+	     absC (CAssign bndr_amode closure))
+						`thenC`
+
+	-- compile the alts
+    cgAlgAlts NoGC uniq Nothing{-cc_slot-} False{-no semi-tagging-}
+		False{-not poly case-} alts deflt
+                False{-don't emit yield-}  	`thenFC` \ (tagged_alts, deflt_c) ->
+
+	-- Do the switch
+    absC (mkAlgAltsCSwitch tag_amode tagged_alts deflt_c)
 
-  | otherwise = panic "cgCase: tagToEnum# of non-enumerated type"
    where
 	(Just (tycon,_)) = splitTyConApp_maybe res_ty
+	uniq = getUnique bndr
+\end{code}
+
+Special case #2: inline PrimOps.
 
+\begin{code}
 cgCase (StgCon (PrimOp op) args res_ty) 
 	live_in_whole_case live_in_alts bndr srt alts
   | not (primOpOutOfLine op)
@@ -348,43 +393,8 @@ getPrimAppResultAmodes
 	:: Unique
 	-> StgCaseAlts
 	-> [CAddrMode]
-\end{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.
 
-\begin{code}
-getPrimAppResultAmodes uniq (StgAlgAlts ty alts 
-				(StgBindDefault rhs))
-  | isEnumerationTyCon spec_tycon = [tag_amode]
-  | otherwise		          = pprPanic "getPrimAppResultAmodes: non-enumeration algebraic alternatives with default" (ppr uniq <+> ppr rhs)
-  where
-    -- A temporary variable to hold the tag; this is unaffected by GC because
-    -- the heap-checks in the branches occur after the switch
-    tag_amode     = CTemp uniq IntRep
-    (spec_tycon, _, _) = splitAlgTyConApp ty
-\end{code}
-
-If we don't have a default case, we could be scrutinising an unboxed
-tuple, or an enumeration type...
-
-\begin{code}
-getPrimAppResultAmodes uniq (StgAlgAlts ty alts other_default)
-	-- Default is either StgNoDefault or StgBindDefault with unused binder
-
-  | isEnumerationTyCon tycon = [CTemp uniq IntRep]
+getPrimAppResultAmodes uniq (StgAlgAlts ty alts some_default)
 
   | isUnboxedTupleTyCon tycon = 
 	case alts of 
@@ -395,12 +405,10 @@ getPrimAppResultAmodes uniq (StgAlgAlts ty alts other_default)
   | otherwise = panic ("getPrimAppResultAmodes: case of primop has strange type: " ++ showSDoc (ppr ty))
 
   where (tycon, _, _) = splitAlgTyConApp ty
-\end{code}
 
-The situation is simpler for primitive results, because there is only
-one!
+-- The situation is simpler for primitive results, because there is only
+-- one!
 
-\begin{code}
 getPrimAppResultAmodes uniq (StgPrimAlts ty _ _)
   = [CTemp uniq (typePrimRep ty)]
 \end{code}
@@ -536,49 +544,6 @@ cgInlineAlts bndr (StgAlgAlts ty [alt@(con,args,use_mask,rhs)] StgNoDefault)
   = panic "cgInlineAlts: single alternative, not an unboxed tuple"
 \end{code}
 
-Hack: to deal with 
-
-	case <# x y of z {
-	   DEFAULT -> ...
-        }
-
-\begin{code}
-cgInlineAlts bndr (StgAlgAlts ty [] (StgBindDefault rhs))
-  = bindNewToTemp bndr			`thenFC` \amode ->
-    let
-    	(tycon, _, _) = splitAlgTyConApp ty
-	closure_lbl = CTableEntry (CLbl (mkClosureTblLabel tycon) PtrRep) amode PtrRep
-    in
-    absC (CAssign amode closure_lbl) 	`thenC`
-    cgExpr rhs
-\end{code}
-
-Second case: algebraic case, several alternatives.
-Tag is held in a temporary.
-
-\begin{code}
-cgInlineAlts bndr (StgAlgAlts ty alts deflt)
-  =	   -- bind the default binder (it covers all the alternatives)
-
-	-- ToDo: BUG! bndr isn't bound in the alternatives
-	-- Shows up when compiling Word.lhs
-	--	case cmp# a b of r {
-	--		True  -> f1 r
-	--		False -> f2 r
-
-    cgAlgAlts NoGC uniq Nothing{-cc_slot-} False{-no semi-tagging-}
-		False{-not poly case-} alts deflt
-                False{-don't emit yield-}  	`thenFC` \ (tagged_alts, deflt_c) ->
-
-	-- Do the switch
-    absC (mkAlgAltsCSwitch tag_amode tagged_alts deflt_c)
- where
-    -- A temporary variable to hold the tag; this is unaffected by GC because
-    -- the heap-checks in the branches occur after the switch
-    tag_amode = CTemp uniq IntRep
-    uniq = getUnique bndr
-\end{code}
-
 Third (real) case: primitive result type.
 
 \begin{code}
@@ -586,7 +551,6 @@ cgInlineAlts bndr (StgPrimAlts ty alts deflt)
   = cgPrimInlineAlts bndr ty alts deflt
 \end{code}
 
-
 %************************************************************************
 %*									*
 \subsection[CgCase-alg-alts]{Algebraic alternatives}
diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 33022296a4377c646d5ed28819bd7a67ce829d89..5bbd2a5a40911375df9e83c49b6cc9dad4de5ba5 100644
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/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, getTag_RDR,
+	error_RDR, assertErr_RDR, getTag_RDR, tagToEnumH_RDR,
 	showString_RDR, showParen_RDR, readParen_RDR, lex_RDR,
 	showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
 
@@ -567,6 +567,7 @@ ltH_Int_RDR	= prelude_primop IntLtOp
 geH_RDR		= prelude_primop IntGeOp
 leH_RDR		= prelude_primop IntLeOp
 minusH_RDR	= prelude_primop IntSubOp
+tagToEnumH_RDR	= prelude_primop TagToEnumOp
 
 getTag_RDR	= varQual pREL_GHC SLIT("getTag#")
 \end{code}
diff --git a/ghc/compiler/simplStg/StgVarInfo.lhs b/ghc/compiler/simplStg/StgVarInfo.lhs
index 9e58a8f2ca45d24a31e7c1aee023abd9eb1f27f3..43974baf2aff669b6710ad889680258d91f18794 100644
--- a/ghc/compiler/simplStg/StgVarInfo.lhs
+++ b/ghc/compiler/simplStg/StgVarInfo.lhs
@@ -16,7 +16,9 @@ import StgSyn
 import Id		( setIdArity, getIdArity, Id )
 import VarSet
 import VarEnv
-import IdInfo		( ArityInfo(..) )
+import Var
+import IdInfo		( ArityInfo(..), InlinePragInfo(..), 
+			  setInlinePragInfo )
 import Maybes		( maybeToBool )
 import Name		( isLocallyDefined )
 import BasicTypes       ( Arity )
@@ -287,6 +289,11 @@ varsExpr (StgCase scrut _ _ bndr srt alts)
     vars_alts alts		  `thenLne` \ (alts2, alts_fvs, alts_escs) ->
     lookupLiveVarsForSet alts_fvs `thenLne` \ alts_lvs ->
     let
+	-- determine whether the default binder is dead or not
+	bndr'= if (bndr `elementOfFVInfo` alts_fvs) 
+		  then bndr `modifyIdInfo` (setInlinePragInfo NoInlinePragInfo)
+		  else bndr `modifyIdInfo` (setInlinePragInfo IAmDead)
+
 	-- don't consider the default binder as being 'live in alts',
 	-- since this is from the point of view of the case expr, where
 	-- the default binder is not free.
@@ -303,7 +310,7 @@ varsExpr (StgCase scrut _ _ bndr srt alts)
 	live_in_whole_case = live_in_alts `unionVarSet` scrut_lvs
     in
     returnLne (
-      StgCase scrut2 live_in_whole_case live_in_alts bndr srt alts2,
+      StgCase scrut2 live_in_whole_case live_in_alts bndr' srt alts2,
       (scrut_fvs `unionFVInfo` alts_fvs) 
 	  `minusFVBinders` [bndr],
       (alts_escs `unionVarSet` (getFVSet scrut_fvs))
diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index c5de5edc4dcd2acc13265c0342623e3b84567aa0..ad960de80041d5884d462ee6e279eb9c4af75907 100644
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -21,8 +21,10 @@ import CoreUtils	( coreExprType )
 import SimplUtils	( findDefault )
 import CostCentre	( noCCS )
 import Id		( Id, mkSysLocal, idType,
-			  externallyVisibleId, setIdUnique, idName
+			  externallyVisibleId, setIdUnique, idName, getIdDemandInfo
 			)
+import Var		( modifyIdInfo )
+import IdInfo		( setDemandInfo )
 import DataCon		( DataCon, dataConName, dataConId )
 import Name	        ( Name, nameModule, isLocallyDefinedName )
 import Module		( isDynamicModule )
@@ -32,6 +34,7 @@ import Const		( Con(..), isWHNFCon, Literal(..) )
 import PrimOp		( PrimOp(..) )
 import Type		( isUnLiftedType, isUnboxedTupleType, Type )
 import TysPrim		( intPrimTy )
+import Demand
 import Unique		( Unique, Uniquable(..) )
 import UniqSupply	-- all of it, really
 import Outputable
@@ -451,7 +454,7 @@ coreExprToStgFloat env expr@(Con con args)
 \begin{code}
 coreExprToStgFloat env expr@(Case scrut bndr alts)
   = coreExprToStgFloat env scrut		`thenUs` \ (binds, scrut') ->
-    newLocalId env bndr				`thenUs` \ (env', bndr') ->
+    newEvaldLocalId env bndr			`thenUs` \ (env', bndr') ->
     alts_to_stg env' (findDefault alts)		`thenUs` \ alts' ->
     returnUs (binds, mkStgCase scrut' bndr' alts')
   where
@@ -534,6 +537,18 @@ newLocalId env id
     in
     returnUs (new_env, id')
 
+-- we overload the demandInfo field of an Id to indicate whether the Id is definitely
+-- evaluated or not (i.e. whether it is a case binder).  This can be used to eliminate
+-- some redundant cases (c.f. dataToTag# above).
+
+newEvaldLocalId env id
+  = getUniqueUs			`thenUs` \ uniq ->
+    let
+      id'     = setIdUnique id uniq `modifyIdInfo` setDemandInfo wwStrict
+      new_env = extendVarEnv env id id'
+    in
+    returnUs (new_env, id')
+
 newLocalIds :: StgEnv -> [Id] -> UniqSM (StgEnv, [Id])
 newLocalIds env []
   = returnUs (env, [])
diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 9e9a79af8a7608ca3d9380ba701f9f2b69c89f75..c0f1c905314dee10b745b4ccdd62b7de7bec0cc6 100644
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -211,7 +211,7 @@ tcDeriving modname fixs rn_name_supply inst_decl_infos_in
 	-- Now augment the InstInfos, adding in the rather boring
 	-- actual-code-to-do-the-methods binds.  We may also need to
 	-- generate extra not-one-inst-decl-specific binds, notably
-	-- "con2tag" and/or "tag2con" functions.  We do these
+	-- the "con2tag" function.  We do these
 	-- separately.
 
     gen_taggery_Names new_inst_infos		`thenTc` \ nm_alist_etc ->
@@ -539,10 +539,6 @@ these is around is given by @hasCon2TagFun@.
 The examples under the different sections below will make this
 clearer.
 
-\item
-Much less often (really just for deriving @Ix@), we use a
-@_tag2con_<tycon>@ function.  See the examples.
-
 \item
 We use the renamer!!!  Reason: we're supposed to be
 producing @RenamedMonoBinds@ for the methods, but that means
@@ -605,7 +601,7 @@ gen_inst_info modname
 
 %************************************************************************
 %*									*
-\subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
+\subsection[TcDeriv-taggery-Names]{What con2tag functions are available?}
 %*									*
 %************************************************************************
 
@@ -613,7 +609,6 @@ gen_inst_info modname
 data Foo ... = ...
 
 con2tag_Foo :: Foo ... -> Int#
-tag2con_Foo :: Int -> Foo ...	-- easier if Int, not Int#
 maxtag_Foo  :: Int		-- ditto (NB: not unboxed)
 
 
@@ -627,14 +622,6 @@ Or: we're deriving @Ord@ (unless single-constructor), @Enum@, @Ix@
 (enum type only????)
 \end{itemize}
 
-We have a @tag2con@ function for a tycon if:
-\begin{itemize}
-\item
-We're deriving @Enum@, or @Ix@ (enum type only???)
-\end{itemize}
-
-If we have a @tag2con@ function, we also generate a @maxtag@ constant.
-
 \begin{code}
 gen_taggery_Names :: [InstInfo]
 		  -> TcM s [(RdrName,	-- for an assoc list
@@ -644,7 +631,7 @@ gen_taggery_Names :: [InstInfo]
 gen_taggery_Names inst_infos
   = --pprTrace "gen_taggery:\n" (vcat [hsep [ppr c, ppr t] | (c,t) <- all_CTs]) $
     foldlTc do_con2tag []           tycons_of_interest `thenTc` \ names_so_far ->
-    foldlTc do_tag2con names_so_far tycons_of_interest
+    foldlTc do_maxtag names_so_far tycons_of_interest
   where
     all_CTs = [ (c, get_tycon ty) | (InstInfo c _ [ty] _ _ _ _ _) <- inst_infos ]
 		    
@@ -667,12 +654,11 @@ gen_taggery_Names inst_infos
       | otherwise
       = returnTc acc_Names
 
-    do_tag2con acc_Names tycon
+    do_maxtag acc_Names tycon
       | isDataTyCon tycon &&
          (we_are_deriving enumClassKey tycon ||
 	  we_are_deriving ixClassKey   tycon)
-      = returnTc ( (tag2con_RDR tycon, tycon, GenTag2Con)
-		 : (maxtag_RDR  tycon, tycon, GenMaxTag)
+      = returnTc ( (maxtag_RDR  tycon, tycon, GenMaxTag)
 		 : acc_Names)
       | otherwise
       = returnTc acc_Names
diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index 77f3c4276b9ede60bae43080c0935a7ab288d095..39db2b4cc4b80f3e96728472f2a44f10ef6e2dc7 100644
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -1081,17 +1081,9 @@ gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
 	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)])
-  where
-    mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
-    mk_stuff var = ([lit_pat], HsVar var_RDR)
-      where
-	lit_pat = ConPatIn mkInt_RDR [LitPatIn (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG)))]
-	var_RDR  = qual_orig_name var
+  = mk_FunMonoBind (getSrcLoc tycon) rdr_name 
+	([([VarPatIn a_RDR], HsApp tagToEnum_Expr a_Expr)])
 
 gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
   = mk_easy_FunMonoBind (getSrcLoc tycon) 
@@ -1362,6 +1354,7 @@ false_Expr	= HsVar false_RDR
 true_Expr	= HsVar true_RDR
 
 getTag_Expr  	= HsVar getTag_RDR
+tagToEnum_Expr 	= HsVar tagToEnumH_RDR
 con2tag_Expr tycon = HsVar (con2tag_RDR tycon)
 
 a_Pat		= VarPatIn a_RDR
@@ -1369,7 +1362,7 @@ b_Pat		= VarPatIn b_RDR
 c_Pat		= VarPatIn c_RDR
 d_Pat		= VarPatIn d_RDR
 
-tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
+con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
 
 con2tag_RDR tycon = varUnqual (_PK_ ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
 tag2con_RDR tycon = varUnqual (_PK_ ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 149ca9d9ac063453155b676a03ed39f36cdc9efe..d9fbaa9f0bd2331c95273101ad0a1809994f2356 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -15,7 +15,7 @@ module Util (
 	zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
         zipLazy, stretchZipEqual,
 	mapAndUnzip, mapAndUnzip3,
-	nOfThem, lengthExceeds, isSingleton,
+	nOfThem, lengthExceeds, isSingleton, only,
 	snocView,
 	isIn, isn'tIn,
 
@@ -188,6 +188,13 @@ isSingleton :: [a] -> Bool
 
 isSingleton [x] = True
 isSingleton  _  = False
+
+only :: [a] -> a
+#ifdef DEBUG
+only [a] = a
+#else
+only (a:_) = a
+#endif
 \end{code}
 
 \begin{code}