X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=ba596e6f3c9709437abc8147c267ccb5a091a8a2;hp=8df6aa74448b1b3d6133b65779eeeb53631354c6;hb=95189f842024e33dbf1b3073c53e90ea0b94a97d;hpb=29e736b7089d535b53e3f02ef04d36331921e42a

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 8df6aa7..ba596e6 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -553,17 +553,15 @@ mkRecordSelId tycon field_label
     mk_alt data_con 
       = 	-- In the non-vanilla case, the pattern must bind type variables and
 		-- the context stuff; hence the arg_prefix binding below
-	  mkReboxingAlt uniqs data_con (arg_prefix ++ arg_ids) rhs
+	  mkReboxingAlt uniqs' data_con (arg_prefix ++ arg_ids) rhs
       where
-	-- TODO: this is *not* right; Orig vs Rep tys
 	(arg_prefix, arg_ids)
-	   | isVanillaDataCon data_con	 	-- Instantiate from commmon base
-	   = ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys))
-	   | otherwise		-- The case pattern binds type variables, which are used
-				-- in the types of the arguments of the pattern
 	   = (ex_tvs ++ co_tvs ++ dict_vs, field_vs)
 
-        (ex_tvs, co_tvs, arg_vs) = dataConOrigInstPat uniqs' data_con res_tys
+           -- get pattern binders with types appropriately instantiated
+        (ex_tvs, co_tvs, arg_vs) = dataConOrigInstPat uniqs data_con res_tys
+        n_vars = (length ex_tvs + length co_tvs + length arg_vs)
+           -- separate dicts vars and field vars so we can associate field lbls
         (dict_vs, field_vs) = splitAt (length dc_theta) arg_vs
 
 	(_, pre_dc_theta, dc_arg_tys) = dataConSig data_con
@@ -584,12 +582,8 @@ mkRecordSelId tycon field_label
         perform_co id_co expr = ASSERT(isIdCoercion id_co) expr
 
           -- split the uniq_list into two
-        uniqs  = takeHalf uniq_list
-        uniqs' = takeHalf (drop 1 uniq_list)
-
-        takeHalf [] = []
-        takeHalf (h:_:t) = h:(takeHalf t)  
-        takeHalf (h:t) = [h]
+        uniqs  = uniq_list
+        uniqs' = drop n_vars uniqs
 
     	the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` arg_ids) field_label
     	field_lbls  = dataConFieldLabels data_con