X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=4cf93e83da60217c0249cc28a1b3a00745fa5caf;hb=cc9a63c2552d74abc1fefae647aeba062ea76b71;hp=071d4c0334c3a0a661ba863e4c14033d11492621;hpb=c04a5fe3e2867d59ce9757069fdd20c06c326724;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 071d4c0..4cf93e8 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -659,7 +659,7 @@ tcSimplifyInfer doc tau_tvs wanted
 	; gbl_tvs  <- tcGetGlobalTyVars
 	; let preds1   = fdPredsOfInsts wanted'
 	      gbl_tvs1 = oclose preds1 gbl_tvs
-	      qtvs     = grow preds1 tau_tvs1 `minusVarSet` gbl_tvs1
+	      qtvs     = growInstsTyVars wanted' tau_tvs1 `minusVarSet` gbl_tvs1
 			-- See Note [Choosing which variables to quantify]
 
 		-- To maximise sharing, remove from consideration any 
@@ -668,7 +668,7 @@ tcSimplifyInfer doc tau_tvs wanted
 	; extendLIEs free
 
 		-- To make types simple, reduce as much as possible
-	; traceTc (text "infer" <+> (ppr preds1 $$ ppr (grow preds1 tau_tvs1) $$ ppr gbl_tvs $$ 
+	; traceTc (text "infer" <+> (ppr preds1 $$ ppr (growInstsTyVars wanted' tau_tvs1) $$ ppr gbl_tvs $$ 
 		   ppr gbl_tvs1 $$ ppr free $$ ppr bound))
 	; (irreds1, binds1) <- tryHardCheckLoop doc bound
 
@@ -709,7 +709,13 @@ tcSimplifyInfer doc tau_tvs wanted
 		-- Then b is fixed by gbl_tvs, so (C a b) will be in free, and
 		-- irreds2 will be empty.  But we don't want to generalise over b!
 	; let preds2 = fdPredsOfInsts irreds2	-- irreds2 is zonked
-	      qtvs   = grow preds2 tau_tvs2 `minusVarSet` oclose preds2 gbl_tvs2
+	      qtvs   = growInstsTyVars irreds2 tau_tvs2 `minusVarSet` oclose preds2 gbl_tvs2
+		---------------------------------------------------
+		-- BUG WARNING: there's a nasty bug lurking here
+		-- fdPredsOfInsts may return preds that mention variables quantified in
+		-- one of the implication constraints in irreds2; and that is clearly wrong:
+		-- we might quantify over too many variables through accidental capture
+		---------------------------------------------------
 	; let (free, irreds3) = partition (isFreeWhenInferring qtvs) irreds2
 	; extendLIEs free