X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnTypes.lhs;h=33190e798768fc0c01be73acdc82ae3135a8ef79;hb=ff818166a0a06e77becad9e28ed116f3b7f5cc8b;hp=f01df31e5ad07cb0a4dd8f12c116b99fd72303cf;hpb=0ee11df0098509d06cf6fc03d1a18429985b6081;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index f01df31..33190e7 100644
--- 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,12 +45,12 @@ 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 )
+			  TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes, pprSkolInfo )
 import InstEnv		( DFunId, InstEnv )
 import IOEnv
 import RdrName		( GlobalRdrEnv, LocalRdrEnv )
@@ -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}
@@ -762,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
@@ -774,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}