{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

\section[RnNames]{Extracting imported and top-level names in scope}
-}

{-# LANGUAGE CPP, NondecreasingIndentation, MultiWayIf, NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module RnNames (
        rnImports, getLocalNonValBinders, newRecordSelector,
        extendGlobalRdrEnvRn,
        gresFromAvails,
        calculateAvails,
        reportUnusedNames,
        checkConName,
        mkChildEnv,
        findChildren,
        dodgyMsg,
        dodgyMsgInsert,
        findImportUsage,
        getMinimalImports,
        printMinimalImports,
        ImportDeclUsage
    ) where

#include "HsVersions.h"

import GhcPrelude

import DynFlags
import TyCoPpr
import GHC.Hs
import TcEnv
import RnEnv
import RnFixity
import RnUtils          ( warnUnusedTopBinds, mkFieldEnv )
import LoadIface        ( loadSrcInterface )
import TcRnMonad
import PrelNames
import Module
import Name
import NameEnv
import NameSet
import Avail
import FieldLabel
import HscTypes
import RdrName
import RdrHsSyn        ( setRdrNameSpace )
import Outputable
import Maybes
import SrcLoc
import BasicTypes      ( TopLevelFlag(..), StringLiteral(..) )
import Util
import FastString
import FastStringEnv
import Id
import Type
import PatSyn
import qualified GHC.LanguageExtensions as LangExt

import Control.Monad
import Data.Either      ( partitionEithers, isRight, rights )
import Data.Map         ( Map )
import qualified Data.Map as Map
import Data.Ord         ( comparing )
import Data.List        ( partition, (\\), find, sortBy )
import qualified Data.Set as S
import System.FilePath  ((</>))

import System.IO

{-
************************************************************************
*                                                                      *
\subsection{rnImports}
*                                                                      *
************************************************************************

Note [Tracking Trust Transitively]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we import a package as well as checking that the direct imports are safe
according to the rules outlined in the Note [HscMain . Safe Haskell Trust Check]
we must also check that these rules hold transitively for all dependent modules
and packages. Doing this without caching any trust information would be very
slow as we would need to touch all packages and interface files a module depends
on. To avoid this we make use of the property that if a modules Safe Haskell
mode changes, this triggers a recompilation from that module in the dependcy
graph. So we can just worry mostly about direct imports.

There is one trust property that can change for a package though without
recompliation being triggered: package trust. So we must check that all
packages a module tranitively depends on to be trusted are still trusted when
we are compiling this module (as due to recompilation avoidance some modules
below may not be considered trusted any more without recompilation being
triggered).

We handle this by augmenting the existing transitive list of packages a module M
depends on with a bool for each package that says if it must be trusted when the
module M is being checked for trust. This list of trust required packages for a
single import is gathered in the rnImportDecl function and stored in an
ImportAvails data structure. The union of these trust required packages for all
imports is done by the rnImports function using the combine function which calls
the plusImportAvails function that is a union operation for the ImportAvails
type. This gives us in an ImportAvails structure all packages required to be
trusted for the module we are currently compiling. Checking that these packages
are still trusted (and that direct imports are trusted) is done in
HscMain.checkSafeImports.

See the note below, [Trust Own Package] for a corner case in this method and
how its handled.


Note [Trust Own Package]
~~~~~~~~~~~~~~~~~~~~~~~~
There is a corner case of package trust checking that the usual transitive check
doesn't cover. (For how the usual check operates see the Note [Tracking Trust
Transitively] below). The case is when you import a -XSafe module M and M
imports a -XTrustworthy module N. If N resides in a different package than M,
then the usual check works as M will record a package dependency on N's package
and mark it as required to be trusted. If N resides in the same package as M
though, then importing M should require its own package be trusted due to N
(since M is -XSafe so doesn't create this requirement by itself). The usual
check fails as a module doesn't record a package dependency of its own package.
So instead we now have a bool field in a modules interface file that simply
states if the module requires its own package to be trusted. This field avoids
us having to load all interface files that the module depends on to see if one
is trustworthy.


Note [Trust Transitive Property]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
So there is an interesting design question in regards to transitive trust
checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
of modules and packages, some packages it requires to be trusted as its using
-XTrustworthy modules from them. Now if I have a module A that doesn't use safe
haskell at all and simply imports B, should A inherit all the trust
requirements from B? Should A now also require that a package p is trusted since
B required it?

We currently say no but saying yes also makes sense. The difference is, if a
module M that doesn't use Safe Haskell imports a module N that does, should all
the trusted package requirements be dropped since M didn't declare that it cares
about Safe Haskell (so -XSafe is more strongly associated with the module doing
the importing) or should it be done still since the author of the module N that
uses Safe Haskell said they cared (so -XSafe is more strongly associated with
the module that was compiled that used it).

Going with yes is a simpler semantics we think and harder for the user to stuff
up but it does mean that Safe Haskell will affect users who don't care about
Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
network) and that packages imports -XTrustworthy modules from another package
(say bytestring), so requires that package is trusted. The user may now get
compilation errors in code that doesn't do anything with Safe Haskell simply
because they are using the network package. They will have to call 'ghc-pkg
trust network' to get everything working. Due to this invasive nature of going
with yes we have gone with no for now.
-}

-- | Process Import Decls.  See 'rnImportDecl' for a description of what
-- the return types represent.
-- Note: Do the non SOURCE ones first, so that we get a helpful warning
-- for SOURCE ones that are unnecessary
rnImports :: [LImportDecl GhcPs]
          -> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports :: [LImportDecl GhcPs]
-> RnM
     ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports [LImportDecl GhcPs]
imports = do
    TcGblEnv
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
    -- NB: want an identity module here, because it's OK for a signature
    -- module to import from its implementor
    let this_mod :: Module
this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
tcg_env
    let ([LImportDecl GhcPs]
source, [LImportDecl GhcPs]
ordinary) = (LImportDecl GhcPs -> AnyHpcUsage)
-> [LImportDecl GhcPs]
-> ([LImportDecl GhcPs], [LImportDecl GhcPs])
forall a. (a -> AnyHpcUsage) -> [a] -> ([a], [a])
partition LImportDecl GhcPs -> AnyHpcUsage
forall a pass.
(HasSrcSpan a, SrcSpanLess a ~ ImportDecl pass) =>
a -> AnyHpcUsage
is_source_import [LImportDecl GhcPs]
imports
        is_source_import :: a -> AnyHpcUsage
is_source_import a
d = ImportDecl pass -> AnyHpcUsage
forall pass. ImportDecl pass -> AnyHpcUsage
ideclSource (a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc a
d)
    [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
stuff1 <- (LImportDecl GhcPs
 -> TcRn
      (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage))
-> [LImportDecl GhcPs]
-> TcRn
     [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> LImportDecl GhcPs
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod) [LImportDecl GhcPs]
ordinary
    [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
stuff2 <- (LImportDecl GhcPs
 -> TcRn
      (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage))
-> [LImportDecl GhcPs]
-> TcRn
     [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
mapAndReportM (Module
-> LImportDecl GhcPs
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod) [LImportDecl GhcPs]
source
    -- Safe Haskell: See Note [Tracking Trust Transitively]
    let ([LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage) = [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine ([(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
stuff1 [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
forall a. [a] -> [a] -> [a]
++ [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
stuff2)
    ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> RnM
     ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage)

  where
    -- See Note [Combining ImportAvails]
    combine :: [(LImportDecl GhcRn,  GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
            -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
    combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
ss =
      let ([LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails, AnyHpcUsage
hpc_usage, ModuleSet
finsts) = ((LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
 -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
     ModuleSet)
 -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
     ModuleSet))
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
    ModuleSet)
-> [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
    ModuleSet)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
    ModuleSet)
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage,
    ModuleSet)
forall a.
(a, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
plus
            ([], GlobalRdrEnv
emptyGlobalRdrEnv, ImportAvails
emptyImportAvails, AnyHpcUsage
False, ModuleSet
emptyModuleSet)
            [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
ss
      in ([LImportDecl GhcRn]
decls, GlobalRdrEnv
rdr_env, ImportAvails
imp_avails { imp_finsts :: [Module]
imp_finsts = ModuleSet -> [Module]
moduleSetElts ModuleSet
finsts },
            AnyHpcUsage
hpc_usage)

    plus :: (a, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
-> ([a], GlobalRdrEnv, ImportAvails, AnyHpcUsage, ModuleSet)
plus (a
decl,  GlobalRdrEnv
gbl_env1, ImportAvails
imp_avails1, AnyHpcUsage
hpc_usage1)
         ([a]
decls, GlobalRdrEnv
gbl_env2, ImportAvails
imp_avails2, AnyHpcUsage
hpc_usage2, ModuleSet
finsts_set)
      = ( a
decla -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
decls,
          GlobalRdrEnv
gbl_env1 GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
`plusGlobalRdrEnv` GlobalRdrEnv
gbl_env2,
          ImportAvails
imp_avails1' ImportAvails -> ImportAvails -> ImportAvails
`plusImportAvails` ImportAvails
imp_avails2,
          AnyHpcUsage
hpc_usage1 AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
hpc_usage2,
          ModuleSet -> [Module] -> ModuleSet
extendModuleSetList ModuleSet
finsts_set [Module]
new_finsts )
      where
      imp_avails1' :: ImportAvails
imp_avails1' = ImportAvails
imp_avails1 { imp_finsts :: [Module]
imp_finsts = [] }
      new_finsts :: [Module]
new_finsts = ImportAvails -> [Module]
imp_finsts ImportAvails
imp_avails1

{-
Note [Combining ImportAvails]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
imp_finsts in ImportAvails is a list of family instance modules
transitively depended on by an import. imp_finsts for a currently
compiled module is a union of all the imp_finsts of imports.
Computing the union of two lists of size N is O(N^2) and if we
do it to M imports we end up with O(M*N^2). That can get very
expensive for bigger module hierarchies.

Union can be optimized to O(N log N) if we use a Set.
imp_finsts is converted back and forth between dep_finsts, so
changing a type of imp_finsts means either paying for the conversions
or changing the type of dep_finsts as well.

I've measured that the conversions would cost 20% of allocations on my
test case, so that can be ruled out.

Changing the type of dep_finsts forces checkFamInsts to
get the module lists in non-deterministic order. If we wanted to restore
the deterministic order, we'd have to sort there, which is an additional
cost. As far as I can tell, using a non-deterministic order is fine there,
but that's a brittle nonlocal property which I'd like to avoid.

Additionally, dep_finsts is read from an interface file, so its "natural"
type is a list. Which makes it a natural type for imp_finsts.

Since rnImports.combine is really the only place that would benefit from
it being a Set, it makes sense to optimize the hot loop in rnImports.combine
without changing the representation.

So here's what we do: instead of naively merging ImportAvails with
plusImportAvails in a loop, we make plusImportAvails merge empty imp_finsts
and compute the union on the side using Sets. When we're done, we can
convert it back to a list. One nice side effect of this approach is that
if there's a lot of overlap in the imp_finsts of imports, the
Set doesn't really need to grow and we don't need to allocate.

Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
23s before, and 11s after.
-}



-- | Given a located import declaration @decl@ from @this_mod@,
-- calculate the following pieces of information:
--
--  1. An updated 'LImportDecl', where all unresolved 'RdrName' in
--     the entity lists have been resolved into 'Name's,
--
--  2. A 'GlobalRdrEnv' representing the new identifiers that were
--     brought into scope (taking into account module qualification
--     and hiding),
--
--  3. 'ImportAvails' summarizing the identifiers that were imported
--     by this declaration, and
--
--  4. A boolean 'AnyHpcUsage' which is true if the imported module
--     used HPC.
rnImportDecl  :: Module -> LImportDecl GhcPs
             -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl :: Module
-> LImportDecl GhcPs
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl Module
this_mod
             (L SrcSpan
loc decl :: ImportDecl GhcPs
decl@(ImportDecl { ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt = XCImportDecl GhcPs
noExtField
                                     , ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName = Located ModuleName
loc_imp_mod_name
                                     , ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual = Maybe StringLiteral
mb_pkg
                                     , ideclSource :: forall pass. ImportDecl pass -> AnyHpcUsage
ideclSource = AnyHpcUsage
want_boot, ideclSafe :: forall pass. ImportDecl pass -> AnyHpcUsage
ideclSafe = AnyHpcUsage
mod_safe
                                     , ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
qual_style, ideclImplicit :: forall pass. ImportDecl pass -> AnyHpcUsage
ideclImplicit = AnyHpcUsage
implicit
                                     , ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs = Maybe (Located ModuleName)
as_mod, ideclHiding :: forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding = Maybe (AnyHpcUsage, Located [LIE GhcPs])
imp_details }))
  = SrcSpan
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
 -> TcRn
      (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage))
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
forall a b. (a -> b) -> a -> b
$ do

    AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (Maybe StringLiteral -> AnyHpcUsage
forall a. Maybe a -> AnyHpcUsage
isJust Maybe StringLiteral
mb_pkg) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
        AnyHpcUsage
pkg_imports <- Extension -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. Extension -> TcRnIf gbl lcl AnyHpcUsage
xoptM Extension
LangExt.PackageImports
        AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
pkg_imports) (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
packageImportErr

    let qual_only :: AnyHpcUsage
qual_only = ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified ImportDeclQualifiedStyle
qual_style

    -- If there's an error in loadInterface, (e.g. interface
    -- file not found) we get lots of spurious errors from 'filterImports'
    let imp_mod_name :: SrcSpanLess (Located ModuleName)
imp_mod_name = Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
loc_imp_mod_name
        doc :: MsgDoc
doc = ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
SrcSpanLess (Located ModuleName)
imp_mod_name MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is directly imported"

    -- Check for self-import, which confuses the typechecker (#9032)
    -- ghc --make rejects self-import cycles already, but batch-mode may not
    -- at least not until TcIface.tcHiBootIface, which is too late to avoid
    -- typechecker crashes.  (Indirect self imports are not caught until
    -- TcIface, see #10337 tracking how to make this error better.)
    --
    -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
    -- caused bug #10182: in one-shot mode, we should never load an hs-boot
    -- file for the module we are compiling into the EPS.  In principle,
    -- it should be possible to support this mode of use, but we would have to
    -- extend Provenance to support a local definition in a qualified location.
    -- For now, we don't support it, but see #10336
    AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (ModuleName
SrcSpanLess (Located ModuleName)
imp_mod_name ModuleName -> ModuleName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Module -> ModuleName
moduleName Module
this_mod AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&&
          (case Maybe StringLiteral
mb_pkg of  -- If we have import "<pkg>" M, then we should
                           -- check that "<pkg>" is "this" (which is magic)
                           -- or the name of this_mod's package.  Yurgh!
                           -- c.f. GHC.findModule, and #9997
             Maybe StringLiteral
Nothing         -> AnyHpcUsage
True
             Just (StringLiteral SourceText
_ FastString
pkg_fs) -> FastString
pkg_fs FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== String -> FastString
fsLit String
"this" AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
||
                            FastString -> UnitId
fsToUnitId FastString
pkg_fs UnitId -> UnitId -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Module -> UnitId
moduleUnitId Module
this_mod))
         (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> MsgDoc
text String
"A module cannot import itself:" MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
SrcSpanLess (Located ModuleName)
imp_mod_name))

    -- Check for a missing import list (Opt_WarnMissingImportList also
    -- checks for T(..) items but that is done in checkDodgyImport below)
    case Maybe (AnyHpcUsage, Located [LIE GhcPs])
imp_details of
        Just (AnyHpcUsage
False, Located [LIE GhcPs]
_) -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Explicit import list
        Maybe (AnyHpcUsage, Located [LIE GhcPs])
_  | AnyHpcUsage
implicit   -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Do not bleat for implicit imports
           | AnyHpcUsage
qual_only  -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           | AnyHpcUsage
otherwise  -> WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (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_WarnMissingImportList)
                                   (ModuleName -> MsgDoc
missingImportListWarn ModuleName
SrcSpanLess (Located ModuleName)
imp_mod_name)

    ModIface
iface <- MsgDoc
-> ModuleName -> AnyHpcUsage -> Maybe FastString -> RnM ModIface
loadSrcInterface MsgDoc
doc ModuleName
SrcSpanLess (Located ModuleName)
imp_mod_name AnyHpcUsage
want_boot ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs Maybe StringLiteral
mb_pkg)

    -- Compiler sanity check: if the import didn't say
    -- {-# SOURCE #-} we should not get a hi-boot file
    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do

    -- Issue a user warning for a redundant {- SOURCE -} import
    -- NB that we arrange to read all the ordinary imports before
    -- any of the {- SOURCE -} imports.
    --
    -- in --make and GHCi, the compilation manager checks for this,
    -- and indeed we shouldn't do it here because the existence of
    -- the non-boot module depends on the compilation order, which
    -- is not deterministic.  The hs-boot test can show this up.
    dflags <- getDynFlags
    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
           (warnRedundantSourceImport imp_mod_name)
    when (mod_safe && not (safeImportsOn dflags)) $
        addErr (text "safe import can't be used as Safe Haskell isn't on!"
                $+$ ptext (sLit $ "please enable Safe Haskell through either "
                                   ++ "Safe, Trustworthy or Unsafe"))

    let
        qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
                                  is_dloc = loc, is_as = qual_mod_name }

    -- filter the imports according to the import declaration
    (new_imp_details, gres) <- filterImports iface imp_spec imp_details

    -- for certain error messages, we’d like to know what could be imported
    -- here, if everything were imported
    potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing

    let gbl_env = mkGlobalRdrEnv gres

        is_hiding | Just (True,_) <- imp_details = True
                  | otherwise                    = False

        -- should the import be safe?
        mod_safe' = mod_safe
                    || (not implicit && safeDirectImpsReq dflags)
                    || (implicit && safeImplicitImpsReq dflags)

    let imv = ImportedModsVal
            { imv_name        = qual_mod_name
            , imv_span        = loc
            , imv_is_safe     = mod_safe'
            , imv_is_hiding   = is_hiding
            , imv_all_exports = potential_gres
            , imv_qualified   = qual_only
            }
        imports = calculateAvails dflags iface mod_safe' want_boot (ImportedByUser imv)

    -- Complain if we import a deprecated module
    whenWOptM Opt_WarnWarningsDeprecations (
       case (mi_warns iface) of
          WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
                                (moduleWarn imp_mod_name txt)
          _           -> return ()
     )

    -- Complain about -Wcompat-unqualified-imports violations.
    warnUnqualifiedImport decl iface

    let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe'
                                   , ideclHiding = new_imp_details })

    return (new_imp_decl, gbl_env, imports, mi_hpc iface)
rnImportDecl Module
_ (L SrcSpan
_ (XImportDecl XXImportDecl GhcPs
nec)) = NoExtCon
-> TcRn
     (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
forall a. NoExtCon -> a
noExtCon XXImportDecl GhcPs
NoExtCon
nec

-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
calculateAvails :: DynFlags
                -> ModIface
                -> IsSafeImport
                -> IsBootInterface
                -> ImportedBy
                -> ImportAvails
calculateAvails :: DynFlags
-> ModIface
-> AnyHpcUsage
-> AnyHpcUsage
-> ImportedBy
-> ImportAvails
calculateAvails DynFlags
dflags ModIface
iface AnyHpcUsage
mod_safe' AnyHpcUsage
want_boot ImportedBy
imported_by =
  let imp_mod :: Module
imp_mod    = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
      imp_sem_mod :: Module
imp_sem_mod= ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface
      orph_iface :: AnyHpcUsage
orph_iface = ModIfaceBackend -> AnyHpcUsage
mi_orphan (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
      has_finsts :: AnyHpcUsage
has_finsts = ModIfaceBackend -> AnyHpcUsage
mi_finsts (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
      deps :: Dependencies
deps       = ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface
      trust :: SafeHaskellMode
trust      = IfaceTrustInfo -> SafeHaskellMode
getSafeMode (IfaceTrustInfo -> SafeHaskellMode)
-> IfaceTrustInfo -> SafeHaskellMode
forall a b. (a -> b) -> a -> b
$ ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface
      trust_pkg :: AnyHpcUsage
trust_pkg  = ModIface -> AnyHpcUsage
forall (phase :: ModIfacePhase). ModIface_ phase -> AnyHpcUsage
mi_trust_pkg ModIface
iface

      -- If the module exports anything defined in this module, just
      -- ignore it.  Reason: otherwise it looks as if there are two
      -- local definition sites for the thing, and an error gets
      -- reported.  Easiest thing is just to filter them out up
      -- front. This situation only arises if a module imports
      -- itself, or another module that imported it.  (Necessarily,
      -- this invoves a loop.)
      --
      -- We do this *after* filterImports, so that if you say
      --      module A where
      --         import B( AType )
      --         type AType = ...
      --
      --      module B( AType ) where
      --         import {-# SOURCE #-} A( AType )
      --
      -- then you won't get a 'B does not export AType' message.


      -- Compute new transitive dependencies
      --
      -- 'dep_orphs' and 'dep_finsts' do NOT include the imported module
      -- itself, but we DO need to include this module in 'imp_orphs' and
      -- 'imp_finsts' if it defines an orphan or instance family; thus the
      -- orph_iface/has_iface tests.

      orphans :: [Module]
orphans | AnyHpcUsage
orph_iface = ASSERT2( not (imp_sem_mod `elem` dep_orphs deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
                             Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: Dependencies -> [Module]
dep_orphs Dependencies
deps
              | AnyHpcUsage
otherwise  = Dependencies -> [Module]
dep_orphs Dependencies
deps

      finsts :: [Module]
finsts | AnyHpcUsage
has_finsts = ASSERT2( not (imp_sem_mod `elem` dep_finsts deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
                            Module
imp_sem_mod Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: Dependencies -> [Module]
dep_finsts Dependencies
deps
             | AnyHpcUsage
otherwise  = Dependencies -> [Module]
dep_finsts Dependencies
deps

      pkg :: UnitId
pkg = Module -> UnitId
moduleUnitId (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
      ipkg :: InstalledUnitId
ipkg = UnitId -> InstalledUnitId
toInstalledUnitId UnitId
pkg

      -- Does this import mean we now require our own pkg
      -- to be trusted? See Note [Trust Own Package]
      ptrust :: AnyHpcUsage
ptrust = SafeHaskellMode
trust SafeHaskellMode -> SafeHaskellMode -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== SafeHaskellMode
Sf_Trustworthy AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
trust_pkg

      ([(ModuleName, AnyHpcUsage)]
dependent_mods, [(InstalledUnitId, AnyHpcUsage)]
dependent_pkgs, AnyHpcUsage
pkg_trust_req)
         | UnitId
pkg UnitId -> UnitId -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== DynFlags -> UnitId
thisPackage DynFlags
dflags =
            -- Imported module is from the home package
            -- Take its dependent modules and add imp_mod itself
            -- Take its dependent packages unchanged
            --
            -- NB: (dep_mods deps) might include a hi-boot file
            -- for the module being compiled, CM. Do *not* filter
            -- this out (as we used to), because when we've
            -- finished dealing with the direct imports we want to
            -- know if any of them depended on CM.hi-boot, in
            -- which case we should do the hi-boot consistency
            -- check.  See LoadIface.loadHiBootInterface
            ((Module -> ModuleName
moduleName Module
imp_mod,AnyHpcUsage
want_boot)(ModuleName, AnyHpcUsage)
-> [(ModuleName, AnyHpcUsage)] -> [(ModuleName, AnyHpcUsage)]
forall a. a -> [a] -> [a]
:Dependencies -> [(ModuleName, AnyHpcUsage)]
dep_mods Dependencies
deps,Dependencies -> [(InstalledUnitId, AnyHpcUsage)]
dep_pkgs Dependencies
deps,AnyHpcUsage
ptrust)

         | AnyHpcUsage
otherwise =
            -- Imported module is from another package
            -- Dump the dependent modules
            -- Add the package imp_mod comes from to the dependent packages
            ASSERT2( not (ipkg `elem` (map fst $ dep_pkgs deps))
                   , ppr ipkg <+> ppr (dep_pkgs deps) )
            ([], (InstalledUnitId
ipkg, AnyHpcUsage
False) (InstalledUnitId, AnyHpcUsage)
-> [(InstalledUnitId, AnyHpcUsage)]
-> [(InstalledUnitId, AnyHpcUsage)]
forall a. a -> [a] -> [a]
: Dependencies -> [(InstalledUnitId, AnyHpcUsage)]
dep_pkgs Dependencies
deps, AnyHpcUsage
False)

  in ImportAvails :: ImportedMods
-> ModuleNameEnv (ModuleName, AnyHpcUsage)
-> Set InstalledUnitId
-> Set InstalledUnitId
-> AnyHpcUsage
-> [Module]
-> [Module]
-> ImportAvails
ImportAvails {
          imp_mods :: ImportedMods
imp_mods       = Module -> [ImportedBy] -> ImportedMods
forall a. Module -> a -> ModuleEnv a
unitModuleEnv (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) [ImportedBy
imported_by],
          imp_orphs :: [Module]
imp_orphs      = [Module]
orphans,
          imp_finsts :: [Module]
imp_finsts     = [Module]
finsts,
          imp_dep_mods :: ModuleNameEnv (ModuleName, AnyHpcUsage)
imp_dep_mods   = [(ModuleName, AnyHpcUsage)]
-> ModuleNameEnv (ModuleName, AnyHpcUsage)
mkModDeps [(ModuleName, AnyHpcUsage)]
dependent_mods,
          imp_dep_pkgs :: Set InstalledUnitId
imp_dep_pkgs   = [InstalledUnitId] -> Set InstalledUnitId
forall a. Ord a => [a] -> Set a
S.fromList ([InstalledUnitId] -> Set InstalledUnitId)
-> ([(InstalledUnitId, AnyHpcUsage)] -> [InstalledUnitId])
-> [(InstalledUnitId, AnyHpcUsage)]
-> Set InstalledUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InstalledUnitId, AnyHpcUsage) -> InstalledUnitId)
-> [(InstalledUnitId, AnyHpcUsage)] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (InstalledUnitId, AnyHpcUsage) -> InstalledUnitId
forall a b. (a, b) -> a
fst ([(InstalledUnitId, AnyHpcUsage)] -> Set InstalledUnitId)
-> [(InstalledUnitId, AnyHpcUsage)] -> Set InstalledUnitId
forall a b. (a -> b) -> a -> b
$ [(InstalledUnitId, AnyHpcUsage)]
dependent_pkgs,
          -- Add in the imported modules trusted package
          -- requirements. ONLY do this though if we import the
          -- module as a safe import.
          -- See Note [Tracking Trust Transitively]
          -- and Note [Trust Transitive Property]
          imp_trust_pkgs :: Set InstalledUnitId
imp_trust_pkgs = if AnyHpcUsage
mod_safe'
                               then [InstalledUnitId] -> Set InstalledUnitId
forall a. Ord a => [a] -> Set a
S.fromList ([InstalledUnitId] -> Set InstalledUnitId)
-> ([(InstalledUnitId, AnyHpcUsage)] -> [InstalledUnitId])
-> [(InstalledUnitId, AnyHpcUsage)]
-> Set InstalledUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InstalledUnitId, AnyHpcUsage) -> InstalledUnitId)
-> [(InstalledUnitId, AnyHpcUsage)] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (InstalledUnitId, AnyHpcUsage) -> InstalledUnitId
forall a b. (a, b) -> a
fst ([(InstalledUnitId, AnyHpcUsage)] -> Set InstalledUnitId)
-> [(InstalledUnitId, AnyHpcUsage)] -> Set InstalledUnitId
forall a b. (a -> b) -> a -> b
$ ((InstalledUnitId, AnyHpcUsage) -> AnyHpcUsage)
-> [(InstalledUnitId, AnyHpcUsage)]
-> [(InstalledUnitId, AnyHpcUsage)]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (InstalledUnitId, AnyHpcUsage) -> AnyHpcUsage
forall a b. (a, b) -> b
snd [(InstalledUnitId, AnyHpcUsage)]
dependent_pkgs
                               else Set InstalledUnitId
forall a. Set a
S.empty,
          -- Do we require our own pkg to be trusted?
          -- See Note [Trust Own Package]
          imp_trust_own_pkg :: AnyHpcUsage
imp_trust_own_pkg = AnyHpcUsage
pkg_trust_req
     }


-- | Issue a warning if the user imports Data.List without either an import
-- list or `qualified`. This is part of the migration plan for the
-- `Data.List.singleton` proposal. See #17244.
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnqualifiedImport ImportDecl GhcPs
decl ModIface
iface =
    WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnCompatUnqualifiedImports
    (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when AnyHpcUsage
bad_import
    (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnCompatUnqualifiedImports) SrcSpan
loc MsgDoc
warning
  where
    mod :: Module
mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
    loc :: SrcSpan
loc = Located ModuleName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located ModuleName -> SrcSpan) -> Located ModuleName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
decl

    is_qual :: AnyHpcUsage
is_qual = ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified (ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
decl)
    has_import_list :: AnyHpcUsage
has_import_list =
      -- We treat a `hiding` clause as not having an import list although
      -- it's not entirely clear this is the right choice.
      case ImportDecl GhcPs -> Maybe (AnyHpcUsage, Located [LIE GhcPs])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding ImportDecl GhcPs
decl of
        Just (AnyHpcUsage
False, Located [LIE GhcPs]
_) -> AnyHpcUsage
True
        Maybe (AnyHpcUsage, Located [LIE GhcPs])
_               -> AnyHpcUsage
False
    bad_import :: AnyHpcUsage
bad_import =
      Module
mod Module -> ModuleSet -> AnyHpcUsage
`elemModuleSet` ModuleSet
qualifiedMods
      AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
is_qual
      AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
has_import_list

    warning :: MsgDoc
warning = [MsgDoc] -> MsgDoc
vcat
      [ String -> MsgDoc
text String
"To ensure compatibility with future core libraries changes"
      , String -> MsgDoc
text String
"imports to" MsgDoc -> MsgDoc -> MsgDoc
<+> Located ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
decl) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"should be"
      , String -> MsgDoc
text String
"either qualified or have an explicit import list."
      ]

    -- Modules for which we warn if we see unqualified imports
    qualifiedMods :: ModuleSet
qualifiedMods = [Module] -> ModuleSet
mkModuleSet [ Module
dATA_LIST ]


warnRedundantSourceImport :: ModuleName -> SDoc
warnRedundantSourceImport :: ModuleName -> MsgDoc
warnRedundantSourceImport ModuleName
mod_name
  = String -> MsgDoc
text String
"Unnecessary {-# SOURCE #-} in the import of module"
          MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod_name)

{-
************************************************************************
*                                                                      *
\subsection{importsFromLocalDecls}
*                                                                      *
************************************************************************

From the top-level declarations of this module produce
        * the lexical environment
        * the ImportAvails
created by its bindings.

Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also: Note [Interactively-bound Ids in GHCi] in HscTypes
          Note [Looking up Exact RdrNames] in RnEnv

Consider a Template Haskell declaration quotation like this:
      module M where
        f x = h [d| f = 3 |]
When renaming the declarations inside [d| ...|], we treat the
top level binders specially in two ways

1.  We give them an Internal Name, not (as usual) an External one.
    This is done by RnEnv.newTopSrcBinder.

2.  We make them *shadow* the outer bindings.
    See Note [GlobalRdrEnv shadowing]

3. We find out whether we are inside a [d| ... |] by testing the TH
   stage. This is a slight hack, because the stage field was really
   meant for the type checker, and here we are not interested in the
   fields of Brack, hence the error thunks in thRnBrack.
-}

extendGlobalRdrEnvRn :: [AvailInfo]
                     -> MiniFixityEnv
                     -> RnM (TcGblEnv, TcLclEnv)
-- Updates both the GlobalRdrEnv and the FixityEnv
-- We return a new TcLclEnv only because we might have to
-- delete some bindings from it;
-- see Note [Top-level Names in Template Haskell decl quotes]

extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
new_fixities
  = do  { (TcGblEnv
gbl_env, TcLclEnv
lcl_env) <- RnM (TcGblEnv, TcLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
        ; ThStage
stage <- TcM ThStage
getStage
        ; AnyHpcUsage
isGHCi <- TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
getIsGHCi
        ; let rdr_env :: GlobalRdrEnv
rdr_env  = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
              fix_env :: FixityEnv
fix_env  = TcGblEnv -> FixityEnv
tcg_fix_env TcGblEnv
gbl_env
              th_bndrs :: ThBindEnv
th_bndrs = TcLclEnv -> ThBindEnv
tcl_th_bndrs TcLclEnv
lcl_env
              th_lvl :: Int
th_lvl   = ThStage -> Int
thLevel ThStage
stage

              -- Delete new_occs from global and local envs
              -- If we are in a TemplateHaskell decl bracket,
              --    we are going to shadow them
              -- See Note [GlobalRdrEnv shadowing]
              inBracket :: AnyHpcUsage
inBracket = ThStage -> AnyHpcUsage
isBrackStage ThStage
stage

              lcl_env_TH :: TcLclEnv
lcl_env_TH = TcLclEnv
lcl_env { tcl_rdr :: LocalRdrEnv
tcl_rdr = LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList (TcLclEnv -> LocalRdrEnv
tcl_rdr TcLclEnv
lcl_env) [OccName]
new_occs }
                           -- See Note [GlobalRdrEnv shadowing]

              lcl_env2 :: TcLclEnv
lcl_env2 | AnyHpcUsage
inBracket = TcLclEnv
lcl_env_TH
                       | AnyHpcUsage
otherwise = TcLclEnv
lcl_env

              -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
              want_shadowing :: AnyHpcUsage
want_shadowing = AnyHpcUsage
isGHCi AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
inBracket
              rdr_env1 :: GlobalRdrEnv
rdr_env1 | AnyHpcUsage
want_shadowing = GlobalRdrEnv -> [Name] -> GlobalRdrEnv
shadowNames GlobalRdrEnv
rdr_env [Name]
new_names
                       | AnyHpcUsage
otherwise      = GlobalRdrEnv
rdr_env

              lcl_env3 :: TcLclEnv
lcl_env3 = TcLclEnv
lcl_env2 { tcl_th_bndrs :: ThBindEnv
tcl_th_bndrs = ThBindEnv -> [(Name, (TopLevelFlag, Int))] -> ThBindEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList ThBindEnv
th_bndrs
                                                       [ (Name
n, (TopLevelFlag
TopLevel, Int
th_lvl))
                                                       | Name
n <- [Name]
new_names ] }

        ; GlobalRdrEnv
rdr_env2 <- (GlobalRdrEnv
 -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv)
-> GlobalRdrEnv
-> [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
rdr_env1 [GlobalRdrElt]
new_gres

        ; let fix_env' :: FixityEnv
fix_env' = (FixityEnv -> GlobalRdrElt -> FixityEnv)
-> FixityEnv -> [GlobalRdrElt] -> FixityEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env [GlobalRdrElt]
new_gres
              gbl_env' :: TcGblEnv
gbl_env' = TcGblEnv
gbl_env { tcg_rdr_env :: GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
rdr_env2, tcg_fix_env :: FixityEnv
tcg_fix_env = FixityEnv
fix_env' }

        ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"extendGlobalRdrEnvRn 2" (AnyHpcUsage -> GlobalRdrEnv -> MsgDoc
pprGlobalRdrEnv AnyHpcUsage
True GlobalRdrEnv
rdr_env2)
        ; (TcGblEnv, TcLclEnv) -> RnM (TcGblEnv, TcLclEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
gbl_env', TcLclEnv
lcl_env3) }
  where
    new_names :: [Name]
new_names = (AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
availNames [AvailInfo]
avails
    new_occs :: [OccName]
new_occs  = (Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
nameOccName [Name]
new_names

    -- If there is a fixity decl for the gre, add it to the fixity env
    extend_fix_env :: FixityEnv -> GlobalRdrElt -> FixityEnv
extend_fix_env FixityEnv
fix_env GlobalRdrElt
gre
      | Just (L SrcSpan
_ Fixity
fi) <- MiniFixityEnv -> FastString -> Maybe (Located Fixity)
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv MiniFixityEnv
new_fixities (OccName -> FastString
occNameFS OccName
occ)
      = FixityEnv -> Name -> FixItem -> FixityEnv
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv FixityEnv
fix_env Name
name (OccName -> Fixity -> FixItem
FixItem OccName
occ Fixity
fi)
      | AnyHpcUsage
otherwise
      = FixityEnv
fix_env
      where
        name :: Name
name = GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre
        occ :: OccName
occ  = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre

    new_gres :: [GlobalRdrElt]  -- New LocalDef GREs, derived from avails
    new_gres :: [GlobalRdrElt]
new_gres = (AvailInfo -> [GlobalRdrElt]) -> [AvailInfo] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [GlobalRdrElt]
localGREsFromAvail [AvailInfo]
avails

    add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
    -- Extend the GlobalRdrEnv with a LocalDef GRE
    -- If there is already a LocalDef GRE with the same OccName,
    --    report an error and discard the new GRE
    -- This establishes INVARIANT 1 of GlobalRdrEnvs
    add_gre :: GlobalRdrEnv
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
add_gre GlobalRdrEnv
env GlobalRdrElt
gre
      | AnyHpcUsage -> AnyHpcUsage
not ([GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [GlobalRdrElt]
dups)    -- Same OccName defined twice
      = do { [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
dups); GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalRdrEnv
env }

      | AnyHpcUsage
otherwise
      = GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env GlobalRdrElt
gre)
      where
        name :: Name
name = GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre
        occ :: OccName
occ  = Name -> OccName
nameOccName Name
name
        dups :: [GlobalRdrElt]
dups = (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter GlobalRdrElt -> AnyHpcUsage
isLocalGRE (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ)


{- *********************************************************************
*                                                                      *
    getLocalDeclBindersd@ returns the names for an HsDecl
             It's used for source code.

        *** See Note [The Naming story] in GHC.Hs.Decls ****
*                                                                      *
********************************************************************* -}

getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
    -> RnM ((TcGblEnv, TcLclEnv), NameSet)
-- Get all the top-level binders bound the group *except*
-- for value bindings, which are treated separately
-- Specifically we return AvailInfo for
--      * type decls (incl constructors and record selectors)
--      * class decls (including class ops)
--      * associated types
--      * foreign imports
--      * value signatures (in hs-boot files only)

getLocalNonValBinders :: MiniFixityEnv
-> HsGroup GhcPs -> RnM ((TcGblEnv, TcLclEnv), NameSet)
getLocalNonValBinders MiniFixityEnv
fixity_env
     (HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds  = HsValBinds GhcPs
binds,
                hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup GhcPs]
tycl_decls,
                hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords  = [LForeignDecl GhcPs]
foreign_decls })
  = do  { -- Process all type/class decls *except* family instances
        ; let inst_decls :: [LInstDecl GhcPs]
inst_decls = [TyClGroup GhcPs]
tycl_decls [TyClGroup GhcPs]
-> (TyClGroup GhcPs -> [LInstDecl GhcPs]) -> [LInstDecl GhcPs]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup GhcPs -> [LInstDecl GhcPs]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds
        ; AnyHpcUsage
overload_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. Extension -> TcRnIf gbl lcl AnyHpcUsage
xoptM Extension
LangExt.DuplicateRecordFields
        ; ([AvailInfo]
tc_avails, [[(Name, [FieldLabel])]]
tc_fldss)
            <- ([(AvailInfo, [(Name, [FieldLabel])])]
 -> ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
     (Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(AvailInfo, [(Name, [FieldLabel])])]
-> ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. [(a, b)] -> ([a], [b])
unzip (IOEnv
   (Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
 -> IOEnv
      (Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]]))
-> IOEnv
     (Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall a b. (a -> b) -> a -> b
$ (LTyClDecl GhcPs
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [LTyClDecl GhcPs]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [(AvailInfo, [(Name, [FieldLabel])])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> LTyClDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc AnyHpcUsage
overload_ok)
                                 ([TyClGroup GhcPs] -> [LTyClDecl GhcPs]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcPs]
tycl_decls)
        ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 1" ([AvailInfo] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [AvailInfo]
tc_avails)
        ; (TcGblEnv, TcLclEnv)
envs <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
tc_avails MiniFixityEnv
fixity_env
        ; (TcGblEnv, TcLclEnv)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall gbl' lcl' a gbl lcl.
(gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
setEnvs (TcGblEnv, TcLclEnv)
envs (RnM ((TcGblEnv, TcLclEnv), NameSet)
 -> RnM ((TcGblEnv, TcLclEnv), NameSet))
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall a b. (a -> b) -> a -> b
$ do {
            -- Bring these things into scope first
            -- See Note [Looking up family names in family instances]

          -- Process all family instances
          -- to bring new data constructors into scope
        ; ([[AvailInfo]]
nti_availss, [[(Name, [FieldLabel])]]
nti_fldss) <- (LInstDecl GhcPs
 -> IOEnv
      (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])]))
-> [LInstDecl GhcPs]
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([[AvailInfo]], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (AnyHpcUsage
-> LInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc AnyHpcUsage
overload_ok)
                                                   [LInstDecl GhcPs]
inst_decls

          -- Finish off with value binders:
          --    foreign decls and pattern synonyms for an ordinary module
          --    type sigs in case of a hs-boot file only
        ; AnyHpcUsage
is_boot <- TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
tcIsHsBootOrSig
        ; let val_bndrs :: [GenLocated SrcSpan RdrName]
val_bndrs | AnyHpcUsage
is_boot   = [GenLocated SrcSpan RdrName]
hs_boot_sig_bndrs
                        | AnyHpcUsage
otherwise = [GenLocated SrcSpan RdrName]
for_hs_bndrs
        ; [AvailInfo]
val_avails <- (GenLocated SrcSpan RdrName
 -> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [AvailInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple [GenLocated SrcSpan RdrName]
val_bndrs

        ; let avails :: [AvailInfo]
avails    = [[AvailInfo]] -> [AvailInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AvailInfo]]
nti_availss [AvailInfo] -> [AvailInfo] -> [AvailInfo]
forall a. [a] -> [a] -> [a]
++ [AvailInfo]
val_avails
              new_bndrs :: NameSet
new_bndrs = [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
avails NameSet -> NameSet -> NameSet
`unionNameSet`
                          [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
tc_avails
              flds :: [(Name, [FieldLabel])]
flds      = [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
nti_fldss [(Name, [FieldLabel])]
-> [(Name, [FieldLabel])] -> [(Name, [FieldLabel])]
forall a. [a] -> [a] -> [a]
++ [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
tc_fldss
        ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 2" ([AvailInfo] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [AvailInfo]
avails)
        ; (TcGblEnv
tcg_env, TcLclEnv
tcl_env) <- [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv)
extendGlobalRdrEnvRn [AvailInfo]
avails MiniFixityEnv
fixity_env

        -- Extend tcg_field_env with new fields (this used to be the
        -- work of extendRecordFieldEnv)
        ; let field_env :: NameEnv [FieldLabel]
field_env = NameEnv [FieldLabel]
-> [(Name, [FieldLabel])] -> NameEnv [FieldLabel]
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList (TcGblEnv -> NameEnv [FieldLabel]
tcg_field_env TcGblEnv
tcg_env) [(Name, [FieldLabel])]
flds
              envs :: (TcGblEnv, TcLclEnv)
envs      = (TcGblEnv
tcg_env { tcg_field_env :: NameEnv [FieldLabel]
tcg_field_env = NameEnv [FieldLabel]
field_env }, TcLclEnv
tcl_env)

        ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"getLocalNonValBinders 3" ([MsgDoc] -> MsgDoc
vcat [[(Name, [FieldLabel])] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(Name, [FieldLabel])]
flds, NameEnv [FieldLabel] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameEnv [FieldLabel]
field_env])
        ; ((TcGblEnv, TcLclEnv), NameSet)
-> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TcGblEnv, TcLclEnv)
envs, NameSet
new_bndrs) } }
  where
    ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_val_binds [LSig GhcPs]
val_sigs = HsValBinds GhcPs
binds

    for_hs_bndrs :: [Located RdrName]
    for_hs_bndrs :: [GenLocated SrcSpan RdrName]
for_hs_bndrs = [LForeignDecl GhcPs] -> [Located (IdP GhcPs)]
forall pass. [LForeignDecl pass] -> [Located (IdP pass)]
hsForeignDeclsBinders [LForeignDecl GhcPs]
foreign_decls

    -- In a hs-boot file, the value binders come from the
    --  *signatures*, and there should be no foreign binders
    hs_boot_sig_bndrs :: [GenLocated SrcSpan RdrName]
hs_boot_sig_bndrs = [ SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
decl_loc (GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan RdrName
n)
                        | L SrcSpan
decl_loc (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ns LHsSigWcType GhcPs
_) <- [LSig GhcPs]
val_sigs, GenLocated SrcSpan RdrName
n <- [GenLocated SrcSpan RdrName]
[Located (IdP GhcPs)]
ns]

      -- the SrcSpan attached to the input should be the span of the
      -- declaration, not just the name
    new_simple :: Located RdrName -> RnM AvailInfo
    new_simple :: GenLocated SrcSpan RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
new_simple GenLocated SrcSpan RdrName
rdr_name = do{ Name
nm <- GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder GenLocated SrcSpan RdrName
rdr_name
                            ; AvailInfo -> IOEnv (Env TcGblEnv TcLclEnv) AvailInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AvailInfo
avail Name
nm) }

    new_tc :: Bool -> LTyClDecl GhcPs
           -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_tc :: AnyHpcUsage
-> LTyClDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_tc AnyHpcUsage
overload_ok LTyClDecl GhcPs
tc_decl -- NOT for type/data instances
        = do { let ([GenLocated SrcSpan RdrName]
bndrs, [LFieldOcc GhcPs]
flds) = LTyClDecl GhcPs -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
Located (TyClDecl (GhcPass p))
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLTyClDeclBinders LTyClDecl GhcPs
tc_decl
             ; names :: [Name]
names@(Name
main_name : [Name]
sub_names) <- (GenLocated SrcSpan RdrName -> RnM Name)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder [GenLocated SrcSpan RdrName]
bndrs
             ; [FieldLabel]
flds' <- (LFieldOcc GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [LFieldOcc GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
overload_ok [Name]
sub_names) [LFieldOcc GhcPs]
flds
             ; let fld_env :: [(Name, [FieldLabel])]
fld_env = case LTyClDecl GhcPs -> SrcSpanLess (LTyClDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LTyClDecl GhcPs
tc_decl of
                     DataDecl { tcdDataDefn = d } -> HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env HsDataDefn GhcPs
d [Name]
names [FieldLabel]
flds'
                     SrcSpanLess (LTyClDecl GhcPs)
_                            -> []
             ; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
main_name [Name]
names [FieldLabel]
flds', [(Name, [FieldLabel])]
fld_env) }


    -- Calculate the mapping from constructor names to fields, which
    -- will go in tcg_field_env. It's convenient to do this here where
    -- we are working with a single datatype definition.
    mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
               -> [(Name, [FieldLabel])]
    mk_fld_env :: HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env HsDataDefn GhcPs
d [Name]
names [FieldLabel]
flds = (GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])])
-> [GenLocated SrcSpan (ConDecl GhcPs)] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (HsDataDefn GhcPs -> [GenLocated SrcSpan (ConDecl GhcPs)]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
d)
      where
        find_con_flds :: GenLocated SrcSpan (ConDecl GhcPs) -> [(Name, [FieldLabel])]
find_con_flds (L SrcSpan
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_name = L SrcSpan
_ IdP GhcPs
rdr
                                       , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args = RecCon Located [LConDeclField GhcPs]
cdflds }))
            = [( RdrName -> Name
find_con_name RdrName
IdP GhcPs
rdr
               , (LConDeclField GhcPs -> [FieldLabel])
-> [LConDeclField GhcPs] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LConDeclField GhcPs -> [FieldLabel]
find_con_decl_flds (Located [LConDeclField GhcPs]
-> SrcSpanLess (Located [LConDeclField GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcPs]
cdflds) )]
        find_con_flds (L SrcSpan
_ (ConDeclGADT { con_names :: forall pass. ConDecl pass -> [Located (IdP pass)]
con_names = [Located (IdP GhcPs)]
rdrs
                                        , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args = RecCon Located [LConDeclField GhcPs]
flds }))
            = [ ( RdrName -> Name
find_con_name RdrName
rdr
                 , (LConDeclField GhcPs -> [FieldLabel])
-> [LConDeclField GhcPs] -> [FieldLabel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LConDeclField GhcPs -> [FieldLabel]
find_con_decl_flds (Located [LConDeclField GhcPs]
-> SrcSpanLess (Located [LConDeclField GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcPs]
flds))
              | L SrcSpan
_ RdrName
rdr <- [GenLocated SrcSpan RdrName]
[Located (IdP GhcPs)]
rdrs ]

        find_con_flds GenLocated SrcSpan (ConDecl GhcPs)
_ = []

        find_con_name :: RdrName -> Name
find_con_name RdrName
rdr
          = String -> Maybe Name -> Name
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_name" (Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$
              (Name -> AnyHpcUsage) -> [Name] -> Maybe Name
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\ Name
n -> Name -> OccName
nameOccName Name
n OccName -> OccName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== RdrName -> OccName
rdrNameOcc RdrName
rdr) [Name]
names
        find_con_decl_flds :: LConDeclField GhcPs -> [FieldLabel]
find_con_decl_flds (L SrcSpan
_ ConDeclField GhcPs
x)
          = (LFieldOcc GhcPs -> FieldLabel)
-> [LFieldOcc GhcPs] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map LFieldOcc GhcPs -> FieldLabel
find_con_decl_fld (ConDeclField GhcPs -> [LFieldOcc GhcPs]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcPs
x)

        find_con_decl_fld :: LFieldOcc GhcPs -> FieldLabel
find_con_decl_fld  (L SrcSpan
_ (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpan
_ RdrName
rdr)))
          = String -> Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getLocalNonValBinders/find_con_decl_fld" (Maybe FieldLabel -> FieldLabel) -> Maybe FieldLabel -> FieldLabel
forall a b. (a -> b) -> a -> b
$
              (FieldLabel -> AnyHpcUsage) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\ FieldLabel
fl -> FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel FieldLabel
fl FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== FastString
lbl) [FieldLabel]
flds
          where lbl :: FastString
lbl = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr)
        find_con_decl_fld (L SrcSpan
_ (XFieldOcc XXFieldOcc GhcPs
nec)) = NoExtCon -> FieldLabel
forall a. NoExtCon -> a
noExtCon XXFieldOcc GhcPs
NoExtCon
nec

    new_assoc :: Bool -> LInstDecl GhcPs
              -> RnM ([AvailInfo], [(Name, [FieldLabel])])
    new_assoc :: AnyHpcUsage
-> LInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
new_assoc AnyHpcUsage
_ (L SrcSpan
_ (TyFamInstD {})) = ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
      -- type instances don't bind new names

    new_assoc AnyHpcUsage
overload_ok (L SrcSpan
_ (DataFamInstD XDataFamInstD GhcPs
_ DataFamInstDecl GhcPs
d))
      = do { (AvailInfo
avail, [(Name, [FieldLabel])]
flds) <- AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
forall a. Maybe a
Nothing DataFamInstDecl GhcPs
d
           ; ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([AvailInfo
avail], [(Name, [FieldLabel])]
flds) }
    new_assoc AnyHpcUsage
overload_ok (L SrcSpan
_ (ClsInstD XClsInstD GhcPs
_ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcPs
inst_ty
                                                      , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcPs]
adts })))
      = do -- First, attempt to grab the name of the class from the instance.
           -- This step could fail if the instance is not headed by a class,
           -- such as in the following examples:
           --
           -- (1) The class is headed by a bang pattern, such as in
           --     `instance !Show Int` (#3811c)
           -- (2) The class is headed by a type variable, such as in
           --     `instance c` (#16385)
           --
           -- If looking up the class name fails, then mb_cls_nm will
           -- be Nothing.
           Maybe Name
mb_cls_nm <- MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ do
             -- See (1) above
             L SrcSpan
loc RdrName
cls_rdr <- IOEnv (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
-> MaybeT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
 -> MaybeT
      (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
-> MaybeT
     (IOEnv (Env TcGblEnv TcLclEnv)) (GenLocated SrcSpan RdrName)
forall a b. (a -> b) -> a -> b
$ Maybe (GenLocated SrcSpan RdrName)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (GenLocated SrcSpan RdrName)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName)))
-> Maybe (GenLocated SrcSpan RdrName)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Maybe (GenLocated SrcSpan RdrName))
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Maybe (Located (IdP GhcPs))
forall (p :: Pass).
LHsSigType (GhcPass p) -> Maybe (Located (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType GhcPs
inst_ty
             -- See (2) above
             IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Name)
lookupGlobalOccRn_maybe RdrName
cls_rdr
           -- Assuming the previous step succeeded, process any associated data
           -- family instances. If the previous step failed, bail out.
           case Maybe Name
mb_cls_nm of
             Maybe Name
Nothing -> ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
             Just Name
cls_nm -> do
               ([AvailInfo]
avails, [[(Name, [FieldLabel])]]
fldss)
                 <- (LDataFamInstDecl GhcPs
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])]))
-> [LDataFamInstDecl GhcPs]
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [[(Name, [FieldLabel])]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM (AnyHpcUsage
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di AnyHpcUsage
overload_ok (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cls_nm)) [LDataFamInstDecl GhcPs]
adts
               ([AvailInfo], [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AvailInfo]
avails, [[(Name, [FieldLabel])]] -> [(Name, [FieldLabel])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, [FieldLabel])]]
fldss)
    new_assoc AnyHpcUsage
_ (L SrcSpan
_ (ClsInstD XClsInstD GhcPs
_ (XClsInstDecl XXClsInstDecl GhcPs
nec))) = NoExtCon
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall a. NoExtCon -> a
noExtCon XXClsInstDecl GhcPs
NoExtCon
nec
    new_assoc AnyHpcUsage
_ (L SrcSpan
_ (XInstDecl XXInstDecl GhcPs
nec))                 = NoExtCon
-> IOEnv
     (Env TcGblEnv TcLclEnv) ([AvailInfo], [(Name, [FieldLabel])])
forall a. NoExtCon -> a
noExtCon XXInstDecl GhcPs
NoExtCon
nec

    new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs
                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_di :: AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
mb_cls dfid :: DataFamInstDecl GhcPs
dfid@(DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn =
                                     HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl }})
        = do { Located Name
main_name <- Maybe Name -> GenLocated SrcSpan RdrName -> RnM (Located Name)
lookupFamInstName Maybe Name
mb_cls (FamEqn GhcPs (HsDataDefn GhcPs) -> Located (IdP GhcPs)
forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl)
             ; let ([GenLocated SrcSpan RdrName]
bndrs, [LFieldOcc GhcPs]
flds) = DataFamInstDecl GhcPs -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs])
forall (p :: Pass).
DataFamInstDecl (GhcPass p)
-> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders DataFamInstDecl GhcPs
dfid
             ; [Name]
sub_names <- (GenLocated SrcSpan RdrName -> RnM Name)
-> [GenLocated SrcSpan RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder [GenLocated SrcSpan RdrName]
bndrs
             ; [FieldLabel]
flds' <- (LFieldOcc GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> [LFieldOcc GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
overload_ok [Name]
sub_names) [LFieldOcc GhcPs]
flds
             ; let avail :: AvailInfo
avail    = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
main_name) [Name]
sub_names [FieldLabel]
flds'
                                  -- main_name is not bound here!
                   fld_env :: [(Name, [FieldLabel])]
fld_env  = HsDataDefn GhcPs
-> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
mk_fld_env (FamEqn GhcPs (HsDataDefn GhcPs) -> HsDataDefn GhcPs
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn GhcPs (HsDataDefn GhcPs)
ti_decl) [Name]
sub_names [FieldLabel]
flds'
             ; (AvailInfo, [(Name, [FieldLabel])])
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall (m :: * -> *) a. Monad m => a -> m a
return (AvailInfo
avail, [(Name, [FieldLabel])]
fld_env) }
    new_di AnyHpcUsage
_ Maybe Name
_ (DataFamInstDecl (XHsImplicitBndrs XXHsImplicitBndrs GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
nec)) = NoExtCon
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
NoExtCon
nec

    new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs
                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_loc_di :: AnyHpcUsage
-> Maybe Name
-> LDataFamInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_loc_di AnyHpcUsage
overload_ok Maybe Name
mb_cls (L SrcSpan
_ DataFamInstDecl GhcPs
d) = AnyHpcUsage
-> Maybe Name
-> DataFamInstDecl GhcPs
-> IOEnv
     (Env TcGblEnv TcLclEnv) (AvailInfo, [(Name, [FieldLabel])])
new_di AnyHpcUsage
overload_ok Maybe Name
mb_cls DataFamInstDecl GhcPs
d
getLocalNonValBinders MiniFixityEnv
_ (XHsGroup XXHsGroup GhcPs
nec) = NoExtCon -> RnM ((TcGblEnv, TcLclEnv), NameSet)
forall a. NoExtCon -> a
noExtCon XXHsGroup GhcPs
NoExtCon
nec

newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector :: AnyHpcUsage
-> [Name]
-> LFieldOcc GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
newRecordSelector AnyHpcUsage
_ [] LFieldOcc GhcPs
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. HasCallStack => String -> a
error String
"newRecordSelector: datatype has no constructors!"
newRecordSelector AnyHpcUsage
_ [Name]
_ (L SrcSpan
_ (XFieldOcc XXFieldOcc GhcPs
nec)) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a. NoExtCon -> a
noExtCon XXFieldOcc GhcPs
NoExtCon
nec
newRecordSelector AnyHpcUsage
overload_ok (Name
dc:[Name]
_) (L SrcSpan
loc (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpan
_ RdrName
fld)))
  = do { Name
selName <- GenLocated SrcSpan RdrName -> RnM Name
newTopSrcBinder (GenLocated SrcSpan RdrName -> RnM Name)
-> GenLocated SrcSpan RdrName -> RnM Name
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (RdrName -> GenLocated SrcSpan RdrName)
-> RdrName -> GenLocated SrcSpan RdrName
forall a b. (a -> b) -> a -> b
$ RdrName
field
       ; FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel)
-> FieldLabel -> IOEnv (Env TcGblEnv TcLclEnv) FieldLabel
forall a b. (a -> b) -> a -> b
$ FieldLbl OccName
qualFieldLbl { flSelector :: Name
flSelector = Name
selName } }
  where
    fieldOccName :: FastString
fieldOccName = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
fld
    qualFieldLbl :: FieldLbl OccName
qualFieldLbl = FastString -> OccName -> AnyHpcUsage -> FieldLbl OccName
mkFieldLabelOccs FastString
fieldOccName (Name -> OccName
nameOccName Name
dc) AnyHpcUsage
overload_ok
    field :: RdrName
field | RdrName -> AnyHpcUsage
isExact RdrName
fld = RdrName
fld
              -- use an Exact RdrName as is to preserve the bindings
              -- of an already renamer-resolved field and its use
              -- sites. This is needed to correctly support record
              -- selectors in Template Haskell. See Note [Binders in
              -- Template Haskell] in Convert.hs and Note [Looking up
              -- Exact RdrNames] in RnEnv.hs.
          | AnyHpcUsage
otherwise   = OccName -> RdrName
mkRdrUnqual (FieldLbl OccName -> OccName
forall a. FieldLbl a -> a
flSelector FieldLbl OccName
qualFieldLbl)

{-
Note [Looking up family names in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

  module M where
    type family T a :: *
    type instance M.T Int = Bool

We might think that we can simply use 'lookupOccRn' when processing the type
instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
the *same* HsGroup as the type instance declaration.  Hence, as we are
currently collecting the binders declared in that HsGroup, these binders will
not have been added to the global environment yet.

Solution is simple: process the type family declarations first, extend
the environment, and then process the type instances.


************************************************************************
*                                                                      *
\subsection{Filtering imports}
*                                                                      *
************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

Note [Dealing with imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
For import M( ies ), we take the mi_exports of M, and make
   imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
One entry for each Name that M exports; the AvailInfo is the
AvailInfo exported from M that exports that Name.

The situation is made more complicated by associated types. E.g.
   module M where
     class    C a    where { data T a }
     instance C Int  where { data T Int = T1 | T2 }
     instance C Bool where { data T Int = T3 }
Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
  C(C,T), T(T,T1,T2,T3)
Notice that T appears *twice*, once as a child and once as a parent. From
this list we construct a raw list including
   T -> (T, T( T1, T2, T3 ), Nothing)
   T -> (C, C( C, T ),       Nothing)
and we combine these (in function 'combine' in 'imp_occ_env' in
'filterImports') to get
   T  -> (T,  T(T,T1,T2,T3), Just C)

So the overall imp_occ_env is
   C  -> (C,  C(C,T),        Nothing)
   T  -> (T,  T(T,T1,T2,T3), Just C)
   T1 -> (T1, T(T,T1,T2,T3), Nothing)   -- similarly T2,T3

If we say
   import M( T(T1,T2) )
then we get *two* Avails:  C(T), T(T1,T2)

Note that the imp_occ_env will have entries for data constructors too,
although we never look up data constructors.
-}

filterImports
    :: ModIface
    -> ImpDeclSpec                     -- The span for the entire import decl
    -> Maybe (Bool, Located [LIE GhcPs])    -- Import spec; True => hiding
    -> RnM (Maybe (Bool, Located [LIE GhcRn]), -- Import spec w/ Names
            [GlobalRdrElt])                   -- Same again, but in GRE form
filterImports :: ModIface
-> ImpDeclSpec
-> Maybe (AnyHpcUsage, Located [LIE GhcPs])
-> RnM (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
filterImports ModIface
iface ImpDeclSpec
decl_spec Maybe (AnyHpcUsage, Located [LIE GhcPs])
Nothing
  = (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
-> RnM (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall a. Maybe a
Nothing, Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
imp_spec) (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface))
  where
    imp_spec :: ImportSpec
imp_spec = ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }


filterImports ModIface
iface ImpDeclSpec
decl_spec (Just (AnyHpcUsage
want_hiding, L SrcSpan
l [LIE GhcPs]
import_items))
  = do  -- check for errors, convert RdrNames to Names
        [[(LIE GhcRn, AvailInfo)]]
items1 <- (LIE GhcPs
 -> IOEnv (Env TcGblEnv TcLclEnv) [(LIE GhcRn, AvailInfo)])
-> [LIE GhcPs]
-> IOEnv (Env TcGblEnv TcLclEnv) [[(LIE GhcRn, AvailInfo)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LIE GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) [(LIE GhcRn, AvailInfo)]
lookup_lie [LIE GhcPs]
import_items

        let items2 :: [(LIE GhcRn, AvailInfo)]
            items2 :: [(LIE GhcRn, AvailInfo)]
items2 = [[(LIE GhcRn, AvailInfo)]] -> [(LIE GhcRn, AvailInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(LIE GhcRn, AvailInfo)]]
items1
                -- NB the AvailInfo may have duplicates, and several items
                --    for the same parent; e.g N(x) and N(y)

            names :: NameSet
names  = [AvailInfo] -> NameSet
availsToNameSetWithSelectors (((LIE GhcRn, AvailInfo) -> AvailInfo)
-> [(LIE GhcRn, AvailInfo)] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map (LIE GhcRn, AvailInfo) -> AvailInfo
forall a b. (a, b) -> b
snd [(LIE GhcRn, AvailInfo)]
items2)
            keep :: Name -> AnyHpcUsage
keep Name
n = AnyHpcUsage -> AnyHpcUsage
not (Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
names)
            pruned_avails :: [AvailInfo]
pruned_avails = (Name -> AnyHpcUsage) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> AnyHpcUsage
keep [AvailInfo]
all_avails
            hiding_spec :: ImportSpec
hiding_spec = ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }

            gres :: [GlobalRdrElt]
gres | AnyHpcUsage
want_hiding = Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just ImportSpec
hiding_spec) [AvailInfo]
pruned_avails
                 | AnyHpcUsage
otherwise   = ((LIE GhcRn, AvailInfo) -> [GlobalRdrElt])
-> [(LIE GhcRn, AvailInfo)] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec) [(LIE GhcRn, AvailInfo)]
items2

        (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
-> RnM (Maybe (AnyHpcUsage, Located [LIE GhcRn]), [GlobalRdrElt])
forall (m :: * -> *) a. Monad m => a -> m a
return ((AnyHpcUsage, Located [LIE GhcRn])
-> Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall a. a -> Maybe a
Just (AnyHpcUsage
want_hiding, SrcSpan -> [LIE GhcRn] -> Located [LIE GhcRn]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (((LIE GhcRn, AvailInfo) -> LIE GhcRn)
-> [(LIE GhcRn, AvailInfo)] -> [LIE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (LIE GhcRn, AvailInfo) -> LIE GhcRn
forall a b. (a, b) -> a
fst [(LIE GhcRn, AvailInfo)]
items2)), [GlobalRdrElt]
gres)
  where
    all_avails :: [AvailInfo]
all_avails = ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface

        -- See Note [Dealing with imports]
    imp_occ_env :: OccEnv (Name,    -- the name
                           AvailInfo,   -- the export item providing the name
                           Maybe Name)  -- the parent of associated types
    imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
imp_occ_env = ((Name, AvailInfo, Maybe Name)
 -> (Name, AvailInfo, Maybe Name) -> (Name, AvailInfo, Maybe Name))
-> [(OccName, (Name, AvailInfo, Maybe Name))]
-> OccEnv (Name, AvailInfo, Maybe Name)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C (Name, AvailInfo, Maybe Name)
-> (Name, AvailInfo, Maybe Name) -> (Name, AvailInfo, Maybe Name)
forall a a.
(Outputable a, Outputable a) =>
(Name, AvailInfo, Maybe a)
-> (Name, AvailInfo, Maybe a) -> (Name, AvailInfo, Maybe Name)
combine [ (OccName
occ, (Name
n, AvailInfo
a, Maybe Name
forall a. Maybe a
Nothing))
                                     | AvailInfo
a <- [AvailInfo]
all_avails
                                     , (Name
n, OccName
occ) <- AvailInfo -> [(Name, OccName)]
availNamesWithOccs AvailInfo
a]
      where
        -- See Note [Dealing with imports]
        -- 'combine' is only called for associated data types which appear
        -- twice in the all_avails. In the example, we combine
        --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)
        -- NB: the AvailTC can have fields as well as data constructors (#12127)
        combine :: (Name, AvailInfo, Maybe a)
-> (Name, AvailInfo, Maybe a) -> (Name, AvailInfo, Maybe Name)
combine (Name
name1, a1 :: AvailInfo
a1@(AvailTC Name
p1 [Name]
_ [FieldLabel]
_), Maybe a
mp1)
                (Name
name2, a2 :: AvailInfo
a2@(AvailTC Name
p2 [Name]
_ [FieldLabel]
_), Maybe a
mp2)
          = ASSERT2( name1 == name2 && isNothing mp1 && isNothing mp2
                   , ppr name1 <+> ppr name2 <+> ppr mp1 <+> ppr mp2 )
            if Name
p1 Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name
name1 then (Name
name1, AvailInfo
a1, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p2)
                           else (Name
name1, AvailInfo
a2, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
p1)
        combine (Name, AvailInfo, Maybe a)
x (Name, AvailInfo, Maybe a)
y = String -> MsgDoc -> (Name, AvailInfo, Maybe Name)
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"filterImports/combine" ((Name, AvailInfo, Maybe a) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name, AvailInfo, Maybe a)
x MsgDoc -> MsgDoc -> MsgDoc
$$ (Name, AvailInfo, Maybe a) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name, AvailInfo, Maybe a)
y)

    lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
    lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie RdrName
rdr
       | RdrName -> AnyHpcUsage
isQual RdrName
rdr              = IELookupError -> IELookupM (Name, AvailInfo, Maybe Name)
forall a. IELookupError -> IELookupM a
failLookupWith (RdrName -> IELookupError
QualImportError RdrName
rdr)
       | Just (Name, AvailInfo, Maybe Name)
succ <- Maybe (Name, AvailInfo, Maybe Name)
mb_success = (Name, AvailInfo, Maybe Name)
-> IELookupM (Name, AvailInfo, Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name, AvailInfo, Maybe Name)
succ
       | AnyHpcUsage
otherwise               = IELookupError -> IELookupM (Name, AvailInfo, Maybe Name)
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
      where
        mb_success :: Maybe (Name, AvailInfo, Maybe Name)
mb_success = OccEnv (Name, AvailInfo, Maybe Name)
-> OccName -> Maybe (Name, AvailInfo, Maybe Name)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (Name, AvailInfo, Maybe Name)
imp_occ_env (RdrName -> OccName
rdrNameOcc RdrName
rdr)

    lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
    lookup_lie :: LIE GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) [(LIE GhcRn, AvailInfo)]
lookup_lie (L SrcSpan
loc IE GhcPs
ieRdr)
        = do ([(IE GhcRn, AvailInfo)]
stuff, [IELookupWarning]
warns) <- SrcSpan
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
 -> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
                               (Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
 -> ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. a -> Maybe a -> a
fromMaybe ([],[])) (IOEnv
   (Env TcGblEnv TcLclEnv)
   (Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
 -> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> TcRn ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$
                               IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
forall a. IELookupM a -> TcRn (Maybe a)
run_lookup (IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ieRdr)
             (IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [IELookupWarning] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning [IELookupWarning]
warns
             [(LIE GhcRn, AvailInfo)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(LIE GhcRn, AvailInfo)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (SrcSpan -> IE GhcRn -> LIE GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc IE GhcRn
ie, AvailInfo
avail) | (IE GhcRn
ie,AvailInfo
avail) <- [(IE GhcRn, AvailInfo)]
stuff ]
        where
            -- Warn when importing T(..) if T was exported abstractly
            emit_warning :: IELookupWarning -> IOEnv (Env TcGblEnv TcLclEnv) ()
emit_warning (DodgyImport RdrName
n) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (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_WarnDodgyImports) (RdrName -> MsgDoc
dodgyImportWarn RdrName
n)
            emit_warning IELookupWarning
MissingImportList = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnMissingImportList (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_WarnMissingImportList) (IE GhcPs -> MsgDoc
missingImportListItem IE GhcPs
ieRdr)
            emit_warning (BadImportW IE GhcPs
ie) = WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnDodgyImports (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_WarnDodgyImports) (IELookupError -> MsgDoc
lookup_err_msg (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie))

            run_lookup :: IELookupM a -> TcRn (Maybe a)
            run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup IELookupM a
m = case IELookupM a
m of
              Failed IELookupError
err -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (IELookupError -> MsgDoc
lookup_err_msg IELookupError
err) IOEnv (Env TcGblEnv TcLclEnv) ()
-> TcRn (Maybe a) -> TcRn (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> TcRn (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
              Succeeded a
a -> Maybe a -> TcRn (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

            lookup_err_msg :: IELookupError -> MsgDoc
lookup_err_msg IELookupError
err = case IELookupError
err of
              BadImport IE GhcPs
ie  -> ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> MsgDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
all_avails
              IELookupError
IllegalImport -> MsgDoc
illegalImportItemErr
              QualImportError RdrName
rdr -> RdrName -> MsgDoc
qualImportItemErr RdrName
rdr

        -- For each import item, we convert its RdrNames to Names,
        -- and at the same time construct an AvailInfo corresponding
        -- to what is actually imported by this item.
        -- Returns Nothing on error.
        -- We return a list here, because in the case of an import
        -- item like C, if we are hiding, then C refers to *both* a
        -- type/class and a data constructor.  Moreover, when we import
        -- data constructors of an associated family, we need separate
        -- AvailInfos for the data constructors and the family (as they have
        -- different parents).  See Note [Dealing with imports]
    lookup_ie :: IE GhcPs
              -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
    lookup_ie :: IE GhcPs -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
lookup_ie IE GhcPs
ie = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
handle_bad_import (IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
 -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$ do
      case IE GhcPs
ie of
        IEVar XIEVar GhcPs
_ (L SrcSpan
l IEWrappedName (IdP GhcPs)
n) -> do
            (Name
name, AvailInfo
avail, Maybe Name
_) <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (RdrName -> IELookupM (Name, AvailInfo, Maybe Name))
-> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
n
            ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
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 XIEVar GhcRn
NoExtField
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
n Name
name)),
                                                  AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
avail Name
name)], [])

        IEThingAll XIEThingAll GhcPs
_ (L SrcSpan
l IEWrappedName (IdP GhcPs)
tc) -> do
            (Name
name, AvailInfo
avail, Maybe Name
mb_parent) <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (RdrName -> IELookupM (Name, AvailInfo, Maybe Name))
-> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc
            let warns :: [IELookupWarning]
warns = case AvailInfo
avail of
                          Avail {}                     -- e.g. f(..)
                            -> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc]

                          AvailTC Name
_ [Name]
subs [FieldLabel]
fs
                            | [Name] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop Int
1 [Name]
subs) AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& [FieldLabel] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [FieldLabel]
fs -- e.g. T(..) where T is a synonym
                            -> [RdrName -> IELookupWarning
DodgyImport (RdrName -> IELookupWarning) -> RdrName -> IELookupWarning
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc]

                            | AnyHpcUsage -> AnyHpcUsage
not (ImpDeclSpec -> AnyHpcUsage
is_qual ImpDeclSpec
decl_spec)  -- e.g. import M( T(..) )
                            -> [IELookupWarning
MissingImportList]

                            | AnyHpcUsage
otherwise
                            -> []

                renamed_ie :: IE GhcRn
renamed_ie = XIEThingAll GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll XIEThingAll GhcRn
NoExtField
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName RdrName -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc Name
name))
                sub_avails :: [(IE GhcRn, AvailInfo)]
sub_avails = case AvailInfo
avail of
                               Avail {}              -> []
                               AvailTC Name
name2 [Name]
subs [FieldLabel]
fs -> [(IE GhcRn
renamed_ie, Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
name2 ([Name]
subs [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name
name]) [FieldLabel]
fs)]
            case Maybe Name
mb_parent of
              Maybe Name
Nothing     -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(IE GhcRn
renamed_ie, AvailInfo
avail)], [IELookupWarning]
warns)
                             -- non-associated ty/cls
              Just Name
parent -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ((IE GhcRn
renamed_ie, Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
parent [Name
name] []) (IE GhcRn, AvailInfo)
-> [(IE GhcRn, AvailInfo)] -> [(IE GhcRn, AvailInfo)]
forall a. a -> [a] -> [a]
: [(IE GhcRn, AvailInfo)]
sub_avails, [IELookupWarning]
warns)
                             -- associated type

        IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpan
l IEWrappedName (IdP GhcPs)
tc')
            | AnyHpcUsage
want_hiding   -- hiding ( C )
                       -- Here the 'C' can be a data constructor
                       --  *or* a type/class, or even both
            -> let tc :: RdrName
tc = IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc'
                   tc_name :: IELookupM (Name, AvailInfo, Maybe Name)
tc_name = IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie RdrName
tc
                   dc_name :: IELookupM (Name, AvailInfo, Maybe Name)
dc_name = IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
tc NameSpace
srcDataName)
               in
               case [IELookupM (Name, AvailInfo, Maybe Name)]
-> [(Name, AvailInfo, Maybe Name)]
forall a. [IELookupM a] -> [a]
catIELookupM [ IELookupM (Name, AvailInfo, Maybe Name)
tc_name, IELookupM (Name, AvailInfo, Maybe Name)
dc_name ] of
                 []    -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith (IE GhcPs -> IELookupError
BadImport IE GhcPs
ie)
                 [(Name, AvailInfo, Maybe Name)]
names -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName RdrName
-> SrcSpan
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
forall pass name1.
(XIEThingAbs pass ~ NoExtField, IdP pass ~ Name) =>
IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc' SrcSpan
l (Name, AvailInfo, Maybe Name)
name | (Name, AvailInfo, Maybe Name)
name <- [(Name, AvailInfo, Maybe Name)]
names], [])
            | AnyHpcUsage
otherwise
            -> do (Name, AvailInfo, Maybe Name)
nameAvail <- IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
lookup_name IE GhcPs
ie (IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc')
                  ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([IEWrappedName RdrName
-> SrcSpan
-> (Name, AvailInfo, Maybe Name)
-> (IE GhcRn, AvailInfo)
forall pass name1.
(XIEThingAbs pass ~ NoExtField, IdP pass ~ Name) =>
IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName RdrName
IEWrappedName (IdP GhcPs)
tc' SrcSpan
l (Name, AvailInfo, Maybe Name)
nameAvail]
                         , [])

        IEThingWith XIEThingWith GhcPs
xt ltc :: GenLocated SrcSpan (IEWrappedName (IdP GhcPs))
ltc@(L SrcSpan
l IEWrappedName (IdP GhcPs)
rdr_tc) IEWildcard
wc [GenLocated SrcSpan (IEWrappedName (IdP GhcPs))]
rdr_ns [Located (FieldLbl (IdP GhcPs))]
rdr_fs ->
          ASSERT2(null rdr_fs, ppr rdr_fs) do
           (name, avail, mb_parent)
               <- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc)

           let (ns,subflds) = case avail of
                                AvailTC _ ns' subflds' -> (ns',subflds')
                                Avail _                -> panic "filterImports"

           -- Look up the children in the sub-names of the parent
           let subnames = case ns of   -- The tc is first in ns,
                            [] -> []   -- if it is there at all
                                       -- See the AvailTC Invariant in Avail.hs
                            (n1:ns1) | n1 == name -> ns1
                                     | otherwise  -> ns
           case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of

             Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs []))
                                -- We are trying to import T( a,b,c,d ), and failed
                                -- to find 'b' and 'd'.  So we make up an import item
                                -- to report as failing, namely T( b, d ).
                                -- c.f. #15412

             Succeeded (childnames, childflds) ->
               case mb_parent of
                 -- non-associated ty/cls
                 Nothing
                   -> return ([(IEThingWith noExtField (L l name') wc childnames'
                                                                 childflds,
                               AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
                              [])
                   where name' = replaceWrappedName rdr_tc name
                         childnames' = map to_ie_post_rn childnames
                         -- childnames' = postrn_ies childnames
                 -- associated ty
                 Just parent
                   -> return ([(IEThingWith noExtField (L l name') wc childnames'
                                                           childflds,
                                AvailTC name (map unLoc childnames) (map unLoc childflds)),
                               (IEThingWith noExtField (L l name') wc childnames'
                                                           childflds,
                                AvailTC parent [name] [])],
                              [])
                   where name' = replaceWrappedName rdr_tc name
                         childnames' = map to_ie_post_rn childnames

        IE GhcPs
_other -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
IllegalImport
        -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
        -- all errors.

      where
        mkIEThingAbs :: IEWrappedName name1
-> SrcSpan -> (Name, AvailInfo, Maybe Name) -> (IE pass, AvailInfo)
mkIEThingAbs IEWrappedName name1
tc SrcSpan
l (Name
n, AvailInfo
av, Maybe Name
Nothing    )
          = (XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs XIEThingAbs pass
NoExtField
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName name1 -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName name1
tc Name
n)), AvailInfo -> Name -> AvailInfo
trimAvail AvailInfo
av Name
n)
        mkIEThingAbs IEWrappedName name1
tc SrcSpan
l (Name
n, AvailInfo
_,  Just Name
parent)
          = (XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs XIEThingAbs pass
NoExtField
noExtField (SrcSpan
-> IEWrappedName Name -> GenLocated SrcSpan (IEWrappedName Name)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (IEWrappedName name1 -> Name -> IEWrappedName Name
forall name1 name2.
IEWrappedName name1 -> name2 -> IEWrappedName name2
replaceWrappedName IEWrappedName name1
tc Name
n))
             , Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
parent [Name
n] [])

        handle_bad_import :: IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
handle_bad_import IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m = IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> (IELookupError
    -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a.
IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
m ((IELookupError
  -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
 -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> (IELookupError
    -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning]))
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a b. (a -> b) -> a -> b
$ \IELookupError
err -> case IELookupError
err of
          BadImport IE GhcPs
ie | AnyHpcUsage
want_hiding -> ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [IE GhcPs -> IELookupWarning
BadImportW IE GhcPs
ie])
          IELookupError
_                          -> IELookupError
-> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
forall a. IELookupError -> IELookupM a
failLookupWith IELookupError
err

type IELookupM = MaybeErr IELookupError

data IELookupWarning
  = BadImportW (IE GhcPs)
  | MissingImportList
  | DodgyImport RdrName
  -- NB. use the RdrName for reporting a "dodgy" import

data IELookupError
  = QualImportError RdrName
  | BadImport (IE GhcPs)
  | IllegalImport

failLookupWith :: IELookupError -> IELookupM a
failLookupWith :: IELookupError -> IELookupM a
failLookupWith IELookupError
err = IELookupError -> IELookupM a
forall err val. err -> MaybeErr err val
Failed IELookupError
err

catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup IELookupM a
m IELookupError -> IELookupM a
h = case IELookupM a
m of
  Succeeded a
r -> a -> IELookupM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
  Failed IELookupError
err  -> IELookupError -> IELookupM a
h IELookupError
err

catIELookupM :: [IELookupM a] -> [a]
catIELookupM :: [IELookupM a] -> [a]
catIELookupM [IELookupM a]
ms = [ a
a | Succeeded a
a <- [IELookupM a]
ms ]

{-
************************************************************************
*                                                                      *
\subsection{Import/Export Utils}
*                                                                      *
************************************************************************
-}

-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
gresFromIE ImpDeclSpec
decl_spec (L SrcSpan
loc IE GhcRn
ie, AvailInfo
avail)
  = (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail Name -> Maybe ImportSpec
prov_fn AvailInfo
avail
  where
    is_explicit :: Name -> AnyHpcUsage
is_explicit = case IE GhcRn
ie of
                    IEThingAll XIEThingAll GhcRn
_ LIEWrappedName (IdP GhcRn)
name -> \Name
n -> Name
n Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
name
                    IE GhcRn
_                 -> \Name
_ -> AnyHpcUsage
True
    prov_fn :: Name -> Maybe ImportSpec
prov_fn Name
name
      = ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just (ImpSpec :: ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
decl_spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
item_spec })
      where
        item_spec :: ImpItemSpec
item_spec = ImpSome :: AnyHpcUsage -> SrcSpan -> ImpItemSpec
ImpSome { is_explicit :: AnyHpcUsage
is_explicit = Name -> AnyHpcUsage
is_explicit Name
name, is_iloc :: SrcSpan
is_iloc = SrcSpan
loc }


{-
Note [Children for duplicate record fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the module

    {-# LANGUAGE DuplicateRecordFields #-}
    module M (F(foo, MkFInt, MkFBool)) where
      data family F a
      data instance F Int = MkFInt { foo :: Int }
      data instance F Bool = MkFBool { foo :: Bool }

The `foo` in the export list refers to *both* selectors! For this
reason, lookupChildren builds an environment that maps the FastString
to a list of items, rather than a single item.
-}

mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
gres = (GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> [GlobalRdrElt]
-> NameEnv [GlobalRdrElt]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add NameEnv [GlobalRdrElt]
forall a. NameEnv a
emptyNameEnv [GlobalRdrElt]
gres
  where
    add :: GlobalRdrElt -> NameEnv [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
add GlobalRdrElt
gre NameEnv [GlobalRdrElt]
env = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
        FldParent Name
p Maybe FastString
_  -> (GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrElt -> [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> Name
-> GlobalRdrElt
-> NameEnv [GlobalRdrElt]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrElt -> [GlobalRdrElt]
forall a. a -> [a]
singleton NameEnv [GlobalRdrElt]
env Name
p GlobalRdrElt
gre
        ParentIs  Name
p    -> (GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrElt -> [GlobalRdrElt])
-> NameEnv [GlobalRdrElt]
-> Name
-> GlobalRdrElt
-> NameEnv [GlobalRdrElt]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) GlobalRdrElt -> [GlobalRdrElt]
forall a. a -> [a]
singleton NameEnv [GlobalRdrElt]
env Name
p GlobalRdrElt
gre
        Parent
NoParent       -> NameEnv [GlobalRdrElt]
env

findChildren :: NameEnv [a] -> Name -> [a]
findChildren :: NameEnv [a] -> Name -> [a]
findChildren NameEnv [a]
env Name
n = NameEnv [a] -> Name -> Maybe [a]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv [a]
env Name
n Maybe [a] -> [a] -> [a]
forall a. Maybe a -> a -> a
`orElse` []

lookupChildren :: [Either Name FieldLabel] -> [LIEWrappedName RdrName]
               -> MaybeErr [LIEWrappedName RdrName]   -- The ones for which the lookup failed
                           ([Located Name], [Located FieldLabel])
-- (lookupChildren all_kids rdr_items) maps each rdr_item to its
-- corresponding Name all_kids, if the former exists
-- The matching is done by FastString, not OccName, so that
--    Cls( meth, AssocTy )
-- will correctly find AssocTy among the all_kids of Cls, even though
-- the RdrName for AssocTy may have a (bogus) DataName namespace
-- (Really the rdr_items should be FastStrings in the first place.)
lookupChildren :: [Either Name FieldLabel]
-> [LIEWrappedName RdrName]
-> MaybeErr
     [LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
lookupChildren [Either Name FieldLabel]
all_kids [LIEWrappedName RdrName]
rdr_items
  | [LIEWrappedName RdrName] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [LIEWrappedName RdrName]
fails
  = ([Located Name], [Located FieldLabel])
-> MaybeErr
     [LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (([[Located FieldLabel]] -> [Located FieldLabel])
-> ([Located Name], [[Located FieldLabel]])
-> ([Located Name], [Located FieldLabel])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Located FieldLabel]] -> [Located FieldLabel]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Either (Located Name) [Located FieldLabel]]
-> ([Located Name], [[Located FieldLabel]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Located Name) [Located FieldLabel]]
oks))
       -- This 'fmap concat' trickily applies concat to the /second/ component
       -- of the pair, whose type is ([Located Name], [[Located FieldLabel]])
  | AnyHpcUsage
otherwise
  = [LIEWrappedName RdrName]
-> MaybeErr
     [LIEWrappedName RdrName] ([Located Name], [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed [LIEWrappedName RdrName]
fails
  where
    mb_xs :: [MaybeErr
   (LIEWrappedName RdrName)
   (Either (Located Name) [Located FieldLabel])]
mb_xs = (LIEWrappedName RdrName
 -> MaybeErr
      (LIEWrappedName RdrName)
      (Either (Located Name) [Located FieldLabel]))
-> [LIEWrappedName RdrName]
-> [MaybeErr
      (LIEWrappedName RdrName)
      (Either (Located Name) [Located FieldLabel])]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName RdrName
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (Located Name) [Located FieldLabel])
doOne [LIEWrappedName RdrName]
rdr_items
    fails :: [LIEWrappedName RdrName]
fails = [ LIEWrappedName RdrName
bad_rdr | Failed LIEWrappedName RdrName
bad_rdr <- [MaybeErr
   (LIEWrappedName RdrName)
   (Either (Located Name) [Located FieldLabel])]
mb_xs ]
    oks :: [Either (Located Name) [Located FieldLabel]]
oks   = [ Either (Located Name) [Located FieldLabel]
ok      | Succeeded Either (Located Name) [Located FieldLabel]
ok   <- [MaybeErr
   (LIEWrappedName RdrName)
   (Either (Located Name) [Located FieldLabel])]
mb_xs ]
    oks :: [Either (Located Name) [Located FieldLabel]]

    doOne :: LIEWrappedName RdrName
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (Located Name) [Located FieldLabel])
doOne item :: LIEWrappedName RdrName
item@(L SrcSpan
l IEWrappedName RdrName
r)
       = case (FastStringEnv [Either Name FieldLabel]
-> FastString -> Maybe [Either Name FieldLabel]
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv [Either Name FieldLabel]
kid_env (FastString -> Maybe [Either Name FieldLabel])
-> (IEWrappedName RdrName -> FastString)
-> IEWrappedName RdrName
-> Maybe [Either Name FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (IEWrappedName RdrName -> OccName)
-> IEWrappedName RdrName
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (IEWrappedName RdrName -> RdrName)
-> IEWrappedName RdrName
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName) IEWrappedName RdrName
r of
           Just [Left Name
n]            -> Either (Located Name) [Located FieldLabel]
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (Located Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded (Located Name -> Either (Located Name) [Located FieldLabel]
forall a b. a -> Either a b
Left (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
n))
           Just [Either Name FieldLabel]
rs | (Either Name FieldLabel -> AnyHpcUsage)
-> [Either Name FieldLabel] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all Either Name FieldLabel -> AnyHpcUsage
forall a b. Either a b -> AnyHpcUsage
isRight [Either Name FieldLabel]
rs -> Either (Located Name) [Located FieldLabel]
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (Located Name) [Located FieldLabel])
forall err val. val -> MaybeErr err val
Succeeded ([Located FieldLabel] -> Either (Located Name) [Located FieldLabel]
forall a b. b -> Either a b
Right ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> FieldLabel -> Located FieldLabel
forall l e. l -> e -> GenLocated l e
L SrcSpan
l) ([Either Name FieldLabel] -> [FieldLabel]
forall a b. [Either a b] -> [b]
rights [Either Name FieldLabel]
rs)))
           Maybe [Either Name FieldLabel]
_                        -> LIEWrappedName RdrName
-> MaybeErr
     (LIEWrappedName RdrName)
     (Either (Located Name) [Located FieldLabel])
forall err val. err -> MaybeErr err val
Failed    LIEWrappedName RdrName
item

    -- See Note [Children for duplicate record fields]
    kid_env :: FastStringEnv [Either Name FieldLabel]
kid_env = ([Either Name FieldLabel]
 -> [Either Name FieldLabel] -> [Either Name FieldLabel])
-> FastStringEnv [Either Name FieldLabel]
-> [(FastString, [Either Name FieldLabel])]
-> FastStringEnv [Either Name FieldLabel]
forall a.
(a -> a -> a)
-> FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList_C [Either Name FieldLabel]
-> [Either Name FieldLabel] -> [Either Name FieldLabel]
forall a. [a] -> [a] -> [a]
(++) FastStringEnv [Either Name FieldLabel]
forall a. NameEnv a
emptyFsEnv
              [((Name -> FastString)
-> (FieldLabel -> FastString)
-> Either Name FieldLabel
-> FastString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OccName -> FastString
occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel Either Name FieldLabel
x, [Either Name FieldLabel
x]) | Either Name FieldLabel
x <- [Either Name FieldLabel]
all_kids]



-------------------------------

{-
*********************************************************
*                                                       *
\subsection{Unused names}
*                                                       *
*********************************************************
-}

reportUnusedNames :: TcGblEnv -> RnM ()
reportUnusedNames :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
reportUnusedNames TcGblEnv
gbl_env
  = do  { NameSet
keep <- TcRef NameSet -> TcRnIf TcGblEnv TcLclEnv NameSet
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef (TcGblEnv -> TcRef NameSet
tcg_keep TcGblEnv
gbl_env)
        ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"RUN" (DefUses -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env))
        ; TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env
        ; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedTopBinds ([GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ NameSet -> [GlobalRdrElt]
unused_locals NameSet
keep
        ; TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env }
  where
    used_names :: NameSet -> NameSet
    used_names :: NameSet -> NameSet
used_names NameSet
keep = DefUses -> NameSet -> NameSet
findUses (TcGblEnv -> DefUses
tcg_dus TcGblEnv
gbl_env) NameSet
emptyNameSet NameSet -> NameSet -> NameSet
`unionNameSet` NameSet
keep
    -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
    -- Hence findUses

    -- Collect the defined names from the in-scope environment
    defined_names :: [GlobalRdrElt]
    defined_names :: [GlobalRdrElt]
defined_names = GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts (TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env)

    kids_env :: NameEnv [GlobalRdrElt]
kids_env = [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
mkChildEnv [GlobalRdrElt]
defined_names
    -- This is done in mkExports too; duplicated work

    gre_is_used :: NameSet -> GlobalRdrElt -> Bool
    gre_is_used :: NameSet -> GlobalRdrElt -> AnyHpcUsage
gre_is_used NameSet
used_names (GRE {gre_name :: GlobalRdrElt -> Name
gre_name = Name
name})
        = Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names
          AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
any (\ GlobalRdrElt
gre -> GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names) (NameEnv [GlobalRdrElt] -> Name -> [GlobalRdrElt]
forall a. NameEnv [a] -> Name -> [a]
findChildren NameEnv [GlobalRdrElt]
kids_env Name
name)
                -- A use of C implies a use of T,
                -- if C was brought into scope by T(..) or T(C)

    -- Filter out the ones that are
    --  (a) defined in this module, and
    --  (b) not defined by a 'deriving' clause
    -- The latter have an Internal Name, so we can filter them out easily
    unused_locals :: NameSet -> [GlobalRdrElt]
    unused_locals :: NameSet -> [GlobalRdrElt]
unused_locals NameSet
keep =
      let -- Note that defined_and_used, defined_but_not_used
          -- are both [GRE]; that's why we need defined_and_used
          -- rather than just used_names
          _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
          ([GlobalRdrElt]
_defined_and_used, [GlobalRdrElt]
defined_but_not_used)
              = (GlobalRdrElt -> AnyHpcUsage)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> AnyHpcUsage) -> [a] -> ([a], [a])
partition (NameSet -> GlobalRdrElt -> AnyHpcUsage
gre_is_used (NameSet -> NameSet
used_names NameSet
keep)) [GlobalRdrElt]
defined_names

      in (GlobalRdrElt -> AnyHpcUsage) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter GlobalRdrElt -> AnyHpcUsage
is_unused_local [GlobalRdrElt]
defined_but_not_used
    is_unused_local :: GlobalRdrElt -> Bool
    is_unused_local :: GlobalRdrElt -> AnyHpcUsage
is_unused_local GlobalRdrElt
gre = GlobalRdrElt -> AnyHpcUsage
isLocalGRE GlobalRdrElt
gre AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& Name -> AnyHpcUsage
isExternalName (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre)

{- *********************************************************************
*                                                                      *
              Missing signatures
*                                                                      *
********************************************************************* -}

-- | Warn the user about top level binders that lack type signatures.
-- Called /after/ type inference, so that we can report the
-- inferred type of the function
warnMissingSignatures :: TcGblEnv -> RnM ()
warnMissingSignatures :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnMissingSignatures TcGblEnv
gbl_env
  = do { let exports :: NameSet
exports = [AvailInfo] -> NameSet
availsToNameSet (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
gbl_env)
             sig_ns :: NameSet
sig_ns  = TcGblEnv -> NameSet
tcg_sigs TcGblEnv
gbl_env
               -- We use sig_ns to exclude top-level bindings that are generated by GHC
             binds :: [IdP (GhcPass 'Typechecked)]
binds    = LHsBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
-> [IdP (GhcPass 'Typechecked)]
forall (p :: Pass) idR.
LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders (LHsBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
 -> [IdP (GhcPass 'Typechecked)])
-> LHsBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
-> [IdP (GhcPass 'Typechecked)]
forall a b. (a -> b) -> a -> b
$ TcGblEnv
-> LHsBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
tcg_binds TcGblEnv
gbl_env
             pat_syns :: [PatSyn]
pat_syns = TcGblEnv -> [PatSyn]
tcg_patsyns TcGblEnv
gbl_env

         -- Warn about missing signatures
         -- Do this only when we have a type to offer
       ; AnyHpcUsage
warn_missing_sigs  <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingSignatures
       ; AnyHpcUsage
warn_only_exported <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingExportedSignatures
       ; AnyHpcUsage
warn_pat_syns      <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv AnyHpcUsage
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl AnyHpcUsage
woptM WarningFlag
Opt_WarnMissingPatternSynonymSignatures

       ; let add_sig_warns :: IOEnv (Env TcGblEnv TcLclEnv) ()
add_sig_warns
               | AnyHpcUsage
warn_only_exported = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingExportedSignatures
               | AnyHpcUsage
warn_missing_sigs  = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingSignatures
               | AnyHpcUsage
warn_pat_syns      = WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
Opt_WarnMissingPatternSynonymSignatures
               | AnyHpcUsage
otherwise          = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

             add_warns :: WarningFlag -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warns WarningFlag
flag
                = AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when AnyHpcUsage
warn_pat_syns
                       ((PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [PatSyn] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_pat_syn_warn [PatSyn]
pat_syns) IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (AnyHpcUsage
warn_missing_sigs AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| AnyHpcUsage
warn_only_exported)
                       ((Id -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [Id] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_bind_warn [Id]
[IdP (GhcPass 'Typechecked)]
binds)
                where
                  add_pat_syn_warn :: PatSyn -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_pat_syn_warn PatSyn
p
                    = Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                      MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Pattern synonym with no type signature:")
                         Int
2 (String -> MsgDoc
text String
"pattern" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. NamedThing a => a -> MsgDoc
pprPrefixName Name
name MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
dcolon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_ty)
                    where
                      name :: Name
name  = PatSyn -> Name
patSynName PatSyn
p
                      pp_ty :: MsgDoc
pp_ty = PatSyn -> MsgDoc
pprPatSynType PatSyn
p

                  add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
                  add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_bind_warn Id
id
                    = do { TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv     -- Why not use emptyTidyEnv?
                         ; let name :: Name
name    = Id -> Name
idName Id
id
                               (TidyEnv
_, Type
ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
env (Id -> Type
idType Id
id)
                               ty_msg :: MsgDoc
ty_msg  = Type -> MsgDoc
pprSigmaType Type
ty
                         ; Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                           MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Top-level binding with no type signature:")
                              Int
2 (Name -> MsgDoc
forall a. NamedThing a => a -> MsgDoc
pprPrefixName Name
name MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
dcolon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
ty_msg) }

                  add_warn :: Name -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_warn Name
name MsgDoc
msg
                    = AnyHpcUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
sig_ns AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& Name -> AnyHpcUsage
export_check Name
name)
                           (WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
name) MsgDoc
msg)

                  export_check :: Name -> AnyHpcUsage
export_check Name
name
                    = AnyHpcUsage -> AnyHpcUsage
not AnyHpcUsage
warn_only_exported AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
|| Name
name Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
exports

       ; IOEnv (Env TcGblEnv TcLclEnv) ()
add_sig_warns }


{-
*********************************************************
*                                                       *
\subsection{Unused imports}
*                                                       *
*********************************************************

This code finds which import declarations are unused.  The
specification and implementation notes are here:
  https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/unused-imports

See also Note [Choosing the best import declaration] in RdrName
-}

type ImportDeclUsage
   = ( LImportDecl GhcRn   -- The import declaration
     , [GlobalRdrElt]      -- What *is* used (normalised)
     , [Name] )            -- What is imported but *not* used

warnUnusedImportDecls :: TcGblEnv -> RnM ()
warnUnusedImportDecls :: TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImportDecls TcGblEnv
gbl_env
  = do { [GlobalRdrElt]
uses <- IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a env. IORef a -> IOEnv env a
readMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
gbl_env)
       ; let user_imports :: [LImportDecl GhcRn]
user_imports = (LImportDecl GhcRn -> AnyHpcUsage)
-> [LImportDecl GhcRn] -> [LImportDecl GhcRn]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filterOut
                              (ImportDecl GhcRn -> AnyHpcUsage
forall pass. ImportDecl pass -> AnyHpcUsage
ideclImplicit (ImportDecl GhcRn -> AnyHpcUsage)
-> (LImportDecl GhcRn -> ImportDecl GhcRn)
-> LImportDecl GhcRn
-> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcRn -> ImportDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                              (TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
gbl_env)
                -- This whole function deals only with *user* imports
                -- both for warning about unnecessary ones, and for
                -- deciding the minimal ones
             rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gbl_env
             fld_env :: NameEnv (FastString, Name)
fld_env = GlobalRdrEnv -> NameEnv (FastString, Name)
mkFieldEnv GlobalRdrEnv
rdr_env

       ; let usage :: [ImportDeclUsage]
             usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
user_imports [GlobalRdrElt]
uses

       ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"warnUnusedImportDecls" (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                       ([MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"Uses:" MsgDoc -> MsgDoc -> MsgDoc
<+> [GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
uses
                             , String -> MsgDoc
text String
"Import usage" MsgDoc -> MsgDoc -> MsgDoc
<+> [ImportDeclUsage] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [ImportDeclUsage]
usage])

       ; WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedImports (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
         (ImportDeclUsage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WarningFlag
-> NameEnv (FastString, Name)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
Opt_WarnUnusedImports NameEnv (FastString, Name)
fld_env) [ImportDeclUsage]
usage

       ; GeneralFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_D_dump_minimal_imports (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
         [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports [ImportDeclUsage]
usage }

findImportUsage :: [LImportDecl GhcRn]
                -> [GlobalRdrElt]
                -> [ImportDeclUsage]

findImportUsage :: [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
imports [GlobalRdrElt]
used_gres
  = (LImportDecl GhcRn -> ImportDeclUsage)
-> [LImportDecl GhcRn] -> [ImportDeclUsage]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcRn -> ImportDeclUsage
unused_decl [LImportDecl GhcRn]
imports
  where
    import_usage :: ImportMap
    import_usage :: ImportMap
import_usage = [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
used_gres

    unused_decl :: LImportDecl GhcRn -> ImportDeclUsage
unused_decl decl :: LImportDecl GhcRn
decl@(L SrcSpan
loc (ImportDecl { ideclHiding :: forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding = Maybe (AnyHpcUsage, Located [LIE GhcRn])
imps }))
      = (LImportDecl GhcRn
decl, [GlobalRdrElt]
used_gres, NameSet -> [Name]
nameSetElemsStable NameSet
unused_imps)
      where
        used_gres :: [GlobalRdrElt]
used_gres = SrcLoc -> ImportMap -> Maybe [GlobalRdrElt]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) ImportMap
import_usage
                               -- srcSpanEnd: see Note [The ImportMap]
                    Maybe [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. Maybe a -> a -> a
`orElse` []

        used_names :: NameSet
used_names   = [Name] -> NameSet
mkNameSet ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map      GlobalRdrElt -> Name
gre_name        [GlobalRdrElt]
used_gres)
        used_parents :: NameSet
used_parents = [Name] -> NameSet
mkNameSet ((GlobalRdrElt -> Maybe Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe Name
greParent_maybe [GlobalRdrElt]
used_gres)

        unused_imps :: NameSet
unused_imps   -- Not trivial; see eg #7454
          = case Maybe (AnyHpcUsage, Located [LIE GhcRn])
imps of
              Just (AnyHpcUsage
False, L SrcSpan
_ [LIE GhcRn]
imp_ies) ->
                                 (LIE GhcRn -> NameSet -> NameSet)
-> NameSet -> [LIE GhcRn] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IE GhcRn -> NameSet -> NameSet
add_unused (IE GhcRn -> NameSet -> NameSet)
-> (LIE GhcRn -> IE GhcRn) -> LIE GhcRn -> NameSet -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcRn -> IE GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) NameSet
emptyNameSet [LIE GhcRn]
imp_ies
              Maybe (AnyHpcUsage, Located [LIE GhcRn])
_other -> NameSet
emptyNameSet -- No explicit import list => no unused-name list

        add_unused :: IE GhcRn -> NameSet -> NameSet
        add_unused :: IE GhcRn -> NameSet -> NameSet
add_unused (IEVar XIEVar GhcRn
_ LIEWrappedName (IdP GhcRn)
n)      NameSet
acc = Name -> NameSet -> NameSet
add_unused_name (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
        add_unused (IEThingAbs XIEThingAbs GhcRn
_ LIEWrappedName (IdP GhcRn)
n) NameSet
acc = Name -> NameSet -> NameSet
add_unused_name (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
        add_unused (IEThingAll XIEThingAll GhcRn
_ LIEWrappedName (IdP GhcRn)
n) NameSet
acc = Name -> NameSet -> NameSet
add_unused_all  (GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
n) NameSet
acc
        add_unused (IEThingWith XIEThingWith GhcRn
_ LIEWrappedName (IdP GhcRn)
p IEWildcard
wc [LIEWrappedName (IdP GhcRn)]
ns [Located (FieldLbl (IdP GhcRn))]
fs) NameSet
acc =
          NameSet -> NameSet
add_wc_all (Name -> [Name] -> NameSet -> NameSet
add_unused_with Name
pn [Name]
xs NameSet
acc)
          where pn :: Name
pn = GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName GenLocated SrcSpan (IEWrappedName Name)
LIEWrappedName (IdP GhcRn)
p
                xs :: [Name]
xs = (GenLocated SrcSpan (IEWrappedName Name) -> Name)
-> [GenLocated SrcSpan (IEWrappedName Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (IEWrappedName Name) -> Name
forall name. LIEWrappedName name -> name
lieWrappedName [GenLocated SrcSpan (IEWrappedName Name)]
[LIEWrappedName (IdP GhcRn)]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Located FieldLabel -> Name) -> [Located FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector (FieldLabel -> Name)
-> (Located FieldLabel -> FieldLabel) -> Located FieldLabel -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located FieldLabel -> FieldLabel
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located FieldLabel]
[Located (FieldLbl (IdP GhcRn))]
fs
                add_wc_all :: NameSet -> NameSet
add_wc_all = case IEWildcard
wc of
                            IEWildcard
NoIEWildcard -> NameSet -> NameSet
forall a. a -> a
id
                            IEWildcard Int
_ -> Name -> NameSet -> NameSet
add_unused_all Name
pn
        add_unused IE GhcRn
_ NameSet
acc = NameSet
acc

        add_unused_name :: Name -> NameSet -> NameSet
add_unused_name Name
n NameSet
acc
          | Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names = NameSet
acc
          | AnyHpcUsage
otherwise                  = NameSet
acc NameSet -> Name -> NameSet
`extendNameSet` Name
n
        add_unused_all :: Name -> NameSet -> NameSet
add_unused_all Name
n NameSet
acc
          | Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_names   = NameSet
acc
          | Name
n Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
used_parents = NameSet
acc
          | AnyHpcUsage
otherwise                    = NameSet
acc NameSet -> Name -> NameSet
`extendNameSet` Name
n
        add_unused_with :: Name -> [Name] -> NameSet -> NameSet
add_unused_with Name
p [Name]
ns NameSet
acc
          | (Name -> AnyHpcUsage) -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (Name -> NameSet -> AnyHpcUsage
`elemNameSet` NameSet
acc1) [Name]
ns = Name -> NameSet -> NameSet
add_unused_name Name
p NameSet
acc1
          | AnyHpcUsage
otherwise = NameSet
acc1
          where
            acc1 :: NameSet
acc1 = (Name -> NameSet -> NameSet) -> NameSet -> [Name] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> NameSet -> NameSet
add_unused_name NameSet
acc [Name]
ns
       -- If you use 'signum' from Num, then the user may well have
       -- imported Num(signum).  We don't want to complain that
       -- Num is not itself mentioned.  Hence the two cases in add_unused_with.
    unused_decl (L SrcSpan
_ (XImportDecl XXImportDecl GhcRn
nec)) = NoExtCon -> ImportDeclUsage
forall a. NoExtCon -> a
noExtCon XXImportDecl GhcRn
NoExtCon
nec


{- Note [The ImportMap]
~~~~~~~~~~~~~~~~~~~~~~~
The ImportMap is a short-lived intermediate data structure records, for
each import declaration, what stuff brought into scope by that
declaration is actually used in the module.

The SrcLoc is the location of the END of a particular 'import'
declaration.  Why *END*?  Because we don't want to get confused
by the implicit Prelude import. Consider (#7476) the module
    import Foo( foo )
    main = print foo
There is an implicit 'import Prelude(print)', and it gets a SrcSpan
of line 1:1 (just the point, not a span). If we use the *START* of
the SrcSpan to identify the import decl, we'll confuse the implicit
import Prelude with the explicit 'import Foo'.  So we use the END.
It's just a cheap hack; we could equally well use the Span too.

The [GlobalRdrElt] are the things imported from that decl.
-}

type ImportMap = Map SrcLoc [GlobalRdrElt]  -- See [The ImportMap]
     -- If loc :-> gres, then
     --   'loc' = the end loc of the bestImport of each GRE in 'gres'

mkImportMap :: [GlobalRdrElt] -> ImportMap
-- For each of a list of used GREs, find all the import decls that brought
-- it into scope; choose one of them (bestImport), and record
-- the RdrName in that import decl's entry in the ImportMap
mkImportMap :: [GlobalRdrElt] -> ImportMap
mkImportMap [GlobalRdrElt]
gres
  = (GlobalRdrElt -> ImportMap -> ImportMap)
-> ImportMap -> [GlobalRdrElt] -> ImportMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> ImportMap -> ImportMap
add_one ImportMap
forall k a. Map k a
Map.empty [GlobalRdrElt]
gres
  where
    add_one :: GlobalRdrElt -> ImportMap -> ImportMap
add_one gre :: GlobalRdrElt
gre@(GRE { gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
imp_specs }) ImportMap
imp_map
       = ([GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt])
-> SrcLoc -> [GlobalRdrElt] -> ImportMap -> ImportMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add SrcLoc
decl_loc [GlobalRdrElt
gre] ImportMap
imp_map
       where
          best_imp_spec :: ImportSpec
best_imp_spec = [ImportSpec] -> ImportSpec
bestImport [ImportSpec]
imp_specs
          decl_loc :: SrcLoc
decl_loc      = SrcSpan -> SrcLoc
srcSpanEnd (ImpDeclSpec -> SrcSpan
is_dloc (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
best_imp_spec))
                        -- For srcSpanEnd see Note [The ImportMap]
          add :: [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
add [GlobalRdrElt]
_ [GlobalRdrElt]
gres = GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres

warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name)
                 -> ImportDeclUsage -> RnM ()
warnUnusedImport :: WarningFlag
-> NameEnv (FastString, Name)
-> ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedImport WarningFlag
flag NameEnv (FastString, Name)
fld_env (L SrcSpan
loc ImportDecl GhcRn
decl, [GlobalRdrElt]
used, [Name]
unused)

  -- Do not warn for 'import M()'
  | Just (AnyHpcUsage
False,L SrcSpan
_ []) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding ImportDecl GhcRn
decl
  = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Note [Do not warn about Prelude hiding]
  | Just (AnyHpcUsage
True, L SrcSpan
_ [LIE GhcRn]
hides) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding ImportDecl GhcRn
decl
  , AnyHpcUsage -> AnyHpcUsage
not ([LIE GhcRn] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [LIE GhcRn]
hides)
  , ModuleName
pRELUDE_NAME ModuleName -> ModuleName -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ImportDecl GhcRn -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcRn
decl)
  = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Nothing used; drop entire declaration
  | [GlobalRdrElt] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [GlobalRdrElt]
used
  = WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) SrcSpan
loc MsgDoc
msg1

  -- Everything imported is used; nop
  | [Name] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [Name]
unused
  = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Some imports are unused
  | AnyHpcUsage
otherwise
  = WarnReason -> SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
flag) SrcSpan
loc  MsgDoc
msg2

  where
    msg1 :: MsgDoc
msg1 = [MsgDoc] -> MsgDoc
vcat [ MsgDoc
pp_herald MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
is_redundant
                , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"except perhaps to import instances from"
                                   MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod)
                , String -> MsgDoc
text String
"To import instances alone, use:"
                                   MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"import" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens MsgDoc
Outputable.empty ]
    msg2 :: MsgDoc
msg2 = [MsgDoc] -> MsgDoc
sep [ MsgDoc
pp_herald MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
sort_unused
               , String -> MsgDoc
text String
"from module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pp_mod MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
is_redundant]
    pp_herald :: MsgDoc
pp_herald  = String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_qual MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"import of"
    pp_qual :: MsgDoc
pp_qual
      | ImportDeclQualifiedStyle -> AnyHpcUsage
isImportDeclQualified (ImportDecl GhcRn -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcRn
decl)= String -> MsgDoc
text String
"qualified"
      | AnyHpcUsage
otherwise                                  = MsgDoc
Outputable.empty
    pp_mod :: MsgDoc
pp_mod       = ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ImportDecl GhcRn -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcRn
decl))
    is_redundant :: MsgDoc
is_redundant = String -> MsgDoc
text String
"is redundant"

    -- In warning message, pretty-print identifiers unqualified unconditionally
    -- to improve the consistent for ambiguous/unambiguous identifiers.
    -- See trac#14881.
    ppr_possible_field :: Name -> MsgDoc
ppr_possible_field Name
n = case NameEnv (FastString, Name) -> Name -> Maybe (FastString, Name)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (FastString, Name)
fld_env Name
n of
                               Just (FastString
fld, Name
p) -> Name -> MsgDoc
pprNameUnqualified Name
p MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FastString
fld)
                               Maybe (FastString, Name)
Nothing  -> Name -> MsgDoc
pprNameUnqualified Name
n

    -- Print unused names in a deterministic (lexicographic) order
    sort_unused :: SDoc
    sort_unused :: MsgDoc
sort_unused = (Name -> MsgDoc) -> [Name] -> MsgDoc
forall a. (a -> MsgDoc) -> [a] -> MsgDoc
pprWithCommas Name -> MsgDoc
ppr_possible_field ([Name] -> MsgDoc) -> [Name] -> MsgDoc
forall a b. (a -> b) -> a -> b
$
                  (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Name -> OccName) -> Name -> Name -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Name -> OccName
nameOccName) [Name]
unused

{-
Note [Do not warn about Prelude hiding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We do not warn about
   import Prelude hiding( x, y )
because even if nothing else from Prelude is used, it may be essential to hide
x,y to avoid name-shadowing warnings.  Example (#9061)
   import Prelude hiding( log )
   f x = log where log = ()



Note [Printing minimal imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To print the minimal imports we walk over the user-supplied import
decls, and simply trim their import lists.  NB that

  * We do *not* change the 'qualified' or 'as' parts!

  * We do not disard a decl altogether; we might need instances
    from it.  Instead we just trim to an empty import list
-}

getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports = (ImportDeclUsage
 -> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn))
-> [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ImportDeclUsage
-> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn)
forall (t :: * -> *) a.
Foldable t =>
(LImportDecl GhcRn, [GlobalRdrElt], t a)
-> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn)
mk_minimal
  where
    mk_minimal :: (LImportDecl GhcRn, [GlobalRdrElt], t a)
-> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn)
mk_minimal (L SrcSpan
l ImportDecl GhcRn
decl, [GlobalRdrElt]
used_gres, t a
unused)
      | t a -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null t a
unused
      , Just (AnyHpcUsage
False, Located [LIE GhcRn]
_) <- ImportDecl GhcRn -> Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall pass.
ImportDecl pass -> Maybe (AnyHpcUsage, Located [LIE pass])
ideclHiding ImportDecl GhcRn
decl
      = LImportDecl GhcRn
-> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> ImportDecl GhcRn -> LImportDecl GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcRn
decl)
      | AnyHpcUsage
otherwise
      = do { let ImportDecl { ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName    = L SrcSpan
_ ModuleName
mod_name
                            , ideclSource :: forall pass. ImportDecl pass -> AnyHpcUsage
ideclSource  = AnyHpcUsage
is_boot
                            , ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual = Maybe StringLiteral
mb_pkg } = ImportDecl GhcRn
decl
           ; ModIface
iface <- MsgDoc
-> ModuleName -> AnyHpcUsage -> Maybe FastString -> RnM ModIface
loadSrcInterface MsgDoc
doc ModuleName
mod_name AnyHpcUsage
is_boot ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs Maybe StringLiteral
mb_pkg)
           ; let used_avails :: [AvailInfo]
used_avails = [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo [GlobalRdrElt]
used_gres
                 lies :: [LIE GhcRn]
lies = (IE GhcRn -> LIE GhcRn) -> [IE GhcRn] -> [LIE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> IE GhcRn -> LIE GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l) ((AvailInfo -> [IE GhcRn]) -> [AvailInfo] -> [IE GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
iface) [AvailInfo]
used_avails)
           ; LImportDecl GhcRn
-> IOEnv (Env TcGblEnv TcLclEnv) (LImportDecl GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> ImportDecl GhcRn -> LImportDecl GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (ImportDecl GhcRn
decl { ideclHiding :: Maybe (AnyHpcUsage, Located [LIE GhcRn])
ideclHiding = (AnyHpcUsage, Located [LIE GhcRn])
-> Maybe (AnyHpcUsage, Located [LIE GhcRn])
forall a. a -> Maybe a
Just (AnyHpcUsage
False, SrcSpan -> [LIE GhcRn] -> Located [LIE GhcRn]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [LIE GhcRn]
lies) })) }
      where
        doc :: MsgDoc
doc = String -> MsgDoc
text String
"Compute minimal imports for" MsgDoc -> MsgDoc -> MsgDoc
<+> ImportDecl GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ImportDecl GhcRn
decl

    to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
    -- The main trick here is that if we're importing all the constructors
    -- we want to say "T(..)", but if we're importing only a subset we want
    -- to say "T(A,B,C)".  So we have to find out what the module exports.
    to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
to_ie ModIface
_ (Avail Name
n)
       = [XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar XIEVar GhcRn
NoExtField
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n)]
    to_ie ModIface
_ (AvailTC Name
n [Name
m] [])
       | Name
nName -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
==Name
m = [XIEThingAbs GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs XIEThingAbs GhcRn
NoExtField
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n)]
    to_ie ModIface
iface (AvailTC Name
n [Name]
ns [FieldLabel]
fs)
      = case [([Name]
xs,[FieldLabel]
gs) |  AvailTC Name
x [Name]
xs [FieldLabel]
gs <- ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface
                 , Name
x Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name
n
                 , Name
x Name -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Name]
xs    -- Note [Partial export]
                 ] of
           [([Name], [FieldLabel])
xs] | ([Name], [FieldLabel]) -> AnyHpcUsage
all_used ([Name], [FieldLabel])
xs -> [XIEThingAll GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll XIEThingAll GhcRn
NoExtField
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n)]
                | AnyHpcUsage
otherwise   ->
                   [XIEThingWith GhcRn
-> LIEWrappedName (IdP GhcRn)
-> IEWildcard
-> [LIEWrappedName (IdP GhcRn)]
-> [Located (FieldLbl (IdP GhcRn))]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith XIEThingWith GhcRn
NoExtField
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n) IEWildcard
NoIEWildcard
                                ((Name -> GenLocated SrcSpan (IEWrappedName Name))
-> [Name] -> [GenLocated SrcSpan (IEWrappedName Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) ((Name -> AnyHpcUsage) -> [Name] -> [Name]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Name
n) [Name]
ns))
                                ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [FieldLabel]
fs)]
                                          -- Note [Overloaded field import]
           [([Name], [FieldLabel])]
_other | [FieldLabel] -> AnyHpcUsage
forall a. [FieldLbl a] -> AnyHpcUsage
all_non_overloaded [FieldLabel]
fs
                           -> (Name -> IE GhcRn) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XIEVar GhcRn -> LIEWrappedName (IdP GhcRn) -> IE GhcRn
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar XIEVar GhcRn
NoExtField
noExtField (GenLocated SrcSpan (IEWrappedName Name) -> IE GhcRn)
-> (Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Name
-> IE GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn_var (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) ([Name] -> [IE GhcRn]) -> [Name] -> [IE GhcRn]
forall a b. (a -> b) -> a -> b
$ [Name]
ns
                                 [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector [FieldLabel]
fs
                  | AnyHpcUsage
otherwise ->
                      [XIEThingWith GhcRn
-> LIEWrappedName (IdP GhcRn)
-> IEWildcard
-> [LIEWrappedName (IdP GhcRn)]
-> [Located (FieldLbl (IdP GhcRn))]
-> IE GhcRn
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith XIEThingWith GhcRn
NoExtField
noExtField (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n) IEWildcard
NoIEWildcard
                                ((Name -> GenLocated SrcSpan (IEWrappedName Name))
-> [Name] -> [GenLocated SrcSpan (IEWrappedName Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> GenLocated SrcSpan (IEWrappedName Name)
forall name. HasOccName name => Located name -> LIEWrappedName name
to_ie_post_rn (Located Name -> GenLocated SrcSpan (IEWrappedName Name))
-> (Name -> Located Name)
-> Name
-> GenLocated SrcSpan (IEWrappedName Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) ((Name -> AnyHpcUsage) -> [Name] -> [Name]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (Name -> Name -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Name
n) [Name]
ns))
                                ((FieldLabel -> Located FieldLabel)
-> [FieldLabel] -> [Located FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Located FieldLabel
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [FieldLabel]
fs)]
        where

          fld_lbls :: [FastString]
fld_lbls = (FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel [FieldLabel]
fs

          all_used :: ([Name], [FieldLabel]) -> AnyHpcUsage
all_used ([Name]
avail_occs, [FieldLabel]
avail_flds)
              = (Name -> AnyHpcUsage) -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (Name -> [Name] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Name]
ns) [Name]
avail_occs
                    AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& (FastString -> AnyHpcUsage) -> [FastString] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (FastString -> [FastString] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [FastString]
fld_lbls) ((FieldLabel -> FastString) -> [FieldLabel] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel [FieldLabel]
avail_flds)

          all_non_overloaded :: [FieldLbl a] -> AnyHpcUsage
all_non_overloaded = (FieldLbl a -> AnyHpcUsage) -> [FieldLbl a] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all (AnyHpcUsage -> AnyHpcUsage
not (AnyHpcUsage -> AnyHpcUsage)
-> (FieldLbl a -> AnyHpcUsage) -> FieldLbl a -> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl a -> AnyHpcUsage
forall a. FieldLbl a -> AnyHpcUsage
flIsOverloaded)

printMinimalImports :: [ImportDeclUsage] -> RnM ()
-- See Note [Printing minimal imports]
printMinimalImports :: [ImportDeclUsage] -> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports [ImportDeclUsage]
imports_w_usage
  = do { [LImportDecl GhcRn]
imports' <- [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
getMinimalImports [ImportDeclUsage]
imports_w_usage
       ; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
       ; DynFlags
dflags   <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
         do { Handle
h <- String -> IOMode -> IO Handle
openFile (DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod) IOMode
WriteMode
            ; DynFlags -> Handle -> PrintUnqualified -> MsgDoc -> IO ()
printForUser DynFlags
dflags Handle
h PrintUnqualified
neverQualify ([MsgDoc] -> MsgDoc
vcat ((LImportDecl GhcRn -> MsgDoc) -> [LImportDecl GhcRn] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [LImportDecl GhcRn]
imports')) }
              -- The neverQualify is important.  We are printing Names
              -- but they are in the context of an 'import' decl, and
              -- we never qualify things inside there
              -- E.g.   import Blag( f, b )
              -- not    import Blag( Blag.f, Blag.g )!
       }
  where
    mkFilename :: DynFlags -> Module -> String
mkFilename DynFlags
dflags Module
this_mod
      | Just String
d <- DynFlags -> Maybe String
dumpDir DynFlags
dflags = String
d String -> String -> String
</> String
basefn
      | AnyHpcUsage
otherwise                = String
basefn
      where
        basefn :: String
basefn = ModuleName -> String
moduleNameString (Module -> ModuleName
moduleName Module
this_mod) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".imports"


to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name
to_ie_post_rn_var :: Located name -> LIEWrappedName name
to_ie_post_rn_var (L SrcSpan
l name
n)
  | OccName -> AnyHpcUsage
isDataOcc (OccName -> AnyHpcUsage) -> OccName -> AnyHpcUsage
forall a b. (a -> b) -> a -> b
$ name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEPattern (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
  | AnyHpcUsage
otherwise             = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEName    (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))


to_ie_post_rn :: (HasOccName name) => Located name -> LIEWrappedName name
to_ie_post_rn :: Located name -> LIEWrappedName name
to_ie_post_rn (L SrcSpan
l name
n)
  | OccName -> AnyHpcUsage
isTcOcc OccName
occ AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& OccName -> AnyHpcUsage
isSymOcc OccName
occ = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEType (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
  | AnyHpcUsage
otherwise                   = SrcSpan -> IEWrappedName name -> LIEWrappedName name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Located name -> IEWrappedName name
forall name. Located name -> IEWrappedName name
IEName (SrcSpan -> name -> Located name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l name
n))
  where occ :: OccName
occ = name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n

{-
Note [Partial export]
~~~~~~~~~~~~~~~~~~~~~
Suppose we have

   module A( op ) where
     class C a where
       op :: a -> a

   module B where
   import A
   f = ..op...

Then the minimal import for module B is
   import A( op )
not
   import A( C( op ) )
which we would usually generate if C was exported from B.  Hence
the (x `elem` xs) test when deciding what to generate.


Note [Overloaded field import]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On the other hand, if we have

    {-# LANGUAGE DuplicateRecordFields #-}
    module A where
      data T = MkT { foo :: Int }

    module B where
      import A
      f = ...foo...

then the minimal import for module B must be
    import A ( T(foo) )
because when DuplicateRecordFields is enabled, field selectors are
not in scope without their enclosing datatype.


************************************************************************
*                                                                      *
\subsection{Errors}
*                                                                      *
************************************************************************
-}

qualImportItemErr :: RdrName -> SDoc
qualImportItemErr :: RdrName -> MsgDoc
qualImportItemErr RdrName
rdr
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal qualified name in import item:")
       Int
2 (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr)

badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
  = [MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text String
"Module", MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)), MsgDoc
source_import,
         String -> MsgDoc
text String
"does not export", MsgDoc -> MsgDoc
quotes (IE GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IE GhcPs
ie)]
  where
    source_import :: MsgDoc
source_import | ModIface -> AnyHpcUsage
mi_boot ModIface
iface = String -> MsgDoc
text String
"(hi-boot interface)"
                  | AnyHpcUsage
otherwise     = MsgDoc
Outputable.empty

badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs
                        -> SDoc
badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrDataCon OccName
dataType_occ ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
  = [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"In module"
             MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec))
             MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
source_import MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon
         , Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ MsgDoc -> MsgDoc
quotes MsgDoc
datacon
             MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is a data constructor of"
             MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
dataType
         , String -> MsgDoc
text String
"To import it use"
         , Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"import"
             MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
             MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp (MsgDoc
dataType MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp MsgDoc
datacon)
         , String -> MsgDoc
text String
"or"
         , Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text String
"import"
             MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
decl_spec)
             MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens_sp (MsgDoc
dataType MsgDoc -> MsgDoc -> MsgDoc
<> String -> MsgDoc
text String
"(..)")
         ]
  where
    datacon_occ :: OccName
datacon_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
    datacon :: MsgDoc
datacon = OccName -> MsgDoc -> MsgDoc
parenSymOcc OccName
datacon_occ (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
datacon_occ)
    dataType :: MsgDoc
dataType = OccName -> MsgDoc -> MsgDoc
parenSymOcc OccName
dataType_occ (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
dataType_occ)
    source_import :: MsgDoc
source_import | ModIface -> AnyHpcUsage
mi_boot ModIface
iface = String -> MsgDoc
text String
"(hi-boot interface)"
                  | AnyHpcUsage
otherwise     = MsgDoc
Outputable.empty
    parens_sp :: MsgDoc -> MsgDoc
parens_sp MsgDoc
d = MsgDoc -> MsgDoc
parens (MsgDoc
space MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
d MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
space)  -- T( f,g )

badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> MsgDoc
badImportItemErr ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie [AvailInfo]
avails
  = case (AvailInfo -> AnyHpcUsage) -> [AvailInfo] -> Maybe AvailInfo
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find AvailInfo -> AnyHpcUsage
checkIfDataCon [AvailInfo]
avails of
      Just AvailInfo
con -> OccName -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrDataCon (AvailInfo -> OccName
availOccName AvailInfo
con) ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
      Maybe AvailInfo
Nothing  -> ModIface -> ImpDeclSpec -> IE GhcPs -> MsgDoc
badImportItemErrStd ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie
  where
    checkIfDataCon :: AvailInfo -> AnyHpcUsage
checkIfDataCon (AvailTC Name
_ [Name]
ns [FieldLabel]
_) =
      case (Name -> AnyHpcUsage) -> [Name] -> Maybe Name
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> Maybe a
find (\Name
n -> FastString
importedFS FastString -> FastString -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Name -> FastString
nameOccNameFS Name
n) [Name]
ns of
        Just Name
n  -> Name -> AnyHpcUsage
isDataConName Name
n
        Maybe Name
Nothing -> AnyHpcUsage
False
    checkIfDataCon AvailInfo
_ = AnyHpcUsage
False
    availOccName :: AvailInfo -> OccName
availOccName = Name -> OccName
nameOccName (Name -> OccName) -> (AvailInfo -> Name) -> AvailInfo -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> Name
availName
    nameOccNameFS :: Name -> FastString
nameOccNameFS = OccName -> FastString
occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName
    importedFS :: FastString
importedFS = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> FastString) -> RdrName -> FastString
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie

illegalImportItemErr :: SDoc
illegalImportItemErr :: MsgDoc
illegalImportItemErr = String -> MsgDoc
text String
"Illegal import item"

dodgyImportWarn :: RdrName -> SDoc
dodgyImportWarn :: RdrName -> MsgDoc
dodgyImportWarn RdrName
item
  = MsgDoc -> RdrName -> IE GhcPs -> MsgDoc
forall a b.
(Outputable a, Outputable b) =>
MsgDoc -> a -> b -> MsgDoc
dodgyMsg (String -> MsgDoc
text String
"import") RdrName
item (IdP GhcPs -> IE GhcPs
forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert RdrName
IdP GhcPs
item :: IE GhcPs)

dodgyMsg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgyMsg :: MsgDoc -> a -> b -> MsgDoc
dodgyMsg MsgDoc
kind a
tc b
ie
  = [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
kind MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"item")
                    -- <+> quotes (ppr (IEThingAll (noLoc (IEName $ noLoc tc))))
                     MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (b -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr b
ie)
                MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"suggests that",
          MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
tc) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"has (in-scope) constructors or class methods,",
          String -> MsgDoc
text String
"but it has none" ]

dodgyMsgInsert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert :: IdP (GhcPass p) -> IE (GhcPass p)
dodgyMsgInsert IdP (GhcPass p)
tc = XIEThingAll (GhcPass p)
-> LIEWrappedName (IdP (GhcPass p)) -> IE (GhcPass p)
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll XIEThingAll (GhcPass p)
NoExtField
noExtField LIEWrappedName (IdP (GhcPass p))
ii
  where
    ii :: LIEWrappedName (IdP (GhcPass p))
    ii :: LIEWrappedName (IdP (GhcPass p))
ii = SrcSpanLess (LIEWrappedName (IdP (GhcPass p)))
-> LIEWrappedName (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Located (IdP (GhcPass p)) -> IEWrappedName (IdP (GhcPass p))
forall name. Located name -> IEWrappedName name
IEName (Located (IdP (GhcPass p)) -> IEWrappedName (IdP (GhcPass p)))
-> Located (IdP (GhcPass p)) -> IEWrappedName (IdP (GhcPass p))
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located (IdP (GhcPass p)))
-> Located (IdP (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (IdP (GhcPass p)))
IdP (GhcPass p)
tc)


addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
addDupDeclErr :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDupDeclErr [] = String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. String -> a
panic String
"addDupDeclErr: empty list"
addDupDeclErr gres :: [GlobalRdrElt]
gres@(GlobalRdrElt
gre : [GlobalRdrElt]
_)
  = SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan ([Name] -> Name
forall a. [a] -> a
last [Name]
sorted_names)) (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
    -- Report the error at the later location
    [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"Multiple declarations of" MsgDoc -> MsgDoc -> MsgDoc
<+>
             MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name -> OccName
nameOccName Name
name)),
             -- NB. print the OccName, not the Name, because the
             -- latter might not be in scope in the RdrEnv and so will
             -- be printed qualified.
          String -> MsgDoc
text String
"Declared at:" MsgDoc -> MsgDoc -> MsgDoc
<+>
                   [MsgDoc] -> MsgDoc
vcat ((Name -> MsgDoc) -> [Name] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (SrcLoc -> MsgDoc) -> (Name -> SrcLoc) -> Name -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SrcLoc
nameSrcLoc) [Name]
sorted_names)]
  where
    name :: Name
name = GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre
    sorted_names :: [Name]
sorted_names = (Name -> SrcLoc) -> [Name] -> [Name]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Name -> SrcLoc
nameSrcLoc ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
gres)



missingImportListWarn :: ModuleName -> SDoc
missingImportListWarn :: ModuleName -> MsgDoc
missingImportListWarn ModuleName
mod
  = String -> MsgDoc
text String
"The module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"does not have an explicit import list")

missingImportListItem :: IE GhcPs -> SDoc
missingImportListItem :: IE GhcPs -> MsgDoc
missingImportListItem IE GhcPs
ie
  = String -> MsgDoc
text String
"The import item" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (IE GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IE GhcPs
ie) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"does not have an explicit import list")

moduleWarn :: ModuleName -> WarningTxt -> SDoc
moduleWarn :: ModuleName -> WarningTxt -> MsgDoc
moduleWarn ModuleName
mod (WarningTxt Located SourceText
_ [Located StringLiteral]
txt)
  = [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod) MsgDoc -> MsgDoc -> MsgDoc
<> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
":"),
          Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
vcat ((Located StringLiteral -> MsgDoc)
-> [Located StringLiteral] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
txt)) ]
moduleWarn ModuleName
mod (DeprecatedTxt Located SourceText
_ [Located StringLiteral]
txt)
  = [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
mod)
                                MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"is deprecated:",
          Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
vcat ((Located StringLiteral -> MsgDoc)
-> [Located StringLiteral] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
txt)) ]

packageImportErr :: SDoc
packageImportErr :: MsgDoc
packageImportErr
  = String -> MsgDoc
text String
"Package-qualified imports are not enabled; use PackageImports"

-- This data decl will parse OK
--      data T = a Int
-- treating "a" as the constructor.
-- It is really hard to make the parser spot this malformation.
-- So the renamer has to check that the constructor is legal
--
-- We can get an operator as the constructor, even in the prefix form:
--      data T = :% Int Int
-- from interface files, which always print in prefix form

checkConName :: RdrName -> TcRn ()
checkConName :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkConName RdrName
name = AnyHpcUsage -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr (RdrName -> AnyHpcUsage
isRdrDataCon RdrName
name) (RdrName -> MsgDoc
badDataCon RdrName
name)

badDataCon :: RdrName -> SDoc
badDataCon :: RdrName -> MsgDoc
badDataCon RdrName
name
   = [MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text String
"Illegal data constructor name", MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
name)]