- 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 `thenTc` \ (pats', lie_reqs, exs_tvs, exs_ids, exs_lie, answer) ->
- returnTc ( pat':pats',
- lie_req `plusLIE` lie_reqs,
- ex_tvs `unionBags` exs_tvs,
- ex_ids ++ exs_ids,
- ex_lie `plusLIE` 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
- -> LIE -- and context
- -> LIE -- Required context
- -> TcType -- and type of the Match; vars in here must not escape
- -> TcM (LIE, 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
- -- Short cut for case when there are no existentials
- -- and no polymorphic overloaded variables
- -- e.g. f :: (forall a. Ord a => a -> a) -> Int -> Int
- -- f op x = ....
- -- Here we must discharge op Methods
- = ASSERT( isEmptyLIE ex_lie )
- returnTc (lie_req, EmptyMonoBinds)
-
- | otherwise
- = tcAddErrCtxtM (sigPatCtxt tv_list ex_ids match_ty) $
-
- -- In case there are any polymorpic, overloaded binders in the pattern
- -- (which can happen in the case of rank-2 type signatures, or data constructors
- -- with polymorphic arguments), we must do a bindInstsOfLocalFns here
- bindInstsOfLocalFuns lie_req ex_ids `thenTc` \ (lie1, inst_binds) ->
-
- -- Deal with overloaded functions bound by the pattern
- tcSimplifyCheck doc tv_list (lieToList ex_lie) lie1 `thenTc` \ (lie2, dict_binds) ->
- checkSigTyVarsWrt (tyVarsOfType match_ty) tv_list `thenTc_`
-
- returnTc (lie2, dict_binds `AndMonoBinds` inst_binds)
+ ctxt = SC { sc_what = do_or_mdo,
+ sc_rhs = \ rhs -> do { (rhs', rhs_ty) <- tcInferRho rhs
+ ; rhs_elt_ty <- unifyAppTy m_ty rhs_ty
+ ; return (rhs', rhs_elt_ty) },
+ sc_body = \ body -> tcCheckRho body res_ty,
+ sc_ty = res_ty }
+ in
+ tcStmts ctxt stmts `thenM` \ stmts' ->
+
+ -- Build the then and zero methods in case we need them
+ -- It's important that "then" and "return" appear just once in the final LIE,
+ -- not only for typechecker efficiency, but also because otherwise during
+ -- simplification we end up with silly stuff like
+ -- then = case d of (t,r) -> t
+ -- then = then
+ -- where the second "then" sees that it already exists in the "available" stuff.
+ mapM (tcSyntaxName DoOrigin m_ty) method_names `thenM` \ methods ->
+
+ returnM (stmts', methods)
+
+tcComprehension do_or_lc m_tycon elt_ty stmts
+ = tcStmts ctxt stmts