- returnTc (RecPat data_con pat_ty ex_tvs ex_dicts rpats',
- lie_req1 `plusLIE` lie_req2 `plusLIE` lie_req3,
- listToBag ex_tvs `unionBags` tvs,
- ids,
- lie_avail1 `plusLIE` lie_avail2)
-
- where
- tc_fields field_tys []
- = returnTc ([], emptyLIE, emptyBag, emptyBag, emptyLIE)
-
- tc_fields field_tys ((field_label, rhs_pat, pun_flag) : rpats)
- = tc_fields field_tys rpats `thenTc` \ (rpats', lie_req1, tvs1, ids1, lie_avail1) ->
-
- (case [ty | (f,ty) <- field_tys, f == field_label] of
-
- -- No matching field; chances are this field label comes from some
- -- other record type (or maybe none). As well as reporting an
- -- error we still want to typecheck the pattern, principally to
- -- make sure that all the variables it binds are put into the
- -- environment, else the type checker crashes later:
- -- f (R { foo = (a,b) }) = a+b
- -- If foo isn't one of R's fields, we don't want to crash when
- -- typechecking the "a+b".
- [] -> addErrTc (badFieldCon name field_label) `thenNF_Tc_`
- newTyVarTy liftedTypeKind `thenNF_Tc_`
- returnTc (error "Bogus selector Id", pat_ty)
-
- -- The normal case, when the field comes from the right constructor
- (pat_ty : extras) ->
- ASSERT( null extras )
- tcLookupGlobalId field_label `thenNF_Tc` \ sel_id ->
- returnTc (sel_id, pat_ty)
- ) `thenTc` \ (sel_id, pat_ty) ->