Commit 0ccf2c3b authored by Simon Peyton Jones's avatar Simon Peyton Jones

Some minor wibbling in printing source locations

I found that an imported instance was getting printed with <no
location info>.  Fixing this pushed me into a bit more refactoring
than I intended, but it's all small aesthetic stuff, nothing
fundamental.  Caused some error message to change as a result.

I removed pprDefnLoc from the GHC API because it doesn't seem to be
used.  Name.pprNamedefnLoc and pprDefinedAt are probably more useful
anyway.
parent faadd61e
......@@ -37,7 +37,8 @@ module Name (
BuiltInSyntax(..),
-- ** Creating 'Name's
mkInternalName, mkSystemName, mkDerivedInternalName,
mkSystemName, mkSystemNameAt,
mkInternalName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
mkTickBoxOpName,
......@@ -50,7 +51,7 @@ module Name (
hashName, localiseName,
mkLocalisedOccName,
nameSrcLoc, nameSrcSpan, pprNameLoc,
nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
-- ** Predicates on 'Name's
isSystemName, isInternalName, isExternalName,
......@@ -278,8 +279,11 @@ mkWiredInName mod occ uniq thing built_in
-- | Create a name brought into being by the compiler
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKeyFastInt uniq, n_sort = System,
n_occ = occ, n_loc = noSrcSpan }
mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan
mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
mkSystemNameAt uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = System
, n_occ = occ, n_loc = loc }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
......@@ -519,15 +523,23 @@ ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
-- Prints (if mod information is available) "Defined at <loc>" or
-- "Defined in <mod>" information for a Name.
pprNameLoc :: Name -> SDoc
pprNameLoc name = case nameSrcSpan name of
RealSrcSpan s ->
pprDefnLoc s
UnhelpfulSpan _
| isInternalName name || isSystemName name ->
ptext (sLit "<no location info>")
| otherwise ->
ptext (sLit "Defined in ") <> ppr (nameModule name)
pprDefinedAt :: Name -> SDoc
pprDefinedAt name = ptext (sLit "Defined") <+> pprNameDefnLoc name
pprNameDefnLoc :: Name -> SDoc
-- Prints "at <loc>" or
-- or "in <mod>" depending on what info is available
pprNameDefnLoc name
= case nameSrcLoc name of
-- nameSrcLoc rather than nameSrcSpan
-- It seems less cluttered to show a location
-- rather than a span for the definition point
RealSrcLoc s -> ptext (sLit "at") <+> ppr s
UnhelpfulLoc s
| isInternalName name || isSystemName name
-> ptext (sLit "at") <+> ftext s
| otherwise
-> ptext (sLit "in") <+> quotes (ppr (nameModule name))
\end{code}
%************************************************************************
......
......@@ -31,9 +31,6 @@ module SrcLoc (
srcLocLine, -- return the line part
srcLocCol, -- return the column part
-- ** Misc. operations on SrcLoc
pprDefnLoc,
-- * SrcSpan
RealSrcSpan, -- Abstract
SrcSpan(..),
......@@ -481,10 +478,6 @@ pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
pprUserRealSpan show_path (SrcSpanPoint src_path line col)
= hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
, int line, char ':', int col ]
pprDefnLoc :: RealSrcSpan -> SDoc
-- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
pprDefnLoc loc = ptext (sLit "Defined at") <+> ppr loc
\end{code}
%************************************************************************
......
......@@ -188,7 +188,7 @@ module GHC (
compareFixity,
-- ** Source locations
SrcLoc(..), RealSrcLoc, pprDefnLoc,
SrcLoc(..), RealSrcLoc,
mkSrcLoc, noSrcLoc,
srcLocFile, srcLocLine, srcLocCol,
SrcSpan(..), RealSrcSpan,
......
......@@ -57,8 +57,7 @@ showSub_maybe (n:ns) thing = if n == getName thing then Just ns
-- | Pretty-prints a 'TyThing' with its defining location.
pprTyThingLoc :: PrintExplicitForalls -> TyThing -> SDoc
pprTyThingLoc pefas tyThing
= showWithLoc loc (pprTyThing pefas tyThing)
where loc = pprNameLoc (GHC.getName tyThing)
= showWithLoc (pprDefinedAt (GHC.getName tyThing)) (pprTyThing pefas tyThing)
-- | Pretty-prints a 'TyThing'.
pprTyThing :: PrintExplicitForalls -> TyThing -> SDoc
......@@ -79,7 +78,7 @@ pprTyThingInContext pefas thing
-- | Like 'pprTyThingInContext', but adds the defining location.
pprTyThingInContextLoc :: PrintExplicitForalls -> TyThing -> SDoc
pprTyThingInContextLoc pefas tyThing
= showWithLoc (pprNameLoc (GHC.getName tyThing))
= showWithLoc (pprDefinedAt (GHC.getName tyThing))
(pprTyThingInContext pefas tyThing)
-- | Pretty-prints the 'TyThing' header. For functions and data constructors
......
......@@ -85,7 +85,7 @@ pprFamInst :: FamInst -> SDoc
pprFamInst famInst
= hang (pprFamInstHdr famInst)
2 (vcat [ ifPprDebug (ptext (sLit "Coercion axiom:") <+> pp_ax)
, ptext (sLit "--") <+> pprNameLoc (getName famInst)])
, ptext (sLit "--") <+> pprDefinedAt (getName famInst)])
where
pp_ax = case tyConFamilyCoercion_maybe (fi_tycon famInst) of
Just ax -> ppr ax
......
......@@ -309,8 +309,8 @@ improveFromInstEnv inst_env pred@(ClassP cls tys, _)
, not (instanceCantMatch inst_tcs trimmed_tcs)
, let p_inst = (mkClassPred cls tys_inst,
sep [ ptext (sLit "arising from the dependency") <+> quotes (pprFunDep fd)
, ptext (sLit "in the instance declaration at")
<+> ppr (getSrcLoc ispec)])
, ptext (sLit "in the instance declaration")
<+> pprNameDefnLoc (getName ispec)])
, (qtvs, eqs) <- checkClsFD qtvs fd cls_tvs tys_inst tys -- NB: orientation
, not (null eqs)
]
......
......@@ -145,7 +145,7 @@ pprInstance :: Instance -> SDoc
-- Prints the Instance as an instance declaration
pprInstance ispec
= hang (pprInstanceHdr ispec)
2 (ptext (sLit "--") <+> pprNameLoc (getName ispec))
2 (ptext (sLit "--") <+> pprDefinedAt (getName ispec))
-- * pprInstanceHdr is used in VStudio to populate the ClassView tree
pprInstanceHdr :: Instance -> SDoc
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment