diff options
Diffstat (limited to 'compiler/GHC/Rename')
| -rw-r--r-- | compiler/GHC/Rename/Env.hs | 397 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Expr.hs | 22 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Module.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Names.hs | 126 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Pat.hs | 47 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Unbound.hs | 23 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Utils.hs | 53 |
7 files changed, 505 insertions, 174 deletions
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) |