diff options
| author | Adam Gundry <adam@well-typed.com> | 2020-12-23 22:22:08 +0000 |
|---|---|---|
| committer | Adam Gundry <adam@well-typed.com> | 2021-02-05 21:43:48 +0000 |
| commit | c375a07d92b141220242946fc06c74b5d2c1f53f (patch) | |
| tree | 7e836a34e4d77ee5e1bb277b0c23b9c34230cabc | |
| parent | ddbdec4128f0e6760c8c7a19344f2f2a7a3314bf (diff) | |
| download | haskell-c375a07d92b141220242946fc06c74b5d2c1f53f.tar.gz | |
Implement NoFieldSelectors extension (ghc-proposals 160)
Fixes #5972. This adds an extension NoFieldSelectors to disable the generation
of selector functions corresponding to record fields. When this extension is
enabled, record field selectors are not accessible as functions, but users are
still able to use them for record construction, pattern matching and updates.
See Note [NoFieldSelectors] in GHC.Rename.Env for details.
Defining the same field multiple times requires the DuplicateRecordFields
extension to be enabled, even when NoFieldSelectors is in use.
Along the way, this fixes the use of non-imported DuplicateRecordFields in GHCi
with -fimplicit-import-qualified (fixes #18729).
Moreover, it extends DisambiguateRecordFields to ignore non-fields when looking
up fields in record updates (fixes #18999), as described by
Note [DisambiguateRecordFields for updates].
Co-authored-by: Simon Hafner <hafnersimon@gmail.com>
Co-authored-by: Fumiaki Kinoshita <fumiexcel@gmail.com>
64 files changed, 1236 insertions, 265 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 85f1b71852..0b070f5e3e 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -35,6 +35,8 @@ module GHC.Driver.Session ( wopt_fatal, wopt_set_fatal, wopt_unset_fatal, xopt, xopt_set, xopt_unset, xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, lang_set, DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed, dynamicOutputFile, @@ -253,6 +255,7 @@ import qualified GHC.Utils.Ppr as Pretty import GHC.Types.SrcLoc import GHC.Types.SafeHaskell import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf ) +import qualified GHC.Types.FieldLabel as FieldLabel import GHC.Data.FastString import GHC.Utils.Fingerprint import GHC.Utils.Outputable @@ -1487,6 +1490,7 @@ languageExtensions (Just Haskell98) LangExt.NPlusKPatterns, LangExt.DatatypeContexts, LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, LangExt.NondecreasingIndentation -- strictly speaking non-standard, but we always had this -- on implicitly before the option was added in 7.1, and @@ -1507,6 +1511,7 @@ languageExtensions (Just Haskell2010) LangExt.ForeignFunctionInterface, LangExt.PatternGuards, LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, LangExt.RelaxedPolyRec] hasPprDebug :: DynFlags -> Bool @@ -1643,6 +1648,16 @@ xopt_set_unlessExplSpec ext setUnset dflags = in if ext `elem` referedExts then dflags else setUnset dflags ext +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + lang_set :: DynFlags -> Maybe Language -> DynFlags lang_set dflags lang = dflags { @@ -3611,6 +3626,7 @@ xFlagsDeps = [ depFlagSpec' "DoRec" LangExt.RecursiveDo (deprecatedForExtension "RecursiveDo"), flagSpec "DuplicateRecordFields" LangExt.DuplicateRecordFields, + flagSpec "FieldSelectors" LangExt.FieldSelectors, flagSpec "EmptyCase" LangExt.EmptyCase, flagSpec "EmptyDataDecls" LangExt.EmptyDataDecls, flagSpec "EmptyDataDeriving" LangExt.EmptyDataDeriving, diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 242c893807..684ae41e65 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -2037,7 +2037,7 @@ instance ToHie (IEContext (LIEWrappedName Name)) where ] instance ToHie (IEContext (Located FieldLabel)) where - toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of - FieldLabel _ _ n -> - [ toHie $ C (IEThing c) $ L span n - ] + toHie (IEC c (L span lbl)) = concatM + [ makeNode lbl span + , toHie $ C (IEThing c) $ L span (flSelector lbl) + ] diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs index f523d24625..18ec136726 100644 --- a/compiler/GHC/Iface/Rename.hs +++ b/compiler/GHC/Iface/Rename.hs @@ -259,9 +259,9 @@ rnGreName (NormalGreName n) = NormalGreName <$> rnIfaceGlobal n rnGreName (FieldGreName fl) = FieldGreName <$> rnFieldLabel fl rnFieldLabel :: Rename FieldLabel -rnFieldLabel (FieldLabel l b sel) = do - sel' <- rnIfaceGlobal sel - return (FieldLabel l b sel') +rnFieldLabel fl = do + sel' <- rnIfaceGlobal (flSelector fl) + return (fl { flSelector = sel' }) diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index 6e0c19f190..26deaedae8 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} @@ -11,13 +13,19 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. module GHC.Rename.Env ( newTopSrcBinder, + lookupLocatedTopBndrRn, lookupTopBndrRn, + lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe, lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupLocalOccRn, lookupTypeOccRn, lookupGlobalOccRn, lookupGlobalOccRn_maybe, - lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, + + AmbiguousResult(..), + lookupExprOccRn, + lookupRecFieldOcc, + lookupRecFieldOcc_update, ChildLookupResult(..), lookupSubBndrOcc_helper, @@ -26,7 +34,7 @@ module GHC.Rename.Env ( HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigCtxtOccRn, - lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName, + lookupInstDeclBndr, lookupFamInstName, lookupConstructorFields, lookupGreAvailRn, @@ -89,8 +97,10 @@ import GHC.Rename.Utils import qualified Data.Semigroup as Semi import Data.Either ( partitionEithers ) import Data.List ( find, sortBy ) +import qualified Data.List.NonEmpty as NE import Control.Arrow ( first ) import Data.Function +import GHC.Types.FieldLabel {- ********************************************************* @@ -463,8 +473,8 @@ These variants should *not* attach any errors, as there are places where we want to attempt looking up a name, but it's not the end of the world if we don't find it. -For example, see lookupThName_maybe: It calls lookupGlobalOccRn_maybe multiple -times for varying names in different namespaces. lookupGlobalOccRn_maybe should +For example, see lookupThName_maybe: It calls lookupOccRn_maybe multiple +times for varying names in different namespaces. lookupOccRn_maybe should therefore never attach an error, instead just return a Nothing. For these _maybe/_either variant functions then, avoid calling further lookup @@ -478,7 +488,7 @@ counterparts. -- flag is on, take account of the data constructor name to -- disambiguate which field to use. -- --- See Note [DisambiguateRecordFields]. +-- See Note [DisambiguateRecordFields] and Note [NoFieldSelectors]. lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual -- Just con => use data con to disambiguate -> RdrName @@ -502,12 +512,45 @@ lookupRecFieldOcc mb_con rdr_name ; case mb_field of Just (fl, gre) -> do { addUsedGRE True gre ; return (flSelector fl) } - Nothing -> lookupGlobalOccRn rdr_name } + Nothing -> lookupGlobalOccRn' WantBoth rdr_name } -- See Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc] | otherwise -- This use of Global is right as we are looking up a selector which -- can only be defined at the top level. - = lookupGlobalOccRn rdr_name + = lookupGlobalOccRn' WantBoth rdr_name + +-- | Look up an occurrence of a field in a record update, returning the selector +-- name. +-- +-- Unlike construction and pattern matching with @-XDisambiguateRecordFields@ +-- (see 'lookupRecFieldOcc'), there is no data constructor to help disambiguate, +-- so this may be ambiguous if the field is in scope multiple times. However we +-- ignore non-fields in scope with the same name if @-XDisambiguateRecordFields@ +-- is on (see Note [DisambiguateRecordFields for updates]). +-- +-- Here a field is in scope even if @NoFieldSelectors@ was enabled at its +-- definition site (see Note [NoFieldSelectors]). +lookupRecFieldOcc_update + :: DuplicateRecordFields + -> RdrName + -> RnM AmbiguousResult +lookupRecFieldOcc_update dup_fields_ok rdr_name = do + disambig_ok <- xoptM LangExt.DisambiguateRecordFields + let want | disambig_ok = WantField + | otherwise = WantBoth + mr <- lookupGlobalOccRn_overloaded dup_fields_ok want rdr_name + case mr of + Just r -> return r + Nothing -- Try again if we previously looked only for fields, see + -- Note [DisambiguateRecordFields for updates] + | disambig_ok -> do mr' <- lookupGlobalOccRn_overloaded dup_fields_ok WantBoth rdr_name + case mr' of + Just r -> return r + Nothing -> unbound + | otherwise -> unbound + where + unbound = UnambiguousGre . NormalGreName <$> unboundName WL_Global rdr_name + {- Note [DisambiguateRecordFields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -554,6 +597,42 @@ GRE for `A.x` and the guard will succeed because the field RdrName `x` is unqualified. +Note [DisambiguateRecordFields for updates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are looking up record fields in record update, we can take advantage of +the fact that we know we are looking for a field, even though we do not know the +data constructor name (as in Note [DisambiguateRecordFields]), provided the +-XDisambiguateRecordFields flag is on. + +For example, consider: + + module N where + f = () + + {-# LANGUAGE DisambiguateRecordFields #-} + module M where + import N (f) + data T = MkT { f :: Int } + t = MkT { f = 1 } -- unambiguous because MkT determines which field we mean + u = t { f = 2 } -- unambiguous because we ignore the non-field 'f' + +This works by lookupRecFieldOcc_update using 'WantField :: FieldsOrSelectors' +when looking up the field name, so that 'filterFieldGREs' will later ignore any +non-fields in scope. Of course, if a record update has two fields in scope with +the same name, it is still ambiguous. + +If we do not find anything when looking only for fields, we try again allowing +fields or non-fields. This leads to a better error message if the user +mistakenly tries to use a non-field name in a record update: + + f = () + e x = x { f = () } + +Unlike with constructors or pattern-matching, we do not allow the module +qualifier to be omitted, because we do not have a data constructor from which to +determine it. + + Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Whenever we fail to find the field or it is not in scope, mb_field @@ -639,24 +718,24 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name -- constructors, neither of which is the parent. noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult noMatchingParentErr original_gres = do - overload_ok <- xoptM LangExt.DuplicateRecordFields + dup_fields_ok <- xoptM LangExt.DuplicateRecordFields case original_gres of [] -> return NameNotFound [g] -> return $ IncorrectParent parent (gre_name g) [p | Just p <- [getParent g]] - gss@(g:_:_) -> - if all isRecFldGRE gss && overload_ok + gss@(g:gss'@(_:_)) -> + if all isRecFldGRE gss && dup_fields_ok then return $ IncorrectParent parent (gre_name g) [p | x <- gss, Just p <- [getParent x]] - else mkNameClashErr gss + else mkNameClashErr $ g NE.:| gss' - mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult + mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult mkNameClashErr gres = do addNameClashErrRn rdr_name gres - return (FoundChild (gre_par (head gres)) (gre_name (head gres))) + return (FoundChild (gre_par (NE.head gres)) (gre_name (NE.head gres))) getParent :: GlobalRdrElt -> Maybe Name getParent (GRE { gre_par = p } ) = @@ -691,7 +770,7 @@ data DisambigInfo -- The GRE has no parent. It could be a pattern synonym. | DisambiguatedOccurrence GlobalRdrElt -- The parent of the GRE is the correct parent - | AmbiguousOccurrence [GlobalRdrElt] + | AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt) -- For example, two normal identifiers with the same name are in -- scope. They will both be resolved to "UniqueOccurrence" and the -- monoid will combine them to this failing case. @@ -711,13 +790,13 @@ instance Semi.Semigroup DisambigInfo where NoOccurrence <> m = m m <> NoOccurrence = m UniqueOccurrence g <> UniqueOccurrence g' - = AmbiguousOccurrence [g, g'] + = AmbiguousOccurrence $ g NE.:| [g'] UniqueOccurrence g <> AmbiguousOccurrence gs - = AmbiguousOccurrence (g:gs) + = AmbiguousOccurrence (g `NE.cons` gs) AmbiguousOccurrence gs <> UniqueOccurrence g' - = AmbiguousOccurrence (g':gs) + = AmbiguousOccurrence (g' `NE.cons` gs) AmbiguousOccurrence gs <> AmbiguousOccurrence gs' - = AmbiguousOccurrence (gs ++ gs') + = AmbiguousOccurrence (gs Semi.<> gs') instance Monoid DisambigInfo where mempty = NoOccurrence @@ -939,6 +1018,7 @@ lookupLocalOccRn rdr_name Nothing -> unboundName WL_LocalOnly rdr_name } -- lookupTypeOccRn looks up an optionally promoted RdrName. +-- Used for looking up type variables. lookupTypeOccRn :: RdrName -> RnM Name -- see Note [Demotion] lookupTypeOccRn rdr_name @@ -1065,15 +1145,29 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name [ fmap wrapper <$> lookupLocalOccRn_maybe rdr_name , globalLookup rdr_name ] +-- Used outside this module only by TH name reification (lookupName, lookupThName_maybe) lookupOccRn_maybe :: RdrName -> RnM (Maybe Name) lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id -lookupOccRn_overloaded :: Bool -> RdrName - -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok rdr_name - = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name +-- | Look up a 'RdrName' used as a variable in an expression. +-- +-- This may be a local variable, global variable, or one or more record selector +-- functions. It will not return record fields created with the +-- @NoFieldSelectors@ extension (see Note [NoFieldSelectors]). The +-- 'DuplicateRecordFields' argument controls whether ambiguous fields will be +-- allowed (resulting in an 'AmbiguousFields' result being returned). +-- +-- If the name is not in scope at the term level, but its promoted equivalent is +-- in scope at the type level, the lookup will succeed (so that the type-checker +-- can report a more informative error later). See Note [Promotion]. +-- +lookupExprOccRn + :: DuplicateRecordFields -> RdrName + -> RnM (Maybe AmbiguousResult) +lookupExprOccRn dup_fields_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup (UnambiguousGre . NormalGreName) rdr_name ; case mb_name of - Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + Nothing -> fmap @Maybe (UnambiguousGre . NormalGreName) <$> lookup_promoted rdr_name -- See Note [Promotion]. -- We try looking up the name as a -- type constructor or type variable, if @@ -1081,13 +1175,8 @@ lookupOccRn_overloaded overload_ok rdr_name p -> return p } where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] - - + global_lookup :: RdrName -> RnM (Maybe AmbiguousResult) + global_lookup = lookupGlobalOccRn_overloaded dup_fields_ok WantNormal lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name) -- Looks up a RdrName occurrence in the top-level @@ -1096,17 +1185,24 @@ lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name) -- No filter function; does not report an error on failure -- See Note [Errors in lookup functions] -- Uses addUsedRdrName to record use and deprecations +-- +-- Used directly only by getLocalNonValBinders (new_assoc). lookupGlobalOccRn_maybe rdr_name = - lookupExactOrOrig_maybe rdr_name id (lookupGlobalOccRn_base rdr_name) + lookupExactOrOrig_maybe rdr_name id (lookupGlobalOccRn_base WantNormal rdr_name) lookupGlobalOccRn :: RdrName -> RnM Name -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global -- environment. Adds an error message if the RdrName is not in scope. -- You usually want to use "lookupOccRn" which also looks in the local -- environment. -lookupGlobalOccRn rdr_name = +-- +-- Used by exports_from_avail +lookupGlobalOccRn = lookupGlobalOccRn' WantNormal + +lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name +lookupGlobalOccRn' fos rdr_name = lookupExactOrOrig rdr_name id $ do - mn <- lookupGlobalOccRn_base rdr_name + mn <- lookupGlobalOccRn_base fos rdr_name case mn of Just n -> return n Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) @@ -1116,11 +1212,11 @@ lookupGlobalOccRn rdr_name = -- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first. -- lookupQualifiedNameGHCi here is used when we're in GHCi and a name like -- 'Data.Map.elems' is typed, even if you didn't import Data.Map -lookupGlobalOccRn_base :: RdrName -> RnM (Maybe Name) -lookupGlobalOccRn_base rdr_name = +lookupGlobalOccRn_base :: FieldsOrSelectors -> RdrName -> RnM (Maybe Name) +lookupGlobalOccRn_base fos rdr_name = runMaybeT . msum . map MaybeT $ - [ fmap greMangledName <$> lookupGreRn_maybe rdr_name - , listToMaybe <$> lookupQualifiedNameGHCi rdr_name ] + [ fmap greMangledName <$> lookupGreRn_maybe fos rdr_name + , fmap greNameMangledName <$> lookupOneQualifiedNameGHCi fos rdr_name ] -- This test is not expensive, -- and only happens for failed lookups @@ -1135,37 +1231,139 @@ lookupInfoOccRn :: RdrName -> RnM [Name] lookupInfoOccRn rdr_name = lookupExactOrOrig rdr_name (:[]) $ do { rdr_env <- getGlobalRdrEnv - ; let ns = map greMangledName (lookupGRE_RdrName rdr_name rdr_env) - ; qual_ns <- lookupQualifiedNameGHCi rdr_name + ; let ns = map greMangledName (lookupGRE_RdrName' rdr_name rdr_env) + ; qual_ns <- map greNameMangledName <$> lookupQualifiedNameGHCi WantBoth rdr_name ; return (ns ++ (qual_ns `minusList` ns)) } -- | Like 'lookupOccRn_maybe', but with a more informative result if -- the 'RdrName' happens to be a record selector: -- --- * Nothing -> name not in scope (no error reported) --- * Just (Left x) -> name uniquely refers to x, --- or there is a name clash (reported) --- * Just (Right xs) -> name refers to one or more record selectors; --- if overload_ok was False, this list will be --- a singleton. - -lookupGlobalOccRn_overloaded :: Bool -> RdrName - -> RnM (Maybe (Either Name [Name])) -lookupGlobalOccRn_overloaded overload_ok rdr_name = - lookupExactOrOrig_maybe rdr_name (fmap Left) $ - do { res <- lookupGreRn_helper rdr_name - ; case res of - GreNotFound -> return Nothing - OneNameMatch gre -> do - let wrapper = if isRecFldGRE gre then Right . (:[]) else Left - return $ Just (wrapper (greMangledName gre)) - MultipleNames gres | all isRecFldGRE gres && overload_ok -> - -- Don't record usage for ambiguous selectors - -- until we know which is meant - return $ Just (Right (map greMangledName gres)) - MultipleNames gres -> do +-- * Nothing -> name not in scope (no error reported) +-- * Just (UnambiguousGre x) -> name uniquely refers to x, +-- or there is a name clash (reported) +-- * Just AmbiguousFields -> name refers to two or more record fields +-- (no error reported) +-- +-- See Note [ Unbound vs Ambiguous Names ]. +lookupGlobalOccRn_overloaded :: DuplicateRecordFields -> FieldsOrSelectors -> RdrName + -> RnM (Maybe AmbiguousResult) +lookupGlobalOccRn_overloaded dup_fields_ok fos rdr_name = + lookupExactOrOrig_maybe rdr_name (fmap (UnambiguousGre . NormalGreName)) $ + do { res <- lookupGreRn_helper fos rdr_name + ; case res of + GreNotFound -> fmap UnambiguousGre <$> lookupOneQualifiedNameGHCi fos rdr_name + OneNameMatch gre -> return $ Just (UnambiguousGre (gre_name gre)) + MultipleNames gres + | all isRecFldGRE gres + , dup_fields_ok == DuplicateRecordFields -> return $ Just AmbiguousFields + | otherwise -> do addNameClashErrRn rdr_name gres - return (Just (Left (greMangledName (head gres)))) } + return (Just (UnambiguousGre (gre_name (NE.head gres)))) } + + +-- | Result of looking up an occurrence that might be an ambiguous field. +data AmbiguousResult + = UnambiguousGre GreName + -- ^ Occurrence picked out a single name, which may or may not belong to a + -- field (or might be unbound, if an error has been reported already, per + -- Note [ Unbound vs Ambiguous Names ]). + | AmbiguousFields + -- ^ Occurrence picked out two or more fields, and no non-fields. For now + -- this is allowed by DuplicateRecordFields in certain circumstances, as the + -- type-checker may be able to disambiguate later. + + +{- +Note [NoFieldSelectors] +~~~~~~~~~~~~~~~~~~~~~~~ +The NoFieldSelectors extension allows record fields to be defined without +bringing the corresponding selector functions into scope. However, such fields +may still be used in contexts such as record construction, pattern matching or +update. This requires us to distinguish contexts in which selectors are required +from those in which any field may be used. For example: + + {-# LANGUAGE NoFieldSelectors #-} + module M (T(foo), foo) where -- T(foo) refers to the field, + -- unadorned foo to the value binding + data T = MkT { foo :: Int } + foo = () + + bar = foo -- refers to the value binding, field ignored + + module N where + import M (T(..)) + baz = MkT { foo = 3 } -- refers to the field + oops = foo -- an error: the field is in scope but the value binding is not + +Each 'FieldLabel' indicates (in the 'flHasFieldSelector' field) whether the +FieldSelectors extension was enabled in the defining module. This allows them +to be filtered out by 'filterFieldGREs'. + +Even when NoFieldSelectors is in use, we still generate selector functions +internally. For example, the expression + getField @"foo" t +or (with dot-notation) + t.foo +extracts the `foo` field of t::T, and hence needs the selector function +(see Note [HasField instances] in GHC.Tc.Instance.Class). In order to avoid +name clashes with normal bindings reusing the names, selector names for such +fields are mangled just as for DuplicateRecordFields (see Note [FieldLabel] in +GHC.Types.FieldLabel). + + +In many of the name lookup functions in this module we pass a FieldsOrSelectors +value, indicating what we are looking for: + + * WantNormal: fields are in scope only if they have an accompanying selector + function, e.g. we are looking up a variable in an expression + (lookupExprOccRn). + + * WantBoth: any name or field will do, regardless of whether the selector + function is available, e.g. record updates (lookupRecFieldOcc_update) with + NoDisambiguateRecordFields. + + * WantField: any field will do, regardless of whether the selector function is + available, but ignoring any non-field names, e.g. record updates + (lookupRecFieldOcc_update) with DisambiguateRecordFields. + +----------------------------------------------------------------------------------- + Context FieldsOrSelectors +----------------------------------------------------------------------------------- + Record construction/pattern match WantBoth if NoDisambiguateRecordFields + e.g. MkT { foo = 3 } (DisambiguateRecordFields is separate) + + Record update WantBoth if NoDisambiguateRecordFields + e.g. e { foo = 3 } WantField if DisambiguateRecordFields + + :info in GHCi WantBoth + + Variable occurrence in expression WantNormal + Type variable, data constructor + Pretty much everything else +----------------------------------------------------------------------------------- +-} + +-- | When looking up GREs, we may or may not want to include fields that were +-- defined in modules with @NoFieldSelectors@ enabled. See Note +-- [NoFieldSelectors]. +data FieldsOrSelectors + = WantNormal -- ^ Include normal names, and fields with selectors, but + -- ignore fields without selectors. + | WantBoth -- ^ Include normal names and all fields (regardless of whether + -- they have selectors). + | WantField -- ^ Include only fields, with or without selectors, ignoring + -- any non-fields in scope. + deriving Eq + +filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt] +filterFieldGREs fos = filter (allowGreName fos . gre_name) + +allowGreName :: FieldsOrSelectors -> GreName -> Bool +allowGreName WantBoth _ = True +allowGreName WantNormal (FieldGreName fl) = flHasFieldSelector fl == FieldSelectors +allowGreName WantNormal (NormalGreName _) = True +allowGreName WantField (FieldGreName _) = True +allowGreName WantField (NormalGreName _) = False -------------------------------------------------- @@ -1174,23 +1372,23 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name = data GreLookupResult = GreNotFound | OneNameMatch GlobalRdrElt - | MultipleNames [GlobalRdrElt] + | MultipleNames (NE.NonEmpty GlobalRdrElt) -lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) +lookupGreRn_maybe :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt) -- Look up the RdrName in the GlobalRdrEnv -- Exactly one binding: records it as "used", return (Just gre) -- No bindings: return Nothing -- Many bindings: report "ambiguous", return an arbitrary (Just gre) -- Uses addUsedRdrName to record use and deprecations -lookupGreRn_maybe rdr_name +lookupGreRn_maybe fos rdr_name = do - res <- lookupGreRn_helper rdr_name + res <- lookupGreRn_helper fos rdr_name case res of OneNameMatch gre -> return $ Just gre MultipleNames gres -> do traceRn "lookupGreRn_maybe:NameClash" (ppr gres) addNameClashErrRn rdr_name gres - return $ Just (head gres) + return $ Just (NE.head gres) GreNotFound -> return Nothing {- @@ -1222,14 +1420,16 @@ is enabled then we defer the selection until the typechecker. -- Internal Function -lookupGreRn_helper :: RdrName -> RnM GreLookupResult -lookupGreRn_helper rdr_name +lookupGreRn_helper :: FieldsOrSelectors -> RdrName -> RnM GreLookupResult +lookupGreRn_helper fos rdr_name = do { env <- getGlobalRdrEnv - ; case lookupGRE_RdrName rdr_name env of + ; case filterFieldGREs fos (lookupGRE_RdrName' rdr_name env) of [] -> return GreNotFound [gre] -> do { addUsedGRE True gre ; return (OneNameMatch gre) } - gres -> return (MultipleNames gres) } + -- Don't record usage for ambiguous names + -- until we know which is meant + (gre:gres) -> return (MultipleNames (gre NE.:| gres)) } lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo) -- Used in export lists @@ -1237,7 +1437,7 @@ lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo) -- Uses addUsedRdrName to record use and deprecations lookupGreAvailRn rdr_name = do - mb_gre <- lookupGreRn_helper rdr_name + mb_gre <- lookupGreRn_helper WantNormal rdr_name case mb_gre of GreNotFound -> do @@ -1395,12 +1595,49 @@ Note [Safe Haskell and GHCi] We DON'T do this Safe Haskell as we need to check imports. We can and should instead check the qualified import but at the moment this requires some refactoring so leave as a TODO --} +Note [DuplicateRecordFields and -fimplicit-import-qualified] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When DuplicateRecordFields is used, a single module can export the same OccName +multiple times, for example: + + module M where + data S = MkS { foo :: Int } + data T = MkT { foo :: Int } + +Now if we refer to M.foo via -fimplicit-import-qualified, we need to report an +ambiguity error. +-} -lookupQualifiedNameGHCi :: RdrName -> RnM [Name] -lookupQualifiedNameGHCi rdr_name + +-- | Like 'lookupQualifiedNameGHCi' but returning at most one name, reporting an +-- ambiguity error if there are more than one. +lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GreName) +lookupOneQualifiedNameGHCi fos rdr_name = do + gnames <- lookupQualifiedNameGHCi fos rdr_name + case gnames of + [] -> return Nothing + [gname] -> return (Just gname) + (gname:gnames') -> do addNameClashErrRn rdr_name (toGRE gname NE.:| map toGRE gnames') + return (Just (NormalGreName (mkUnboundNameRdr rdr_name))) + where + -- Fake a GRE so we can report a sensible name clash error if + -- -fimplicit-import-qualified is used with a module that exports the same + -- field name multiple times (see + -- Note [DuplicateRecordFields and -fimplicit-import-qualified]). + toGRE gname = GRE { gre_name = gname, gre_par = NoParent, gre_lcl = False, gre_imp = [is] } + is = ImpSpec { is_decl = ImpDeclSpec { is_mod = mod, is_as = mod, is_qual = True, is_dloc = noSrcSpan } + , is_item = ImpAll } + -- If -fimplicit-import-qualified succeeded, the name must be qualified. + (mod, _) = fromMaybe (pprPanic "lookupOneQualifiedNameGHCi" (ppr rdr_name)) (isQual_maybe rdr_name) + + +-- | Look up *all* the names to which the 'RdrName' may refer in GHCi (using +-- @-fimplicit-import-qualified@). This will normally be zero or one, but may +-- be more in the presence of @DuplicateRecordFields@. +lookupQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM [GreName] +lookupQualifiedNameGHCi fos rdr_name = -- We want to behave as we would for a source file import here, -- and respect hiddenness of modules/packages, hence loadSrcInterface. do { dflags <- getDynFlags @@ -1416,10 +1653,14 @@ lookupQualifiedNameGHCi rdr_name = do { res <- loadSrcInterface_maybe doc mod NotBoot Nothing ; case res of Succeeded iface - -> return [ name + -> return [ gname | avail <- mi_exports iface - , name <- availNames avail - , nameOccName name == occ ] + , gname <- availGreNames avail + , occName gname == occ + -- Include a field if it has a selector or we are looking for all fields; + -- see Note [NoFieldSelectors]. + , allowGreName fos gname + ] _ -> -- Either we couldn't load the interface, or -- we could but we didn't find the name in it diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index ab5330cce6..3b362d0729 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -47,6 +47,7 @@ import GHC.Rename.Pat import GHC.Driver.Session import GHC.Builtin.Names +import GHC.Types.FieldLabel import GHC.Types.Fixity import GHC.Types.Name import GHC.Types.Name.Set @@ -120,12 +121,13 @@ rnUnboundVar v = ; return (HsVar noExtField (noLoc n), emptyFVs) } rnExpr (HsVar _ (L l v)) - = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields - ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v - ; dflags <- getDynFlags + = do { dflags <- getDynFlags + ; let dup_fields_ok = xopt_DuplicateRecordFields dflags + ; mb_name <- lookupExprOccRn dup_fields_ok v + ; case mb_name of { Nothing -> rnUnboundVar v ; - Just (Left name) + Just (UnambiguousGre (NormalGreName name)) | name == nilDataConName -- Treat [] as an ExplicitList, so that -- OverloadedLists works correctly -- Note [Empty lists] in GHC.Hs.Expr @@ -134,12 +136,12 @@ rnExpr (HsVar _ (L l v)) | otherwise -> finishHsVar (L l name) ; - Just (Right [s]) -> - return ( HsRecFld noExtField (Unambiguous s (L l v) ), unitFV s) ; - Just (Right fs@(_:_:_)) -> - return ( HsRecFld noExtField (Ambiguous noExtField (L l v)) - , mkFVs fs); - Just (Right []) -> panic "runExpr/HsVar" } } + Just (UnambiguousGre (FieldGreName fl)) -> + let sel_name = flSelector fl in + return ( HsRecFld noExtField (Unambiguous sel_name (L l v) ), unitFV sel_name) ; + Just AmbiguousFields -> + return ( HsRecFld noExtField (Ambiguous noExtField (L l v) ), emptyFVs) } } + rnExpr (HsIPVar x v) = return (HsIPVar x v, emptyFVs) diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 7fd73855ba..622432bf4d 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -133,7 +133,9 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- Need to do this before (D2) because rnTopBindsLHS -- looks up those pattern synonyms (#9889) - extendPatSynEnv val_decls local_fix_env $ \pat_syn_bndrs -> do { + dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags ; + has_sel <- xopt_FieldSelectors <$> getDynFlags ; + extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env $ \pat_syn_bndrs -> do { -- (D2) Rename the left-hand sides of the value bindings. -- This depends on everything from (B) being in scope. @@ -2383,9 +2385,9 @@ rnRecConDeclFields con doc (L l fields) -- | Brings pattern synonym names and also pattern synonym selectors -- from record pattern synonyms into scope. -extendPatSynEnv :: HsValBinds GhcPs -> MiniFixityEnv +extendPatSynEnv :: DuplicateRecordFields -> FieldSelectors -> HsValBinds GhcPs -> MiniFixityEnv -> ([Name] -> TcRnIf TcGblEnv TcLclEnv a) -> TcM a -extendPatSynEnv val_decls local_fix_env thing = do { +extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do { names_with_fls <- new_ps val_decls ; let pat_syn_bndrs = concat [ name: map flSelector fields | (name, fields) <- names_with_fls ] @@ -2410,8 +2412,7 @@ extendPatSynEnv val_decls local_fix_env thing = do { = do bnd_name <- newTopSrcBinder (L bind_loc n) let field_occs = map ((\ f -> L (getLoc (rdrNameFieldOcc f)) f) . recordPatSynField) as - overload_ok <- xoptM LangExt.DuplicateRecordFields - flds <- mapM (newRecordSelector overload_ok [bnd_name]) field_occs + flds <- mapM (newRecordSelector dup_fields_ok has_sel [bnd_name]) field_occs return ((bnd_name, flds): names) | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n})) <- bind = do diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 0f6e4e1cce..99d2089799 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -665,9 +665,14 @@ extendGlobalRdrEnvRn avails new_fixities where -- See Note [Reporting duplicate local declarations] dups = filter isDupGRE (lookupGlobalRdrEnv env (greOccName gre)) - isDupGRE gre' = isLocalGRE gre' - && (not (isOverloadedRecFldGRE gre && isOverloadedRecFldGRE gre') - || (gre_name gre == gre_name gre')) + isDupGRE gre' = isLocalGRE gre' && not (isAllowedDup gre') + isAllowedDup gre' = + case (isRecFldGRE gre, isRecFldGRE gre') of + (True, True) -> gre_name gre /= gre_name gre' + && isDuplicateRecFldGRE gre' + (True, False) -> isNoFieldSelectorGRE gre + (False, True) -> isNoFieldSelectorGRE gre' + (False, False) -> False {- Note [Reporting duplicate local declarations] @@ -675,9 +680,9 @@ Note [Reporting duplicate local declarations] In general, a single module may not define the same OccName multiple times. This is checked in extendGlobalRdrEnvRn: when adding a new locally-defined GRE to the GlobalRdrEnv we report an error if there are already duplicates in the -environment. This establishes INVARIANT 1 of the GlobalRdrEnv, which says that -for a given OccName, all the GlobalRdrElts to which it maps must have distinct -'gre_name's. +environment. This establishes INVARIANT 1 (see comments on GlobalRdrEnv in +GHC.Types.Name.Reader), which says that for a given OccName, all the +GlobalRdrElts to which it maps must have distinct 'gre_name's. For example, the following will be rejected: @@ -685,17 +690,34 @@ For example, the following will be rejected: g x = x f x = x -- Duplicate! -Under what conditions will a GRE that exists already count as a duplicate of the -LocalDef GRE being added? - -* It must also be a LocalDef: the programmer is allowed to make a new local - definition that clashes with an imported one (although attempting to refer to - either may lead to ambiguity errors at use sites). For example, the following - definition is allowed: +Two GREs with the same OccName are OK iff: +------------------------------------------------------------------- + Existing GRE | Newly-defined GRE + | NormalGre FieldGre +------------------------------------------------------------------- + Imported | Always Always + | + Local NormalGre | Never NoFieldSelectors + | + Local FieldGre | NoFieldSelectors DuplicateRecordFields + | and not in same record +------------------------------------------------------------------- - +In this table "NoFieldSelectors" means "NoFieldSelectors was enabled at the +definition site of the fields; ditto "DuplicateRecordFields". These facts are +recorded in the 'FieldLabel' (but where both GREs are local, both will +necessarily have the same extensions enabled). + +More precisely: + +* The programmer is allowed to make a new local definition that clashes with an + imported one (although attempting to refer to either may lead to ambiguity + errors at use sites). For example, the following definition is allowed: import M (f) f x = x + Thus isDupGRE reports errors only if the existing GRE is a LocalDef. + * When DuplicateRecordFields is enabled, the same field label may be defined in multiple records. For example, this is allowed: @@ -704,8 +726,8 @@ LocalDef GRE being added? data S2 = MkS2 { f :: Int } Even though both fields have the same OccName, this does not violate INVARIANT - 1, because the fields have distinct selector names, which form part of the - gre_name (see Note [GreNames] in GHC.Types.Name.Reader). + 1 of the GlobalRdrEnv, because the fields have distinct selector names, which + form part of the gre_name (see Note [GreNames] in GHC.Types.Name.Reader). * However, we must be careful to reject the following (#9156): @@ -714,18 +736,32 @@ LocalDef GRE being added? In this case, both 'gre_name's are the same (because the fields belong to the same type), and adding them both to the environment would be a violation of - INVARIANT 1. Thus isDupGRE checks whether both GREs have the same gre_name. + INVARIANT 1. Thus isAllowedDup checks both GREs have distinct 'gre_name's + if they are both record fields. -* We also reject attempts to define a field and a non-field with the same - OccName (#17965): +* With DuplicateRecordFields, we reject attempts to define a field and a + non-field with the same OccName (#17965): {-# LANGUAGE DuplicateRecordFields #-} f x = x data T = MkT { f :: Int} In principle this could be supported, but the current "specification" of - DuplicateRecordFields does not allow it. Thus isDupGRE checks that *both* GREs - being compared are record fields. + DuplicateRecordFields does not allow it. Thus isAllowedDup checks for + DuplicateRecordFields only if *both* GREs being compared are record fields. + +* However, with NoFieldSelectors, it is possible by design to define a field and + a non-field with the same OccName: + + {-# LANGUAGE NoFieldSelectors #-} + f x = x + data T = MkT { f :: Int} + + Thus isAllowedDup checks for NoFieldSelectors if either the existing or the + new GRE are record fields. See Note [NoFieldSelectors] in GHC.Rename.Env. + +See also Note [Skipping ambiguity errors at use sites of local declarations] in +GHC.Rename.Utils. -} @@ -755,9 +791,10 @@ getLocalNonValBinders fixity_env hs_fords = foreign_decls }) = do { -- Process all type/class decls *except* family instances ; let inst_decls = tycl_decls >>= group_instds - ; overload_ok <- xoptM LangExt.DuplicateRecordFields + ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags + ; has_sel <- xopt_FieldSelectors <$> getDynFlags ; (tc_avails, tc_fldss) - <- fmap unzip $ mapM (new_tc overload_ok) + <- fmap unzip $ mapM (new_tc dup_fields_ok has_sel) (tyClGroupTyClDecls tycl_decls) ; traceRn "getLocalNonValBinders 1" (ppr tc_avails) ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env @@ -767,7 +804,7 @@ getLocalNonValBinders fixity_env -- Process all family instances -- to bring new data constructors into scope - ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok) + ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc dup_fields_ok has_sel) inst_decls -- Finish off with value binders: @@ -809,12 +846,12 @@ getLocalNonValBinders fixity_env new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name ; return (avail nm) } - new_tc :: Bool -> LTyClDecl GhcPs + new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_tc overload_ok tc_decl -- NOT for type/data instances + new_tc dup_fields_ok has_sel tc_decl -- NOT for type/data instances = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs - ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds + ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds ; let fld_env = case unLoc tc_decl of DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds' _ -> [] @@ -851,15 +888,15 @@ getLocalNonValBinders fixity_env find (\ fl -> flLabel fl == lbl) flds where lbl = occNameFS (rdrNameOcc rdr) - new_assoc :: Bool -> LInstDecl GhcPs + new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs -> RnM ([AvailInfo], [(Name, [FieldLabel])]) - new_assoc _ (L _ (TyFamInstD {})) = return ([], []) + new_assoc _ _ (L _ (TyFamInstD {})) = return ([], []) -- type instances don't bind new names - new_assoc overload_ok (L _ (DataFamInstD _ d)) - = do { (avail, flds) <- new_di overload_ok Nothing d + new_assoc dup_fields_ok has_sel (L _ (DataFamInstD _ d)) + = do { (avail, flds) <- new_di dup_fields_ok has_sel Nothing d ; return ([avail], flds) } - new_assoc overload_ok (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty + new_assoc dup_fields_ok has_sel (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty , cid_datafam_insts = adts }))) = do -- First, attempt to grab the name of the class from the instance. -- This step could fail if the instance is not headed by a class, @@ -883,35 +920,36 @@ getLocalNonValBinders fixity_env Nothing -> pure ([], []) Just cls_nm -> do (avails, fldss) - <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts + <- mapAndUnzipM (new_loc_di dup_fields_ok has_sel (Just cls_nm)) adts pure (avails, concat fldss) - new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs + new_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> DataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_di overload_ok mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl }) + new_di dup_fields_ok has_sel mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl }) = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl) ; let (bndrs, flds) = hsDataFamInstBinders dfid ; sub_names <- mapM newTopSrcBinder bndrs - ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds + ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds ; let avail = availTC (unLoc main_name) sub_names flds' -- main_name is not bound here! fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds' ; return (avail, fld_env) } - new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs + new_loc_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> LDataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d + new_loc_di dup_fields_ok has_sel mb_cls (L _ d) = new_di dup_fields_ok has_sel mb_cls d -newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel -newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!" -newRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld))) +newRecordSelector :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel +newRecordSelector _ _ [] _ = error "newRecordSelector: datatype has no constructors!" +newRecordSelector dup_fields_ok has_sel (dc:_) (L loc (FieldOcc _ (L _ fld))) = do { selName <- newTopSrcBinder $ L loc $ field ; return $ FieldLabel { flLabel = fieldLabelString - , flIsOverloaded = overload_ok + , flHasDuplicateRecordFields = dup_fields_ok + , flHasFieldSelector = has_sel , flSelector = selName } } where fieldLabelString = occNameFS $ rdrNameOcc fld - selOccName = fieldSelectorOccName fieldLabelString (nameOccName dc) overload_ok + selOccName = fieldSelectorOccName fieldLabelString (nameOccName dc) dup_fields_ok has_sel field | isExact fld = fld -- use an Exact RdrName as is to preserve the bindings -- of an already renamer-resolved field and its use @@ -1321,8 +1359,8 @@ mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt] mkChildEnv gres = foldr add emptyNameEnv gres where add gre env = case gre_par gre of - ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre - NoParent -> env + ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre + NoParent -> env findChildren :: NameEnv [a] -> Name -> [a] findChildren env n = lookupNameEnv env n `orElse` [] diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index 80341b27ac..a1bd52be3f 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -58,10 +58,10 @@ import GHC.Rename.Fixity import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames , warnUnusedMatches, newLocalBndrRn , checkUnusedRecordWildcard - , checkDupNames, checkDupAndShadowedNames - , unknownSubordinateErr ) + , checkDupNames, checkDupAndShadowedNames ) import GHC.Rename.HsType import GHC.Builtin.Names +import GHC.Types.Avail ( greNameMangledName ) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader @@ -75,12 +75,14 @@ import GHC.Types.SrcLoc import GHC.Types.Literal ( inCharRange ) import GHC.Builtin.Types ( nilDataCon ) import GHC.Core.DataCon +import GHC.Driver.Session ( getDynFlags, xopt_DuplicateRecordFields ) import qualified GHC.LanguageExtensions as LangExt import Control.Monad ( when, ap, guard, forM, unless ) import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.Ratio +import GHC.Types.FieldLabel (DuplicateRecordFields(..)) {- ********************************************************* @@ -748,8 +750,8 @@ rnHsRecUpdFields -> RnM ([LHsRecUpdField GhcRn], FreeVars) rnHsRecUpdFields flds = do { pun_ok <- xoptM LangExt.RecordPuns - ; overload_ok <- xoptM LangExt.DuplicateRecordFields - ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok overload_ok) flds + ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags + ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok dup_fields_ok) flds ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds -- Check for an empty record update e {} @@ -758,27 +760,16 @@ rnHsRecUpdFields flds ; return (flds1, plusFVs fvss) } where - doc = text "constructor field name" - - rn_fld :: Bool -> Bool -> LHsRecUpdField GhcPs + rn_fld :: Bool -> DuplicateRecordFields -> LHsRecUpdField GhcPs -> RnM (LHsRecUpdField GhcRn, FreeVars) - rn_fld pun_ok overload_ok (L l (HsRecField { hsRecFieldLbl = L loc f + rn_fld pun_ok dup_fields_ok (L l (HsRecField { hsRecFieldLbl = L loc f , hsRecFieldArg = arg , hsRecPun = pun })) = do { let lbl = rdrNameAmbiguousFieldOcc f - ; sel <- setSrcSpan loc $ + ; mb_sel <- setSrcSpan loc $ -- Defer renaming of overloaded fields to the typechecker -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head - if overload_ok - then do { mb <- lookupGlobalOccRn_overloaded - overload_ok lbl - ; case mb of - Nothing -> - do { addErr - (unknownSubordinateErr doc lbl) - ; return (Right []) } - Just r -> return r } - else fmap Left $ lookupGlobalOccRn lbl + lookupRecFieldOcc_update dup_fields_ok lbl ; arg' <- if pun then do { checkErr pun_ok (badPun (L loc lbl)) -- Discard any module qualifier (#11662) @@ -787,18 +778,12 @@ rnHsRecUpdFields flds else return arg ; (arg'', fvs) <- rnLExpr arg' - ; let fvs' = case sel of - Left sel_name -> fvs `addOneFV` sel_name - Right [sel_name] -> fvs `addOneFV` sel_name - Right _ -> fvs - lbl' = case sel of - Left sel_name -> - L loc (Unambiguous sel_name (L loc lbl)) - Right [sel_name] -> - L loc (Unambiguous sel_name (L loc lbl)) - Right _ -> L loc (Ambiguous noExtField (L loc lbl)) - - ; return (L l (HsRecField { hsRecFieldLbl = lbl' + ; let (lbl', fvs') = case mb_sel of + UnambiguousGre gname -> let sel_name = greNameMangledName gname + in (Unambiguous sel_name (L loc lbl), fvs `addOneFV` sel_name) + AmbiguousFields -> (Ambiguous noExtField (L loc lbl), fvs) + + ; return (L l (HsRecField { hsRecFieldLbl = L loc lbl' , hsRecFieldArg = arg'' , hsRecPun = pun }), fvs') } diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs index 88b23a8725..9ebd15e5f6 100644 --- a/compiler/GHC/Rename/Unbound.hs +++ b/compiler/GHC/Rename/Unbound.hs @@ -116,8 +116,27 @@ unknownNameSuggestions_ where_look dflags hpt curr_mod global_env local_env similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$ importSuggestions where_look global_env hpt curr_mod imports tried_rdr_name $$ - extensionSuggestions tried_rdr_name + extensionSuggestions tried_rdr_name $$ + fieldSelectorSuggestions global_env tried_rdr_name + +-- | When the name is in scope as field whose selector has been suppressed by +-- NoFieldSelectors, display a helpful message explaining this. +fieldSelectorSuggestions :: GlobalRdrEnv -> RdrName -> SDoc +fieldSelectorSuggestions global_env tried_rdr_name + | null gres = Outputable.empty + | otherwise = text "NB:" + <+> quotes (ppr tried_rdr_name) + <+> text "is a field selector" <+> whose + $$ text "that has been suppressed by NoFieldSelectors" + where + gres = filter isNoFieldSelectorGRE $ + lookupGRE_RdrName' tried_rdr_name global_env + parents = [ parent | ParentIs parent <- map gre_par gres ] + -- parents may be empty if this is a pattern synonym field without a selector + whose | null parents = empty + | otherwise = text "belonging to the type" <> plural parents + <+> pprQuotedList parents similarNameSuggestions :: WhereLooking -> DynFlags -> GlobalRdrEnv -> LocalRdrEnv @@ -180,6 +199,7 @@ similarNameSuggestions where_look dflags global_env | tried_is_qual = [ (rdr_qual, (rdr_qual, how)) | gre <- globalRdrEnvElts global_env , isGreOk where_look gre + , not (isNoFieldSelectorGRE gre) , let occ = greOccName gre , correct_name_space occ , (mod, how) <- qualsInScope gre @@ -188,6 +208,7 @@ similarNameSuggestions where_look dflags global_env | otherwise = [ (rdr_unqual, pair) | gre <- globalRdrEnvElts global_env , isGreOk where_look gre + , not (isNoFieldSelectorGRE gre) , let occ = greOccName gre rdr_unqual = mkRdrUnqual occ , correct_name_space occ diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 6bced4930d..2edd8a2663 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -492,17 +492,48 @@ wildcardDoc herald = $$ nest 2 (text "Possible fix" <> colon <+> text "omit the" <+> quotes (text "..")) -addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM () +{- +Note [Skipping ambiguity errors at use sites of local declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In general, we do not report ambiguous occurrences at use sites where all the +clashing names are defined locally, because the error will have been reported at +the definition site, and we want to avoid an error cascade. + +However, when DuplicateRecordFields is enabled, it is possible to define the +same field name multiple times, so we *do* need to report an error at the use +site when there is ambiguity between multiple fields. Moreover, when +NoFieldSelectors is enabled, it is possible to define a field with the same name +as a non-field, so again we need to report ambiguity at the use site. + +We can skip reporting an ambiguity error whenever defining the GREs must have +yielded a duplicate declarations error. More precisely, we can skip if: + + * there are at least two non-fields amongst the GREs; or + + * there are at least two fields amongst the GREs, and DuplicateRecordFields is + *disabled*; or + + * there is at least one non-field, at least one field, and NoFieldSelectors is + *disabled*. + +These conditions ensure that a duplicate local declaration will have been +reported. See also Note [Reporting duplicate local declarations] in +GHC.Rename.Names). + +-} + +addNameClashErrRn :: RdrName -> NE.NonEmpty GlobalRdrElt -> RnM () addNameClashErrRn rdr_name gres - | all isLocalGRE gres && not (all isRecFldGRE gres) - -- If there are two or more *local* defns, we'll have reported - = return () -- that already, and we don't want an error cascade + | all isLocalGRE gres && can_skip + -- If there are two or more *local* defns, we'll usually have reported that + -- already, and we don't want an error cascade. + = return () | otherwise = addErr (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) , text "It could refer to" , nest 3 (vcat (msg1 : msgs)) ]) where - (np1:nps) = gres + np1 NE.:| nps = gres msg1 = text "either" <+> ppr_gre np1 msgs = [text " or" <+> ppr_gre np | np <- nps] ppr_gre gre = sep [ pp_greMangledName gre <> comma @@ -533,6 +564,18 @@ addNameClashErrRn rdr_name gres = pprPanic "addNameClassErrRn" (ppr gre $$ ppr iss) -- Invariant: either 'lcl' is True or 'iss' is non-empty + -- If all the GREs are defined locally, can we skip reporting an ambiguity + -- error at use sites, because it will have been reported already? See + -- Note [Skipping ambiguity errors at use sites of local declarations] + can_skip = num_non_flds >= 2 + || (num_flds >= 2 && not (isDuplicateRecFldGRE (head flds))) + || (num_non_flds >= 1 && num_flds >= 1 + && not (isNoFieldSelectorGRE (head flds))) + (flds, non_flds) = NE.partition isRecFldGRE gres + num_flds = length flds + num_non_flds = length non_flds + + shadowedNameWarn :: OccName -> [SDoc] -> SDoc shadowedNameWarn occ shadowed_locs = sep [text "This binding for" <+> quotes (ppr occ) diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs index 114e339dec..fe6dcfd88d 100644 --- a/compiler/GHC/Tc/Gen/Export.hs +++ b/compiler/GHC/Tc/Gen/Export.hs @@ -8,6 +8,7 @@ module GHC.Tc.Gen.Export (tcRnExports, exports_from_avail) where import GHC.Prelude import GHC.Hs +import GHC.Types.FieldLabel import GHC.Builtin.Names import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env @@ -22,7 +23,6 @@ import GHC.Core.TyCon import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.ConLike -import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Data.Maybe import GHC.Utils.Misc (capitalise) diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 2d5a49f2e6..7d7b34e9d3 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -1283,7 +1283,6 @@ getFixedTyVars upd_fld_occs univ_tvs cons , (tv1,tv) <- univ_tvs `zip` u_tvs , tv `elemVarSet` fixed_tvs ] - -- Disambiguate the fields in a record update. -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType @@ -1316,7 +1315,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty , [(RecSelParent, GlobalRdrElt)])] getUpdFieldsParents = fmap (zip rbnds) $ mapM - (lookupParents . unLoc . hsRecUpdFieldRdr . unLoc) + (lookupParents False . unLoc . hsRecUpdFieldRdr . unLoc) rbnds -- Given a the lists of possible parents for each field, diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index fa642131c1..eb5da5ca26 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -73,6 +73,7 @@ import GHC.Utils.Panic import Control.Monad import Data.Function +import qualified Data.List.NonEmpty as NE #include "HsVersions.h" @@ -539,7 +540,7 @@ finish_ambiguous_selector lr@(L _ rdr) parent_type Nothing -> ambiguousSelector lr ; Just p -> - do { xs <- lookupParents rdr + do { xs <- lookupParents True rdr ; let parent = RecSelData p ; case lookup parent xs of { Nothing -> failWithTc (fieldNotInType parent rdr) ; @@ -561,7 +562,9 @@ addAmbiguousNameErr :: RdrName -> TcM () addAmbiguousNameErr rdr = do { env <- getGlobalRdrEnv ; let gres = lookupGRE_RdrName rdr env - ; setErrCtxt [] $ addNameClashErrRn rdr gres} + ; case gres of + [] -> panic "addAmbiguousNameErr: not found" + gre : gres -> setErrCtxt [] $ addNameClashErrRn rdr $ gre NE.:| gres} -- A type signature on the argument of an ambiguous record selector or -- the record expression in an update must be "obvious", i.e. the @@ -590,10 +593,15 @@ tyConOfET fam_inst_envs ty0 = tyConOf fam_inst_envs =<< checkingExpType_maybe ty -- For an ambiguous record field, find all the candidate record -- selectors (as GlobalRdrElts) and their parents. -lookupParents :: RdrName -> RnM [(RecSelParent, GlobalRdrElt)] -lookupParents rdr +lookupParents :: Bool -> RdrName -> RnM [(RecSelParent, GlobalRdrElt)] +lookupParents is_selector rdr = do { env <- getGlobalRdrEnv - ; let gres = lookupGRE_RdrName rdr env + -- Filter by isRecFldGRE because otherwise a non-selector variable with + -- an overlapping name can get through when NoFieldSelectors is enabled. + -- See Note [NoFieldSelectors] in GHC.Rename.Env. + ; let all_gres = lookupGRE_RdrName' rdr env + ; let gres | is_selector = filter isFieldSelectorGRE all_gres + | otherwise = filter isRecFldGRE all_gres ; mapM lookupParent gres } where lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt) diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 4e26509606..d918e5eadb 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -92,6 +92,7 @@ import GHC.Core.PatSyn import GHC.Core.ConLike import GHC.Core.DataCon as DataCon +import GHC.Types.FieldLabel import GHC.Types.SrcLoc import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -1497,11 +1498,8 @@ lookupName :: Bool -- True <=> type namespace -- False <=> value namespace -> String -> TcM (Maybe TH.Name) lookupName is_type_name s - = do { lcl_env <- getLocalRdrEnv - ; case lookupLocalRdrEnv lcl_env rdr_name of - Just n -> return (Just (reifyName n)) - Nothing -> do { mb_nm <- lookupGlobalOccRn_maybe rdr_name - ; return (fmap reifyName mb_nm) } } + = do { mb_nm <- lookupOccRn_maybe rdr_name + ; return (fmap reifyName mb_nm) } where th_name = TH.mkName s -- Parses M.x into a base of 'x' and a module of 'M' @@ -1550,18 +1548,10 @@ lookupThName th_name = do lookupThName_maybe :: TH.Name -> TcM (Maybe Name) lookupThName_maybe th_name - = do { names <- mapMaybeM lookup (thRdrNameGuesses th_name) + = do { names <- mapMaybeM lookupOccRn_maybe (thRdrNameGuesses th_name) -- Pick the first that works -- E.g. reify (mkName "A") will pick the class A in preference to the data constructor A ; return (listToMaybe names) } - where - lookup rdr_name - = do { -- Repeat much of lookupOccRn, because we want - -- to report errors in a TH-relevant way - ; rdr_env <- getLocalRdrEnv - ; case lookupLocalRdrEnv rdr_env rdr_name of - Just name -> return (Just name) - Nothing -> lookupGlobalOccRn_maybe rdr_name } tcLookupTh :: Name -> TcM TcTyThing -- This is a specialised version of GHC.Tc.Utils.Env.tcLookup; specialised mainly in that diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 338e24153c..2577de341e 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -60,7 +60,7 @@ import GHC.Types.FieldLabel import GHC.Rename.Env import GHC.Data.Bag import GHC.Utils.Misc -import GHC.Driver.Session ( getDynFlags ) +import GHC.Driver.Session ( getDynFlags, xopt_FieldSelectors ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) @@ -720,7 +720,8 @@ tc_patsyn_finish lname dir is_infix lpat' prag_fn field_labels -- Selectors - ; let rn_rec_sel_binds = mkPatSynRecSelBinds patSyn (patSynFieldLabels patSyn) + ; has_sel <- xopt_FieldSelectors <$> getDynFlags + ; let rn_rec_sel_binds = mkPatSynRecSelBinds patSyn (patSynFieldLabels patSyn) has_sel tything = AConLike (PatSynCon patSyn) ; tcg_env <- tcExtendGlobalEnv [tything] $ tcRecSelBinds rn_rec_sel_binds @@ -825,9 +826,10 @@ tcPatSynMatcher (L loc name) lpat prag_fn mkPatSynRecSelBinds :: PatSyn -> [FieldLabel] -- ^ Visible field labels + -> FieldSelectors -> [(Id, LHsBind GhcRn)] -mkPatSynRecSelBinds ps fields - = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl +mkPatSynRecSelBinds ps fields has_sel + = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl has_sel | fld_lbl <- fields ] isUnidirectional :: HsPatSynDir a -> Bool diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index b9fb54cc9f..fe32ea6770 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -65,6 +65,7 @@ import GHC.Data.FastString import GHC.Unit.Module import GHC.Types.Basic +import GHC.Types.FieldLabel import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceText @@ -865,12 +866,13 @@ mkRecSelBinds tycons mkRecSelBind :: (TyCon, FieldLabel) -> (Id, LHsBind GhcRn) mkRecSelBind (tycon, fl) = mkOneRecordSelector all_cons (RecSelData tycon) fl + FieldSelectors -- See Note [NoFieldSelectors and naughty record selectors] where all_cons = map RealDataCon (tyConDataCons tycon) -mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel +mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors -> (Id, LHsBind GhcRn) -mkOneRecordSelector all_cons idDetails fl +mkOneRecordSelector all_cons idDetails fl has_sel = (sel_id, L loc sel_bind) where loc = getSrcSpan sel_name @@ -890,6 +892,7 @@ mkOneRecordSelector all_cons idDetails fl conLikeUserTyVarBinders con1 data_tv_set= tyCoVarsOfTypes inst_tys is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) + || has_sel == NoFieldSelectors sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] | otherwise = mkForAllTys (tyVarSpecToBinders data_tvbs) $ mkPhiTy (conLikeStupidTheta con1) $ -- Urgh! @@ -1032,6 +1035,26 @@ so that the later type-check will add them to the environment, and they'll be exported. The function is never called, because the typechecker spots the sel_naughty field. +Note [NoFieldSelectors and naughty record selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Under NoFieldSelectors (see Note [NoFieldSelectors] in GHC.Rename.Env), record +selectors will not be in scope in the renamer. However, for normal datatype +declarations we still generate the underlying selector functions, so they can be +used for constructing the dictionaries for HasField constraints (as described by +Note [HasField instances] in GHC.Tc.Instance.Class). Hence the call to +mkOneRecordSelector in mkRecSelBind always uses FieldSelectors. + +However, record pattern synonyms are not used with HasField, so when +NoFieldSelectors is used we do not need to generate selector functions. Thus +mkPatSynRecSelBinds passes the current state of the FieldSelectors extension to +mkOneRecordSelector, and in the NoFieldSelectors case it will treat them as +"naughty" fields (see Note [Naughty record selectors]). + +Why generate a naughty binding, rather than no binding at all? Because when +type-checking a record update, we need to look up Ids for the fields. In +particular, disambiguateRecordBinds calls lookupParents which needs to look up +the RecSelIds to determine the sel_tycon. + Note [GADT record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For GADTs, we require that all constructors with a common field 'f' have the same diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs index 61d9d91b0a..e3e821deca 100644 --- a/compiler/GHC/Types/Avail.hs +++ b/compiler/GHC/Types/Avail.hs @@ -96,13 +96,13 @@ datatype like gives rise to the AvailInfo - AvailTC T [T, MkT, FieldLabel "foo" False foo] + AvailTC T [T, MkT, FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo] whereas if -XDuplicateRecordFields is enabled it gives - AvailTC T [T, MkT, FieldLabel "foo" True $sel:foo:MkT] + AvailTC T [T, MkT, FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkT] -since the label does not match the selector name. +where the label foo does not match the selector name $sel:foo:MkT. The labels in a field list are not necessarily unique: data families allow the same parent (the family tycon) to have @@ -115,25 +115,25 @@ multiple distinct fields with the same label. For example, gives rise to AvailTC F [ F, MkFInt, MkFBool - , FieldLabel "foo" True $sel:foo:MkFInt - , FieldLabel "foo" True $sel:foo:MkFBool ] + , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt + , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFBool ] -Moreover, note that the flIsOverloaded flag need not be the same for -all the elements of the list. In the example above, this occurs if -the two data instances are defined in different modules, one with -`-XDuplicateRecordFields` enabled and one with it disabled. Thus it -is possible to have +Moreover, note that the flHasDuplicateRecordFields or flFieldSelectors flags +need not be the same for all the elements of the list. In the example above, +this occurs if the two data instances are defined in different modules, with +different states of the `-XDuplicateRecordFields` or `-XNoFieldSelectors` +extensions. Thus it is possible to have AvailTC F [ F, MkFInt, MkFBool - , FieldLabel "foo" True $sel:foo:MkFInt - , FieldLabel "foo" False foo ] - -If the two data instances are defined in different modules, both -without `-XDuplicateRecordFields`, it will be impossible to export -them from the same module (even with `-XDuplicateRecordfields` -enabled), because they would be represented identically. The -workaround here is to enable `-XDuplicateRecordFields` on the defining -modules. + , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt + , FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo ] + +If the two data instances are defined in different modules, both without +`-XDuplicateRecordFields` or `-XNoFieldSelectors`, it will be impossible to +export them from the same module (even with `-XDuplicateRecordfields` enabled), +because they would be represented identically. The workaround here is to enable +`-XDuplicateRecordFields` or `-XNoFieldSelectors` on the defining modules. See +also #13352. Note [Representing pattern synonym fields in AvailInfo] diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs index 87f0b9eed8..12dedda5ca 100644 --- a/compiler/GHC/Types/FieldLabel.hs +++ b/compiler/GHC/Types/FieldLabel.hs @@ -12,25 +12,32 @@ Note [FieldLabel] This module defines the representation of FieldLabels as stored in TyCons. As well as a selector name, these have some extra structure -to support the DuplicateRecordFields extension. +to support the DuplicateRecordFields and NoFieldSelectors extensions. -In the normal case (with NoDuplicateRecordFields), a datatype like +In the normal case (with NoDuplicateRecordFields and FieldSelectors), +a datatype like data T = MkT { foo :: Int } has - FieldLabel { flLabel = "foo" - , flIsOverloaded = False - , flSelector = foo }. + FieldLabel { flLabel = "foo" + , flHasDuplicateRecordFields = NoDuplicateRecordFields + , flHasFieldSelector = FieldSelectors + , flSelector = foo }. In particular, the Name of the selector has the same string representation as the label. If DuplicateRecordFields is enabled, however, the same declaration instead gives - FieldLabel { flLabel = "foo" - , flIsOverloaded = True - , flSelector = $sel:foo:MkT }. + FieldLabel { flLabel = "foo" + , flHasDuplicateRecordFields = DuplicateRecordFields + , flHasFieldSelector = FieldSelectors + , flSelector = $sel:foo:MkT }. + +Similarly, the selector name will be mangled if NoFieldSelectors is used +(whether or not DuplicateRecordFields is enabled). See Note [NoFieldSelectors] +in GHC.Rename.Env. Now the name of the selector ($sel:foo:MkT) does not match the label of the field (foo). We must be careful not to show the selector name to @@ -69,6 +76,9 @@ module GHC.Types.FieldLabel , FieldLabel(..) , fieldSelectorOccName , fieldLabelPrintableName + , DuplicateRecordFields(..) + , FieldSelectors(..) + , flIsOverloaded ) where @@ -82,6 +92,7 @@ import GHC.Data.FastString.Env import GHC.Utils.Outputable import GHC.Utils.Binary +import Data.Bool import Data.Data -- | Field labels are just represented as strings; @@ -91,13 +102,17 @@ type FieldLabelString = FastString -- | A map from labels to all the auxiliary information type FieldLabelEnv = DFastStringEnv FieldLabel - -- | Fields in an algebraic record type; see Note [FieldLabel]. data FieldLabel = FieldLabel { - flLabel :: FieldLabelString, -- ^ User-visible label of the field - flIsOverloaded :: Bool, -- ^ Was DuplicateRecordFields on - -- in the defining module for this datatype? - flSelector :: Name -- ^ Record selector function + flLabel :: FieldLabelString, + -- ^ User-visible label of the field + flHasDuplicateRecordFields :: DuplicateRecordFields, + -- ^ Was @DuplicateRecordFields@ on in the defining module for this datatype? + flHasFieldSelector :: FieldSelectors, + -- ^ Was @FieldSelectors@ enabled in the defining module for this datatype? + -- See Note [NoFieldSelectors] in GHC.Rename.Env + flSelector :: Name + -- ^ Record selector function } deriving (Data, Eq) @@ -105,31 +120,65 @@ instance HasOccName FieldLabel where occName = mkVarOccFS . flLabel instance Outputable FieldLabel where - ppr fl = ppr (flLabel fl) <> whenPprDebug (braces (ppr (flSelector fl))) + ppr fl = ppr (flLabel fl) <> whenPprDebug (braces (ppr (flSelector fl)) + <> ppr (flHasDuplicateRecordFields fl) + <> ppr (flHasFieldSelector fl)) + +-- | Flag to indicate whether the DuplicateRecordFields extension is enabled. +data DuplicateRecordFields + = DuplicateRecordFields -- ^ Fields may be duplicated in a single module + | NoDuplicateRecordFields -- ^ Fields must be unique within a module (the default) + deriving (Show, Eq, Typeable, Data) + +instance Binary DuplicateRecordFields where + put_ bh f = put_ bh (f == DuplicateRecordFields) + get bh = bool NoDuplicateRecordFields DuplicateRecordFields <$> get bh + +instance Outputable DuplicateRecordFields where + ppr DuplicateRecordFields = text "+dup" + ppr NoDuplicateRecordFields = text "-dup" + + +-- | Flag to indicate whether the FieldSelectors extension is enabled. +data FieldSelectors + = FieldSelectors -- ^ Selector functions are available (the default) + | NoFieldSelectors -- ^ Selector functions are not available + deriving (Show, Eq, Typeable, Data) + +instance Binary FieldSelectors where + put_ bh f = put_ bh (f == FieldSelectors) + get bh = bool NoFieldSelectors FieldSelectors <$> get bh + +instance Outputable FieldSelectors where + ppr FieldSelectors = text "+sel" + ppr NoFieldSelectors = text "-sel" + -- | We need the @Binary Name@ constraint here even though there is an instance -- defined in "GHC.Types.Name", because the we have a SOURCE import, so the -- instance is not in scope. And the instance cannot be added to Name.hs-boot -- because "GHC.Utils.Binary" itself depends on "GHC.Types.Name". instance Binary Name => Binary FieldLabel where - put_ bh (FieldLabel aa ab ac) = do + put_ bh (FieldLabel aa ab ac ad) = do put_ bh aa put_ bh ab put_ bh ac + put_ bh ad get bh = do + aa <- get bh ab <- get bh ac <- get bh ad <- get bh - return (FieldLabel ab ac ad) + return (FieldLabel aa ab ac ad) -- | Record selector OccNames are built from the underlying field name -- and the name of the first data constructor of the type, to support -- duplicate record field names. -- See Note [Why selector names include data constructors]. -fieldSelectorOccName :: FieldLabelString -> OccName -> Bool -> OccName -fieldSelectorOccName lbl dc is_overloaded - | is_overloaded = mkRecFldSelOcc str +fieldSelectorOccName :: FieldLabelString -> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName +fieldSelectorOccName lbl dc dup_fields_ok has_sel + | shouldMangleSelectorNames dup_fields_ok has_sel = mkRecFldSelOcc str | otherwise = mkVarOccFS lbl where str = ":" ++ unpackFS lbl ++ ":" ++ occNameString dc @@ -142,3 +191,15 @@ fieldLabelPrintableName :: FieldLabel -> Name fieldLabelPrintableName fl | flIsOverloaded fl = tidyNameOcc (flSelector fl) (mkVarOccFS (flLabel fl)) | otherwise = flSelector fl + +-- | Selector name mangling should be used if either DuplicateRecordFields or +-- NoFieldSelectors is enabled, so that the OccName of the field can be used for +-- something else. See Note [FieldLabel], and Note [NoFieldSelectors] in +-- GHC.Rename.Env. +shouldMangleSelectorNames :: DuplicateRecordFields -> FieldSelectors -> Bool +shouldMangleSelectorNames dup_fields_ok has_sel + = dup_fields_ok == DuplicateRecordFields || has_sel == NoFieldSelectors + +flIsOverloaded :: FieldLabel -> Bool +flIsOverloaded fl = + shouldMangleSelectorNames (flHasDuplicateRecordFields fl) (flHasFieldSelector fl) diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs index c40a7143ff..6eb81653a5 100644 --- a/compiler/GHC/Types/Name/Reader.hs +++ b/compiler/GHC/Types/Name/Reader.hs @@ -46,7 +46,7 @@ module GHC.Types.Name.Reader ( GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames, pprGlobalRdrEnv, globalRdrEnvElts, - lookupGRE_RdrName, lookupGRE_Name, + lookupGRE_RdrName, lookupGRE_RdrName', lookupGRE_Name, lookupGRE_GreName, lookupGRE_FieldLabel, lookupGRE_Name_OccName, getGRE_NameQualifier_maybes, @@ -58,9 +58,11 @@ module GHC.Types.Name.Reader ( gresToAvailInfo, greDefinitionModule, greDefinitionSrcSpan, greMangledName, grePrintableName, + greFieldLabel, -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' - GlobalRdrElt(..), isLocalGRE, isRecFldGRE, isOverloadedRecFldGRE, greFieldLabel, + GlobalRdrElt(..), isLocalGRE, isRecFldGRE, + isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE, unQualOK, qualSpecOK, unQualSpecOK, pprNameProvenance, GreName(..), greNameSrcSpan, @@ -836,7 +838,15 @@ lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of Just gres -> gres lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt] -lookupGRE_RdrName rdr_name env +-- ^ Look for this 'RdrName' in the global environment. Omits record fields +-- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env). +lookupGRE_RdrName rdr_name env = + filter (not . isNoFieldSelectorGRE) (lookupGRE_RdrName' rdr_name env) + +lookupGRE_RdrName' :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt] +-- ^ Look for this 'RdrName' in the global environment. Includes record fields +-- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env). +lookupGRE_RdrName' rdr_name env = case lookupOccEnv env (rdrNameOcc rdr_name) of Nothing -> [] Just gres -> pickGREs rdr_name gres @@ -858,14 +868,14 @@ lookupGRE_GreName env gname lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt -- ^ Look for a particular record field selector in the environment, where the -- selector name and field label may be different: the GlobalRdrEnv is keyed on --- the label. See Note [Parents for record fields] for why this happens. +-- the label. See Note [GreNames] for why this happens. lookupGRE_FieldLabel env fl = lookupGRE_Name_OccName env (flSelector fl) (mkVarOccFS (flLabel fl)) lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt -- ^ Look for precisely this 'Name' in the environment, but with an 'OccName' -- that might differ from that of the 'Name'. See 'lookupGRE_FieldLabel' and --- Note [Parents for record fields]. +-- Note [GreNames]. lookupGRE_Name_OccName env name occ = case [ gre | gre <- lookupGlobalRdrEnv env occ , greMangledName gre == name ] of @@ -895,10 +905,23 @@ isLocalGRE (GRE {gre_lcl = lcl }) = lcl isRecFldGRE :: GlobalRdrElt -> Bool isRecFldGRE = isJust . greFieldLabel -isOverloadedRecFldGRE :: GlobalRdrElt -> Bool +isDuplicateRecFldGRE :: GlobalRdrElt -> Bool -- ^ Is this a record field defined with DuplicateRecordFields? --- (See Note [Parents for record fields]) -isOverloadedRecFldGRE = maybe False flIsOverloaded . greFieldLabel +-- (See Note [GreNames]) +isDuplicateRecFldGRE = + maybe False ((DuplicateRecordFields ==) . flHasDuplicateRecordFields) . greFieldLabel + +isNoFieldSelectorGRE :: GlobalRdrElt -> Bool +-- ^ Is this a record field defined with NoFieldSelectors? +-- (See Note [NoFieldSelectors] in GHC.Rename.Env) +isNoFieldSelectorGRE = + maybe False ((NoFieldSelectors ==) . flHasFieldSelector) . greFieldLabel + +isFieldSelectorGRE :: GlobalRdrElt -> Bool +-- ^ Is this a record field defined with FieldSelectors? +-- (See Note [NoFieldSelectors] in GHC.Rename.Env) +isFieldSelectorGRE = + maybe False ((FieldSelectors ==) . flHasFieldSelector) . greFieldLabel greFieldLabel :: GlobalRdrElt -> Maybe FieldLabel -- ^ Returns the field label of this GRE, if it has one diff --git a/compiler/GHC/Types/Name/Shape.hs b/compiler/GHC/Types/Name/Shape.hs index 304f341b53..456c1d6d24 100644 --- a/compiler/GHC/Types/Name/Shape.hs +++ b/compiler/GHC/Types/Name/Shape.hs @@ -198,9 +198,9 @@ setNameGreName hsc_env mb_mod gname = case gname of -- | Set the 'Module' of a 'FieldSelector' setNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel setNameFieldSelector _ Nothing f = return f -setNameFieldSelector hsc_env mb_mod (FieldLabel l b sel) = do +setNameFieldSelector hsc_env mb_mod (FieldLabel l b has_sel sel) = do sel' <- initIfaceLoad hsc_env $ setNameModule mb_mod sel - return (FieldLabel l b sel') + return (FieldLabel l b has_sel sel') {- ************************************************************************ diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst index 1e73770c5d..27895379c9 100644 --- a/docs/users_guide/9.2.1-notes.rst +++ b/docs/users_guide/9.2.1-notes.rst @@ -50,7 +50,21 @@ Language * Previously, ``-XUndecidableInstances`` accidentally implied ``-XFlexibleContexts``. This is now fixed, but it means that some programs will newly require ``-XFlexibleContexts``. - + +* Various records-related extensions have been improved: + + - A new extension :extension:`NoFieldSelectors` hides record field selector + functions, so it is possible to define top-level bindings with the same names. + + - The :extension:`DisambiguateRecordFields` extension now works for updates. + An update ``expr { field = value }`` will be accepted if there is a single + field called ``field`` in scope, regardless of whether there are non-fields + in scope with the same name. + + - The :extension:`DuplicateRecordFields` extension now applies to fields in + record pattern synonyms. In particular, it is possible for a single module + to define multiple pattern synonyms using the same field names. + Compiler ~~~~~~~~ diff --git a/docs/users_guide/exts/control.rst b/docs/users_guide/exts/control.rst index eccb22c1e4..fff8107b13 100644 --- a/docs/users_guide/exts/control.rst +++ b/docs/users_guide/exts/control.rst @@ -31,6 +31,7 @@ Language extensions can be controlled (i.e. allowed or not) in two ways: * :extension:`MonomorphismRestriction` * :extension:`DatatypeContexts` * :extension:`TraditionalRecordSyntax` + * :extension:`FieldSelectors` * :extension:`EmptyDataDecls` * :extension:`ForeignFunctionInterface` * :extension:`PatternGuards` @@ -53,6 +54,7 @@ Language extensions can be controlled (i.e. allowed or not) in two ways: * :extension:`NPlusKPatterns` * :extension:`DatatypeContexts` * :extension:`TraditionalRecordSyntax` + * :extension:`FieldSelectors` * :extension:`NondecreasingIndentation` diff --git a/docs/users_guide/exts/disambiguate_record_fields.rst b/docs/users_guide/exts/disambiguate_record_fields.rst index 5fd8015ce1..3c1fbcc4b4 100644 --- a/docs/users_guide/exts/disambiguate_record_fields.rst +++ b/docs/users_guide/exts/disambiguate_record_fields.rst @@ -8,9 +8,10 @@ Record field disambiguation Implied by :extension:`RecordWildCards`. :since: 6.8.1 + :implied by: :extension:`RecordWildCards`, :extension:`DuplicateRecordFields` - Allow the compiler to automatically choose between identically-named - record selectors based on type (if the choice is unambiguous). + Allow the compiler to automatically choose between identically-named record + fields (if the choice is unambiguous). In record construction and record pattern matching it is entirely unambiguous which field is referred to, even if there are two different @@ -48,6 +49,17 @@ variables in scope with the same name. This reduces the clutter of qualified names when you import two records from different modules that use the same field name. +Since version 9.2.1, record fields in updates are disambiguated by ignoring +non-field names in scope. For example, the following is accepted under +:extension:`DisambiguateRecordFields`: :: + + module Bar where + import M -- imports the field x + + x = () + + e r = r { x = 0 } -- unambiguously refers to the field + Some details: - Field disambiguation can be combined with punning (see @@ -72,5 +84,3 @@ Some details: name it ``M.MkS``, but the field ``x`` does not need to be qualified even though ``M.x`` is in scope but ``x`` is not (In effect, it is qualified by the constructor). - - diff --git a/docs/users_guide/exts/duplicate_record_fields.rst b/docs/users_guide/exts/duplicate_record_fields.rst index a99c0c8a95..d8abedaefa 100644 --- a/docs/users_guide/exts/duplicate_record_fields.rst +++ b/docs/users_guide/exts/duplicate_record_fields.rst @@ -33,6 +33,10 @@ Field names used as selector functions or in record updates must be unambiguous, either because there is only one such field in scope, or because a type signature is supplied, as described in the following sections. +While :extension:`DuplicateRecordFields` permits multiple fields with the same +name in a single module, it does not permit a field and a normal value binding +to have the same name. For that, use :extension:`NoFieldSelectors`. + Selector functions ~~~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/exts/field_selectors.rst b/docs/users_guide/exts/field_selectors.rst new file mode 100644 index 0000000000..462596a225 --- /dev/null +++ b/docs/users_guide/exts/field_selectors.rst @@ -0,0 +1,95 @@ +.. _field-selectors: + +Field selectors +--------------- + +.. extension:: FieldSelectors + :shortdesc: Control visibility of field selector functions. + + :since: 9.2.1 + + Make `record field selector functions + <https://www.haskell.org/onlinereport/haskell2010/haskellch3.html#x8-500003.15.1>`_ + visible in expressions. + +By default, the :extension:`FieldSelectors` extension is enabled, so defining a +record datatype brings a selector function into scope for each field in the +record. :extension:`NoFieldSelectors` negates this feature, making it possible +to: + +- declare a top-level binding with the same name as a field, and +- refer to this top-level binding unambiguously in expressions. + +Field labels are still usable within record construction, updates and pattern +matching. + +For example, given a datatype definition :: + + data Foo = MkFoo { bar :: Int, baz :: String } + +The following will be available: + +1. the type constructor ``Foo``; +2. the data constructor ``MkFoo``; +3. the fields ``bar`` and ``baz`` for record construction, update, and pattern + matching; and +4. the selector functions ``bar :: Foo -> Int`` and ``baz :: Foo -> String``. + +If the :extension:`NoFieldSelectors` extension is enabled at the datatype +definition site, items (1), (2), and (3) will still be available, but (4) will +not. Correspondingly, it is permitted to define a top-level binding with the +same name as a field, and using this name in an expression unambiguously refers +to the non-field. For exmaple, the following is permitted: :: + + data Foo = MkFoo { bar :: Int, baz :: String } + bar = () -- does not conflict with `bar` field + baz = bar -- unambiguously refers to `bar` the unit value, not the field + +If you have multiple datatypes with the same field name, you need to enable +:extension:`DuplicateRecordFields` to allow them to be declared simultaneously. +It is never permitted for a single module to define multiple top-level bindings +with the same name. + +The :extension:`DisambiguateRecordFields` extension (implied by +:extension:`DuplicateRecordFields`) is useful in conjunction with +:extension:`NoFieldSelectors`, because it excludes non-fields from consideration +when resolving field names in record construction, update and pattern matching. + + +Import and export of selector functions +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Under :extension:`FieldSelectors`, these modules are equivalent: :: + + module A (Foo(MkFoo, bar, baz)) where + data Foo = MkFoo { bar :: Int, baz :: Int } + + module B (Foo(MkFoo, bar), baz) where + data Foo = MkFoo { bar :: Int, baz :: Int } + +Under :extension:`NoFieldSelectors`, these two export statements are now +different. The first one will export the field ``baz``, but not the top-level +binding ``baz``, while the second one would export the top-level binding ``baz`` +(if one were defined), but not the field ``baz``. + +Because of this change, using :extension:`NoFieldSelectors` and writing out +selector functions explicitly is different to using :extension:`FieldSelectors`: +in the former case the fields and functions must be exported separately. For +example, here the selector functions are not exported: :: + + {-# LANGUAGE NoFieldSelectors #-} + module M (Foo(MkFoo, bar, baz)) where + data Foo = MkFoo { bar :: Int, baz :: Int } + + bar (MkFoo x _) = x + baz (MkFoo _ x) = x + +whereas here the selector functions are exported: :: + + {-# LANGUAGE FieldSelectors #-} + module M (Foo(MkFoo, bar, baz)) where + data Foo = MkFoo { bar :: Int, baz :: Int } + +Wildcard exports will export the field labels, but will not export a top-level +binding that happens to have the same name. In the examples above, exporting +``Foo(..)`` is (still) equivalent to exporting ``Foo(MkFoo, bar, baz)``. diff --git a/docs/users_guide/exts/records.rst b/docs/users_guide/exts/records.rst index 28f8988220..9395cf4666 100644 --- a/docs/users_guide/exts/records.rst +++ b/docs/users_guide/exts/records.rst @@ -10,6 +10,7 @@ Records field_selectors_and_type_applications disambiguate_record_fields duplicate_record_fields + field_selectors record_puns record_wildcards hasfield diff --git a/docs/users_guide/exts/traditional_record_syntax.rst b/docs/users_guide/exts/traditional_record_syntax.rst index e500ff8d24..842af80652 100644 --- a/docs/users_guide/exts/traditional_record_syntax.rst +++ b/docs/users_guide/exts/traditional_record_syntax.rst @@ -14,4 +14,22 @@ Traditional record syntax Traditional record syntax, such as ``C {f = x}``, is enabled by default. To disable it, you can use the :extension:`NoTraditionalRecordSyntax` extension. +Under :extension:`NoTraditionalRecordSyntax`, it is not permitted to define a +record datatype or use record syntax in an expression. For example, the +following all require :extension:`TraditionalRecordSyntax`: +.. code-block:: haskell + + data T = MkT { foo :: Int } -- record datatype definition + + x = MkT { foo = 3 } -- construction + + y = x { foo = 3 } -- update + + f (MkT { foo = i }) = i -- pattern matching + +However, if a field selector function is in scope, it may be used normally. +(This arises if a module using :extension:`NoTraditionalRecordSyntax` imports a +module that defined a record with :extension:`TraditionalRecordSyntax` enabled). +If you wish to suppress field selector functions, use the +:extension:`NoFieldSelectors` extension. diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs index d8478c8e39..9be6431eeb 100644 --- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs @@ -146,6 +146,7 @@ data Extension | CUSKs | StandaloneKindSignatures | LexicalNegation + | FieldSelectors deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 78d552c6cd..d574365f87 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -40,6 +40,7 @@ expectedGhcOnlyExtensions = [ "RelaxedLayout" , "AlternativeLayoutRule" , "AlternativeLayoutRuleTransitional" + , "FieldSelectors" ] expectedCabalOnlyExtensions :: [String] diff --git a/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.hs b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.hs new file mode 100644 index 0000000000..5b54ad5ba3 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module GHCiDRF where +data T = MkT { foo :: Int, bar :: Int } +data U = MkU { bar :: Bool } diff --git a/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.script b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.script new file mode 100644 index 0000000000..89a7623c8b --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.script @@ -0,0 +1,11 @@ +:l GHCiDRF +:t GHCiDRF.foo +:t GHCiDRF.bar +:info GHCiDRF.foo +:info GHCiDRF.bar +:m - GHCiDRF +:t GHCiDRF.foo +:t GHCiDRF.bar +:info GHCiDRF.foo +:info GHCiDRF.bar +GHCiDRF.bar (GHCiDRF.MkU True :: GHCiDRF.U) diff --git a/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.stdout b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.stdout new file mode 100644 index 0000000000..1a7b44e64e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/GHCiDRF.stdout @@ -0,0 +1,48 @@ +GHCiDRF.foo :: T -> Int + +<interactive>:1:1: error: + Ambiguous occurrence ‘GHCiDRF.bar’ + It could refer to + either the field ‘bar’, defined at GHCiDRF.hs:4:16 + or the field ‘bar’, defined at GHCiDRF.hs:3:28 +type T :: * +data T = MkT {foo :: Int, ...} + -- Defined at GHCiDRF.hs:3:16 +type U :: * +data U = MkU {GHCiDRF.bar :: Bool} + -- Defined at GHCiDRF.hs:4:16 + +type T :: * +data T = MkT {..., GHCiDRF.bar :: Int} + -- Defined at GHCiDRF.hs:3:28 +GHCiDRF.foo :: GHCiDRF.T -> Int + +<interactive>:1:1: error: + Ambiguous occurrence ‘GHCiDRF.bar’ + It could refer to + either the field ‘bar’, + imported qualified from ‘GHCiDRF’ + (and originally defined at GHCiDRF.hs:3:28-30) + or the field ‘bar’, + imported qualified from ‘GHCiDRF’ + (and originally defined at GHCiDRF.hs:4:16-18) +type GHCiDRF.T :: * +data GHCiDRF.T = GHCiDRF.MkT {GHCiDRF.foo :: Int, ...} + -- Defined at GHCiDRF.hs:3:16 +type GHCiDRF.T :: * +data GHCiDRF.T = GHCiDRF.MkT {..., GHCiDRF.bar :: Int} + -- Defined at GHCiDRF.hs:3:28 + +type GHCiDRF.U :: * +data GHCiDRF.U = GHCiDRF.MkU {GHCiDRF.bar :: Bool} + -- Defined at GHCiDRF.hs:4:16 + +<interactive>:11:1: error: + Ambiguous occurrence ‘GHCiDRF.bar’ + It could refer to + either the field ‘bar’, + imported qualified from ‘GHCiDRF’ + (and originally defined at GHCiDRF.hs:3:28-30) + or the field ‘bar’, + imported qualified from ‘GHCiDRF’ + (and originally defined at GHCiDRF.hs:4:16-18) diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T index e8c008d1df..7bddafd6fb 100644 --- a/testsuite/tests/overloadedrecflds/ghci/all.T +++ b/testsuite/tests/overloadedrecflds/ghci/all.T @@ -1,3 +1,4 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script']) +test('GHCiDRF', [extra_files(['GHCiDRF.hs']), combined_output], ghci_script, ['GHCiDRF.script']) diff --git a/testsuite/tests/overloadedrecflds/should_compile/NFSDRF.hs b/testsuite/tests/overloadedrecflds/should_compile/NFSDRF.hs new file mode 100644 index 0000000000..a1e8744974 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/NFSDRF.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module NFSDRF where + +import Prelude + + +data Foo = Foo { foo :: Int, bar :: String } +data Bar = Bar { foo :: Int, bar' :: String } + +foo = 3 -- should not conflict + +fooX = foo + 1 + +rwcPatFoo Foo{..} = show (foo, bar) +rwcConFoo = Foo{..} where + foo = 42 + bar = "hello" + +foo1 :: Foo +foo1 = Foo 3 "bar" + +foo2 = Foo { foo = 3, bar = "bar" } -- disambiguate foo + + +-- foo3 :: Foo +-- foo3 = foo1 { foo = 4 } -- currently rejected, see #18999 + +foo4 = foo1 { bar = "baz" } -- unambiguous + +bar0 = Bar { foo = 0, bar' = "bar'" } + +-- bar1 :: Bar +-- bar1 = bar0 { foo = 1 } -- currently rejected, see #18999 diff --git a/testsuite/tests/overloadedrecflds/should_compile/NFSExport.hs b/testsuite/tests/overloadedrecflds/should_compile/NFSExport.hs new file mode 100644 index 0000000000..8e83c085bf --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/NFSExport.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module NFSExport (T(foo), def) where + +data T = MkT { foo :: Bool } + +def :: T +def = MkT False diff --git a/testsuite/tests/overloadedrecflds/should_compile/NFSImport.hs b/testsuite/tests/overloadedrecflds/should_compile/NFSImport.hs new file mode 100644 index 0000000000..433e9f06fc --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/NFSImport.hs @@ -0,0 +1,5 @@ +module NFSImport where + +import NFSExport + +t = def { foo = True } diff --git a/testsuite/tests/overloadedrecflds/should_compile/NoFieldSelectors.hs b/testsuite/tests/overloadedrecflds/should_compile/NoFieldSelectors.hs new file mode 100644 index 0000000000..d114861672 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/NoFieldSelectors.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE RecordWildCards #-} + + +module NoFieldSelectors +where + +import Prelude + + +data Foo = Foo { foo :: Int, bar :: String } + +{-# ANN foo () #-} +foo = 3 -- should not conflict + +fooX = foo + 1 + +rwcPatFoo Foo{..} = show (foo, bar) +rwcConFoo = Foo{..} where + foo = 42 + bar = "hello" + +foo1 :: Foo +foo1 = Foo 3 "bar" + +foo2 = Foo { foo = 3, bar = "bar" } -- disambiguate foo + +-- foo3 = foo1 { foo = 4 } -- currently rejected, see #18999 + +foo4 = foo1 { bar = "baz" } -- bar is unambiguous diff --git a/testsuite/tests/overloadedrecflds/should_compile/T18999_FieldSelectors.hs b/testsuite/tests/overloadedrecflds/should_compile/T18999_FieldSelectors.hs new file mode 100644 index 0000000000..8fb6e5f9df --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/T18999_FieldSelectors.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +module T18999_FieldSelectors where + +data Foo = Foo { not :: Int } + +foo = Foo { not = 1 } +y = foo { not = 2 } diff --git a/testsuite/tests/overloadedrecflds/should_compile/T18999_NoFieldSelectors.hs b/testsuite/tests/overloadedrecflds/should_compile/T18999_NoFieldSelectors.hs new file mode 100644 index 0000000000..69bf8fb427 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/T18999_NoFieldSelectors.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} +module T18999_NoFieldSelectors where + +data Foo = Foo { bar :: Int, baz :: Int } +baz = 42 + +foo = Foo { bar = 23, baz = 1 } +y = foo { baz = baz } diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T index 515b19635f..a043570034 100644 --- a/testsuite/tests/overloadedrecflds/should_compile/all.T +++ b/testsuite/tests/overloadedrecflds/should_compile/all.T @@ -3,3 +3,8 @@ test('T12609', normal, compile, ['']) test('T16597', [], multimod_compile, ['T16597', '-v0']) test('T17176', normal, compile, ['']) test('DRFPatSynExport', [], makefile_test, ['DRFPatSynExport']) +test('NoFieldSelectors', normal, compile, ['']) +test('NFSDRF', normal, compile, ['']) +test('NFSImport', [extra_files(['NFSExport.hs'])], multimod_compile, ['NFSImport NFSExport', '-v0']) +test('T18999_NoFieldSelectors', normal, compile, ['']) +test('T18999_FieldSelectors', normal, compile, ['']) diff --git a/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.hs b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.hs new file mode 100644 index 0000000000..e33f4c0971 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE FieldSelectors #-} + +module FieldSelectors +where + +import Prelude + +data Foo = Foo { foo :: Int, bar :: String } + +foo = 3 diff --git a/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr new file mode 100644 index 0000000000..8edc117f3d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr @@ -0,0 +1,4 @@ +FieldSelectors.hs:10:1: + Multiple declarations of ‘foo’ + Declared at: FieldSelectors.hs:8:18 + FieldSelectors.hs:10:1
\ No newline at end of file diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFS9156.hs b/testsuite/tests/overloadedrecflds/should_fail/NFS9156.hs new file mode 100644 index 0000000000..4cc1091cf2 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFS9156.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE NoFieldSelectors #-} +module NFS9156 where +data D = D1 { f1 :: Int } + | D2 { f1, f1 :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFS9156.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFS9156.stderr new file mode 100644 index 0000000000..66ab58fcbd --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFS9156.stderr @@ -0,0 +1,5 @@ + +NFS9156.hs:4:19: error: + Multiple declarations of ‘f1’ + Declared at: NFS9156.hs:3:15 + NFS9156.hs:4:19 diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.hs b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.hs new file mode 100644 index 0000000000..5da0175a1e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE NoDuplicateRecordFields #-} +module NFSDuplicate where + +-- Two definitions of 'foo' as fields is an error, even though it is permitted +-- to define it as a non-field. +data S = MkS { foo :: Int } +data T = MkT { foo :: Int } + +foo = () diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr new file mode 100644 index 0000000000..f30bb1e490 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr @@ -0,0 +1,5 @@ + +NFSDuplicate.hs:8:16: error: + Multiple declarations of ‘foo’ + Declared at: NFSDuplicate.hs:7:16 + NFSDuplicate.hs:8:16 diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSExport.hs b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.hs new file mode 100644 index 0000000000..839b32bae4 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE NoFieldSelectors #-} +module NFSExport (T(foo), foo) where -- only T(foo) is supported +data T = MkT { foo :: Bool } diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr new file mode 100644 index 0000000000..c704facfc9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSExport.stderr @@ -0,0 +1,5 @@ + +NFSExport.hs:2:27: error: + Not in scope: ‘foo’ + NB: ‘foo’ is a field selector belonging to the type ‘T’ + that has been suppressed by NoFieldSelectors diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.hs b/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.hs new file mode 100644 index 0000000000..d2b3d8dd1b --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.hs @@ -0,0 +1,5 @@ +module NFSMixed where + +import NFSMixedA + +test = \x -> x { foo = 0 } diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.stderr new file mode 100644 index 0000000000..b569125c4a --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSMixed.stderr @@ -0,0 +1,13 @@ + +NFSMixed.hs:5:18: error: + Ambiguous occurrence ‘foo’ + It could refer to + either the field ‘foo’, + imported from ‘NFSMixedA’ at NFSMixed.hs:3:1-16 + (and originally defined at NFSMixedA.hs:4:18-20) + or the field ‘foo’, + imported from ‘NFSMixedA’ at NFSMixed.hs:3:1-16 + (and originally defined at NFSMixedA.hs:5:18-20) + or ‘NFSMixedA.foo’, + imported from ‘NFSMixedA’ at NFSMixed.hs:3:1-16 + (and originally defined at NFSMixedA.hs:8:1-3) diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSMixedA.hs b/testsuite/tests/overloadedrecflds/should_fail/NFSMixedA.hs new file mode 100644 index 0000000000..626d5bfc35 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSMixedA.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE DuplicateRecordFields #-} +module NFSMixedA where +data Foo = Foo { foo :: Int, bar :: String } +data Bar = Bar { foo :: Int, bar' :: String } + +foo :: Int +foo = 0 diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.hs b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.hs new file mode 100644 index 0000000000..0eb415d032 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module NFSSuppressed where + +import Prelude + +data Foo = Foo { foo :: Int } + +x = foo diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr new file mode 100644 index 0000000000..51415300e0 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSSuppressed.stderr @@ -0,0 +1,6 @@ + +NFSSuppressed.hs:9:5: error: + • Variable not in scope: foo + • Perhaps you meant data constructor ‘Foo’ (line 7) + NB: ‘foo’ is a field selector belonging to the type ‘Foo’ + that has been suppressed by NoFieldSelectors diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs new file mode 100644 index 0000000000..c2ade91335 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE NoFieldSelectors #-} +module NoFieldSelectorsFail (foo, bar) where + +import NoFieldSelectorsFailA + +foo1 :: Foo +foo1 = Foo 3 "bar" + +bar0 = Bar { foo = 0, bar' = "bar'" } + +foo3 :: Foo +foo3 = foo1 { foo = 4 } -- update + +bar1 = bar0 { foo = 1 } + +foo4 = foo1 { bar = "" } -- currently rejected, see #18999 diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.stderr b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.stderr new file mode 100644 index 0000000000..13193f38d9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.stderr @@ -0,0 +1,40 @@ + +NoFieldSelectorsFail.hs:9:14: error: + Ambiguous occurrence ‘foo’ + It could refer to + either the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:5:18-20) + or the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:6:18-20) + +NoFieldSelectorsFail.hs:12:15: error: + Ambiguous occurrence ‘foo’ + It could refer to + either the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:5:18-20) + or the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:6:18-20) + +NoFieldSelectorsFail.hs:14:15: error: + Ambiguous occurrence ‘foo’ + It could refer to + either the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:5:18-20) + or the field ‘foo’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:6:18-20) + +NoFieldSelectorsFail.hs:16:15: error: + Ambiguous occurrence ‘bar’ + It could refer to + either the field ‘bar’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:5:30-32) + or ‘NoFieldSelectorsFailA.bar’, + imported from ‘NoFieldSelectorsFailA’ at NoFieldSelectorsFail.hs:4:1-28 + (and originally defined at NoFieldSelectorsFailA.hs:8:1-3) diff --git a/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFailA.hs b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFailA.hs new file mode 100644 index 0000000000..1c542a869a --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFailA.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE DuplicateRecordFields #-} +module NoFieldSelectorsFailA where + +data Foo = Foo { foo :: Int, bar :: String } +data Bar = Bar { foo :: Int, bar' :: String } + +bar = undefined + +foo4 = (Foo 3 "bar") { bar = "" } -- permitted thanks to DisambiguateRecordFields + -- (implied by DuplicateRecordFields), see #18999 diff --git a/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs b/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs new file mode 100644 index 0000000000..2a78c20d13 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoFieldSelectors #-} +module T18999_NoDisambiguateRecordFields where + +data Foo = Foo { not :: Int } + +foo = Foo { not = 1 } -- ambiguous without DisambiguateRecordFields +x = not -- unambiguous because of NoFieldSelectors +y = foo { not = 2 } -- ambiguous without DisambiguateRecordFields diff --git a/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr b/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr new file mode 100644 index 0000000000..425e8d7245 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr @@ -0,0 +1,18 @@ + +T18999_NoDisambiguateRecordFields.hs:6:13: error: + Ambiguous occurrence ‘not’ + It could refer to + either ‘Prelude.not’, + imported from ‘Prelude’ at T18999_NoDisambiguateRecordFields.hs:2:8-40 + (and originally defined in ‘GHC.Classes’) + or the field ‘not’, + defined at T18999_NoDisambiguateRecordFields.hs:4:18 + +T18999_NoDisambiguateRecordFields.hs:8:11: error: + Ambiguous occurrence ‘not’ + It could refer to + either ‘Prelude.not’, + imported from ‘Prelude’ at T18999_NoDisambiguateRecordFields.hs:2:8-40 + (and originally defined in ‘GHC.Classes’) + or the field ‘not’, + defined at T18999_NoDisambiguateRecordFields.hs:4:18 diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T index 09bee3ba06..644d3a8427 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/all.T +++ b/testsuite/tests/overloadedrecflds/should_fail/all.T @@ -36,4 +36,12 @@ test('T17965', normal, compile_fail, ['']) test('DRFHoleFits', extra_files(['DRFHoleFits_A.hs']), multimod_compile_fail, ['DRFHoleFits', '']) test('DRFPartialFields', normal, compile_fail, ['']) test('T16745', extra_files(['T16745C.hs', 'T16745B.hs']), multimod_compile_fail, ['T16745A', '']) +test('FieldSelectors', normal, compile_fail, ['']) +test('NoFieldSelectorsFail', normal, multimod_compile_fail, ['NoFieldSelectorsFail','-v0']) +test('NFSSuppressed', normal, compile_fail, ['']) +test('NFSMixed', normal, multimod_compile_fail, ['NFSMixed','-v0']) test('DRF9156', normal, compile_fail, ['']) +test('NFS9156', normal, compile_fail, ['']) +test('NFSDuplicate', normal, compile_fail, ['']) +test('NFSExport', normal, compile_fail, ['']) +test('T18999_NoDisambiguateRecordFields', normal, compile_fail, ['']) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail14.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail14.stderr index 908996f39e..7a211fd366 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail14.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail14.stderr @@ -1,5 +1,5 @@ overloadedrecfldsfail14.hs:12:7: error: - ‘y’ is not a record selector + No type has all these fields: ‘x’, ‘y’ In the expression: r {x = 3, y = False} In an equation for ‘f’: f r = r {x = 3, y = False} diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index 8e79b4bc9f..cee8ecdbf9 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -126,7 +126,8 @@ [({ T14189.hs:3:11 } (FieldLabel {FastString: "f"} - (False) + (NoDuplicateRecordFields) + (FieldSelectors) {Name: T14189.f}))] ({ T14189.hs:3:3-8 } (IEName @@ -146,7 +147,8 @@ ,(FieldGreName (FieldLabel {FastString: "f"} - (False) + (NoDuplicateRecordFields) + (FieldSelectors) {Name: T14189.f}))])])]) (Nothing))) diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 5faea83c88..9520cc0b77 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -16,6 +16,7 @@ test('records-no-uni-update2', normal, compile_fail, ['']) test('records-mixing-fields', normal, compile_fail, ['']) test('records-exquant', normal, compile_fail, ['']) test('records-poly-update', normal, compile_fail, ['']) +test('records-nofieldselectors', normal, compile_fail, ['']) test('mixed-pat-syn-record-sels', normal, compile_fail, ['']) test('T11039', normal, compile_fail, ['']) test('T11039a', normal, compile, ['']) diff --git a/testsuite/tests/patsyn/should_fail/records-nofieldselectors.hs b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.hs new file mode 100644 index 0000000000..17fa340905 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE PatternSynonyms #-} +module ShouldFail where + +pattern Single{x} = [x] + +-- Selector +selector :: Int +selector = x [5] + +update :: [String] +update = ["String"] { x = "updated" } diff --git a/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr new file mode 100644 index 0000000000..26124310fc --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr @@ -0,0 +1,5 @@ + +records-nofieldselectors.hs:9:12: error: + • Variable not in scope: x :: [a0] -> Int + • NB: ‘x’ is a field selector + that has been suppressed by NoFieldSelectors |