X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcExpr.lhs;h=a26a106e8461af01bbb60f405627e50128404a36;hb=ca49225cd41123ab6ce229040a93cc4b993b190a;hp=f4f1e8e75cd8970c86f1117a4c59b4e12b75fbac;hpb=58786d7131b8842c5d50cb3ac4173753951cc343;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs index f4f1e8e..a26a106 100644 --- a/ghc/compiler/typecheck/TcExpr.lhs +++ b/ghc/compiler/typecheck/TcExpr.lhs @@ -51,7 +51,7 @@ import Id ( idType, recordSelectorFieldLabel, isRecordSelector, isNaughtyRecord import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks, dataConWrapId, isVanillaDataCon, dataConTyVars, dataConOrigArgTys ) import Name ( Name ) -import TyCon ( TyCon, FieldLabel, tyConStupidTheta, tyConArity, tyConDataCons ) +import TyCon ( FieldLabel, tyConStupidTheta, tyConDataCons ) import Type ( substTheta, substTy ) import Var ( tyVarKind ) import VarSet ( emptyVarSet, elemVarSet ) @@ -69,6 +69,10 @@ import ListSetOps ( assocMaybe ) import Maybes ( catMaybes ) import Outputable import FastString + +#ifdef DEBUG +import TyCon ( tyConArity ) +#endif \end{code} %************************************************************************ @@ -948,11 +952,6 @@ tcRecordBinds data_con flds_w_tys rbinds = do { addErrTc (badFieldCon data_con field_lbl) ; return Nothing } -badFields rbinds data_con - = filter (not . (`elem` field_names)) (recBindFields rbinds) - where - field_names = dataConFieldLabels data_con - checkMissingFields :: DataCon -> HsRecordBinds Name -> TcM () checkMissingFields data_con rbinds | null field_labels -- Not declared as a record;