[project @ 2005-03-31 10:16:33 by simonmar]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 5ebfe58..9fd20a0 100644 (file)
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -22,7 +22,7 @@ module TcEnv(
        tcLookup, tcLookupLocated, tcLookupLocalIds,
        tcLookupId, tcLookupTyVar,
        lclEnvElts, getInLocalScope, findGlobals, 
-       wrongThingErr,
+       wrongThingErr, pprBinders,
 
        tcExtendRecEnv,         -- For knot-tying
 
@@ -47,12 +47,13 @@ module TcEnv(
 
 import HsSyn           ( LRuleDecl, LHsBinds, LSig, pprLHsBinds )
 import TcIface         ( tcImportDecl )
+import TcRnTypes       ( pprTcTyThingCategory )
 import TcRnMonad
 import TcMType         ( zonkTcType, zonkTcTyVarsAndFV )
 import TcType          ( Type, TcKind, TcTyVar, TcTyVarSet, TcType,
                          tyVarsOfType, tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
                          getDFunTyKey, tcTyConAppTyCon, tcGetTyVar, mkTyVarTy,
-                         tidyOpenType, pprTyThingCategory
+                         tidyOpenType 
                        )
 import qualified Type  ( getTyVar_maybe )
 import Id              ( idName, isLocalId )
@@ -344,13 +345,13 @@ find_thing ignore_it tidy_env (ATyVar tv ty)
     else let
        -- The name tv is scoped, so we don't need to tidy it
        (tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
-       msg = sep [ppr tv <+> eq_stuff, nest 2 bound_at]
+       msg = sep [ptext SLIT("Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
 
        eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty, 
-                  tv == tyVarName tv' = empty
+                  getOccName tv == getOccName tv' = empty
                 | otherwise = equals <+> ppr tidy_ty
                -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
-       bound_at = ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
+       bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
     in
     returnM (tidy_env1, Just msg)
 \end{code}
@@ -466,7 +467,7 @@ checkWellStaged pp_thing bind_lvl use_stage
 topIdLvl :: Id -> ThLevel
 -- Globals may either be imported, or may be from an earlier "chunk" 
 -- (separated by declaration splices) of this module.  The former
--- *can* be used inside a top-level splice, but the latter cannot.
+--  *can* be used inside a top-level splice, but the latter cannot.
 -- Hence we give the former impLevel, but the latter topLevel
 -- E.g. this is bad:
 --     x = [| foo |]
@@ -591,15 +592,17 @@ simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 %************************************************************************
 
 \begin{code}
+pprBinders :: [Name] -> SDoc
+-- Used in error messages
+-- Use quotes for a single one; they look a bit "busy" for several
+pprBinders [bndr] = quotes (ppr bndr)
+pprBinders bndrs  = pprWithCommas ppr bndrs
+
 notFound name 
   = failWithTc (ptext SLIT("GHC internal error:") <+> quotes (ppr name) <+> 
                ptext SLIT("is not in scope"))
 
 wrongThingErr expected thing name
-  = failWithTc (pp_thing thing <+> quotes (ppr name) <+> 
+  = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
                ptext SLIT("used as a") <+> text expected)
-  where
-    pp_thing (AGlobal thing) = pprTyThingCategory thing
-    pp_thing (ATyVar _ _)    = ptext SLIT("Type variable")
-    pp_thing (ATcId _ _ _)   = ptext SLIT("Local identifier")
 \end{code}