X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FMkId.lhs;h=9d93a67008ce2538dfba1014c5bf95f2529d9738;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=4ff6a0cce1542c493fa7e00daf5b334bb0114f59;hpb=36436bc62a98f53e126ec02fe946337c4c766c3f;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 4ff6a0c..9d93a67 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -59,7 +59,7 @@ import Class		( Class, classTyCon, classSelIds )
 import Var		( Id, TyVar, Var )
 import VarSet		( isEmptyVarSet, subVarSet, varSetElems )
 import Name		( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..) )
-import OccName		( mkOccFS, varName )
+import OccName		( mkOccNameFS, varName )
 import PrimOp		( PrimOp, primOpSig, primOpOcc, primOpTag )
 import ForeignCall	( ForeignCall )
 import DataCon		( DataCon, DataConIds(..), dataConTyVars,
@@ -537,14 +537,15 @@ mkRecordSelId tycon field_label
 	(arg_prefix, arg_ids)
 	   | isVanillaDataCon data_con	 	-- Instantiate from commmon base
 	   = ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys))
-	   | otherwise
+	   | otherwise		-- The case pattern binds type variables, which are used
+				-- in the types of the arguments of the pattern
 	   = (dc_tyvars ++ mkTemplateLocalsNum arg_base (mkPredTys dc_theta),
 	      mkTemplateLocalsNum arg_base' dc_arg_tys)
 
 	(dc_tyvars, dc_theta, dc_arg_tys, _, _) = dataConSig data_con
 	arg_base' = arg_base + length dc_theta
 
-	unpack_base = arg_base' + length dc_theta
+	unpack_base = arg_base' + length dc_arg_tys
 	uniqs = map mkBuiltinUnique [unpack_base..]
 
     	the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` arg_ids) field_label
@@ -846,7 +847,7 @@ another gun with which to shoot yourself in the foot.
 
 \begin{code}
 mkWiredInIdName mod fs uniq id
- = mkWiredInName mod (mkOccFS varName fs) uniq Nothing (AnId id) UserSyntax
+ = mkWiredInName mod (mkOccNameFS varName fs) uniq Nothing (AnId id) UserSyntax
 
 unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
 nullAddrName     = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#")	   nullAddrIdKey      nullAddrId