X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FMkId.lhs;h=dae32dfeb5d14f9e4b6de22fefcc53fd6d60d2e8;hb=5cf73eab6ec5df0abe330e107cbe969d41e38d30;hp=c2809e3e9fb85a3b3eb0ae82588f9e7c86bdcf65;hpb=a4a632f53f22c4cff2c7cc6171c94da5dc2a2530;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index c2809e3..dae32df 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -456,9 +456,12 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
 	    	    body 	      = mkVarApps (mkVarApps (Var the_arg_id) field_tyvars) field_dict_ids
 	    	    strict_marks      = dataConStrictMarks data_con
 	    	    (expr, real_args) = rebuildConArgs data_con arg_ids strict_marks body
-						       (length arg_ids + 1)
+						       unpack_base
 	where
             arg_ids = mkTemplateLocalsNum field_base (dataConInstOrigArgTys data_con tyvar_tys)
+
+	    unpack_base = field_base + length arg_ids
+
 				-- arity+1 avoids all shadowing
     	    maybe_the_arg_id  = assocMaybe (field_lbls `zip` arg_ids) field_label
     	    field_lbls	      = dataConFieldLabels data_con