From: simonpj@microsoft.com <unknown>
Date: Thu, 2 Feb 2006 13:04:09 +0000 (+0000)
Subject: Deal correctly with lazy patterns and GADTs
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=04fd714108aa00aeebe0b954259e51dac281c245

Deal correctly with lazy patterns and GADTs
---

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 2ab8d19..ae55767 100644
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -88,7 +88,8 @@ tcPats ctxt pats tys res_ty thing_inside
   =  do	{ let init_state = PS { pat_ctxt = ctxt, pat_reft = emptyTvSubst }
 
 	; (pats', ex_tvs, res) <- tc_lpats init_state pats tys $ \ pstate' ->
-				  thing_inside (refineType (pat_reft pstate') res_ty)
+				  refineEnvironment (pat_reft pstate') $
+	     			  thing_inside (refineType (pat_reft pstate') res_ty)
 
 	; tcCheckExistentialPat ctxt pats' ex_tvs tys res_ty
 
@@ -605,10 +606,10 @@ refineAlt pstate con pat_tvs arg_flags pat_res_tys ctxt_res_tys thing_inside
 				-- to refine the environment or pstate
 	  -> do  { traceTc trace_msg
 		 ; thing_inside pstate pat_tvs' }
-	  | otherwise 		-- New bindings affect the context, so refine
-				-- the environment and pstate
-	  -> refineEnvironment (pat_reft pstate') $
-	     do { traceTc trace_msg
+	  | otherwise 	-- New bindings affect the context, so pass down pstate'.  
+			-- DO NOT refine the envt, because we might be inside a
+			-- lazy pattern
+	  -> do { traceTc trace_msg
 		; thing_inside pstate' pat_tvs' }
 	  where
   	     pat_tvs' = map (substTyVar new_subst) pat_tvs