[project @ 2005-03-01 21:40:40 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index 063017e..33190e7 100644 (file)
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -20,7 +20,7 @@ module TcRnTypes(
        WhereFrom(..), mkModDeps,
 
        -- Typechecker types
-       TcTyThing(..), GadtRefinement,
+       TcTyThing(..), pprTcTyThingCategory, GadtRefinement,
 
        -- Template Haskell
        ThStage(..), topStage, topSpliceStage,
@@ -48,9 +48,9 @@ import HscTypes               ( FixityEnv,
                          GenAvailInfo(..), AvailInfo, HscSource(..),
                          availName, IsBootInterface, Deprecations )
 import Packages                ( PackageId )
-import Type            ( Type, TvSubstEnv, pprParendType )
+import Type            ( Type, TvSubstEnv, pprParendType, pprTyThingCategory )
 import TcType          ( TcTyVarSet, TcType, TcTauType, TcThetaType, SkolemInfo,
-                         TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes )
+                         TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes, pprSkolInfo )
 import InstEnv         ( DFunId, InstEnv )
 import IOEnv
 import RdrName         ( GlobalRdrEnv, LocalRdrEnv )
@@ -409,10 +409,17 @@ data TcTyThing
                                        --      tycons and clases in this recursive group
 
 instance Outputable TcTyThing where    -- Debugging only
-   ppr (AGlobal g)      = text "AGlobal" <+> ppr g
-   ppr (ATcId g tl pl)  = text "ATcId" <+> ppr g <+> ppr tl <+> ppr pl
-   ppr (ATyVar tv ty)   = text "ATyVar" <+> ppr tv <+> pprParendType ty
+   ppr (AGlobal g)      = ppr g
+   ppr (ATcId g tl pl)  = text "Identifier" <> 
+                         ifPprDebug (brackets (ppr g <> comma <> ppr tl <> comma <> ppr pl))
+   ppr (ATyVar tv ty)   = text "Type variable" <+> quotes (ppr tv) <+> pprParendType ty
    ppr (AThing k)       = text "AThing" <+> ppr k
+
+pprTcTyThingCategory :: TcTyThing -> SDoc
+pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
+pprTcTyThingCategory (ATyVar _ _)    = ptext SLIT("Type variable")
+pprTcTyThingCategory (ATcId _ _ _)   = ptext SLIT("Local identifier")
+pprTcTyThingCategory (AThing _)             = ptext SLIT("Kinded thing")
 \end{code}
 
 \begin{code}
@@ -772,8 +779,6 @@ data InstOrigin
 
 \begin{code}
 pprInstLoc :: InstLoc -> SDoc
-pprInstLoc (InstLoc (SigOrigin info) locn _) 
-  = text "arising from" <+> ppr info   -- I don't think this happens much, if at all
 pprInstLoc (InstLoc orig locn _)
   = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
   where
@@ -784,11 +789,11 @@ pprInstLoc (InstLoc orig locn _)
     pp_orig (LiteralOrigin lit)         = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
     pp_orig (ArithSeqOrigin seq) = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
     pp_orig (PArrSeqOrigin seq)         = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
-    pp_orig InstSigOrigin       =  ptext SLIT("instantiating a type signature")
-    pp_orig InstScOrigin        =  ptext SLIT("the superclasses of an instance declaration")
+    pp_orig InstSigOrigin       = ptext SLIT("instantiating a type signature")
+    pp_orig InstScOrigin        = ptext SLIT("the superclasses of an instance declaration")
     pp_orig DerivOrigin                 = ptext SLIT("the 'deriving' clause of a data type declaration")
     pp_orig DefaultOrigin       = ptext SLIT("a 'default' declaration")
-    pp_orig DoOrigin            =  ptext SLIT("a do statement")
-    pp_orig ProcOrigin          =  ptext SLIT("a proc expression")
-    pp_orig (SigOrigin info)    = ppr info
+    pp_orig DoOrigin            = ptext SLIT("a do statement")
+    pp_orig ProcOrigin          = ptext SLIT("a proc expression")
+    pp_orig (SigOrigin info)    = pprSkolInfo info
 \end{code}