X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcEnv.lhs;h=9fd20a04024fbc42f7cfea4af077b0a61b6eae25;hb=853e20a3eb86137cdb8accf69c6caa9db83a3d34;hp=5ebfe58da7bb4fcd625ebad131df5d3de3ef6a58;hpb=ac80e0dececb68ed6385e3b34765fd8f9c019767;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 5ebfe58..9fd20a0 100644
--- 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}