{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-}
module GHC.Rename.Env (
newTopSrcBinder,
lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
ChildLookupResult(..),
lookupSubBndrOcc_helper,
combineChildLookupResult,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
lookupSigCtxtOccRn,
lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName,
lookupConstructorFields,
lookupGreAvailRn,
lookupSyntax, lookupSyntaxExpr, lookupSyntaxName, lookupSyntaxNames,
lookupIfThenElse, lookupReboundIf,
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.Driver.Types
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Parser.PostProcess ( filterCTuple, setRdrNameSpace )
import GHC.Builtin.RebindableNames
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.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Utils.Error ( MsgDoc )
import GHC.Builtin.Names( rOOT_MAIN )
import GHC.Types.Basic ( pprWarningTxtForMsg, 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.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 Control.Arrow ( first )
import Data.Function
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder (L SrcSpan
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
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 SrcSpan
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
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) SrcSpan
loc) }
else
do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"newTopSrcBinder" (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
this_mod MsgDoc -> MsgDoc -> MsgDoc
$$ RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name MsgDoc -> MsgDoc -> MsgDoc
$$ SrcSpan -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr SrcSpan
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) SrcSpan
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 (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> MsgDoc
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
gre_name GlobalRdrElt
gre)
[GlobalRdrElt]
_ -> do
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupTopBndrRN fail" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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
lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name)
lookupExactOcc_either :: Name -> RnM (Either MsgDoc 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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name) }
| Name -> Bool
isExternalName Name
name
= Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc 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
gre_name GlobalRdrElt
gre Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ]
; case [GlobalRdrElt]
gres of
[GlobalRdrElt
gre] -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre))
[] ->
do { LocalRdrEnv
lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; if Name
name Name -> LocalRdrEnv -> Bool
`inLocalRdrEnvScope` LocalRdrEnv
lcl_env
then Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc 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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name)
else Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left (Name -> MsgDoc
exactNameErr Name
name))
}
}
[GlobalRdrElt]
gres -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left ([GlobalRdrElt] -> MsgDoc
sameNameErr [GlobalRdrElt]
gres))
}
sameNameErr :: [GlobalRdrElt] -> MsgDoc
sameNameErr :: [GlobalRdrElt] -> MsgDoc
sameNameErr [] = String -> MsgDoc
forall a. String -> a
panic String
"addSameNameErr: empty list"
sameNameErr gres :: [GlobalRdrElt]
gres@(GlobalRdrElt
_ : [GlobalRdrElt]
_)
= MsgDoc -> Arity -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Same exact name in multiple name-spaces:")
Arity
2 ([MsgDoc] -> MsgDoc
vcat ((Name -> MsgDoc) -> [Name] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> MsgDoc
pp_one [Name]
sorted_names) MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
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
gre_name [GlobalRdrElt]
gres)
pp_one :: Name -> MsgDoc
pp_one Name
name
= MsgDoc -> Arity -> MsgDoc -> MsgDoc
hang (NameSpace -> MsgDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name))
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
comma)
Arity
2 (String -> MsgDoc
text String
"declared at:" MsgDoc -> MsgDoc -> MsgDoc
<+> SrcLoc -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
th_hint :: MsgDoc
th_hint = [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"Probable cause: you bound a unique Template Haskell name (NameU),"
, String -> MsgDoc
text String
"perhaps via newName, in different name-spaces."
, String -> MsgDoc
text String
"If that's it, then -ddump-splices might be useful" ]
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr :: Name -> MsgDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls MsgDoc
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)
(MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> MsgDoc
badQualBndrErr RdrName
rdr))
; Either MsgDoc Name
mb_name <- Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc
Bool
False
Name
cls MsgDoc
doc RdrName
rdr
; case Either MsgDoc Name
mb_name of
Left MsgDoc
err -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
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 :: MsgDoc
doc = MsgDoc
what MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"of class" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
cls)
lookupFamInstName :: Maybe Name -> Located RdrName
-> RnM (Located Name)
lookupFamInstName :: Maybe Name -> Located RdrName -> RnM (Located Name)
lookupFamInstName (Just Name
cls) Located RdrName
tc_rdr
= (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM (Name -> MsgDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls (String -> MsgDoc
text String
"associated type")) Located RdrName
tc_rdr
lookupFamInstName Maybe Name
Nothing Located RdrName
tc_rdr
= Located RdrName -> RnM (Located Name)
lookupLocatedOccRn Located 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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"lookupCF" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
con_name MsgDoc -> MsgDoc -> MsgDoc
$$ Maybe [FieldLabel] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (RecFieldEnv -> Name -> Maybe [FieldLabel]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name) MsgDoc -> MsgDoc -> MsgDoc
$$ RecFieldEnv -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"lookupCF 2" (ConLike -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 MsgDoc
e ->
do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
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 MsgDoc
_ -> 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 MsgDoc
| 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 MsgDoc Name -> ExactOrOrigResult
cvtEither (Either MsgDoc Name -> ExactOrOrigResult)
-> RnM (Either MsgDoc Name) -> RnM ExactOrOrigResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM (Either MsgDoc 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 MsgDoc Name -> ExactOrOrigResult
cvtEither (Left MsgDoc
e) = MsgDoc -> ExactOrOrigResult
ExactOrOrigError MsgDoc
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 :: FieldLabelString
lbl = OccName -> FieldLabelString
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 ((FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
lbl) (FieldLabelString -> Bool)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
forall a. FieldLbl a -> FieldLabelString
flLabel) [FieldLabel]
flds
GlobalRdrElt
gre <- GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (RdrName -> Bool
isQual RdrName
rdr_name
Bool -> Bool -> Bool
&& [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (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)
; 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
forall a. FieldLbl a -> a
flSelector FieldLabel
fl) }
Maybe (FieldLabel, GlobalRdrElt)
Nothing -> RdrName -> RnM Name
lookupGlobalOccRn RdrName
rdr_name }
| Bool
otherwise
= RdrName -> RnM Name
lookupGlobalOccRn 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 -> Name -> ChildLookupResult
FoundName Parent
NoParent (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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"parent" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
parent)
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild original_gres:" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
original_gres)
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupExportChild picked_gres:" (DisambigInfo -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ([GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres) MsgDoc -> MsgDoc -> MsgDoc
$$ Bool -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 [GlobalRdrElt]
gres ->
[GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr [GlobalRdrElt]
gres
where
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g :: GlobalRdrElt
g@GRE{Name
gre_name :: Name
gre_name :: GlobalRdrElt -> Name
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
$ case Parent
gre_par of
FldParent Name
_ Maybe FieldLabelString
mfs ->
FieldLabel -> ChildLookupResult
FoundFL (Name -> Maybe FieldLabelString -> FieldLabel
fldParentToFieldLabel Name
gre_name Maybe FieldLabelString
mfs)
Parent
_ -> Parent -> Name -> ChildLookupResult
FoundName Parent
gre_par Name
gre_name
fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabel
fldParentToFieldLabel :: Name -> Maybe FieldLabelString -> FieldLabel
fldParentToFieldLabel Name
name Maybe FieldLabelString
mfs =
case Maybe FieldLabelString
mfs of
Maybe FieldLabelString
Nothing ->
let fs :: FieldLabelString
fs = OccName -> FieldLabelString
occNameFS (Name -> OccName
nameOccName Name
name)
in FieldLabelString -> Bool -> Name -> FieldLabel
forall a. FieldLabelString -> Bool -> a -> FieldLbl a
FieldLabel FieldLabelString
fs Bool
False Name
name
Just FieldLabelString
fs -> FieldLabelString -> Bool -> Name -> FieldLabel
forall a. FieldLabelString -> Bool -> a -> FieldLbl a
FieldLabel FieldLabelString
fs Bool
True Name
name
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres = do
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"npe" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
original_gres)
Bool
overload_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 -> Name -> MsgDoc -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> Name
gre_name GlobalRdrElt
g) (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name -> MsgDoc) -> Name -> MsgDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
gre_name GlobalRdrElt
g)
[Name
p | Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
g]]
gss :: [GlobalRdrElt]
gss@(GlobalRdrElt
g: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
overload_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 -> Name -> MsgDoc -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
(GlobalRdrElt -> Name
gre_name GlobalRdrElt
g)
(FieldLabelString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FieldLabelString -> MsgDoc) -> FieldLabelString -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> Maybe FieldLabelString -> FieldLabelString
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"noMatchingParentErr" (GlobalRdrElt -> Maybe FieldLabelString
greLabel GlobalRdrElt
g))
[Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, Just Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
x]]
else [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr [GlobalRdrElt]
gss
mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr [GlobalRdrElt]
gres = do
RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> Name -> ChildLookupResult
FoundName (GlobalRdrElt -> Parent
gre_par ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)) (GlobalRdrElt -> Name
gre_name ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [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
FldParent { par_is :: Parent -> Name
par_is = 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 [GlobalRdrElt]
instance Outputable DisambigInfo where
ppr :: DisambigInfo -> MsgDoc
ppr DisambigInfo
NoOccurrence = String -> MsgDoc
text String
"NoOccurence"
ppr (UniqueOccurrence GlobalRdrElt
gre) = String -> MsgDoc
text String
"UniqueOccurrence:" MsgDoc -> MsgDoc -> MsgDoc
<+> GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr GlobalRdrElt
gre
ppr (DisambiguatedOccurrence GlobalRdrElt
gre) = String -> MsgDoc
text String
"DiambiguatedOccurrence:" MsgDoc -> MsgDoc -> MsgDoc
<+> GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr GlobalRdrElt
gre
ppr (AmbiguousOccurrence [GlobalRdrElt]
gres) = String -> MsgDoc
text String
"Ambiguous:" MsgDoc -> MsgDoc -> MsgDoc
<+> [GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [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'
= [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence [GlobalRdrElt
g, GlobalRdrElt
g']
UniqueOccurrence GlobalRdrElt
g <> AmbiguousOccurrence [GlobalRdrElt]
gs
= [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
gGlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:[GlobalRdrElt]
gs)
AmbiguousOccurrence [GlobalRdrElt]
gs <> UniqueOccurrence GlobalRdrElt
g'
= [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g'GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:[GlobalRdrElt]
gs)
AmbiguousOccurrence [GlobalRdrElt]
gs <> AmbiguousOccurrence [GlobalRdrElt]
gs'
= [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence ([GlobalRdrElt]
gs [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [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
Name
SDoc
[Name]
| FoundName Parent Name
| FoundFL FieldLabel
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 -> MsgDoc
ppr ChildLookupResult
NameNotFound = String -> MsgDoc
text String
"NameNotFound"
ppr (FoundName Parent
p Name
n) = String -> MsgDoc
text String
"Found:" MsgDoc -> MsgDoc -> MsgDoc
<+> Parent -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Parent
p MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
ppr (FoundFL FieldLabel
fls) = String -> MsgDoc
text String
"FoundFL:" MsgDoc -> MsgDoc -> MsgDoc
<+> FieldLabel -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FieldLabel
fls
ppr (IncorrectParent Name
p Name
n MsgDoc
td [Name]
ns) = String -> MsgDoc
text String
"IncorrectParent"
MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
hsep [Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
p, Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n, MsgDoc
td, [Name] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Name]
ns]
lookupSubBndrOcc :: Bool
-> Name
-> SDoc
-> RdrName
-> RnM (Either MsgDoc Name)
lookupSubBndrOcc :: Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc Bool
warn_if_deprec Name
the_parent MsgDoc
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 -> Name -> ChildLookupResult
FoundName Parent
NoParent) (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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left (MsgDoc -> RdrName -> MsgDoc
unknownSubordinateErr MsgDoc
doc RdrName
rdr_name))
FoundName Parent
_p Name
n -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n)
FoundFL FieldLabel
fl -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl))
IncorrectParent {}
-> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MsgDoc Name -> RnM (Either MsgDoc Name))
-> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left (MsgDoc -> RdrName -> MsgDoc
unknownSubordinateErr MsgDoc
doc RdrName
rdr_name)
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM 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 :: MsgDoc
star_info = Bool -> RdrName -> MsgDoc
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 -> MsgDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name MsgDoc
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn
(WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnUntickedPromotedConstructors)
(Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 :: MsgDoc
suggestion | Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust Maybe Name
mb_demoted_name = MsgDoc
suggest_dk
| Bool
otherwise = MsgDoc
star_info
; WhereLooking -> RdrName -> MsgDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name MsgDoc
suggestion } }
| Bool
otherwise
= RdrName -> RnM Name
reportUnboundName RdrName
rdr_name
where
suggest_dk :: MsgDoc
suggest_dk = String -> MsgDoc
text String
"A data constructor of that name is in scope; did you mean DataKinds?"
untickedPromConstrWarn :: a -> MsgDoc
untickedPromConstrWarn a
name =
String -> MsgDoc
text String
"Unticked promoted constructor" MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
dot
MsgDoc -> MsgDoc -> MsgDoc
$$
[MsgDoc] -> MsgDoc
hsep [ String -> MsgDoc
text String
"Use"
, MsgDoc -> MsgDoc
quotes (Char -> MsgDoc
char Char
'\'' MsgDoc -> MsgDoc -> MsgDoc
<> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name)
, String -> MsgDoc
text String
"instead of"
, MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
dot ]
badVarInType :: RdrName -> RnM Name
badVarInType :: RdrName -> RnM Name
badVarInType RdrName
rdr_name
= do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> MsgDoc
text String
"Illegal promoted term variable in a type:"
MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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
lookupOccRn_overloaded :: Bool -> RdrName
-> RnM (Maybe (Either Name [Name]))
lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupOccRn_overloaded Bool
overload_ok
= (RdrName -> RnM (Maybe (Either Name [Name])))
-> (Name -> Either Name [Name])
-> RdrName
-> RnM (Maybe (Either Name [Name]))
forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe (Either Name [Name]))
global_lookup Name -> Either Name [Name]
forall a b. a -> Either a b
Left
where
global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
global_lookup RdrName
n =
MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
-> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
-> RnM (Maybe (Either Name [Name])))
-> ([RnM (Maybe (Either Name [Name]))]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> [RnM (Maybe (Either Name [Name]))]
-> RnM (Maybe (Either Name [Name]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> ([RnM (Maybe (Either Name [Name]))]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])])
-> [RnM (Maybe (Either Name [Name]))]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe (Either Name [Name]))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> [RnM (Maybe (Either Name [Name]))]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe (Either Name [Name]))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe (Either Name [Name]))]
-> RnM (Maybe (Either Name [Name])))
-> [RnM (Maybe (Either Name [Name]))]
-> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$
[ Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded Bool
overload_ok RdrName
n
, (Name -> Either Name [Name])
-> Maybe Name -> Maybe (Either Name [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name [Name]
forall a b. a -> Either a b
Left (Maybe Name -> Maybe (Either Name [Name]))
-> ([Name] -> Maybe Name) -> [Name] -> Maybe (Either Name [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Maybe Name
forall a. [a] -> Maybe a
listToMaybe ([Name] -> Maybe (Either Name [Name]))
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> RnM (Maybe (Either Name [Name]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
n ]
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 (RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base RdrName
rdr_name)
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn 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 <- RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base 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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGlobalOccRn" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
; WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name }
lookupGlobalOccRn_base :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_base 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
gre_name (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
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe RdrName
rdr_name
, [Name] -> Maybe Name
forall a. [a] -> Maybe a
listToMaybe ([Name] -> Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) [Name] -> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
rdr_name ]
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupInfoOccRn RdrName
rdr_name =
RdrName
-> (Name -> [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[]) (IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [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
gre_name (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
rdr_env)
; [Name]
qual_ns <- RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
rdr_name
; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [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 :: Bool -> RdrName
-> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded Bool
overload_ok RdrName
rdr_name =
RdrName
-> (Maybe Name -> Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
forall r. RdrName -> (Maybe Name -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name ((Name -> Either Name [Name])
-> Maybe Name -> Maybe (Either Name [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name [Name]
forall a b. a -> Either a b
Left) (RnM (Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name])))
-> RnM (Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$
do { GreLookupResult
res <- RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
; case GreLookupResult
res of
GreLookupResult
GreNotFound -> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Name [Name])
forall a. Maybe a
Nothing
OneNameMatch GlobalRdrElt
gre -> do
let wrapper :: a -> Either a [a]
wrapper = if GlobalRdrElt -> Bool
isRecFldGRE GlobalRdrElt
gre then [a] -> Either a [a]
forall a b. b -> Either a b
Right ([a] -> Either a [a]) -> (a -> [a]) -> a -> Either a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) else a -> Either a [a]
forall a b. a -> Either a b
Left
Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name])))
-> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$ Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just (Name -> Either Name [Name]
forall {a}. a -> Either a [a]
wrapper (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre))
MultipleNames [GlobalRdrElt]
gres | (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE [GlobalRdrElt]
gres Bool -> Bool -> Bool
&& Bool
overload_ok ->
Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name])))
-> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$ Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just ([Name] -> Either Name [Name]
forall a b. b -> Either a b
Right ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
gres))
MultipleNames [GlobalRdrElt]
gres -> do
RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just (Name -> Either Name [Name]
forall a b. a -> Either a b
Left (GlobalRdrElt -> Name
gre_name ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)))) }
data GreLookupResult = GreNotFound
| OneNameMatch GlobalRdrElt
| MultipleNames [GlobalRdrElt]
lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe RdrName
rdr_name
= do
GreLookupResult
res <- RdrName -> RnM GreLookupResult
lookupGreRn_helper 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 [GlobalRdrElt]
gres -> do
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreRn_maybe:NameClash" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
gres)
RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [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 ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [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 :: RdrName -> RnM GreLookupResult
lookupGreRn_helper :: RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
= do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
; case 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]
gres -> GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ([GlobalRdrElt] -> GreLookupResult
MultipleNames [GlobalRdrElt]
gres) }
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn RdrName
rdr_name
= do
GreLookupResult
mb_gre <- RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
case GreLookupResult
mb_gre of
GreLookupResult
GreNotFound ->
do
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreAvailRn" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 [GlobalRdrElt]
gres ->
do
RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [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
gre_name 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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGRE" (GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"addUsedGREs" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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_name :: GlobalRdrElt -> Name
gre_name = Name
name, 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 <- MsgDoc -> Name -> TcRn ModIface
loadInterfaceForName MsgDoc
doc Name
name
; case ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec ModIface
iface GlobalRdrElt
gre of
Just WarningTxt
txt -> WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnWarningsDeprecations)
(ImportSpec -> WarningTxt -> MsgDoc
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_mod :: Module
name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
doc :: MsgDoc
doc = String -> MsgDoc
text String
"The name" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"is mentioned explicitly")
mk_msg :: ImportSpec -> WarningTxt -> MsgDoc
mk_msg ImportSpec
imp_spec WarningTxt
txt
= [MsgDoc] -> MsgDoc
sep [ [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"In the use of"
MsgDoc -> MsgDoc -> MsgDoc
<+> NameSpace -> MsgDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ)
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ)
, MsgDoc -> MsgDoc
parens MsgDoc
imp_msg MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon ]
, WarningTxt -> MsgDoc
pprWarningTxtForMsg WarningTxt
txt ]
where
imp_mod :: ModuleName
imp_mod = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec
imp_msg :: MsgDoc
imp_msg = String -> MsgDoc
text String
"imported from" MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
imp_mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
extra
extra :: MsgDoc
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 = MsgDoc
Outputable.empty
| Bool
otherwise = String -> MsgDoc
text String
", but defined in" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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)
FldParent { par_is :: Parent -> Name
par_is = 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
lookupQualifiedNameGHCi :: RdrName -> RnM [Name]
lookupQualifiedNameGHCi :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi 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) [Name]
go_for_it DynFlags
dflags Bool
is_ghci }
where
go_for_it :: DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
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 MsgDoc ModIface
res <- MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FieldLabelString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe MsgDoc
doc ModuleName
mod IsBootInterface
NotBoot Maybe FieldLabelString
forall a. Maybe a
Nothing
; case MaybeErr MsgDoc ModIface
res of
Succeeded ModIface
iface
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Name
name
| AvailInfo
avail <- ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
, Name
name <- AvailInfo -> [Name]
availNames AvailInfo
avail
, Name -> OccName
nameOccName Name
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ ]
MaybeErr MsgDoc ModIface
_ ->
do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [] } }
| Bool
otherwise
= do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi: off" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
doc :: MsgDoc
doc = String -> MsgDoc
text String
"Need to find" MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name
data HsSigCtxt
= TopSigCtxt NameSet
| LocalBindCtxt NameSet
| ClsDeclCtxt Name
| InstDeclCtxt NameSet
| HsBootCtxt NameSet
| RoleAnnotCtxt NameSet
instance Outputable HsSigCtxt where
ppr :: HsSigCtxt -> MsgDoc
ppr (TopSigCtxt NameSet
ns) = String -> MsgDoc
text String
"TopSigCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
ppr (LocalBindCtxt NameSet
ns) = String -> MsgDoc
text String
"LocalBindCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
ppr (ClsDeclCtxt Name
n) = String -> MsgDoc
text String
"ClsDeclCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
ppr (InstDeclCtxt NameSet
ns) = String -> MsgDoc
text String
"InstDeclCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
ppr (HsBootCtxt NameSet
ns) = String -> MsgDoc
text String
"HsBootCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
ppr (RoleAnnotCtxt NameSet
ns) = String -> MsgDoc
text String
"RoleAnnotCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
lookupSigOccRn :: HsSigCtxt
-> Sig GhcPs
-> Located RdrName -> RnM (Located Name)
lookupSigOccRn :: HsSigCtxt -> Sig GhcPs -> Located RdrName -> RnM (Located Name)
lookupSigOccRn HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> MsgDoc -> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> MsgDoc
forall name. Sig name -> MsgDoc
hsSigDoc Sig GhcPs
sig)
lookupSigCtxtOccRn :: HsSigCtxt
-> SDoc
-> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn :: HsSigCtxt -> MsgDoc -> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt MsgDoc
what
= (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
wrapLocM ((RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name))
-> (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
do { Either MsgDoc Name
mb_name <- HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt MsgDoc
what RdrName
rdr_name
; case Either MsgDoc Name
mb_name of
Left MsgDoc
err -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
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 MsgDoc Name)
lookupBindGroupOcc :: HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt MsgDoc
what RdrName
rdr_name
| Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
= Name -> RnM (Either MsgDoc 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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n') }
| Bool
otherwise
= case HsSigCtxt
ctxt of
HsBootCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
TopSigCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
LocalBindCtxt NameSet
ns -> NameSet -> RnM (Either MsgDoc Name)
lookup_group NameSet
ns
ClsDeclCtxt Name
cls -> Name -> RnM (Either MsgDoc 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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (Name -> Either MsgDoc Name) -> Name -> Either MsgDoc Name
forall a b. (a -> b) -> a -> b
$ RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
else (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
where
lookup_cls_op :: Name -> RnM (Either MsgDoc Name)
lookup_cls_op Name
cls
= Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc Bool
True Name
cls MsgDoc
doc RdrName
rdr_name
where
doc :: MsgDoc
doc = String -> MsgDoc
text String
"method of class" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
cls)
lookup_top :: (Name -> Bool) -> RnM (Either MsgDoc 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
gre_name
([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 :: MsgDoc
candidates_msg = [Name] -> MsgDoc
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
gre_name) [GlobalRdrElt]
all_gres of
[] | [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> MsgDoc -> RnM (Either MsgDoc Name)
forall {m :: * -> *} {b}. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
candidates_msg
| Bool
otherwise -> MsgDoc -> RnM (Either MsgDoc Name)
forall {m :: * -> *} {b}. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
local_msg
(GlobalRdrElt
gre:[GlobalRdrElt]
_) -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre)) }
lookup_group :: NameSet -> RnM (Either MsgDoc 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 :: MsgDoc
candidates_msg = [Name] -> MsgDoc
candidates ([Name] -> MsgDoc) -> [Name] -> MsgDoc
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 MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n)
| Bool
otherwise -> MsgDoc -> RnM (Either MsgDoc Name)
forall {m :: * -> *} {b}. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
local_msg
Maybe Name
Nothing -> MsgDoc -> RnM (Either MsgDoc Name)
forall {m :: * -> *} {b}. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
candidates_msg }
bale_out_with :: MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
msg
= Either MsgDoc b -> m (Either MsgDoc b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc b
forall a b. a -> Either a b
Left ([MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
what
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"for" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
, Arity -> MsgDoc -> MsgDoc
nest Arity
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"lacks an accompanying binding"]
MsgDoc -> MsgDoc -> MsgDoc
$$ Arity -> MsgDoc -> MsgDoc
nest Arity
2 MsgDoc
msg))
local_msg :: MsgDoc
local_msg = MsgDoc -> MsgDoc
parens (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
what MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"must be given where")
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is declared"
candidates :: [Name] -> MsgDoc
candidates :: [Name] -> MsgDoc
candidates [Name]
names_in_scope
= case [Name]
similar_names of
[] -> MsgDoc
Outputable.empty
[Name
n] -> String -> MsgDoc
text String
"Perhaps you meant" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
pp_item Name
n
[Name]
_ -> [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Perhaps you meant one of these:"
, Arity -> MsgDoc -> MsgDoc
nest Arity
2 ((Name -> MsgDoc) -> [Name] -> MsgDoc
forall a. (a -> MsgDoc) -> [a] -> MsgDoc
pprWithCommas Name -> MsgDoc
pp_item [Name]
similar_names) ]
where
similar_names :: [Name]
similar_names
= String -> [(String, Name)] -> [Name]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FieldLabelString -> String
unpackFS (FieldLabelString -> String) -> FieldLabelString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FieldLabelString
occNameFS (OccName -> FieldLabelString) -> OccName -> FieldLabelString
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 -> ((FieldLabelString -> String
unpackFS (FieldLabelString -> String) -> FieldLabelString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FieldLabelString
occNameFS (OccName -> FieldLabelString) -> OccName -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
x), Name
x))
[Name]
names_in_scope
pp_item :: Name -> MsgDoc
pp_item Name
x = MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
x) MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
parens (Name -> MsgDoc
pprDefinedAt Name
x)
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames :: HsSigCtxt -> MsgDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames HsSigCtxt
ctxt MsgDoc
what RdrName
rdr_name
= do { [Either MsgDoc (RdrName, Name)]
mb_gres <- (RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name)))
-> [RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Either MsgDoc (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 MsgDoc (RdrName, Name))
lookup (RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name)
; let ([MsgDoc]
errs, [(RdrName, Name)]
names) = [Either MsgDoc (RdrName, Name)] -> ([MsgDoc], [(RdrName, Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either MsgDoc (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
$ MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr ([MsgDoc] -> MsgDoc
forall a. [a] -> a
head [MsgDoc]
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 MsgDoc (RdrName, Name))
lookup RdrName
rdr = do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Either MsgDoc Name
nameEither <- HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt MsgDoc
what RdrName
rdr
; Either MsgDoc (RdrName, Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name))
forall (m :: * -> *) a. Monad m => a -> m a
return (Module
-> RdrName -> Either MsgDoc Name -> Either MsgDoc (RdrName, Name)
forall {a}.
(HasOccName a, Outputable a) =>
Module -> a -> Either MsgDoc Name -> Either MsgDoc (a, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr Either MsgDoc Name
nameEither) }
guard_builtin_syntax :: Module -> a -> Either MsgDoc Name -> Either MsgDoc (a, Name)
guard_builtin_syntax Module
this_mod a
rdr (Right Name
name)
| Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe (a -> OccName
forall name. HasOccName name => name -> OccName
occName a
rdr)
, Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
= MsgDoc -> Either MsgDoc (a, Name)
forall a b. a -> Either a b
Left ([MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text String
"Illegal", MsgDoc
what, String -> MsgDoc
text String
"of built-in syntax:", a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
rdr])
| Bool
otherwise
= (a, Name) -> Either MsgDoc (a, Name)
forall a b. b -> Either a b
Right (a
rdr, Name
name)
guard_builtin_syntax Module
_ a
_ (Left MsgDoc
err) = MsgDoc -> Either MsgDoc (a, Name)
forall a b. a -> Either a b
Left MsgDoc
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 -> FieldLabelString
occNameFS OccName
occ FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FieldLabelString
fsLit String
"~" -> RdrName
eqTyCon_RDR
RdrName
_ -> RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
rdr_name NameSpace
tcName
lookupIfThenElse :: Bool
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupIfThenElse :: Bool -> RnM (SyntaxExpr GhcRn, NameSet)
lookupIfThenElse Bool
maybe_use_rs
= 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 Bool -> Bool -> Bool
&& Bool
maybe_use_rs)
then (SyntaxExprRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn
NoSyntaxExprRn, NameSet
emptyFVs)
else do { Name
ite <- RdrName -> RnM Name
lookupOccRn (FieldLabelString -> RdrName
mkVarUnqual (String -> FieldLabelString
fsLit String
"ifThenElse"))
; (SyntaxExprRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Name -> SyntaxExprRn
mkRnSyntaxExpr Name
ite
, Name -> NameSet
unitFV Name
ite ) } }
lookupSyntaxName :: Name
-> RnM (Name, FreeVars)
lookupSyntaxName :: Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
= 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
(Name, NameSet) -> RnM (Name, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
std_name, NameSet
emptyFVs)
else
do { Name
usr_name <- 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
usr_name, Name -> NameSet
unitFV Name
usr_name) } }
lookupSyntaxExpr :: Name
-> RnM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr :: Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
= ((Name, NameSet) -> (HsExpr GhcRn, NameSet))
-> RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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 (id :: Pass). IdP (GhcPass id) -> HsExpr (GhcPass id)
nl_HsVar) (RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet))
-> RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall a b. (a -> b) -> a -> b
$ Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
lookupSyntax :: Name
-> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntax Name
std_name
= ((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
fmap ((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) (RnM (HsExpr GhcRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet))
-> RnM (HsExpr GhcRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall a b. (a -> b) -> a -> b
$ Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
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 -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Located Name -> HsExpr GhcRn)
-> (Name -> Located Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall e. e -> Located e
noLoc) [Name]
std_names, NameSet
emptyFVs)
else
do { [Name]
usr_names <- (Name -> RnM Name)
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [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 -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Located Name -> HsExpr GhcRn)
-> (Name -> Located Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall e. e -> Located e
noLoc) [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 (id :: Pass). IdP (GhcPass id) -> HsExpr (GhcPass id)
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
lookupRebound :: FastString -> RnM (Maybe (Located Name))
lookupRebound :: FieldLabelString -> RnM (Maybe (Located Name))
lookupRebound FieldLabelString
nameStr = do
Bool
rebind <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
if Bool
rebind
then (\Name
nm -> Located Name -> Maybe (Located Name)
forall a. a -> Maybe a
Just (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L (Name -> SrcSpan
nameSrcSpan Name
nm) Name
nm)) (Name -> Maybe (Located Name))
-> RnM Name -> RnM (Maybe (Located Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
RdrName -> RnM Name
lookupOccRn (FieldLabelString -> RdrName
mkVarUnqual FieldLabelString
nameStr)
else Maybe (Located Name) -> RnM (Maybe (Located Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Located Name)
forall a. Maybe a
Nothing
lookupReboundIf :: RnM (Maybe (Located Name))
lookupReboundIf :: RnM (Maybe (Located Name))
lookupReboundIf = FieldLabelString -> RnM (Maybe (Located Name))
lookupRebound FieldLabelString
reboundIfSymbol
opDeclErr :: RdrName -> SDoc
opDeclErr :: RdrName -> MsgDoc
opDeclErr RdrName
n
= MsgDoc -> Arity -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal declaration of a type or class operator" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
n))
Arity
2 (String -> MsgDoc
text String
"Use TypeOperators to declare operators in type and declarations")
badOrigBinding :: RdrName -> SDoc
badOrigBinding :: RdrName -> MsgDoc
badOrigBinding RdrName
name
| Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
= String -> MsgDoc
text String
"Illegal binding of built-in syntax:" MsgDoc -> MsgDoc -> MsgDoc
<+> OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ
| Bool
otherwise
= String -> MsgDoc
text String
"Cannot redefine a Name retrieved by a Template Haskell quote:"
MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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