X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcSimplify.lhs;h=e2892012f1e8fb94a9524a6460ef9a74de5ee3fb;hb=ba013704bfb94aa133fb28f342e0d432698a5d6d;hp=3f9a9de19e92d969731fd475cb868775b8510325;hpb=b3c6ee0e0185f45d6a9092b5c1f84120c3b8d16d;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 3f9a9de..e289201 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -139,7 +139,7 @@ import Inst		( lookupInst, lookupSimpleInst, LookupInstResult(..),
 			  Inst, LIE, pprInsts, pprInstsInFull, mkLIE, 
 			  InstOrigin, pprOrigin
 			)
-import TcEnv		( TcIdOcc(..) )
+import TcEnv		( TcIdOcc(..), tcGetGlobalTyVars )
 import TcType		( TcType, TcTyVarSet, TcMaybe, tcInstType, tcInstTheta )
 import Unify		( unifyTauTy )
 import Id		( mkIdSet )
@@ -155,7 +155,7 @@ import Type		( Type, ThetaType, TauType, mkTyVarTy, getTyVar,
 import PprType		( pprConstraint )
 import TysWiredIn	( unitTy )
 import TyVar		( intersectTyVarSets, unionManyTyVarSets, minusTyVarSet,
-			  isEmptyTyVarSet, tyVarSetToList,
+			  isEmptyTyVarSet, tyVarSetToList, unionTyVarSets,
 			  zipTyVarEnv, emptyTyVarEnv
 			)
 import FiniteMap
@@ -208,10 +208,14 @@ tcSimplify str top_lvl local_tvs wanted_lie
 	-- But we can get stuck with 
 	--	C a b
 	-- where "a" is one of the local_tvs, but "b" is unconstrained.
-	-- Then we must yell about the ambiguous b
+	-- Then we must yell about the ambiguous b.
+	-- But we must only do so if "b" really is unconstrained; so
+	-- we must grab the global tyvars to answer that question
+    tcGetGlobalTyVars				`thenNF_Tc` \ global_tvs ->
     let
+	avail_tvs	    = local_tvs `unionTyVarSets` global_tvs
 	(irreds', bad_guys) = partition (isEmptyTyVarSet . ambig_tv_fn) irreds
-	ambig_tv_fn dict    = tyVarsOfInst dict `minusTyVarSet` local_tvs
+	ambig_tv_fn dict    = tyVarsOfInst dict `minusTyVarSet` avail_tvs
     in
     addAmbigErrs ambig_tv_fn bad_guys	`thenNF_Tc_`
 
@@ -401,7 +405,6 @@ reduceContext str try_me givens wanteds
 	     text "----------------------"
 	     ]) $
 -}
-
         -- Build the Avail mapping from "givens"
     foldlNF_Tc addGiven emptyFM givens		`thenNF_Tc` \ avails ->
 
@@ -432,7 +435,9 @@ reduceContext str try_me givens wanteds
 	     text "given" <+> ppr givens,
 	     text "wanted" <+> ppr wanteds,
 	     text "----", 
-	     pprAvails avails,
+	     text "avails" <+> pprAvails avails,
+	     text "free" <+> ppr frees,		
+	     text "irreds" <+> ppr irreds,		
 	     text "----------------------"
 	     ]) $
 -}