X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=46099590c67cdcf73aab965b456c0f98b96e9be8;hb=247fd64109002ed88c27bc5d6cfea6a71ee48cfa;hp=de8db07c6dac0d130407e7a79bc9f7a8f1bdb9fe;hpb=8912a05e1bcc30c7e8e5e017d9cf10176076f141;p=ghc-hetmet.git diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index de8db07..4609959 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -555,6 +555,7 @@ mkRecordSelId tycon field_label -- the context stuff; hence the arg_prefix binding below 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)) @@ -575,9 +576,9 @@ mkRecordSelId tycon field_label uniq_list = map mkBuiltinUnique [unpack_base..] Succeeded refinement = gadtRefine emptyRefinement ex_tvs co_tvs - (co_fn, out_ty) = refineType refinement (idType the_arg_id) + (co_fn, _) = refineType refinement (idType the_arg_id) - rhs = ASSERT(out_ty `coreEqType` field_tau) perform_co co_fn (Var the_arg_id) + rhs = perform_co co_fn (Var the_arg_id) perform_co (ExprCoFn co) expr = Cast expr co perform_co id_co expr = ASSERT(isIdCoercion id_co) expr