Some minor wibbling in printing source locations
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 2 Sep 2011 08:25:25 +0000 (09:25 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 2 Sep 2011 08:25:25 +0000 (09:25 +0100)
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.

compiler/basicTypes/Name.lhs
compiler/basicTypes/SrcLoc.lhs
compiler/main/GHC.hs
compiler/main/PprTyThing.hs
compiler/types/FamInstEnv.lhs
compiler/types/FunDeps.lhs
compiler/types/InstEnv.lhs

index c82a06c..94ad72d 100644 (file)
@@ -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}
 
 %************************************************************************
index f15d0da..b89d55e 100644 (file)
@@ -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}
 
 %************************************************************************
index 0042d87..bd7baa1 100644 (file)
@@ -188,7 +188,7 @@ module GHC (
        compareFixity,
 
        -- ** Source locations
-       SrcLoc(..), RealSrcLoc, pprDefnLoc,
+       SrcLoc(..), RealSrcLoc, 
         mkSrcLoc, noSrcLoc,
        srcLocFile, srcLocLine, srcLocCol,
         SrcSpan(..), RealSrcSpan,
index d97fd96..7e2a98b 100644 (file)
@@ -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
index 5b4374a..41ddffe 100644 (file)
@@ -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
index f1c9347..cb29c6b 100644 (file)
@@ -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)
     ]
index bfae8b3..dd70be8 100644 (file)
@@ -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