{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
module GHC.Rename.Env (
newTopSrcBinder,
lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn,
lookupLocatedTopConstructorRn, lookupLocatedTopConstructorRnN,
lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
lookupLocatedOccRnNone,
lookupOccRn, lookupOccRn_maybe, lookupSameOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupExprOccRn,
lookupRecFieldOcc,
lookupRecUpdFields,
getFieldUpdLbl,
getUpdFieldLbls,
ChildLookupResult(..),
lookupSubBndrOcc_helper,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
lookupSigCtxtOccRn,
lookupInstDeclBndr, lookupFamInstName,
lookupConstructorInfo, lookupConstructorFields,
lookupGREInfo,
lookupGreAvailRn,
lookupSyntax, lookupSyntaxExpr, lookupSyntaxNames,
lookupSyntaxName,
lookupIfThenElse,
lookupQualifiedDoExpr, lookupQualifiedDo,
lookupQualifiedDoName, lookupNameWithQualifier,
DeprecationWarnings(..),
addUsedGRE, addUsedGREs, addUsedDataCons,
dataTcOccs,
) where
import GHC.Prelude
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import GHC.Iface.Load
import GHC.Iface.Env
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
import GHC.Tc.Errors.Ppr (pprScopeError)
import GHC.Tc.Utils.Env
import GHC.Tc.Types.LclEnv
import GHC.Tc.Utils.Monad
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(..) )
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Builtin.Names( rOOT_MAIN )
import GHC.Types.Basic ( TopLevelFlag(..), TupleSort(..), tupleSortBoxity )
import GHC.Types.TyThing ( tyThingGREInfo )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain (assert)
import GHC.Data.Maybe
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Data.List.SetOps ( minusList )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Rename.Unbound
import GHC.Rename.Utils
import GHC.Data.Bag
import GHC.Types.PkgQual
import GHC.Types.GREInfo
import Control.Arrow ( first )
import Control.Monad
import Data.Either ( partitionEithers )
import Data.Function ( on )
import Data.List ( find, partition, groupBy, sortBy )
import Data.Foldable ( for_ )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semi
import System.IO.Unsafe ( unsafePerformIO )
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 <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
(SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
TcRnBindingOfExistingName RdrName
rdr_name))
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
else
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Module -> Name -> RnM Name
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 <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod Bool -> Bool -> Bool
|| Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
rOOT_MAIN)
(SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
TcRnBindingOfExistingName RdrName
rdr_name))
; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
rdr_mod OccName
rdr_occ (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }
| Bool
otherwise
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr_name)
(SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
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 <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc)) }
else
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"newTopSrcBinder" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc))
; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
this_mod (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (SrcSpanAnnN -> SrcSpan
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 =
RdrName -> (GlobalRdrElt -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$
do {
let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
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 <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
op_ok (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> TcRnMessage
TcRnIllegalTypeOperatorDecl RdrName
rdr_name)) })
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE (GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (LookupGRE GREInfo -> [GlobalRdrElt])
-> LookupGRE GREInfo -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr_name (WhichGREs GREInfo -> LookupGRE GREInfo)
-> WhichGREs GREInfo -> LookupGRE GREInfo
forall a b. (a -> b) -> a -> b
$ FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) of
[GlobalRdrElt
gre] -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
[GlobalRdrElt]
_ -> do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupTopBndrRN fail" (RdrName -> SDoc
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 = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
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 = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
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 = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
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 = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
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 GlobalRdrElt)
lookupExactOcc_either :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
name
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
, Just TyCon
tycon <- case TyThing
thing of
ATyCon TyCon
tc -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
AConLike (RealDataCon DataCon
dc) -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (DataCon -> TyCon
dataConTyCon DataCon
dc)
TyThing
_ -> Maybe TyCon
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 Arity -> Arity -> Arity
forall a. Integral a => a -> a -> a
`div` Arity
2
TupleSort
_ -> TyCon -> Arity
tyConArity TyCon
tycon
; let info :: GREInfo
info = case TyThing
thing of
ATyCon {} -> TyConFlavour Name -> GREInfo
IAmTyCon (TyConFlavour Name -> GREInfo) -> TyConFlavour Name -> GREInfo
forall a b. (a -> b) -> a -> b
$ Boxity -> TyConFlavour Name
forall tc. Boxity -> TyConFlavour tc
TupleFlavour (Boxity -> TyConFlavour Name) -> Boxity -> TyConFlavour Name
forall a b. (a -> b) -> a -> b
$ TupleSort -> Boxity
tupleSortBoxity TupleSort
tupleSort
TyThing
_ -> ConInfo -> GREInfo
IAmConLike (ConInfo -> GREInfo) -> ConInfo -> GREInfo
forall a b. (a -> b) -> a -> b
$ Arity -> [FieldLabel] -> ConInfo
mkConInfo Arity
tupArity []
; Arity -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize Arity
tupArity
; Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt))
-> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt)
-> GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ Name -> GREInfo -> GlobalRdrElt
mkExactGRE Name
name GREInfo
info }
| Name -> Bool
isExternalName Name
name
= do { GREInfo
info <- Name -> RnM GREInfo
lookupExternalExactName Name
name
; Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt))
-> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt)
-> GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ Name -> GREInfo -> GlobalRdrElt
mkExactGRE Name
name GREInfo
info }
| Bool
otherwise
= Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name
lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName Name
name
= do { TyThing
thing <-
case Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name of
Just TyThing
thing -> TyThing -> IOEnv (Env TcGblEnv TcLclEnv) TyThing
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
Maybe TyThing
_ -> Name -> IOEnv (Env TcGblEnv TcLclEnv) TyThing
tcLookupGlobal Name
name
; GREInfo -> RnM GREInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GREInfo -> RnM GREInfo) -> GREInfo -> RnM GREInfo
forall a b. (a -> b) -> a -> b
$ TyThing -> GREInfo
tyThingGREInfo TyThing
thing }
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let lk :: LookupGRE GREInfo
lk = LookupExactName { lookupExactName :: Name
lookupExactName = Name
name
, lookInAllNameSpaces :: Bool
lookInAllNameSpaces = Bool
True }
; case GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env LookupGRE GREInfo
lk of
[GlobalRdrElt
gre] -> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right GlobalRdrElt
gre)
[] ->
do { LocalRdrEnv
lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; let gre :: GlobalRdrElt
gre = Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE Parent
NoParent Name
name
; if Name
name Name -> LocalRdrEnv -> Bool
`inLocalRdrEnvScope` LocalRdrEnv
lcl_env
then Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right GlobalRdrElt
gre)
else
do { TcRef NameSet
th_topnames_var <- (TcGblEnv -> TcRef NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
-> IOEnv (Env TcGblEnv TcLclEnv) (TcRef NameSet)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TcGblEnv -> TcRef NameSet
tcg_th_topnames IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; NameSet
th_topnames <- TcRef NameSet -> IOEnv (Env TcGblEnv TcLclEnv) NameSet
forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
readTcRef TcRef NameSet
th_topnames_var
; if Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
th_topnames
then Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right GlobalRdrElt
gre)
else Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotInScopeError -> Either NotInScopeError GlobalRdrElt
forall a b. a -> Either a b
Left (Name -> NotInScopeError
NoExactName Name
name))
}
}
[GlobalRdrElt]
gres -> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotInScopeError -> Either NotInScopeError GlobalRdrElt
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 { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr)
(TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr))
; Either NotInScopeError Name
mb_name <- DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc
DeprecationWarnings
NoDeprecationWarnings
Name
cls SDoc
doc RdrName
rdr
; case Either NotInScopeError Name
mb_name of
Left NotInScopeError
err -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr NotInScopeError
err)
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr) }
Right Name
nm -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm }
where
doc :: SDoc
doc = SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
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
= (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
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
forall doc. IsLine doc => String -> doc
text String
"associated type")) LocatedN RdrName
tc_rdr
lookupFamInstName Maybe Name
Nothing LocatedN RdrName
tc_rdr
= LocatedN RdrName -> RnM (LocatedN Name)
forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRnConstr LocatedN RdrName
tc_rdr
lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel]
lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel]
lookupConstructorFields = (ConInfo -> [FieldLabel])
-> IOEnv (Env TcGblEnv TcLclEnv) ConInfo -> RnM [FieldLabel]
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConInfo -> [FieldLabel]
conInfoFields (IOEnv (Env TcGblEnv TcLclEnv) ConInfo -> RnM [FieldLabel])
-> (Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> Name
-> RnM [FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
lookupConstructorInfo
lookupConstructorInfo :: HasDebugCallStack => Name -> RnM ConInfo
lookupConstructorInfo :: HasDebugCallStack => Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
lookupConstructorInfo Name
con_name
= do { GREInfo
info <- HasDebugCallStack => Name -> RnM GREInfo
Name -> RnM GREInfo
lookupGREInfo_GRE Name
con_name
; case GREInfo
info of
IAmConLike ConInfo
con_info -> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ConInfo
con_info
GREInfo
UnboundGRE -> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ConInfo
ConHasPositionalArgs
GREInfo
_ -> String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupConstructorInfo: not a ConLike" (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con_name ]
}
lookupExactOrOrig :: RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig :: forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig GlobalRdrElt
gre -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> RnM r) -> r -> RnM r
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> r
res GlobalRdrElt
gre
ExactOrOrigResult
NotExactOrOrig -> RnM r
k
ExactOrOrigError NotInScopeError
e ->
do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
e)
; r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> RnM r) -> r -> RnM r
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> r
res (RdrName -> GlobalRdrElt
mkUnboundGRERdr RdrName
rdr_name) } }
lookupExactOrOrig_maybe :: RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe :: forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig GlobalRdrElt
gre -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> r
res (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre))
ExactOrOrigError NotInScopeError
_ -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> r
res Maybe GlobalRdrElt
forall a. Maybe a
Nothing)
ExactOrOrigResult
NotExactOrOrig -> RnM r
k }
data ExactOrOrigResult
= FoundExactOrOrig GlobalRdrElt
| 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 GlobalRdrElt -> ExactOrOrigResult
cvtEither (Either NotInScopeError GlobalRdrElt -> ExactOrOrigResult)
-> RnM (Either NotInScopeError GlobalRdrElt)
-> RnM ExactOrOrigResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
n
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Name
nm <- Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Either NotInScopeError GlobalRdrElt
mb_gre <-
if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
nm
then Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
nm
else do { GREInfo
info <- Name -> RnM GREInfo
lookupExternalExactName Name
nm
; Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt))
-> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt)
-> GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ Name -> GREInfo -> GlobalRdrElt
mkExactGRE Name
nm GREInfo
info }
; ExactOrOrigResult -> RnM ExactOrOrigResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExactOrOrigResult -> RnM ExactOrOrigResult)
-> ExactOrOrigResult -> RnM ExactOrOrigResult
forall a b. (a -> b) -> a -> b
$ case Either NotInScopeError GlobalRdrElt
mb_gre of
Left NotInScopeError
err -> NotInScopeError -> ExactOrOrigResult
ExactOrOrigError NotInScopeError
err
Right GlobalRdrElt
gre -> GlobalRdrElt -> ExactOrOrigResult
FoundExactOrOrig GlobalRdrElt
gre }
| Bool
otherwise = ExactOrOrigResult -> RnM ExactOrOrigResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExactOrOrigResult
NotExactOrOrig
where
cvtEither :: Either NotInScopeError GlobalRdrElt -> ExactOrOrigResult
cvtEither (Left NotInScopeError
e) = NotInScopeError -> ExactOrOrigResult
ExactOrOrigError NotInScopeError
e
cvtEither (Right GlobalRdrElt
gre) = GlobalRdrElt -> ExactOrOrigResult
FoundExactOrOrig GlobalRdrElt
gre
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
= Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
mk_unbound_rec_fld Name
con
| Just Name
con <- Maybe Name
mb_con
= do { let lbl :: FieldLabelString
lbl = FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString) -> FastString -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
; Maybe Name
mb_nm <- RdrName
-> (GlobalRdrElt -> Maybe Name)
-> RnM (Maybe Name)
-> RnM (Maybe Name)
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Maybe Name
ensure_recfld (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
do { [FieldLabel]
flds <- HasDebugCallStack => Name -> RnM [FieldLabel]
Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let mb_gre :: Maybe GlobalRdrElt
mb_gre = do FieldLabel
fl <- (FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
lbl) (FieldLabelString -> Bool)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel) [FieldLabel]
flds
GlobalRdrElt
gre <- GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
if RdrName -> Bool
isQual RdrName
rdr_name
then [GlobalRdrElt] -> Maybe GlobalRdrElt
forall a. [a] -> Maybe a
listToMaybe ([GlobalRdrElt] -> Maybe GlobalRdrElt)
-> [GlobalRdrElt] -> Maybe GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
forall info.
RdrName -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
pickGREs RdrName
rdr_name [GlobalRdrElt
gre]
else GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrElt
gre
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupRecFieldOcc" (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"mb_con:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Name
mb_con
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"rdr_name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flds:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [FieldLabel] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [FieldLabel]
flds
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"mb_gre:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe GlobalRdrElt
mb_gre ]
; (GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Maybe GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
AllDeprecationWarnings) Maybe GlobalRdrElt
mb_gre
; Maybe Name -> RnM (Maybe Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> RnM (Maybe Name)) -> Maybe Name -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector (FieldLabel -> Name)
-> (GlobalRdrElt -> FieldLabel) -> GlobalRdrElt -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => GlobalRdrElt -> FieldLabel
GlobalRdrElt -> FieldLabel
fieldGRELabel (GlobalRdrElt -> Name) -> Maybe GlobalRdrElt -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GlobalRdrElt
mb_gre }
; case Maybe Name
mb_nm of
{ Maybe Name
Nothing -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (Name -> FieldLabelString -> TcRnMessage
badFieldConErr Name
con FieldLabelString
lbl)
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
mk_unbound_rec_fld Name
con }
; Just Name
nm -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm } }
| Bool
otherwise
= WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantField) RdrName
rdr_name
where
mk_unbound_rec_fld :: Name -> Name
mk_unbound_rec_fld Name
con = OccName -> Name
mkUnboundName (OccName -> Name) -> OccName -> Name
forall a b. (a -> b) -> a -> b
$
FastString -> FastString -> OccName
mkRecFieldOccFS (Name -> FastString
forall a. NamedThing a => a -> FastString
getOccFS Name
con) (OccName -> FastString
occNameFS OccName
occ)
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
ensure_recfld :: GlobalRdrElt -> Maybe Name
ensure_recfld :: GlobalRdrElt -> Maybe Name
ensure_recfld GlobalRdrElt
gre = do { Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
gre)
; Name -> Maybe Name
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre }
lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper :: Bool
-> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
must_have_parent DeprecationWarnings
warn_if_deprec Name
parent RdrName
rdr_name LookupChild
how_lkup
| Name -> Bool
isUnboundName Name
parent
= ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> ChildLookupResult
FoundChild (RdrName -> GlobalRdrElt
mkUnboundGRERdr RdrName
rdr_name))
| Bool
otherwise = do
GlobalRdrEnv
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
let original_gres :: [GlobalRdrElt]
original_gres = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
gre_env (OccName -> LookupChild -> LookupGRE GREInfo
forall info. OccName -> LookupChild -> LookupGRE info
LookupChildren (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) LookupChild
how_lkup)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"parent" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild original_gres:" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild picked_gres:" (DisambigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Bool -> 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 GlobalRdrElt
g = do
DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
g
ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> ChildLookupResult
FoundChild GlobalRdrElt
g
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres = do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"npe" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
Bool
dup_fields_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
case [GlobalRdrElt]
original_gres of
[] -> ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
[GlobalRdrElt
g] -> ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ Name -> GlobalRdrElt -> [Name] -> ChildLookupResult
IncorrectParent Name
parent GlobalRdrElt
g
[Name
p | ParentIs Name
p <- [GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
g]]
gss :: [GlobalRdrElt]
gss@(GlobalRdrElt
g:gss' :: [GlobalRdrElt]
gss'@(GlobalRdrElt
_:[GlobalRdrElt]
_)) ->
if (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE [GlobalRdrElt]
gss Bool -> Bool -> Bool
&& Bool
dup_fields_ok
then ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
Name -> GlobalRdrElt -> [Name] -> ChildLookupResult
IncorrectParent Name
parent GlobalRdrElt
g
[Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, ParentIs Name
p <- [GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
x]]
else NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr (NonEmpty GlobalRdrElt -> RnM ChildLookupResult)
-> NonEmpty GlobalRdrElt -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
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 -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> ChildLookupResult
FoundChild (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres))
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
gres
| RdrName -> Bool
isUnqual RdrName
rdr_name
= [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent [GlobalRdrElt]
gres)
| Bool
otherwise
= [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
forall info.
RdrName -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres))
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent GlobalRdrElt
p
= case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
p of
ParentIs Name
cur_parent
| Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
p
| Bool
otherwise -> DisambigInfo
NoOccurrence
Parent
NoParent -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
p
{-# INLINEABLE lookupSubBndrOcc_helper #-}
data DisambigInfo
= NoOccurrence
| UniqueOccurrence GlobalRdrElt
| DisambiguatedOccurrence GlobalRdrElt
| AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt)
instance Outputable DisambigInfo where
ppr :: DisambigInfo -> SDoc
ppr DisambigInfo
NoOccurrence = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoOccurrence"
ppr (UniqueOccurrence GlobalRdrElt
gre) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UniqueOccurrence:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (DisambiguatedOccurrence GlobalRdrElt
gre) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DiambiguatedOccurrence:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (AmbiguousOccurrence NonEmpty GlobalRdrElt
gres) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NonEmpty GlobalRdrElt -> 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 (NonEmpty GlobalRdrElt -> DisambigInfo)
-> NonEmpty GlobalRdrElt -> DisambigInfo
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt
g']
UniqueOccurrence GlobalRdrElt
g <> AmbiguousOccurrence NonEmpty GlobalRdrElt
gs
= NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
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' GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
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 NonEmpty GlobalRdrElt
-> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
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 = DisambigInfo -> DisambigInfo -> DisambigInfo
forall a. Semigroup a => a -> a -> a
(Semi.<>)
data ChildLookupResult
= NameNotFound
| IncorrectParent Name
GlobalRdrElt
[Name]
| FoundChild GlobalRdrElt
instance Outputable ChildLookupResult where
ppr :: ChildLookupResult -> SDoc
ppr ChildLookupResult
NameNotFound = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameNotFound"
ppr (FoundChild GlobalRdrElt
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Parent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
n
ppr (IncorrectParent Name
p GlobalRdrElt
g [Name]
ns)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IncorrectParent"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
p, Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
g, [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns]
lookupSubBndrOcc :: DeprecationWarnings
-> Name
-> SDoc
-> RdrName
-> RnM (Either NotInScopeError Name)
lookupSubBndrOcc :: DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc DeprecationWarnings
warn_if_deprec Name
the_parent SDoc
doc RdrName
rdr_name =
RdrName
-> (GlobalRdrElt -> Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> (GlobalRdrElt -> Name)
-> GlobalRdrElt
-> Either NotInScopeError Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) (RnM (Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name))
-> RnM (Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$
do { ChildLookupResult
child <- Bool
-> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
True DeprecationWarnings
warn_if_deprec Name
the_parent RdrName
rdr_name LookupChild
what_lkup
; Either NotInScopeError Name -> RnM (Either NotInScopeError Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NotInScopeError Name -> RnM (Either NotInScopeError Name))
-> Either NotInScopeError Name -> RnM (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ case ChildLookupResult
child of
FoundChild GlobalRdrElt
g -> Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
g)
ChildLookupResult
NameNotFound -> NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc)
IncorrectParent {} -> NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc) }
where
what_lkup :: LookupChild
what_lkup = LookupChild { wantedParent :: Name
wantedParent = Name
the_parent
, lookupDataConFirst :: Bool
lookupDataConFirst = Bool
False
, prioritiseParent :: Bool
prioritiseParent = Bool
True
}
lookupLocatedOccRn :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn = (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
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 = (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
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 = (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
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 = (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
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
; Maybe Name -> RnM (Maybe Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
; Maybe (TopLevelFlag, Arity) -> RnM (Maybe (TopLevelFlag, Arity))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameEnv (TopLevelFlag, Arity)
-> Name -> Maybe (TopLevelFlag, Arity)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (TcLclEnv -> NameEnv (TopLevelFlag, Arity)
getLclEnvThBndrs TcLclEnv
lcl_env) Name
name) }
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
which_suggest RdrName
rdr_name
= do { Maybe GlobalRdrElt
mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe GlobalRdrElt
mb_gre of
Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
Maybe GlobalRdrElt
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 -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 (OccName -> Bool) -> (OccName -> Bool) -> OccName -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<||> OccName -> Bool
isFieldOcc) (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
= RdrName -> RnM Name
badVarInType RdrName
rdr_name
| Bool
otherwise
= do { Maybe GlobalRdrElt
mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe GlobalRdrElt
mb_gre of
Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
Maybe GlobalRdrElt
Nothing ->
if RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
rdr_name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
eqTyCon_RDR
then Name
eqTyConName Name -> IOEnv (Env TcGblEnv TcLclEnv) () -> RnM Name
forall a b.
a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
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 <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
; Bool
star_is_type <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
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 GlobalRdrElt
mb_demoted_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
demoted_rdr
; case Maybe GlobalRdrElt
mb_demoted_gre of
Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> [GhcHint] -> RnM Name
unboundNameX LookingFor
looking_for RdrName
rdr_name [GhcHint]
star_is_type_hints
Just GlobalRdrElt
demoted_gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
demoted_gre}
else do {
Maybe GlobalRdrElt
mb_demoted_name <- RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a. TcRn a -> TcRn a
discardErrs (RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt))
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
demoted_rdr
; let suggestion :: [GhcHint]
suggestion | Maybe GlobalRdrElt -> Bool
forall a. Maybe a -> Bool
isJust Maybe GlobalRdrElt
mb_demoted_name
, let additional :: SDoc
additional = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to refer to the data constructor of that name?"
= [LanguageExtensionHint -> GhcHint
SuggestExtension (LanguageExtensionHint -> GhcHint)
-> LanguageExtensionHint -> GhcHint
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 } }
| Just RdrName
demoted_rdr_name <- RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr_name,
RdrName -> Bool
isQual RdrName
rdr_name
= RdrName -> RdrName -> RnM Name
report_qualified_term_in_types RdrName
rdr_name RdrName
demoted_rdr_name
| 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
report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
report_qualified_term_in_types RdrName
rdr_name RdrName
demoted_rdr_name =
do { Maybe GlobalRdrElt
mName <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
demoted_rdr_name
; case Maybe GlobalRdrElt
mName of
(Just GlobalRdrElt
_) -> LookingFor -> RdrName -> RdrName -> [GhcHint] -> RnM Name
termNameInType LookingFor
looking_for RdrName
rdr_name RdrName
demoted_rdr_name []
Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> RdrName -> RnM Name
unboundTermNameInTypes LookingFor
looking_for RdrName
rdr_name RdrName
demoted_rdr_name }
where
looking_for :: LookingFor
looking_for = WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Constructor WhereLooking
WL_Global
lookup_promoted :: RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted :: RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
| Just RdrName
promoted_rdr <- RdrName -> Maybe RdrName
promoteRdrName RdrName
rdr_name
= RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
promoted_rdr
| Bool
otherwise
= Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
badVarInType :: RdrName -> RnM Name
badVarInType :: RdrName -> RnM Name
badVarInType RdrName
rdr_name
= do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (Name -> PromotionErr -> TcRnMessage
TcRnUnpromotableThing Name
name PromotionErr
TermVariablePE)
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
where
name :: Name
name = RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (GlobalRdrElt -> RnM r) -> RdrName
-> RnM (Maybe r)
lookupOccRnX_maybe :: forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe r)
globalLookup GlobalRdrElt -> RnM r
wrapper RdrName
rdr_name
= MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r -> RnM (Maybe r)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r -> RnM (Maybe r))
-> ([RnM (Maybe r)] -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> [RnM (Maybe r)]
-> RnM (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ([RnM (Maybe r)] -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r])
-> [RnM (Maybe r)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe r) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> [RnM (Maybe r)] -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe r) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe r)] -> RnM (Maybe r))
-> [RnM (Maybe r)] -> RnM (Maybe r)
forall a b. (a -> b) -> a -> b
$
[ do { Maybe Name
res <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; case Maybe Name
res of
{ Maybe Name
Nothing -> Maybe r -> RnM (Maybe r)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe r
forall a. Maybe a
Nothing
; Just Name
nm ->
do { let gre :: GlobalRdrElt
gre = Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE Parent
NoParent Name
nm
; r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> RnM r -> RnM (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobalRdrElt -> RnM r
wrapper GlobalRdrElt
gre } } }
, RdrName -> RnM (Maybe r)
globalLookup RdrName
rdr_name ]
lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe =
(RdrName -> RnM (Maybe GlobalRdrElt))
-> (GlobalRdrElt -> RnM GlobalRdrElt)
-> RdrName
-> RnM (Maybe GlobalRdrElt)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
(WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe (WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt))
-> WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal)
GlobalRdrElt -> RnM GlobalRdrElt
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return
lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupSameOccRn_maybe =
(RdrName -> RnM (Maybe Name))
-> (GlobalRdrElt -> RnM Name) -> RdrName -> RnM (Maybe Name)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
(RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
get_name (RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name))
-> (RdrName -> RnM (Maybe GlobalRdrElt))
-> RdrName
-> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe WhichGREs GREInfo
forall info. WhichGREs info
SameNameSpace)
(Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name)
-> (GlobalRdrElt -> Name) -> GlobalRdrElt -> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName)
where
get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
get_name = (Maybe GlobalRdrElt -> Maybe Name)
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlobalRdrElt -> Name) -> Maybe GlobalRdrElt -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName)
lookupExprOccRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupExprOccRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupExprOccRn RdrName
rdr_name
= do { Maybe GlobalRdrElt
mb_name <- (RdrName -> RnM (Maybe GlobalRdrElt))
-> (GlobalRdrElt -> RnM GlobalRdrElt)
-> RdrName
-> RnM (Maybe GlobalRdrElt)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded
GlobalRdrElt -> RnM GlobalRdrElt
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return
RdrName
rdr_name
; case Maybe GlobalRdrElt
mb_name of
Maybe GlobalRdrElt
Nothing -> RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
Maybe GlobalRdrElt
p -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
p }
lookupGlobalOccRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name =
RdrName
-> (Maybe GlobalRdrElt -> Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> a
id (RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt))
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn = WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal)
lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' WhichGREs GREInfo
which_gres RdrName
rdr_name =
RdrName -> (GlobalRdrElt -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ do
Maybe GlobalRdrElt
mb_gre <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name
case Maybe GlobalRdrElt
mb_gre of
Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
Maybe GlobalRdrElt
Nothing -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGlobalOccRn" (RdrName -> SDoc
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 WhichGREs GREInfo -> FieldsOrSelectors
includeFieldSelectors WhichGREs GREInfo
which_gres of
FieldsOrSelectors
WantBoth -> WhatLooking
WL_RecField
FieldsOrSelectors
WantField -> WhatLooking
WL_RecField
FieldsOrSelectors
WantNormal -> WhatLooking
WL_Anything
lookupGlobalOccRn_base :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name =
MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> RnM (Maybe GlobalRdrElt)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> RnM (Maybe GlobalRdrElt))
-> ([RnM (Maybe GlobalRdrElt)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> [RnM (Maybe GlobalRdrElt)]
-> RnM (Maybe GlobalRdrElt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> ([RnM (Maybe GlobalRdrElt)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt])
-> [RnM (Maybe GlobalRdrElt)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe GlobalRdrElt)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> [RnM (Maybe GlobalRdrElt)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe GlobalRdrElt)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe GlobalRdrElt)] -> RnM (Maybe GlobalRdrElt))
-> [RnM (Maybe GlobalRdrElt)] -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
[ WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name
, FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name ]
where
fos :: FieldsOrSelectors
fos = case WhichGREs GREInfo
which_gres of
RelevantGREs { includeFieldSelectors :: WhichGREs GREInfo -> FieldsOrSelectors
includeFieldSelectors = FieldsOrSelectors
sel } -> FieldsOrSelectors
sel
WhichGREs GREInfo
_ -> if OccName -> Bool
isFieldOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
then FieldsOrSelectors
WantField
else FieldsOrSelectors
WantNormal
lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo
lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo
lookupGREInfo_GRE Name
name
= do { GlobalRdrEnv
rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env Name
name of
Just ( GRE { gre_info :: forall info. GlobalRdrEltX info -> info
gre_info = GREInfo
info } )
-> GREInfo -> RnM GREInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GREInfo
info
Maybe GlobalRdrElt
_ -> do { HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; GREInfo -> RnM GREInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GREInfo -> RnM GREInfo) -> GREInfo -> RnM GREInfo
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
name } }
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn RdrName
rdr_name =
RdrName -> (GlobalRdrElt -> [Name]) -> RnM [Name] -> RnM [Name]
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (\ GlobalRdrElt
gre -> [GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre]) (RnM [Name] -> RnM [Name]) -> RnM [Name] -> RnM [Name]
forall a b. (a -> b) -> a -> b
$
do { GlobalRdrEnv
rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let nms :: [Name]
nms = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrElt] -> [Name]) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
rdr_env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr_name (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth))
; [Name]
qual_nms <- (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrElt] -> [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt] -> RnM [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr_name
; [Name] -> RnM [Name]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> RnM [Name]) -> [Name] -> RnM [Name]
forall a b. (a -> b) -> a -> b
$ [Name]
nms [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
qual_nms [Name] -> [Name] -> [Name]
forall a. Ord a => [a] -> [a] -> [a]
`minusList` [Name]
nms) }
lookupFieldGREs :: GlobalRdrEnv -> LocatedN RdrName -> RnM (NE.NonEmpty FieldGlobalRdrElt)
lookupFieldGREs :: GlobalRdrEnv -> LocatedN RdrName -> RnM (NonEmpty GlobalRdrElt)
lookupFieldGREs GlobalRdrEnv
env (L SrcSpanAnnN
loc RdrName
rdr)
= SrcSpanAnnN
-> RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnN
loc
(RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt))
-> RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ do { [GlobalRdrElt]
res <- RdrName
-> (GlobalRdrElt -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr (\ GlobalRdrElt
gre -> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a. Maybe a -> [a]
maybeToList (Maybe GlobalRdrElt -> [GlobalRdrElt])
-> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
fieldGRE_maybe GlobalRdrElt
gre) (IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$
do { let ([GlobalRdrElt]
env_fld_gres, [GlobalRdrElt]
env_var_gres) =
(GlobalRdrElt -> Bool)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE ([GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt]))
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a b. (a -> b) -> a -> b
$
GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth))
; [GlobalRdrElt]
ghci_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr
; let ([GlobalRdrElt]
ghci_fld_gres, [GlobalRdrElt]
ghci_var_gres) =
(GlobalRdrElt -> Bool)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE ([GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt]))
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a b. (a -> b) -> a -> b
$
[GlobalRdrElt]
ghci_gres
; let fld_gres :: [GlobalRdrElt]
fld_gres = [GlobalRdrElt]
ghci_fld_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_fld_gres
var_gres :: [GlobalRdrElt]
var_gres = [GlobalRdrElt]
ghci_var_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_var_gres
; Bool
disamb_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DisambiguateRecordFields
; if | Bool -> Bool
not Bool
disamb_ok
, GlobalRdrElt
gre1 : GlobalRdrElt
gre2 : [GlobalRdrElt]
others <- [GlobalRdrElt]
fld_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
var_gres
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrTc (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt, GlobalRdrElt, [GlobalRdrElt]) -> TcRnMessage
TcRnAmbiguousFieldInUpdate (GlobalRdrElt
gre1, GlobalRdrElt
gre2, [GlobalRdrElt]
others)
| Bool
otherwise
-> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [GlobalRdrElt]
fld_gres }
; case [GlobalRdrElt]
res of
GlobalRdrElt
gre : [GlobalRdrElt]
gres -> NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt))
-> NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres
[] -> do { ([ImportError]
imp_errs, [GhcHint]
hints) <-
LocalRdrEnv
-> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint])
unknownNameSuggestions LocalRdrEnv
emptyLocalRdrEnv WhatLooking
WL_RecField RdrName
rdr
; TcRnMessage -> RnM (NonEmpty GlobalRdrElt)
forall a. TcRnMessage -> TcM a
failWithTc (TcRnMessage -> RnM (NonEmpty GlobalRdrElt))
-> TcRnMessage -> RnM (NonEmpty GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
NotInScopeError
-> RdrName -> [ImportError] -> [GhcHint] -> TcRnMessage
TcRnNotInScope NotInScopeError
NotARecordField RdrName
rdr [ImportError]
imp_errs [GhcHint]
hints } }
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded RdrName
rdr_name =
RdrName
-> (Maybe GlobalRdrElt -> Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> a
id (RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt))
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
do { GreLookupResult
res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
; case GreLookupResult
res of
GreLookupResult
GreNotFound -> FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
WantNormal RdrName
rdr_name
OneNameMatch GlobalRdrElt
gre -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
MultipleNames gres :: NonEmpty GlobalRdrElt
gres@(GlobalRdrElt
gre NE.:| [GlobalRdrElt]
_) -> do
RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre) }
getFieldUpdLbl :: LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl :: forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl = AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
forall (p :: Pass).
AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
ambiguousFieldOccLRdrName (AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> AmbiguousFieldOcc (GhcPass p))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> AmbiguousFieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q)
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q)
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(LHsExpr q)
forall l e. GenLocated l e -> e
unLoc
lookupRecUpdFields :: NE.NonEmpty (LHsRecUpdField GhcPs GhcPs)
-> RnM (NE.NonEmpty (HsRecUpdParent GhcRn))
lookupRecUpdFields :: NonEmpty (LHsRecUpdField GhcPs GhcPs)
-> RnM (NonEmpty (HsRecUpdParent GhcRn))
lookupRecUpdFields NonEmpty (LHsRecUpdField GhcPs GhcPs)
flds
= do {
; GlobalRdrEnv
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; NonEmpty GlobalRdrElt
fld1_gres NE.:| [NonEmpty GlobalRdrElt]
other_flds_gres <- (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> RnM (NonEmpty GlobalRdrElt))
-> NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
-> IOEnv (Env TcGblEnv TcLclEnv) (NonEmpty (NonEmpty GlobalRdrElt))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (GlobalRdrEnv -> LocatedN RdrName -> RnM (NonEmpty GlobalRdrElt)
lookupFieldGREs GlobalRdrEnv
gre_env (LocatedN RdrName -> RnM (NonEmpty GlobalRdrElt))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> LocatedN RdrName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> RnM (NonEmpty GlobalRdrElt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecUpdField GhcPs GhcPs -> LocatedN RdrName
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> LocatedN RdrName
forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl) NonEmpty (LHsRecUpdField GhcPs GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
flds
; let possible_GREs :: [HsRecUpdParent GhcRn]
possible_GREs = NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
fld1_gres [NonEmpty GlobalRdrElt]
other_flds_gres
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupRecUpdFields" (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flds:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NonEmpty (LocatedN RdrName) -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> LocatedN RdrName)
-> NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
-> NonEmpty (LocatedN RdrName)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsRecUpdField GhcPs GhcPs -> LocatedN RdrName
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))
-> LocatedN RdrName
forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl NonEmpty (LHsRecUpdField GhcPs GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
flds)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"possible_GREs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[NonEmpty Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((HsRecUpdParent GhcRn -> NonEmpty Name)
-> [HsRecUpdParent GhcRn] -> [NonEmpty Name]
forall a b. (a -> b) -> [a] -> [b]
map ((GlobalRdrElt -> Name) -> NonEmpty GlobalRdrElt -> NonEmpty Name
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName (NonEmpty GlobalRdrElt -> NonEmpty Name)
-> (HsRecUpdParent GhcRn -> NonEmpty GlobalRdrElt)
-> HsRecUpdParent GhcRn
-> NonEmpty Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecUpdParent GhcRn -> NonEmpty GlobalRdrElt
rnRecUpdLabels) [HsRecUpdParent GhcRn]
possible_GREs) ]
; case [HsRecUpdParent GhcRn]
possible_GREs of
{ HsRecUpdParent GhcRn
p1:[HsRecUpdParent GhcRn]
ps -> NonEmpty (HsRecUpdParent GhcRn)
-> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsRecUpdParent GhcRn
p1 HsRecUpdParent GhcRn
-> [HsRecUpdParent GhcRn] -> NonEmpty (HsRecUpdParent GhcRn)
forall a. a -> [a] -> NonEmpty a
NE.:| [HsRecUpdParent GhcRn]
ps)
; [HsRecUpdParent GhcRn]
_ ->
let
fld1_cons :: UniqSet ConLikeName
fld1_cons :: UniqSet ConLikeName
fld1_cons = [UniqSet ConLikeName] -> UniqSet ConLikeName
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
([UniqSet ConLikeName] -> UniqSet ConLikeName)
-> [UniqSet ConLikeName] -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName]
forall a. NonEmpty a -> [a]
NE.toList
(NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName])
-> NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> UniqSet ConLikeName)
-> NonEmpty GlobalRdrElt -> NonEmpty (UniqSet ConLikeName)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (RecFieldInfo -> UniqSet ConLikeName
recFieldCons (RecFieldInfo -> UniqSet ConLikeName)
-> (GlobalRdrElt -> RecFieldInfo)
-> GlobalRdrElt
-> UniqSet ConLikeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo) NonEmpty GlobalRdrElt
fld1_gres
fld1_cons_fields :: UniqFM ConLikeName [FieldLabel]
fld1_cons_fields :: UniqFM ConLikeName [FieldLabel]
fld1_cons_fields
= (ConLikeName -> [FieldLabel])
-> UniqFM ConLikeName ConLikeName
-> UniqFM ConLikeName [FieldLabel]
forall a b.
(a -> b) -> UniqFM ConLikeName a -> UniqFM ConLikeName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GlobalRdrEnv -> ConLikeName -> [FieldLabel]
lkp_con_fields GlobalRdrEnv
gre_env)
(UniqFM ConLikeName ConLikeName -> UniqFM ConLikeName [FieldLabel])
-> UniqFM ConLikeName ConLikeName
-> UniqFM ConLikeName [FieldLabel]
forall a b. (a -> b) -> a -> b
$ UniqSet ConLikeName -> UniqFM ConLikeName ConLikeName
forall a. UniqSet a -> UniqFM a a
getUniqSet UniqSet ConLikeName
fld1_cons
in TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a. TcRnMessage -> TcM a
failWithTc (TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn)))
-> TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a b. (a -> b) -> a -> b
$ [LHsRecUpdField GhcPs GhcPs]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
forall (p :: Pass) q.
OutputableBndrId p =>
[LHsRecUpdField (GhcPass p) q]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
badFieldsUpd (NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsRecUpdField GhcPs GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
flds) UniqFM ConLikeName [FieldLabel]
fld1_cons_fields } }
where
intersect_by_cons :: NE.NonEmpty FieldGlobalRdrElt
-> [NE.NonEmpty FieldGlobalRdrElt]
-> [HsRecUpdParent GhcRn]
intersect_by_cons :: NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
this [] =
(GlobalRdrElt -> HsRecUpdParent GhcRn)
-> [GlobalRdrElt] -> [HsRecUpdParent GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map
(\ GlobalRdrElt
fld -> NonEmpty GlobalRdrElt
-> UniqSet ConLikeName -> HsRecUpdParent GhcRn
RnRecUpdParent (GlobalRdrElt
fld GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| []) (RecFieldInfo -> UniqSet ConLikeName
recFieldCons (HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo GlobalRdrElt
fld)))
(NonEmpty GlobalRdrElt -> [GlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty GlobalRdrElt
this)
intersect_by_cons NonEmpty GlobalRdrElt
this (NonEmpty GlobalRdrElt
new : [NonEmpty GlobalRdrElt]
rest) =
[ NonEmpty GlobalRdrElt
-> UniqSet ConLikeName -> HsRecUpdParent GhcRn
RnRecUpdParent (GlobalRdrElt
this_fld GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty GlobalRdrElt
next_flds) UniqSet ConLikeName
both_cons
| GlobalRdrElt
this_fld <- NonEmpty GlobalRdrElt -> [GlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty GlobalRdrElt
this
, let this_cons :: UniqSet ConLikeName
this_cons = RecFieldInfo -> UniqSet ConLikeName
recFieldCons (RecFieldInfo -> UniqSet ConLikeName)
-> RecFieldInfo -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo GlobalRdrElt
this_fld
, RnRecUpdParent NonEmpty GlobalRdrElt
next_flds UniqSet ConLikeName
next_cons <- NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
new [NonEmpty GlobalRdrElt]
rest
, let both_cons :: UniqSet ConLikeName
both_cons = UniqSet ConLikeName
next_cons UniqSet ConLikeName -> UniqSet ConLikeName -> UniqSet ConLikeName
forall a. UniqSet a -> UniqSet a -> UniqSet a
`intersectUniqSets` UniqSet ConLikeName
this_cons
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UniqSet ConLikeName -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet ConLikeName
both_cons
]
lkp_con_fields :: GlobalRdrEnv -> ConLikeName -> [FieldLabel]
lkp_con_fields :: GlobalRdrEnv -> ConLikeName -> [FieldLabel]
lkp_con_fields GlobalRdrEnv
gre_env ConLikeName
con =
[ FieldLabel
fl
| let nm :: Name
nm = ConLikeName -> Name
conLikeName_Name ConLikeName
con
, GlobalRdrElt
gre <- Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a. Maybe a -> [a]
maybeToList (Maybe GlobalRdrElt -> [GlobalRdrElt])
-> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
gre_env Name
nm
, ConInfo
con_info <- Maybe ConInfo -> [ConInfo]
forall a. Maybe a -> [a]
maybeToList (Maybe ConInfo -> [ConInfo]) -> Maybe ConInfo -> [ConInfo]
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => GlobalRdrElt -> Maybe ConInfo
GlobalRdrElt -> Maybe ConInfo
recFieldConLike_maybe GlobalRdrElt
gre
, FieldLabel
fl <- ConInfo -> [FieldLabel]
conInfoFields ConInfo
con_info ]
getUpdFieldLbls :: forall p q. UnXRec (GhcPass p)
=> [LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls :: forall (p :: Pass) q.
UnXRec (GhcPass p) =>
[LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls
= (LHsRecUpdField (GhcPass p) q -> RdrName)
-> [LHsRecUpdField (GhcPass p) q] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map ((LHsRecUpdField (GhcPass p) q -> RdrName)
-> [LHsRecUpdField (GhcPass p) q] -> [RdrName])
-> (LHsRecUpdField (GhcPass p) q -> RdrName)
-> [LHsRecUpdField (GhcPass p) q]
-> [RdrName]
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName
(AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> AmbiguousFieldOcc (GhcPass p))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass p)
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> AmbiguousFieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass p)
badFieldsUpd
:: (OutputableBndrId p)
=> [LHsRecUpdField (GhcPass p) q]
-> UniqFM ConLikeName [FieldLabel]
-> TcRnMessage
badFieldsUpd :: forall (p :: Pass) q.
OutputableBndrId p =>
[LHsRecUpdField (GhcPass p) q]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
badFieldsUpd [LHsRecUpdField (GhcPass p) q]
rbinds UniqFM ConLikeName [FieldLabel]
fld1_cons_fields
= [RdrName] -> BadRecordUpdateReason -> TcRnMessage
TcRnBadRecordUpdate
([LHsRecUpdField (GhcPass p) q] -> [RdrName]
forall (p :: Pass) q.
UnXRec (GhcPass p) =>
[LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls [LHsRecUpdField (GhcPass p) q]
rbinds)
([FieldLabelString] -> BadRecordUpdateReason
NoConstructorHasAllFields [FieldLabelString]
conflictingFields)
where
conflictingFields :: [FieldLabelString]
conflictingFields = case [(FieldLabelString, [Bool])]
nonMembers of
(FieldLabelString
nonMember, [Bool]
_) : [(FieldLabelString, [Bool])]
_ -> [FieldLabelString
aMember, FieldLabelString
nonMember]
[] -> let
growingSets :: [(FieldLabelString, [Bool])]
growingSets :: [(FieldLabelString, [Bool])]
growingSets = ((FieldLabelString, [Bool])
-> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]))
-> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 (FieldLabelString, [Bool])
-> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool])
forall {a} {a}. (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
combine [(FieldLabelString, [Bool])]
membership
combine :: (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
combine (a
_, [Bool]
setMem) (a
field, [Bool]
fldMem)
= (a
field, (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(&&) [Bool]
setMem [Bool]
fldMem)
in
([(FieldLabelString, [Bool])] -> FieldLabelString)
-> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldLabelString, [Bool]) -> FieldLabelString
forall a b. (a, b) -> a
fst ((FieldLabelString, [Bool]) -> FieldLabelString)
-> ([(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool]))
-> [(FieldLabelString, [Bool])]
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool])
forall a. HasCallStack => [a] -> a
head) ([[(FieldLabelString, [Bool])]] -> [FieldLabelString])
-> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
forall a b. (a -> b) -> a -> b
$ ((FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]) -> Bool)
-> [(FieldLabelString, [Bool])] -> [[(FieldLabelString, [Bool])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Bool] -> [Bool] -> Bool)
-> ((FieldLabelString, [Bool]) -> [Bool])
-> (FieldLabelString, [Bool])
-> (FieldLabelString, [Bool])
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FieldLabelString, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd) [(FieldLabelString, [Bool])]
growingSets
aMember :: FieldLabelString
aMember = Bool
-> ((FieldLabelString, [Bool]) -> FieldLabelString)
-> (FieldLabelString, [Bool])
-> FieldLabelString
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ([(FieldLabelString, [Bool])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, [Bool])]
members) ) (FieldLabelString, [Bool]) -> FieldLabelString
forall a b. (a, b) -> a
fst ([(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool])
forall a. HasCallStack => [a] -> a
head [(FieldLabelString, [Bool])]
members)
([(FieldLabelString, [Bool])]
members, [(FieldLabelString, [Bool])]
nonMembers) = ((FieldLabelString, [Bool]) -> Bool)
-> [(FieldLabelString, [Bool])]
-> ([(FieldLabelString, [Bool])], [(FieldLabelString, [Bool])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ((FieldLabelString, [Bool]) -> [Bool])
-> (FieldLabelString, [Bool])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabelString, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd) [(FieldLabelString, [Bool])]
membership
membership :: [(FieldLabelString, [Bool])]
membership :: [(FieldLabelString, [Bool])]
membership
= [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall {a}. [(a, [Bool])] -> [(a, [Bool])]
sortMembership ([(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])])
-> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall a b. (a -> b) -> a -> b
$
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> (FieldLabelString, [Bool]))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))]
-> [(FieldLabelString, [Bool])]
forall a b. (a -> b) -> [a] -> [b]
map
( (\FieldLabelString
fld -> (FieldLabelString
fld, (UniqSet FieldLabelString -> Bool)
-> [UniqSet FieldLabelString] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabelString
fld FieldLabelString -> UniqSet FieldLabelString -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet`) [UniqSet FieldLabelString]
fieldLabelSets))
(FieldLabelString -> (FieldLabelString, [Bool]))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FieldLabelString)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> (FieldLabelString, [Bool])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FastString)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> OccName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> RdrName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> LocatedN RdrName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> LocatedN RdrName
forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl )
[LHsRecUpdField (GhcPass p) q]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc (GhcPass p)))
(XRec q (HsExpr q)))]
rbinds
fieldLabelSets :: [UniqSet FieldLabelString]
fieldLabelSets :: [UniqSet FieldLabelString]
fieldLabelSets = ([FieldLabel] -> UniqSet FieldLabelString)
-> [[FieldLabel]] -> [UniqSet FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map ([FieldLabelString] -> UniqSet FieldLabelString
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([FieldLabelString] -> UniqSet FieldLabelString)
-> ([FieldLabel] -> [FieldLabelString])
-> [FieldLabel]
-> UniqSet FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabel -> FieldLabelString)
-> [FieldLabel] -> [FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FieldLabelString
flLabel) ([[FieldLabel]] -> [UniqSet FieldLabelString])
-> [[FieldLabel]] -> [UniqSet FieldLabelString]
forall a b. (a -> b) -> a -> b
$ UniqFM ConLikeName [FieldLabel] -> [[FieldLabel]]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM ConLikeName [FieldLabel]
fld1_cons_fields
sortMembership :: [(a, [Bool])] -> [(a, [Bool])]
sortMembership =
((Arity, (a, [Bool])) -> (a, [Bool]))
-> [(Arity, (a, [Bool]))] -> [(a, [Bool])]
forall a b. (a -> b) -> [a] -> [b]
map (Arity, (a, [Bool])) -> (a, [Bool])
forall a b. (a, b) -> b
snd ([(Arity, (a, [Bool]))] -> [(a, [Bool])])
-> ([(a, [Bool])] -> [(Arity, (a, [Bool]))])
-> [(a, [Bool])]
-> [(a, [Bool])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Arity, (a, [Bool])) -> (Arity, (a, [Bool])) -> Ordering)
-> [(Arity, (a, [Bool]))] -> [(Arity, (a, [Bool]))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Arity -> Arity -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Arity -> Arity -> Ordering)
-> ((Arity, (a, [Bool])) -> Arity)
-> (Arity, (a, [Bool]))
-> (Arity, (a, [Bool]))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Arity, (a, [Bool])) -> Arity
forall a b. (a, b) -> a
fst) ([(Arity, (a, [Bool]))] -> [(Arity, (a, [Bool]))])
-> ([(a, [Bool])] -> [(Arity, (a, [Bool]))])
-> [(a, [Bool])]
-> [(Arity, (a, [Bool]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((a, [Bool]) -> (Arity, (a, [Bool])))
-> [(a, [Bool])] -> [(Arity, (a, [Bool]))]
forall a b. (a -> b) -> [a] -> [b]
map (\ item :: (a, [Bool])
item@(a
_, [Bool]
membershipRow) -> ([Bool] -> Arity
countTrue [Bool]
membershipRow, (a, [Bool])
item))
countTrue :: [Bool] -> Arity
countTrue = (Bool -> Bool) -> [Bool] -> Arity
forall a. (a -> Bool) -> [a] -> Arity
count Bool -> Bool
forall a. a -> a
id
data GreLookupResult = GreNotFound
| OneNameMatch GlobalRdrElt
| MultipleNames (NE.NonEmpty GlobalRdrElt)
lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name
= do
GreLookupResult
res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper WhichGREs GREInfo
which_gres RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
case GreLookupResult
res of
OneNameMatch GlobalRdrElt
gre -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
MultipleNames NonEmpty GlobalRdrElt
gres -> do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreRn_maybe:NameClash" (NonEmpty GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonEmpty GlobalRdrElt
gres)
RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)
GreLookupResult
GreNotFound -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper :: WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper WhichGREs GREInfo
which_gres RdrName
rdr_name DeprecationWarnings
warn_if_deprec
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr_name WhichGREs GREInfo
which_gres) of
[] -> GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GreLookupResult
GreNotFound
[GlobalRdrElt
gre] -> do { DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
gre
; GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> GreLookupResult
OneNameMatch GlobalRdrElt
gre) }
(GlobalRdrElt
gre:[GlobalRdrElt]
others) -> GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty GlobalRdrElt -> GreLookupResult
MultipleNames (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
others)) }
lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreAvailRn RdrName
rdr_name
= do
GreLookupResult
mb_gre <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
ExportDeprecationWarnings
case GreLookupResult
mb_gre of
GreLookupResult
GreNotFound ->
do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreAvailRn" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
Name
_ <- LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Global) RdrName
rdr_name
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
MultipleNames NonEmpty GlobalRdrElt
gres ->
do
RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
OneNameMatch GlobalRdrElt
gre ->
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
addUsedDataCons :: GlobalRdrEnv -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedDataCons GlobalRdrEnv
rdr_env TyCon
tycon
= DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs DeprecationWarnings
NoDeprecationWarnings
[ GlobalRdrElt
gre
| DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tycon
, Just GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
dc)] ]
data DeprecationWarnings
= NoDeprecationWarnings
| ExportDeprecationWarnings
| AllDeprecationWarnings
addUsedGRE :: DeprecationWarnings -> GlobalRdrElt -> RnM ()
addUsedGRE :: DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
gre
= do { DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
condWarnIfDeprecated DeprecationWarnings
warn_if_deprec [GlobalRdrElt
gre]
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isImportedGRE GlobalRdrElt
gre) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGRE" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
; TcRef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => TcRef a -> (a -> a) -> m ()
updTcRef (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:) } }
addUsedGREs :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
addUsedGREs :: DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs DeprecationWarnings
warn_if_deprec [GlobalRdrElt]
gres
= do { DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
condWarnIfDeprecated DeprecationWarnings
warn_if_deprec [GlobalRdrElt]
gres
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
imp_gres) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGREs" ([Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Name] -> SDoc) -> [Name] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
imp_gres)
; TcRef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => TcRef a -> (a -> a) -> m ()
updTcRef (TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) ([GlobalRdrElt]
imp_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++) } }
where
imp_gres :: [GlobalRdrElt]
imp_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isImportedGRE [GlobalRdrElt]
gres
condWarnIfDeprecated :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
condWarnIfDeprecated :: DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
condWarnIfDeprecated DeprecationWarnings
NoDeprecationWarnings [GlobalRdrElt]
_ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
condWarnIfDeprecated DeprecationWarnings
opt [GlobalRdrElt]
gres = do
Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
let external_gres :: [GlobalRdrElt]
external_gres
= (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) [GlobalRdrElt]
gres
(GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GlobalRdrElt
gre -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfExportDeprecated GlobalRdrElt
gre IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
maybeWarnDeclDepr GlobalRdrElt
gre) [GlobalRdrElt]
external_gres
where
maybeWarnDeclDepr :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
maybeWarnDeclDepr = case DeprecationWarnings
opt of
DeprecationWarnings
ExportDeprecationWarnings -> IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. a -> b -> a
const (IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DeprecationWarnings
AllDeprecationWarnings -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeclDeprecated
warnIfDeclDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeclDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeclDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss })
| Just ImportSpec
imp_spec <- Bag ImportSpec -> Maybe ImportSpec
forall a. Bag a -> Maybe a
headMaybe Bag ImportSpec
iss
= do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Bool
wopt_any_custom DynFlags
dflags) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
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)
lookupImpDeclDeprec ModIface
iface GlobalRdrElt
gre of
Just WarningTxt GhcRn
deprText -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnPragmaWarning {
pragma_warning_occ :: OccName
pragma_warning_occ = OccName
occ,
pragma_warning_msg :: WarningTxt GhcRn
pragma_warning_msg = WarningTxt GhcRn
deprText,
pragma_warning_import_mod :: ModuleName
pragma_warning_import_mod = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec,
pragma_warning_defined_mod :: Maybe ModuleName
pragma_warning_defined_mod = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
definedMod
}
Maybe (WarningTxt GhcRn)
Nothing -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return () } }
| Bool
otherwise
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
definedMod :: ModuleName
definedMod = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> Module -> Module
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is mentioned explicitly"
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec ModIface
iface GlobalRdrElt
gre
= ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre) Maybe (WarningTxt GhcRn)
-> Maybe (WarningTxt GhcRn) -> Maybe (WarningTxt GhcRn)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre of
ParentIs Name
p -> ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (Name -> OccName
nameOccName Name
p)
Parent
NoParent -> Maybe (WarningTxt GhcRn)
forall a. Maybe a
Nothing
warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
warnIfExportDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfExportDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp = Bag ImportSpec
iss })
= do { Bag (Maybe (ModuleName, WarningTxt GhcRn))
mod_warn_mbs <- (ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn)))
-> Bag ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (Maybe (ModuleName, WarningTxt GhcRn)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec Bag ImportSpec
iss
; Maybe (Bag (ModuleName, WarningTxt GhcRn))
-> (Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ()))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Bag (Maybe (ModuleName, WarningTxt GhcRn))
-> Maybe (Bag (ModuleName, WarningTxt GhcRn))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
sequence Bag (Maybe (ModuleName, WarningTxt GhcRn))
mod_warn_mbs) ((Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ()))
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ()))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ ((ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapM
(((ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ()))
-> ((ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Bag (ModuleName, WarningTxt GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bag ())
forall a b. (a -> b) -> a -> b
$ \(ModuleName
importing_mod, WarningTxt GhcRn
warn_txt) -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnPragmaWarning {
pragma_warning_occ :: OccName
pragma_warning_occ = OccName
occ,
pragma_warning_msg :: WarningTxt GhcRn
pragma_warning_msg = WarningTxt GhcRn
warn_txt,
pragma_warning_import_mod :: ModuleName
pragma_warning_import_mod = ModuleName
importing_mod,
pragma_warning_defined_mod :: Maybe ModuleName
pragma_warning_defined_mod = Maybe ModuleName
forall a. Maybe a
Nothing
} }
where
occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is mentioned explicitly"
process_import_spec :: ImportSpec -> RnM (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec :: ImportSpec
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec ImportSpec
is = do
let mod :: Module
mod = ImpDeclSpec -> Module
is_mod (ImpDeclSpec -> Module) -> ImpDeclSpec -> Module
forall a b. (a -> b) -> a -> b
$ ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is
ModIface
iface <- SDoc -> Module -> TcRn ModIface
loadInterfaceForModule SDoc
doc Module
mod
let mb_warn_txt :: Maybe (WarningTxt GhcRn)
mb_warn_txt = ModIfaceBackend -> Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) Name
name
Maybe (ModuleName, WarningTxt GhcRn)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ModuleName, WarningTxt GhcRn)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn)))
-> Maybe (ModuleName, WarningTxt GhcRn)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Maybe (ModuleName, WarningTxt GhcRn))
forall a b. (a -> b) -> a -> b
$ (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod, ) (WarningTxt GhcRn -> (ModuleName, WarningTxt GhcRn))
-> Maybe (WarningTxt GhcRn) -> Maybe (ModuleName, WarningTxt GhcRn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WarningTxt GhcRn)
mb_warn_txt
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name = do
[GlobalRdrElt]
all_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
case [GlobalRdrElt]
all_gres of
[] -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
[GlobalRdrElt
gre] -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (GlobalRdrElt -> Maybe GlobalRdrElt)
-> GlobalRdrElt -> Maybe GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
gre
(GlobalRdrElt
gre:[GlobalRdrElt]
gres) ->
do RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres)
Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (OccName -> GlobalRdrElt
mkUnboundGRE (OccName -> GlobalRdrElt) -> OccName -> GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre))
lookupQualifiedNameGHCi :: HasDebugCallStack => FieldsOrSelectors -> RdrName -> RnM [GlobalRdrElt]
lookupQualifiedNameGHCi :: HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
=
do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool
is_ghci <- TcRnIf TcGblEnv TcLclEnv Bool
getIsGHCi
; DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
go_for_it DynFlags
dflags Bool
is_ghci }
where
go_for_it :: DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
go_for_it DynFlags
dflags Bool
is_ghci
| Just (ModuleName
mod_name,OccName
occ) <- RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name
, let ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
, Bool
is_ghci
, GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ImplicitImportQualified DynFlags
dflags
, Bool -> Bool
not (DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)
= do { MaybeErr MissingInterfaceError ModIface
res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod_name IsBootInterface
NotBoot PkgQual
NoPkgQual
; case MaybeErr MissingInterfaceError ModIface
res of
Succeeded ModIface
iface
-> do { HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; let gres :: [GlobalRdrElt]
gres =
[ GlobalRdrElt
gre
| IfaceExport
avail <- ModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface
, Name
gname <- IfaceExport -> [Name]
availNames IfaceExport
avail
, let lk_occ :: OccName
lk_occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
gname
lk_ns :: NameSpace
lk_ns = OccName -> NameSpace
occNameSpace OccName
lk_occ
, OccName -> FastString
occNameFS OccName
occ FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS OccName
lk_occ
, NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
lk_ns Bool -> Bool -> Bool
|| (NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
varName Bool -> Bool -> Bool
&& NameSpace -> Bool
isFieldNameSpace NameSpace
lk_ns)
, let mod :: Module
mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
gre :: GlobalRdrElt
gre = Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE Module
mod HscEnv
hsc_env Name
gname
, FieldsOrSelectors -> GlobalRdrElt -> Bool
allowGRE FieldsOrSelectors
fos GlobalRdrElt
gre
]
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [GlobalRdrElt]
gres }
MaybeErr MissingInterfaceError ModIface
_ ->
do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] } }
| Bool
otherwise
= do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi: off" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Need to find" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE Module
mod HscEnv
hsc_env Name
nm =
GRE { gre_name :: Name
gre_name = Name
nm
, gre_par :: Parent
gre_par = Parent
NoParent
, gre_lcl :: Bool
gre_lcl = Bool
False
, gre_imp :: Bag ImportSpec
gre_imp = ImportSpec -> Bag ImportSpec
forall a. a -> Bag a
unitBag ImportSpec
is
, gre_info :: GREInfo
gre_info = GREInfo
info }
where
info :: GREInfo
info = HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
nm
spec :: ImpDeclSpec
spec = ImpDeclSpec { is_mod :: Module
is_mod = Module
mod, is_as :: ModuleName
is_as = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod, is_qual :: Bool
is_qual = Bool
True, is_dloc :: SrcSpan
is_dloc = SrcSpan
noSrcSpan }
is :: ImportSpec
is = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
lookupGREInfo :: HasDebugCallStack => HscEnv -> Name -> GREInfo
lookupGREInfo :: HasDebugCallStack => HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
nm
| Just TyThing
ty_thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
nm
= TyThing -> GREInfo
tyThingGREInfo TyThing
ty_thing
| Bool
otherwise
= case Name -> Maybe Module
nameModule_maybe Name
nm of
Maybe Module
Nothing -> GREInfo
UnboundGRE
Just Module
mod ->
IO GREInfo -> GREInfo
forall a. IO a -> a
unsafePerformIO (IO GREInfo -> GREInfo) -> IO GREInfo -> GREInfo
forall a b. (a -> b) -> a -> b
$ do
MaybeErr MissingInterfaceError ModIface
_ <- HscEnv
-> IfG (MaybeErr MissingInterfaceError ModIface)
-> IO (MaybeErr MissingInterfaceError ModIface)
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
hsc_env (IfG (MaybeErr MissingInterfaceError ModIface)
-> IO (MaybeErr MissingInterfaceError ModIface))
-> IfG (MaybeErr MissingInterfaceError ModIface)
-> IO (MaybeErr MissingInterfaceError ModIface)
forall a b. (a -> b) -> a -> b
$
SDoc
-> Module
-> WhereFrom
-> IfG (MaybeErr MissingInterfaceError ModIface)
forall lcl.
SDoc
-> Module
-> WhereFrom
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
loadInterface (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookupGREInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm))
Module
mod WhereFrom
ImportBySystem
Maybe TyThing
mb_ty_thing <- HscEnv -> Name -> IO (Maybe TyThing)
lookupType HscEnv
hsc_env Name
nm
case Maybe TyThing
mb_ty_thing of
Maybe TyThing
Nothing -> String -> SDoc -> IO GREInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupGREInfo" (SDoc -> IO GREInfo) -> SDoc -> IO GREInfo
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookup failed:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm ]
Just TyThing
ty_thing -> GREInfo -> IO GREInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GREInfo -> IO GREInfo) -> GREInfo -> IO GREInfo
forall a b. (a -> b) -> a -> b
$ TyThing -> GREInfo
tyThingGREInfo TyThing
ty_thing
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
forall doc. IsLine doc => String -> doc
text String
"TopSigCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (LocalBindCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalBindCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (ClsDeclCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ClsDeclCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
ppr (InstDeclCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InstDeclCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (HsBootCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsBootCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (RoleAnnotCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RoleAnnotCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> 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)
forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (SrcSpanAnn' ann) RdrName
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> 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)
forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (SrcSpanAnn' ann) RdrName
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcPs
sig)
lookupSigCtxtOccRn :: HsSigCtxt
-> SDoc
-> GenLocated (SrcSpanAnn' ann) RdrName
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn :: forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (SrcSpanAnn' ann) RdrName
-> RnM (GenLocated (SrcSpanAnn' ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt SDoc
what
= (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA ((RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name))
-> (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { let also_try_tycons :: Bool
also_try_tycons = Bool
False
; NonEmpty (Either NotInScopeError Name)
mb_names <- HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycons
; case NonEmpty (Either NotInScopeError Name)
mb_names of
Right Name
name NE.:| [Either NotInScopeError Name]
rest ->
do { Bool -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr ([Either NotInScopeError Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either NotInScopeError Name]
rest) (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookupSigCtxtOccRn" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Either NotInScopeError Name -> SDoc)
-> [Either NotInScopeError Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((NotInScopeError -> SDoc)
-> (Name -> SDoc) -> Either NotInScopeError Name -> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
rdr_name) Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Either NotInScopeError Name]
rest)
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
Left NotInScopeError
err NE.:| [Either NotInScopeError Name]
_ ->
do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
err)
; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
}
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> RnM (NE.NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycon_ns
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= do { Either NotInScopeError GlobalRdrElt
mb_gre <- Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
n
; NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ case Either NotInScopeError GlobalRdrElt
mb_gre of
Left NotInScopeError
err -> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left NotInScopeError
err
Right GlobalRdrElt
gre -> NotInScopeError
-> GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
finish (Name -> NotInScopeError
NoExactName (Name -> NotInScopeError) -> Name -> NotInScopeError
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre) GlobalRdrElt
gre }
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> (Name -> Either NotInScopeError Name)
-> Name
-> NonEmpty (Either NotInScopeError Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> NonEmpty (Either NotInScopeError Name))
-> RnM Name -> RnM (NonEmpty (Either NotInScopeError Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ }
| Bool
otherwise
= case HsSigCtxt
ctxt of
HsBootCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
TopSigCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
LocalBindCtxt NameSet
ns -> NameSet -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_group NameSet
ns
ClsDeclCtxt Name
cls -> Name -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_cls_op Name
cls
InstDeclCtxt NameSet
ns -> if (Name -> Bool) -> NameSet -> Bool
forall a. (a -> Bool) -> UniqSet a -> Bool
uniqSetAny Name -> Bool
isUnboundName NameSet
ns
then NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> Name -> Either NotInScopeError Name
forall a b. (a -> b) -> a -> b
$ RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
else (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
where
ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
relevant_gres :: WhichGREs GREInfo
relevant_gres =
RelevantGREs
{ includeFieldSelectors :: FieldsOrSelectors
includeFieldSelectors = FieldsOrSelectors
WantBoth
, lookupVariablesForFields :: Bool
lookupVariablesForFields = Bool
True
, lookupTyConsAsWell :: Bool
lookupTyConsAsWell = Bool
also_try_tycon_ns }
ok_gre :: GlobalRdrElt -> Bool
ok_gre = WhichGREs GREInfo -> NameSpace -> GlobalRdrElt -> Bool
greIsRelevant WhichGREs GREInfo
relevant_gres NameSpace
ns
finish :: NotInScopeError
-> GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
finish NotInScopeError
err GlobalRdrElt
gre
| GlobalRdrElt -> Bool
ok_gre GlobalRdrElt
gre
= Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> Name -> Either NotInScopeError Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
| Bool
otherwise
= Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left NotInScopeError
err)
lookup_cls_op :: Name -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_cls_op Name
cls
= Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> RnM (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc DeprecationWarnings
AllDeprecationWarnings Name
cls SDoc
doc RdrName
rdr_name
where
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"method of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)
lookup_top :: (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top Name -> Bool
keep_me
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
all_gres :: [GlobalRdrElt]
all_gres = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (OccName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. OccName -> WhichGREs info -> LookupGRE info
LookupOccName OccName
occ WhichGREs GREInfo
relevant_gres)
names_in_scope :: [Name]
names_in_scope =
(GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName
([GlobalRdrElt] -> [Name]) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobalRdrElt -> Bool
ok_gre (GlobalRdrElt -> Bool)
-> (GlobalRdrElt -> Bool) -> GlobalRdrElt -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<&&> GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE)
([GlobalRdrElt] -> [GlobalRdrElt])
-> [GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> [GlobalRdrElt]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts GlobalRdrEnv
env
candidates_msg :: [GhcHint]
candidates_msg = [Name] -> [GhcHint]
candidates [Name]
names_in_scope
; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep_me (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) [GlobalRdrElt]
all_gres of
[] | [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
candidates_msg
| Bool
otherwise -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
local_msg
(GlobalRdrElt
gre1:[GlobalRdrElt]
gres) -> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GlobalRdrElt -> Either NotInScopeError Name)
-> NonEmpty GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> (GlobalRdrElt -> Name)
-> GlobalRdrElt
-> Either NotInScopeError Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) (GlobalRdrElt
gre1 GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres)) }
lookup_group :: NameSet -> RnM (NonEmpty (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 ([Name] -> [GhcHint]) -> [Name] -> [GhcHint]
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 -> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right Name
n
| Bool
otherwise -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
local_msg
Maybe Name
Nothing -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
candidates_msg }
bale_out_with :: [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
hints = NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (NotInScopeError -> Either NotInScopeError Name)
-> NotInScopeError -> Either NotInScopeError Name
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) <- (Name -> SimilarName) -> [Name] -> [SimilarName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SimilarName
SimilarName [Name]
similar_names
= [RdrName -> NonEmpty SimilarName -> GhcHint
SuggestSimilarNames RdrName
rdr_name (SimilarName
nm SimilarName -> [SimilarName] -> NonEmpty SimilarName
forall a. a -> [a] -> NonEmpty a
NE.:| [SimilarName]
nms)]
| Bool
otherwise
= []
where
similar_names :: [Name]
similar_names
= String -> [(String, Name)] -> [Name]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FastString -> String
unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
([(String, Name)] -> [Name]) -> [(String, Name)] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> (String, Name)) -> [Name] -> [(String, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
x -> ((FastString -> String
unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
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
= do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; let also_try_tycon_ns :: Bool
also_try_tycon_ns = Bool
True
; NonEmpty (Either TcRnMessage (RdrName, Name))
nms_eithers <- (Either NotInScopeError Name -> Either TcRnMessage (RdrName, Name))
-> NonEmpty (Either NotInScopeError Name)
-> NonEmpty (Either TcRnMessage (RdrName, Name))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module
-> RdrName
-> Either NotInScopeError Name
-> Either TcRnMessage (RdrName, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr) (NonEmpty (Either NotInScopeError Name)
-> NonEmpty (Either TcRnMessage (RdrName, Name)))
-> RnM (NonEmpty (Either NotInScopeError Name))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(NonEmpty (Either TcRnMessage (RdrName, Name)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr Bool
also_try_tycon_ns
; let ([TcRnMessage]
errs, [(RdrName, Name)]
names) = [Either TcRnMessage (RdrName, Name)]
-> ([TcRnMessage], [(RdrName, Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (NonEmpty (Either TcRnMessage (RdrName, Name))
-> [Either TcRnMessage (RdrName, Name)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Either TcRnMessage (RdrName, Name))
nms_eithers)
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(RdrName, Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RdrName, Name)]
names) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr ([TcRnMessage] -> TcRnMessage
forall a. HasCallStack => [a] -> a
head [TcRnMessage]
errs)
; [(RdrName, Name)] -> RnM [(RdrName, Name)]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(RdrName, Name)]
names }
where
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 (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
rdr)
, Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
= TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. a -> Either a b
Left (TcRnMessage -> Either TcRnMessage (RdrName, Name))
-> TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. (a -> b) -> a -> b
$ SDoc -> RdrName -> TcRnMessage
TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr
| Bool
otherwise
= (RdrName, Name) -> Either TcRnMessage (RdrName, Name)
forall a b. b -> Either a b
Right (RdrName
rdr, Name
name)
guard_builtin_syntax Module
_ RdrName
_ (Left NotInScopeError
err)
= TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. a -> Either a b
Left (TcRnMessage -> Either TcRnMessage (RdrName, Name))
-> TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. (a -> b) -> a -> b
$ RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr 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 <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on
then Maybe Name -> RnM (Maybe Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
else do { Name
ite <- RdrName -> RnM Name
lookupOccRnNone (FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"ifThenElse"))
; Maybe Name -> RnM (Maybe Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
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 <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebind
then (Name, NameSet) -> RnM (Name, NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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))
; (Name, NameSet) -> RnM (Name, NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
; (HsExpr GhcRn, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IdP GhcRn -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar IdP GhcRn
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
; (SyntaxExprRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on then
([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (LocatedN Name -> HsExpr GhcRn)
-> (Name -> LocatedN Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedN Name
forall a an. a -> LocatedAn an a
noLocA) [Name]
std_names, NameSet
emptyFVs)
else
do { [Name]
usr_names <-
(Name -> RnM Name) -> [Name] -> RnM [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RdrName -> RnM Name
lookupOccRnNone (RdrName -> RnM Name) -> (Name -> RdrName) -> Name -> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (Name -> OccName) -> Name -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
std_names
; ([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (LocatedN Name -> HsExpr GhcRn)
-> (Name -> LocatedN Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedN Name
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
= (Name -> HsExpr GhcRn)
-> (Name, NameSet) -> (HsExpr GhcRn, NameSet)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first IdP GhcRn -> HsExpr GhcRn
Name -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar ((Name, NameSet) -> (HsExpr GhcRn, NameSet))
-> RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext p -> Name -> RnM (Name, NameSet)
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
= (HsExpr GhcRn -> SyntaxExprRn)
-> (HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr ((HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet))
-> RnM (HsExpr GhcRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
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))
; (Name, NameSet) -> RnM (Name, NameSet)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 HsStmtContext p -> Maybe ModuleName
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