[Git][ghc/ghc][master] 3 commits: Fix deprecation of record fields
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jul 13 12:03:02 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6143838a by sheaf at 2023-07-13T08:02:17-04:00
Fix deprecation of record fields
Commit 3f374399 inadvertently broke the deprecation/warning mechanism
for record fields due to its introduction of record field namespaces.
This patch ensures that, when a top-level deprecation is applied to
an identifier, it applies to all the record fields as well.
This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and
GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of
NameSpaces but to look up all NameSpaces and filter out the irrelevant
ones.
- - - - -
6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00
Introduce greInfo, greParent
These are simple helper functions that wrap the internal
field names gre_info, gre_par.
- - - - -
7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00
Refactor lookupGRE_... functions
This commit consolidates all the logic for looking up something in
the Global Reader Environment into the single function lookupGRE.
This allows us to declaratively specify all the different modes of
looking up in the GlobalRdrEnv, and avoids manually passing around
filtering functions as was the case in e.g. the function
GHC.Rename.Env.lookupSubBndrOcc_helper.
-------------------------
Metric Decrease:
T8095
-------------------------
-------------------------
Metric Increase:
T8095
-------------------------
- - - - -
29 changed files:
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Rename/Doc.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/GREInfo.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Types/Name/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr
- + testsuite/tests/overloadedrecflds/should_compile/T23279.hs
- + testsuite/tests/overloadedrecflds/should_compile/T23279.stderr
- + testsuite/tests/overloadedrecflds/should_compile/T23279_aux.hs
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
- testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr
- testsuite/tests/th/T7241.stderr
Changes:
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -419,7 +419,8 @@ prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not
be looked up /by the plugin/.
let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
- putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts
+ putMsgS $ showSDoc dflags $ ppr $
+ lookupGRE (mg_rdr_env guts) (LookupRdrName rdrName AllRelevantGREs)
`mkTcOcc` involves the lookup (or creation) of a FastString. Since the
plugin's FastString.string_table is empty, constructing the RdrName also
=====================================
compiler/GHC/Rename/Doc.hs
=====================================
@@ -8,7 +8,6 @@ import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Tc.Utils.Monad (getGblEnv)
-import GHC.Rename.Env
rnLHsDoc :: LHsDoc GhcPs -> RnM (LHsDoc GhcRn)
rnLHsDoc = traverse rnHsDoc
@@ -38,8 +37,8 @@ rnHsDoc (WithHsDocIdentifiers s ids) = do
rnHsDocIdentifiers :: GlobalRdrEnv
-> [Located RdrName]
-> [Located Name]
-rnHsDocIdentifiers gre_env ns = concat
- [ map (L l . greName) (lookupGRE_RdrName (IncludeFields WantNormal) gre_env c)
+rnHsDocIdentifiers gre_env ns =
+ [ L l $ greName gre
| L l rdr_name <- ns
- , c <- dataTcOccs rdr_name
+ , gre <- lookupGRE gre_env (LookupOccName (rdrNameOcc rdr_name) AllRelevantGREs)
]
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -33,7 +33,6 @@ module GHC.Rename.Env (
ChildLookupResult(..),
lookupSubBndrOcc_helper,
- combineChildLookupResult, -- Called by lookupChildrenExport
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
lookupSigCtxtOccRn,
@@ -57,8 +56,6 @@ module GHC.Rename.Env (
DeprecationWarnings(..),
addUsedGRE, addUsedGREs, addUsedDataCons,
-
-
dataTcOccs, --TODO: Move this somewhere, into utils?
) where
@@ -72,6 +69,7 @@ import GHC.Iface.Env
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr (pprScopeError)
import GHC.Tc.Utils.Env
import GHC.Tc.Types.LclEnv
import GHC.Tc.Utils.Monad
@@ -298,7 +296,7 @@ lookupTopBndrRn which_suggest rdr_name =
(do { op_ok <- xoptM LangExt.TypeOperators
; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) })
; env <- getGlobalRdrEnv
- ; case filter isLocalGRE (lookupGRE_RdrName (IncludeFields WantNormal) env rdr_name) of
+ ; case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS WantNormal) of
[gre] -> return (greName gre)
_ -> do -- Ambiguous (can't happen) or unbound
traceRn "lookupTopBndrRN fail" (ppr rdr_name)
@@ -357,17 +355,14 @@ lookupExternalExactName name
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE name
= do { env <- getGlobalRdrEnv
- ; let main_occ = nameOccName name
- demoted_occs = case demoteOccName main_occ of
- Just occ -> [occ]
- Nothing -> []
- gres = [ gre | occ <- main_occ : demoted_occs
- , gre <- lookupGRE_OccName (IncludeFields WantBoth) env occ
- -- We're filtering by an exact 'Name' match,
- -- so we should look up as many potential matches as possible.
- -- See also test case T11809.
- , greName gre == name ]
- ; case gres of
+ ; let lk = LookupExactName { lookupExactName = name
+ , lookInAllNameSpaces = True }
+ -- We want to check for clashes where the same Unique
+ -- occurs in two different NameSpaces, as per
+ -- Note [Template Haskell ambiguity]. So we
+ -- check ALL namespaces, not just the NameSpace of the Name.
+ -- See test cases T9066, T11809.
+ ; case lookupGRE env lk of
[gre] -> return (Right gre)
[] -> -- See Note [Splicing Exact names]
@@ -384,7 +379,8 @@ lookupLocalExactGRE name
}
}
- gres -> return (Left (SameName gres)) } -- Ugh! See Note [Template Haskell ambiguity] }
+ gres -> return (Left (SameName gres)) }
+ -- Ugh! See Note [Template Haskell ambiguity] }
-----------------------------------------------
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
@@ -433,15 +429,16 @@ lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrenc
= lookupLocatedOccRnConstr tc_rdr
-----------------------------------------------
-lookupConstructorFields :: Name -> RnM [FieldLabel]
+lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel]
lookupConstructorFields = fmap conInfoFields . lookupConstructorInfo
-- | Look up the arity and record fields of a constructor.
-lookupConstructorInfo :: Name -> RnM ConInfo
+lookupConstructorInfo :: HasDebugCallStack => Name -> RnM ConInfo
lookupConstructorInfo con_name
= do { info <- lookupGREInfo_GRE con_name
; case info of
IAmConLike con_info -> return con_info
+ UnboundGRE -> return ConHasPositionalArgs
_ -> pprPanic "lookupConstructorInfo: not a ConLike" $
vcat [ text "name:" <+> ppr con_name ]
}
@@ -454,10 +451,10 @@ lookupExactOrOrig rdr_name res k
= do { men <- lookupExactOrOrig_base rdr_name
; case men of
FoundExactOrOrig gre -> return $ res gre
- ExactOrOrigError e ->
+ NotExactOrOrig -> k
+ ExactOrOrigError e ->
do { addErr (mkTcRnNotInScope rdr_name e)
- ; return $ res (mkUnboundGRERdr rdr_name) }
- NotExactOrOrig -> k }
+ ; return $ res (mkUnboundGRERdr rdr_name) } }
-- Variant of 'lookupExactOrOrig' that does not report an error
-- See Note [Errors in lookup functions]
@@ -563,7 +560,7 @@ lookupRecFieldOcc mb_con rdr_name
; Just nm -> return nm } }
| otherwise -- Can't use the data constructor to disambiguate
- = lookupGlobalOccRn' (IncludeFields WantField) rdr_name
+ = lookupGlobalOccRn' (RelevantGREsFOS WantField) rdr_name
-- This use of Global is right as we are looking up a selector,
-- which can only be defined at the top level.
@@ -683,23 +680,21 @@ disambiguation anyway, because `x` is an original name, and
lookupGlobalOccRn will find it.
-}
-
-- | Used in export lists to lookup the children.
-lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings -> Name -> RdrName
+lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
+ -> Name
+ -> RdrName -- ^ thing we are looking up
+ -> LookupChild -- ^ how to look it up (e.g. which
+ -- 'NameSpace's to look in)
-> RnM ChildLookupResult
-lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
+lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
| isUnboundName parent
-- Avoid an error cascade
= return (FoundChild (mkUnboundGRERdr rdr_name))
| otherwise = do
gre_env <- getGlobalRdrEnv
-
- let original_gres = lookupGRE_OccName (IncludeFields WantBoth) gre_env (rdrNameOcc rdr_name)
- -- WantBoth: we are looking for children, so we want to include fields defined
- -- with no field selectors, as we can export those as children. See test NFSExport.
-
- -- Disambiguate the lookup based on the parent information.
+ let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc rdr_name) how_lkup)
-- The remaining GREs are things that we *could* export here, note that
-- this includes things which have `NoParent`. Those are sorted in
-- `checkPatSynParent`.
@@ -710,8 +705,9 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
NoOccurrence ->
noMatchingParentErr original_gres
UniqueOccurrence g ->
- if must_have_parent then noMatchingParentErr original_gres
- else checkFld g
+ if must_have_parent
+ then noMatchingParentErr original_gres
+ else checkFld g
DisambiguatedOccurrence g ->
checkFld g
AmbiguousOccurrence gres ->
@@ -737,27 +733,21 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
traceRn "npe" (ppr original_gres)
dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
case original_gres of
- [] -> return NameNotFound
+ [] -> return NameNotFound
[g] -> return $ IncorrectParent parent g
- [p | Just p <- [getParent g]]
+ [p | ParentIs p <- [greParent g]]
gss@(g:gss'@(_:_)) ->
if all isRecFldGRE gss && dup_fields_ok
- then return $
- IncorrectParent parent g
- [p | x <- gss, Just p <- [getParent x]]
- else mkNameClashErr $ g NE.:| gss'
+ then return $
+ IncorrectParent parent g
+ [p | x <- gss, ParentIs p <- [greParent x]]
+ else mkNameClashErr $ g NE.:| gss'
mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr gres = do
addNameClashErrRn rdr_name gres
return (FoundChild (NE.head gres))
- getParent :: GlobalRdrElt -> Maybe Name
- getParent (GRE { gre_par = p } ) =
- case p of
- ParentIs cur_parent -> Just cur_parent
- NoParent -> Nothing
-
picked_gres :: [GlobalRdrElt] -> DisambigInfo
-- For Unqual, find GREs that are in scope qualified or unqualified
-- For Qual, find GREs that are in scope with that qualification
@@ -769,12 +759,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent p
- = case getParent p of
- Just cur_parent
- | parent == cur_parent -> DisambiguatedOccurrence p
- | otherwise -> NoOccurrence
- Nothing -> UniqueOccurrence p
-
+ = case greParent p of
+ ParentIs cur_parent
+ | parent == cur_parent -> DisambiguatedOccurrence p
+ | otherwise -> NoOccurrence
+ NoParent -> UniqueOccurrence p
+{-# INLINEABLE lookupSubBndrOcc_helper #-}
-- This domain specific datatype is used to record why we decided it was
-- possible that a GRE could be exported with a parent.
@@ -830,18 +820,9 @@ data ChildLookupResult
-- | We resolved to a child
| FoundChild GlobalRdrElt
--- | Specialised version of msum for RnM ChildLookupResult
-combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
-combineChildLookupResult [] = return NameNotFound
-combineChildLookupResult (x:xs) = do
- res <- x
- case res of
- NameNotFound -> combineChildLookupResult xs
- _ -> return res
-
instance Outputable ChildLookupResult where
ppr NameNotFound = text "NameNotFound"
- ppr (FoundChild n) = text "Found:" <+> ppr (gre_par n) <+> ppr n
+ ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n
ppr (IncorrectParent p g ns)
= text "IncorrectParent"
<+> hsep [ppr p, ppr $ greName g, ppr ns]
@@ -851,19 +832,21 @@ lookupSubBndrOcc :: DeprecationWarnings
-> SDoc
-> RdrName
-> RnM (Either NotInScopeError Name)
--- Find all the things the rdr-name maps to
--- and pick the one with the right parent name
+-- ^ Find all the things the 'RdrName' maps to,
+-- and pick the one with the right 'Parent' 'Name'.
lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name =
lookupExactOrOrig rdr_name (Right . greName) $
-- This happens for built-in classes, see mod052 for example
- do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name
+ do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name what_lkup
; return $ case child of
FoundChild g -> Right (greName g)
NameNotFound -> Left (UnknownSubordinate doc)
IncorrectParent {} -> Left (UnknownSubordinate doc) }
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
-
+ where
+ what_lkup = LookupChild { wantedParent = the_parent
+ , lookupDataConFirst = False }
{-
Note [Family instance binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1138,7 +1121,7 @@ lookup_demoted rdr_name
-- ^^^^^^^^^^^
report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
report_qualified_term_in_types rdr_name demoted_rdr_name =
- do { mName <- lookupGlobalOccRn_maybe (IncludeFields WantNormal) demoted_rdr_name
+ do { mName <- lookupGlobalOccRn_maybe (RelevantGREsFOS WantNormal) demoted_rdr_name
; case mName of
(Just _) -> termNameInType looking_for rdr_name demoted_rdr_name []
Nothing -> unboundTermNameInTypes looking_for rdr_name demoted_rdr_name }
@@ -1250,14 +1233,14 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name
lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe =
lookupOccRnX_maybe
- (lookupGlobalOccRn_maybe $ IncludeFields WantNormal)
+ (lookupGlobalOccRn_maybe $ RelevantGREsFOS WantNormal)
return
-- Used outside this module only by TH name reification (lookupName, lookupThName_maybe)
lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupSameOccRn_maybe =
lookupOccRnX_maybe
- (get_name <$> lookupGlobalOccRn_maybe SameOccName)
+ (get_name <$> lookupGlobalOccRn_maybe SameNameSpace)
(return . greName)
where
get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
@@ -1307,7 +1290,7 @@ lookupGlobalOccRn :: RdrName -> RnM Name
-- environment.
--
-- Used by exports_from_avail
-lookupGlobalOccRn = lookupGlobalOccRn' (IncludeFields WantNormal)
+lookupGlobalOccRn = lookupGlobalOccRn' (RelevantGREsFOS WantNormal)
lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' which_gres rdr_name =
@@ -1317,10 +1300,10 @@ lookupGlobalOccRn' which_gres rdr_name =
Just gre -> return (greName gre)
Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name)
; unboundName (LF which_suggest WL_Global) rdr_name }
- where which_suggest = case which_gres of
- IncludeFields WantBoth -> WL_RecField
- IncludeFields WantField -> WL_RecField
- _ -> WL_Anything
+ where which_suggest = case includeFieldSelectors which_gres of
+ WantBoth -> WL_RecField
+ WantField -> WL_RecField
+ WantNormal -> WL_Anything
-- Looks up a RdrName occurrence in the GlobalRdrEnv and with
-- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first.
@@ -1335,12 +1318,14 @@ lookupGlobalOccRn_base which_gres rdr_name =
-- and only happens for failed lookups
where
fos = case which_gres of
- IncludeFields f_or_s -> f_or_s
- _ -> WantNormal
+ RelevantGREs { includeFieldSelectors = sel } -> sel
+ _ -> if isFieldOcc (rdrNameOcc rdr_name)
+ then WantField
+ else WantNormal
-- | Lookup a 'Name' in the 'GlobalRdrEnv', falling back to looking up
-- in the type environment it if fails.
-lookupGREInfo_GRE :: Name -> RnM GREInfo
+lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo
lookupGREInfo_GRE name
= do { rdr_env <- getGlobalRdrEnv
; case lookupGRE_Name rdr_env name of
@@ -1352,19 +1337,19 @@ lookupGREInfo_GRE name
-- need to handle qualified imports in GHCi; see e.g. T9815ghci.
lookupInfoOccRn :: RdrName -> RnM [Name]
--- lookupInfoOccRn is intended for use in GHCi's ":info" command
+-- ^ lookupInfoOccRn is intended for use in GHCi's ":info" command
-- It finds all the GREs that RdrName could mean, not complaining
--- about ambiguity, but rather returning them all
--- C.f. #9881
+-- about ambiguity, but rather returning them all (c.f. #9881).
+--
-- lookupInfoOccRn is also used in situations where we check for
-- at least one definition of the RdrName, not complaining about
--- multiple definitions. (See #17832)
+-- multiple definitions (see #17832).
lookupInfoOccRn rdr_name =
lookupExactOrOrig rdr_name (\ gre -> [greName gre]) $
do { rdr_env <- getGlobalRdrEnv
- ; let ns = map greName $ lookupGRE_RdrName (IncludeFields WantBoth) rdr_env rdr_name
- ; qual_ns <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name
- ; return $ ns ++ (qual_ns `minusList` ns) }
+ ; let nms = map greName $ lookupGRE rdr_env (LookupRdrName rdr_name (RelevantGREsFOS WantBoth))
+ ; qual_nms <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name
+ ; return $ nms ++ (qual_nms `minusList` nms) }
-- | Look up all record field names, available in the 'GlobalRdrEnv',
-- that a given 'RdrName' might refer to.
@@ -1379,7 +1364,7 @@ lookupFieldGREs env (L loc rdr)
$ do { res <- lookupExactOrOrig rdr (\ gre -> maybeToList $ fieldGRE_maybe gre) $
do { let (env_fld_gres, env_var_gres) =
partition isRecFldGRE $
- lookupGRE_RdrName (IncludeFields WantBoth) env rdr
+ lookupGRE env (LookupRdrName rdr (RelevantGREsFOS WantBoth))
-- Handle implicit qualified imports in GHCi. See T10439.
; ghci_gres <- lookupQualifiedNameGHCi WantBoth rdr
@@ -1416,7 +1401,7 @@ lookupFieldGREs env (L loc rdr)
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded rdr_name =
lookupExactOrOrig_maybe rdr_name id $
- do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name AllDeprecationWarnings
+ do { res <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name AllDeprecationWarnings
; case res of
GreNotFound -> lookupOneQualifiedNameGHCi WantNormal rdr_name
OneNameMatch gre -> return $ Just gre
@@ -1675,7 +1660,7 @@ is enabled then we defer the selection until the typechecker.
lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper which_gres rdr_name warn_if_deprec
= do { env <- getGlobalRdrEnv
- ; case lookupGRE_RdrName which_gres env rdr_name of
+ ; case lookupGRE env (LookupRdrName rdr_name which_gres) of
[] -> return GreNotFound
[gre] -> do { addUsedGRE warn_if_deprec gre
; return (OneNameMatch gre) }
@@ -1689,7 +1674,7 @@ lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Uses addUsedRdrName to record use and deprecations
lookupGreAvailRn rdr_name
= do
- mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name ExportDeprecationWarnings
+ mb_gre <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name ExportDeprecationWarnings
case mb_gre of
GreNotFound ->
do
@@ -1828,10 +1813,11 @@ warnIfDeclDeprecated gre@(GRE { gre_imp = iss })
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec iface gre
- = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` -- Bleat if the thing,
- case gre_par gre of -- or its parent, is warn'd
- ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
- NoParent -> Nothing
+ -- Bleat if the thing, or its parent, is warn'd
+ = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`
+ case greParent gre of
+ ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
+ NoParent -> Nothing
warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
warnIfExportDeprecated gre@(GRE { gre_imp = iss })
@@ -2008,17 +1994,18 @@ lookupGREInfo hsc_env nm
-- and looks up the TyThing in the type environment.
--
-- See Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo.
- = let lookup_res = unsafePerformIO $ do
- let mod = nameModule nm
+ = case nameModule_maybe nm of
+ Nothing -> UnboundGRE
+ Just mod ->
+ unsafePerformIO $ do
_ <- initIfaceLoad hsc_env $
loadInterface (text "lookupGREInfo" <+> parens (ppr nm))
mod ImportBySystem
- lookupType hsc_env nm
- in
- case lookup_res of
- Nothing -> pprPanic "lookupGREInfo" $
- vcat [ text "lookup failed:" <+> ppr nm ]
- Just ty_thing -> tyThingGREInfo ty_thing
+ mb_ty_thing <- lookupType hsc_env nm
+ case mb_ty_thing of
+ Nothing -> pprPanic "lookupGREInfo" $
+ vcat [ text "lookup failed:" <+> ppr nm ]
+ Just ty_thing -> return $ tyThingGREInfo ty_thing
{-
Note [Looking up signature names]
@@ -2102,31 +2089,41 @@ lookupSigCtxtOccRn :: HsSigCtxt
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn ctxt what
= wrapLocMA $ \ rdr_name ->
- do { mb_name <- lookupBindGroupOcc ctxt what rdr_name
- ; case mb_name of
- Left err -> do { addErr (mkTcRnNotInScope rdr_name err)
- ; return (mkUnboundNameRdr rdr_name) }
- Right name -> return name }
+ do { let also_try_tycons = False
+ ; mb_names <- lookupBindGroupOcc ctxt what rdr_name also_try_tycons
+ ; case mb_names of
+ Right name NE.:| rest ->
+ do { massertPpr (null rest) $
+ vcat (text "lookupSigCtxtOccRn" <+> ppr name : map (either (pprScopeError rdr_name) ppr) rest)
+ ; return name }
+ Left err NE.:| _ ->
+ do { addErr (mkTcRnNotInScope rdr_name err)
+ ; return (mkUnboundNameRdr rdr_name) }
+ }
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
- -> RdrName -> RnM (Either NotInScopeError Name)
--- Looks up the RdrName, expecting it to resolve to one of the
--- bound names passed in. If not, return an appropriate error message
+ -> RdrName -- ^ what to look up
+ -> Bool -- ^ if the 'RdrName' we are looking up is in
+ -- a value 'NameSpace', should we also look up
+ -- in the type constructor 'NameSpace'?
+ -> RnM (NE.NonEmpty (Either NotInScopeError Name))
+-- ^ Looks up the 'RdrName', expecting it to resolve to one of the
+-- bound names currently in scope. If not, return an appropriate error message.
--
--- See Note [Looking up signature names]
-lookupBindGroupOcc ctxt what rdr_name
+-- See Note [Looking up signature names].
+lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns
| Just n <- isExact_maybe rdr_name
- = fmap greName <$> lookupExactOcc_either n
- -- allow for the possibility of missing Exacts;
- -- see Note [dataTcOccs and Exact Names]
+ = do { mb_gre <- lookupExactOcc_either n
+ ; return $ case mb_gre of
+ Left err -> NE.singleton $ Left err
+ Right gre -> finish (NoExactName $ greName gre) gre }
-- Maybe we should check the side conditions
-- but it's a pain, and Exact things only show
-- up when you know what you are doing
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
- = do { n' <- lookupOrig rdr_mod rdr_occ
- ; return (Right n') }
+ = do { NE.singleton . Right <$> lookupOrig rdr_mod rdr_occ }
| otherwise
= case ctxt of
@@ -2136,32 +2133,45 @@ lookupBindGroupOcc ctxt what rdr_name
LocalBindCtxt ns -> lookup_group ns
ClsDeclCtxt cls -> lookup_cls_op cls
InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610
- then return (Right $ mkUnboundNameRdr rdr_name)
+ then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name
else lookup_top (`elemNameSet` ns)
where
+
+ ns = occNameSpace occ
+ occ = rdrNameOcc rdr_name
+ relevant_gres =
+ RelevantGREs
+ { includeFieldSelectors = WantBoth
+ , lookupVariablesForFields = True
+ , lookupTyConsAsWell = also_try_tycon_ns }
+ ok_gre = greIsRelevant relevant_gres ns
+
+ finish err gre
+ | ok_gre gre
+ = NE.singleton (Right $ greName gre)
+ | otherwise
+ = NE.singleton (Left err)
+
lookup_cls_op cls
- = lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
+ = NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
where
doc = text "method of class" <+> quotes (ppr cls)
lookup_top keep_me
= do { env <- getGlobalRdrEnv
- ; dflags <- getDynFlags
- ; let all_gres = lookupGRE_OccName (IncludeFields WantNormal) env (rdrNameOcc rdr_name)
+ ; let occ = rdrNameOcc rdr_name
+ all_gres = lookupGRE env (LookupOccName occ relevant_gres)
names_in_scope = -- If rdr_name lacks a binding, only
- -- recommend alternatives from related
+ -- recommend alternatives from relevant
-- namespaces. See #17593.
- filter (\n -> nameSpacesRelated dflags WL_Anything
- (rdrNameSpace rdr_name)
- (nameNameSpace n))
- $ map greName
- $ filter isLocalGRE
+ map greName
+ $ filter (ok_gre <&&> isLocalGRE)
$ globalRdrEnvElts env
candidates_msg = candidates names_in_scope
; case filter (keep_me . greName) all_gres of
[] | null all_gres -> bale_out_with candidates_msg
| otherwise -> bale_out_with local_msg
- (gre:_) -> return (Right (greName gre)) }
+ (gre1:gres) -> return (fmap (Right . greName) (gre1 NE.:| gres)) }
lookup_group bound_names -- Look in the local envt (not top level)
= do { mname <- lookupLocalOccRn_maybe rdr_name
@@ -2169,11 +2179,11 @@ lookupBindGroupOcc ctxt what rdr_name
; let candidates_msg = candidates $ localRdrEnvElts env
; case mname of
Just n
- | n `elemNameSet` bound_names -> return (Right n)
+ | n `elemNameSet` bound_names -> return $ NE.singleton $ Right n
| otherwise -> bale_out_with local_msg
Nothing -> bale_out_with candidates_msg }
- bale_out_with hints = return (Left $ MissingBinding what hints)
+ bale_out_with hints = return $ NE.singleton $ Left $ MissingBinding what hints
local_msg = [SuggestMoveToDeclarationSite what rdr_name]
@@ -2187,8 +2197,8 @@ lookupBindGroupOcc ctxt what rdr_name
where
similar_names
= fuzzyLookup (unpackFS $ occNameFS $ rdrNameOcc rdr_name)
- $ map (\x -> ((unpackFS $ occNameFS $ nameOccName x), x))
- names_in_scope
+ $ map (\x -> ((unpackFS $ occNameFS $ nameOccName x), x))
+ names_in_scope
---------------
@@ -2197,17 +2207,16 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
-- Used for top-level fixity signatures and deprecations.
-- Complain if neither is in scope.
-- See Note [Fixity signature lookup]
-lookupLocalTcNames ctxt what rdr_name
- = do { mb_gres <- mapM lookup (dataTcOccs rdr_name)
- ; let (errs, names) = partitionEithers mb_gres
+lookupLocalTcNames ctxt what rdr
+ = do { this_mod <- getModule
+ ; let also_try_tycon_ns = True
+ ; nms_eithers <- fmap (guard_builtin_syntax this_mod rdr) <$>
+ lookupBindGroupOcc ctxt what rdr also_try_tycon_ns
+ ; let (errs, names) = partitionEithers (NE.toList nms_eithers)
; when (null names) $
addErr (head errs) -- Bleat about one only
; return names }
where
- lookup rdr = do { this_mod <- getModule
- ; nameEither <- lookupBindGroupOcc ctxt what rdr
- ; return (guard_builtin_syntax this_mod rdr nameEither) }
-
-- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233
guard_builtin_syntax this_mod rdr (Right name)
| Just _ <- isBuiltInOcc_maybe (occName rdr)
@@ -2216,7 +2225,7 @@ lookupLocalTcNames ctxt what rdr_name
| otherwise
= Right (rdr, name)
guard_builtin_syntax _ _ (Left err)
- = Left $ mkTcRnNotInScope rdr_name err
+ = Left $ mkTcRnNotInScope rdr err
dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
@@ -2231,9 +2240,8 @@ dataTcOccs rdr_name
occ = rdrNameOcc rdr_name
rdr_name_tc = setRdrNameSpace rdr_name tcName
-{-
-Note [dataTcOccs and Exact Names]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [dataTcOccs and Exact Names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exact RdrNames can occur in code generated by Template Haskell, and generally
those references are, well, exact. However, the TH `Name` type isn't expressive
enough to always track the correct namespace information, so we sometimes get
@@ -2249,8 +2257,6 @@ Note that setRdrNameSpace on an Exact name requires the Name to be External,
which it always is for built in syntax.
-}
-
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -261,7 +261,7 @@ rnExpr (HsVar _ (L l v))
Nothing -> rnUnboundVar v ;
Just gre ->
do { let nm = greName gre
- info = gre_info gre
+ info = greInfo gre
; if | IAmRecField fld_info <- info
-- Since GHC 9.4, such occurrences of record fields must be
-- unambiguous. For ambiguous occurrences, we arbitrarily pick one
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1143,7 +1143,7 @@ warn_term_var_capture lVar = do
case demoteRdrNameTv $ unLoc lVar of
Nothing -> return ()
Just demoted_name -> do
- let global_vars = lookupGRE_RdrName SameOccName gbl_env demoted_name
+ let global_vars = lookupGRE gbl_env (LookupRdrName demoted_name SameNameSpace)
let mlocal_var = lookupLocalRdrEnv local_env demoted_name
case mlocal_var of
Just name -> warnCapturedTerm lVar (Right name)
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -287,7 +287,10 @@ rnSrcWarnDecls bndr_set decls'
= do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
rdr_names
; txt' <- rnWarningTxt txt
- ; return [(rdrNameOcc rdr, txt') | (rdr, _) <- names] }
+ ; return [(nameOccName nm, txt') | (_, nm) <- names] }
+ -- Use the OccName from the Name we looked up, rather than from the RdrName,
+ -- as we might hit multiple different NameSpaces when looking up
+ -- (e.g. deprecating both a variable and a record field).
what = text "deprecation"
@@ -1552,7 +1555,7 @@ toParents rdr_env ns
getParent :: GlobalRdrEnv -> Name -> Name
getParent rdr_env n
= case lookupGRE_Name rdr_env n of
- Just gre -> case gre_par gre of
+ Just gre -> case greParent gre of
ParentIs { par_is = p } -> p
_ -> n
Nothing -> n
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -730,7 +730,7 @@ extendGlobalRdrEnvRn new_gres new_fixities
where
-- See Note [Reporting duplicate local declarations]
dups = filter isBadDupGRE
- $ lookupGRE_OccName (AllNameSpaces WantBoth) env (greOccName gre)
+ $ lookupGRE env (LookupOccName (greOccName gre) (RelevantGREsFOS WantBoth))
isBadDupGRE old_gre = isLocalGRE old_gre && greClashesWith gre old_gre
{- Note [Fail fast on duplicate definitions]
@@ -927,7 +927,7 @@ getLocalNonValBinders fixity_env
-- See (1) above
L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty
-- See (2) above
- MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe SameOccName cls_rdr
+ MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe SameNameSpace cls_rdr
-- Assuming the previous step succeeded, process any associated data
-- family instances. If the previous step failed, bail out.
case mb_cls_gre of
@@ -1530,7 +1530,7 @@ to a list of items, rather than a single item.
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv gres = foldr add emptyNameEnv gres
where
- add gre env = case gre_par gre of
+ add gre env = case greParent gre of
ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre
NoParent -> env
=====================================
compiler/GHC/Rename/Unbound.hs
=====================================
@@ -105,10 +105,10 @@ mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
mkUnboundGRE :: OccName -> GlobalRdrElt
-mkUnboundGRE occ = mkLocalVanillaGRE NoParent $ mkUnboundName occ
+mkUnboundGRE occ = mkLocalGRE UnboundGRE NoParent $ mkUnboundName occ
mkUnboundGRERdr :: RdrName -> GlobalRdrElt
-mkUnboundGRERdr rdr = mkLocalVanillaGRE NoParent $ mkUnboundNameRdr rdr
+mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr
reportUnboundName' :: WhatLooking -> RdrName -> RnM Name
reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr
@@ -212,8 +212,8 @@ fieldSelectorSuggestions global_env tried_rdr_name
| otherwise = [RemindFieldSelectorSuppressed tried_rdr_name parents]
where
gres = filter isNoFieldSelectorGRE
- $ lookupGRE_RdrName (IncludeFields WantField) global_env tried_rdr_name
- parents = [ parent | ParentIs parent <- map gre_par gres ]
+ $ lookupGRE global_env (LookupRdrName tried_rdr_name AllRelevantGREs)
+ parents = [ parent | ParentIs parent <- map greParent gres ]
similarNameSuggestions :: LookingFor -> DynFlags
-> GlobalRdrEnv -> LocalRdrEnv
@@ -355,7 +355,8 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
helpful_imports = filter helpful interesting_imports
where helpful (_,imv)
= any (isGreOk looking_for) $
- lookupGRE_OccName (AllNameSpaces WantNormal) (imv_all_exports imv) occ_name
+ lookupGRE (imv_all_exports imv)
+ (LookupOccName occ_name $ RelevantGREsFOS WantNormal)
-- Which of these do that because of an explicit hiding list resp. an
-- explicit import list
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -164,7 +164,7 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
where
(loc,occ) = get_loc_occ n
mb_local = lookupLocalRdrOcc local_env occ
- gres = lookupGRE_RdrName (AllNameSpaces WantBoth) global_env (mkRdrUnqual occ)
+ gres = lookupGRE global_env (LookupRdrName (mkRdrUnqual occ) (RelevantGREsFOS WantBoth))
-- Make an Unqualified RdrName and look that up, so that
-- we don't find any GREs that are in scope qualified-only
@@ -349,7 +349,7 @@ warnUnusedTopBinds gres
= whenWOptM Opt_WarnUnusedTopBinds
$ do env <- getGblEnv
let isBoot = isHsBootFile $ tcg_src env
- let noParent gre = case gre_par gre of
+ let noParent gre = case greParent gre of
NoParent -> True
_ -> False
-- Don't warn about unused bindings with parents in
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -362,7 +362,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv
$ gresFromAvails hsc_env (Just imp_spec) (mi_exports iface)
- case lookupGRE_RdrName (IncludeFields WantNormal) env rdr_name of
+ case lookupGRE env (LookupRdrName rdr_name (RelevantGREsFOS WantNormal)) of
[gre] -> return (Just (greName gre, iface))
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -2384,7 +2384,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm
| otherwise = []
occ_name_in_scope glb_env lcl_env occ_name = not $
- null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) &&
+ null (lookupGRE glb_env (LookupOccName occ_name (RelevantGREsFOS WantNormal))) &&
isNothing (lookupLocalRdrOcc lcl_env occ_name)
record_field = case orig of
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -654,9 +654,9 @@ instance Diagnostic TcRnMessage where
fld = quotes $ ppr (occNameFS $ greOccName gre1)
pprSugg gre = vcat [ bullet <+> pprGRE gre <> comma
, nest 2 (pprNameProvenance gre) ]
- pprGRE gre = case gre_info gre of
+ pprGRE gre = case greInfo gre of
IAmRecField {}
- -> let parent = par_is $ gre_par gre
+ -> let parent = par_is $ greParent gre
in text "record field" <+> fld <+> text "of" <+> quotes (ppr parent)
_ -> text "variable" <+> fld
TcRnAmbiguousRecordUpdate _rupd tc
@@ -3294,7 +3294,7 @@ dodgy_msg kind tc ie
where
rest :: [SDoc]
rest =
- case gre_info tc of
+ case greInfo tc of
IAmTyCon ClassFlavour
-> [ text "(in-scope) class methods or associated types" <> comma
, text "but it has none" ]
@@ -4629,10 +4629,10 @@ pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hol
pprScopeError :: RdrName -> NotInScopeError -> SDoc
pprScopeError rdr_name scope_err =
case scope_err of
- NotInScope {} ->
+ NotInScope ->
hang (text "Not in scope:")
2 (what <+> quotes (ppr rdr_name))
- NotARecordField {} ->
+ NotARecordField ->
hang (text "Not in scope:")
2 (text "record field" <+> quotes (ppr rdr_name))
NoExactName name ->
@@ -5467,7 +5467,7 @@ pprUnusedName name reason =
-- See #15487
pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc
pprAmbiguousGreName gre_env gre
- | IAmRecField fld_info <- gre_info gre
+ | IAmRecField fld_info <- greInfo gre
= sep [ text "the field" <+> quotes (ppr occ) <+> parent_info fld_info <> comma
, pprNameProvenance gre ]
| otherwise
@@ -5480,13 +5480,13 @@ pprAmbiguousGreName gre_env gre
case first_con of
PatSynName ps -> text "of pattern synonym" <+> quotes (ppr ps)
DataConName {} ->
- case gre_par gre of
+ case greParent gre of
ParentIs par
-- For a data family, only reporting the family TyCon can be
-- unhelpful (see T23301). So we give a bit of additional
-- info in that case.
| Just par_gre <- lookupGRE_Name gre_env par
- , IAmTyCon tc_flav <- gre_info par_gre
+ , IAmTyCon tc_flav <- greInfo par_gre
, OpenFamilyFlavour IAmData _ <- tc_flav
-> vcat [ ppr_cons
, text "in a data family instance of" <+> quotes (ppr par) ]
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5284,10 +5284,9 @@ data NotInScopeError
-- | A run-of-the-mill @"not in scope"@ error.
= NotInScope
- -- | Something used in record syntax, but it isn't a record field.
+ -- | Like 'NotInScope', but when we know we are looking for a
+ -- record field.
| NotARecordField
- -- TODO: this could be folded into NotInScope were there
- -- a separate namespace for record fields.
-- | An exact 'Name' was not in scope.
--
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -683,28 +683,19 @@ lookupChildrenExport :: Name -> [LIEWrappedName GhcPs]
-> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)])
lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
where
- -- Pick out the possible namespaces in order of priority
- -- This is a consequence of how the parser parses all
- -- data constructors as type constructors.
- choosePossibleNamespaces :: NameSpace -> [NameSpace]
- choosePossibleNamespaces ns
- | ns == varName = [varName, tcName]
- -- NB: for varName, we will also end up looking in the
- -- record field namespaces.
- | ns == tcName = [dataName, tcName]
- | otherwise = [ns]
-- Process an individual child
doOne :: LIEWrappedName GhcPs
-> RnM (LIEWrappedName GhcRn, GlobalRdrElt)
doOne n = do
let bareName = (ieWrappedName . unLoc) n
- -- Do not report export list declaration deprecations
- lkup v = lookupSubBndrOcc_helper False ExportDeprecationWarnings
- spec_parent (setRdrNameSpace bareName v)
+ what_lkup :: LookupChild
+ what_lkup = LookupChild { wantedParent = spec_parent
+ , lookupDataConFirst = True }
- name <- combineChildLookupResult $ map lkup $
- choosePossibleNamespaces (rdrNameSpace bareName)
+ -- Do not report export list declaration deprecations
+ name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings
+ spec_parent bareName what_lkup
traceRn "lookupChildrenExport" (ppr name)
-- Default to data constructors for slightly better error
-- messages
@@ -717,7 +708,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
NameNotFound ->
do { ub <- reportUnboundName unboundName
; let l = getLoc n
- gre = mkLocalVanillaGRE NoParent ub
+ gre = mkLocalGRE UnboundGRE NoParent ub
; return (L l (IEName noExtField (L (la2na l) ub)), gre)}
FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) ->
do { checkPatSynParent spec_parent par child_nm
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -958,9 +958,10 @@ checkHiBootIface'
= Just (gre, Nothing)
matching_flds
| isVarOcc missing_occ -- (This only applies to variables.)
- = lookupGRE_OccName (IncludeFields WantField) gre_env missing_occ
+ = lookupGRE gre_env $
+ LookupOccName missing_occ (RelevantGREsFOS WantField)
| otherwise
- = []
+ = [] -- BootFldReexport T18999_NoDisambiguateRecordFields T16745A
in case mapMaybe mb_ok $ matching_flds of
@@ -1750,7 +1751,7 @@ checkMainType tcg_env
do { rdr_env <- getGlobalRdrEnv
; let dflags = hsc_dflags hsc_env
main_occ = getMainOcc dflags
- main_gres = lookupGRE_OccName SameOccName rdr_env main_occ
+ main_gres = lookupGRE rdr_env (LookupOccName main_occ SameNameSpace)
; case filter isLocalGRE main_gres of {
[] -> return emptyWC ;
(_:_:_) -> return emptyWC ;
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -160,7 +160,7 @@ checkHsigIface tcg_env gre_env sig_iface
-- The hsig did NOT define this function; that means it must
-- be a reexport. In this case, make sure the 'Name' of the
-- reexport matches the 'Name' exported here.
- | [gre] <- lookupGRE_OccName (AllNameSpaces WantNormal) gre_env (nameOccName name) = do
+ | [gre] <- lookupGRE gre_env (LookupOccName (nameOccName name) SameNameSpace) = do
let name' = greName gre
when (name /= name') $ do
-- See Note [Error reporting bad reexport]
@@ -741,7 +741,7 @@ mergeSignatures
-- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
let fix_env = mkNameEnv [ (greName rdr_elt, FixItem occ f)
| (occ, f) <- concatMap mi_fixities ifaces
- , rdr_elt <- lookupGRE_OccName (AllNameSpaces WantBoth) rdr_env occ ]
+ , rdr_elt <- lookupGRE rdr_env (LookupOccName occ AllRelevantGREs) ]
-- STEP 5: Typecheck the interfaces
let type_env_var = tcg_type_env_var tcg_env
@@ -955,7 +955,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
impl_iface False{- safe -} NotBoot ImportedBySystem
fix_env = mkNameEnv [ (greName rdr_elt, FixItem occ f)
| (occ, f) <- mi_fixities impl_iface
- , rdr_elt <- lookupGRE_OccName (AllNameSpaces WantBoth) impl_gr occ ]
+ , rdr_elt <- lookupGRE impl_gr (LookupOccName occ AllRelevantGREs) ]
updGblEnv (\tcg_env -> tcg_env {
-- Setting tcg_rdr_env to treat all exported entities from
-- the implementing module as in scope improves error messages,
@@ -989,7 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
-- STEP 3: Check that the implementing interface exports everything
-- we need. (Notice we IGNORE the Modules in the AvailInfos.)
forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
- case lookupGRE_OccName SameOccName impl_gr occ of
+ case lookupGRE impl_gr (LookupOccName occ SameNameSpace) of
[] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod
_ -> return ()
failIfErrsM
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -31,7 +31,6 @@ where
import GHC.Prelude hiding (init, last, tail)
import GHC.Hs as Hs
-import GHC.Builtin.Names
import GHC.Tc.Errors.Types
import GHC.Types.Name.Reader
import qualified GHC.Types.Name as Name
=====================================
compiler/GHC/Types/GREInfo.hs
=====================================
@@ -113,6 +113,8 @@ Search for references to this note in the code for illustration.
data GREInfo
-- | No particular information... e.g. a function
= Vanilla
+ -- | An unbound GRE... could be anything
+ | UnboundGRE
-- | 'TyCon'
| IAmTyCon !(TyConFlavour Name)
-- | 'ConLike'
@@ -126,12 +128,14 @@ data GREInfo
instance NFData GREInfo where
rnf Vanilla = ()
+ rnf UnboundGRE = ()
rnf (IAmTyCon tc) = rnf tc
rnf (IAmConLike info) = rnf info
rnf (IAmRecField info) = rnf info
plusGREInfo :: GREInfo -> GREInfo -> GREInfo
plusGREInfo Vanilla Vanilla = Vanilla
+plusGREInfo UnboundGRE UnboundGRE = UnboundGRE
plusGREInfo (IAmTyCon {}) info2@(IAmTyCon {}) = info2
plusGREInfo (IAmConLike {}) info2@(IAmConLike {}) = info2
plusGREInfo (IAmRecField {}) info2@(IAmRecField {}) = info2
@@ -141,6 +145,7 @@ plusGREInfo info1 info2 = pprPanic "plusInfo" $
instance Outputable GREInfo where
ppr Vanilla = text "Vanilla"
+ ppr UnboundGRE = text "UnboundGRE"
ppr (IAmTyCon flav)
= text "TyCon" <+> ppr flav
ppr (IAmConLike info)
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -89,7 +89,8 @@ module GHC.Types.Name.Occurrence (
OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
mapOccEnv, strictMapOccEnv,
mapMaybeOccEnv,
- lookupOccEnv, lookupOccEnv_WithFields, lookupFieldsOccEnv,
+ lookupOccEnv, lookupOccEnv_AllNameSpaces,
+ lookupOccEnv_WithFields, lookupFieldsOccEnv,
mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
nonDetOccEnvElts, nonDetFoldOccEnv,
plusOccEnv, plusOccEnv_C,
@@ -614,6 +615,13 @@ lookupOccEnv (MkOccEnv as) (OccName ns s)
= do { m <- lookupFsEnv as s
; lookupUFM m ns }
+-- | Lookup an element in an 'OccEnv', ignoring 'NameSpace's entirely.
+lookupOccEnv_AllNameSpaces :: OccEnv a -> OccName -> [a]
+lookupOccEnv_AllNameSpaces (MkOccEnv as) (OccName _ s)
+ = case lookupFsEnv as s of
+ Nothing -> []
+ Just r -> nonDetEltsUFM r
+
-- | Lookup an element in an 'OccEnv', looking in the record field
-- namespace for a variable.
lookupOccEnv_WithFields :: OccEnv a -> OccName -> [a]
=====================================
compiler/GHC/Types/Name/Ppr.hs
=====================================
@@ -97,7 +97,8 @@ mkQualName env = qual_name where
= NameQual (greQualModName gre)
| null qual_gres
- = if null (lookupGRE_RdrName SameOccName env (mkRdrQual (moduleName mod) occ))
+ = if null $ lookupGRE env $
+ LookupRdrName (mkRdrQual (moduleName mod) occ) SameNameSpace
then NameNotInScope1
else NameNotInScope2
@@ -127,8 +128,8 @@ mkQualName env = qual_name where
right_name gre = greDefinitionModule gre == Just mod
- unqual_gres = lookupGRE_RdrName SameOccName env (mkRdrUnqual occ)
- qual_gres = filter right_name (lookupGRE_OccName SameOccName env occ)
+ unqual_gres = lookupGRE env (LookupRdrName (mkRdrUnqual occ) SameNameSpace)
+ qual_gres = filter right_name (lookupGRE env (LookupOccName occ SameNameSpace))
-- we can mention a module P:M without the P: qualifier iff
-- "import M" would resolve unambiguously to P:M. (if P is the
@@ -150,7 +151,7 @@ mkPromTick ptc env
= ptcListTuplePuns ptc
| Just occ' <- promoteOccName occ
- , [] <- lookupGRE_RdrName SameOccName env (mkRdrUnqual occ')
+ , [] <- lookupGRE env (LookupRdrName (mkRdrUnqual occ') SameNameSpace)
= -- Could not find a corresponding type name in the environment,
-- so the data name is unambiguous. Promotion tick not needed.
False
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -7,6 +7,8 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
-- |
-- #name_types#
@@ -53,7 +55,13 @@ module GHC.Types.Name.Reader (
-- ** Looking up 'GlobalRdrElt's
FieldsOrSelectors(..), filterFieldGREs, allowGRE,
- WhichGREs(..), lookupGRE_OccName, lookupGRE_RdrName, lookupGRE_Name,
+
+ LookupGRE(..), lookupGRE,
+ WhichGREs(.., AllRelevantGREs, RelevantGREsFOS),
+ greIsRelevant,
+ LookupChild(..),
+
+ lookupGRE_Name,
lookupGRE_FieldLabel,
getGRE_NameQualifier_maybes,
transformGREs, pickGREs, pickGREsModExp,
@@ -67,7 +75,8 @@ module GHC.Types.Name.Reader (
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt,
- greName, forceGlobalRdrEnv, hydrateGlobalRdrEnv,
+ greName, greNameSpace, greParent, greInfo,
+ forceGlobalRdrEnv, hydrateGlobalRdrEnv,
isLocalGRE, isImportedGRE, isRecFldGRE,
fieldGREInfo,
isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE,
@@ -126,6 +135,7 @@ import GHC.Utils.Panic
import Control.DeepSeq
import Control.Monad ( guard )
import Data.Data
+import Data.List ( sort )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Semigroup as S
@@ -583,8 +593,8 @@ absence of the 'GREInfo' field.
This parametrisation also helps ensure that we don't accidentally force the
GREInfo field (which can cause unnecessary loading of interface files).
-In particular, the 'lookupGRE_OccName' is statically guaranteed to not consult
-the 'GREInfo' field when its first argument is 'SameOccName', which is important
+In particular, the 'lookupGRE' function is statically guaranteed to not consult
+the 'GREInfo' field when using 'SameNameSpace', which is important
as we sometimes need to use this function with an 'IfaceGlobalRdrEnv' in which
the 'GREInfo' fields have been stripped.
-}
@@ -596,6 +606,15 @@ type FieldGlobalRdrElt = GlobalRdrElt
greName :: GlobalRdrEltX info -> Name
greName = gre_name
+greNameSpace :: GlobalRdrEltX info -> NameSpace
+greNameSpace = nameNameSpace . greName
+
+greParent :: GlobalRdrEltX info -> Parent
+greParent = gre_par
+
+greInfo :: GlobalRdrElt -> GREInfo
+greInfo = gre_info
+
instance NFData IfGlobalRdrElt where
rnf !_ = ()
@@ -1023,7 +1042,7 @@ fieldGRELabel = recFieldLabel . fieldGREInfo
fieldGREInfo :: HasDebugCallStack => FieldGlobalRdrElt -> RecFieldInfo
fieldGREInfo gre
= assertPpr (isRecFldGRE gre) (ppr gre) $
- case gre_info gre of
+ case greInfo gre of
IAmRecField info -> info
info -> pprPanic "fieldGREInfo" $
vcat [ text "gre_name:" <+> ppr (greName gre)
@@ -1031,13 +1050,13 @@ fieldGREInfo gre
recFieldConLike_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe ConInfo
recFieldConLike_maybe gre =
- case gre_info gre of
+ case greInfo gre of
IAmConLike info -> Just info
_ -> Nothing
recFieldInfo_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe RecFieldInfo
recFieldInfo_maybe gre =
- case gre_info gre of
+ case greInfo gre of
IAmRecField info -> assertPpr (isRecFldGRE gre) (ppr gre) $ Just info
_ -> Nothing
@@ -1051,7 +1070,7 @@ data FieldsOrSelectors
-- they have selectors).
| WantField -- ^ Include only fields, with or without selectors, ignoring
-- any non-fields in scope.
- deriving Eq
+ deriving (Eq, Show)
filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs WantBoth = id
@@ -1072,7 +1091,7 @@ allowGRE WantNormal gre
allowGRE WantField gre
= isRecFldGRE gre
--- | How should we look up in a 'GlobalRdrEnv'? Should we only look up
+-- | What should we look up in a 'GlobalRdrEnv'? Should we only look up
-- names with the exact same 'OccName', or do we allow different 'NameSpace's?
--
-- Depending on the answer, we might need more or less information from the
@@ -1081,71 +1100,245 @@ allowGRE WantField gre
-- we need to consult the 'GREInfo'. This is why this datatype is a GADT.
--
-- See Note [IfGlobalRdrEnv].
-data WhichGREs info where
+data LookupGRE info where
-- | Look for this specific 'OccName', with the exact same 'NameSpace',
-- in the 'GlobalRdrEnv'.
- SameOccName :: WhichGREs info
- -- | If the 'OccName' is a variable, also look up in the record field namespaces.
- --
- -- Used to look up variables which might refer to record fields.
- IncludeFields :: FieldsOrSelectors
- -- ^ - Should we include record fields defined with @-XNoFieldSelectors@?
- -- - Should we include non-fields?
- --
- -- See Note [NoFieldSelectors].
- -> WhichGREs GREInfo
- -- | Like @'IncludeFields'@, but if the 'OccName' is a field,
- -- also look up in the variable namespace.
+ LookupOccName :: OccName -- ^ the 'OccName' to look up
+ -> WhichGREs info
+ -- ^ information about other relevant 'NameSpace's
+ -> LookupGRE info
+
+ -- | Look up the 'OccName' of this 'RdrName' in the 'GlobalRdrEnv',
+ -- filtering out those whose qualification matches that of the 'RdrName'.
--
- -- Used to check if there are name clashes.
- AllNameSpaces :: FieldsOrSelectors -> WhichGREs GREInfo
+ -- Lookup returns an empty result for 'Exact' or 'Orig' 'RdrName's.
+ LookupRdrName :: RdrName -- ^ the 'RdrName' to look up
+ -> WhichGREs info
+ -- ^ information about other relevant 'NameSpace's
+ -> LookupGRE info
--- | Look for this 'OccName' in the global environment.
---
--- The 'WhichGREs' argument specifies which 'GlobalRdrElt's we are interested in.
-lookupGRE_OccName :: WhichGREs info -> GlobalRdrEnvX info -> OccName -> [GlobalRdrEltX info]
-lookupGRE_OccName what env occ
- -- If the 'RdrName' is a variable, we might also need
- -- to look up in the record field namespaces.
- | isVarOcc occ
- , Just flds <- mb_flds
- = normal ++ flds
- -- If the 'RdrName' is a record field, we might want to check
- -- the variable namespace too.
- | isFieldOcc occ
- , Just flds <- mb_flds
- = flds ++ case what of { AllNameSpaces {} -> vars; _ -> [] }
+ -- | Look for 'GRE's with the same unique as the given 'Name'
+ -- in the 'GlobalRdrEnv'.
+ LookupExactName
+ :: { lookupExactName :: Name
+ -- ^ the 'Name' to look up
+ , lookInAllNameSpaces :: Bool
+ -- ^ whether to look in *all* 'NameSpace's, or just
+ -- in the 'NameSpace' of the 'Name'
+ -- See Note [Template Haskell ambiguity]
+ }
+ -> LookupGRE info
+
+ -- | Look up children 'GlobalRdrElt's with a given 'Parent'.
+ LookupChildren
+ :: OccName -- ^ the 'OccName' to look up
+ -> LookupChild
+ -- ^ information to decide which 'GlobalRdrElt's
+ -- are valid children after looking up
+ -> LookupGRE info
+
+-- | How should we look up in a 'GlobalRdrEnv'?
+-- Which 'NameSpace's are considered relevant for a given lookup?
+data WhichGREs info where
+ -- | Only consider 'GlobalRdrElt's with the exact 'NameSpace' we look up.
+ SameNameSpace :: WhichGREs info
+ -- | Allow 'GlobalRdrElt's with different 'NameSpace's, e.g. allow looking up
+ -- record fields from the variable 'NameSpace', or looking up a 'TyCon' from
+ -- the data constructor 'NameSpace'.
+ RelevantGREs
+ :: { includeFieldSelectors :: !FieldsOrSelectors
+ -- ^ how should we handle looking up variables?
+ --
+ -- - should we include record fields defined with @-XNoFieldSelectors@?
+ -- - should we include non-fields?
+ --
+ -- See Note [NoFieldSelectors].
+ , lookupVariablesForFields :: !Bool
+ -- ^ when looking up a record field, should we also look up plain variables?
+ , lookupTyConsAsWell :: !Bool
+ -- ^ when looking up a variable, field or data constructor, should we
+ -- also try the type constructor 'NameSpace'?
+ }
+ -> WhichGREs GREInfo
+
+-- | Look up as many possibly relevant 'GlobalRdrElt's as possible.
+pattern AllRelevantGREs :: WhichGREs GREInfo
+pattern AllRelevantGREs =
+ RelevantGREs { includeFieldSelectors = WantBoth
+ , lookupVariablesForFields = True
+ , lookupTyConsAsWell = True }
+
+-- | Look up relevant GREs, taking into account the interaction between the
+-- variable and field 'NameSpace's as determined by the 'FieldsOrSelector'
+-- argument.
+pattern RelevantGREsFOS :: FieldsOrSelectors -> WhichGREs GREInfo
+pattern RelevantGREsFOS fos <- RelevantGREs { includeFieldSelectors = fos }
+ where
+ RelevantGREsFOS fos =
+ RelevantGREs { includeFieldSelectors = fos
+ , lookupVariablesForFields = fos == WantBoth
+ , lookupTyConsAsWell = False }
+
+data LookupChild
+ = LookupChild
+ { wantedParent :: Name
+ -- ^ the parent we are looking up children of
+ , lookupDataConFirst :: Bool
+ -- ^ for type constructors, should we look in the data constructor
+ -- namespace first?
+ }
+
+-- | After looking up something with the given 'NameSpace', is the resulting
+-- 'GlobalRdrElt' we have obtained relevant, according to the 'RelevantGREs'
+-- specification of which 'NameSpace's are relevant?
+greIsRelevant :: WhichGREs GREInfo -- ^ specification of which 'GlobalRdrElt's to consider relevant
+ -> NameSpace -- ^ the 'NameSpace' of the thing we are looking up
+ -> GlobalRdrElt -- ^ the 'GlobalRdrElt' we have looked up, in a
+ -- potentially different 'NameSpace' than we wanted
+ -> Bool
+greIsRelevant which_gres ns gre
+ | ns == other_ns
+ = True
| otherwise
- = normal
+ = case which_gres of
+ SameNameSpace -> False
+ RelevantGREs { includeFieldSelectors = fos
+ , lookupVariablesForFields = vars_for_flds
+ , lookupTyConsAsWell = tycons_too }
+ | ns == varName
+ -> (isFieldNameSpace other_ns && allowGRE fos gre) || tc_too
+ | isFieldNameSpace ns
+ -> vars_for_flds &&
+ ( other_ns == varName
+ || (isFieldNameSpace other_ns && allowGRE fos gre)
+ || tc_too )
+ | isDataConNameSpace ns
+ -> tc_too
+ | otherwise
+ -> False
+ where
+ tc_too = tycons_too && isTcClsNameSpace other_ns
+ where
+ other_ns = greNameSpace gre
+
+-- | Scoring priority function for looking up children 'GlobalRdrElt'.
+--
+-- First we score by 'NameSpace', with higher-priority 'NameSpace's having a
+-- lower number. Then we break ties by checking if the 'Parent' is correct.
+--
+-- This complicated scoring function is determined by the behaviour required by
+-- 'lookupChildrenExport', which requires us to look in the data constructor
+-- 'NameSpace' first, for things in the type constructor 'NameSpace'.
+childGREPriority :: LookupChild -- ^ what kind of child do we want,
+ -- e.g. what should its parent be?
+ -> NameSpace -- ^ what 'NameSpace' are we originally looking in?
+ -> GlobalRdrEltX info
+ -- ^ the result of looking up; it might be in a different
+ -- 'NameSpace', which is used to determine the score
+ -- (in the first component)
+ -> Maybe (Int, Int)
+childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first })
+ ns gre =
+ case child_ns_prio $ greNameSpace gre of
+ Nothing -> Nothing
+ Just np -> Just (np, parent_prio $ greParent gre)
+ -- Prioritise GREs first on NameSpace, and then on Parent.
+ -- See T11970.
where
- mb_flds =
- case what of
- IncludeFields fos -> Just $ filterFieldGREs fos $ concat $ lookupFieldsOccEnv env (occNameFS occ)
- AllNameSpaces fos -> Just $ filterFieldGREs fos $ concat $ lookupFieldsOccEnv env (occNameFS occ)
- SameOccName -> Nothing
+ -- Pick out the possible 'NameSpace's in order of priority.
+ child_ns_prio :: (NameSpace -> Maybe Int)
+ child_ns_prio other_ns
+ | other_ns == ns
+ = Just 0
+ | isTermVarOrFieldNameSpace ns
+ , isTermVarOrFieldNameSpace other_ns
+ = Just 0
+ | ns == varName
+ , other_ns == tcName
+ -- When looking up children, we sometimes want to a symbolic variable
+ -- name to resolve to a type constructor, e.g. for an infix declaration
+ -- "infix +!" we want to take into account both class methods and associated
+ -- types. See test T10816.
+ = Just 1
+ | ns == tcName
+ , other_ns == dataName
+ , try_dc_first -- try data namespace before type/class namespace?
+ = Just (-1)
+ | otherwise
+ = Nothing
- normal = fromMaybe [] $ lookupOccEnv env occ
- vars = fromMaybe [] $ lookupOccEnv env (recFieldToVarOcc occ)
+ parent_prio :: Parent -> Int
+ parent_prio (ParentIs other_parent)
+ | other_parent == wanted_parent = 0
+ | otherwise = 1
+ parent_prio NoParent = 0
--- | Like 'lookupGRE_OccName', but for a 'RdrName'.
-lookupGRE_RdrName :: WhichGREs info -> GlobalRdrEnvX info -> RdrName -> [GlobalRdrEltX info]
-lookupGRE_RdrName what env rdr =
- pickGREs rdr $ lookupGRE_OccName what env (rdrNameOcc rdr)
+-- | Look something up in the Global Reader Environment.
+--
+-- The 'LookupGRE' argument specifies what to look up, and in particular
+-- whether there should there be any lee-way if the 'NameSpace's don't
+-- exactly match.
+lookupGRE :: GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
+lookupGRE env = \case
+ LookupOccName occ which_gres ->
+ case which_gres of
+ SameNameSpace ->
+ concat $ lookupOccEnv env occ
+ rel@(RelevantGREs{}) ->
+ filter (greIsRelevant rel (occNameSpace occ)) $
+ concat $ lookupOccEnv_AllNameSpaces env occ
+ LookupRdrName rdr rel ->
+ pickGREs rdr $ lookupGRE env (LookupOccName (rdrNameOcc rdr) rel)
+ LookupExactName { lookupExactName = nm
+ , lookInAllNameSpaces = all_ns } ->
+ [ gre | gre <- lkup, greName gre == nm ]
+ where
+ occ = nameOccName nm
+ lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ
+ | otherwise = fromMaybe [] $ lookupOccEnv env occ
+ LookupChildren occ which_child ->
+ highestPriorityGREs (childGREPriority which_child ns) $
+ concat $ lookupOccEnv_AllNameSpaces env occ
+ where
+ ns :: NameSpace
+ ns = occNameSpace occ
--- | Look for precisely this 'Name' in the environment.
+-- | Collect the 'GlobalRdrElt's with the highest priority according
+-- to the given function (lower value <=> higher priority).
+--
+-- This allows us to first look in e.g. the data 'NameSpace', and then fall back
+-- to the type/class 'NameSpace'.
+highestPriorityGREs :: forall info prio
+ . Ord prio
+ => (GlobalRdrEltX info -> Maybe prio)
+ -- ^ priority function
+ -- lower value <=> higher priority
+ -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
+highestPriorityGREs priority gres =
+ take_highest_prio $ NE.group $ sort
+ [ S.Arg prio gre
+ | gre <- gres
+ , prio <- maybeToList $ priority gre ]
+ where
+ take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info]
+ take_highest_prio [] = []
+ take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs
+{-# INLINEABLE highestPriorityGREs #-}
+
+-- | Look for precisely this 'Name' in the environment,
+-- in the __same 'NameSpace'__ as the 'Name'.
--
-- This tests whether it is in scope, ignoring anything
-- else that might be in scope which doesn't have the same 'Unique'.
lookupGRE_Name :: Outputable info => GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name env name =
- let occ = nameOccName name
- in case [ gre | gre <- lookupGRE_OccName SameOccName env occ
- , gre_name gre == name ] of
+ case lookupGRE env (LookupExactName { lookupExactName = name
+ , lookInAllNameSpaces = False }) of
[] -> Nothing
[gre] -> Just gre
gres -> pprPanic "lookupGRE_Name"
- (ppr name $$ ppr occ $$ ppr gres)
+ (ppr name $$ ppr (nameOccName name) $$ ppr gres)
-- See INVARIANT 1 on GlobalRdrEnv
-- | Look for a particular record field selector in the environment.
@@ -1531,16 +1724,17 @@ greIsShadowed old_gre shadowed =
-- | Whether a 'GlobalRdrElt' is definitely shadowed, definitely not shadowed,
-- or conditionally shadowed based on more information beyond the 'NameSpace'.
data IsShadowed
+ -- | The GRE is not shadowed.
= IsNotShadowed
+ -- | The GRE is shadowed.
| IsShadowed
+ -- | The GRE is shadowed iff it is a record field GRE
+ -- which defines a field selector (i.e. FieldSelectors is enabled in its
+ -- defining module).
| IsShadowedIfFieldSelector
-- | Internal function: is a 'GlobalRdrElt' with the 'NameSpace' with given
-- 'Unique' shadowed by the specified 'ShadowedGREs'?
---
--- - @Just b@ means: definitely @b at .
--- - @Nothing@ means: the GRE is shadowed iff it is a record field GRE
--- with FieldSelectors enabled.
namespace_is_shadowed :: Unique -> ShadowedGREs -> IsShadowed
namespace_is_shadowed old_ns (ShadowedGREs shadowed_nonflds shadowed_flds)
| isFldNSUnique old_ns
=====================================
testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr
=====================================
@@ -2,10 +2,10 @@
BootFldReexport.hs:8:9: error: [GHC-87543]
Ambiguous occurrence ‘fld’.
It could refer to
- either ‘BootFldReexport_N.fld’,
+ either the field ‘fld’ of record ‘BootFldReexport_O.O’,
+ imported from ‘BootFldReexport_O’ at BootFldReexport.hs:6:5-7
+ (and originally defined at BootFldReexport_O.hs:5:16-18),
+ or ‘BootFldReexport_N.fld’,
imported from ‘BootFldReexport_N’ at BootFldReexport.hs:4:5-7
(and originally defined in ‘BootFldReexport_O’
- at BootFldReexport_O.hs-boot:4:1-13),
- or the field ‘fld’ of record ‘BootFldReexport_O.O’,
- imported from ‘BootFldReexport_O’ at BootFldReexport.hs:6:5-7
- (and originally defined at BootFldReexport_O.hs:5:16-18).
+ at BootFldReexport_O.hs-boot:4:1-13).
=====================================
testsuite/tests/overloadedrecflds/should_compile/T23279.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module T23279 where
+
+import T23279_aux
+
+bar = Bar { x = 3, y = 'x', z = False, w = 17.28 }
+baz = Baz { z = 1.1 }
+
+v = w
=====================================
testsuite/tests/overloadedrecflds/should_compile/T23279.stderr
=====================================
@@ -0,0 +1,20 @@
+
+T23279.hs:7:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of record field of Bar ‘x’ (imported from T23279_aux):
+ Deprecated: "Don't use x"
+
+T23279.hs:7:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of record field of Bar ‘z’ (imported from T23279_aux):
+ Deprecated: "Don't use z"
+
+T23279.hs:7:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of record field of Bar ‘w’ (imported from T23279_aux):
+ Deprecated: "Don't use w"
+
+T23279.hs:8:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of record field of Baz ‘z’ (imported from T23279_aux):
+ Deprecated: "Don't use z"
+
+T23279.hs:10:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of ‘w’ (imported from T23279_aux):
+ Deprecated: "Don't use w"
=====================================
testsuite/tests/overloadedrecflds/should_compile/T23279_aux.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE DuplicateRecordFields, NoFieldSelectors #-}
+
+module T23279_aux where
+
+data Bar = Bar
+ { x :: Int
+ , y :: Char
+ , z :: Bool
+ , w :: Double
+ }
+
+data Baz = Baz { z :: Float }
+
+w :: ()
+w = ()
+
+{-# DEPRECATED x "Don't use x" #-}
+{-# DEPRECATED z "Don't use z" #-}
+{-# DEPRECATED w "Don't use w" #-}
=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -55,3 +55,4 @@ test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A'
test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0'])
test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0'])
test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0'])
+test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0'])
=====================================
testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
=====================================
@@ -6,9 +6,9 @@
T16745A.hs:8:9: error: [GHC-87543]
Ambiguous occurrence ‘field’.
It could refer to
- either ‘T16745B.field’,
+ either the field ‘field’ of record ‘T16745B.R’,
imported from ‘T16745B’ at T16745A.hs:3:24-28
- (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5),
- or the field ‘field’ of record ‘T16745B.R’,
+ (and originally defined at T16745B.hs:11:14-18),
+ or ‘T16745B.field’,
imported from ‘T16745B’ at T16745A.hs:3:24-28
- (and originally defined at T16745B.hs:11:14-18).
+ (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5).
=====================================
testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr
=====================================
@@ -2,11 +2,11 @@
T18999_NoDisambiguateRecordFields.hs:6:13: error: [GHC-87543]
Ambiguous occurrence ‘not’.
It could refer to
- either ‘Prelude.not’,
+ either the field ‘not’ of record ‘Foo’,
+ defined at T18999_NoDisambiguateRecordFields.hs:4:18,
+ or ‘Prelude.not’,
imported from ‘Prelude’ at T18999_NoDisambiguateRecordFields.hs:2:8-40
- (and originally defined in ‘GHC.Classes’),
- or the field ‘not’ of record ‘Foo’,
- defined at T18999_NoDisambiguateRecordFields.hs:4:18.
+ (and originally defined in ‘GHC.Classes’).
T18999_NoDisambiguateRecordFields.hs:8:11: error: [GHC-56428]
Ambiguous record field ‘not’.
=====================================
testsuite/tests/th/T7241.stderr
=====================================
@@ -7,3 +7,12 @@ T7241.hs:7:2: error: [GHC-81573]
If you bound a unique Template Haskell name (NameU)
perhaps via newName,
then -ddump-splices might be useful.
+
+T7241.hs:7:2: error: [GHC-81573]
+ Same Name in multiple name-spaces:
+ type constructor or class ‘Foo’, declared at: T7241.hs:7:2
+ data constructor ‘Foo’, declared at: T7241.hs:7:2
+ Suggested fix:
+ If you bound a unique Template Haskell name (NameU)
+ perhaps via newName,
+ then -ddump-splices might be useful.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2af23f0e84eec0eb30d77134abd99858a02d7a18...7f0a86edeeda674f27c80e81be592d325447a897
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2af23f0e84eec0eb30d77134abd99858a02d7a18...7f0a86edeeda674f27c80e81be592d325447a897
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230713/b042d319/attachment-0001.html>
More information about the ghc-commits
mailing list