diff options
64 files changed, 1236 insertions, 265 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 400eb31faa..90f49f995f 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, @@ -248,6 +250,7 @@ import GHC.Utils.Monad 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 @@ -1351,6 +1354,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 @@ -1371,6 +1375,7 @@ languageExtensions (Just Haskell2010) LangExt.ForeignFunctionInterface, LangExt.PatternGuards, LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, LangExt.RelaxedPolyRec] hasPprDebug :: DynFlags -> Bool @@ -1507,6 +1512,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 { @@ -3462,6 +3477,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 cd97c000a8..03c70845ea 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 19c4e4610e..48ec8db86c 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 61b09e27e0..fab5a13c9b 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 @@ -1499,11 +1500,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' @@ -1552,18 +1550,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 2135f18b77..8c7e764147 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 96306e4d9c..a29a744f8b 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 fcc532c23c..a3c3e2edfe 100644 --- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs @@ -145,6 +145,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 ffb076e1e6..27be970d22 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 |