Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 52c3e6ba by sheaf at 2026-03-20T12:21:09-04:00 Improve incomplete record selector warnings This commit stops GHC from emitting spurious incomplete record selector warnings for bare selectors/projections such as .fld There are two places we currently emit incomplete record selector warnings: 1. In the desugarer, when we see a record selector or an occurrence of 'getField'. Here, we can use pattern matching information to ensure we don't give false positives. 2. In the typechecker, which might sometimes give false positives but can emit warnings in cases that the pattern match checker would otherwise miss. This is explained in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc. Now, we obviously don't want to emit the same error twice, and generally we prefer (1), as those messages contain fewer false positives. So we suppress (2) when we are sure we are going to emit (1); the logic for doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel, and works by looking at the CtOrigin. Now, the issue was that this logic handled explicit record selectors as well as overloaded record field selectors such as "x.r" (which turns into a simple GetFieldOrigin CtOrigin), but it didn't properly handle record projectors like ".fld" or ".fld1.fld2" (which result in other CtOrigins such as 'RecordFieldProjectionOrigin'). To solve this problem, we re-use the 'isHasFieldOrigin' introduced in fbdc623a (slightly adjusted). On the way, we also had to update the desugarer with special handling for the 'ExpandedThingTc' case in 'ds_app', to make sure that 'ds_app_var' sees all the type arguments to 'getField' in order for it to indeed emit warnings like in (1). Fixes #26686 - - - - - 8 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/Origin.hs - + testsuite/tests/overloadedrecflds/should_compile/T26686.hs - + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr - testsuite/tests/overloadedrecflds/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -721,6 +721,15 @@ ds_app (XExpr (ConLikeTc con)) _hs_args core_args ds_app (XExpr (HsRecSelTc (FieldOcc { foLabel = L _ sel_id }))) _hs_args core_args = ds_app_rec_sel sel_id sel_id core_args +ds_app (XExpr (ExpandedThingTc _orig e)) hs_args core_args + = ds_app e hs_args core_args + -- NB: this is important for the 'getField' case of 'ds_app_var', which needs + -- to see all type arguments to 'getField' at once, while for record field + -- projections such as (.fld) we may get: + -- + -- XExpr (ExpandedThingTc (.fld) (getField @Symbol @LiftedRep @LiftedRep "fld")) + -- `HsAppType` rec_ty `HsAppType` fld + ds_app (HsVar _ lfun) hs_args core_args = ds_app_var lfun hs_args core_args @@ -736,8 +745,10 @@ ds_app_var (L loc fun_id) hs_args core_args ----------------------- -- Deal with getField applications. General form: -- getField - -- @GHC.Types.Symbol {k} - -- @"sel" x_ty + -- @Symbol {k} + -- @LiftedRep {r_rep} + -- @LiftedRep {a_rep} + -- @"sel" fld -- @T r_ty -- @Int a_ty -- ($dHasField :: HasField "sel" T Int) dict ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -375,6 +375,10 @@ Finally, there are two more items addressing -XOverloadedRecordDot: the (IRS6) warning in the typechecker for a `HasField` constraint that arises from a record-dot HsGetField occurrence. Happily, this is easy to do by looking at its `CtOrigin`. Tested in T24891. + + The same applies for record field projection operators such as (.fld) and + (.fld1.fld2), which have different 'CtOrigin's. The 'isHasFieldOrigin' + function catches those as well. Tested in T26686. -} pmcRecSel :: Id -- ^ Id of the selector ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -97,6 +97,7 @@ import Data.Ord ( comparing ) import Data.Either ( partitionEithers ) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import qualified Data.Semigroup as Semi {- ************************************************************************ @@ -2714,15 +2715,34 @@ hasFieldInfo_maybe rdr_env fam_inst_envs item -- (HF2e) It's a custom HasField constraint, not the one from GHC.Records. | Just (tc, _) <- splitTyConApp_maybe (errorItemPred item) - , getOccString tc == "HasField" - , isHasFieldOrigin (errorItemOrigin item) - = return $ Just $ CustomHasField tc + = do { rebindable_syntax <- xoptM LangExt.RebindableSyntax + ; return $ + if want_custom_hasfield_msg tc rebindable_syntax + then Just $ CustomHasField tc + else Nothing + } | otherwise = return Nothing where + orig = errorItemOrigin item + + want_custom_hasfield_msg tc rebindable_syntax + | getOccString tc == "HasField" + = Semi.getAny $ foldMapCtOrigin (Semi.Any . is_has_field) orig + | otherwise + = False + where + -- Handle custom 'getField'/'setField' with RebindableSyntax. + is_has_field (OccurrenceOf n) + | rebindable_syntax + , getOccString n `elem` ["getField", "setField"] + = True + is_has_field o + = isHasFieldOrigin o + get_parent_nm :: Name -> TcM (Maybe (Either PatSyn TyCon)) get_parent_nm nm = do { fld_id <- tcLookupId nm @@ -2762,22 +2782,6 @@ hasField_maybe pred = -- NB: we deliberately don't handle rebound 'HasField' (with -XRebindableSyntax), -- as GHC only has built-in instances for the built-in 'HasField' class. --- | Does this constraint arise from GHC internal mechanisms that desugar to --- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)? --- --- Just used heuristically to decide whether to print an informative message to --- the user (see (H2e) in Note [Error messages for unsolved HasField constraints]). -isHasFieldOrigin :: CtOrigin -> Bool -isHasFieldOrigin = \case - OccurrenceOf n -> - -- A heuristic... - getOccString n `elem` ["getField", "setField"] - OccurrenceOfRecSel {} -> True - RecordUpdOrigin {} -> True - RecordFieldProjectionOrigin {} -> True - GetFieldOrigin {} -> True - _ -> False - ----------------------- -- relevantBindings looks at the value environment and finds values whose -- types mention any of the offending type variables. It has to be ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -20,7 +20,7 @@ import GHC.Tc.Instance.Typeable import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence import GHC.Tc.Types.CtLoc -import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) ) +import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, isHasFieldOrigin ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs ) import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) @@ -1275,8 +1275,8 @@ warnIncompleteRecSel :: DynFlags -> Id -> CtLoc -> TcM () -- Warn about incomplete record selectors -- See (IRS6) in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc warnIncompleteRecSel dflags sel_id ct_loc - | not (isGetFieldOrigin (ctLocOrigin ct_loc)) - -- isGetFieldOrigin: see (IRS7) in + | not $ isHasFieldOrigin (ctLocOrigin ct_loc) + -- isHasFieldOrigin: see (IRS7) in -- Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc , RecSelId { sel_cons = RSI { rsi_undef = fallible_cons } } <- idDetails sel_id , not (null fallible_cons) @@ -1288,11 +1288,6 @@ warnIncompleteRecSel dflags sel_id ct_loc where maxCons = maxUncoveredPatterns dflags - -- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin, - -- despite the expansion to (getField @"x" r) - isGetFieldOrigin (GetFieldOrigin {}) = True - isGetFieldOrigin _ = False - lookupHasFieldLabel :: FamInstEnvs -> GlobalRdrEnv -> [Type] -> Maybe ( Name -- Name of the record selector ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -16,7 +16,8 @@ module GHC.Tc.Types.Origin ( CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, invisibleOrigin_maybe, isVisibleOrigin, toInvisibleOrigin, pprCtOrigin, pprCtOriginBriefly, isGivenOrigin, - defaultReprEqOrigins, isWantedSuperclassOrigin, + foldMapCtOrigin, + defaultReprEqOrigins, isWantedSuperclassOrigin, isHasFieldOrigin, ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..), HsImplicitLiftSplice(..), StandaloneDeriv, @@ -52,6 +53,8 @@ import GHC.Tc.Utils.TcType import GHC.Hs +import GHC.Builtin.Names (getFieldName) + import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon @@ -79,6 +82,8 @@ import GHC.Types.Unique.Supply import qualified Data.Kind as Hs import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isNothing) +import qualified Data.Semigroup as Semi +import GHC.Generics {- ********************************************************************* * * @@ -993,6 +998,95 @@ pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear") pprNonLinearPatternReason OtherPatternReason = empty + +{- ********************************************************************* +* * + Recursing through CtOrigin +* * +********************************************************************* -} + +-- | Fold over a 'CtOrigin', looking through all recursive +-- occurrences of 'CtOrigin' within 'CtOrigin'. +foldMapCtOrigin :: forall m. Semigroup m => (CtOrigin -> m) -> CtOrigin -> m +foldMapCtOrigin f = go + where + go :: CtOrigin -> m + go orig = + case orig of + KindEqOrigin _ _ o _ -> recur o + CycleBreakerOrigin o -> recur o + WantedSuperclassOrigin _ o -> recur o + DefaultReprEqOrigin _ _ o -> recur o + ScOrigin cls_or_qc _sc_flag -> + case cls_or_qc of + IsQC _ o -> recur o + IsClsInst -> f orig + + -- Explicit pattern match on remaining constructors, in order to get + -- better pattern-match warnings when constructors are changed or + -- added/removed. This isn't entirely fool-proof, as someone may still + -- change the type of one of the fields and hide a 'CtOrigin' inside. + -- + -- This approach was chosen instead of using 'syb'/'GHC.Generics', + -- because those would require deriving 'Data.Data'/'Generic' on + -- a huge number of datatypes. + GivenOrigin {} -> f orig + GivenSCOrigin {} -> f orig + OccurrenceOf {} -> f orig + OccurrenceOfRecSel {} -> f orig + AppOrigin {} -> f orig + SpecPragOrigin {} -> f orig + TypeEqOrigin {}-> f orig + IPOccOrigin {} -> f orig + OverLabelOrigin {} -> f orig + LiteralOrigin {} -> f orig + QualLiteralOrigin {} -> f orig + NegateOrigin {} -> f orig + ArithSeqOrigin {} -> f orig + AssocFamPatOrigin {} -> f orig + SectionOrigin {} -> f orig + GetFieldOrigin {} -> f orig + RecordFieldProjectionOrigin {} -> f orig + TupleOrigin {} -> f orig + ExprSigOrigin {} -> f orig + PatSigOrigin {} -> f orig + PatOrigin {} -> f orig + ProvCtxtOrigin {} -> f orig + RecordUpdOrigin {} -> f orig + ViewPatOrigin {} -> f orig + DerivOrigin {} -> f orig + DerivOriginDC {} -> f orig + DerivOriginCoerce {} -> f orig + DefaultOrigin {} -> f orig + DoOrigin {} -> f orig + DoPatOrigin {} -> f orig + MCompOrigin {} -> f orig + MCompPatOrigin {} -> f orig + ProcOrigin {} -> f orig + ArrowCmdOrigin {} -> f orig + AnnOrigin {} -> f orig + FunDepOrigin {} -> f orig + ExprHoleOrigin {} -> f orig + TypeHoleOrigin {} -> f orig + PatCheckOrigin {} -> f orig + ListOrigin {} -> f orig + IfThenElseOrigin {} -> f orig + BracketOrigin {} -> f orig + StaticOrigin {} -> f orig + ImpedanceMatching {} -> f orig + Shouldn'tHappenOrigin {} -> f orig + InstProvidedOrigin {} -> f orig + NonLinearPatternOrigin {} -> f orig + OmittedFieldOrigin {} -> f orig + UsageEnvironmentOf {} -> f orig + FRROrigin {} -> f orig + InstanceSigOrigin {} -> f orig + AmbiguityCheckOrigin {} -> f orig + ImplicitLiftOrigin {} -> f orig + + where + recur o = f orig Semi.<> go o + {- ********************************************************************* * * Defaulting of representational equalities @@ -1004,21 +1098,10 @@ pprNonLinearPatternReason OtherPatternReason = empty -- That is, this function extracts all occurrences of the 'DefaultReprEqOrigin' -- constructor from within a 'CtOrigin'. defaultReprEqOrigins :: CtOrigin -> [(CtOrigin, (TcType, TcType))] -defaultReprEqOrigins = go +defaultReprEqOrigins = foldMapCtOrigin go where go = \case - DefaultReprEqOrigin l r o -> (o, (l, r)) : go o - - -- Handle recursive occurrences of 'CtOrigin' within 'CtOrigin'. - -- TODO: use syb to derive this, so that the following never goes out of date. - ScOrigin cls_or_qc _ -> - case cls_or_qc of - IsClsInst -> [] - IsQC _ o -> go o - KindEqOrigin _ _ o _ -> go o - CycleBreakerOrigin o -> go o - WantedSuperclassOrigin _ o -> go o - + DefaultReprEqOrigin l r o -> [(o, (l, r))] _ -> [] {- ********************************************************************* @@ -1046,6 +1129,37 @@ isPushCallStackOrigin_maybe orig = Just orig_fs where orig_fs = mkFastString (showSDocUnsafe (pprCtOriginBriefly orig)) +{- ********************************************************************* +* * + HasField and CtOrigin +* * +********************************************************************* -} + +-- | Does this constraint arise from GHC internal mechanisms that desugar to +-- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)? +-- +-- Used in two places: +-- +-- - When reporting an unsolved 'HasField' constraint, to decide whether to +-- print an informative message to the user. +-- See (H2e) in Note [Error messages for unsolved HasField constraints] +-- in GHC.Tc.Errors. +-- - To avoid emitting a poor "incomplete record selector" warning directly +-- in typechecker, in cases when the desugarer will be able to emit a better +-- error message, due to having better pattern match checking information. +-- See (IRS7) in Note [Detecting incomplete record selectors] +-- in GHC.HsToCore.Pmc +isHasFieldOrigin :: CtOrigin -> Bool +isHasFieldOrigin = Semi.getAny . foldMapCtOrigin (Semi.Any . go) + where + go = \case + OccurrenceOf n -> n == getFieldName + OccurrenceOfRecSel {} -> True + RecordFieldProjectionOrigin {} -> True + GetFieldOrigin {} -> True + RecordUpdOrigin {} -> True + _ -> False + {- ************************************************************************ * * ===================================== testsuite/tests/overloadedrecflds/should_compile/T26686.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE GADTs #-} + +{-# OPTIONS_GHC -Wincomplete-record-selectors #-} + +module T26686 where + +import Data.Kind + +data A +data B + +data G = G { f2 :: Int } + +data T x where + TA :: { ta :: G } -> T x + TB :: { tb :: G } -> T B + +data H a = H { f1 :: T a } + +test1_ok :: T A -> G +test1_ok = (.ta) +test2_ok :: T A -> Int +test2_ok = (.ta.f2) +test3_ok :: H A -> G +test3_ok = (.f1.ta) +test4_ok :: H A -> Int +test4_ok = (.f1.ta.f2) + +test1_bad :: T x -> G +test1_bad = (.ta) +test2_bad :: T x -> Int +test2_bad = (.ta.f2) +test3_bad :: H x -> G +test3_bad = (.f1.ta) +test4_bad :: H x -> Int +test4_bad = (.f1.ta.f2) ===================================== testsuite/tests/overloadedrecflds/should_compile/T26686.stderr ===================================== @@ -0,0 +1,16 @@ +T26686.hs:31:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:33:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:35:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:37:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -30,6 +30,7 @@ test('T21720', req_th, compile, ['']) test('T21898', normal, compile, ['']) test('T22160', [extra_files(['T22160_A.hs', 'T22160_B.hs', 'T22160_C.hs'])] , multimod_compile, ['T22160_A T22160_B T22160_C T22160', '-v0']) +test('T26686', normal, compile, ['']) test('DupFldFixity3', normal, compile, ['']) test('overloadedrecflds10' , [extra_files(['OverloadedRecFlds10_A.hs', 'OverloadedRecFlds10_B.hs', 'OverloadedRecFlds10_C.hs'])] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52c3e6ba9f03d19a4fa85aee6a4c417b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52c3e6ba9f03d19a4fa85aee6a4c417b... You're receiving this email because of your account on gitlab.haskell.org.