diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index dcb6901b2c13875c160d6c6efec7d31b4542088a..36d6a2d820b89d949710cf156c84c1e520ed80b7 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/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
diff --git a/compiler/GHC/Rename/Doc.hs b/compiler/GHC/Rename/Doc.hs
index f8499cf8c8b8611a0eab973600342570c37ec4b7..f32f3ec7cc0cdaacc1033be39d9f89515da019ac 100644
--- a/compiler/GHC/Rename/Doc.hs
+++ b/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
@@ -41,6 +40,5 @@ rnHsDocIdentifiers :: GlobalRdrEnv
rnHsDocIdentifiers gre_env ns =
[ L l $ greName gre
| L l rdr_name <- ns
- , gre <- lookupGRE_RdrName AllNameSpaces gre_env rdr_name
- , rdrRelevantNameSpace rdr_name $ greNameSpace gre
+ , gre <- lookupGRE gre_env (LookupOccName (rdrNameOcc rdr_name) AllRelevantGREs)
]
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index ce4a4f458fe19495b29c59fb7fb88f4de84af0c2..e4d8a9d5553e613e2f89ed380015d42645947caf 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -33,7 +33,6 @@ module GHC.Rename.Env (
ChildLookupResult(..),
lookupSubBndrOcc_helper,
- childrenNameSpaces, -- Called by lookupChildrenExport
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
lookupSigCtxtOccRn,
@@ -58,7 +57,6 @@ module GHC.Rename.Env (
addUsedGRE, addUsedGREs, addUsedDataCons,
dataTcOccs, --TODO: Move this somewhere, into utils?
- rdrRelevantNameSpace,
) where
@@ -115,7 +113,7 @@ import Control.Arrow ( first )
import Control.Monad
import Data.Either ( partitionEithers )
import Data.Function ( on )
-import Data.List ( find, partition, groupBy, sort, sortBy )
+import Data.List ( find, partition, groupBy, sortBy )
import Data.Foldable ( for_ )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semi
@@ -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 False) 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,14 +355,14 @@ lookupExternalExactName name
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE name
= do { env <- getGlobalRdrEnv
- ; let occ = nameOccName name
- gres = [ gre | gre <- lookupGRE_OccName AllNameSpaces env occ
- -- We're filtering by an exact 'Name' match,
- -- so we should look up as many potential matches as possible.
- -- See Note [rdrRelevantNameSpace and Exact Names]
- -- and test cases T9066, 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]
@@ -562,7 +560,7 @@ lookupRecFieldOcc mb_con rdr_name
; Just nm -> return nm } }
| otherwise -- Can't use the data constructor to disambiguate
- = lookupGlobalOccRn' (IncludeFields WantField False) 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,38 +681,20 @@ lookupGlobalOccRn will find it.
-}
-- | Used in export lists to lookup the children.
-lookupSubBndrOcc_helper :: forall ns_prio
- . Ord ns_prio
- => Bool -> DeprecationWarnings
+lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
-> Name
-> RdrName -- ^ thing we are looking up
- -> (NameSpace -> Maybe ns_prio)
+ -> 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 ns_prio
+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 gre_prio :: GlobalRdrElt -> Maybe (ns_prio, Int)
- gre_prio gre = case ns_prio $ greNameSpace gre of
- Nothing -> Nothing
- Just np -> Just (np, case right_parent gre of { NoOccurrence -> 1 ; _ -> 0 })
- -- Prioritise GREs first on NameSpace, and then on Parent.
- -- See T11970.
- original_gres =
- highestPriority gre_prio
- $ lookupGRE_OccName AllNameSpaces gre_env (rdrNameOcc rdr_name)
- -- Look in all NameSpaces:
- --
- -- - we want to include fields defined with no field selectors,
- -- as we can export those as children. See test NFSExport.
- -- - for a variable, we might also need to look in the type/class namespace
- -- see e.g. test T10816.
-
- -- 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`.
@@ -786,46 +766,6 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name ns_prio
NoParent -> UniqueOccurrence p
{-# INLINEABLE lookupSubBndrOcc_helper #-}
--- | Collect the 'GlobalRdrElt's with the highest priority 'NameSpace' 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'.
-highestPriority :: Ord prio
- => (GlobalRdrElt -> Maybe prio)
- -- ^ priority function
- -- lower value <=> higher priority
- -> [GlobalRdrElt] -> [GlobalRdrElt]
-highestPriority priority gres =
- take_highest_prio $ NE.group $ sort
- [ Semi.Arg prio gre
- | gre <- gres
- , prio <- maybeToList $ priority gre ]
- where
- take_highest_prio :: [NE.NonEmpty (Semi.Arg prio GlobalRdrElt)] -> [GlobalRdrElt]
- take_highest_prio [] = []
- take_highest_prio (fs:_) = map (\ (Semi.Arg _ gre) -> gre) $ NE.toList fs
-{-# INLINEABLE highestPriority #-}
-
--- | Pick out the possible 'NameSpace's in order of priority.
--- This is a consequence of how the parser parses all
--- data constructors as type constructors.
-childrenNameSpaces :: NameSpace -> (NameSpace -> Maybe Int)
-childrenNameSpaces ns other_ns
- | other_ns == ns
- = Just 0
- | isTermVarOrFieldNameSpace ns
- , isTermVarOrFieldNameSpace other_ns
- = Just 0
- | ns == varName
- , other_ns == tcName
- = Just 1
- | ns == tcName
- , other_ns == dataName
- = Just (-1) -- try data namespace before type/class namespace
- | otherwise
- = Nothing
-
-- This domain specific datatype is used to record why we decided it was
-- possible that a GRE could be exported with a parent.
data DisambigInfo
@@ -897,7 +837,7 @@ lookupSubBndrOcc :: DeprecationWarnings
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 relevant_ns
+ 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)
@@ -905,22 +845,8 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name =
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
where
- -- We already mostly know the exact NameSpace we want. The only exception
- -- is that sometimes we are looking up a symbolic variable name and might
- -- want the symbolic type constructor, e.g. for an infix declaration
- -- "infix +!" we want to take into account both class methods and associated
- -- types. See test T10816.
- relevant_ns :: NameSpace -> Maybe Int
- relevant_ns other_ns
- | ns == other_ns
- = Just 0
- | isVarNameSpace ns
- , isTcClsNameSpace other_ns
- = Just 1
- | otherwise
- = Nothing
- ns = rdrNameSpace rdr_name
-
+ what_lkup = LookupChild { wantedParent = the_parent
+ , lookupDataConFirst = False }
{-
Note [Family instance binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1195,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 False) 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 }
@@ -1307,14 +1233,14 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name
lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe =
lookupOccRnX_maybe
- (lookupGlobalOccRn_maybe $ IncludeFields WantNormal False)
+ (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)
@@ -1364,7 +1290,7 @@ lookupGlobalOccRn :: RdrName -> RnM Name
-- environment.
--
-- Used by exports_from_avail
-lookupGlobalOccRn = lookupGlobalOccRn' (IncludeFields WantNormal False)
+lookupGlobalOccRn = lookupGlobalOccRn' (RelevantGREsFOS WantNormal)
lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' which_gres rdr_name =
@@ -1374,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.
@@ -1392,9 +1318,10 @@ 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
- AllNameSpaces -> WantBoth
- _ -> 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.
@@ -1420,7 +1347,7 @@ lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn rdr_name =
lookupExactOrOrig rdr_name (\ gre -> [greName gre]) $
do { rdr_env <- getGlobalRdrEnv
- ; let nms = map greName $ lookupGRE_RdrName (IncludeFields WantBoth False) rdr_env rdr_name
+ ; 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) }
@@ -1437,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 False) env rdr
+ lookupGRE env (LookupRdrName rdr (RelevantGREsFOS WantBoth))
-- Handle implicit qualified imports in GHCi. See T10439.
; ghci_gres <- lookupQualifiedNameGHCi WantBoth rdr
@@ -1474,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 False) 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
@@ -1733,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) }
@@ -1747,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 False) rdr_name ExportDeprecationWarnings
+ mb_gre <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name ExportDeprecationWarnings
case mb_gre of
GreNotFound ->
do
@@ -1992,10 +1919,7 @@ lookupOneQualifiedNameGHCi fos rdr_name = do
-- | Look up *all* the names to which the 'RdrName' may refer in GHCi (using
-- @-fimplicit-import-qualified@). This will normally be zero or one, but may
-- be more in the presence of @DuplicateRecordFields@.
-lookupQualifiedNameGHCi :: HasDebugCallStack
- => FieldsOrSelectors
- -> RdrName -- ^ the 'RdrName' to look up
- -> RnM [GlobalRdrElt]
+lookupQualifiedNameGHCi :: HasDebugCallStack => FieldsOrSelectors -> RdrName -> RnM [GlobalRdrElt]
lookupQualifiedNameGHCi fos rdr_name
= -- We want to behave as we would for a source file import here,
-- and respect hiddenness of modules/packages, hence loadSrcInterface.
@@ -2165,14 +2089,8 @@ lookupSigCtxtOccRn :: HsSigCtxt
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn ctxt what
= wrapLocMA $ \ rdr_name ->
- do { let ns = rdrNameSpace rdr_name
- -- For a term variable, also look in record field NameSpaces.
- relevant_ns
- | isTermVarOrFieldNameSpace ns
- = isTermVarOrFieldNameSpace
- | otherwise
- = (== ns)
- ; mb_names <- lookupBindGroupOcc ctxt what rdr_name relevant_ns
+ 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) $
@@ -2185,25 +2103,27 @@ lookupSigCtxtOccRn ctxt what
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
- -> RdrName
- -> (NameSpace -> Bool)
+ -> 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 passed in. If not, return an appropriate error message
+-- ^ 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 ok_ns
+-- See Note [Looking up signature names].
+lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns
| Just n <- isExact_maybe rdr_name
- = do { mb_nm <- fmap greName <$> lookupExactOcc_either n
- ; return $ case mb_nm of
- Left err -> NE.singleton $ Left err
- Right n' -> finish (NoExactName n') n' }
+ = 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 { finish NotInScope <$> lookupOrig rdr_mod rdr_occ }
+ = do { NE.singleton . Right <$> lookupOrig rdr_mod rdr_occ }
| otherwise
= case ctxt of
@@ -2217,9 +2137,18 @@ lookupBindGroupOcc ctxt what rdr_name ok_ns
else lookup_top (`elemNameSet` ns)
where
- finish err n
- | ok_ns (nameNameSpace n)
- = NE.singleton (Right n)
+ 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)
@@ -2230,14 +2159,13 @@ lookupBindGroupOcc ctxt what rdr_name ok_ns
lookup_top keep_me
= do { env <- getGlobalRdrEnv
- ; let all_gres = filter (ok_ns . greNameSpace)
- $ lookupGRE_OccName AllNameSpaces 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 relevant
-- namespaces. See #17593.
- filter (ok_ns . nameNameSpace)
- $ 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
@@ -2269,8 +2197,8 @@ lookupBindGroupOcc ctxt what rdr_name ok_ns
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
---------------
@@ -2281,8 +2209,9 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
-- See Note [Fixity signature lookup]
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 (rdrRelevantNameSpace 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
@@ -2301,7 +2230,7 @@ lookupLocalTcNames ctxt what rdr
dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
-- namespace. This is useful when we aren't sure which we are looking at.
--- See also Note [rdrRelevantNameSpace and Exact Names]
+-- See also Note [dataTcOccs and Exact Names]
dataTcOccs rdr_name
| isDataOcc occ || isVarOcc occ
= [rdr_name, rdr_name_tc]
@@ -2311,31 +2240,8 @@ dataTcOccs rdr_name
occ = rdrNameOcc rdr_name
rdr_name_tc = setRdrNameSpace rdr_name tcName
--- | Which 'NameSpace's should we consult when looking up this 'RdrName'?
---
--- For data constructor and term variable 'NameSpace's, also look in the TyCon
--- 'NameSpace', as explained in Note [rdrRelevantNameSpace and Exact Names].
---
--- For term variables, also look in the record field 'NameSpace's.
-rdrRelevantNameSpace :: RdrName -> NameSpace -> Bool
--- Return both the given name and the same name promoted to the TcClsName
--- namespace. This is useful when we aren't sure which we are looking at.
--- See also Note [rdrRelevantNameSpace and Exact Names]
-rdrRelevantNameSpace rdr_name
- | isDataOcc occ
- = isDataConNameSpace <||> isTcClsNameSpace
- | isVarOcc occ
- = isTermVarOrFieldNameSpace <||> isTcClsNameSpace
- | isFieldOcc occ
- = isVarNameSpace <||> (== ns)
- | otherwise
- = (== ns)
- where
- occ = rdrNameOcc rdr_name
- ns = occNameSpace occ
-
-{- Note [rdrRelevantNameSpace 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
@@ -2346,6 +2252,9 @@ There is also an awkward situation for built-in syntax. Example in GHCi
:info []
This parses as the Exact RdrName for nilDataCon, but we also want
the list type constructor.
+
+Note that setRdrNameSpace on an Exact name requires the Name to be External,
+which it always is for built in syntax.
-}
{-
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 103fae04d03cff859e68377d896c2aa8c09ea2b2..39d9f21f14c72aec291a22a927c48688137859b6 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/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)
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 2baddb0646d1dcf1d207b324af7ecd677761abd4..bfb1862743ba8b9b96d36004f3ceed5fa4334906 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/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 (IncludeFields WantBoth True) 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
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 0f8c83930923932b01a38ff18031ec8dfde8b73d..8c1b580ad150d2c7d86c202d9e3d621a215712c3 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -212,7 +212,7 @@ fieldSelectorSuggestions global_env tried_rdr_name
| otherwise = [RemindFieldSelectorSuppressed tried_rdr_name parents]
where
gres = filter isNoFieldSelectorGRE
- $ lookupGRE_RdrName (IncludeFields WantField False) global_env tried_rdr_name
+ $ lookupGRE global_env (LookupRdrName tried_rdr_name AllRelevantGREs)
parents = [ parent | ParentIs parent <- map greParent gres ]
similarNameSuggestions :: LookingFor -> DynFlags
@@ -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 (IncludeFields WantNormal True) (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
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index f9856522e8405a5b2288bc89b49a50f69c393b7e..9cf7af183af9211ea2fc703e4bda436bbe739c08 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/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 (IncludeFields WantBoth True) 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
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index a2ab8a69ac69e086cccd051c2e9227ea5fd7629b..ed9226089416f119395d9872ea33fe16becebeaf 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/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 False) env rdr_name of
+ case lookupGRE env (LookupRdrName rdr_name (RelevantGREsFOS WantNormal)) of
[gre] -> return (Just (greName gre, iface))
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 5537523e234c8e1996a9ce36db1a898fff8c7adb..420c93edfe691b13cb4af684c0484331d3f2522a 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/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 False) glb_env occ_name) &&
+ null (lookupGRE glb_env (LookupOccName occ_name (RelevantGREsFOS WantNormal))) &&
isNothing (lookupLocalRdrOcc lcl_env occ_name)
record_field = case orig of
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index ff7fef606a6ffaa58bf422dfd80d65dd3b9894ac..3912b95c7f8a746166619a17dd8f531dfa5df8ec 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -689,9 +689,13 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
doOne n = do
let bareName = (ieWrappedName . unLoc) n
+ what_lkup :: LookupChild
+ what_lkup = LookupChild { wantedParent = spec_parent
+ , lookupDataConFirst = True }
+
-- Do not report export list declaration deprecations
name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings
- spec_parent bareName (childrenNameSpaces $ rdrNameSpace bareName)
+ spec_parent bareName what_lkup
traceRn "lookupChildrenExport" (ppr name)
-- Default to data constructors for slightly better error
-- messages
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index b8ae990474510453fbdc7d6e94dc810adca657be..5293a86371994b514da370709701ea2afe37d9cb 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/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 False) 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 ;
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index bd17ee0699c7fe5fdf17d8e2539d3414c05207f4..0e93253fabe66d26c7ff3e0313286bed797775d9 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/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 (IncludeFields WantNormal True) 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 (IncludeFields WantBoth True) 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 (IncludeFields WantBoth True) 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
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 812aa2ea89cb63f352290c37634c6f0e25eaae85..119cd695c2e265929b3759b676dc7046da8b96aa 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/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
diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs
index 6ab771a9e02ad64afe7c599d00a4d776d249fbc3..3e6ca84acb71ae8124434afc1e60edaf8a84ac24 100644
--- a/compiler/GHC/Types/Name/Ppr.hs
+++ b/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
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index e2ef8f18a214c6d043d1798a9bc2fc10796f1caa..6f2db7435617082984a488b19cde8a2805c20e9a 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/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,
@@ -127,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
@@ -584,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.
-}
@@ -1061,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
@@ -1082,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
@@ -1091,72 +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
- -- | Look for variables in record field namespaces, and look for
- -- record fields in variable namespaces, depending on the arguments.
- IncludeFields :: FieldsOrSelectors
- -- ^ How should we handle variables?
- --
- -- - Should we include record fields defined with @-XNoFieldSelectors@?
- -- - Should we include non-fields?
- --
- -- See Note [NoFieldSelectors].
- -> Bool
- -- ^ For fields, should we also look up variables?
- -> WhichGREs GREInfo
- -- | Look up in all 'NameSpace's.
- AllNameSpaces :: WhichGREs 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
- | AllNameSpaces <- what
- = concat $ lookupOccEnv_AllNameSpaces 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 { IncludeFields _ True -> vars; _ -> [] }
+ 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'.
+ --
+ -- 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 '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)
- _ -> 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
+
+ parent_prio :: Parent -> Int
+ parent_prio (ParentIs other_parent)
+ | other_parent == wanted_parent = 0
+ | otherwise = 1
+ parent_prio NoParent = 0
- normal = fromMaybe [] $ lookupOccEnv env occ
- vars = fromMaybe [] $ lookupOccEnv env (recFieldToVarOcc occ)
+-- | 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
--- | 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)
+-- | 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.
+-- | 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.
@@ -1542,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@.
--- - @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
diff --git a/testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr b/testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr
index b284812ce29302ae59f643eb7cf6b47c6b55aa09..f0b47db0f5ae3912dae2bd478f9cf1d9c2fa3f8a 100644
--- a/testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr
+++ b/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).
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr b/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
index ebc974a123b6964f53789a7bae394c9447ff0c1a..39d1d6d71a4a494309a1715582ed34f28fd064a3 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
+++ b/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).
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr b/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr
index a54338cbf0eb6a897b5baacfa5d052c9c4847f7e..6831c7c36573cc5c936ed4304e8b93709edc7dc8 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr
+++ b/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’.