X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=c9b5d6e6503cb226a9af402ff3bba4af37e21245;hb=00abc3998739f7db38a2466b6e730105f16f8ddf;hp=e1a1f242040a43f0bf5e6852ee0df643d27278e4;hpb=32722dc3f6466f01698f7a42298a8acedd4059c2;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index e1a1f24..c9b5d6e 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -279,7 +279,9 @@ tc_lpat :: LPat Name
 tc_lpat (L span pat) pat_ty pstate thing_inside
   = setSrcSpan span		  $
     maybeAddErrCtxt (patCtxt pat) $
-    do	{ let (coercion, pat_ty') = refineType (pat_reft pstate) pat_ty
+    do	{ let mb_reft = refineType (pat_reft pstate) pat_ty
+	      pat_ty' = case mb_reft of { Just (_, ty') -> ty'; Nothing -> pat_ty }
+
 		-- Make sure the result type reflects the current refinement
 		-- We must do this here, so that it correctly ``sees'' all
 		-- the refinements to the left.  Example:
@@ -289,7 +291,10 @@ tc_lpat (L span pat) pat_ty pstate thing_inside
 		-- pattern had better see it.
 
 	; (pat', tvs, res) <- tc_pat pstate pat pat_ty' thing_inside
-	; return (mkCoPat coercion (L span pat') pat_ty, tvs, res) }
+	; let final_pat = case mb_reft of
+				Nothing     -> pat'
+				Just (co,_) -> CoPat (WpCo co) pat' pat_ty
+	; return (L span final_pat, tvs, res) }
 
 --------------------
 tc_pat	:: PatState