= 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
-----------------
tcPat :: PatCtxt
- -> LPat Name -> TcType
+ -> LPat Name -> BoxySigmaType
-> BoxyRhoType -- Result type
-> (BoxyRhoType -> TcM a) -- Checker for body, given its result type
-> TcM (LPat TcId, a)
= 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; ... }
; 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
-- 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
-- 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