+ = addSrcLoc locn $
+ tcStmts (PatGuard ctxt) m_ty guarded `thenM` \ guarded' ->
+ returnM (GRHS guarded' locn)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{tcMatchPats}
+%* *
+%************************************************************************
+
+\begin{code}
+tcMatchPats
+ :: [RenamedPat] -> TcType
+ -> (TcType -> TcM a)
+ -> TcM ([TcPat], a, TcHsBinds)
+-- 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
+ -- then do the thing inside
+ getLIE (tc_match_pats pats expected_ty thing_inside)
+
+ ) `thenM` \ ((pats', ex_tvs, ex_ids, ex_lie, result), lie_req) ->
+
+ -- STEP 4: Check for existentially bound type variables
+ -- Do this *outside* the scope of the tcAddScopedTyVars, else checkSigTyVars
+ -- complains that 'a' is captured by the inscope 'a'! (Test (d) in checkSigTyVars.)
+ --
+ -- 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 ex_tvs ex_ids ex_lie lie_req expected_ty `thenM` \ ex_binds ->
+ -- NB: we *must* pass "expected_ty" not "result_ty" to tcCheckExistentialPat
+ -- For example, we must reject this program:
+ -- data C = forall a. C (a -> Int)
+ -- f (C g) x = g x
+ -- Here, result_ty will be simply Int, but expected_ty is (a -> Int).
+
+ returnM (pats', result, mkMonoBind Recursive ex_binds)
+
+tc_match_pats [] expected_ty thing_inside
+ = thing_inside expected_ty `thenM` \ answer ->
+ returnM ([], emptyBag, [], [], answer)
+
+tc_match_pats (pat:pats) expected_ty thing_inside
+ = subFunTy expected_ty $ \ arg_ty rest_ty ->
+ -- This is the unique place we call subFunTy
+ -- The point is that if expected_y is a "hole", we want
+ -- to make arg_ty and rest_ty as "holes" too.
+ tcPat tcMonoPatBndr pat arg_ty `thenM` \ (pat', ex_tvs, pat_bndrs, ex_lie) ->
+ let
+ xve = bagToList pat_bndrs
+ ex_ids = [id | (_, id) <- xve]
+ -- ex_ids is all the pattern-bound Ids, a superset
+ -- of the existential Ids used in checkExistentialPat
+ in
+ tcExtendLocalValEnv2 xve $
+ tc_match_pats pats rest_ty thing_inside `thenM` \ (pats', exs_tvs, exs_ids, exs_lie, answer) ->
+ returnM ( pat':pats',
+ ex_tvs `unionBags` exs_tvs,
+ ex_ids ++ exs_ids,
+ ex_lie ++ exs_lie,
+ answer
+ )
+
+
+tcCheckExistentialPat :: Bag TcTyVar -- Existentially quantified tyvars bound by pattern
+ -> [TcId] -- Ids bound by this pattern; used
+ -- (a) by bindsInstsOfLocalFuns
+ -- (b) to generate helpful error messages
+ -> [Inst] -- and context
+ -> [Inst] -- Required context
+ -> TcType -- and type of the Match; vars in here must not escape
+ -> TcM TcDictBinds -- LIE to float out and dict bindings
+tcCheckExistentialPat ex_tvs ex_ids ex_lie lie_req match_ty
+ | isEmptyBag ex_tvs && all not_overloaded ex_ids