+ 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)
+ = (case maybeSig tc_ty_sigs name of
+ Just sig -> returnNF_Tc (tcSigMonoId sig)
+ Nothing -> newLocalName name `thenNF_Tc` \ bndr_name ->
+ newTyVarTy openTypeKind `thenNF_Tc` \ bndr_ty ->
+ -- NB: not a 'hole' tyvar; since there is no type
+ -- signature, we revert to ordinary H-M typechecking
+ -- which means the variable gets an inferred tau-type
+ returnNF_Tc (mkLocalId bndr_name bndr_ty)
+ ) `thenNF_Tc` \ bndr_id ->
+ let
+ bndr_ty = idType bndr_id
+ 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 $
+ newHoleTyVarTy `thenNF_Tc` \ pat_ty ->
+
+ -- Now typecheck the pattern
+ -- We do now support binding fresh (not-already-in-scope) scoped
+ -- type variables in the pattern of a pattern binding.
+ -- For example, this is now legal:
+ -- (x::a, y::b) = e
+ -- The type variables are brought into scope in tc_binds_and_then,
+ -- so we don't have to do anything here.
+
+ tcPat tc_pat_bndr pat pat_ty `thenTc` \ (pat', lie_req, tvs, ids, lie_avail) ->
+ readHoleResult pat_ty `thenTc` \ pat_ty' ->
+ let
+ complete_it xve = tcAddSrcLoc locn $
+ tcAddErrCtxt (patMonoBindsCtxt bind) $
+ tcExtendLocalValEnv2 xve $
+ tcGRHSs PatBindRhs grhss pat_ty' `thenTc` \ (grhss', lie) ->
+ returnTc (PatMonoBind pat' grhss' locn, lie)
+ in
+ returnTc (complete_it, lie_req, tvs, ids, lie_avail)
+
+ -- tc_pat_bndr is used when dealing with a LHS binder in a pattern.
+ -- If there was a type sig for that Id, we want to make it much
+ -- as if that type signature had been on the binder as a SigPatIn.
+ -- We check for a type signature; if there is one, we use the mono_id
+ -- from the signature. This is how we make sure the tau part of the
+ -- signature actually matches the type of the LHS; then tc_mb_pats
+ -- ensures the LHS and RHS have the same type
+
+ tc_pat_bndr name pat_ty
+ = case maybeSig tc_ty_sigs name of
+ Nothing
+ -> newLocalName name `thenNF_Tc` \ bndr_name ->
+ tcMonoPatBndr bndr_name pat_ty
+
+ Just sig -> tcAddSrcLoc (getSrcLoc name) $
+ tcSubPat (idType mono_id) pat_ty `thenTc` \ (co_fn, lie) ->
+ returnTc (co_fn, lie, mono_id)
+ where
+ mono_id = tcSigMonoId sig