X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=d94ecd7334f6a061f1d81c104d401d2676ad3565;hp=40f6a8d720d9856ea37acf865fd43630e405aa28;hb=HEAD;hpb=9591547fbbdf12728884e125f8ba08b0e6e69f82;ds=sidebyside

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 40f6a8d..d94ecd7 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -42,7 +42,7 @@ module TcRnTypes(
 	CtOrigin(..), EqOrigin(..), 
         WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt,
 
-        SkolemInfo(..),
+	SkolemInfo(..),
 
         CtFlavor(..), pprFlavorArising, isWanted, 
         isGivenOrSolved, isGiven_maybe,
@@ -64,6 +64,7 @@ module TcRnTypes(
 import HsSyn
 import HscTypes
 import Type
+import Id	( evVarPred )
 import Class    ( Class )
 import DataCon  ( DataCon, dataConUserType )
 import TcType
@@ -326,6 +327,7 @@ data IfLclEnv
 		-- plus which bit is currently being examined
 
 	if_tv_env  :: UniqFM TyVar,	-- Nested tyvar bindings
+		      	     		-- (and coercions)
 	if_id_env  :: UniqFM Id		-- Nested id binding
     }
 \end{code}
@@ -375,6 +377,7 @@ data TcLclEnv		-- Changes as we move inside an expression
 		-- We still need the unsullied global name env so that
     		--   we can look up record field names
 
+        tcl_hetMetLevel  :: [TyVar],    -- The current environment classifier level (list-of-names)
 	tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
 			          -- TyVars defined in this module
 					
@@ -511,7 +514,9 @@ data TcTyThing
 
   | ATcId   {		-- Ids defined in this module; may not be fully zonked
 	tct_id    :: TcId,		
-	tct_level :: ThLevel }
+	tct_level :: ThLevel,
+	tct_hetMetLevel :: [TyVar]
+    }
 
   | ATyVar  Name TcType		-- The type to which the lexically scoped type vaiable
 				-- is currently refined. We only need the Name
@@ -526,7 +531,8 @@ instance Outputable TcTyThing where	-- Debugging only
    ppr elt@(ATcId {})   = text "Identifier" <> 
 			  brackets (ppr (tct_id elt) <> dcolon 
                                  <> ppr (varType (tct_id elt)) <> comma
-				 <+> ppr (tct_level elt))
+				 <+> ppr (tct_level elt)
+				 <+> ppr (tct_hetMetLevel elt))
    ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
    ppr (AThing k)       = text "AThing" <+> ppr k
 
@@ -676,7 +682,6 @@ instance Outputable WhereFrom where
 %************************************************************************
 %*									*
 		Wanted constraints
-
      These are forced to be in TcRnTypes because
      	   TcLclEnv mentions WantedConstraints
 	   WantedConstraint mentions CtLoc
@@ -903,7 +908,7 @@ pprEvVarTheta :: [EvVar] -> SDoc
 pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
                               
 pprEvVarWithType :: EvVar -> SDoc
-pprEvVarWithType v = ppr v <+> dcolon <+> pprPred (evVarPred v)
+pprEvVarWithType v = ppr v <+> dcolon <+> pprPredTy (evVarPred v)
 
 pprWantedsWithLocs :: WantedConstraints -> SDoc
 pprWantedsWithLocs wcs