{-# 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,
irrefutableConLikeRn, irrefutableConLikeTc,
lookupGreAvailRn,
lookupSyntax, lookupSyntaxExpr, lookupSyntaxNames,
lookupSyntaxName,
lookupIfThenElse,
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.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.DSet
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import GHC.Utils.Panic
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.CompleteMatch
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 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 { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; unless (this_mod == nameModule name)
(addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
; return name }
else
do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; externaliseName this_mod name }
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
(addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
; newGlobalBinder rdr_mod rdr_occ (locA 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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name))
; stage <- TcM ThStage
getStage
; if isBrackStage stage then
do { uniq <- newUnique
; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) }
else
do { this_mod <- getModule
; traceRn "newTopSrcBinder" (ppr this_mod $$ ppr rdr_name $$ ppr (locA loc))
; newGlobalBinder this_mod (rdrNameOcc rdr_name) (locA 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 { op_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) })
; env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS 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 t a b.
HasLoc t =>
(a -> TcM b) -> GenLocated t 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 (EpAnn ann) a -> TcRn (GenLocated (EpAnn 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 t a b.
HasLoc t =>
(a -> TcM b) -> GenLocated t 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 (EpAnn ann) a -> TcRn (GenLocated (EpAnn 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, TupleSort -> GREInfo
mkInfo)
<- case TyThing
thing of
ATyCon TyCon
tc ->
(TyCon, TupleSort -> GREInfo)
-> Maybe (TyCon, TupleSort -> GREInfo)
forall a. a -> Maybe a
Just (TyCon
tc, TyConFlavour Name -> GREInfo
IAmTyCon (TyConFlavour Name -> GREInfo)
-> (TupleSort -> TyConFlavour Name) -> TupleSort -> GREInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boxity -> TyConFlavour Name
forall tc. Boxity -> TyConFlavour tc
TupleFlavour (Boxity -> TyConFlavour Name)
-> (TupleSort -> Boxity) -> TupleSort -> TyConFlavour Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TupleSort -> Boxity
tupleSortBoxity)
AConLike (RealDataCon DataCon
dc) ->
let tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
in (TyCon, TupleSort -> GREInfo)
-> Maybe (TyCon, TupleSort -> GREInfo)
forall a. a -> Maybe a
Just (TyCon
tc, ConInfo -> GREInfo
IAmConLike (ConInfo -> GREInfo)
-> (TupleSort -> ConInfo) -> TupleSort -> GREInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ TupleSort
_ -> ConLikeInfo -> Arity -> [FieldLabel] -> ConInfo
mkConInfo ([Name] -> ConLikeInfo
ConIsData ([Name] -> ConLikeInfo) -> [Name] -> ConLikeInfo
forall a b. (a -> b) -> a -> b
$ (DataCon -> Name) -> [DataCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Name
dataConName ([DataCon] -> [Name]) -> [DataCon] -> [Name]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc) (DataCon -> Arity
dataConSourceArity DataCon
dc) []))
TyThing
_ -> Maybe (TyCon, TupleSort -> GREInfo)
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 = TupleSort -> GREInfo
mkInfo TupleSort
tupleSort
; 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 { info <- Name -> RnM GREInfo
lookupExternalExactName Name
name
; return $ Right $ mkExactGRE name info }
| Bool
otherwise
= Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name
lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName Name
name
= do { 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
; return $ tyThingGREInfo thing }
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name
= do { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let lk = LookupExactName { lookupExactName :: Name
lookupExactName = Name
name
, lookInAllNameSpaces :: Bool
lookInAllNameSpaces = Bool
True }
; case lookupGRE env 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 { lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; let gre = Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE Parent
NoParent Name
name
; if name `inLocalRdrEnvScope` lcl_env
then return (Right gre)
else
do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
; th_topnames <- readTcRef th_topnames_var
; if name `elemNameSet` th_topnames
then return (Right gre)
else return (Left (NoExactName 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))
; mb_name <- DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc
DeprecationWarnings
NoDeprecationWarnings
Name
cls SDoc
doc RdrName
rdr
; case 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 (EpAnn ann) a -> TcRn (GenLocated (EpAnn 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 (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn 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 { info <- HasDebugCallStack => Name -> RnM GREInfo
Name -> RnM GREInfo
lookupGREInfo_GRE Name
con_name
; case 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 -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a b. (a -> b) -> a -> b
$ ConLikeInfo -> ConFieldInfo -> ConInfo
ConInfo ([Name] -> ConLikeInfo
ConIsData []) ConFieldInfo
ConHasPositionalArgs
IAmTyCon {} -> WhatLooking -> Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. WhatLooking -> Name -> TcM a
failIllegalTyCon WhatLooking
WL_Constructor Name
con_name
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 { men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case 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 { men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case 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 { nm <- Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
; this_mod <- getModule
; mb_gre <-
if nameIsLocalOrFrom this_mod nm
then lookupLocalExactGRE nm
else do { info <- lookupExternalExactName nm
; return $ Right $ mkExactGRE nm info }
; return $ case 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)
; 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 { flds <- HasDebugCallStack => Name -> RnM [FieldLabel]
Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
; env <- getGlobalRdrEnv
; let mb_gre = do 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
gre <- lookupGRE_FieldLabel env fl
if isQual rdr_name
then listToMaybe $ pickGREs rdr_name [gre]
else return gre
; traceRn "lookupRecFieldOcc" $
vcat [ text "mb_con:" <+> ppr mb_con
, text "rdr_name:" <+> ppr rdr_name
, text "flds:" <+> ppr flds
, text "mb_gre:" <+> ppr mb_gre ]
; mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
; return $ flSelector . fieldGRELabel <$> mb_gre }
; case 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
= FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' 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
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
let 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)
picked_gres = [GlobalRdrElt] -> DisambigInfo
pick_gres [GlobalRdrElt]
original_gres
traceRn "parent" (ppr parent)
traceRn "lookupExportChild original_gres:" (ppr original_gres)
traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent)
case picked_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)
dup_fields_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
case 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))
pick_gres :: [GlobalRdrElt] -> DisambigInfo
pick_gres :: [GlobalRdrElt] -> DisambigInfo
pick_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
gre
= case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre of
ParentIs Name
cur_parent
| Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
gre
| Bool
otherwise -> DisambigInfo
NoOccurrence
Parent
NoParent -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
gre
{-# 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 { 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
; return $ case 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 (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRn
lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnConstr
lookupLocatedOccRnRecField :: GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnRecField :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnRecField = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnRecField
lookupLocatedOccRnNone :: GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnNone :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnNone = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn 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 { local_env <- RnM LocalRdrEnv
getLocalRdrEnv
; return (lookupLocalRdrEnv local_env rdr_name) }
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, Arity))
lookupLocalOccThLvl_maybe Name
name
= do { lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
; return (lookupNameEnv (getLclEnvThBndrs lcl_env) name) }
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
which_suggest RdrName
rdr_name
= do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
; case 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 RdrName
rdr_name
= do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
; case 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 -> do
{ mb_ty_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
; case mb_ty_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
WL_Constructor RdrName
rdr_name} }
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 { mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; case 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
= do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
; case 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 { data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
; star_is_type <- xoptM LangExt.StarIsType
; let is_star_type = if Bool
star_is_type then StarIsType
StarIsType else StarIsType
StarIsNotType
star_is_type_hints = StarIsType -> RdrName -> [GhcHint]
noStarIsTypeHints StarIsType
is_star_type RdrName
rdr_name
; if data_kinds
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr
; case 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 {
mb_demoted_name <- discardErrs $
lookupOccRn_maybe demoted_rdr
; let 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
; unboundNameX looking_for rdr_name suggestion } }
| RdrName -> Bool
isQual RdrName
rdr_name,
Just RdrName
demoted_rdr_name <- RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr_name
= RdrName -> RdrName -> RnM Name
report_qualified_term_in_types RdrName
rdr_name RdrName
demoted_rdr_name
| RdrName -> Bool
isUnqual RdrName
rdr_name,
Just RdrName
demoted_rdr_name <- RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr_name
= do { required_type_arguments <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RequiredTypeArguments
; if required_type_arguments
then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr_name
; case mb_demoted_gre of
Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Anywhere) RdrName
rdr_name
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 unboundName looking_for rdr_name }
| Bool
otherwise
= LookingFor -> RdrName -> RnM Name
unboundName 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 { mName <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
demoted_rdr_name
; case 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
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 { res <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; case 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 { 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 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 = FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantNormal
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
fos 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 { mb_gre <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name
; case 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 LookingFor
looking_for RdrName
rdr_name } }
where
which_gres :: WhichGREs GREInfo
which_gres = FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
fos
looking_for :: LookingFor
looking_for = LF { lf_which :: WhatLooking
lf_which = WhatLooking
what_looking, lf_where :: WhereLooking
lf_where = WhereLooking
WL_Global }
what_looking :: WhatLooking
what_looking = case FieldsOrSelectors
fos 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 { rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case lookupGRE_Name rdr_env 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 { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; return $ lookupGREInfo hsc_env 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 { rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let 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))
; qual_nms <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name
; return $ nms ++ (qual_nms `minusList` 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. EpAnn 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 { 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))
; ghci_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr
; let (ghci_fld_gres, ghci_var_gres) =
partition isRecFldGRE $
ghci_gres
; let fld_gres = [GlobalRdrElt]
ghci_fld_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_fld_gres
var_gres = [GlobalRdrElt]
ghci_var_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_var_gres
; disamb_ok <- xoptM LangExt.DisambiguateRecordFields
; if | not disamb_ok
, gre1 : gre2 : others <- fld_gres ++ var_gres
-> addErrTc $ TcRnAmbiguousFieldInUpdate (gre1, gre2, others)
| otherwise
-> return ()
; return fld_gres }
; case 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 { (imp_errs, hints) <-
LocalRdrEnv
-> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint])
unknownNameSuggestions LocalRdrEnv
emptyLocalRdrEnv WhatLooking
WL_RecField RdrName
rdr
; failWithTc $
TcRnNotInScope NotARecordField rdr imp_errs 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 { res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
; case 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 :: IsPass p => LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl :: forall (p :: Pass) q.
IsPass p =>
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl = FieldOcc (GhcPass p) -> LocatedN RdrName
forall (p :: Pass).
IsPass p =>
FieldOcc (GhcPass p) -> LocatedN RdrName
fieldOccLRdrName (FieldOcc (GhcPass p) -> LocatedN RdrName)
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> FieldOcc (GhcPass p))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> FieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q)
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q)
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (LHsExpr q))
-> HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 {
; gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; fld1_gres NE.:| other_flds_gres <- mapM (lookupFieldGREs gre_env . getFieldUpdLbl) flds
; let possible_GREs = NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
fld1_gres [NonEmpty GlobalRdrElt]
other_flds_gres
; traceRn "lookupRecUpdFields" $
vcat [ text "flds:" <+> ppr (fmap getFieldUpdLbl flds)
, text "possible_GREs:" <+>
ppr (map (fmap greName . rnRecUpdLabels) possible_GREs) ]
; case 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 SrcSpanAnnA (FieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs)))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsRecUpdField GhcPs GhcPs)
NonEmpty
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc 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. IsPass p
=> [LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls :: forall (p :: Pass) q.
IsPass 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
$ FieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). IsPass p => FieldOcc (GhcPass p) -> RdrName
fieldOccRdrName
(FieldOcc (GhcPass p) -> RdrName)
-> (LHsRecUpdField (GhcPass p) q -> FieldOcc (GhcPass p))
-> LHsRecUpdField (GhcPass p) 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 SrcSpanAnnA (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (XRec q (HsExpr q))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))) (XRec q (HsExpr q))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> GenLocated SrcSpanAnnA (FieldOcc (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.
IsPass 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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> (FieldLabelString, [Bool]))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FieldLabelString)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> FastString)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> OccName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> RdrName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> LocatedN RdrName)
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 SrcSpanAnnA (FieldOcc (GhcPass p)))
(XRec q (HsExpr q)))
-> LocatedN RdrName
forall (p :: Pass) q.
IsPass p =>
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl )
[LHsRecUpdField (GhcPass p) q]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated SrcSpanAnnA (FieldOcc (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 {k} (key :: k) 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
res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper WhichGREs GREInfo
which_gres RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
case 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 { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case lookupGRE env (LookupRdrName rdr_name 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
mb_gre <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
ExportDeprecationWarnings
case 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)
_ <- LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Global) RdrName
rdr_name
return 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)] ]
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) ()
warnIfDeprecated 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 { env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; traceRn "addUsedGRE" (ppr $ greName gre)
; updTcRef (tcg_used_gres env) (gre :) } }
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) ()
warnIfDeprecated 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 { env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; traceRn "addUsedGREs" (ppr $ map greName imp_gres)
; updTcRef (tcg_used_gres env) (imp_gres ++) } }
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
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name = do
all_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
case 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 { dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; is_ghci <- getIsGHCi
; go_for_it dflags 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 { res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod_name IsBootInterface
NotBoot PkgQual
NoPkgQual
; case res of
Succeeded ModIface
iface
-> do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; let 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
]
; return 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_pkg_qual :: PkgQual
is_pkg_qual = PkgQual
NoPkgQual, is_qual :: Bool
is_qual = Bool
True, is_isboot :: IsBootInterface
is_isboot = IsBootInterface
NotBoot, 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
_ <- 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
mb_ty_thing <- lookupType hsc_env nm
case mb_ty_thing of
Maybe TyThing
Nothing -> do
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 (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn 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 (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn 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 (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn :: forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt SDoc
what
= (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA ((RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name))
-> (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { let also_try_tycons :: Bool
also_try_tycons = Bool
False
; mb_names <- HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> NamespaceSpecifier
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycons NamespaceSpecifier
NoNamespaceSpecifier
; case 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
-> NamespaceSpecifier
-> RnM (NE.NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> NamespaceSpecifier
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycon_ns NamespaceSpecifier
ns_spec
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= do { mb_gre <- Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
n
; return $ case 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 (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
TopSigCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace 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 (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
where
elem_name_set_with_namespace :: NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns Name
n = Name -> Bool
check_namespace Name
n Bool -> Bool -> Bool
&& (Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
check_namespace :: Name -> Bool
check_namespace = NamespaceSpecifier -> NameSpace -> Bool
coveredByNamespaceSpecifier NamespaceSpecifier
ns_spec (NameSpace -> Bool) -> (Name -> NameSpace) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameSpace
nameNameSpace
namespace :: NameSpace
namespace = 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
namespace
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 { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
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 =
(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 = [Name] -> [GhcHint]
candidates [Name]
names_in_scope
; case filter (keep_me . greName) 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 { mname <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; env <- getLocalRdrEnv
; let candidates_msg = [Name] -> [GhcHint]
candidates ([Name] -> [GhcHint]) -> [Name] -> [GhcHint]
forall a b. (a -> b) -> a -> b
$ LocalRdrEnv -> [Name]
localRdrEnvElts LocalRdrEnv
env
; case 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 -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames :: HsSigCtxt
-> SDoc -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames HsSigCtxt
ctxt SDoc
what NamespaceSpecifier
ns_spec RdrName
rdr
= do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; let also_try_tycon_ns = Bool
True
; nms_eithers <- fmap (guard_builtin_syntax this_mod rdr) <$>
lookupBindGroupOcc ctxt what rdr also_try_tycon_ns ns_spec
; let (errs, names) = partitionEithers (NE.toList nms_eithers)
; when (null names) $
addErr (head errs)
; return 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 { rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if not rebindable_on
then return Nothing
else do { ite <- lookupOccRnNone (mkVarUnqual (fsLit "ifThenElse"))
; return (Just ite) } }
lookupSyntaxName :: Name
-> RnM (Name, FreeVars)
lookupSyntaxName :: Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
= do { rebind <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if not rebind
then return (std_name, emptyFVs)
else do { nm <- lookupOccRnNone (mkRdrUnqual (nameOccName std_name))
; return (nm, unitFV nm) } }
lookupSyntaxExpr :: Name
-> RnM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr :: Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
= do { (name, fvs) <- Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
; return (genHsVar name, fvs) }
lookupSyntax :: Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntax Name
std_name
= do { (name, fvs) <- Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
; return (mkRnSyntaxExpr name, fvs) }
lookupSyntaxNames :: [Name]
-> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames :: [Name] -> RnM ([HsExpr GhcRn], NameSet)
lookupSyntaxNames [Name]
std_names
= do { rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if not rebindable_on then
return (map (HsVar noExtField . noLocA) std_names, emptyFVs)
else
do { usr_names <-
mapM (lookupOccRnNone . mkRdrUnqual . nameOccName) std_names
; return (map (HsVar noExtField . noLocA) usr_names, mkFVs usr_names) } }
lookupQualifiedDo :: HsStmtContext fn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo :: forall fn.
HsStmtContext fn -> Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupQualifiedDo HsStmtContext fn
ctxt Name
std_name
= (Name -> SyntaxExprRn)
-> (Name, 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 Name -> SyntaxExprRn
mkRnSyntaxExpr ((Name, NameSet) -> (SyntaxExprRn, NameSet))
-> RnM (Name, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext fn -> Name -> RnM (Name, NameSet)
forall fn. HsStmtContext fn -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext fn
ctxt Name
std_name
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars)
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
= do { qname <- RdrName -> RnM Name
lookupOccRnNone (ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
modName (Name -> OccName
nameOccName Name
std_name))
; return (qname, unitFV qname) }
lookupQualifiedDoName :: HsStmtContext fn -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName :: forall fn. HsStmtContext fn -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext fn
ctxt Name
std_name
= case HsStmtContext fn -> Maybe ModuleName
forall fn. HsStmtContext fn -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext fn
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
irrefutableConLikeRn :: HasDebugCallStack
=> HscEnv
-> GlobalRdrEnv
-> CompleteMatches
-> Name
-> Bool
irrefutableConLikeRn :: HasDebugCallStack =>
HscEnv -> GlobalRdrEnv -> CompleteMatches -> Name -> Bool
irrefutableConLikeRn HscEnv
hsc_env GlobalRdrEnv
rdr_env CompleteMatches
comps Name
con_nm
| Just GlobalRdrElt
gre <- GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env Name
con_nm
= GREInfo -> Bool
go (GREInfo -> Bool) -> GREInfo -> Bool
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
gre
| Bool
otherwise
= GREInfo -> Bool
go (GREInfo -> Bool) -> GREInfo -> Bool
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
con_nm
where
go :: GREInfo -> Bool
go ( IAmConLike ConInfo
conInfo ) =
case ConInfo -> ConLikeInfo
conLikeInfo ConInfo
conInfo of
ConIsData { conLikeDataCons :: ConLikeInfo -> [Name]
conLikeDataCons = [Name]
tc_cons } ->
[Name] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Name]
tc_cons Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1
ConLikeInfo
ConIsPatSyn ->
Name -> CompleteMatches -> Bool
forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm CompleteMatches
comps
go GREInfo
_ = Bool
False
irrefutableConLikeTc :: NamedThing con
=> [CompleteMatchX con]
-> ConLike
-> Bool
irrefutableConLikeTc :: forall con.
NamedThing con =>
[CompleteMatchX con] -> ConLike -> Bool
irrefutableConLikeTc [CompleteMatchX con]
comps ConLike
con =
case ConLike
con of
RealDataCon DataCon
dc -> [DataCon] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length (TyCon -> [DataCon]
tyConDataCons (DataCon -> TyCon
dataConTyCon DataCon
dc)) Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1
PatSynCon {} -> Name -> [CompleteMatchX con] -> Bool
forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm [CompleteMatchX con]
comps
where
con_nm :: Name
con_nm = ConLike -> Name
conLikeName ConLike
con
in_single_complete_match :: NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match :: forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm = [CompleteMatchX con] -> Bool
go
where
go :: [CompleteMatchX con] -> Bool
go [] = Bool
False
go (CompleteMatchX con
comp:[CompleteMatchX con]
comps)
| Maybe Name
Nothing <- CompleteMatchX con -> Maybe Name
forall con. CompleteMatchX con -> Maybe Name
cmResultTyCon CompleteMatchX con
comp
, let comp_nms :: UniqDSet Name
comp_nms = (con -> Name) -> UniqDSet con -> UniqDSet Name
forall b a. Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
mapUniqDSet con -> Name
forall a. NamedThing a => a -> Name
getName (UniqDSet con -> UniqDSet Name) -> UniqDSet con -> UniqDSet Name
forall a b. (a -> b) -> a -> b
$ CompleteMatchX con -> UniqDSet con
forall con. CompleteMatchX con -> UniqDSet con
cmConLikes CompleteMatchX con
comp
, UniqDSet Name
comp_nms UniqDSet Name -> UniqDSet Name -> Bool
forall a. Eq a => a -> a -> Bool
== [Name] -> UniqDSet Name
forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet [Name
con_nm]
= Bool
True
| Bool
otherwise
= [CompleteMatchX con] -> Bool
go [CompleteMatchX con]
comps