X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=50ac35ab50a97d0a65ac6d795704440ec82d7638;hp=47bb554e867d4760659079f8bd8bfbe3c6f89813;hb=4d8c7c976104d2e39a1183967ec0f254a0fc0a47;hpb=0dc2b9de4dd4681aa11dfa5419c931a51b274fa6

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 47bb554..50ac35a 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -28,7 +28,7 @@ module TcType (
   MetaDetails(Flexi, Indirect), MetaInfo(..), 
   SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy,
-  isSigTyVar, isExistentialTyVar,  isTyConableTyVar,
+  isSigTyVar, isOverlappableTyVar,  isTyConableTyVar,
   metaTvRef, 
   isFlexi, isIndirect, isUnkSkol, isRuntimeUnkSkol,
 
@@ -339,9 +339,6 @@ data SkolemInfo
   | RuntimeUnkSkol      -- a type variable used to represent an unknown
                         -- runtime type (used in the GHCi debugger)
 
-  | NoScSkol		-- Used for the "self" superclass when solving
-    			-- superclasses; don't generate superclasses of me
-
   | UnkSkol		-- Unhelpful info (until I improve it)
 
 -------------------------------------
@@ -451,6 +448,9 @@ pprSkolTvBinding tv
 				   sep [pprSkolInfo info, 
 					nest 2 (ptext (sLit "at") <+> ppr (getSrcLoc tv))]]
  
+instance Outputable SkolemInfo where
+  ppr = pprSkolInfo
+
 pprSkolInfo :: SkolemInfo -> SDoc
 -- Complete the sentence "is a rigid type variable bound by..."
 pprSkolInfo (SigSkol ctxt)  = pprUserTypeCtxt ctxt
@@ -458,7 +458,6 @@ pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
                               <+> pprWithCommas ppr ips
 pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
 pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
-pprSkolInfo NoScSkol        = ptext (sLit "the instance declaration (self)")
 pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
 pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
@@ -615,7 +614,7 @@ isImmutableTyVar tv
   | isTcTyVar tv = isSkolemTyVar tv
   | otherwise    = True
 
-isTyConableTyVar, isSkolemTyVar, isExistentialTyVar, 
+isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
   isMetaTyVar :: TcTyVar -> Bool 
 
 isTyConableTyVar tv	
@@ -634,11 +633,14 @@ isSkolemTyVar tv
         FlatSkol {} -> True
  	MetaTv {}   -> False
 
-isExistentialTyVar tv 	-- Existential type variable, bound by a pattern
+-- isOverlappableTyVar has a unique purpose.
+-- See Note [Binding when looking up instances] in InstEnv.
+isOverlappableTyVar tv
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-	SkolemTv (PatSkol {}) -> True
-	_                     -> False
+        SkolemTv (PatSkol {})  -> True
+        SkolemTv (InstSkol {}) -> True
+        _                      -> False
 
 isMetaTyVar tv 
   = ASSERT2( isTcTyVar tv, ppr tv )
@@ -954,6 +956,9 @@ tcInstHeadTyAppAllTyVars :: Type -> Bool
 -- Used in Haskell-98 mode, for the argument types of an instance head
 -- These must be a constructor applied to type variable arguments
 tcInstHeadTyAppAllTyVars ty
+  | Just ty' <- tcView ty       -- Look through synonyms
+  = tcInstHeadTyAppAllTyVars ty'
+  | otherwise
   = case ty of
 	TyConApp _ tys  -> ok tys
 	FunTy arg res   -> ok [arg, res]
@@ -1022,8 +1027,6 @@ getClassPredTys _ = panic "getClassPredTys"
 mkDictTy :: Class -> [Type] -> Type
 mkDictTy clas tys = mkPredTy (ClassP clas tys)
 
-
-
 isDictLikeTy :: Type -> Bool
 -- Note [Dictionary-like types]
 isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'