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

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index c638c04..cc50e50 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -400,16 +400,21 @@ refineEnvironment :: Refinement -> TcM a -> TcM a
 -- I don't think I have to refine the set of global type variables in scope
 -- Reason: the refinement never increases that set
 refineEnvironment reft thing_inside
+  | isEmptyRefinement reft		-- Common case
+  = thing_inside
+  | otherwise
   = do	{ env <- getLclEnv
 	; let le' = mapNameEnv refine (tcl_env env)
  	; 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}
 
 %************************************************************************