summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2020-12-23 22:22:08 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-16 04:34:43 -0500
commit2521b041bff00458cb2c84b8747ea60d6991e329 (patch)
tree091e47028c452050ee46fcb70aa9a01186120c1e /compiler/GHC/Rename
parentf422c12d26f183481ad8a833667cbfdd1c9b3e95 (diff)
downloadhaskell-2521b041bff00458cb2c84b8747ea60d6991e329.tar.gz
Implement NoFieldSelectors extension (ghc-proposals 160)
Fixes #5972. This adds an extension NoFieldSelectors to disable the generation of selector functions corresponding to record fields. When this extension is enabled, record field selectors are not accessible as functions, but users are still able to use them for record construction, pattern matching and updates. See Note [NoFieldSelectors] in GHC.Rename.Env for details. Defining the same field multiple times requires the DuplicateRecordFields extension to be enabled, even when NoFieldSelectors is in use. Along the way, this fixes the use of non-imported DuplicateRecordFields in GHCi with -fimplicit-import-qualified (fixes #18729). Moreover, it extends DisambiguateRecordFields to ignore non-fields when looking up fields in record updates (fixes #18999), as described by Note [DisambiguateRecordFields for updates]. Co-authored-by: Simon Hafner <hafnersimon@gmail.com> Co-authored-by: Fumiaki Kinoshita <fumiexcel@gmail.com>
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r--compiler/GHC/Rename/Env.hs397
-rw-r--r--compiler/GHC/Rename/Expr.hs22
-rw-r--r--compiler/GHC/Rename/Module.hs11
-rw-r--r--compiler/GHC/Rename/Names.hs126
-rw-r--r--compiler/GHC/Rename/Pat.hs47
-rw-r--r--compiler/GHC/Rename/Unbound.hs23
-rw-r--r--compiler/GHC/Rename/Utils.hs53
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)