From: simonpj@microsoft.com <unknown>
Date: Tue, 11 Sep 2007 08:50:05 +0000 (+0000)
Subject: Minor refactoring: give an explicit name to the pretty-printing function for TyThing... 
X-Git-Tag: 2007-09-25~104
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=deda0c55629600e886f47a5e90bad67953df1ad8

Minor refactoring: give an explicit name to the pretty-printing function for TyThing, and use it
---

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 34d4e02..43063be 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -908,16 +908,16 @@ lookupType dflags hpt pte name
 
 \begin{code}
 tyThingTyCon (ATyCon tc) = tc
-tyThingTyCon other	 = pprPanic "tyThingTyCon" (ppr other)
+tyThingTyCon other	 = pprPanic "tyThingTyCon" (pprTyThing other)
 
 tyThingClass (AClass cls) = cls
-tyThingClass other	  = pprPanic "tyThingClass" (ppr other)
+tyThingClass other	  = pprPanic "tyThingClass" (pprTyThing other)
 
 tyThingDataCon (ADataCon dc) = dc
-tyThingDataCon other	     = pprPanic "tyThingDataCon" (ppr other)
+tyThingDataCon other	     = pprPanic "tyThingDataCon" (pprTyThing other)
 
 tyThingId (AnId id) = id
-tyThingId other     = pprPanic "tyThingId" (ppr other)
+tyThingId other     = pprPanic "tyThingId" (pprTyThing other)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index ec2f5da..1e03afd 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -470,7 +470,7 @@ data RefinementVisibility
 					-- GADT refinement
 
 instance Outputable TcTyThing where	-- Debugging only
-   ppr (AGlobal g)      = ppr g
+   ppr (AGlobal g)      = pprTyThing g
    ppr elt@(ATcId {})   = text "Identifier" <> 
 			  ifPprDebug (brackets (ppr (tct_id elt) <> dcolon <> ppr (tct_type elt) <> comma
 				 <+> ppr (tct_level elt) <+> ppr (tct_co elt)))
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index b6b246b..c1e0544 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -105,7 +105,7 @@ module Type (
 	substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
 
 	-- Pretty-printing
-	pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll,
+	pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing, pprForAll,
 	pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
     ) where
 
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 1b2f56d..c694dc8 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -23,7 +23,7 @@ module TypeRep (
 
 	-- Pretty-printing
 	pprType, pprParendType, pprTypeApp,
-	pprTyThingCategory, 
+	pprTyThing, pprTyThingCategory, 
 	pprPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
 
 	-- Kinds
@@ -292,8 +292,11 @@ data TyThing = AnId     Id
 	     | ATyCon   TyCon
 	     | AClass   Class
 
-instance Outputable TyThing where
-  ppr thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
+instance Outputable TyThing where 
+  ppr = pprTyThing
+
+pprTyThing :: TyThing -> SDoc
+pprTyThing thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
 
 pprTyThingCategory :: TyThing -> SDoc
 pprTyThingCategory (ATyCon _) 	= ptext SLIT("Type constructor")