X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=2e3b80ba7e356008476191881a40f513de80dba1;hb=0d1fca153fa5426d793a4b16acdf57e409b9193f;hp=c638c04d5e060aef26355946d6870a255c03eb6d;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index c638c04..2e3b80b 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -405,11 +405,13 @@ refineEnvironment reft thing_inside
  	; setLclEnv (env {tcl_env = le'}) thing_inside }
   where
     refine elt@(ATcId { tct_co = Just co, tct_type = ty })
-			  = let (co', ty') = refineType reft ty
-			    in elt { tct_co = Just (co' <.> co), tct_type = ty' }
-    refine (ATyVar tv ty) = ATyVar tv (snd (refineType reft ty))
-				-- Ignore the coercion that refineType returns
-    refine elt		  = elt
+	| Just (co', ty') <- refineType reft ty
+	= elt { tct_co = Just (WpCo co' <.> co), tct_type = ty' }
+    refine (ATyVar tv ty) 
+	| Just (_, ty') <- refineType reft ty
+	= ATyVar tv ty'	-- Ignore the coercion that refineType returns
+
+    refine elt = elt	-- Common case
 \end{code}
 
 %************************************************************************