From 95189f842024e33dbf1b3073c53e90ea0b94a97d Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:15:40 +0000 Subject: [PATCH] Get rid of special case for Vanilla tycon record selectors and make uniq splitting more uniform Mon Sep 18 17:13:44 EDT 2006 Manuel M T Chakravarty * Get rid of special case for Vanilla tycon record selectors and make uniq splitting more uniform Sun Aug 6 20:48:06 EDT 2006 Manuel M T Chakravarty * Get rid of special case for Vanilla tycon record selectors and make uniq splitting more uniform Wed Aug 2 06:04:19 EDT 2006 kevind@bu.edu --- compiler/basicTypes/MkId.lhs | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) 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 -- 1.7.10.4