X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcPat.lhs;h=ce9e99bedb1be797eede036ab1c24984e59fd610;hb=5d3051c66796dcf884b052f9e4afc3ed19b9f514;hp=4244763f6501518b48916eeada8ce0f566711d10;hpb=c362e21663e6222c01be3106c80ea9452c4ae222;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 4244763..ce9e99b 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
 
@@ -273,6 +274,10 @@ tc_pat pstate (ParPat pat) pat_ty thing_inside
   = do	{ (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
 	; return (ParPat pat', tvs, res) }
 
+tc_pat pstate (BangPat pat) pat_ty thing_inside
+  = do	{ (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
+	; return (BangPat pat', tvs, res) }
+
 -- There's a wrinkle with irrefuatable patterns, namely that we
 -- must not propagate type refinement from them.  For example
 --	data T a where { T1 :: Int -> T Int; ... }
@@ -336,7 +341,7 @@ tc_pat pstate (PArrPat pats _) pat_ty thing_inside
 	; ifM (null pats) (zapToMonotype pat_ty)	-- c.f. ExplicitPArr in TcExpr
 	; return (PArrPat pats' elt_ty, pats_tvs, res) }
 
-tc_pat pstate (TuplePat pats boxity) pat_ty thing_inside
+tc_pat pstate (TuplePat pats boxity _) pat_ty thing_inside
   = do	{ arg_tys <- boxySplitTyConApp (tupleTyCon boxity (length pats)) pat_ty
 	; (pats', pats_tvs, res) <- tc_lpats pstate pats arg_tys thing_inside
 
@@ -344,7 +349,7 @@ tc_pat pstate (TuplePat pats boxity) pat_ty thing_inside
 	-- so that we can experiment with lazy tuple-matching.
 	-- This is a pretty odd place to make the switch, but
 	-- it was easy to do.
-	; let unmangled_result = TuplePat pats' boxity
+	; let unmangled_result = TuplePat pats' boxity pat_ty
 	      possibly_mangled_result
 	        | opt_IrrefutableTuples && isBoxed boxity = LazyPat (noLoc unmangled_result)
 	        | otherwise			          = unmangled_result
@@ -605,10 +610,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