{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.Tc.Gen.Export (rnExports, exports_from_avail) where
import GHC.Prelude
import GHC.Hs
import GHC.Types.FieldLabel
import GHC.Builtin.Names
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.TcType
import GHC.Rename.Names
import GHC.Rename.Env
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Unit.Module.Imported
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Core.ConLike
import GHC.Core.PatSyn
import GHC.Data.Maybe
import GHC.Utils.Misc (capitalise)
import GHC.Data.FastString (fsLit)
import GHC.Driver.Env
import GHC.Types.TyThing( tyThingCategory )
import GHC.Types.Unique.Set
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Avail
import GHC.Types.SourceFile
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name.Reader
import Control.Monad
import GHC.Driver.Session
import GHC.Parser.PostProcess ( setRdrNameSpace )
import Data.Either ( partitionEithers )
data ExportAccum
= ExportAccum
ExportOccMap
(UniqSet ModuleName)
emptyExportAccum :: ExportAccum
emptyExportAccum :: ExportAccum
emptyExportAccum = ExportOccMap -> UniqSet ModuleName -> ExportAccum
ExportAccum ExportOccMap
forall a. OccEnv a
emptyOccEnv UniqSet ModuleName
forall a. UniqSet a
emptyUniqSet
accumExports :: (ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))
-> [x]
-> TcRn [y]
accumExports :: forall x y.
(ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))
-> [x] -> TcRn [y]
accumExports ExportAccum -> x -> TcRn (Maybe (ExportAccum, y))
f = ((ExportAccum, [Maybe y]) -> [y])
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, [Maybe y])
-> IOEnv (Env TcGblEnv TcLclEnv) [y]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe y] -> [y]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe y] -> [y])
-> ((ExportAccum, [Maybe y]) -> [Maybe y])
-> (ExportAccum, [Maybe y])
-> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExportAccum, [Maybe y]) -> [Maybe y]
forall a b. (a, b) -> b
snd) (IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, [Maybe y])
-> IOEnv (Env TcGblEnv TcLclEnv) [y])
-> ([x] -> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, [Maybe y]))
-> [x]
-> IOEnv (Env TcGblEnv TcLclEnv) [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExportAccum
-> x -> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y))
-> ExportAccum
-> [x]
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, [Maybe y])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ExportAccum
-> x -> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y)
f' ExportAccum
emptyExportAccum
where f' :: ExportAccum
-> x -> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y)
f' ExportAccum
acc x
x = do
Maybe (Maybe (ExportAccum, y))
m <- TcRn (Maybe (ExportAccum, y))
-> TcRn (Maybe (Maybe (ExportAccum, y)))
forall r. TcRn r -> TcRn (Maybe r)
attemptM (ExportAccum -> x -> TcRn (Maybe (ExportAccum, y))
f ExportAccum
acc x
x)
(ExportAccum, Maybe y)
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ExportAccum, Maybe y)
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y))
-> (ExportAccum, Maybe y)
-> IOEnv (Env TcGblEnv TcLclEnv) (ExportAccum, Maybe y)
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe (ExportAccum, y))
m of
Just (Just (ExportAccum
acc', y
y)) -> (ExportAccum
acc', y -> Maybe y
forall a. a -> Maybe a
Just y
y)
Maybe (Maybe (ExportAccum, y))
_ -> (ExportAccum
acc, Maybe y
forall a. Maybe a
Nothing)
type ExportOccMap = OccEnv (GreName, IE GhcPs)
rnExports :: Bool
-> Maybe (LocatedL [LIE GhcPs])
-> RnM TcGblEnv
rnExports :: Bool -> Maybe (LocatedL [LIE GhcPs]) -> RnM TcGblEnv
rnExports Bool
explicit_mod Maybe (LocatedL [LIE GhcPs])
exports
= RnM TcGblEnv -> RnM TcGblEnv
forall r. TcM r -> TcM r
checkNoErrs (RnM TcGblEnv -> RnM TcGblEnv) -> RnM TcGblEnv -> RnM TcGblEnv
forall a b. (a -> b) -> a -> b
$
WarningFlag -> RnM TcGblEnv -> RnM TcGblEnv
forall gbl lcl a.
WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetWOptM WarningFlag
Opt_WarnWarningsDeprecations (RnM TcGblEnv -> RnM TcGblEnv) -> RnM TcGblEnv -> RnM TcGblEnv
forall a b. (a -> b) -> a -> b
$
do { HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; TcGblEnv
tcg_env <- RnM TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
TcGblEnv { tcg_mod :: TcGblEnv -> Module
tcg_mod = Module
this_mod
, tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
rdr_env
, tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails
imports
, tcg_src :: TcGblEnv -> HscSource
tcg_src = HscSource
hsc_src } = TcGblEnv
tcg_env
default_main :: RdrName
default_main | HscEnv -> Module
mainModIs HscEnv
hsc_env Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
, Just String
main_fun <- DynFlags -> Maybe String
mainFunIs DynFlags
dflags
= NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
main_fun)
| Bool
otherwise
= RdrName
main_RDR_Unqual
; Bool
has_main <- (Bool -> Bool
not (Bool -> Bool) -> ([Name] -> Bool) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([Name] -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupInfoOccRn RdrName
default_main
; let real_exports :: Maybe (LocatedL [LIE GhcPs])
real_exports
| Bool
explicit_mod = Maybe (LocatedL [LIE GhcPs])
exports
| Bool
has_main
= LocatedAn AnnList [LocatedAn AnnListItem (IE GhcPs)]
-> Maybe (LocatedAn AnnList [LocatedAn AnnListItem (IE GhcPs)])
forall a. a -> Maybe a
Just ([LocatedAn AnnListItem (IE GhcPs)]
-> LocatedAn AnnList [LocatedAn AnnListItem (IE GhcPs)]
forall a an. a -> LocatedAn an a
noLocA [IE GhcPs -> LocatedAn AnnListItem (IE GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
noExtField
(IEWrappedName RdrName
-> LocatedAn AnnListItem (IEWrappedName RdrName)
forall a an. a -> LocatedAn an a
noLocA (GenLocated SrcSpanAnnN RdrName -> IEWrappedName RdrName
forall name. LocatedN name -> IEWrappedName name
IEName (GenLocated SrcSpanAnnN RdrName -> IEWrappedName RdrName)
-> GenLocated SrcSpanAnnN RdrName -> IEWrappedName RdrName
forall a b. (a -> b) -> a -> b
$ RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
default_main)))])
| Bool
otherwise = Maybe (LocatedL [LIE GhcPs])
forall a. Maybe a
Nothing
; let do_it :: RnM (Maybe [(LIE GhcRn, [AvailInfo])], [AvailInfo])
do_it = Maybe (LocatedL [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM (Maybe [(LIE GhcRn, [AvailInfo])], [AvailInfo])
exports_from_avail Maybe (LocatedL [LIE GhcPs])
real_exports GlobalRdrEnv
rdr_env ImportAvails
imports Module
this_mod
; (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
rn_exports, [AvailInfo]
final_avails)
<- if HscSource
hsc_src HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsigFile
then do (Maybe
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
mb_r, Messages DecoratedSDoc
msgs) <- IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> TcRn
(Maybe
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo]),
Messages DecoratedSDoc)
forall a. TcRn a -> TcRn (Maybe a, Messages DecoratedSDoc)
tryTc IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
RnM (Maybe [(LIE GhcRn, [AvailInfo])], [AvailInfo])
do_it
case Maybe
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
mb_r of
Just (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
r -> (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
r
Maybe
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
Nothing -> Messages DecoratedSDoc -> TcRn ()
addMessages Messages DecoratedSDoc
msgs TcRn ()
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall env a. IOEnv env a
failM
else IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall r. TcM r -> TcM r
checkNoErrs IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
RnM (Maybe [(LIE GhcRn, [AvailInfo])], [AvailInfo])
do_it
; let final_ns :: NameSet
final_ns = [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
final_avails
; String -> SDoc -> TcRn ()
traceRn String
"rnExports: Exports:" ([AvailInfo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AvailInfo]
final_avails)
; TcGblEnv -> RnM TcGblEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
tcg_env { tcg_exports :: [AvailInfo]
tcg_exports = [AvailInfo]
final_avails
, tcg_rn_exports :: Maybe [(LIE GhcRn, [AvailInfo])]
tcg_rn_exports = case TcGblEnv -> Maybe [(LIE GhcRn, [AvailInfo])]
tcg_rn_exports TcGblEnv
tcg_env of
Maybe [(LIE GhcRn, [AvailInfo])]
Nothing -> Maybe [(LIE GhcRn, [AvailInfo])]
forall a. Maybe a
Nothing
Just [(LIE GhcRn, [AvailInfo])]
_ -> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
Maybe [(LIE GhcRn, [AvailInfo])]
rn_exports
, tcg_dus :: DefUses
tcg_dus = TcGblEnv -> DefUses
tcg_dus TcGblEnv
tcg_env DefUses -> DefUses -> DefUses
`plusDU`
NameSet -> DefUses
usesOnly NameSet
final_ns }) }
exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM (Maybe [(LIE GhcRn, [AvailInfo])], [AvailInfo])
exports_from_avail Maybe (LocatedL [LIE GhcPs])
Nothing GlobalRdrEnv
rdr_env ImportAvails
_imports Module
_this_mod
= do {
; Bool
warnMissingExportList <- WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnMissingExportList
; WarningFlag -> Bool -> SDoc -> TcRn ()
warnIfFlag WarningFlag
Opt_WarnMissingExportList
Bool
warnMissingExportList
(ModuleName -> SDoc
missingModuleExportWarn (ModuleName -> SDoc) -> ModuleName -> SDoc
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
_this_mod)
; let avails :: [AvailInfo]
avails =
(AvailInfo -> AvailInfo) -> [AvailInfo] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> AvailInfo
fix_faminst ([AvailInfo] -> [AvailInfo])
-> (GlobalRdrEnv -> [AvailInfo]) -> GlobalRdrEnv -> [AvailInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo
([GlobalRdrElt] -> [AvailInfo])
-> (GlobalRdrEnv -> [GlobalRdrElt]) -> GlobalRdrEnv -> [AvailInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE ([GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrEnv -> [GlobalRdrElt])
-> GlobalRdrEnv
-> [GlobalRdrElt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts (GlobalRdrEnv -> [AvailInfo]) -> GlobalRdrEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv
rdr_env
; (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall a. Maybe a
Nothing, [AvailInfo]
avails) }
where
fix_faminst :: AvailInfo -> AvailInfo
fix_faminst avail :: AvailInfo
avail@(AvailTC Name
n [GreName]
ns)
| AvailInfo -> Bool
availExportsDecl AvailInfo
avail = AvailInfo
avail
| Bool
otherwise = Name -> [GreName] -> AvailInfo
AvailTC Name
n (Name -> GreName
NormalGreName Name
nGreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ns)
fix_faminst AvailInfo
avail = AvailInfo
avail
exports_from_avail (Just (L SrcSpanAnnL
_ [LIE GhcPs]
rdr_items)) GlobalRdrEnv
rdr_env ImportAvails
imports Module
this_mod
= do [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
ie_avails <- (ExportAccum
-> LocatedAn AnnListItem (IE GhcPs)
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))))
-> [LocatedAn AnnListItem (IE GhcPs)]
-> TcRn [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall x y.
(ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))
-> [x] -> TcRn [y]
accumExports ExportAccum
-> LocatedAn AnnListItem (IE GhcPs)
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
ExportAccum
-> LIE GhcPs -> RnM (Maybe (ExportAccum, (LIE GhcRn, [AvailInfo])))
do_litem [LocatedAn AnnListItem (IE GhcPs)]
[LIE GhcPs]
rdr_items
let final_exports :: [AvailInfo]
final_exports = [AvailInfo] -> [AvailInfo]
nubAvails (((GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]) -> [AvailInfo])
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
-> [AvailInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]) -> [AvailInfo]
forall a b. (a, b) -> b
snd [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
ie_avails)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])],
[AvailInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
-> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
forall a. a -> Maybe a
Just [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
ie_avails, [AvailInfo]
final_exports)
where
do_litem :: ExportAccum -> LIE GhcPs
-> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))
do_litem :: ExportAccum
-> LIE GhcPs -> RnM (Maybe (ExportAccum, (LIE GhcRn, [AvailInfo])))
do_litem ExportAccum
acc LIE GhcPs
lie = SrcSpan
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (LocatedAn AnnListItem (IE GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn AnnListItem (IE GhcPs)
LIE GhcPs
lie) (ExportAccum
-> LIE GhcPs -> RnM (Maybe (ExportAccum, (LIE GhcRn, [AvailInfo])))
exports_from_item ExportAccum
acc LIE GhcPs
lie)
kids_env :: NameEnv [GlobalRdrElt]
kids_env :: NameEnv [GlobalRdrElt]
kids_env = [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv (GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
rdr_env)
expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]
expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]
expand_tyty_gre (gre :: GlobalRdrElt
gre@GRE { gre_par :: GlobalRdrElt -> Parent
gre_par = ParentIs Name
p })
| Name -> Bool
isTyConName Name
p, Name -> Bool
isTyConName (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre) = [GlobalRdrElt
gre, GlobalRdrElt
gre{ gre_par :: Parent
gre_par = Parent
NoParent }]
expand_tyty_gre GlobalRdrElt
gre = [GlobalRdrElt
gre]
imported_modules :: [ModuleName]
imported_modules = [ ImportedModsVal -> ModuleName
imv_name ImportedModsVal
imv
| [ImportedBy]
xs <- ModuleEnv [ImportedBy] -> [[ImportedBy]]
forall a. ModuleEnv a -> [a]
moduleEnvElts (ModuleEnv [ImportedBy] -> [[ImportedBy]])
-> ModuleEnv [ImportedBy] -> [[ImportedBy]]
forall a b. (a -> b) -> a -> b
$ ImportAvails -> ModuleEnv [ImportedBy]
imp_mods ImportAvails
imports
, ImportedModsVal
imv <- [ImportedBy] -> [ImportedModsVal]
importedByUser [ImportedBy]
xs ]
exports_from_item :: ExportAccum -> LIE GhcPs
-> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))
exports_from_item :: ExportAccum
-> LIE GhcPs -> RnM (Maybe (ExportAccum, (LIE GhcRn, [AvailInfo])))
exports_from_item (ExportAccum ExportOccMap
occs UniqSet ModuleName
earlier_mods)
(L SrcSpanAnnA
loc ie :: IE GhcPs
ie@(IEModuleContents XIEModuleContents GhcPs
_ lmod :: XRec GhcPs ModuleName
lmod@(L SrcSpanAnnA
_ ModuleName
mod)))
| ModuleName
mod ModuleName -> UniqSet ModuleName -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet ModuleName
earlier_mods
= do { WarningFlag -> Bool -> SDoc -> TcRn ()
warnIfFlag WarningFlag
Opt_WarnDuplicateExports Bool
True
(ModuleName -> SDoc
dupModuleExport ModuleName
mod) ;
Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
forall a. Maybe a
Nothing }
| Bool
otherwise
= do { let { exportValid :: Bool
exportValid = (ModuleName
mod ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
imported_modules)
Bool -> Bool -> Bool
|| (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
mod)
; gre_prs :: [(GlobalRdrElt, GlobalRdrElt)]
gre_prs = ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt, GlobalRdrElt)]
pickGREsModExp ModuleName
mod (GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
rdr_env)
; new_exports :: [AvailInfo]
new_exports = [ GlobalRdrElt -> AvailInfo
availFromGRE GlobalRdrElt
gre'
| (GlobalRdrElt
gre, GlobalRdrElt
_) <- [(GlobalRdrElt, GlobalRdrElt)]
gre_prs
, GlobalRdrElt
gre' <- GlobalRdrElt -> [GlobalRdrElt]
expand_tyty_gre GlobalRdrElt
gre ]
; all_gres :: [GlobalRdrElt]
all_gres = ((GlobalRdrElt, GlobalRdrElt) -> [GlobalRdrElt] -> [GlobalRdrElt])
-> [GlobalRdrElt]
-> [(GlobalRdrElt, GlobalRdrElt)]
-> [GlobalRdrElt]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(GlobalRdrElt
gre1,GlobalRdrElt
gre2) [GlobalRdrElt]
gres -> GlobalRdrElt
gre1 GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: GlobalRdrElt
gre2 GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres) [] [(GlobalRdrElt, GlobalRdrElt)]
gre_prs
; mods :: UniqSet ModuleName
mods = UniqSet ModuleName -> ModuleName -> UniqSet ModuleName
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet UniqSet ModuleName
earlier_mods ModuleName
mod
}
; Bool -> SDoc -> TcRn ()
checkErr Bool
exportValid (ModuleName -> SDoc
moduleNotImported ModuleName
mod)
; WarningFlag -> Bool -> SDoc -> TcRn ()
warnIfFlag WarningFlag
Opt_WarnDodgyExports
(Bool
exportValid Bool -> Bool -> Bool
&& [(GlobalRdrElt, GlobalRdrElt)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(GlobalRdrElt, GlobalRdrElt)]
gre_prs)
(ModuleName -> SDoc
nullModuleExport ModuleName
mod)
; String -> SDoc -> TcRn ()
traceRn String
"efa" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod SDoc -> SDoc -> SDoc
$$ [GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
all_gres)
; [GlobalRdrElt] -> TcRn ()
addUsedGREs [GlobalRdrElt]
all_gres
; ExportOccMap
occs' <- IE GhcPs -> ExportOccMap -> [AvailInfo] -> RnM ExportOccMap
check_occs IE GhcPs
ie ExportOccMap
occs [AvailInfo]
new_exports
; String -> SDoc -> TcRn ()
traceRn String
"export_mod"
([SDoc] -> SDoc
vcat [ ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod
, [AvailInfo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AvailInfo]
new_exports ])
; Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
forall a. a -> Maybe a
Just ( ExportOccMap -> UniqSet ModuleName -> ExportAccum
ExportAccum ExportOccMap
occs' UniqSet ModuleName
mods
, ( SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XIEModuleContents GhcRn -> XRec GhcRn ModuleName -> IE GhcRn
forall pass.
XIEModuleContents pass -> XRec pass ModuleName -> IE pass
IEModuleContents NoExtField
XIEModuleContents GhcRn
noExtField XRec GhcPs ModuleName
XRec GhcRn ModuleName
lmod)
, [AvailInfo]
new_exports))) }
exports_from_item acc :: ExportAccum
acc@(ExportAccum ExportOccMap
occs UniqSet ModuleName
mods) (L SrcSpanAnnA
loc IE GhcPs
ie)
| Just IE GhcRn
new_ie <- IE GhcPs -> Maybe (IE GhcRn)
lookup_doc_ie IE GhcPs
ie
= Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
forall a. a -> Maybe a
Just (ExportAccum
acc, (SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IE GhcRn
new_ie, [])))
| Bool
otherwise
= do (IE GhcRn
new_ie, AvailInfo
avail) <- IE GhcPs -> RnM (IE GhcRn, AvailInfo)
lookup_ie IE GhcPs
ie
if Name -> Bool
isUnboundName (IE GhcRn -> IdP GhcRn
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcRn
new_ie)
then Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
forall a. Maybe a
Nothing
else do
ExportOccMap
occs' <- IE GhcPs -> ExportOccMap -> [AvailInfo] -> RnM ExportOccMap
check_occs IE GhcPs
ie ExportOccMap
occs [AvailInfo
avail]
Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> TcRn
(Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
-> Maybe
(ExportAccum, (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo]))
forall a. a -> Maybe a
Just ( ExportOccMap -> UniqSet ModuleName -> ExportAccum
ExportAccum ExportOccMap
occs' UniqSet ModuleName
mods
, (SrcSpanAnnA -> IE GhcRn -> GenLocated SrcSpanAnnA (IE GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IE GhcRn
new_ie, [AvailInfo
avail])))
lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)
lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)
lookup_ie (IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
rdr))
= do (Name
name, AvailInfo
avail) <- RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn (RdrName -> RnM (Name, AvailInfo))
-> RdrName -> RnM (Name, AvailInfo)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
rdr
(IE GhcRn, AvailInfo) -> RnM (IE GhcRn, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcRn
noExtField (SrcSpanAnnA
-> IEWrappedName Name
-> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
rdr Name
name)), AvailInfo
avail)
lookup_ie (IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpanAnnA
l IEWrappedName (IdP GhcPs)
rdr))
= do (Name
name, AvailInfo
avail) <- RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn (RdrName -> RnM (Name, AvailInfo))
-> RdrName -> RnM (Name, AvailInfo)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
rdr
(IE GhcRn, AvailInfo) -> RnM (IE GhcRn, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEThingAbs GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs XIEThingAbs GhcRn
forall a. EpAnn a
noAnn (SrcSpanAnnA
-> IEWrappedName Name
-> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
rdr Name
name))
, AvailInfo
avail)
lookup_ie ie :: IE GhcPs
ie@(IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
n')
= do
(Located Name
n, [Name]
avail, [FieldLabel]
flds) <- IE GhcPs
-> LocatedAn AnnListItem (IEWrappedName RdrName)
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all IE GhcPs
ie LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
n'
let name :: Name
name = Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
n
(IE GhcRn, AvailInfo) -> RnM (IE GhcRn, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEThingAll GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll XIEThingAll GhcRn
forall a. EpAnn a
noAnn (LocatedAn AnnListItem (IEWrappedName RdrName)
-> Name -> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall name1 name2.
LIEWrappedName name1 -> name2 -> LIEWrappedName name2
replaceLWrappedName LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
n' (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
n))
, Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name (Name
nameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
avail) [FieldLabel]
flds)
lookup_ie ie :: IE GhcPs
ie@(IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
l IEWildcard
wc [LIEWrappedName (IdP GhcPs)]
sub_rdrs)
= do
(Located Name
lname, [GenLocated SrcSpanAnnA (IEWrappedName Name)]
subs, [Name]
avails, [Located FieldLabel]
flds)
<- IE GhcPs
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
forall (p :: Pass) a.
OutputableBndrId p =>
IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt IE GhcPs
ie (TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel]))
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
forall a b. (a -> b) -> a -> b
$ LocatedAn AnnListItem (IEWrappedName RdrName)
-> [LocatedAn AnnListItem (IEWrappedName RdrName)]
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
lookup_ie_with LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
l [LocatedAn AnnListItem (IEWrappedName RdrName)]
[LIEWrappedName (IdP GhcPs)]
sub_rdrs
(Located Name
_, [Name]
all_avail, [FieldLabel]
all_flds) <-
case IEWildcard
wc of
IEWildcard
NoIEWildcard -> (Located Name, [Name], [FieldLabel])
-> RnM (Located Name, [Name], [FieldLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return (Located Name
lname, [], [])
IEWildcard Int
_ -> IE GhcPs
-> LocatedAn AnnListItem (IEWrappedName RdrName)
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all IE GhcPs
ie LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
l
let name :: Name
name = Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
lname
let flds' :: [Located FieldLabel]
flds' = [Located FieldLabel]
flds [Located FieldLabel]
-> [Located FieldLabel] -> [Located FieldLabel]
forall a. [a] -> [a] -> [a]
++ ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall e. e -> Located e
noLoc [FieldLabel]
all_flds)
(IE GhcRn, AvailInfo) -> RnM (IE GhcRn, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIEThingWith GhcRn
-> LIEWrappedName (IdP GhcRn)
-> IEWildcard
-> [LIEWrappedName (IdP GhcRn)]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith [Located FieldLabel]
XIEThingWith GhcRn
flds' (LocatedAn AnnListItem (IEWrappedName RdrName)
-> Name -> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall name1 name2.
LIEWrappedName name1 -> name2 -> LIEWrappedName name2
replaceLWrappedName LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
l Name
name) IEWildcard
wc [GenLocated SrcSpanAnnA (IEWrappedName Name)]
[LIEWrappedName (IdP GhcRn)]
subs,
Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
name (Name
name Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
avails [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
all_avail)
((Located FieldLabel -> FieldLabel)
-> [Located FieldLabel] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map Located FieldLabel -> FieldLabel
forall l e. GenLocated l e -> e
unLoc [Located FieldLabel]
flds [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. [a] -> [a] -> [a]
++ [FieldLabel]
all_flds))
lookup_ie IE GhcPs
_ = String -> RnM (IE GhcRn, AvailInfo)
forall a. String -> a
panic String
"lookup_ie"
lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
-> RnM (Located Name, [LIEWrappedName Name], [Name],
[Located FieldLabel])
lookup_ie_with :: LocatedAn AnnListItem (IEWrappedName RdrName)
-> [LocatedAn AnnListItem (IEWrappedName RdrName)]
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
lookup_ie_with (L SrcSpanAnnA
l IEWrappedName RdrName
rdr) [LocatedAn AnnListItem (IEWrappedName RdrName)]
sub_rdrs
= do Name
name <- RdrName -> RnM Name
lookupGlobalOccRn (RdrName -> RnM Name) -> RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
rdr
([GenLocated SrcSpanAnnA (IEWrappedName Name)]
non_flds, [Located FieldLabel]
flds) <- Name
-> [LocatedAn AnnListItem (IEWrappedName RdrName)]
-> RnM
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
lookupChildrenExport Name
name [LocatedAn AnnListItem (IEWrappedName RdrName)]
sub_rdrs
if Name -> Bool
isUnboundName Name
name
then (Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) Name
name, [], [Name
name], [])
else (Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
-> TcM
(Located Name, [GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Name], [Located FieldLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) Name
name, [GenLocated SrcSpanAnnA (IEWrappedName Name)]
non_flds
, (GenLocated SrcSpanAnnA (IEWrappedName Name) -> Name)
-> [GenLocated SrcSpanAnnA (IEWrappedName Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (IEWrappedName Name -> Name
forall name. IEWrappedName name -> name
ieWrappedName (IEWrappedName Name -> Name)
-> (GenLocated SrcSpanAnnA (IEWrappedName Name)
-> IEWrappedName Name)
-> GenLocated SrcSpanAnnA (IEWrappedName Name)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IEWrappedName Name) -> IEWrappedName Name
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IEWrappedName Name)]
non_flds
, [Located FieldLabel]
flds)
lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all :: IE GhcPs
-> LocatedAn AnnListItem (IEWrappedName RdrName)
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all IE GhcPs
ie (L SrcSpanAnnA
l IEWrappedName RdrName
rdr) =
do Name
name <- RdrName -> RnM Name
lookupGlobalOccRn (RdrName -> RnM Name) -> RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
rdr
let gres :: [GlobalRdrElt]
gres = NameEnv [GlobalRdrElt] -> Name -> [GlobalRdrElt]
forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrElt]
kids_env Name
name
([Name]
non_flds, [FieldLabel]
flds) = [GlobalRdrElt] -> ([Name], [FieldLabel])
classifyGREs [GlobalRdrElt]
gres
RdrName -> [GlobalRdrElt] -> TcRn ()
addUsedKids (IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
rdr) [GlobalRdrElt]
gres
Bool
warnDodgyExports <- WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) Bool
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnDodgyExports
Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
gres) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
if Name -> Bool
isTyConName Name
name
then Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warnDodgyExports (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
WarnReason -> SDoc -> TcRn ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnDodgyExports)
(Name -> SDoc
dodgyExportWarn Name
name)
else
SDoc -> TcRn ()
addErr (IE GhcPs -> SDoc
exportItemErr IE GhcPs
ie)
(Located Name, [Name], [FieldLabel])
-> RnM (Located Name, [Name], [FieldLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) Name
name, [Name]
non_flds, [FieldLabel]
flds)
lookup_doc_ie :: IE GhcPs -> Maybe (IE GhcRn)
lookup_doc_ie :: IE GhcPs -> Maybe (IE GhcRn)
lookup_doc_ie (IEGroup XIEGroup GhcPs
_ Int
lev HsDocString
doc) = IE GhcRn -> Maybe (IE GhcRn)
forall a. a -> Maybe a
Just (XIEGroup GhcRn -> Int -> HsDocString -> IE GhcRn
forall pass. XIEGroup pass -> Int -> HsDocString -> IE pass
IEGroup NoExtField
XIEGroup GhcRn
noExtField Int
lev HsDocString
doc)
lookup_doc_ie (IEDoc XIEDoc GhcPs
_ HsDocString
doc) = IE GhcRn -> Maybe (IE GhcRn)
forall a. a -> Maybe a
Just (XIEDoc GhcRn -> HsDocString -> IE GhcRn
forall pass. XIEDoc pass -> HsDocString -> IE pass
IEDoc NoExtField
XIEDoc GhcRn
noExtField HsDocString
doc)
lookup_doc_ie (IEDocNamed XIEDocNamed GhcPs
_ String
str) = IE GhcRn -> Maybe (IE GhcRn)
forall a. a -> Maybe a
Just (XIEDocNamed GhcRn -> String -> IE GhcRn
forall pass. XIEDocNamed pass -> String -> IE pass
IEDocNamed NoExtField
XIEDocNamed GhcRn
noExtField String
str)
lookup_doc_ie IE GhcPs
_ = Maybe (IE GhcRn)
forall a. Maybe a
Nothing
addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
addUsedKids :: RdrName -> [GlobalRdrElt] -> TcRn ()
addUsedKids RdrName
parent_rdr [GlobalRdrElt]
kid_gres = [GlobalRdrElt] -> TcRn ()
addUsedGREs (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
parent_rdr [GlobalRdrElt]
kid_gres)
classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
classifyGREs = [GreName] -> ([Name], [FieldLabel])
partitionGreNames ([GreName] -> ([Name], [FieldLabel]))
-> ([GlobalRdrElt] -> [GreName])
-> [GlobalRdrElt]
-> ([Name], [FieldLabel])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> GreName) -> [GlobalRdrElt] -> [GreName]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> GreName
gre_name
lookupChildrenExport :: Name -> [LIEWrappedName RdrName]
-> RnM ([LIEWrappedName Name], [Located FieldLabel])
lookupChildrenExport :: Name
-> [LocatedAn AnnListItem (IEWrappedName RdrName)]
-> RnM
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
lookupChildrenExport Name
spec_parent [LocatedAn AnnListItem (IEWrappedName RdrName)]
rdr_items =
do
[Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)]
xs <- (LocatedAn AnnListItem (IEWrappedName RdrName)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name))
(Located FieldLabel)))
-> [LocatedAn AnnListItem (IEWrappedName RdrName)]
-> TcRn
[Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM LocatedAn AnnListItem (IEWrappedName RdrName)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
doOne [LocatedAn AnnListItem (IEWrappedName RdrName)]
rdr_items
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
-> RnM
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return (([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
-> RnM
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel]))
-> ([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
-> RnM
([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
forall a b. (a -> b) -> a -> b
$ [Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)]
-> ([GenLocated SrcSpanAnnA (IEWrappedName Name)],
[Located FieldLabel])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)]
xs
where
choosePossibleNamespaces :: NameSpace -> [NameSpace]
choosePossibleNamespaces :: NameSpace -> [NameSpace]
choosePossibleNamespaces NameSpace
ns
| NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
varName = [NameSpace
varName, NameSpace
tcName]
| NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
tcName = [NameSpace
dataName, NameSpace
tcName]
| Bool
otherwise = [NameSpace
ns]
doOne :: LIEWrappedName RdrName
-> RnM (Either (LIEWrappedName Name) (Located FieldLabel))
doOne :: LocatedAn AnnListItem (IEWrappedName RdrName)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
doOne LocatedAn AnnListItem (IEWrappedName RdrName)
n = do
let bareName :: RdrName
bareName = (IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName (IEWrappedName RdrName -> RdrName)
-> (LocatedAn AnnListItem (IEWrappedName RdrName)
-> IEWrappedName RdrName)
-> LocatedAn AnnListItem (IEWrappedName RdrName)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn AnnListItem (IEWrappedName RdrName)
-> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc) LocatedAn AnnListItem (IEWrappedName RdrName)
n
lkup :: NameSpace -> RnM ChildLookupResult
lkup NameSpace
v = Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
False Bool
True
Name
spec_parent (RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
bareName NameSpace
v)
ChildLookupResult
name <- [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult ([RnM ChildLookupResult] -> RnM ChildLookupResult)
-> [RnM ChildLookupResult] -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ (NameSpace -> RnM ChildLookupResult)
-> [NameSpace] -> [RnM ChildLookupResult]
forall a b. (a -> b) -> [a] -> [b]
map NameSpace -> RnM ChildLookupResult
lkup ([NameSpace] -> [RnM ChildLookupResult])
-> [NameSpace] -> [RnM ChildLookupResult]
forall a b. (a -> b) -> a -> b
$
NameSpace -> [NameSpace]
choosePossibleNamespaces (RdrName -> NameSpace
rdrNameSpace RdrName
bareName)
String -> SDoc -> TcRn ()
traceRn String
"lookupChildrenExport" (ChildLookupResult -> SDoc
forall a. Outputable a => a -> SDoc
ppr ChildLookupResult
name)
let unboundName :: RdrName
unboundName :: RdrName
unboundName = if RdrName -> NameSpace
rdrNameSpace RdrName
bareName NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
varName
then RdrName
bareName
else RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
bareName NameSpace
dataName
case ChildLookupResult
name of
ChildLookupResult
NameNotFound -> do { Name
ub <- RdrName -> RnM Name
reportUnboundName RdrName
unboundName
; let l :: SrcSpanAnnA
l = LocatedAn AnnListItem (IEWrappedName RdrName) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedAn AnnListItem (IEWrappedName RdrName)
n
; Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (IEWrappedName Name)
-> Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> IEWrappedName Name
-> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (GenLocated SrcSpanAnnN Name -> IEWrappedName Name
forall name. LocatedN name -> IEWrappedName name
IEName (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
l) Name
ub))))}
FoundChild Parent
par GreName
child -> do { Name -> Parent -> GreName -> TcRn ()
checkPatSynParent Name
spec_parent Parent
par GreName
child
; Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name))
(Located FieldLabel)))
-> Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
forall a b. (a -> b) -> a -> b
$ case GreName
child of
FieldGreName FieldLabel
fl -> Located FieldLabel
-> Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
forall a b. b -> Either a b
Right (SrcSpan -> FieldLabel -> Located FieldLabel
forall l e. l -> e -> GenLocated l e
L (LocatedAn AnnListItem (IEWrappedName RdrName) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn AnnListItem (IEWrappedName RdrName)
n) FieldLabel
fl)
NormalGreName Name
name -> GenLocated SrcSpanAnnA (IEWrappedName Name)
-> Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel)
forall a b. a -> Either a b
Left (LocatedAn AnnListItem (IEWrappedName RdrName)
-> Name -> GenLocated SrcSpanAnnA (IEWrappedName Name)
forall name1 name2.
LIEWrappedName name1 -> name2 -> LIEWrappedName name2
replaceLWrappedName LocatedAn AnnListItem (IEWrappedName RdrName)
n Name
name)
}
IncorrectParent Name
p GreName
c [Name]
gs -> Name
-> GreName
-> [Name]
-> TcRn
(Either
(GenLocated SrcSpanAnnA (IEWrappedName Name)) (Located FieldLabel))
forall a. Name -> GreName -> [Name] -> TcM a
failWithDcErr Name
p GreName
c [Name]
gs
checkPatSynParent :: Name
-> Parent
-> GreName
-> TcM ()
checkPatSynParent :: Name -> Parent -> GreName -> TcRn ()
checkPatSynParent Name
_ (ParentIs {}) GreName
_
= () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPatSynParent Name
parent Parent
NoParent GreName
gname
| Name -> Bool
isUnboundName Name
parent
= () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do { TyCon
parent_ty_con <- Name -> TcM TyCon
tcLookupTyCon Name
parent
; TyThing
mpat_syn_thing <- Name -> TcM TyThing
tcLookupGlobal (GreName -> Name
greNameMangledName GreName
gname)
; case TyThing
mpat_syn_thing of
AnId Id
i | Id -> Bool
isId Id
i
, RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelPatSyn PatSyn
p } <- Id -> IdDetails
idDetails Id
i
-> SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn (GreName -> SDoc
selErr GreName
gname) TyCon
parent_ty_con PatSyn
p
AConLike (PatSynCon PatSyn
p) -> SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn (PatSyn -> SDoc
psErr PatSyn
p) TyCon
parent_ty_con PatSyn
p
TyThing
_ -> Name -> GreName -> [Name] -> TcRn ()
forall a. Name -> GreName -> [Name] -> TcM a
failWithDcErr Name
parent GreName
gname [] }
where
psErr :: PatSyn -> SDoc
psErr = String -> PatSyn -> SDoc
forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
"pattern synonym"
selErr :: GreName -> SDoc
selErr = String -> GreName -> SDoc
forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
"pattern synonym record selector"
assocClassErr :: SDoc
assocClassErr :: SDoc
assocClassErr = String -> SDoc
text String
"Pattern synonyms can be bundled only with datatypes."
handle_pat_syn :: SDoc
-> TyCon
-> PatSyn
-> TcM ()
handle_pat_syn :: SDoc -> TyCon -> PatSyn -> TcRn ()
handle_pat_syn SDoc
doc TyCon
ty_con PatSyn
pat_syn
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TyCon -> Bool
isTyConWithSrcDataCons TyCon
ty_con
= SDoc -> TcRn () -> TcRn ()
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
doc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ SDoc -> TcRn ()
forall a. SDoc -> TcM a
failWithTc SDoc
assocClassErr
| Maybe TyCon
Nothing <- Maybe TyCon
mtycon
= () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just TyCon
p_ty_con <- Maybe TyCon
mtycon, TyCon
p_ty_con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
/= TyCon
ty_con
= SDoc -> TcRn () -> TcRn ()
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
doc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ SDoc -> TcRn ()
forall a. SDoc -> TcM a
failWithTc SDoc
typeMismatchError
| Bool
otherwise
= () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
expected_res_ty :: Type
expected_res_ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
ty_con ([Id] -> [Type]
mkTyVarTys (TyCon -> [Id]
tyConTyVars TyCon
ty_con))
([Id]
_, [Type]
_, [Id]
_, [Type]
_, [Scaled Type]
_, Type
res_ty) = PatSyn -> ([Id], [Type], [Id], [Type], [Scaled Type], Type)
patSynSig PatSyn
pat_syn
mtycon :: Maybe TyCon
mtycon = (TyCon, [Type]) -> TyCon
forall a b. (a, b) -> a
fst ((TyCon, [Type]) -> TyCon) -> Maybe (TyCon, [Type]) -> Maybe TyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
res_ty
typeMismatchError :: SDoc
typeMismatchError :: SDoc
typeMismatchError =
String -> SDoc
text String
"Pattern synonyms can only be bundled with matching type constructors"
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Couldn't match expected type of"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
expected_res_ty)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"with actual type of"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty)
check_occs :: IE GhcPs -> ExportOccMap -> [AvailInfo]
-> RnM ExportOccMap
check_occs :: IE GhcPs -> ExportOccMap -> [AvailInfo] -> RnM ExportOccMap
check_occs IE GhcPs
ie ExportOccMap
occs [AvailInfo]
avails
= (ExportOccMap -> GreName -> RnM ExportOccMap)
-> ExportOccMap -> [GreName] -> RnM ExportOccMap
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ExportOccMap -> GreName -> RnM ExportOccMap
check ExportOccMap
occs [GreName]
children
where
children :: [GreName]
children = (AvailInfo -> [GreName]) -> [AvailInfo] -> [GreName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GreName]
availGreNames [AvailInfo]
avails
check :: ExportOccMap -> GreName -> RnM ExportOccMap
check :: ExportOccMap -> GreName -> RnM ExportOccMap
check ExportOccMap
occs GreName
child
= case ExportOccMap -> GreName -> Either (GreName, IE GhcPs) ExportOccMap
try_insert ExportOccMap
occs GreName
child of
Right ExportOccMap
occs' -> ExportOccMap -> RnM ExportOccMap
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs'
Left (GreName
child', IE GhcPs
ie')
| GreName -> Name
greNameMangledName GreName
child Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== GreName -> Name
greNameMangledName GreName
child'
-> do { WarningFlag -> Bool -> SDoc -> TcRn ()
warnIfFlag WarningFlag
Opt_WarnDuplicateExports
(Bool -> Bool
not (GreName -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok GreName
child IE GhcPs
ie IE GhcPs
ie'))
(GreName -> IE GhcPs -> IE GhcPs -> SDoc
dupExportWarn GreName
child IE GhcPs
ie IE GhcPs
ie')
; ExportOccMap -> RnM ExportOccMap
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs }
| Bool
otherwise
-> do { GlobalRdrEnv
global_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv ;
SDoc -> TcRn ()
addErr (GlobalRdrEnv -> GreName -> GreName -> IE GhcPs -> IE GhcPs -> SDoc
exportClashErr GlobalRdrEnv
global_env GreName
child' GreName
child IE GhcPs
ie' IE GhcPs
ie) ;
ExportOccMap -> RnM ExportOccMap
forall (m :: * -> *) a. Monad m => a -> m a
return ExportOccMap
occs }
try_insert :: ExportOccMap -> GreName -> Either (GreName, IE GhcPs) ExportOccMap
try_insert :: ExportOccMap -> GreName -> Either (GreName, IE GhcPs) ExportOccMap
try_insert ExportOccMap
occs GreName
child
= case ExportOccMap -> OccName -> Maybe (GreName, IE GhcPs)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv ExportOccMap
occs OccName
name_occ of
Maybe (GreName, IE GhcPs)
Nothing -> ExportOccMap -> Either (GreName, IE GhcPs) ExportOccMap
forall a b. b -> Either a b
Right (ExportOccMap -> OccName -> (GreName, IE GhcPs) -> ExportOccMap
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv ExportOccMap
occs OccName
name_occ (GreName
child, IE GhcPs
ie))
Just (GreName, IE GhcPs)
x -> (GreName, IE GhcPs) -> Either (GreName, IE GhcPs) ExportOccMap
forall a b. a -> Either a b
Left (GreName, IE GhcPs)
x
where
name_occ :: OccName
name_occ = Name -> OccName
nameOccName (GreName -> Name
greNameMangledName GreName
child)
dupExport_ok :: GreName -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok :: GreName -> IE GhcPs -> IE GhcPs -> Bool
dupExport_ok GreName
child IE GhcPs
ie1 IE GhcPs
ie2
= Bool -> Bool
not ( IE GhcPs -> Bool
forall {pass}. IE pass -> Bool
single IE GhcPs
ie1 Bool -> Bool -> Bool
|| IE GhcPs -> Bool
forall {pass}. IE pass -> Bool
single IE GhcPs
ie2
Bool -> Bool -> Bool
|| (IE GhcPs -> Bool
explicit_in IE GhcPs
ie1 Bool -> Bool -> Bool
&& IE GhcPs -> Bool
explicit_in IE GhcPs
ie2) )
where
explicit_in :: IE GhcPs -> Bool
explicit_in (IEModuleContents {}) = Bool
False
explicit_in (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
r)
= GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
child OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc (IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName (IEWrappedName RdrName -> RdrName)
-> IEWrappedName RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ LocatedAn AnnListItem (IEWrappedName RdrName)
-> IEWrappedName RdrName
forall l e. GenLocated l e -> e
unLoc LocatedAn AnnListItem (IEWrappedName RdrName)
LIEWrappedName (IdP GhcPs)
r)
explicit_in IE GhcPs
_ = Bool
True
single :: IE pass -> Bool
single IEVar {} = Bool
True
single IEThingAbs {} = Bool
True
single IE pass
_ = Bool
False
dupModuleExport :: ModuleName -> SDoc
dupModuleExport :: ModuleName -> SDoc
dupModuleExport ModuleName
mod
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"Duplicate",
SDoc -> SDoc
quotes (String -> SDoc
text String
"Module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod),
String -> SDoc
text String
"in export list"]
moduleNotImported :: ModuleName -> SDoc
moduleNotImported :: ModuleName -> SDoc
moduleNotImported ModuleName
mod
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"The export item",
SDoc -> SDoc
quotes (String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod),
String -> SDoc
text String
"is not imported"]
nullModuleExport :: ModuleName -> SDoc
nullModuleExport :: ModuleName -> SDoc
nullModuleExport ModuleName
mod
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"The export item",
SDoc -> SDoc
quotes (String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod),
String -> SDoc
text String
"exports nothing"]
missingModuleExportWarn :: ModuleName -> SDoc
missingModuleExportWarn :: ModuleName -> SDoc
missingModuleExportWarn ModuleName
mod
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"The export item",
SDoc -> SDoc
quotes (String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod),
String -> SDoc
text String
"is missing an export list"]
dodgyExportWarn :: Name -> SDoc
dodgyExportWarn :: Name -> SDoc
dodgyExportWarn Name
item
= SDoc -> Name -> IE GhcRn -> SDoc
forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgyMsg (String -> SDoc
text String
"export") Name
item (IdP GhcRn -> IE GhcRn
forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert Name
IdP GhcRn
item :: IE GhcRn)
exportErrCtxt :: Outputable o => String -> o -> SDoc
exportErrCtxt :: forall o. Outputable o => String -> o -> SDoc
exportErrCtxt String
herald o
exp =
String -> SDoc
text String
"In the" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (String
herald String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") SDoc -> SDoc -> SDoc
<+> o -> SDoc
forall a. Outputable a => a -> SDoc
ppr o
exp
addExportErrCtxt :: (OutputableBndrId p)
=> IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt :: forall (p :: Pass) a.
OutputableBndrId p =>
IE (GhcPass p) -> TcM a -> TcM a
addExportErrCtxt IE (GhcPass p)
ie = SDoc -> TcM a -> TcM a
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
exportCtxt
where
exportCtxt :: SDoc
exportCtxt = String -> SDoc
text String
"In the export:" SDoc -> SDoc -> SDoc
<+> IE (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE (GhcPass p)
ie
exportItemErr :: IE GhcPs -> SDoc
exportItemErr :: IE GhcPs -> SDoc
exportItemErr IE GhcPs
export_item
= [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The export item" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item),
String -> SDoc
text String
"attempts to export constructors or class methods that are not visible here" ]
dupExportWarn :: GreName -> IE GhcPs -> IE GhcPs -> SDoc
dupExportWarn :: GreName -> IE GhcPs -> IE GhcPs -> SDoc
dupExportWarn GreName
child IE GhcPs
ie1 IE GhcPs
ie2
= [SDoc] -> SDoc
hsep [SDoc -> SDoc
quotes (GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child),
String -> SDoc
text String
"is exported by", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1),
String -> SDoc
text String
"and", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie2)]
dcErrMsg :: Name -> String -> SDoc -> [SDoc] -> SDoc
dcErrMsg :: Name -> String -> SDoc -> [SDoc] -> SDoc
dcErrMsg Name
ty_con String
what_is SDoc
thing [SDoc]
parents =
String -> SDoc
text String
"The type constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ty_con)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not the parent of the" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
what_is
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
thing SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.'
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text (String -> String
capitalise String
what_is)
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"s can only be exported with their parent type constructor."
SDoc -> SDoc -> SDoc
$$ (case [SDoc]
parents of
[] -> SDoc
empty
[SDoc
_] -> String -> SDoc
text String
"Parent:"
[SDoc]
_ -> String -> SDoc
text String
"Parents:") SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
parents)
failWithDcErr :: Name -> GreName -> [Name] -> TcM a
failWithDcErr :: forall a. Name -> GreName -> [Name] -> TcM a
failWithDcErr Name
parent GreName
child [Name]
parents = do
TyThing
ty_thing <- Name -> TcM TyThing
tcLookupGlobal (GreName -> Name
greNameMangledName GreName
child)
SDoc -> TcM a
forall a. SDoc -> TcM a
failWithTc (SDoc -> TcM a) -> SDoc -> TcM a
forall a b. (a -> b) -> a -> b
$ Name -> String -> SDoc -> [SDoc] -> SDoc
dcErrMsg Name
parent (TyThing -> String
pp_category TyThing
ty_thing)
(GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child) ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
parents)
where
pp_category :: TyThing -> String
pp_category :: TyThing -> String
pp_category (AnId Id
i)
| Id -> Bool
isRecordSelector Id
i = String
"record selector"
pp_category TyThing
i = TyThing -> String
tyThingCategory TyThing
i
exportClashErr :: GlobalRdrEnv
-> GreName -> GreName
-> IE GhcPs -> IE GhcPs
-> SDoc
exportClashErr :: GlobalRdrEnv -> GreName -> GreName -> IE GhcPs -> IE GhcPs -> SDoc
exportClashErr GlobalRdrEnv
global_env GreName
child1 GreName
child2 IE GhcPs
ie1 IE GhcPs
ie2
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Conflicting exports for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
<> SDoc
colon
, GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child1' GlobalRdrElt
gre1' IE GhcPs
ie1'
, GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child2' GlobalRdrElt
gre2' IE GhcPs
ie2'
]
where
occ :: OccName
occ = GreName -> OccName
forall name. HasOccName name => name -> OccName
occName GreName
child1
ppr_export :: GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child GlobalRdrElt
gre a
ie = Int -> SDoc -> SDoc
nest Int
3 (SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ie) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"exports" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (GreName -> SDoc
ppr_name GreName
child))
Int
2 (GlobalRdrElt -> SDoc
pprNameProvenance GlobalRdrElt
gre))
ppr_name :: GreName -> SDoc
ppr_name (FieldGreName FieldLabel
fl) | FieldLabel -> Bool
flIsOverloaded FieldLabel
fl = FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl
| Bool
otherwise = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> Name
flSelector FieldLabel
fl)
ppr_name (NormalGreName Name
name) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
gre1 :: GlobalRdrElt
gre1 = GreName -> GlobalRdrElt
get_gre GreName
child1
gre2 :: GlobalRdrElt
gre2 = GreName -> GlobalRdrElt
get_gre GreName
child2
get_gre :: GreName -> GlobalRdrElt
get_gre GreName
child
= GlobalRdrElt -> Maybe GlobalRdrElt -> GlobalRdrElt
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> GlobalRdrElt
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"exportClashErr" (GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child))
(GlobalRdrEnv -> GreName -> Maybe GlobalRdrElt
lookupGRE_GreName GlobalRdrEnv
global_env GreName
child)
(GreName
child1', GlobalRdrElt
gre1', IE GhcPs
ie1', GreName
child2', GlobalRdrElt
gre2', IE GhcPs
ie2') =
case SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (GlobalRdrElt -> SrcSpan
greSrcSpan GlobalRdrElt
gre1) (GlobalRdrElt -> SrcSpan
greSrcSpan GlobalRdrElt
gre2) of
Ordering
LT -> (GreName
child1, GlobalRdrElt
gre1, IE GhcPs
ie1, GreName
child2, GlobalRdrElt
gre2, IE GhcPs
ie2)
Ordering
GT -> (GreName
child2, GlobalRdrElt
gre2, IE GhcPs
ie2, GreName
child1, GlobalRdrElt
gre1, IE GhcPs
ie1)
Ordering
EQ -> String
-> (GreName, GlobalRdrElt, IE GhcPs, GreName, GlobalRdrElt,
IE GhcPs)
forall a. String -> a
panic String
"exportClashErr: clashing exports have idential location"