Commit 2521b041 authored by Adam Gundry's avatar Adam Gundry Committed by Marge Bot
Browse files

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's avatarSimon Hafner <hafnersimon@gmail.com>
Co-authored-by: Fumiaki Kinoshita's avatarFumiaki Kinoshita <fumiexcel@gmail.com>
parent f422c12d
......@@ -35,6 +35,8 @@ module GHC.Driver.Session (
wopt_fatal, wopt_set_fatal, wopt_unset_fatal,
xopt, xopt_set, xopt_unset,
xopt_set_unlessExplSpec,
xopt_DuplicateRecordFields,
xopt_FieldSelectors,
lang_set,
DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed,
dynamicOutputFile,
......@@ -248,6 +250,7 @@ import GHC.Utils.Monad
import GHC.Types.SrcLoc
import GHC.Types.SafeHaskell
import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import qualified GHC.Types.FieldLabel as FieldLabel
import GHC.Data.FastString
import GHC.Utils.Fingerprint
import GHC.Utils.Outputable
......@@ -1351,6 +1354,7 @@ languageExtensions (Just Haskell98)
LangExt.NPlusKPatterns,
LangExt.DatatypeContexts,
LangExt.TraditionalRecordSyntax,
LangExt.FieldSelectors,
LangExt.NondecreasingIndentation
-- strictly speaking non-standard, but we always had this
-- on implicitly before the option was added in 7.1, and
......@@ -1371,6 +1375,7 @@ languageExtensions (Just Haskell2010)
LangExt.ForeignFunctionInterface,
LangExt.PatternGuards,
LangExt.DoAndIfThenElse,
LangExt.FieldSelectors,
LangExt.RelaxedPolyRec]
hasPprDebug :: DynFlags -> Bool
......@@ -1507,6 +1512,16 @@ xopt_set_unlessExplSpec ext setUnset dflags =
in
if ext `elem` referedExts then dflags else setUnset dflags ext
xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields
xopt_DuplicateRecordFields dfs
| xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields
| otherwise = FieldLabel.NoDuplicateRecordFields
xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors
xopt_FieldSelectors dfs
| xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors
| otherwise = FieldLabel.NoFieldSelectors
lang_set :: DynFlags -> Maybe Language -> DynFlags
lang_set dflags lang =
dflags {
......@@ -3462,6 +3477,7 @@ xFlagsDeps = [
depFlagSpec' "DoRec" LangExt.RecursiveDo
(deprecatedForExtension "RecursiveDo"),
flagSpec "DuplicateRecordFields" LangExt.DuplicateRecordFields,
flagSpec "FieldSelectors" LangExt.FieldSelectors,
flagSpec "EmptyCase" LangExt.EmptyCase,
flagSpec "EmptyDataDecls" LangExt.EmptyDataDecls,
flagSpec "EmptyDataDeriving" LangExt.EmptyDataDeriving,
......
......@@ -2037,7 +2037,7 @@ instance ToHie (IEContext (LIEWrappedName Name)) where
]
instance ToHie (IEContext (Located FieldLabel)) where
toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of
FieldLabel _ _ n ->
[ toHie $ C (IEThing c) $ L span n
]
toHie (IEC c (L span lbl)) = concatM
[ makeNode lbl span
, toHie $ C (IEThing c) $ L span (flSelector lbl)
]
......@@ -259,9 +259,9 @@ rnGreName (NormalGreName n) = NormalGreName <$> rnIfaceGlobal n
rnGreName (FieldGreName fl) = FieldGreName <$> rnFieldLabel fl
rnFieldLabel :: Rename FieldLabel
rnFieldLabel (FieldLabel l b sel) = do
sel' <- rnIfaceGlobal sel
return (FieldLabel l b sel')
rnFieldLabel fl = do
sel' <- rnIfaceGlobal (flSelector fl)
return (fl { flSelector = sel' })
......
This diff is collapsed.
......@@ -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)
......
......@@ -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
......
......@@ -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` []
......
......@@ -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') }
......
......@@ -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
......
......@@ -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)