X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=95d8deb964b590403e3cce26edff420a85b4a41c;hb=a162b85d26966ba0eecc4d2ae02d4fd71f5cb9f8;hp=636ee0ea696c012a1822aa3323ea2efafc3dea38;hpb=b279a3fc517ee355844223758ef026e108535e57;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 636ee0e..95d8deb 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -165,6 +165,7 @@ import Util
 import Maybes
 import ListSetOps
 import Outputable
+import FastString
 
 import Data.List
 import Data.IORef
@@ -670,9 +671,7 @@ tcSplitPhiTy ty = split ty ty []
   split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
 
   split orig_ty (ForAllTy tv ty) ts
-        | isCoVar tv = split ty ty (eq_pred:ts)
-        where
-           PredTy eq_pred = tyVarKind tv
+        | isCoVar tv = split ty ty (coVarPred tv : ts)
   split orig_ty (FunTy arg res) ts 
 	| Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
   split orig_ty ty		ts = (reverse ts, orig_ty)
@@ -814,7 +813,6 @@ tcInstHeadTyNotSynonym :: Type -> Bool
 -- are transparent, so we need a special function here
 tcInstHeadTyNotSynonym ty
   = case ty of
-        NoteTy _ ty     -> tcInstHeadTyNotSynonym ty
         TyConApp tc tys -> not (isSynTyCon tc)
         _ -> True
 
@@ -823,7 +821,6 @@ tcInstHeadTyAppAllTyVars :: Type -> Bool
 -- These must be a constructor applied to type variable arguments
 tcInstHeadTyAppAllTyVars ty
   = case ty of
-	NoteTy _ ty     -> tcInstHeadTyAppAllTyVars ty
 	TyConApp _ tys  -> ok tys
 	FunTy arg res   -> ok [arg, res]
 	other		-> False
@@ -834,7 +831,6 @@ tcInstHeadTyAppAllTyVars ty
 	   where
 	     tvs = mapCatMaybes get_tv tys
 
-    get_tv (NoteTy _ ty) = get_tv ty 	-- Again, do not look
     get_tv (TyVarTy tv)  = Just tv	-- through synonyms
     get_tv other  	 = Nothing
 \end{code}
@@ -1022,7 +1018,6 @@ tcTyVarsOfType :: Type -> TcTyVarSet
 tcTyVarsOfType (TyVarTy tv)	    = if isTcTyVar tv then unitVarSet tv
 						      else emptyVarSet
 tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys
-tcTyVarsOfType (NoteTy _ ty)	    = tcTyVarsOfType ty
 tcTyVarsOfType (PredTy sty)	    = tcTyVarsOfPred sty
 tcTyVarsOfType (FunTy arg res)	    = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
 tcTyVarsOfType (AppTy fun arg)	    = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
@@ -1062,6 +1057,15 @@ exactTyVarsOfType is used by the type checker to figure out exactly
 which type variables are mentioned in a type.  It's also used in the
 smart-app checking code --- see TcExpr.tcIdApp
 
+On the other hand, consider a *top-level* definition
+	f = (\x -> x) :: T a -> T a
+If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
+if we have an application like (f "x") we get a confusing error message 
+involving Any.  So the conclusion is this: when generalising
+  - at top level use tyVarsOfType
+  - in nested bindings use exactTyVarsOfType
+See Trac #1813 for example.
+
 \begin{code}
 exactTyVarsOfType :: TcType -> TyVarSet
 -- Find the free type variables (of any kind)
@@ -1077,7 +1081,6 @@ exactTyVarsOfType ty
     go (AppTy fun arg)	    	  = go fun `unionVarSet` go arg
     go (ForAllTy tyvar ty)  	  = delVarSet (go ty) tyvar
                                     `unionVarSet` go_tv tyvar
-    go (NoteTy _ _) 		  = panic "exactTyVarsOfType"	-- Handled by tcView
 
     go_pred (IParam _ ty)    = go ty
     go_pred (ClassP _ tys)   = exactTyVarsOfTypes tys
@@ -1097,7 +1100,6 @@ end of the compiler.
 tyClsNamesOfType :: Type -> NameSet
 tyClsNamesOfType (TyVarTy tv)		    = emptyNameSet
 tyClsNamesOfType (TyConApp tycon tys)	    = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
-tyClsNamesOfType (NoteTy _ ty2) 	    = tyClsNamesOfType ty2
 tyClsNamesOfType (PredTy (IParam n ty))     = tyClsNamesOfType ty
 tyClsNamesOfType (PredTy (ClassP cl tys))   = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
 tyClsNamesOfType (PredTy (EqPred ty1 ty2))  = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2