{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
module GHC.Rename.Env (
newTopSrcBinder,
lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn,
lookupLocatedTopConstructorRn, lookupLocatedTopConstructorRnN,
lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
lookupLocatedOccRnNone,
lookupOccRn, lookupOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
AmbiguousResult(..),
lookupExprOccRn,
lookupRecFieldOcc,
lookupRecFieldOcc_update,
ChildLookupResult(..),
lookupSubBndrOcc_helper,
combineChildLookupResult,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
lookupSigCtxtOccRn, lookupSigCtxtOccRnN,
lookupInstDeclBndr, lookupFamInstName,
lookupConstructorFields,
lookupGreAvailRn,
lookupSyntax, lookupSyntaxExpr, lookupSyntaxNames,
lookupSyntaxName,
lookupIfThenElse,
lookupQualifiedDoExpr, lookupQualifiedDo,
lookupQualifiedDoName, lookupNameWithQualifier,
addUsedGRE, addUsedGREs, addUsedDataCons,
dataTcOccs,
) where
import GHC.Prelude
import GHC.Iface.Load ( loadInterfaceForName, loadSrcInterface_maybe )
import GHC.Iface.Env
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Builtin.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Types.Hint
import GHC.Types.Error
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Warnings ( WarningTxt, pprWarningTxtForMsg )
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Builtin.Names( rOOT_MAIN )
import GHC.Types.Basic ( TopLevelFlag(..), TupleSort(..) )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Types.Unique.Set ( uniqSetAny )
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Data.Maybe
import GHC.Driver.Session
import GHC.Data.FastString
import Control.Monad
import GHC.Data.List.SetOps ( minusList )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Rename.Unbound
import GHC.Rename.Utils
import qualified Data.Semigroup as Semi
import Data.Either ( partitionEithers )
import Data.List ( find )
import qualified Data.List.NonEmpty as NE
import Control.Arrow ( first )
import GHC.Types.FieldLabel
import GHC.Data.Bag
import GHC.Types.PkgQual
newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder (L SrcSpanAnnN
loc RdrName
rdr_name)
| Just Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
=
if Name -> Bool
isExternalName Name
name then
do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
this_mod forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
nameModule Name
name)
(SrcSpan -> TcRnMessage -> TcRn ()
addErrAt (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badOrigBinding RdrName
rdr_name))
; forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
else
do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; forall m n. Module -> Name -> TcRnIf m n Name
externaliseName Module
this_mod Name
name }
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
rdr_mod forall a. Eq a => a -> a -> Bool
== Module
this_mod Bool -> Bool -> Bool
|| Module
rdr_mod forall a. Eq a => a -> a -> Bool
== Module
rOOT_MAIN)
(SrcSpan -> TcRnMessage -> TcRn ()
addErrAt (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badOrigBinding RdrName
rdr_name))
; forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
rdr_mod OccName
rdr_occ (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }
| Bool
otherwise
= do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr_name)
(SrcSpan -> TcRnMessage -> TcRn ()
addErrAt (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name))
; ThStage
stage <- TcM ThStage
getStage
; if ThStage -> Bool
isBrackStage ThStage
stage then
do { Unique
uniq <- forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
; forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc)) }
else
do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; String -> SDoc -> TcRn ()
traceRn String
"newTopSrcBinder" (forall a. Outputable a => a -> SDoc
ppr Module
this_mod SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc))
; forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
this_mod (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }
}
lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
which_suggest RdrName
rdr_name =
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
do {
let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ)
(do { Bool
op_ok <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
op_ok (TcRnMessage -> TcRn ()
addErr (RdrName -> TcRnMessage
opDeclErr RdrName
rdr_name)) })
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
env) of
[GlobalRdrElt
gre] -> forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre)
[GlobalRdrElt]
_ -> do
String -> SDoc -> TcRn ()
traceRn String
"lookupTopBndrRN fail" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
which_suggest WhereLooking
WL_LocalTop) RdrName
rdr_name
}
lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopConstructorRn = forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Constructor)
lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopConstructorRnN = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Constructor)
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Anything)
lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Anything)
lookupExactOcc_either :: Name -> RnM (Either NotInScopeError Name)
lookupExactOcc_either :: Name -> RnM (Either NotInScopeError Name)
lookupExactOcc_either Name
name
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
, Just TyCon
tycon <- case TyThing
thing of
ATyCon TyCon
tc -> forall a. a -> Maybe a
Just TyCon
tc
AConLike (RealDataCon DataCon
dc) -> forall a. a -> Maybe a
Just (DataCon -> TyCon
dataConTyCon DataCon
dc)
TyThing
_ -> forall a. Maybe a
Nothing
, Just TupleSort
tupleSort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tycon
= do { let tupArity :: Arity
tupArity = case TupleSort
tupleSort of
TupleSort
UnboxedTuple -> TyCon -> Arity
tyConArity TyCon
tycon forall a. Integral a => a -> a -> a
`div` Arity
2
TupleSort
_ -> TyCon -> Arity
tyConArity TyCon
tycon
; Arity -> TcRn ()
checkTupSize Arity
tupArity
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
name) }
| Name -> Bool
isExternalName Name
name
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
name)
| Bool
otherwise
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let
main_occ :: OccName
main_occ = Name -> OccName
nameOccName Name
name
demoted_occs :: [OccName]
demoted_occs = case OccName -> Maybe OccName
demoteOccName OccName
main_occ of
Just OccName
occ -> [OccName
occ]
Maybe OccName
Nothing -> []
gres :: [GlobalRdrElt]
gres = [ GlobalRdrElt
gre | OccName
occ <- OccName
main_occ forall a. a -> [a] -> [a]
: [OccName]
demoted_occs
, GlobalRdrElt
gre <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ
, GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre forall a. Eq a => a -> a -> Bool
== Name
name ]
; case [GlobalRdrElt]
gres of
[GlobalRdrElt
gre] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre))
[] ->
do { LocalRdrEnv
lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; if Name
name Name -> LocalRdrEnv -> Bool
`inLocalRdrEnvScope` LocalRdrEnv
lcl_env
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
name)
else
do { TcRef NameSet
th_topnames_var <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TcGblEnv -> TcRef NameSet
tcg_th_topnames forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; NameSet
th_topnames <- forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef TcRef NameSet
th_topnames_var
; if Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
th_topnames
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
name)
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Name -> NotInScopeError
NoExactName Name
name))
}
}
[GlobalRdrElt]
gres -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left ([GlobalRdrElt] -> NotInScopeError
SameName [GlobalRdrElt]
gres))
}
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls SDoc
what RdrName
rdr
= do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr)
(TcRnMessage -> TcRn ()
addErr (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr))
; Either NotInScopeError Name
mb_name <- Bool
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc
Bool
False
Name
cls SDoc
doc RdrName
rdr
; case Either NotInScopeError Name
mb_name of
Left NotInScopeError
err -> do { TcRnMessage -> TcRn ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr NotInScopeError
err)
; forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr) }
Right Name
nm -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm }
where
doc :: SDoc
doc = SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
cls)
lookupFamInstName :: Maybe Name -> LocatedN RdrName
-> RnM (LocatedN Name)
lookupFamInstName :: Maybe Name -> LocatedN RdrName -> RnM (LocatedN Name)
lookupFamInstName (Just Name
cls) LocatedN RdrName
tc_rdr
= forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls (String -> SDoc
text String
"associated type")) LocatedN RdrName
tc_rdr
lookupFamInstName Maybe Name
Nothing LocatedN RdrName
tc_rdr
= forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnConstr LocatedN RdrName
tc_rdr
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields Name
con_name
= do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
con_name then
do { RecFieldEnv
field_env <- TcRn RecFieldEnv
getRecFieldEnv
; String -> SDoc -> TcRn ()
traceTc String
"lookupCF" (forall a. Outputable a => a -> SDoc
ppr Name
con_name SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name) SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr RecFieldEnv
field_env)
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name forall a. Maybe a -> a -> a
`orElse` []) }
else
do { ConLike
con <- Name -> TcM ConLike
tcLookupConLike Name
con_name
; String -> SDoc -> TcRn ()
traceTc String
"lookupCF 2" (forall a. Outputable a => a -> SDoc
ppr ConLike
con)
; forall (m :: * -> *) a. Monad m => a -> m a
return (ConLike -> [FieldLabel]
conLikeFieldLabels ConLike
con) } }
lookupExactOrOrig :: RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig :: forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig Name
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> r
res Name
n)
ExactOrOrigError NotInScopeError
e ->
do { TcRnMessage -> TcRn ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
e)
; forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> r
res (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)) }
ExactOrOrigResult
NotExactOrOrig -> RnM r
k }
lookupExactOrOrig_maybe :: RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe :: forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe Name -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig Name
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> r
res (forall a. a -> Maybe a
Just Name
n))
ExactOrOrigError NotInScopeError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> r
res forall a. Maybe a
Nothing)
ExactOrOrigResult
NotExactOrOrig -> RnM r
k }
data ExactOrOrigResult = FoundExactOrOrig Name
| ExactOrOrigError NotInScopeError
| NotExactOrOrig
lookupExactOrOrig_base :: RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base :: RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= Either NotInScopeError Name -> ExactOrOrigResult
cvtEither forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM (Either NotInScopeError Name)
lookupExactOcc_either Name
n
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= Name -> ExactOrOrigResult
FoundExactOrOrig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ExactOrOrigResult
NotExactOrOrig
where
cvtEither :: Either NotInScopeError Name -> ExactOrOrigResult
cvtEither (Left NotInScopeError
e) = NotInScopeError -> ExactOrOrigResult
ExactOrOrigError NotInScopeError
e
cvtEither (Right Name
n) = Name -> ExactOrOrigResult
FoundExactOrOrig Name
n
lookupRecFieldOcc :: Maybe Name
-> RdrName
-> RnM Name
lookupRecFieldOcc :: Maybe Name -> RdrName -> RnM Name
lookupRecFieldOcc Maybe Name
mb_con RdrName
rdr_name
| Just Name
con <- Maybe Name
mb_con
, Name -> Bool
isUnboundName Name
con
= forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
| Just Name
con <- Maybe Name
mb_con
= forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
do { [FieldLabel]
flds <- Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let lbl :: FastString
lbl = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
mb_field :: Maybe (FieldLabel, GlobalRdrElt)
mb_field = do FieldLabel
fl <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== FastString
lbl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FastString
flLabel) [FieldLabel]
flds
GlobalRdrElt
gre <- GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
if RdrName -> Bool
isQual RdrName
rdr_name
then do GlobalRdrElt
gre' <- forall a. [a] -> Maybe a
listToMaybe (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt
gre])
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel
fl, GlobalRdrElt
gre')
else forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel
fl, GlobalRdrElt
gre)
; case Maybe (FieldLabel, GlobalRdrElt)
mb_field of
Just (FieldLabel
fl, GlobalRdrElt
gre) -> do { Bool -> GlobalRdrElt -> TcRn ()
addUsedGRE Bool
True GlobalRdrElt
gre
; forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> Name
flSelector FieldLabel
fl) }
Maybe (FieldLabel, GlobalRdrElt)
Nothing -> do { TcRnMessage -> TcRn ()
addErr (Name -> FastString -> TcRnMessage
badFieldConErr Name
con FastString
lbl)
; forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) } }
| Bool
otherwise
= FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantBoth RdrName
rdr_name
lookupRecFieldOcc_update
:: DuplicateRecordFields
-> RdrName
-> RnM AmbiguousResult
lookupRecFieldOcc_update :: DuplicateRecordFields -> RdrName -> RnM AmbiguousResult
lookupRecFieldOcc_update DuplicateRecordFields
dup_fields_ok RdrName
rdr_name = do
Bool
disambig_ok <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DisambiguateRecordFields
let want :: FieldsOrSelectors
want | Bool
disambig_ok = FieldsOrSelectors
WantField
| Bool
otherwise = FieldsOrSelectors
WantBoth
Maybe AmbiguousResult
mr <- DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
want RdrName
rdr_name
case Maybe AmbiguousResult
mr of
Just AmbiguousResult
r -> forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousResult
r
Maybe AmbiguousResult
Nothing
| Bool
disambig_ok -> do Maybe AmbiguousResult
mr' <- DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
WantBoth RdrName
rdr_name
case Maybe AmbiguousResult
mr' of
Just AmbiguousResult
r -> forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousResult
r
Maybe AmbiguousResult
Nothing -> RnM AmbiguousResult
unbound
| Bool
otherwise -> RnM AmbiguousResult
unbound
where
unbound :: RnM AmbiguousResult
unbound = GreName -> AmbiguousResult
UnambiguousGre forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_RecField WhereLooking
WL_Global) RdrName
rdr_name
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName
-> RnM ChildLookupResult
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
must_have_parent Bool
warn_if_deprec Name
parent RdrName
rdr_name
| Name -> Bool
isUnboundName Name
parent
= forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> GreName -> ChildLookupResult
FoundChild Parent
NoParent (Name -> GreName
NormalGreName (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)))
| Bool
otherwise = do
GlobalRdrEnv
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
let original_gres :: [GlobalRdrElt]
original_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
gre_env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
String -> SDoc -> TcRn ()
traceRn String
"parent" (forall a. Outputable a => a -> SDoc
ppr Name
parent)
String -> SDoc -> TcRn ()
traceRn String
"lookupExportChild original_gres:" (forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
String -> SDoc -> TcRn ()
traceRn String
"lookupExportChild picked_gres:" (forall a. Outputable a => a -> SDoc
ppr ([GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres) SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr Bool
must_have_parent)
case [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres of
DisambigInfo
NoOccurrence ->
[GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
UniqueOccurrence GlobalRdrElt
g ->
if Bool
must_have_parent then [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
else GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
DisambiguatedOccurrence GlobalRdrElt
g ->
GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
AmbiguousOccurrence NonEmpty GlobalRdrElt
gres ->
NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr NonEmpty GlobalRdrElt
gres
where
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g :: GlobalRdrElt
g@GRE{GreName
gre_name :: GlobalRdrElt -> GreName
gre_name :: GreName
gre_name,Parent
gre_par :: GlobalRdrElt -> Parent
gre_par :: Parent
gre_par} = do
Bool -> GlobalRdrElt -> TcRn ()
addUsedGRE Bool
warn_if_deprec GlobalRdrElt
g
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Parent -> GreName -> ChildLookupResult
FoundChild Parent
gre_par GreName
gre_name
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres = do
String -> SDoc -> TcRn ()
traceRn String
"npe" (forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
Bool
dup_fields_ok <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
case [GlobalRdrElt]
original_gres of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
[GlobalRdrElt
g] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> GreName -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> GreName
gre_name GlobalRdrElt
g)
[Name
p | Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
g]]
gss :: [GlobalRdrElt]
gss@(GlobalRdrElt
g:gss' :: [GlobalRdrElt]
gss'@(GlobalRdrElt
_:[GlobalRdrElt]
_)) ->
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE [GlobalRdrElt]
gss Bool -> Bool -> Bool
&& Bool
dup_fields_ok
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Name -> GreName -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> GreName
gre_name GlobalRdrElt
g)
[Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
x]]
else NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gss'
mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr :: NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr NonEmpty GlobalRdrElt
gres = do
RdrName -> NonEmpty GlobalRdrElt -> TcRn ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> GreName -> ChildLookupResult
FoundChild (GlobalRdrElt -> Parent
gre_par (forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)) (GlobalRdrElt -> GreName
gre_name (forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)))
getParent :: GlobalRdrElt -> Maybe Name
getParent :: GlobalRdrElt -> Maybe Name
getParent (GRE { gre_par :: GlobalRdrElt -> Parent
gre_par = Parent
p } ) =
case Parent
p of
ParentIs Name
cur_parent -> forall a. a -> Maybe a
Just Name
cur_parent
Parent
NoParent -> forall a. Maybe a
Nothing
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
gres
| RdrName -> Bool
isUnqual RdrName
rdr_name
= forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent [GlobalRdrElt]
gres)
| Bool
otherwise
= forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres))
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent GlobalRdrElt
p
= case GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
p of
Just Name
cur_parent
| Name
parent forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
p
| Bool
otherwise -> DisambigInfo
NoOccurrence
Maybe Name
Nothing -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
p
data DisambigInfo
= NoOccurrence
| UniqueOccurrence GlobalRdrElt
| DisambiguatedOccurrence GlobalRdrElt
| AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt)
instance Outputable DisambigInfo where
ppr :: DisambigInfo -> SDoc
ppr DisambigInfo
NoOccurrence = String -> SDoc
text String
"NoOccurence"
ppr (UniqueOccurrence GlobalRdrElt
gre) = String -> SDoc
text String
"UniqueOccurrence:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (DisambiguatedOccurrence GlobalRdrElt
gre) = String -> SDoc
text String
"DiambiguatedOccurrence:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (AmbiguousOccurrence NonEmpty GlobalRdrElt
gres) = String -> SDoc
text String
"Ambiguous:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NonEmpty GlobalRdrElt
gres
instance Semi.Semigroup DisambigInfo where
DisambigInfo
_ <> :: DisambigInfo -> DisambigInfo -> DisambigInfo
<> DisambiguatedOccurrence GlobalRdrElt
g' = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'
DisambiguatedOccurrence GlobalRdrElt
g' <> DisambigInfo
_ = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'
DisambigInfo
NoOccurrence <> DisambigInfo
m = DisambigInfo
m
DisambigInfo
m <> DisambigInfo
NoOccurrence = DisambigInfo
m
UniqueOccurrence GlobalRdrElt
g <> UniqueOccurrence GlobalRdrElt
g'
= NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt
g']
UniqueOccurrence GlobalRdrElt
g <> AmbiguousOccurrence NonEmpty GlobalRdrElt
gs
= NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` NonEmpty GlobalRdrElt
gs)
AmbiguousOccurrence NonEmpty GlobalRdrElt
gs <> UniqueOccurrence GlobalRdrElt
g'
= NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g' forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` NonEmpty GlobalRdrElt
gs)
AmbiguousOccurrence NonEmpty GlobalRdrElt
gs <> AmbiguousOccurrence NonEmpty GlobalRdrElt
gs'
= NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (NonEmpty GlobalRdrElt
gs forall a. Semigroup a => a -> a -> a
Semi.<> NonEmpty GlobalRdrElt
gs')
instance Monoid DisambigInfo where
mempty :: DisambigInfo
mempty = DisambigInfo
NoOccurrence
mappend :: DisambigInfo -> DisambigInfo -> DisambigInfo
mappend = forall a. Semigroup a => a -> a -> a
(Semi.<>)
data ChildLookupResult
= NameNotFound
| IncorrectParent Name
GreName
[Name]
| FoundChild Parent GreName
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [] = forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
combineChildLookupResult (RnM ChildLookupResult
x:[RnM ChildLookupResult]
xs) = do
ChildLookupResult
res <- RnM ChildLookupResult
x
case ChildLookupResult
res of
ChildLookupResult
NameNotFound -> [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [RnM ChildLookupResult]
xs
ChildLookupResult
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
res
instance Outputable ChildLookupResult where
ppr :: ChildLookupResult -> SDoc
ppr ChildLookupResult
NameNotFound = String -> SDoc
text String
"NameNotFound"
ppr (FoundChild Parent
p GreName
n) = String -> SDoc
text String
"Found:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Parent
p SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr GreName
n
ppr (IncorrectParent Name
p GreName
n [Name]
ns) = String -> SDoc
text String
"IncorrectParent"
SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [forall a. Outputable a => a -> SDoc
ppr Name
p, forall a. Outputable a => a -> SDoc
ppr GreName
n, forall a. Outputable a => a -> SDoc
ppr [Name]
ns]
lookupSubBndrOcc :: Bool
-> Name
-> SDoc
-> RdrName
-> RnM (Either NotInScopeError Name)
lookupSubBndrOcc :: Bool
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc Bool
warn_if_deprec Name
the_parent SDoc
doc RdrName
rdr_name = do
ChildLookupResult
res <-
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Parent -> GreName -> ChildLookupResult
FoundChild Parent
NoParent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName) forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
True Bool
warn_if_deprec Name
the_parent RdrName
rdr_name
case ChildLookupResult
res of
ChildLookupResult
NameNotFound -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc))
FoundChild Parent
_p GreName
child -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (GreName -> Name
greNameMangledName GreName
child))
IncorrectParent {}
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc)
lookupLocatedOccRn :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRn
lookupLocatedOccRnConstr :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnConstr :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnConstr = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnConstr
lookupLocatedOccRnRecField :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnRecField :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnRecField = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnRecField
lookupLocatedOccRnNone :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnNone :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnNone = forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnNone
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
= do { LocalRdrEnv
local_env <- RnM LocalRdrEnv
getLocalRdrEnv
; forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
local_env RdrName
rdr_name) }
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, Arity))
lookupLocalOccThLvl_maybe Name
name
= do { TcLclEnv
lcl_env <- forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (TcLclEnv -> ThBindEnv
tcl_th_bndrs TcLclEnv
lcl_env) Name
name) }
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
which_suggest RdrName
rdr_name
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> WhatLooking -> RdrName -> RnM Name
reportUnboundName' WhatLooking
which_suggest RdrName
rdr_name }
lookupOccRn :: RdrName -> RnM Name
lookupOccRn :: RdrName -> RnM Name
lookupOccRn = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_Anything
lookupOccRnConstr :: RdrName -> RnM Name
lookupOccRnConstr :: RdrName -> RnM Name
lookupOccRnConstr = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_Constructor
lookupOccRnRecField :: RdrName -> RnM Name
lookupOccRnRecField :: RdrName -> RnM Name
lookupOccRnRecField = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_RecField
lookupOccRnNone :: RdrName -> RnM Name
lookupOccRnNone :: RdrName -> RnM Name
lookupOccRnNone = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_None
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn RdrName
rdr_name
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_LocalOnly) RdrName
rdr_name }
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn RdrName
rdr_name
| OccName -> Bool
isVarOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
= RdrName -> RnM Name
badVarInType RdrName
rdr_name
| Bool
otherwise
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing ->
if forall name. HasOccName name => name -> OccName
occName RdrName
rdr_name forall a. Eq a => a -> a -> Bool
== forall name. HasOccName name => name -> OccName
occName RdrName
eqTyCon_RDR
then Name
eqTyConName forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TcRnMessage -> TcRn ()
addDiagnostic TcRnMessage
TcRnTypeEqualityOutOfScope
else RdrName -> RnM Name
lookup_demoted RdrName
rdr_name }
lookup_demoted :: RdrName -> RnM Name
lookup_demoted :: RdrName -> RnM Name
lookup_demoted RdrName
rdr_name
| Just RdrName
demoted_rdr <- RdrName -> Maybe RdrName
demoteRdrName RdrName
rdr_name
= do { Bool
data_kinds <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
; Bool
star_is_type <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.StarIsType
; let is_star_type :: StarIsType
is_star_type = if Bool
star_is_type then StarIsType
StarIsType else StarIsType
StarIsNotType
star_is_type_hints :: [GhcHint]
star_is_type_hints = StarIsType -> RdrName -> [GhcHint]
noStarIsTypeHints StarIsType
is_star_type RdrName
rdr_name
; if Bool
data_kinds
then do { Maybe Name
mb_demoted_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
; case Maybe Name
mb_demoted_name of
Maybe Name
Nothing -> LookingFor -> RdrName -> [GhcHint] -> RnM Name
unboundNameX LookingFor
looking_for RdrName
rdr_name [GhcHint]
star_is_type_hints
Just Name
demoted_name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
demoted_name }
else do {
Maybe Name
mb_demoted_name <- forall a. TcRn a -> TcRn a
discardErrs forall a b. (a -> b) -> a -> b
$
RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
; let suggestion :: [GhcHint]
suggestion | forall a. Maybe a -> Bool
isJust Maybe Name
mb_demoted_name
, let additional :: SDoc
additional = String -> SDoc
text String
"to refer to the data constructor of that name?"
= [LanguageExtensionHint -> GhcHint
SuggestExtension forall a b. (a -> b) -> a -> b
$ SDoc -> Extension -> LanguageExtensionHint
SuggestSingleExtension SDoc
additional Extension
LangExt.DataKinds]
| Bool
otherwise
= [GhcHint]
star_is_type_hints
; LookingFor -> RdrName -> [GhcHint] -> RnM Name
unboundNameX LookingFor
looking_for RdrName
rdr_name [GhcHint]
suggestion } }
| Bool
otherwise
= WhatLooking -> RdrName -> RnM Name
reportUnboundName' (LookingFor -> WhatLooking
lf_which LookingFor
looking_for) RdrName
rdr_name
where
looking_for :: LookingFor
looking_for = WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Constructor WhereLooking
WL_Anywhere
lookup_promoted :: RdrName -> RnM (Maybe Name)
lookup_promoted :: RdrName -> RnM (Maybe Name)
lookup_promoted RdrName
rdr_name
| Just RdrName
promoted_rdr <- RdrName -> Maybe RdrName
promoteRdrName RdrName
rdr_name
= RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
promoted_rdr
| Bool
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
badVarInType :: RdrName -> RnM Name
badVarInType :: RdrName -> RnM Name
badVarInType RdrName
rdr_name
= do { TcRnMessage -> TcRn ()
addErr (forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints
(String -> SDoc
text String
"Illegal promoted term variable in a type:"
SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name))
; forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName
-> RnM (Maybe r)
lookupOccRnX_maybe :: forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe r)
globalLookup Name -> r
wrapper RdrName
rdr_name
= forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$
[ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> r
wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
, RdrName -> RnM (Maybe r)
globalLookup RdrName
rdr_name ]
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe = forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe forall a. a -> a
id
lookupExprOccRn :: RdrName -> RnM (Maybe GreName)
lookupExprOccRn :: RdrName -> RnM (Maybe GreName)
lookupExprOccRn RdrName
rdr_name
= do { Maybe GreName
mb_name <- forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe GreName)
global_lookup Name -> GreName
NormalGreName RdrName
rdr_name
; case Maybe GreName
mb_name of
Maybe GreName
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @Maybe Name -> GreName
NormalGreName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> RnM (Maybe Name)
lookup_promoted RdrName
rdr_name
Maybe GreName
p -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GreName
p }
where
global_lookup :: RdrName -> RnM (Maybe GreName)
global_lookup :: RdrName -> RnM (Maybe GreName)
global_lookup RdrName
rdr_name =
do { Maybe AmbiguousResult
mb_name <- DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
NoDuplicateRecordFields FieldsOrSelectors
WantNormal RdrName
rdr_name
; case Maybe AmbiguousResult
mb_name of
Just (UnambiguousGre GreName
name) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just GreName
name)
Just AmbiguousResult
_ -> forall a. String -> a
panic String
"GHC.Rename.Env.global_lookup: The impossible happened!"
Maybe AmbiguousResult
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
}
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe RdrName
rdr_name =
forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name forall a. a -> a
id (FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
WantNormal RdrName
rdr_name)
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn = FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantNormal
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
fos RdrName
rdr_name =
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ do
Maybe Name
mn <- FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
fos RdrName
rdr_name
case Maybe Name
mn of
Just Name
n -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
Maybe Name
Nothing -> do { String -> SDoc -> TcRn ()
traceRn String
"lookupGlobalOccRn" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
which_suggest WhereLooking
WL_Global) RdrName
rdr_name }
where which_suggest :: WhatLooking
which_suggest = case FieldsOrSelectors
fos of
FieldsOrSelectors
WantNormal -> WhatLooking
WL_Anything
FieldsOrSelectors
WantBoth -> WhatLooking
WL_RecField
FieldsOrSelectors
WantField -> WhatLooking
WL_RecField
lookupGlobalOccRn_base :: FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base :: FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
fos RdrName
rdr_name =
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$
[ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
greMangledName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe FieldsOrSelectors
fos RdrName
rdr_name
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GreName -> Name
greNameMangledName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors -> RdrName -> RnM (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name ]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn RdrName
rdr_name =
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$
do { GlobalRdrEnv
rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let ns :: [Name]
ns = forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
rdr_env)
; [Name]
qual_ns <- forall a b. (a -> b) -> [a] -> [b]
map GreName -> Name
greNameMangledName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors -> RdrName -> RnM [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr_name
; forall (m :: * -> *) a. Monad m => a -> m a
return ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
qual_ns forall a. Ord a => [a] -> [a] -> [a]
`minusList` [Name]
ns)) }
lookupGlobalOccRn_overloaded :: DuplicateRecordFields -> FieldsOrSelectors -> RdrName
-> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded :: DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
fos RdrName
rdr_name =
forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GreName -> AmbiguousResult
UnambiguousGre forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName)) forall a b. (a -> b) -> a -> b
$
do { GreLookupResult
res <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
; case GreLookupResult
res of
GreLookupResult
GreNotFound -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GreName -> AmbiguousResult
UnambiguousGre forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors -> RdrName -> RnM (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
OneNameMatch GlobalRdrElt
gre -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (GreName -> AmbiguousResult
UnambiguousGre (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre))
MultipleNames NonEmpty GlobalRdrElt
gres
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE NonEmpty GlobalRdrElt
gres
, DuplicateRecordFields
dup_fields_ok forall a. Eq a => a -> a -> Bool
== DuplicateRecordFields
DuplicateRecordFields -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AmbiguousResult
AmbiguousFields
| Bool
otherwise -> do
RdrName -> NonEmpty GlobalRdrElt -> TcRn ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (GreName -> AmbiguousResult
UnambiguousGre (GlobalRdrElt -> GreName
gre_name (forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)))) }
data AmbiguousResult
= UnambiguousGre GreName
| AmbiguousFields
data FieldsOrSelectors
= WantNormal
| WantBoth
| WantField
deriving FieldsOrSelectors -> FieldsOrSelectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
$c/= :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
== :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
$c== :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
Eq
filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs FieldsOrSelectors
fos = forall a. (a -> Bool) -> [a] -> [a]
filter (FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
fos forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name)
allowGreName :: FieldsOrSelectors -> GreName -> Bool
allowGreName :: FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
WantBoth GreName
_ = Bool
True
allowGreName FieldsOrSelectors
WantNormal (FieldGreName FieldLabel
fl) = FieldLabel -> FieldSelectors
flHasFieldSelector FieldLabel
fl forall a. Eq a => a -> a -> Bool
== FieldSelectors
FieldSelectors
allowGreName FieldsOrSelectors
WantNormal (NormalGreName Name
_) = Bool
True
allowGreName FieldsOrSelectors
WantField (FieldGreName FieldLabel
_) = Bool
True
allowGreName FieldsOrSelectors
WantField (NormalGreName Name
_) = Bool
False
data GreLookupResult = GreNotFound
| OneNameMatch GlobalRdrElt
| MultipleNames (NE.NonEmpty GlobalRdrElt)
lookupGreRn_maybe :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe FieldsOrSelectors
fos RdrName
rdr_name
= do
GreLookupResult
res <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
case GreLookupResult
res of
OneNameMatch GlobalRdrElt
gre -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just GlobalRdrElt
gre
MultipleNames NonEmpty GlobalRdrElt
gres -> do
String -> SDoc -> TcRn ()
traceRn String
"lookupGreRn_maybe:NameClash" (forall a. Outputable a => a -> SDoc
ppr NonEmpty GlobalRdrElt
gres)
RdrName -> NonEmpty GlobalRdrElt -> TcRn ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)
GreLookupResult
GreNotFound -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupGreRn_helper :: FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper :: FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs FieldsOrSelectors
fos (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
env) of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return GreLookupResult
GreNotFound
[GlobalRdrElt
gre] -> do { Bool -> GlobalRdrElt -> TcRn ()
addUsedGRE Bool
True GlobalRdrElt
gre
; forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> GreLookupResult
OneNameMatch GlobalRdrElt
gre) }
(GlobalRdrElt
gre:[GlobalRdrElt]
gres) -> forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty GlobalRdrElt -> GreLookupResult
MultipleNames (GlobalRdrElt
gre forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres)) }
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn RdrName
rdr_name
= do
GreLookupResult
mb_gre <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
WantNormal RdrName
rdr_name
case GreLookupResult
mb_gre of
GreLookupResult
GreNotFound ->
do
String -> SDoc -> TcRn ()
traceRn String
"lookupGreAvailRn" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
Name
name <- LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Global) RdrName
rdr_name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Name -> AvailInfo
avail Name
name)
MultipleNames NonEmpty GlobalRdrElt
gres ->
do
RdrName -> NonEmpty GlobalRdrElt -> TcRn ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
let unbound_name :: Name
unbound_name = RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
unbound_name, Name -> AvailInfo
avail Name
unbound_name)
OneNameMatch GlobalRdrElt
gre ->
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre, GlobalRdrElt -> AvailInfo
availFromGRE GlobalRdrElt
gre)
addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
addUsedDataCons :: GlobalRdrEnv -> TyCon -> TcRn ()
addUsedDataCons GlobalRdrEnv
rdr_env TyCon
tycon
= [GlobalRdrElt] -> TcRn ()
addUsedGREs [ GlobalRdrElt
gre
| DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tycon
, Just GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
dc)] ]
addUsedGRE :: Bool -> GlobalRdrElt -> RnM ()
addUsedGRE :: Bool -> GlobalRdrElt -> TcRn ()
addUsedGRE Bool
warn_if_deprec GlobalRdrElt
gre
= do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn_if_deprec (GlobalRdrElt -> TcRn ()
warnIfDeprecated GlobalRdrElt
gre)
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GlobalRdrElt -> Bool
isLocalGRE GlobalRdrElt
gre) forall a b. (a -> b) -> a -> b
$
do { TcGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> TcRn ()
traceRn String
"addUsedGRE" (forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre)
; forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) (GlobalRdrElt
gre forall a. a -> [a] -> [a]
:) } }
addUsedGREs :: [GlobalRdrElt] -> RnM ()
addUsedGREs :: [GlobalRdrElt] -> TcRn ()
addUsedGREs [GlobalRdrElt]
gres
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
imp_gres = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do { TcGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> TcRn ()
traceRn String
"addUsedGREs" (forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
imp_gres)
; forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) ([GlobalRdrElt]
imp_gres forall a. [a] -> [a] -> [a]
++) }
where
imp_gres :: [GlobalRdrElt]
imp_gres = forall a. (a -> Bool) -> [a] -> [a]
filterOut GlobalRdrElt -> Bool
isLocalGRE [GlobalRdrElt]
gres
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated :: GlobalRdrElt -> TcRn ()
warnIfDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: GlobalRdrElt -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss })
| Just ImportSpec
imp_spec <- forall a. Bag a -> Maybe a
headMaybe Bag ImportSpec
iss
= do { DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnWarningsDeprecations DynFlags
dflags Bool -> Bool -> Bool
&&
Bool -> Bool
not (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name)) forall a b. (a -> b) -> a -> b
$
do { ModIface
iface <- SDoc -> Name -> TcRn ModIface
loadInterfaceForName SDoc
doc Name
name
; case ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeprec ModIface
iface GlobalRdrElt
gre of
Just WarningTxt GhcRn
txt -> do
let msg :: TcRnMessage
msg = forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$
DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnWarningsDeprecations)
[GhcHint]
noHints
(ImportSpec -> WarningTxt GhcRn -> SDoc
mk_msg ImportSpec
imp_spec WarningTxt GhcRn
txt)
TcRnMessage -> TcRn ()
addDiagnostic TcRnMessage
msg
Maybe (WarningTxt GhcRn)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return () } }
| Bool
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre
name_mod :: Module
name_mod = forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (forall a. Outputable a => a -> SDoc
ppr Name
name) (HasDebugCallStack => Name -> Module
nameModule Name
name)
doc :: SDoc
doc = String -> SDoc
text String
"The name" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is mentioned explicitly"
mk_msg :: ImportSpec -> WarningTxt GhcRn -> SDoc
mk_msg ImportSpec
imp_spec WarningTxt GhcRn
txt
= [SDoc] -> SDoc
sep [ [SDoc] -> SDoc
sep [ String -> SDoc
text String
"In the use of"
SDoc -> SDoc -> SDoc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ)
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
occ)
, SDoc -> SDoc
parens SDoc
imp_msg SDoc -> SDoc -> SDoc
<> SDoc
colon ]
, forall p. WarningTxt p -> SDoc
pprWarningTxtForMsg WarningTxt GhcRn
txt ]
where
imp_mod :: ModuleName
imp_mod = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec
imp_msg :: SDoc
imp_msg = String -> SDoc
text String
"imported from" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod SDoc -> SDoc -> SDoc
<> SDoc
extra
extra :: SDoc
extra | ModuleName
imp_mod forall a. Eq a => a -> a -> Bool
== forall unit. GenModule unit -> ModuleName
moduleName Module
name_mod = SDoc
Outputable.empty
| Bool
otherwise = String -> SDoc
text String
", but defined in" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Module
name_mod
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeprec ModIface
iface GlobalRdrElt
gre
= ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_warn_fn (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
ParentIs Name
p -> ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_warn_fn (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (Name -> OccName
nameOccName Name
p)
Parent
NoParent -> forall a. Maybe a
Nothing
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GreName)
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name = do
[GreName]
gnames <- FieldsOrSelectors -> RdrName -> RnM [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
case [GreName]
gnames of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
[GreName
gname] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just GreName
gname)
(GreName
gname:[GreName]
gnames') -> do RdrName -> NonEmpty GlobalRdrElt -> TcRn ()
addNameClashErrRn RdrName
rdr_name (GreName -> GlobalRdrElt
toGRE GreName
gname forall a. a -> [a] -> NonEmpty a
NE.:| forall a b. (a -> b) -> [a] -> [b]
map GreName -> GlobalRdrElt
toGRE [GreName]
gnames')
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Name -> GreName
NormalGreName (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)))
where
toGRE :: GreName -> GlobalRdrElt
toGRE GreName
gname = GRE { gre_name :: GreName
gre_name = GreName
gname, gre_par :: Parent
gre_par = Parent
NoParent, gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: Bag ImportSpec
gre_imp = forall a. a -> Bag a
unitBag ImportSpec
is }
is :: ImportSpec
is = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec { is_mod :: ModuleName
is_mod = ModuleName
mod, is_as :: ModuleName
is_as = ModuleName
mod, is_qual :: Bool
is_qual = Bool
True, is_dloc :: SrcSpan
is_dloc = SrcSpan
noSrcSpan }
, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
(ModuleName
mod, OccName
_) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupOneQualifiedNameGHCi" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)) (RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name)
lookupQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM [GreName]
lookupQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
=
do { DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool
is_ghci <- TcRn Bool
getIsGHCi
; DynFlags -> Bool -> RnM [GreName]
go_for_it DynFlags
dflags Bool
is_ghci }
where
go_for_it :: DynFlags -> Bool -> RnM [GreName]
go_for_it DynFlags
dflags Bool
is_ghci
| Just (ModuleName
mod,OccName
occ) <- RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name
, Bool
is_ghci
, GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ImplicitImportQualified DynFlags
dflags
, Bool -> Bool
not (DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)
= do { MaybeErr SDoc ModIface
res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
NotBoot PkgQual
NoPkgQual
; case MaybeErr SDoc ModIface
res of
Succeeded ModIface
iface
-> forall (m :: * -> *) a. Monad m => a -> m a
return [ GreName
gname
| AvailInfo
avail <- forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
, GreName
gname <- AvailInfo -> [GreName]
availGreNames AvailInfo
avail
, forall name. HasOccName name => name -> OccName
occName GreName
gname forall a. Eq a => a -> a -> Bool
== OccName
occ
, FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
fos GreName
gname
]
MaybeErr SDoc ModIface
_ ->
do { String -> SDoc -> TcRn ()
traceRn String
"lookupQualifiedNameGHCi" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; forall (m :: * -> *) a. Monad m => a -> m a
return [] } }
| Bool
otherwise
= do { String -> SDoc -> TcRn ()
traceRn String
"lookupQualifiedNameGHCi: off" (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; forall (m :: * -> *) a. Monad m => a -> m a
return [] }
doc :: SDoc
doc = String -> SDoc
text String
"Need to find" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
data HsSigCtxt
= TopSigCtxt NameSet
| LocalBindCtxt NameSet
| ClsDeclCtxt Name
| InstDeclCtxt NameSet
| HsBootCtxt NameSet
| RoleAnnotCtxt NameSet
instance Outputable HsSigCtxt where
ppr :: HsSigCtxt -> SDoc
ppr (TopSigCtxt NameSet
ns) = String -> SDoc
text String
"TopSigCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (LocalBindCtxt NameSet
ns) = String -> SDoc
text String
"LocalBindCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (ClsDeclCtxt Name
n) = String -> SDoc
text String
"ClsDeclCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
n
ppr (InstDeclCtxt NameSet
ns) = String -> SDoc
text String
"InstDeclCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (HsBootCtxt NameSet
ns) = String -> SDoc
text String
"HsBootCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (RoleAnnotCtxt NameSet
ns) = String -> SDoc
text String
"RoleAnnotCtxt" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr NameSet
ns
lookupSigOccRn :: HsSigCtxt
-> Sig GhcPs
-> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigOccRn :: HsSigCtxt -> Sig GhcPs -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigOccRn HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> SDoc -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (forall name. Sig name -> SDoc
hsSigDoc Sig GhcPs
sig)
lookupSigOccRnN :: HsSigCtxt
-> Sig GhcPs
-> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN :: HsSigCtxt -> Sig GhcPs -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> SDoc -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN HsSigCtxt
ctxt (forall name. Sig name -> SDoc
hsSigDoc Sig GhcPs
sig)
lookupSigCtxtOccRnN :: HsSigCtxt
-> SDoc
-> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN :: HsSigCtxt -> SDoc -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN HsSigCtxt
ctxt SDoc
what
= forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { Either NotInScopeError Name
mb_name <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
; case Either NotInScopeError Name
mb_name of
Left NotInScopeError
err -> do { TcRnMessage -> TcRn ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
err)
; forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
Right Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
lookupSigCtxtOccRn :: HsSigCtxt
-> SDoc
-> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigCtxtOccRn :: HsSigCtxt -> SDoc -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt SDoc
what
= forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { Either NotInScopeError Name
mb_name <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
; case Either NotInScopeError Name
mb_name of
Left NotInScopeError
err -> do { TcRnMessage -> TcRn ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
err)
; forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
Right Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName -> RnM (Either NotInScopeError Name)
lookupBindGroupOcc :: HsSigCtxt -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= Name -> RnM (Either NotInScopeError Name)
lookupExactOcc_either Name
n
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Name
n' <- forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
n') }
| Bool
otherwise
= case HsSigCtxt
ctxt of
HsBootCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either NotInScopeError Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
TopSigCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either NotInScopeError Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either NotInScopeError Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
LocalBindCtxt NameSet
ns -> NameSet -> RnM (Either NotInScopeError Name)
lookup_group NameSet
ns
ClsDeclCtxt Name
cls -> Name -> RnM (Either NotInScopeError Name)
lookup_cls_op Name
cls
InstDeclCtxt NameSet
ns -> if forall a. (a -> Bool) -> UniqSet a -> Bool
uniqSetAny Name -> Bool
isUnboundName NameSet
ns
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
else (Name -> Bool) -> RnM (Either NotInScopeError Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
where
lookup_cls_op :: Name -> RnM (Either NotInScopeError Name)
lookup_cls_op Name
cls
= Bool
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc Bool
True Name
cls SDoc
doc RdrName
rdr_name
where
doc :: SDoc
doc = String -> SDoc
text String
"method of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
cls)
lookup_top :: (Name -> Bool) -> RnM (Either NotInScopeError Name)
lookup_top Name -> Bool
keep_me
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let all_gres :: [GlobalRdrElt]
all_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
names_in_scope :: [Name]
names_in_scope =
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> DynFlags -> WhatLooking -> NameSpace -> NameSpace -> Bool
nameSpacesRelated DynFlags
dflags WhatLooking
WL_Anything
(RdrName -> NameSpace
rdrNameSpace RdrName
rdr_name)
(Name -> NameSpace
nameNameSpace Name
n))
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
env
candidates_msg :: [GhcHint]
candidates_msg = [Name] -> [GhcHint]
candidates [Name]
names_in_scope
; case forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep_me forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
greMangledName) [GlobalRdrElt]
all_gres of
[] | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> [GhcHint] -> RnM (Either NotInScopeError Name)
bale_out_with [GhcHint]
candidates_msg
| Bool
otherwise -> [GhcHint] -> RnM (Either NotInScopeError Name)
bale_out_with [GhcHint]
local_msg
(GlobalRdrElt
gre:[GlobalRdrElt]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre)) }
lookup_group :: NameSet -> RnM (Either NotInScopeError Name)
lookup_group NameSet
bound_names
= do { Maybe Name
mname <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; LocalRdrEnv
env <- RnM LocalRdrEnv
getLocalRdrEnv
; let candidates_msg :: [GhcHint]
candidates_msg = [Name] -> [GhcHint]
candidates forall a b. (a -> b) -> a -> b
$ LocalRdrEnv -> [Name]
localRdrEnvElts LocalRdrEnv
env
; case Maybe Name
mname of
Just Name
n
| Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
bound_names -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Name
n)
| Bool
otherwise -> [GhcHint] -> RnM (Either NotInScopeError Name)
bale_out_with [GhcHint]
local_msg
Maybe Name
Nothing -> [GhcHint] -> RnM (Either NotInScopeError Name)
bale_out_with [GhcHint]
candidates_msg }
bale_out_with :: [GhcHint] -> RnM (Either NotInScopeError Name)
bale_out_with [GhcHint]
hints = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SDoc -> [GhcHint] -> NotInScopeError
MissingBinding SDoc
what [GhcHint]
hints)
local_msg :: [GhcHint]
local_msg = [SDoc -> RdrName -> GhcHint
SuggestMoveToDeclarationSite SDoc
what RdrName
rdr_name]
candidates :: [Name] -> [GhcHint]
candidates :: [Name] -> [GhcHint]
candidates [Name]
names_in_scope
| (SimilarName
nm : [SimilarName]
nms) <- forall a b. (a -> b) -> [a] -> [b]
map Name -> SimilarName
SimilarName [Name]
similar_names
= [RdrName -> NonEmpty SimilarName -> GhcHint
SuggestSimilarNames RdrName
rdr_name (SimilarName
nm forall a. a -> [a] -> NonEmpty a
NE.:| [SimilarName]
nms)]
| Bool
otherwise
= []
where
similar_names :: [Name]
similar_names
= forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FastString -> String
unpackFS forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Name
x -> ((FastString -> String
unpackFS forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
x), Name
x))
[Name]
names_in_scope
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
= do { [Either TcRnMessage (RdrName, Name)]
mb_gres <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RdrName
-> IOEnv
(Env TcGblEnv TcLclEnv) (Either TcRnMessage (RdrName, Name))
lookup (RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name)
; let ([TcRnMessage]
errs, [(RdrName, Name)]
names) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either TcRnMessage (RdrName, Name)]
mb_gres
; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RdrName, Name)]
names) forall a b. (a -> b) -> a -> b
$
TcRnMessage -> TcRn ()
addErr (forall a. [a] -> a
head [TcRnMessage]
errs)
; forall (m :: * -> *) a. Monad m => a -> m a
return [(RdrName, Name)]
names }
where
lookup :: RdrName
-> IOEnv
(Env TcGblEnv TcLclEnv) (Either TcRnMessage (RdrName, Name))
lookup RdrName
rdr = do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; Either NotInScopeError Name
nameEither <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr
; forall (m :: * -> *) a. Monad m => a -> m a
return (Module
-> RdrName
-> Either NotInScopeError Name
-> Either TcRnMessage (RdrName, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr Either NotInScopeError Name
nameEither) }
guard_builtin_syntax :: Module
-> RdrName
-> Either NotInScopeError Name
-> Either TcRnMessage (RdrName, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr (Right Name
name)
| Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe (forall name. HasOccName name => name -> OccName
occName RdrName
rdr)
, Module
this_mod forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
nameModule Name
name
= forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SDoc -> RdrName -> TcRnMessage
TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr
| Bool
otherwise
= forall a b. b -> Either a b
Right (RdrName
rdr, Name
name)
guard_builtin_syntax Module
_ RdrName
_ (Left NotInScopeError
err)
= forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
err
dataTcOccs :: RdrName -> [RdrName]
dataTcOccs :: RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name
| OccName -> Bool
isDataOcc OccName
occ Bool -> Bool -> Bool
|| OccName -> Bool
isVarOcc OccName
occ
= [RdrName
rdr_name, RdrName
rdr_name_tc]
| Bool
otherwise
= [RdrName
rdr_name]
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
rdr_name_tc :: RdrName
rdr_name_tc = RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
rdr_name NameSpace
tcName
lookupIfThenElse :: RnM (Maybe Name)
lookupIfThenElse :: RnM (Maybe Name)
lookupIfThenElse
= do { Bool
rebindable_on <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do { Name
ite <- RdrName -> RnM Name
lookupOccRnNone (FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"ifThenElse"))
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Name
ite) } }
lookupSyntaxName :: Name
-> RnM (Name, FreeVars)
lookupSyntaxName :: Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
= do { Bool
rebind <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebind
then forall (m :: * -> *) a. Monad m => a -> m a
return (Name
std_name, NameSet
emptyFVs)
else do { Name
nm <- RdrName -> RnM Name
lookupOccRnNone (OccName -> RdrName
mkRdrUnqual (Name -> OccName
nameOccName Name
std_name))
; forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nm, Name -> NameSet
unitFV Name
nm) } }
lookupSyntaxExpr :: Name
-> RnM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr :: Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
= do { (Name
name, NameSet
fvs) <- Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar Name
name, NameSet
fvs) }
lookupSyntax :: Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntax Name
std_name
= do { (HsExpr GhcRn
expr, NameSet
fvs) <- Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
; forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr HsExpr GhcRn
expr, NameSet
fvs) }
lookupSyntaxNames :: [Name]
-> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames :: [Name] -> RnM ([HsExpr GhcRn], NameSet)
lookupSyntaxNames [Name]
std_names
= do { Bool
rebindable_on <- forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on then
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
noExtField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) [Name]
std_names, NameSet
emptyFVs)
else
do { [Name]
usr_names <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RdrName -> RnM Name
lookupOccRnNone forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
std_names
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map (forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
noExtField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) [Name]
usr_names, [Name] -> NameSet
mkFVs [Name]
usr_names) } }
lookupQualifiedDoExpr :: HsStmtContext p -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr :: forall p. HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
std_name
= forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. HsStmtContext p -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext p
ctxt Name
std_name
lookupQualifiedDo
:: HsStmtContext p
-> Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo :: forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupQualifiedDo HsStmtContext p
ctxt Name
std_name
= forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
std_name
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars)
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
= do { Name
qname <- RdrName -> RnM Name
lookupOccRnNone (ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
modName (Name -> OccName
nameOccName Name
std_name))
; forall (m :: * -> *) a. Monad m => a -> m a
return (Name
qname, Name -> NameSet
unitFV Name
qname) }
lookupQualifiedDoName
:: HsStmtContext p
-> Name
-> RnM (Name, FreeVars)
lookupQualifiedDoName :: forall p. HsStmtContext p -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext p
ctxt Name
std_name
= case forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext p
ctxt of
Maybe ModuleName
Nothing -> Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
Just ModuleName
modName -> Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
opDeclErr :: RdrName -> TcRnMessage
opDeclErr :: RdrName -> TcRnMessage
opDeclErr RdrName
n
= forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal declaration of a type or class operator" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
n))
Arity
2 (String -> SDoc
text String
"Use TypeOperators to declare operators in type and declarations")
badOrigBinding :: RdrName -> TcRnMessage
badOrigBinding :: RdrName -> TcRnMessage
badOrigBinding RdrName
name
| Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
= forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal binding of built-in syntax:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr OccName
occ
| Bool
otherwise
= forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Cannot redefine a Name retrieved by a Template Haskell quote:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr RdrName
name
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
filterCTuple RdrName
name