X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcMType.lhs;h=097c7f9c23df8c06183a5ec23e35fc8225c75996;hb=0862ececb9fa3439a0da20076a8b2db0f3ee76a4;hp=b7a10b2f0eba71037c9a619a74cd6153efb49bb1;hpb=dbc254c3dcd64761015a3d1c191ac742caafbf4c;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index b7a10b2..097c7f9 100644
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -14,7 +14,7 @@ module TcMType (
   newTyVar, 
   newTyVarTy,		-- Kind -> TcM TcType
   newTyVarTys,		-- Int -> Kind -> TcM [TcType]
-  newKindVar, newKindVars, newBoxityVar,
+  newKindVar, newKindVars, newOpenTypeKind,
   putTcTyVar, getTcTyVar,
   newMutTyVar, readMutTyVar, writeMutTyVar, 
 
@@ -46,14 +46,14 @@ module TcMType (
 
 -- friends:
 import TypeRep		( Type(..), SourceType(..), TyNote(..),	 -- Friend; can see representation
-			  Kind, ThetaType
+			  Kind, ThetaType, typeCon
 			) 
 import TcType		( TcType, TcThetaType, TcTauType, TcPredType,
 			  TcTyVarSet, TcKind, TcTyVar, TyVarDetails(..),
-			  tcEqType, tcCmpPred,
+			  tcEqType, tcCmpPred, isClassPred,
 			  tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe, 
 			  tcSplitTyConApp_maybe, tcSplitForAllTys,
-			  tcIsTyVarTy, tcSplitSigmaTy, 
+			  tcIsTyVarTy, tcSplitSigmaTy, mkTyConApp,
 			  isUnLiftedType, isIPPred, isHoleTyVar, isTyVarTy,
 
 			  mkAppTy, mkTyVarTy, mkTyVarTys, 
@@ -131,11 +131,11 @@ newKindVar
 newKindVars :: Int -> TcM [TcKind]
 newKindVars n = mappM (\ _ -> newKindVar) (nOfThem n ())
 
-newBoxityVar :: TcM TcKind
-newBoxityVar
+newOpenTypeKind :: TcM TcKind	-- Returns the kind (Type bx), where bx is fresh
+newOpenTypeKind
   = newUnique 							  `thenM` \ uniq ->
     newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx")) superBoxity VanillaTv  `thenM` \ kv ->
-    returnM (TyVarTy kv)
+    returnM (mkTyConApp typeCon [TyVarTy kv])
 \end{code}
 
 
@@ -908,13 +908,18 @@ checkAmbiguity forall_tyvars theta tau_tyvars
   where
     complain pred     = addErrTc (ambigErr pred)
     extended_tau_vars = grow theta tau_tyvars
-    is_ambig pred     = any ambig_var (varSetElems (tyVarsOfPred pred))
+
+	-- Only a *class* predicate can give rise to ambiguity
+	-- An *implicit parameter* cannot.  For example:
+	--	foo :: (?x :: [a]) => Int
+	--	foo = length ?x
+	-- is fine.  The call site will suppply a particular 'x'
+    is_ambig pred     = isClassPred  pred &&
+			any ambig_var (varSetElems (tyVarsOfPred pred))
 
     ambig_var ct_var  = (ct_var `elem` forall_tyvars) &&
 		        not (ct_var `elemVarSet` extended_tau_vars)
 
-    is_free ct_var    = not (ct_var `elem` forall_tyvars)
-
 ambigErr pred
   = sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprPred pred),
 	 nest 4 (ptext SLIT("At least one of the forall'd type variables mentioned by the constraint") $$