[project @ 2004-09-02 15:18:34 by simonpj]

Make error messages consistent

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 0269678..50b39fe 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -358,11 +358,11 @@ setOccNameSpace :: NameSpace -> OccName -> OccName
 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 
 -- occNameFlavour is used only to generate good error messages
-occNameFlavour :: OccName -> String
-occNameFlavour (OccName DataName _)  = "data constructor"
-occNameFlavour (OccName TvName _)    = "type variable"
-occNameFlavour (OccName TcClsName _) = "type constructor or class"
-occNameFlavour (OccName VarName s)   = ""
+occNameFlavour :: OccName -> SDoc
+occNameFlavour (OccName DataName _)  = ptext SLIT("data constructor")
+occNameFlavour (OccName TvName _)    = ptext SLIT("type variable")
+occNameFlavour (OccName TcClsName _) = ptext SLIT("type constructor or class")
+occNameFlavour (OccName VarName s)   = empty
 
 -- briefOccNameFlavour is used in debug-printing of names
 briefOccNameFlavour :: OccName -> String

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index 82cabf6..a4e34d4 100644 (file)
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -210,7 +210,7 @@ instance Outputable RdrName where
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 
-ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
+ppr_name_space occ = ifPprDebug (parens (occNameFlavour occ))
 
 instance OutputableBndr RdrName where
     pprBndr _ n 

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 14957f9..c9e48cb 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -705,7 +705,9 @@ warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 
 warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
 warnUnusedName (name, prov)
-  = addWarnAt loc (sep [msg <> colon, nest 4 (ppr name)])
+  = addWarnAt loc $
+    sep [msg <> colon, 
+        nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
        -- TODO should be a proper span
   where
     (loc,msg) = case prov of
@@ -735,13 +737,9 @@ shadowedNameWarn doc shadow
               ptext SLIT("shadows an existing binding")]
     $$ doc
 
-unknownNameErr name
+unknownNameErr rdr_name
   = sep [ptext SLIT("Not in scope:"), 
-        if isVarOcc occ_name then quotes (ppr name)
-                             else text (occNameFlavour occ_name) 
-                                       <+> quotes (ppr name)]
-  where
-    occ_name = rdrNameOcc name
+        nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
 
 unknownInstBndrErr cls op
   = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 6781ee7..396aba9 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -740,7 +740,7 @@ reportDeprecations tcg_env
       ,        Just deprec_txt <- lookupDeprec hpt pit name
       = addSrcSpan (is_loc imp_spec) $
        addWarn (sep [ptext SLIT("Deprecated use of") <+> 
-                       text (occNameFlavour (nameOccName name)) <+> 
+                       occNameFlavour (nameOccName name) <+> 
                        quotes (ppr name),
                      (parens imp_msg),
                      (ppr deprec_txt) ])