- let
- field_ty = tyConFieldType tycon field_lbl
- field_ty' = substTy tenv field_ty
- in
- tcCheckSigma rhs field_ty' `thenM` \ rhs' ->
- tcLookupId field_lbl `thenM` \ sel_id ->
- ASSERT( isRecordSelector sel_id )
- returnM (L loc sel_id, rhs')
-
-tyConFieldType :: TyCon -> FieldLabel -> Type
-tyConFieldType tycon field_lbl
- = case [ty | (f,ty,_) <- tyConFields tycon, f == field_lbl] of
- (ty:other) -> ASSERT( null other) ty
- -- This lookup and assertion will surely succeed, because
- -- we check that the fields are indeed record selectors
- -- before calling tcRecordBinds
-
-badFields rbinds data_con
- = filter (not . (`elem` field_names)) (recBindFields rbinds)
- where
- field_names = dataConFieldLabels data_con
+ do { rhs' <- tcCheckSigma rhs field_ty
+ ; sel_id <- tcLookupId field_lbl
+ ; ASSERT( isRecordSelector sel_id )
+ return (Just (L loc sel_id, rhs')) }
+ | otherwise
+ = do { addErrTc (badFieldCon data_con field_lbl)
+ ; return Nothing }