[project @ 2005-02-25 13:06:31 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 f01df31..a89ebf3 100644 (file)
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -9,7 +9,7 @@ module TcRnTypes(
        -- The environment types
        Env(..), 
        TcGblEnv(..), TcLclEnv(..), 
-       IfGblEnv(..), IfLclEnv(..),
+       IfGblEnv(..), IfLclEnv(..), 
 
        -- Ranamer types
        ErrCtxt,
@@ -20,7 +20,7 @@ module TcRnTypes(
        WhereFrom(..), mkModDeps,
 
        -- Typechecker types
-       TcTyThing(..), GadtRefinement,
+       TcTyThing(..), pprTcTyThingCategory, GadtRefinement,
 
        -- Template Haskell
        ThStage(..), topStage, topSpliceStage,
@@ -45,10 +45,10 @@ import HsSyn                ( PendingSplice, HsOverLit, LRuleDecl, LForeignDecl,
                          ArithSeqInfo, DictBinds, LHsBinds )
 import HscTypes                ( FixityEnv,
                          HscEnv, TypeEnv, TyThing, 
-                         GenAvailInfo(..), AvailInfo,
+                         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 )
 import InstEnv         ( DFunId, InstEnv )
@@ -129,6 +129,9 @@ data Env gbl lcl    -- Changes as we move into an expression
 data TcGblEnv
   = TcGblEnv {
        tcg_mod     :: Module,          -- Module being compiled
+       tcg_src     :: HscSource,       -- What kind of module 
+                                       -- (regular Haskell, hs-boot, ext-core)
+
        tcg_rdr_env :: GlobalRdrEnv,    -- Top level envt; used during renaming
        tcg_default :: Maybe [Type],    -- Types used for defaulting
                                        -- Nothing => no 'default' decl
@@ -232,6 +235,13 @@ data IfLclEnv
        -- it means M.f = \x -> x, where M is the if_mod
        if_mod :: Module,
 
+       -- The field is used only for error reporting
+       -- if (say) there's a Lint error in it
+       if_loc :: SDoc,
+               -- Where the interface came from:
+               --      .hi file, or GHCi state, or ext core
+               -- plus which bit is currently being examined
+
        if_tv_env  :: OccEnv TyVar,     -- Nested tyvar bindings
        if_id_env  :: OccEnv Id         -- Nested id binding
     }
@@ -399,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}