+ tc_mb_pats (AndMonoBinds mb1 mb2)
+ = tc_mb_pats mb1 `thenTc` \ (complete_it1, lie_req1, tvs1, ids1, lie_avail1) ->
+ tc_mb_pats mb2 `thenTc` \ (complete_it2, lie_req2, tvs2, ids2, lie_avail2) ->
+ let
+ complete_it xve = complete_it1 xve `thenTc` \ (mb1', lie1) ->
+ complete_it2 xve `thenTc` \ (mb2', lie2) ->
+ returnTc (AndMonoBinds mb1' mb2', lie1 `plusLIE` lie2)
+ in
+ returnTc (complete_it,
+ lie_req1 `plusLIE` lie_req2,
+ tvs1 `unionBags` tvs2,
+ ids1 `unionBags` ids2,
+ lie_avail1 `plusLIE` lie_avail2)
+
+ tc_mb_pats (FunMonoBind name inf matches locn)
+ = new_lhs_ty `thenNF_Tc` \ bndr_ty ->
+ tc_pat_bndr name bndr_ty `thenTc` \ bndr_id ->
+ let
+ complete_it xve = tcAddSrcLoc locn $
+ tcMatchesFun xve name bndr_ty matches `thenTc` \ (matches', lie) ->
+ returnTc (FunMonoBind bndr_id inf matches' locn, lie)
+ in
+ returnTc (complete_it, emptyLIE, emptyBag, unitBag (name, bndr_id), emptyLIE)
+
+ tc_mb_pats bind@(PatMonoBind pat grhss locn)
+ = tcAddSrcLoc locn $
+ new_lhs_ty `thenNF_Tc` \ pat_ty ->
+
+ -- Now typecheck the pattern
+ -- We don't support binding fresh type variables in the
+ -- pattern of a pattern binding. For example, this is illegal:
+ -- (x::a, y::b) = e
+ -- whereas this is ok
+ -- (x::Int, y::Bool) = e
+ --
+ -- We don't check explicitly for this problem. Instead, we simply
+ -- type check the pattern with tcPat. If the pattern mentions any
+ -- fresh tyvars we simply get an out-of-scope type variable error
+ tcPat tc_pat_bndr pat pat_ty `thenTc` \ (pat', lie_req, tvs, ids, lie_avail) ->
+ let
+ complete_it xve = tcAddSrcLoc locn $
+ tcAddErrCtxt (patMonoBindsCtxt bind) $
+ tcExtendLocalValEnv xve $
+ tcGRHSs grhss pat_ty PatBindRhs `thenTc` \ (grhss', lie) ->
+ returnTc (PatMonoBind pat' grhss' locn, lie)
+ in
+ returnTc (complete_it, lie_req, tvs, ids, lie_avail)