+\begin{code}
+tcMatchPats
+ :: [RenamedPat] -> TcType
+ -> ([TypecheckedPat] -> TcType -> TcM (a, LIE))
+ -> TcM (a, LIE, TcDictBinds)
+-- Typecheck the patterns, extend the environment to bind the variables,
+-- do the thing inside, use any existentially-bound dictionaries to
+-- discharge parts of the returning LIE, and deal with pattern type
+-- signatures
+
+tcMatchPats pats expected_ty thing_inside
+ = -- STEP 1: Bring pattern-signature type variables into scope
+ tcAddScopedTyVars (collectSigTysFromPats pats) $
+
+ -- STEP 2: Typecheck the patterns themselves, gathering all the stuff
+ tc_match_pats pats expected_ty `thenTc` \ (rhs_ty, pats', lie_req1, ex_tvs, pat_bndrs, lie_avail) ->
+
+ -- STEP 3: Extend the environment, and do the thing inside
+ let
+ xve = bagToList pat_bndrs
+ pat_ids = map snd xve
+ in
+ tcExtendLocalValEnv xve (thing_inside pats' rhs_ty) `thenTc` \ (result, lie_req2) ->
+
+ -- STEP 4: Check for existentially bound type variables
+ -- I'm a bit concerned that lie_req1 from an 'inner' pattern in the list
+ -- might need (via lie_req2) something made available from an 'outer'
+ -- pattern. But it's inconvenient to deal with, and I can't find an example
+ tcCheckExistentialPat pat_ids ex_tvs lie_avail lie_req2 rhs_ty `thenTc` \ (lie_req2', ex_binds) ->
+
+ returnTc (result, lie_req1 `plusLIE` lie_req2', ex_binds)
+
+tcAddScopedTyVars :: [RenamedHsType] -> TcM a -> TcM a
+-- Find the not-already-in-scope signature type variables,
+-- kind-check them, and bring them into scope
+--
+-- We no longer specify that these type variables must be univerally
+-- quantified (lots of email on the subject). If you want to put that
+-- back in, you need to
+-- a) Do a checkSigTyVars after thing_inside
+-- b) More insidiously, don't pass in expected_ty, else
+-- we unify with it too early and checkSigTyVars barfs
+-- Instead you have to pass in a fresh ty var, and unify
+-- it with expected_ty afterwards
+tcAddScopedTyVars sig_tys thing_inside
+ = tcGetEnv `thenNF_Tc` \ env ->
+ let
+ all_sig_tvs = foldr (unionNameSets . extractHsTyVars) emptyNameSet sig_tys
+ sig_tvs = filter not_in_scope (nameSetToList all_sig_tvs)
+ not_in_scope tv = not (tcInLocalScope env tv)
+ in
+ tcScopedTyVars sig_tvs (kcHsSigTypes sig_tys) thing_inside