Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7897623599db0a2b0e9b8870fdb8b2401396b3a9 >--------------------------------------------------------------- commit 7897623599db0a2b0e9b8870fdb8b2401396b3a9 Author: Simon Peyton Jones <[email protected]> Date: Tue Aug 2 17:29:16 2011 +0100 Improve pretty-printing for ambiguous imports etc >--------------------------------------------------------------- compiler/basicTypes/RdrName.lhs | 31 +++++++++++++++++++++---------- compiler/rename/RnNames.lhs | 5 +++-- 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 096c866..8250998 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -671,25 +671,36 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef}) = ptext (sLit "defined at") <+> ppr (nameSrcLoc name) pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys}) = case whys of - (why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))] + (why:_) -> sep [ppr why, ppr_defn_site why name] [] -> panic "pprNameProvenance" -- If we know the exact definition point (which we may do with GHCi) -- then show that too. But not if it's just "imported from X". -ppr_defn :: SrcLoc -> SDoc -ppr_defn (RealSrcLoc loc) = parens (ptext (sLit "defined at") <+> ppr loc) -ppr_defn (UnhelpfulLoc _) = empty +ppr_defn_site :: ImportSpec -> Name -> SDoc +ppr_defn_site imp_spec name + | same_module && not (isGoodSrcSpan loc) + = empty -- Nothing interesting to say + | otherwise + = parens $ hang (ptext (sLit "and originally defined") <+> pp_mod) + 2 (pprLoc loc) + where + loc = nameSrcSpan name + defining_mod = nameModule name + same_module = importSpecModule imp_spec == moduleName defining_mod + pp_mod | same_module = empty + | otherwise = ptext (sLit "in") <+> quotes (ppr defining_mod) + instance Outputable ImportSpec where ppr imp_spec = ptext (sLit "imported") <+> qual - <+> ptext (sLit "from") <+> ppr (importSpecModule imp_spec) - <+> pprLoc + <+> ptext (sLit "from") <+> quotes (ppr (importSpecModule imp_spec)) + <+> pprLoc (importSpecLoc imp_spec) where qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified") | otherwise = empty - loc = importSpecLoc imp_spec - pprLoc = case loc of - RealSrcSpan s -> ptext (sLit "at") <+> ppr s - UnhelpfulSpan _ -> empty + +pprLoc :: SrcSpan -> SDoc +pprLoc (RealSrcSpan s) = ptext (sLit "at") <+> ppr s +pprLoc (UnhelpfulSpan {}) = empty \end{code} diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index c28c5c7..0d7e52f 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -1674,8 +1674,9 @@ exportClashErr global_env name1 name2 ie1 ie2 , ppr_export ie2' name2' ] where occ = nameOccName name1 - ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext (sLit "exports") <+> - quotes (ppr name) <+> pprNameProvenance (get_gre name)) + ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> ptext (sLit "exports") <+> + quotes (ppr name)) + 2 (pprNameProvenance (get_gre name))) -- get_gre finds a GRE for the Name, so that we can show its provenance get_gre name _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
