Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/d4c20a1b2c402d35b00b920c311f93b6396c6cf5 >--------------------------------------------------------------- commit d4c20a1b2c402d35b00b920c311f93b6396c6cf5 Author: Simon Marlow <[email protected]> Date: Thu Aug 18 15:32:22 2011 +0100 For the location on a record selector binding, use the location of the record selector identifier in the data declaration. Previously the location was pointing to the TyCon in the source, which was clearly wrong, and the new way gives more useful information from HPC: if a record selector is never used, the markup will shade the identifier yellow. >--------------------------------------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 14 +++++++------- 1 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 1e309b0..7d71b66 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1277,9 +1277,9 @@ mkRecSelBinds tycons mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name) mkRecSelBind (tycon, sel_name) - = (L loc (IdSig sel_id), unitBag (L loc sel_bind)) + = (L sel_loc (IdSig sel_id), unitBag (L sel_loc sel_bind)) where - loc = getSrcSpan tycon + sel_loc = getSrcSpan tycon sel_id = Var.mkExportedLocalVar rec_details sel_name sel_ty vanillaIdInfo rec_details = RecSelId { sel_tycon = tycon, sel_naughty = is_naughty } @@ -1307,15 +1307,15 @@ mkRecSelBind (tycon, sel_name) -- where cons_w_field = [C2,C7] sel_bind | is_naughty = mkTopFunBind sel_lname [mkSimpleMatch [] unit_rhs] | otherwise = mkTopFunBind sel_lname (map mk_match cons_w_field ++ deflt) - mk_match con = mkSimpleMatch [L loc (mk_sel_pat con)] - (L loc (HsVar field_var)) - mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields) + mk_match con = mkSimpleMatch [noLoc (mk_sel_pat con)] + (noLoc (HsVar field_var)) + mk_sel_pat con = ConPatIn (noLoc (getName con)) (RecCon rec_fields) rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = HsRecField { hsRecFieldId = sel_lname , hsRecFieldArg = nlVarPat field_var , hsRecPun = False } - sel_lname = L loc sel_name - field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc + sel_lname = L sel_loc sel_name + field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) sel_loc -- Add catch-all default case unless the case is exhaustive -- We do this explicitly so that we get a nice error message that _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
