X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMType.lhs;h=e2381b6f72c51e91e9e121c36e814036819332f7;hp=4a125364758d2ed2ca9b32efc2654ed4698d939c;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hpb=f4510d27c5883fe7e8570f4dd49d45a8b0122f2c

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 4a12536..e2381b6 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -47,7 +47,8 @@ module TcMType (
   --------------------------------
   -- Zonking
   zonkType, zonkTcPredType, 
-  zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkQuantifiedTyVar,
+  zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, 
+  zonkQuantifiedTyVar, zonkQuantifiedTyVars,
   zonkTcType, zonkTcTypes, zonkTcClassConstraints, zonkTcThetaType,
   zonkTcKindToKind, zonkTcKind, zonkTopTyVar,
 
@@ -61,7 +62,6 @@ module TcMType (
 import TypeRep
 import TcType
 import Type
-import Type
 import Coercion
 import Class
 import TyCon
@@ -359,7 +359,7 @@ data LookupTyVarResult	-- The result of a lookupTcTyVar call
 
 lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult
 lookupTcTyVar tyvar 
-  = ASSERT( isTcTyVar tyvar )
+  = ASSERT2( isTcTyVar tyvar, ppr tyvar )
     case details of
       SkolemTv _   -> return (DoneTv details)
       MetaTv _ ref -> do { meta_details <- readMutVar ref
@@ -484,17 +484,24 @@ zonkTopTyVar tv
     k = tyVarKind tv
     default_k = defaultKind k
 
+zonkQuantifiedTyVars :: [TcTyVar] -> TcM [TyVar]
+zonkQuantifiedTyVars = mappM zonkQuantifiedTyVar
+
 zonkQuantifiedTyVar :: TcTyVar -> TcM TyVar
 -- zonkQuantifiedTyVar is applied to the a TcTyVar when quantifying over it.
--- It might be a meta TyVar, in which case we freeze it into an ordinary TyVar.
--- When we do this, we also default the kind -- see notes with Kind.defaultKind
+--
+-- The quantified type variables often include meta type variables
+-- we want to freeze them into ordinary type variables, and
+-- default their kind (e.g. from OpenTypeKind to TypeKind)
+-- 			-- see notes with Kind.defaultKind
 -- The meta tyvar is updated to point to the new regular TyVar.  Now any 
 -- bound occurences of the original type variable will get zonked to 
 -- the immutable version.
 --
 -- We leave skolem TyVars alone; they are immutable.
 zonkQuantifiedTyVar tv
-  | isSkolemTyVar tv = return tv
+  | ASSERT( isTcTyVar tv ) 
+    isSkolemTyVar tv = return tv
 	-- It might be a skolem type variable, 
 	-- for example from a user type signature
 
@@ -917,14 +924,14 @@ check_valid_theta ctxt theta
 
 -------------------------
 check_pred_ty dflags ctxt pred@(ClassP cls tys)
-  = 	-- Class predicates are valid in all contexts
-    checkTc (arity == n_tys) arity_err		`thenM_`
-
-	-- Check the form of the argument types
-    mappM_ check_arg_type tys				`thenM_`
-    checkTc (check_class_pred_tys dflags ctxt tys)
-	    (predTyVarErr pred $$ how_to_allow)
-
+  = do {	-- Class predicates are valid in all contexts
+       ; checkTc (arity == n_tys) arity_err
+
+		-- Check the form of the argument types
+       ; mappM_ check_arg_type tys
+       ; checkTc (check_class_pred_tys dflags ctxt tys)
+		 (predTyVarErr pred $$ how_to_allow)
+       }
   where
     class_name = className cls
     arity      = classArity cls
@@ -932,10 +939,23 @@ check_pred_ty dflags ctxt pred@(ClassP cls tys)
     arity_err  = arityErr "Class" class_name arity n_tys
     how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this"))
 
+check_pred_ty dflags ctxt pred@(EqPred ty1 ty2)
+  = do {	-- Equational constraints are valid in all contexts if indexed
+		-- types are permitted
+       ; checkTc (dopt Opt_IndexedTypes dflags) (eqPredTyErr pred)
+
+		-- Check the form of the argument types
+       ; check_eq_arg_type ty1
+       ; check_eq_arg_type ty2
+       }
+  where 
+    check_eq_arg_type = check_poly_type (Rank 0) UT_NotOk
+
 check_pred_ty dflags SigmaCtxt (IParam _ ty) = check_arg_type ty
-	-- Implicit parameters only allows in type
+	-- Implicit parameters only allowed in type
 	-- signatures; not in instance decls, superclasses etc
-	-- The reason for not allowing implicit params in instances is a bit subtle
+	-- The reason for not allowing implicit params in instances is a bit
+	-- subtle.
 	-- If we allowed	instance (?x::Int, Eq a) => Foo [a] where ...
 	-- then when we saw (e :: (?x::Int) => t) it would be unclear how to 
 	-- discharge all the potential usas of the ?x in e.   For example, a
@@ -1050,6 +1070,9 @@ checkThetaCtxt ctxt theta
 	  ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ]
 
 badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
+eqPredTyErr  sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty
+		   $$
+		   parens (ptext SLIT("Use -findexed-types to permit this"))
 predTyVarErr pred  = sep [ptext SLIT("Non type-variable argument"),
 			  nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
 dupPredWarn dups   = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
@@ -1146,7 +1169,7 @@ checkValidInstance tyvars theta clas inst_tys
 	-- Check that instance inference will terminate (if we care)
 	-- For Haskell 98, checkValidTheta has already done that
 	; when (gla_exts && not undecidable_ok) $
-	  mapM_ failWithTc (checkInstTermination inst_tys theta)
+	  mapM_ addErrTc (checkInstTermination inst_tys theta)
 	
 	-- The Coverage Condition
 	; checkTc (undecidable_ok || checkInstCoverage clas inst_tys)