X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=7b9f1f1b3f24cfdff99a39adbbf779c10f8cc4ea;hb=d90023f2e54e2c0b5aad169d0f55748a152fecce;hp=708b8e4d7873c5b7c3abfe73e3d447b047bd0ca2;hpb=fd17403d85c172ba898bc9a4817bb4f9e175bf8f;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 708b8e4..7b9f1f1 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -849,10 +849,11 @@ bindIrredsR loc qtvs co_vars reft givens irreds
 		-- The givens can include methods
 		-- See Note [Pruning the givens in an implication constraint]
 
-	   -- If there are no 'givens', then it's safe to 
+	   -- If there are no 'givens' *and* the refinement is empty
+	   -- (the refinement is like more givens), then it's safe to 
 	   -- partition the 'wanteds' by their qtvs, thereby trimming irreds
 	   -- See Note [Freeness and implications]
-	; irreds' <- if null givens'
+	; irreds' <- if null givens' && isEmptyRefinement reft
 	     	     then do
 	     	    	{ let qtv_set = mkVarSet qtvs
 	     	    	      (frees, real_irreds) = partition (isFreeWrtTyVars qtv_set) irreds