{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
module GHC.Rename.Env (
newTopSrcBinder,
lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
AmbiguousResult(..),
lookupExprOccRn,
lookupRecFieldOcc,
lookupRecFieldOcc_update,
ChildLookupResult(..),
lookupSubBndrOcc_helper,
combineChildLookupResult,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
lookupSigCtxtOccRn, lookupSigCtxtOccRnN,
lookupInstDeclBndr, lookupFamInstName,
lookupConstructorFields,
lookupGreAvailRn,
lookupSyntax, lookupSyntaxExpr, lookupSyntaxNames,
lookupSyntaxName,
lookupIfThenElse,
lookupQualifiedDoExpr, lookupQualifiedDo,
lookupQualifiedDoName, lookupNameWithQualifier,
addUsedGRE, addUsedGREs, addUsedDataCons,
dataTcOccs,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Iface.Load ( loadInterfaceForName, loadSrcInterface_maybe )
import GHC.Iface.Env
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Builtin.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Warnings ( WarningTxt, pprWarningTxtForMsg )
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Builtin.Names( rOOT_MAIN )
import GHC.Types.Basic ( TopLevelFlag(..), TupleSort(..) )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Types.Unique.Set ( uniqSetAny )
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Data.Maybe
import GHC.Driver.Session
import GHC.Data.FastString
import Control.Monad
import GHC.Data.List.SetOps ( minusList )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Rename.Unbound
import GHC.Rename.Utils
import qualified Data.Semigroup as Semi
import Data.Either ( partitionEithers )
import Data.List ( find, sortBy )
import qualified Data.List.NonEmpty as NE
import Control.Arrow ( first )
import Data.Function
import GHC.Types.FieldLabel
newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder (L SrcSpanAnnN
loc RdrName
rdr_name)
| Just Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
=
if Name -> Bool
isExternalName Name
name then
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
(SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> SDoc
badOrigBinding RdrName
rdr_name))
; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
else
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Module -> Name -> RnM Name
forall m n. Module -> Name -> TcRnIf m n Name
externaliseName Module
this_mod Name
name }
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod Bool -> Bool -> Bool
|| Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
rOOT_MAIN)
(SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> SDoc
badOrigBinding RdrName
rdr_name))
; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
rdr_mod OccName
rdr_occ (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }
| Bool
otherwise
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr_name)
(SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> SDoc
badQualBndrErr RdrName
rdr_name))
; ThStage
stage <- TcM ThStage
getStage
; if ThStage -> Bool
isBrackStage ThStage
stage then
do { Unique
uniq <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc)) }
else
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"newTopSrcBinder" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod SDoc -> SDoc -> SDoc
$$ RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name SDoc -> SDoc -> SDoc
$$ SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc))
; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
this_mod (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc) }
}
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn RdrName
rdr_name =
RdrName -> (Name -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> Name
forall a. a -> a
id (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$
do {
let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ)
(do { Bool
op_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
op_ok (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> SDoc
opDeclErr RdrName
rdr_name)) })
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
env) of
[GlobalRdrElt
gre] -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
greMangledName 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)
WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_LocalTop RdrName
rdr_name
}
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM RdrName -> RnM Name
lookupTopBndrRn
lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupTopBndrRn
lookupExactOcc_either :: Name -> RnM (Either SDoc Name)
lookupExactOcc_either :: Name -> RnM (Either SDoc Name)
lookupExactOcc_either Name
name
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
, Just TyCon
tycon <- case TyThing
thing of
ATyCon TyCon
tc -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
AConLike (RealDataCon DataCon
dc) -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (DataCon -> TyCon
dataConTyCon DataCon
dc)
TyThing
_ -> Maybe TyCon
forall a. Maybe a
Nothing
, Just TupleSort
tupleSort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tycon
= do { let tupArity :: Arity
tupArity = case TupleSort
tupleSort of
TupleSort
UnboxedTuple -> TyCon -> Arity
tyConArity TyCon
tycon Arity -> Arity -> Arity
forall a. Integral a => a -> a -> a
`div` Arity
2
TupleSort
_ -> TyCon -> Arity
tyConArity TyCon
tycon
; Arity -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize Arity
tupArity
; Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
name) }
| Name -> Bool
isExternalName Name
name
= Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
name)
| Bool
otherwise
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let
main_occ :: OccName
main_occ = Name -> OccName
nameOccName Name
name
demoted_occs :: [OccName]
demoted_occs = case OccName -> Maybe OccName
demoteOccName OccName
main_occ of
Just OccName
occ -> [OccName
occ]
Maybe OccName
Nothing -> []
gres :: [GlobalRdrElt]
gres = [ GlobalRdrElt
gre | OccName
occ <- OccName
main_occ OccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
: [OccName]
demoted_occs
, GlobalRdrElt
gre <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ
, GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ]
; case [GlobalRdrElt]
gres of
[GlobalRdrElt
gre] -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre))
[] ->
do { LocalRdrEnv
lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; if Name
name Name -> LocalRdrEnv -> Bool
`inLocalRdrEnvScope` LocalRdrEnv
lcl_env
then Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
name)
else
do { TcRef NameSet
th_topnames_var <- (TcGblEnv -> TcRef NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
-> IOEnv (Env TcGblEnv TcLclEnv) (TcRef NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TcGblEnv -> TcRef NameSet
tcg_th_topnames IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; NameSet
th_topnames <- TcRef NameSet -> TcRnIf TcGblEnv TcLclEnv NameSet
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef TcRef NameSet
th_topnames_var
; if Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
th_topnames
then Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
name)
else Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> Either SDoc Name
forall a b. a -> Either a b
Left (Name -> SDoc
exactNameErr Name
name))
}
}
[GlobalRdrElt]
gres -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> Either SDoc Name
forall a b. a -> Either a b
Left ([GlobalRdrElt] -> SDoc
sameNameErr [GlobalRdrElt]
gres))
}
sameNameErr :: [GlobalRdrElt] -> SDoc
sameNameErr :: [GlobalRdrElt] -> SDoc
sameNameErr [] = String -> SDoc
forall a. String -> a
panic String
"addSameNameErr: empty list"
sameNameErr gres :: [GlobalRdrElt]
gres@(GlobalRdrElt
_ : [GlobalRdrElt]
_)
= SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
text String
"Same exact name in multiple name-spaces:")
Arity
2 ([SDoc] -> SDoc
vcat ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
pp_one [Name]
sorted_names) SDoc -> SDoc -> SDoc
$$ SDoc
th_hint)
where
sorted_names :: [Name]
sorted_names = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan) ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName [GlobalRdrElt]
gres)
pp_one :: Name -> SDoc
pp_one Name
name
= SDoc -> Arity -> SDoc -> SDoc
hang (NameSpace -> SDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name))
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
<> SDoc
comma)
Arity
2 (String -> SDoc
text String
"declared at:" SDoc -> SDoc -> SDoc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
th_hint :: SDoc
th_hint = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Probable cause: you bound a unique Template Haskell name (NameU),"
, String -> SDoc
text String
"perhaps via newName, in different name-spaces."
, String -> SDoc
text String
"If that's it, then -ddump-splices might be useful" ]
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)
(SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> SDoc
badQualBndrErr RdrName
rdr))
; Either SDoc Name
mb_name <- Bool -> Name -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupSubBndrOcc
Bool
False
Name
cls SDoc
doc RdrName
rdr
; case Either SDoc Name
mb_name of
Left SDoc
err -> do { SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr SDoc
err; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr) }
Right Name
nm -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm }
where
doc :: SDoc
doc = SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)
lookupFamInstName :: Maybe Name -> LocatedN RdrName
-> RnM (LocatedN Name)
lookupFamInstName :: Maybe Name -> LocatedN RdrName -> RnM (LocatedN Name)
lookupFamInstName (Just Name
cls) LocatedN RdrName
tc_rdr
= (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls (String -> SDoc
text String
"associated type")) LocatedN RdrName
tc_rdr
lookupFamInstName Maybe Name
Nothing LocatedN RdrName
tc_rdr
= LocatedN RdrName -> RnM (LocatedN Name)
forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn LocatedN RdrName
tc_rdr
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields Name
con_name
= do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
con_name then
do { RecFieldEnv
field_env <- TcRn RecFieldEnv
getRecFieldEnv
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"lookupCF" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con_name SDoc -> SDoc -> SDoc
$$ Maybe [FieldLabel] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RecFieldEnv -> Name -> Maybe [FieldLabel]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name) SDoc -> SDoc -> SDoc
$$ RecFieldEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr RecFieldEnv
field_env)
; [FieldLabel] -> RnM [FieldLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return (RecFieldEnv -> Name -> Maybe [FieldLabel]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name Maybe [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. Maybe a -> a -> a
`orElse` []) }
else
do { ConLike
con <- Name -> TcM ConLike
tcLookupConLike Name
con_name
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"lookupCF 2" (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con)
; [FieldLabel] -> RnM [FieldLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return (ConLike -> [FieldLabel]
conLikeFieldLabels ConLike
con) } }
lookupExactOrOrig :: RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig :: forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig Name
n -> r -> RnM r
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> r
res Name
n)
ExactOrOrigError SDoc
e ->
do { SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr SDoc
e
; r -> RnM r
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> r
res (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)) }
ExactOrOrigResult
NotExactOrOrig -> RnM r
k }
lookupExactOrOrig_maybe :: RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe :: forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe Name -> r
res RnM r
k
= do { ExactOrOrigResult
men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
; case ExactOrOrigResult
men of
FoundExactOrOrig Name
n -> r -> RnM r
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> r
res (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n))
ExactOrOrigError SDoc
_ -> r -> RnM r
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> r
res Maybe Name
forall a. Maybe a
Nothing)
ExactOrOrigResult
NotExactOrOrig -> RnM r
k }
data ExactOrOrigResult = FoundExactOrOrig Name
| ExactOrOrigError SDoc
| 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 SDoc Name -> ExactOrOrigResult
cvtEither (Either SDoc Name -> ExactOrOrigResult)
-> RnM (Either SDoc Name) -> RnM ExactOrOrigResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM (Either SDoc Name)
lookupExactOcc_either Name
n
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= Name -> ExactOrOrigResult
FoundExactOrOrig (Name -> ExactOrOrigResult) -> RnM Name -> RnM ExactOrOrigResult
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 = ExactOrOrigResult -> RnM ExactOrOrigResult
forall (m :: * -> *) a. Monad m => a -> m a
return ExactOrOrigResult
NotExactOrOrig
where
cvtEither :: Either SDoc Name -> ExactOrOrigResult
cvtEither (Left SDoc
e) = SDoc -> ExactOrOrigResult
ExactOrOrigError SDoc
e
cvtEither (Right Name
n) = Name -> ExactOrOrigResult
FoundExactOrOrig Name
n
lookupRecFieldOcc :: Maybe Name
-> RdrName
-> RnM Name
lookupRecFieldOcc :: Maybe Name -> RdrName -> RnM Name
lookupRecFieldOcc Maybe Name
mb_con RdrName
rdr_name
| Just Name
con <- Maybe Name
mb_con
, Name -> Bool
isUnboundName Name
con
= Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
| Just Name
con <- Maybe Name
mb_con
= do { [FieldLabel]
flds <- Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let lbl :: FastString
lbl = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
mb_field :: Maybe (FieldLabel, GlobalRdrElt)
mb_field = do FieldLabel
fl <- (FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
lbl) (FastString -> Bool)
-> (FieldLabel -> FastString) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FastString
flLabel) [FieldLabel]
flds
GlobalRdrElt
gre <- GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
if RdrName -> Bool
isQual RdrName
rdr_name
then do GlobalRdrElt
gre' <- [GlobalRdrElt] -> Maybe GlobalRdrElt
forall a. [a] -> Maybe a
listToMaybe (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt
gre])
(FieldLabel, GlobalRdrElt) -> Maybe (FieldLabel, GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel
fl, GlobalRdrElt
gre')
else (FieldLabel, GlobalRdrElt) -> Maybe (FieldLabel, GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel
fl, GlobalRdrElt
gre)
; case Maybe (FieldLabel, GlobalRdrElt)
mb_field of
Just (FieldLabel
fl, GlobalRdrElt
gre) -> do { Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
True GlobalRdrElt
gre
; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> Name
flSelector FieldLabel
fl) }
Maybe (FieldLabel, GlobalRdrElt)
Nothing -> FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantBoth RdrName
rdr_name }
| Bool
otherwise
= FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantBoth RdrName
rdr_name
lookupRecFieldOcc_update
:: DuplicateRecordFields
-> RdrName
-> RnM AmbiguousResult
lookupRecFieldOcc_update :: DuplicateRecordFields -> RdrName -> RnM AmbiguousResult
lookupRecFieldOcc_update DuplicateRecordFields
dup_fields_ok RdrName
rdr_name = do
Bool
disambig_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DisambiguateRecordFields
let want :: FieldsOrSelectors
want | Bool
disambig_ok = FieldsOrSelectors
WantField
| Bool
otherwise = FieldsOrSelectors
WantBoth
Maybe AmbiguousResult
mr <- DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
want RdrName
rdr_name
case Maybe AmbiguousResult
mr of
Just AmbiguousResult
r -> AmbiguousResult -> RnM AmbiguousResult
forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousResult
r
Maybe AmbiguousResult
Nothing
| Bool
disambig_ok -> do Maybe AmbiguousResult
mr' <- DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
WantBoth RdrName
rdr_name
case Maybe AmbiguousResult
mr' of
Just AmbiguousResult
r -> AmbiguousResult -> RnM AmbiguousResult
forall (m :: * -> *) a. Monad m => a -> m a
return AmbiguousResult
r
Maybe AmbiguousResult
Nothing -> RnM AmbiguousResult
unbound
| Bool
otherwise -> RnM AmbiguousResult
unbound
where
unbound :: RnM AmbiguousResult
unbound = GreName -> AmbiguousResult
UnambiguousGre (GreName -> AmbiguousResult)
-> (Name -> GreName) -> Name -> AmbiguousResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName (Name -> AmbiguousResult) -> RnM Name -> RnM AmbiguousResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName
-> RnM ChildLookupResult
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
must_have_parent Bool
warn_if_deprec Name
parent RdrName
rdr_name
| Name -> Bool
isUnboundName Name
parent
= ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> GreName -> ChildLookupResult
FoundChild Parent
NoParent (Name -> GreName
NormalGreName (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)))
| Bool
otherwise = do
GlobalRdrEnv
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
let original_gres :: [GlobalRdrElt]
original_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
gre_env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"parent" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild original_gres:" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild picked_gres:" (DisambigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres) SDoc -> SDoc -> SDoc
$$ Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
must_have_parent)
case [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres of
DisambigInfo
NoOccurrence ->
[GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
UniqueOccurrence GlobalRdrElt
g ->
if Bool
must_have_parent then [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
else GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
DisambiguatedOccurrence GlobalRdrElt
g ->
GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
AmbiguousOccurrence NonEmpty GlobalRdrElt
gres ->
NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr NonEmpty GlobalRdrElt
gres
where
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g :: GlobalRdrElt
g@GRE{GreName
gre_name :: GlobalRdrElt -> GreName
gre_name :: GreName
gre_name,Parent
gre_par :: GlobalRdrElt -> Parent
gre_par :: Parent
gre_par} = do
Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
warn_if_deprec GlobalRdrElt
g
ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ Parent -> GreName -> ChildLookupResult
FoundChild Parent
gre_par GreName
gre_name
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres = do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"npe" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
Bool
dup_fields_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
case [GlobalRdrElt]
original_gres of
[] -> ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
[GlobalRdrElt
g] -> ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ Name -> GreName -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> GreName
gre_name GlobalRdrElt
g)
[Name
p | Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
g]]
gss :: [GlobalRdrElt]
gss@(GlobalRdrElt
g:gss' :: [GlobalRdrElt]
gss'@(GlobalRdrElt
_:[GlobalRdrElt]
_)) ->
if (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE [GlobalRdrElt]
gss Bool -> Bool -> Bool
&& Bool
dup_fields_ok
then ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
Name -> GreName -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> GreName
gre_name GlobalRdrElt
g)
[Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
x]]
else NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr (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 (m :: * -> *) a. Monad m => a -> m a
return (Parent -> GreName -> ChildLookupResult
FoundChild (GlobalRdrElt -> Parent
gre_par (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)) (GlobalRdrElt -> GreName
gre_name (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)))
getParent :: GlobalRdrElt -> Maybe Name
getParent :: GlobalRdrElt -> Maybe Name
getParent (GRE { gre_par :: GlobalRdrElt -> Parent
gre_par = Parent
p } ) =
case Parent
p of
ParentIs Name
cur_parent -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cur_parent
Parent
NoParent -> Maybe Name
forall a. Maybe a
Nothing
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
gres
| RdrName -> Bool
isUnqual RdrName
rdr_name
= [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent [GlobalRdrElt]
gres)
| Bool
otherwise
= [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres))
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent GlobalRdrElt
p
= case GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
p of
Just Name
cur_parent
| Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
p
| Bool
otherwise -> DisambigInfo
NoOccurrence
Maybe Name
Nothing -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
p
data DisambigInfo
= NoOccurrence
| UniqueOccurrence GlobalRdrElt
| DisambiguatedOccurrence GlobalRdrElt
| AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt)
instance Outputable DisambigInfo where
ppr :: DisambigInfo -> SDoc
ppr DisambigInfo
NoOccurrence = String -> SDoc
text String
"NoOccurence"
ppr (UniqueOccurrence GlobalRdrElt
gre) = String -> SDoc
text String
"UniqueOccurrence:" SDoc -> SDoc -> SDoc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (DisambiguatedOccurrence GlobalRdrElt
gre) = String -> SDoc
text String
"DiambiguatedOccurrence:" SDoc -> SDoc -> SDoc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
ppr (AmbiguousOccurrence NonEmpty GlobalRdrElt
gres) = String -> SDoc
text String
"Ambiguous:" SDoc -> SDoc -> SDoc
<+> 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
GreName
[Name]
| FoundChild Parent GreName
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [] = ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
combineChildLookupResult (RnM ChildLookupResult
x:[RnM ChildLookupResult]
xs) = do
ChildLookupResult
res <- RnM ChildLookupResult
x
case ChildLookupResult
res of
ChildLookupResult
NameNotFound -> [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [RnM ChildLookupResult]
xs
ChildLookupResult
_ -> ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
res
instance Outputable ChildLookupResult where
ppr :: ChildLookupResult -> SDoc
ppr ChildLookupResult
NameNotFound = String -> SDoc
text String
"NameNotFound"
ppr (FoundChild Parent
p GreName
n) = String -> SDoc
text String
"Found:" SDoc -> SDoc -> SDoc
<+> Parent -> SDoc
forall a. Outputable a => a -> SDoc
ppr Parent
p SDoc -> SDoc -> SDoc
<+> GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
n
ppr (IncorrectParent Name
p GreName
n [Name]
ns) = String -> SDoc
text String
"IncorrectParent"
SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
p, GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
n, [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns]
lookupSubBndrOcc :: Bool
-> Name
-> SDoc
-> RdrName
-> RnM (Either SDoc Name)
lookupSubBndrOcc :: Bool -> Name -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupSubBndrOcc Bool
warn_if_deprec Name
the_parent SDoc
doc RdrName
rdr_name = do
ChildLookupResult
res <-
RdrName
-> (Name -> ChildLookupResult)
-> RnM ChildLookupResult
-> RnM ChildLookupResult
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Parent -> GreName -> ChildLookupResult
FoundChild Parent
NoParent (GreName -> ChildLookupResult)
-> (Name -> GreName) -> Name -> ChildLookupResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName) (RnM ChildLookupResult -> RnM ChildLookupResult)
-> RnM ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
True Bool
warn_if_deprec Name
the_parent RdrName
rdr_name
case ChildLookupResult
res of
ChildLookupResult
NameNotFound -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> Either SDoc Name
forall a b. a -> Either a b
Left (SDoc -> RdrName -> SDoc
unknownSubordinateErr SDoc
doc RdrName
rdr_name))
FoundChild Parent
_p GreName
child -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right (GreName -> Name
greNameMangledName GreName
child))
IncorrectParent {}
-> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SDoc Name -> RnM (Either SDoc Name))
-> Either SDoc Name -> RnM (Either SDoc Name)
forall a b. (a -> b) -> a -> b
$ SDoc -> Either SDoc Name
forall a b. a -> Either a b
Left (SDoc -> RdrName -> SDoc
unknownSubordinateErr SDoc
doc RdrName
rdr_name)
lookupLocatedOccRn :: GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn :: forall ann.
GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
lookupLocatedOccRn = (RdrName -> RnM Name)
-> GenLocated (SrcSpanAnn' ann) RdrName
-> TcRn (GenLocated (SrcSpanAnn' ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRn
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
= do { LocalRdrEnv
local_env <- RnM LocalRdrEnv
getLocalRdrEnv
; Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
local_env RdrName
rdr_name) }
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, Arity))
lookupLocalOccThLvl_maybe Name
name
= do { TcLclEnv
lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
; Maybe (TopLevelFlag, Arity) -> RnM (Maybe (TopLevelFlag, Arity))
forall (m :: * -> *) a. Monad m => a -> m a
return (NameEnv (TopLevelFlag, Arity)
-> Name -> Maybe (TopLevelFlag, Arity)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (TcLclEnv -> NameEnv (TopLevelFlag, Arity)
tcl_th_bndrs TcLclEnv
lcl_env) Name
name) }
lookupOccRn :: RdrName -> RnM Name
lookupOccRn :: RdrName -> RnM Name
lookupOccRn RdrName
rdr_name
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> RdrName -> RnM Name
reportUnboundName RdrName
rdr_name }
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn RdrName
rdr_name
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_LocalOnly RdrName
rdr_name }
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn RdrName
rdr_name
| OccName -> Bool
isVarOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
= RdrName -> RnM Name
badVarInType RdrName
rdr_name
| Bool
otherwise
= do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
; case Maybe Name
mb_name of
Just Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> RdrName -> RnM Name
lookup_demoted RdrName
rdr_name }
lookup_demoted :: RdrName -> RnM Name
lookup_demoted :: RdrName -> RnM Name
lookup_demoted RdrName
rdr_name
| Just RdrName
demoted_rdr <- RdrName -> Maybe RdrName
demoteRdrName RdrName
rdr_name
= do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
; Bool
star_is_type <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.StarIsType
; let star_info :: SDoc
star_info = Bool -> RdrName -> SDoc
starInfo Bool
star_is_type RdrName
rdr_name
; if Bool
data_kinds
then do { Maybe Name
mb_demoted_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
; case Maybe Name
mb_demoted_name of
Maybe Name
Nothing -> WhereLooking -> RdrName -> SDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name SDoc
star_info
Just Name
demoted_name ->
do { WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUntickedPromotedConstructors (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn
(WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnUntickedPromotedConstructors)
(Name -> SDoc
forall a. Outputable a => a -> SDoc
untickedPromConstrWarn Name
demoted_name)
; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
demoted_name } }
else do {
Maybe Name
mb_demoted_name <- RnM (Maybe Name) -> RnM (Maybe Name)
forall a. TcRn a -> TcRn a
discardErrs (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
; let suggestion :: SDoc
suggestion | Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust Maybe Name
mb_demoted_name = SDoc
suggest_dk
| Bool
otherwise = SDoc
star_info
; WhereLooking -> RdrName -> SDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name SDoc
suggestion } }
| Bool
otherwise
= RdrName -> RnM Name
reportUnboundName RdrName
rdr_name
where
suggest_dk :: SDoc
suggest_dk = String -> SDoc
text String
"A data constructor of that name is in scope; did you mean DataKinds?"
untickedPromConstrWarn :: a -> SDoc
untickedPromConstrWarn a
name =
String -> SDoc
text String
"Unticked promoted constructor" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name) SDoc -> SDoc -> SDoc
<> SDoc
dot
SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Use"
, SDoc -> SDoc
quotes (Char -> SDoc
char Char
'\'' SDoc -> SDoc -> SDoc
<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name)
, String -> SDoc
text String
"instead of"
, SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name) SDoc -> SDoc -> SDoc
<> SDoc
dot ]
lookup_promoted :: RdrName -> RnM (Maybe Name)
lookup_promoted :: RdrName -> RnM (Maybe Name)
lookup_promoted RdrName
rdr_name
| Just RdrName
promoted_rdr <- RdrName -> Maybe RdrName
promoteRdrName RdrName
rdr_name
= RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
promoted_rdr
| Bool
otherwise
= Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
badVarInType :: RdrName -> RnM Name
badVarInType :: RdrName -> RnM Name
badVarInType RdrName
rdr_name
= do { SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> SDoc
text String
"Illegal promoted term variable in a type:"
SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName
-> RnM (Maybe r)
lookupOccRnX_maybe :: forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe r)
globalLookup Name -> r
wrapper RdrName
rdr_name
= 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
$
[ (Name -> r) -> Maybe Name -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> r
wrapper (Maybe Name -> Maybe r) -> RnM (Maybe Name) -> RnM (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
, RdrName -> RnM (Maybe r)
globalLookup RdrName
rdr_name ]
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe = (RdrName -> RnM (Maybe Name))
-> (Name -> Name) -> RdrName -> RnM (Maybe Name)
forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe Name -> Name
forall a. a -> a
id
lookupExprOccRn
:: DuplicateRecordFields -> RdrName
-> RnM (Maybe AmbiguousResult)
lookupExprOccRn :: DuplicateRecordFields -> RdrName -> RnM (Maybe AmbiguousResult)
lookupExprOccRn DuplicateRecordFields
dup_fields_ok RdrName
rdr_name
= do { Maybe AmbiguousResult
mb_name <- (RdrName -> RnM (Maybe AmbiguousResult))
-> (Name -> AmbiguousResult)
-> RdrName
-> RnM (Maybe AmbiguousResult)
forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe AmbiguousResult)
global_lookup (GreName -> AmbiguousResult
UnambiguousGre (GreName -> AmbiguousResult)
-> (Name -> GreName) -> Name -> AmbiguousResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName) RdrName
rdr_name
; case Maybe AmbiguousResult
mb_name of
Maybe AmbiguousResult
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @Maybe (GreName -> AmbiguousResult
UnambiguousGre (GreName -> AmbiguousResult)
-> (Name -> GreName) -> Name -> AmbiguousResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName) (Maybe Name -> Maybe AmbiguousResult)
-> RnM (Maybe Name) -> RnM (Maybe AmbiguousResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> RnM (Maybe Name)
lookup_promoted RdrName
rdr_name
Maybe AmbiguousResult
p -> Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AmbiguousResult
p }
where
global_lookup :: RdrName -> RnM (Maybe AmbiguousResult)
global_lookup :: RdrName -> RnM (Maybe AmbiguousResult)
global_lookup = DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
WantNormal
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe RdrName
rdr_name =
RdrName
-> (Maybe Name -> Maybe Name)
-> RnM (Maybe Name)
-> RnM (Maybe Name)
forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe Name -> Maybe Name
forall a. a -> a
id (FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
WantNormal RdrName
rdr_name)
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn = FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
WantNormal
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
lookupGlobalOccRn' FieldsOrSelectors
fos RdrName
rdr_name =
RdrName -> (Name -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> Name
forall a. a -> a
id (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ do
Maybe Name
mn <- FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
fos RdrName
rdr_name
case Maybe Name
mn of
Just Name
n -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
Maybe Name
Nothing -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGlobalOccRn" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name }
lookupGlobalOccRn_base :: FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base :: FieldsOrSelectors -> RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base FieldsOrSelectors
fos RdrName
rdr_name =
MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name -> RnM (Maybe Name)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name -> RnM (Maybe Name))
-> ([RnM (Maybe Name)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> [RnM (Maybe Name)]
-> RnM (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> ([RnM (Maybe Name)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name])
-> [RnM (Maybe Name)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe Name) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> [RnM (Maybe Name)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe Name) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe Name)] -> RnM (Maybe Name))
-> [RnM (Maybe Name)] -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
[ (GlobalRdrElt -> Name) -> Maybe GlobalRdrElt -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
greMangledName (Maybe GlobalRdrElt -> Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
-> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe FieldsOrSelectors
fos RdrName
rdr_name
, (GreName -> Name) -> Maybe GreName -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GreName -> Name
greNameMangledName (Maybe GreName -> Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
-> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name ]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn RdrName
rdr_name =
RdrName -> (Name -> [Name]) -> RnM [Name] -> RnM [Name]
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[]) (RnM [Name] -> RnM [Name]) -> RnM [Name] -> RnM [Name]
forall a b. (a -> b) -> a -> b
$
do { GlobalRdrEnv
rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let ns :: [Name]
ns = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
rdr_env)
; [Name]
qual_ns <- (GreName -> Name) -> [GreName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> Name
greNameMangledName ([GreName] -> [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [GreName] -> RnM [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr_name
; [Name] -> RnM [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
qual_ns [Name] -> [Name] -> [Name]
forall a. Ord a => [a] -> [a] -> [a]
`minusList` [Name]
ns)) }
lookupGlobalOccRn_overloaded :: DuplicateRecordFields -> FieldsOrSelectors -> RdrName
-> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded :: DuplicateRecordFields
-> FieldsOrSelectors -> RdrName -> RnM (Maybe AmbiguousResult)
lookupGlobalOccRn_overloaded DuplicateRecordFields
dup_fields_ok FieldsOrSelectors
fos RdrName
rdr_name =
RdrName
-> (Maybe Name -> Maybe AmbiguousResult)
-> RnM (Maybe AmbiguousResult)
-> RnM (Maybe AmbiguousResult)
forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name ((Name -> AmbiguousResult) -> Maybe Name -> Maybe AmbiguousResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GreName -> AmbiguousResult
UnambiguousGre (GreName -> AmbiguousResult)
-> (Name -> GreName) -> Name -> AmbiguousResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GreName
NormalGreName)) (RnM (Maybe AmbiguousResult) -> RnM (Maybe AmbiguousResult))
-> RnM (Maybe AmbiguousResult) -> RnM (Maybe AmbiguousResult)
forall a b. (a -> b) -> a -> b
$
do { GreLookupResult
res <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
; case GreLookupResult
res of
GreLookupResult
GreNotFound -> (GreName -> AmbiguousResult)
-> Maybe GreName -> Maybe AmbiguousResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GreName -> AmbiguousResult
UnambiguousGre (Maybe GreName -> Maybe AmbiguousResult)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
-> RnM (Maybe AmbiguousResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
OneNameMatch GlobalRdrElt
gre -> Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult))
-> Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall a b. (a -> b) -> a -> b
$ AmbiguousResult -> Maybe AmbiguousResult
forall a. a -> Maybe a
Just (GreName -> AmbiguousResult
UnambiguousGre (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre))
MultipleNames NonEmpty GlobalRdrElt
gres
| (GlobalRdrElt -> Bool) -> NonEmpty GlobalRdrElt -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE NonEmpty GlobalRdrElt
gres
, DuplicateRecordFields
dup_fields_ok DuplicateRecordFields -> DuplicateRecordFields -> Bool
forall a. Eq a => a -> a -> Bool
== DuplicateRecordFields
DuplicateRecordFields -> Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult))
-> Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall a b. (a -> b) -> a -> b
$ AmbiguousResult -> Maybe AmbiguousResult
forall a. a -> Maybe a
Just AmbiguousResult
AmbiguousFields
| Bool
otherwise -> do
RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
Maybe AmbiguousResult -> RnM (Maybe AmbiguousResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (AmbiguousResult -> Maybe AmbiguousResult
forall a. a -> Maybe a
Just (GreName -> AmbiguousResult
UnambiguousGre (GlobalRdrElt -> GreName
gre_name (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)))) }
data AmbiguousResult
= UnambiguousGre GreName
| AmbiguousFields
data FieldsOrSelectors
= WantNormal
| WantBoth
| WantField
deriving FieldsOrSelectors -> FieldsOrSelectors -> Bool
(FieldsOrSelectors -> FieldsOrSelectors -> Bool)
-> (FieldsOrSelectors -> FieldsOrSelectors -> Bool)
-> Eq FieldsOrSelectors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
$c/= :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
== :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
$c== :: FieldsOrSelectors -> FieldsOrSelectors -> Bool
Eq
filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs FieldsOrSelectors
fos = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
fos (GreName -> Bool)
-> (GlobalRdrElt -> GreName) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name)
allowGreName :: FieldsOrSelectors -> GreName -> Bool
allowGreName :: FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
WantBoth GreName
_ = Bool
True
allowGreName FieldsOrSelectors
WantNormal (FieldGreName FieldLabel
fl) = FieldLabel -> FieldSelectors
flHasFieldSelector FieldLabel
fl FieldSelectors -> FieldSelectors -> Bool
forall a. Eq a => a -> a -> Bool
== FieldSelectors
FieldSelectors
allowGreName FieldsOrSelectors
WantNormal (NormalGreName Name
_) = Bool
True
allowGreName FieldsOrSelectors
WantField (FieldGreName FieldLabel
_) = Bool
True
allowGreName FieldsOrSelectors
WantField (NormalGreName Name
_) = Bool
False
data GreLookupResult = GreNotFound
| OneNameMatch GlobalRdrElt
| MultipleNames (NE.NonEmpty GlobalRdrElt)
lookupGreRn_maybe :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe :: FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe FieldsOrSelectors
fos RdrName
rdr_name
= do
GreLookupResult
res <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
case GreLookupResult
res of
OneNameMatch GlobalRdrElt
gre -> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (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
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (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
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
lookupGreRn_helper :: FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper :: FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
fos RdrName
rdr_name
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt]
filterFieldGREs FieldsOrSelectors
fos (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
env) of
[] -> GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return GreLookupResult
GreNotFound
[GlobalRdrElt
gre] -> do { Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
True GlobalRdrElt
gre
; GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> GreLookupResult
OneNameMatch GlobalRdrElt
gre) }
(GlobalRdrElt
gre:[GlobalRdrElt]
gres) -> GreLookupResult -> RnM GreLookupResult
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]
gres)) }
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn RdrName
rdr_name
= do
GreLookupResult
mb_gre <- FieldsOrSelectors -> RdrName -> RnM GreLookupResult
lookupGreRn_helper FieldsOrSelectors
WantNormal RdrName
rdr_name
case GreLookupResult
mb_gre of
GreLookupResult
GreNotFound ->
do
String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreAvailRn" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
Name
name <- WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name
(Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Name -> AvailInfo
avail Name
name)
MultipleNames NonEmpty GlobalRdrElt
gres ->
do
RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
let unbound_name :: Name
unbound_name = RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
(Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
unbound_name, Name -> AvailInfo
avail Name
unbound_name)
OneNameMatch GlobalRdrElt
gre ->
(Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre, GlobalRdrElt -> AvailInfo
availFromGRE GlobalRdrElt
gre)
addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
addUsedDataCons :: GlobalRdrEnv -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedDataCons GlobalRdrEnv
rdr_env TyCon
tycon
= [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs [ GlobalRdrElt
gre
| DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tycon
, Just GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
dc)] ]
addUsedGRE :: Bool -> GlobalRdrElt -> RnM ()
addUsedGRE :: Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
warn_if_deprec GlobalRdrElt
gre
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn_if_deprec (GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated GlobalRdrElt
gre)
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GlobalRdrElt -> Bool
isLocalGRE GlobalRdrElt
gre) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGRE" (GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre)
; IORef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:) } }
addUsedGREs :: [GlobalRdrElt] -> RnM ()
addUsedGREs :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs [GlobalRdrElt]
gres
| [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
imp_gres = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGREs" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
imp_gres)
; IORef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) ([GlobalRdrElt]
imp_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++) }
where
imp_gres :: [GlobalRdrElt]
imp_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filterOut GlobalRdrElt -> Bool
isLocalGRE [GlobalRdrElt]
gres
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
| (ImportSpec
imp_spec : [ImportSpec]
_) <- [ImportSpec]
iss
= do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnWarningsDeprecations DynFlags
dflags Bool -> Bool -> Bool
&&
Bool -> Bool
not (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name)) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { ModIface
iface <- SDoc -> Name -> TcRn ModIface
loadInterfaceForName SDoc
doc Name
name
; case ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec ModIface
iface GlobalRdrElt
gre of
Just WarningTxt
txt -> WarnReason -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnWarningsDeprecations)
(ImportSpec -> WarningTxt -> SDoc
mk_msg ImportSpec
imp_spec WarningTxt
txt)
Maybe WarningTxt
Nothing -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () } }
| Bool
otherwise
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
name :: Name
name = GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre
name_mod :: Module
name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
doc :: SDoc
doc = String -> SDoc
text String
"The name" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"is mentioned explicitly")
mk_msg :: ImportSpec -> WarningTxt -> SDoc
mk_msg ImportSpec
imp_spec WarningTxt
txt
= [SDoc] -> SDoc
sep [ [SDoc] -> SDoc
sep [ String -> SDoc
text String
"In the use of"
SDoc -> SDoc -> SDoc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ)
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
, SDoc -> SDoc
parens SDoc
imp_msg SDoc -> SDoc -> SDoc
<> SDoc
colon ]
, WarningTxt -> SDoc
pprWarningTxtForMsg WarningTxt
txt ]
where
imp_mod :: ModuleName
imp_mod = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec
imp_msg :: SDoc
imp_msg = String -> SDoc
text String
"imported from" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod SDoc -> SDoc -> SDoc
<> SDoc
extra
extra :: SDoc
extra | ModuleName
imp_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
name_mod = SDoc
Outputable.empty
| Bool
otherwise = String -> SDoc
text String
", but defined in" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
name_mod
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec ModIface
iface GlobalRdrElt
gre
= ModIfaceBackend -> OccName -> Maybe WarningTxt
mi_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre) Maybe WarningTxt -> Maybe WarningTxt -> Maybe WarningTxt
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
ParentIs Name
p -> ModIfaceBackend -> OccName -> Maybe WarningTxt
mi_warn_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) (Name -> OccName
nameOccName Name
p)
Parent
NoParent -> Maybe WarningTxt
forall a. Maybe a
Nothing
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GreName)
lookupOneQualifiedNameGHCi :: FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name = do
[GreName]
gnames <- FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
case [GreName]
gnames of
[] -> Maybe GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GreName
forall a. Maybe a
Nothing
[GreName
gname] -> Maybe GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
forall (m :: * -> *) a. Monad m => a -> m a
return (GreName -> Maybe GreName
forall a. a -> Maybe a
Just GreName
gname)
(GreName
gname:[GreName]
gnames') -> do RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name (GreName -> GlobalRdrElt
toGRE GreName
gname GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| (GreName -> GlobalRdrElt) -> [GreName] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> GlobalRdrElt
toGRE [GreName]
gnames')
Maybe GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GreName)
forall (m :: * -> *) a. Monad m => a -> m a
return (GreName -> Maybe GreName
forall a. a -> Maybe a
Just (Name -> GreName
NormalGreName (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)))
where
toGRE :: GreName -> GlobalRdrElt
toGRE GreName
gname = GRE { gre_name :: GreName
gre_name = GreName
gname, gre_par :: Parent
gre_par = Parent
NoParent, gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: [ImportSpec]
gre_imp = [ImportSpec
is] }
is :: ImportSpec
is = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec { is_mod :: ModuleName
is_mod = ModuleName
mod, is_as :: ModuleName
is_as = ModuleName
mod, is_qual :: Bool
is_qual = Bool
True, is_dloc :: SrcSpan
is_dloc = SrcSpan
noSrcSpan }
, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }
(ModuleName
mod, OccName
_) = (ModuleName, OccName)
-> Maybe (ModuleName, OccName) -> (ModuleName, OccName)
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> (ModuleName, OccName)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupOneQualifiedNameGHCi" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)) (RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name)
lookupQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM [GreName]
lookupQualifiedNameGHCi :: FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
=
do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool
is_ghci <- TcRnIf TcGblEnv TcLclEnv Bool
getIsGHCi
; DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
go_for_it DynFlags
dflags Bool
is_ghci }
where
go_for_it :: DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
go_for_it DynFlags
dflags Bool
is_ghci
| Just (ModuleName
mod,OccName
occ) <- RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name
, Bool
is_ghci
, GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ImplicitImportQualified DynFlags
dflags
, Bool -> Bool
not (DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)
= do { MaybeErr SDoc ModIface
res <- SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
NotBoot Maybe FastString
forall a. Maybe a
Nothing
; case MaybeErr SDoc ModIface
res of
Succeeded ModIface
iface
-> [GreName] -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ GreName
gname
| AvailInfo
avail <- ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
, GreName
gname <- AvailInfo -> [GreName]
availGreNames AvailInfo
avail
, GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
gname OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ
, FieldsOrSelectors -> GreName -> Bool
allowGreName FieldsOrSelectors
fos GreName
gname
]
MaybeErr SDoc ModIface
_ ->
do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
; [GreName] -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
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)
; [GreName] -> IOEnv (Env TcGblEnv TcLclEnv) [GreName]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
doc :: SDoc
doc = String -> SDoc
text String
"Need to find" SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
data HsSigCtxt
= TopSigCtxt NameSet
| LocalBindCtxt NameSet
| ClsDeclCtxt Name
| InstDeclCtxt NameSet
| HsBootCtxt NameSet
| RoleAnnotCtxt NameSet
instance Outputable HsSigCtxt where
ppr :: HsSigCtxt -> SDoc
ppr (TopSigCtxt NameSet
ns) = String -> SDoc
text String
"TopSigCtxt" SDoc -> SDoc -> SDoc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (LocalBindCtxt NameSet
ns) = String -> SDoc
text String
"LocalBindCtxt" SDoc -> SDoc -> SDoc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (ClsDeclCtxt Name
n) = String -> SDoc
text String
"ClsDeclCtxt" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
ppr (InstDeclCtxt NameSet
ns) = String -> SDoc
text String
"InstDeclCtxt" SDoc -> SDoc -> SDoc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (HsBootCtxt NameSet
ns) = String -> SDoc
text String
"HsBootCtxt" SDoc -> SDoc -> SDoc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
ppr (RoleAnnotCtxt NameSet
ns) = String -> SDoc
text String
"RoleAnnotCtxt" SDoc -> SDoc -> SDoc
<+> 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)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall name. Sig name -> SDoc
hsSigDoc Sig GhcPs
sig)
lookupSigOccRnN :: HsSigCtxt
-> Sig GhcPs
-> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN :: HsSigCtxt -> Sig GhcPs -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> SDoc -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall name. Sig name -> SDoc
hsSigDoc Sig GhcPs
sig)
lookupSigCtxtOccRnN :: HsSigCtxt
-> SDoc
-> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN :: HsSigCtxt -> SDoc -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigCtxtOccRnN HsSigCtxt
ctxt SDoc
what
= (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA ((RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name))
-> (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { Either SDoc Name
mb_name <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
; case Either SDoc Name
mb_name of
Left SDoc
err -> do { SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr SDoc
err; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
Right Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
lookupSigCtxtOccRn :: HsSigCtxt
-> SDoc
-> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigCtxtOccRn :: HsSigCtxt -> SDoc -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt SDoc
what
= (RdrName -> RnM Name) -> LocatedA RdrName -> RnM (LocatedA Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA ((RdrName -> RnM Name) -> LocatedA RdrName -> RnM (LocatedA Name))
-> (RdrName -> RnM Name) -> LocatedA RdrName -> RnM (LocatedA Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { Either SDoc Name
mb_name <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
; case Either SDoc Name
mb_name of
Left SDoc
err -> do { SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr SDoc
err; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
Right Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName -> RnM (Either SDoc Name)
lookupBindGroupOcc :: HsSigCtxt -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= Name -> RnM (Either SDoc Name)
lookupExactOcc_either Name
n
| Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
= do { Name
n' <- Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
; Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
n') }
| Bool
otherwise
= case HsSigCtxt
ctxt of
HsBootCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either SDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
TopSigCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either SDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either SDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
LocalBindCtxt NameSet
ns -> NameSet -> RnM (Either SDoc Name)
lookup_group NameSet
ns
ClsDeclCtxt Name
cls -> Name -> RnM (Either SDoc 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 Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right (Name -> Either SDoc Name) -> Name -> Either SDoc Name
forall a b. (a -> b) -> a -> b
$ RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
else (Name -> Bool) -> RnM (Either SDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
where
lookup_cls_op :: Name -> RnM (Either SDoc Name)
lookup_cls_op Name
cls
= Bool -> Name -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupSubBndrOcc Bool
True Name
cls SDoc
doc RdrName
rdr_name
where
doc :: SDoc
doc = String -> SDoc
text String
"method of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)
lookup_top :: (Name -> Bool) -> RnM (Either SDoc Name)
lookup_top Name -> Bool
keep_me
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; let all_gres :: [GlobalRdrElt]
all_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
names_in_scope :: [Name]
names_in_scope =
(Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> NameSpace -> NameSpace -> Bool
nameSpacesRelated
(RdrName -> NameSpace
rdrNameSpace RdrName
rdr_name)
(Name -> NameSpace
nameNameSpace Name
n))
([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName
([GlobalRdrElt] -> [Name]) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE
([GlobalRdrElt] -> [GlobalRdrElt])
-> [GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
env
candidates_msg :: SDoc
candidates_msg = [Name] -> SDoc
candidates [Name]
names_in_scope
; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep_me (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
greMangledName) [GlobalRdrElt]
all_gres of
[] | [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> SDoc -> RnM (Either SDoc Name)
bale_out_with SDoc
candidates_msg
| Bool
otherwise -> SDoc -> RnM (Either SDoc Name)
bale_out_with SDoc
local_msg
(GlobalRdrElt
gre:[GlobalRdrElt]
_) -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre)) }
lookup_group :: NameSet -> RnM (Either SDoc Name)
lookup_group NameSet
bound_names
= do { Maybe Name
mname <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
; LocalRdrEnv
env <- RnM LocalRdrEnv
getLocalRdrEnv
; let candidates_msg :: SDoc
candidates_msg = [Name] -> SDoc
candidates ([Name] -> SDoc) -> [Name] -> SDoc
forall a b. (a -> b) -> a -> b
$ LocalRdrEnv -> [Name]
localRdrEnvElts LocalRdrEnv
env
; case Maybe Name
mname of
Just Name
n
| Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
bound_names -> Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either SDoc Name
forall a b. b -> Either a b
Right Name
n)
| Bool
otherwise -> SDoc -> RnM (Either SDoc Name)
bale_out_with SDoc
local_msg
Maybe Name
Nothing -> SDoc -> RnM (Either SDoc Name)
bale_out_with SDoc
candidates_msg }
bale_out_with :: SDoc -> RnM (Either SDoc Name)
bale_out_with SDoc
msg
= Either SDoc Name -> RnM (Either SDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> Either SDoc Name
forall a b. a -> Either a b
Left ([SDoc] -> SDoc
sep [ String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
what
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
, Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"lacks an accompanying binding"]
SDoc -> SDoc -> SDoc
$$ Arity -> SDoc -> SDoc
nest Arity
2 SDoc
msg))
local_msg :: SDoc
local_msg = SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"must be given where")
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is declared"
candidates :: [Name] -> SDoc
candidates :: [Name] -> SDoc
candidates [Name]
names_in_scope
= case [Name]
similar_names of
[] -> SDoc
Outputable.empty
[Name
n] -> String -> SDoc
text String
"Perhaps you meant" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
pp_item Name
n
[Name]
_ -> [SDoc] -> SDoc
sep [ String -> SDoc
text String
"Perhaps you meant one of these:"
, Arity -> SDoc -> SDoc
nest Arity
2 ((Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
pp_item [Name]
similar_names) ]
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
pp_item :: Name -> SDoc
pp_item Name
x = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
x) SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (Name -> SDoc
pprDefinedAt Name
x)
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames HsSigCtxt
ctxt SDoc
what RdrName
rdr_name
= do { [Either SDoc (RdrName, Name)]
mb_gres <- (RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SDoc (RdrName, Name)))
-> [RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Either SDoc (RdrName, Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SDoc (RdrName, Name))
lookup (RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name)
; let ([SDoc]
errs, [(RdrName, Name)]
names) = [Either SDoc (RdrName, Name)] -> ([SDoc], [(RdrName, Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SDoc (RdrName, Name)]
mb_gres
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(RdrName, Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RdrName, Name)]
names) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr ([SDoc] -> SDoc
forall a. [a] -> a
head [SDoc]
errs)
; [(RdrName, Name)] -> RnM [(RdrName, Name)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(RdrName, Name)]
names }
where
lookup :: RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SDoc (RdrName, Name))
lookup RdrName
rdr = do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Either SDoc Name
nameEither <- HsSigCtxt -> SDoc -> RdrName -> RnM (Either SDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr
; Either SDoc (RdrName, Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Either SDoc (RdrName, Name))
forall (m :: * -> *) a. Monad m => a -> m a
return (Module
-> RdrName -> Either SDoc Name -> Either SDoc (RdrName, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr Either SDoc Name
nameEither) }
guard_builtin_syntax :: Module
-> RdrName -> Either SDoc Name -> Either SDoc (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
= SDoc -> Either SDoc (RdrName, Name)
forall a b. a -> Either a b
Left ([SDoc] -> SDoc
hsep [String -> SDoc
text String
"Illegal", SDoc
what, String -> SDoc
text String
"of built-in syntax:", RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr])
| Bool
otherwise
= (RdrName, Name) -> Either SDoc (RdrName, Name)
forall a b. b -> Either a b
Right (RdrName
rdr, Name
name)
guard_builtin_syntax Module
_ RdrName
_ (Left SDoc
err) = SDoc -> Either SDoc (RdrName, Name)
forall a b. a -> Either a b
Left SDoc
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 =
case RdrName
rdr_name of
Unqual OccName
occ | OccName -> FastString
occNameFS OccName
occ FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"~" -> RdrName
eqTyCon_RDR
RdrName
_ -> RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
rdr_name NameSpace
tcName
lookupIfThenElse :: RnM (Maybe Name)
lookupIfThenElse :: RnM (Maybe Name)
lookupIfThenElse
= do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on
then Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
else do { Name
ite <- RdrName -> RnM Name
lookupOccRn (FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"ifThenElse"))
; Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
ite) } }
lookupSyntaxName :: Name
-> RnM (Name, FreeVars)
lookupSyntaxName :: Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
= do { Bool
rebind <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebind
then (Name, NameSet) -> RnM (Name, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
std_name, NameSet
emptyFVs)
else do { Name
nm <- RdrName -> RnM Name
lookupOccRn (OccName -> RdrName
mkRdrUnqual (Name -> OccName
nameOccName Name
std_name))
; (Name, NameSet) -> RnM (Name, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nm, Name -> NameSet
unitFV Name
nm) } }
lookupSyntaxExpr :: Name
-> RnM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr :: Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
= do { (Name
name, NameSet
fvs) <- Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
; (HsExpr GhcRn, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (IdP GhcRn -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar Name
IdP GhcRn
name, NameSet
fvs) }
lookupSyntax :: Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntax Name
std_name
= do { (HsExpr GhcRn
expr, NameSet
fvs) <- Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
; (SyntaxExprRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr HsExpr GhcRn
expr, NameSet
fvs) }
lookupSyntaxNames :: [Name]
-> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames :: [Name] -> RnM ([HsExpr GhcRn], NameSet)
lookupSyntaxNames [Name]
std_names
= do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool -> Bool
not Bool
rebindable_on then
([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (LocatedN Name -> HsExpr GhcRn)
-> (Name -> LocatedN Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedN Name
forall a an. a -> LocatedAn an a
noLocA) [Name]
std_names, NameSet
emptyFVs)
else
do { [Name]
usr_names <- (Name -> RnM Name) -> [Name] -> RnM [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RdrName -> RnM Name
lookupOccRn (RdrName -> RnM Name) -> (Name -> RdrName) -> Name -> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (Name -> OccName) -> Name -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
std_names
; ([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (LocatedN Name -> HsExpr GhcRn)
-> (Name -> LocatedN Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedN Name
forall a an. a -> LocatedAn an a
noLocA) [Name]
usr_names, [Name] -> NameSet
mkFVs [Name]
usr_names) } }
lookupQualifiedDoExpr :: HsStmtContext p -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr :: forall p. HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
std_name
= (Name -> HsExpr GhcRn)
-> (Name, NameSet) -> (HsExpr GhcRn, NameSet)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar ((Name, NameSet) -> (HsExpr GhcRn, NameSet))
-> RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext p -> Name -> RnM (Name, NameSet)
forall p. HsStmtContext p -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext p
ctxt Name
std_name
lookupQualifiedDo
:: HsStmtContext p
-> Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo :: forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupQualifiedDo HsStmtContext p
ctxt Name
std_name
= (HsExpr GhcRn -> SyntaxExprRn)
-> (HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr ((HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet))
-> RnM (HsExpr GhcRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
forall p. HsStmtContext p -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
std_name
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars)
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
= do { Name
qname <- RdrName -> RnM Name
lookupOccRn (ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
modName (Name -> OccName
nameOccName Name
std_name))
; (Name, NameSet) -> RnM (Name, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
qname, Name -> NameSet
unitFV Name
qname) }
lookupQualifiedDoName
:: HsStmtContext p
-> Name
-> RnM (Name, FreeVars)
lookupQualifiedDoName :: forall p. HsStmtContext p -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext p
ctxt Name
std_name
= case HsStmtContext p -> Maybe ModuleName
forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext p
ctxt of
Maybe ModuleName
Nothing -> Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
Just ModuleName
modName -> Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
opDeclErr :: RdrName -> SDoc
opDeclErr :: RdrName -> SDoc
opDeclErr RdrName
n
= SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal declaration of a type or class operator" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
n))
Arity
2 (String -> SDoc
text String
"Use TypeOperators to declare operators in type and declarations")
badOrigBinding :: RdrName -> SDoc
badOrigBinding :: RdrName -> SDoc
badOrigBinding RdrName
name
| Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
= String -> SDoc
text String
"Illegal binding of built-in syntax:" SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ
| Bool
otherwise
= String -> SDoc
text String
"Cannot redefine a Name retrieved by a Template Haskell quote:"
SDoc -> SDoc -> SDoc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name
where
occ :: OccName
occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
filterCTuple RdrName
name