never executed always true always false
    1 {-
    2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    3 
    4 Extracting imported and top-level names in scope
    5 -}
    6 
    7 {-# LANGUAGE NondecreasingIndentation #-}
    8 {-# LANGUAGE FlexibleContexts #-}
    9 {-# LANGUAGE RankNTypes #-}
   10 {-# LANGUAGE ScopedTypeVariables #-}
   11 {-# LANGUAGE TypeFamilies #-}
   12 {-# LANGUAGE LambdaCase #-}
   13 
   14 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
   15 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
   16 
   17 module GHC.Rename.Names (
   18         rnImports, getLocalNonValBinders, newRecordSelector,
   19         extendGlobalRdrEnvRn,
   20         gresFromAvails,
   21         calculateAvails,
   22         reportUnusedNames,
   23         checkConName,
   24         mkChildEnv,
   25         findChildren,
   26         findImportUsage,
   27         getMinimalImports,
   28         printMinimalImports,
   29         renamePkgQual, renameRawPkgQual,
   30         ImportDeclUsage
   31     ) where
   32 
   33 import GHC.Prelude
   34 
   35 import GHC.Driver.Env
   36 import GHC.Driver.Session
   37 import GHC.Driver.Ppr
   38 
   39 import GHC.Rename.Env
   40 import GHC.Rename.Fixity
   41 import GHC.Rename.Utils ( warnUnusedTopBinds, mkFieldEnv )
   42 
   43 import GHC.Tc.Errors.Types
   44 import GHC.Tc.Utils.Env
   45 import GHC.Tc.Utils.Monad
   46 
   47 import GHC.Hs
   48 import GHC.Iface.Load   ( loadSrcInterface )
   49 import GHC.Builtin.Names
   50 import GHC.Parser.PostProcess ( setRdrNameSpace )
   51 import GHC.Core.Type
   52 import GHC.Core.PatSyn
   53 import GHC.Core.TyCo.Ppr
   54 import GHC.Core.TyCon ( TyCon, tyConName, tyConKind )
   55 import qualified GHC.LanguageExtensions as LangExt
   56 
   57 import GHC.Utils.Outputable as Outputable
   58 import GHC.Utils.Misc as Utils
   59 import GHC.Utils.Panic
   60 import GHC.Utils.Trace
   61 
   62 import GHC.Types.Fixity.Env
   63 import GHC.Types.SafeHaskell
   64 import GHC.Types.Name
   65 import GHC.Types.Name.Env
   66 import GHC.Types.Name.Set
   67 import GHC.Types.Name.Reader
   68 import GHC.Types.Avail
   69 import GHC.Types.FieldLabel
   70 import GHC.Types.SourceFile
   71 import GHC.Types.SrcLoc as SrcLoc
   72 import GHC.Types.Basic  ( TopLevelFlag(..) )
   73 import GHC.Types.SourceText
   74 import GHC.Types.Id
   75 import GHC.Types.HpcInfo
   76 import GHC.Types.Unique.FM
   77 import GHC.Types.Error
   78 import GHC.Types.PkgQual
   79 
   80 import GHC.Unit
   81 import GHC.Unit.Module.Warnings
   82 import GHC.Unit.Module.ModIface
   83 import GHC.Unit.Module.Imported
   84 import GHC.Unit.Module.Deps
   85 import GHC.Unit.Env
   86 
   87 import GHC.Data.Maybe
   88 import GHC.Data.FastString
   89 import GHC.Data.FastString.Env
   90 
   91 import Control.Monad
   92 import Data.Either      ( partitionEithers )
   93 import Data.Map         ( Map )
   94 import qualified Data.Map as Map
   95 import Data.Ord         ( comparing )
   96 import Data.List        ( partition, (\\), find, sortBy, groupBy, sortOn )
   97 import Data.Function    ( on )
   98 import qualified Data.Set as S
   99 import System.FilePath  ((</>))
  100 
  101 import System.IO
  102 import GHC.Data.Bag
  103 
  104 {-
  105 ************************************************************************
  106 *                                                                      *
  107 \subsection{rnImports}
  108 *                                                                      *
  109 ************************************************************************
  110 
  111 Note [Tracking Trust Transitively]
  112 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  113 When we import a package as well as checking that the direct imports are safe
  114 according to the rules outlined in the Note [Safe Haskell Trust Check] in GHC.Driver.Main
  115 we must also check that these rules hold transitively for all dependent modules
  116 and packages. Doing this without caching any trust information would be very
  117 slow as we would need to touch all packages and interface files a module depends
  118 on. To avoid this we make use of the property that if a modules Safe Haskell
  119 mode changes, this triggers a recompilation from that module in the dependecy
  120 graph. So we can just worry mostly about direct imports.
  121 
  122 There is one trust property that can change for a package though without
  123 recompilation being triggered: package trust. So we must check that all
  124 packages a module transitively depends on to be trusted are still trusted when
  125 we are compiling this module (as due to recompilation avoidance some modules
  126 below may not be considered trusted any more without recompilation being
  127 triggered).
  128 
  129 We handle this by augmenting the existing transitive list of packages a module M
  130 depends on with a bool for each package that says if it must be trusted when the
  131 module M is being checked for trust. This list of trust required packages for a
  132 single import is gathered in the rnImportDecl function and stored in an
  133 ImportAvails data structure. The union of these trust required packages for all
  134 imports is done by the rnImports function using the combine function which calls
  135 the plusImportAvails function that is a union operation for the ImportAvails
  136 type. This gives us in an ImportAvails structure all packages required to be
  137 trusted for the module we are currently compiling. Checking that these packages
  138 are still trusted (and that direct imports are trusted) is done in
  139 GHC.Driver.Main.checkSafeImports.
  140 
  141 See the note below, [Trust Own Package] for a corner case in this method and
  142 how its handled.
  143 
  144 
  145 Note [Trust Own Package]
  146 ~~~~~~~~~~~~~~~~~~~~~~~~
  147 There is a corner case of package trust checking that the usual transitive check
  148 doesn't cover. (For how the usual check operates see the Note [Tracking Trust
  149 Transitively] below). The case is when you import a -XSafe module M and M
  150 imports a -XTrustworthy module N. If N resides in a different package than M,
  151 then the usual check works as M will record a package dependency on N's package
  152 and mark it as required to be trusted. If N resides in the same package as M
  153 though, then importing M should require its own package be trusted due to N
  154 (since M is -XSafe so doesn't create this requirement by itself). The usual
  155 check fails as a module doesn't record a package dependency of its own package.
  156 So instead we now have a bool field in a modules interface file that simply
  157 states if the module requires its own package to be trusted. This field avoids
  158 us having to load all interface files that the module depends on to see if one
  159 is trustworthy.
  160 
  161 
  162 Note [Trust Transitive Property]
  163 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  164 So there is an interesting design question in regards to transitive trust
  165 checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
  166 of modules and packages, some packages it requires to be trusted as its using
  167 -XTrustworthy modules from them. Now if I have a module A that doesn't use safe
  168 haskell at all and simply imports B, should A inherit all the trust
  169 requirements from B? Should A now also require that a package p is trusted since
  170 B required it?
  171 
  172 We currently say no but saying yes also makes sense. The difference is, if a
  173 module M that doesn't use Safe Haskell imports a module N that does, should all
  174 the trusted package requirements be dropped since M didn't declare that it cares
  175 about Safe Haskell (so -XSafe is more strongly associated with the module doing
  176 the importing) or should it be done still since the author of the module N that
  177 uses Safe Haskell said they cared (so -XSafe is more strongly associated with
  178 the module that was compiled that used it).
  179 
  180 Going with yes is a simpler semantics we think and harder for the user to stuff
  181 up but it does mean that Safe Haskell will affect users who don't care about
  182 Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
  183 network) and that packages imports -XTrustworthy modules from another package
  184 (say bytestring), so requires that package is trusted. The user may now get
  185 compilation errors in code that doesn't do anything with Safe Haskell simply
  186 because they are using the network package. They will have to call 'ghc-pkg
  187 trust network' to get everything working. Due to this invasive nature of going
  188 with yes we have gone with no for now.
  189 -}
  190 
  191 -- | Process Import Decls.  See 'rnImportDecl' for a description of what
  192 -- the return types represent.
  193 -- Note: Do the non SOURCE ones first, so that we get a helpful warning
  194 -- for SOURCE ones that are unnecessary
  195 rnImports :: [(LImportDecl GhcPs, SDoc)]
  196           -> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
  197 rnImports imports = do
  198     tcg_env <- getGblEnv
  199     -- NB: want an identity module here, because it's OK for a signature
  200     -- module to import from its implementor
  201     let this_mod = tcg_mod tcg_env
  202     let (source, ordinary) = partition (is_source_import . fst) imports
  203         is_source_import d = ideclSource (unLoc d) == IsBoot
  204     stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
  205     stuff2 <- mapAndReportM (rnImportDecl this_mod) source
  206     -- Safe Haskell: See Note [Tracking Trust Transitively]
  207     let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
  208     -- Update imp_boot_mods if imp_direct_mods mentions any of them
  209     let merged_import_avail = clobberSourceImports imp_avails
  210     dflags <- getDynFlags
  211     let final_import_avail  =
  212           merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags)
  213                                                         `S.union` imp_dep_direct_pkgs merged_import_avail}
  214     return (decls, rdr_env, final_import_avail, hpc_usage)
  215 
  216   where
  217     clobberSourceImports imp_avails =
  218       imp_avails { imp_boot_mods = imp_boot_mods' }
  219       where
  220         imp_boot_mods' = mergeUFM combJ id (const mempty)
  221                             (imp_boot_mods imp_avails)
  222                             (imp_direct_dep_mods imp_avails)
  223 
  224         combJ (GWIB _ IsBoot) x = Just x
  225         combJ r _               = Just r
  226     -- See Note [Combining ImportAvails]
  227     combine :: [(LImportDecl GhcRn,  GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
  228             -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
  229     combine ss =
  230       let (decls, rdr_env, imp_avails, hpc_usage, finsts) = foldr
  231             plus
  232             ([], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet)
  233             ss
  234       in (decls, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts },
  235             hpc_usage)
  236 
  237     plus (decl,  gbl_env1, imp_avails1, hpc_usage1)
  238          (decls, gbl_env2, imp_avails2, hpc_usage2, finsts_set)
  239       = ( decl:decls,
  240           gbl_env1 `plusGlobalRdrEnv` gbl_env2,
  241           imp_avails1' `plusImportAvails` imp_avails2,
  242           hpc_usage1 || hpc_usage2,
  243           extendModuleSetList finsts_set new_finsts )
  244       where
  245       imp_avails1' = imp_avails1 { imp_finsts = [] }
  246       new_finsts = imp_finsts imp_avails1
  247 
  248 {-
  249 Note [Combining ImportAvails]
  250 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  251 imp_finsts in ImportAvails is a list of family instance modules
  252 transitively depended on by an import. imp_finsts for a currently
  253 compiled module is a union of all the imp_finsts of imports.
  254 Computing the union of two lists of size N is O(N^2) and if we
  255 do it to M imports we end up with O(M*N^2). That can get very
  256 expensive for bigger module hierarchies.
  257 
  258 Union can be optimized to O(N log N) if we use a Set.
  259 imp_finsts is converted back and forth between dep_finsts, so
  260 changing a type of imp_finsts means either paying for the conversions
  261 or changing the type of dep_finsts as well.
  262 
  263 I've measured that the conversions would cost 20% of allocations on my
  264 test case, so that can be ruled out.
  265 
  266 Changing the type of dep_finsts forces checkFamInsts to
  267 get the module lists in non-deterministic order. If we wanted to restore
  268 the deterministic order, we'd have to sort there, which is an additional
  269 cost. As far as I can tell, using a non-deterministic order is fine there,
  270 but that's a brittle nonlocal property which I'd like to avoid.
  271 
  272 Additionally, dep_finsts is read from an interface file, so its "natural"
  273 type is a list. Which makes it a natural type for imp_finsts.
  274 
  275 Since rnImports.combine is really the only place that would benefit from
  276 it being a Set, it makes sense to optimize the hot loop in rnImports.combine
  277 without changing the representation.
  278 
  279 So here's what we do: instead of naively merging ImportAvails with
  280 plusImportAvails in a loop, we make plusImportAvails merge empty imp_finsts
  281 and compute the union on the side using Sets. When we're done, we can
  282 convert it back to a list. One nice side effect of this approach is that
  283 if there's a lot of overlap in the imp_finsts of imports, the
  284 Set doesn't really need to grow and we don't need to allocate.
  285 
  286 Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
  287 23s before, and 11s after.
  288 -}
  289 
  290 
  291 
  292 -- | Given a located import declaration @decl@ from @this_mod@,
  293 -- calculate the following pieces of information:
  294 --
  295 --  1. An updated 'LImportDecl', where all unresolved 'RdrName' in
  296 --     the entity lists have been resolved into 'Name's,
  297 --
  298 --  2. A 'GlobalRdrEnv' representing the new identifiers that were
  299 --     brought into scope (taking into account module qualification
  300 --     and hiding),
  301 --
  302 --  3. 'ImportAvails' summarizing the identifiers that were imported
  303 --     by this declaration, and
  304 --
  305 --  4. A boolean 'AnyHpcUsage' which is true if the imported module
  306 --     used HPC.
  307 rnImportDecl  :: Module -> (LImportDecl GhcPs, SDoc)
  308              -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
  309 rnImportDecl this_mod
  310              (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
  311                                      , ideclPkgQual = raw_pkg_qual
  312                                      , ideclSource = want_boot, ideclSafe = mod_safe
  313                                      , ideclQualified = qual_style, ideclImplicit = implicit
  314                                      , ideclAs = as_mod, ideclHiding = imp_details }), import_reason)
  315   = setSrcSpanA loc $ do
  316 
  317     case raw_pkg_qual of
  318       NoRawPkgQual -> pure ()
  319       RawPkgQual _ -> do
  320         pkg_imports <- xoptM LangExt.PackageImports
  321         when (not pkg_imports) $ addErr packageImportErr
  322 
  323     let qual_only = isImportDeclQualified qual_style
  324 
  325     -- If there's an error in loadInterface, (e.g. interface
  326     -- file not found) we get lots of spurious errors from 'filterImports'
  327     let imp_mod_name = unLoc loc_imp_mod_name
  328         doc = ppr imp_mod_name <+> import_reason
  329 
  330     unit_env <- hsc_unit_env <$> getTopEnv
  331     let pkg_qual = renameRawPkgQual unit_env raw_pkg_qual
  332 
  333     -- Check for self-import, which confuses the typechecker (#9032)
  334     -- ghc --make rejects self-import cycles already, but batch-mode may not
  335     -- at least not until GHC.IfaceToCore.tcHiBootIface, which is too late to avoid
  336     -- typechecker crashes.  (Indirect self imports are not caught until
  337     -- GHC.IfaceToCore, see #10337 tracking how to make this error better.)
  338     --
  339     -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
  340     -- caused bug #10182: in one-shot mode, we should never load an hs-boot
  341     -- file for the module we are compiling into the EPS.  In principle,
  342     -- it should be possible to support this mode of use, but we would have to
  343     -- extend Provenance to support a local definition in a qualified location.
  344     -- For now, we don't support it, but see #10336
  345     when (imp_mod_name == moduleName this_mod &&
  346           (case pkg_qual of -- If we have import "<pkg>" M, then we should
  347                             -- check that "<pkg>" is "this" (which is magic)
  348                             -- or the name of this_mod's package.  Yurgh!
  349                             -- c.f. GHC.findModule, and #9997
  350              NoPkgQual         -> True
  351              ThisPkg _         -> True
  352              OtherPkg _        -> False))
  353          (addErr $ TcRnUnknownMessage $ mkPlainError noHints $
  354            (text "A module cannot import itself:" <+> ppr imp_mod_name))
  355 
  356     -- Check for a missing import list (Opt_WarnMissingImportList also
  357     -- checks for T(..) items but that is done in checkDodgyImport below)
  358     case imp_details of
  359         Just (False, _) -> return () -- Explicit import list
  360         _  | implicit   -> return () -- Do not bleat for implicit imports
  361            | qual_only  -> return ()
  362            | otherwise  -> whenWOptM Opt_WarnMissingImportList $ do
  363                              let msg = TcRnUnknownMessage $
  364                                    mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingImportList)
  365                                                      noHints
  366                                                      (missingImportListWarn imp_mod_name)
  367                              addDiagnostic msg
  368 
  369 
  370     iface <- loadSrcInterface doc imp_mod_name want_boot pkg_qual
  371 
  372     -- Compiler sanity check: if the import didn't say
  373     -- {-# SOURCE #-} we should not get a hi-boot file
  374     warnPprTrace ((want_boot == NotBoot) && (mi_boot iface == IsBoot)) (ppr imp_mod_name) $ do
  375 
  376     -- Issue a user warning for a redundant {- SOURCE -} import
  377     -- NB that we arrange to read all the ordinary imports before
  378     -- any of the {- SOURCE -} imports.
  379     --
  380     -- in --make and GHCi, the compilation manager checks for this,
  381     -- and indeed we shouldn't do it here because the existence of
  382     -- the non-boot module depends on the compilation order, which
  383     -- is not deterministic.  The hs-boot test can show this up.
  384     dflags <- getDynFlags
  385     warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags))
  386            (warnRedundantSourceImport imp_mod_name)
  387     when (mod_safe && not (safeImportsOn dflags)) $
  388         addErr $ TcRnUnknownMessage $ mkPlainError noHints $
  389           (text "safe import can't be used as Safe Haskell isn't on!"
  390                 $+$ text ("please enable Safe Haskell through either Safe, Trustworthy or Unsafe"))
  391 
  392     let
  393         qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
  394         imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
  395                                   is_dloc = locA loc, is_as = qual_mod_name }
  396 
  397     -- filter the imports according to the import declaration
  398     (new_imp_details, gres) <- filterImports iface imp_spec imp_details
  399 
  400     -- for certain error messages, we’d like to know what could be imported
  401     -- here, if everything were imported
  402     potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing
  403 
  404     let gbl_env = mkGlobalRdrEnv gres
  405 
  406         is_hiding | Just (True,_) <- imp_details = True
  407                   | otherwise                    = False
  408 
  409         -- should the import be safe?
  410         mod_safe' = mod_safe
  411                     || (not implicit && safeDirectImpsReq dflags)
  412                     || (implicit && safeImplicitImpsReq dflags)
  413 
  414     hsc_env <- getTopEnv
  415     let home_unit = hsc_home_unit hsc_env
  416         imv = ImportedModsVal
  417             { imv_name        = qual_mod_name
  418             , imv_span        = locA loc
  419             , imv_is_safe     = mod_safe'
  420             , imv_is_hiding   = is_hiding
  421             , imv_all_exports = potential_gres
  422             , imv_qualified   = qual_only
  423             }
  424         imports = calculateAvails home_unit iface mod_safe' want_boot (ImportedByUser imv)
  425 
  426     -- Complain if we import a deprecated module
  427     case mi_warns iface of
  428        WarnAll txt -> do
  429          let msg = TcRnUnknownMessage $
  430                mkPlainDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
  431                                  noHints
  432                                  (moduleWarn imp_mod_name txt)
  433          addDiagnostic msg
  434        _           -> return ()
  435 
  436     -- Complain about -Wcompat-unqualified-imports violations.
  437     warnUnqualifiedImport decl iface
  438 
  439     let new_imp_decl = ImportDecl
  440           { ideclExt       = noExtField
  441           , ideclSourceSrc = ideclSourceSrc decl
  442           , ideclName      = ideclName decl
  443           , ideclPkgQual   = pkg_qual
  444           , ideclSource    = ideclSource decl
  445           , ideclSafe      = mod_safe'
  446           , ideclQualified = ideclQualified decl
  447           , ideclImplicit  = ideclImplicit decl
  448           , ideclAs        = ideclAs decl
  449           , ideclHiding    = new_imp_details
  450           }
  451 
  452     return (L loc new_imp_decl, gbl_env, imports, mi_hpc iface)
  453 
  454 
  455 -- | Rename raw package imports
  456 renameRawPkgQual :: UnitEnv -> RawPkgQual -> PkgQual
  457 renameRawPkgQual unit_env = \case
  458   NoRawPkgQual -> NoPkgQual
  459   RawPkgQual p -> renamePkgQual unit_env (Just (sl_fs p))
  460 
  461 -- | Rename raw package imports
  462 renamePkgQual :: UnitEnv -> Maybe FastString -> PkgQual
  463 renamePkgQual unit_env mb_pkg = case mb_pkg of
  464   Nothing -> NoPkgQual
  465   Just pkg_fs
  466     | Just uid <- homeUnitId <$> ue_home_unit unit_env
  467     , pkg_fs == fsLit "this" || pkg_fs == unitFS uid
  468     -> ThisPkg uid
  469 
  470     | Just uid <- lookupPackageName (ue_units unit_env) (PackageName pkg_fs)
  471     -> OtherPkg uid
  472 
  473     | otherwise
  474     -> OtherPkg (UnitId pkg_fs)
  475        -- not really correct as pkg_fs is unlikely to be a valid unit-id but
  476        -- we will report the failure later...
  477 
  478 -- | Calculate the 'ImportAvails' induced by an import of a particular
  479 -- interface, but without 'imp_mods'.
  480 calculateAvails :: HomeUnit
  481                 -> ModIface
  482                 -> IsSafeImport
  483                 -> IsBootInterface
  484                 -> ImportedBy
  485                 -> ImportAvails
  486 calculateAvails home_unit iface mod_safe' want_boot imported_by =
  487   let imp_mod    = mi_module iface
  488       imp_sem_mod= mi_semantic_module iface
  489       orph_iface = mi_orphan (mi_final_exts iface)
  490       has_finsts = mi_finsts (mi_final_exts iface)
  491       deps       = mi_deps iface
  492       trust      = getSafeMode $ mi_trust iface
  493       trust_pkg  = mi_trust_pkg iface
  494       is_sig     = mi_hsc_src iface == HsigFile
  495 
  496       -- If the module exports anything defined in this module, just
  497       -- ignore it.  Reason: otherwise it looks as if there are two
  498       -- local definition sites for the thing, and an error gets
  499       -- reported.  Easiest thing is just to filter them out up
  500       -- front. This situation only arises if a module imports
  501       -- itself, or another module that imported it.  (Necessarily,
  502       -- this involves a loop.)
  503       --
  504       -- We do this *after* filterImports, so that if you say
  505       --      module A where
  506       --         import B( AType )
  507       --         type AType = ...
  508       --
  509       --      module B( AType ) where
  510       --         import {-# SOURCE #-} A( AType )
  511       --
  512       -- then you won't get a 'B does not export AType' message.
  513 
  514 
  515       -- Compute new transitive dependencies
  516       --
  517       -- 'dep_orphs' and 'dep_finsts' do NOT include the imported module
  518       -- itself, but we DO need to include this module in 'imp_orphs' and
  519       -- 'imp_finsts' if it defines an orphan or instance family; thus the
  520       -- orph_iface/has_iface tests.
  521 
  522       deporphs  = dep_orphs deps
  523       depfinsts = dep_finsts deps
  524 
  525       orphans | orph_iface = assertPpr (not (imp_sem_mod `elem` deporphs)) (ppr imp_sem_mod <+> ppr deporphs) $
  526                              imp_sem_mod : deporphs
  527               | otherwise  = deporphs
  528 
  529       finsts | has_finsts = assertPpr (not (imp_sem_mod `elem` depfinsts)) (ppr imp_sem_mod <+> ppr depfinsts) $
  530                             imp_sem_mod : depfinsts
  531              | otherwise  = depfinsts
  532 
  533       -- Trusted packages are a lot like orphans.
  534       trusted_pkgs | mod_safe' = dep_trusted_pkgs deps
  535                    | otherwise = S.empty
  536 
  537 
  538       pkg = moduleUnit (mi_module iface)
  539       ipkg = toUnitId pkg
  540 
  541       -- Does this import mean we now require our own pkg
  542       -- to be trusted? See Note [Trust Own Package]
  543       ptrust = trust == Sf_Trustworthy || trust_pkg
  544       pkg_trust_req
  545         | isHomeUnit home_unit pkg = ptrust
  546         | otherwise = False
  547 
  548       dependent_pkgs = if isHomeUnit home_unit pkg
  549                         then S.empty
  550                         else S.singleton ipkg
  551 
  552       direct_mods = mkModDeps $ if isHomeUnit home_unit pkg
  553                       then S.singleton (GWIB (moduleName imp_mod) want_boot)
  554                       else S.empty
  555 
  556       dep_boot_mods_map = mkModDeps (dep_boot_mods deps)
  557 
  558       boot_mods
  559         -- If we are looking for a boot module, it must be HPT
  560         | IsBoot <- want_boot = addToUFM dep_boot_mods_map (moduleName imp_mod) (GWIB (moduleName imp_mod) IsBoot)
  561         -- Now we are importing A properly, so don't go looking for
  562         -- A.hs-boot
  563         | isHomeUnit home_unit pkg = dep_boot_mods_map
  564         -- There's no boot files to find in external imports
  565         | otherwise = emptyUFM
  566 
  567       sig_mods =
  568         if is_sig
  569           then moduleName imp_mod : dep_sig_mods deps
  570           else dep_sig_mods deps
  571 
  572 
  573   in ImportAvails {
  574           imp_mods       = unitModuleEnv (mi_module iface) [imported_by],
  575           imp_orphs      = orphans,
  576           imp_finsts     = finsts,
  577           imp_sig_mods   = sig_mods,
  578           imp_direct_dep_mods = direct_mods,
  579           imp_dep_direct_pkgs = dependent_pkgs,
  580           imp_boot_mods = boot_mods,
  581 
  582           -- Add in the imported modules trusted package
  583           -- requirements. ONLY do this though if we import the
  584           -- module as a safe import.
  585           -- See Note [Tracking Trust Transitively]
  586           -- and Note [Trust Transitive Property]
  587           imp_trust_pkgs = trusted_pkgs,
  588           -- Do we require our own pkg to be trusted?
  589           -- See Note [Trust Own Package]
  590           imp_trust_own_pkg = pkg_trust_req
  591      }
  592 
  593 
  594 -- | Issue a warning if the user imports Data.List without either an import
  595 -- list or `qualified`. This is part of the migration plan for the
  596 -- `Data.List.singleton` proposal. See #17244.
  597 --
  598 -- Currently not used for anything.
  599 warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
  600 warnUnqualifiedImport decl iface =
  601     when bad_import $ do
  602       let msg = TcRnUnknownMessage $
  603             mkPlainDiagnostic (WarningWithFlag Opt_WarnCompatUnqualifiedImports)
  604                               noHints
  605                               warning
  606       addDiagnosticAt loc msg
  607   where
  608     mod = mi_module iface
  609     loc = getLocA $ ideclName decl
  610 
  611     is_qual = isImportDeclQualified (ideclQualified decl)
  612     has_import_list =
  613       -- We treat a `hiding` clause as not having an import list although
  614       -- it's not entirely clear this is the right choice.
  615       case ideclHiding decl of
  616         Just (False, _) -> True
  617         _               -> False
  618     bad_import =
  619          not is_qual
  620       && not has_import_list
  621       && mod `elemModuleSet` qualifiedMods
  622 
  623     warning = vcat
  624       [ text "To ensure compatibility with future core libraries changes"
  625       , text "imports to" <+> ppr (ideclName decl) <+> text "should be"
  626       , text "either qualified or have an explicit import list."
  627       ]
  628 
  629     -- Modules for which we warn if we see unqualified imports
  630     -- Currently empty.
  631     qualifiedMods = mkModuleSet []
  632 
  633 
  634 warnRedundantSourceImport :: ModuleName -> TcRnMessage
  635 warnRedundantSourceImport mod_name
  636   = TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $
  637       text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name)
  638 
  639 {-
  640 ************************************************************************
  641 *                                                                      *
  642 \subsection{importsFromLocalDecls}
  643 *                                                                      *
  644 ************************************************************************
  645 
  646 From the top-level declarations of this module produce
  647         * the lexical environment
  648         * the ImportAvails
  649 created by its bindings.
  650 
  651 Note [Top-level Names in Template Haskell decl quotes]
  652 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  653 See also: Note [Interactively-bound Ids in GHCi] in GHC.Driver.Env
  654           Note [Looking up Exact RdrNames] in GHC.Rename.Env
  655 
  656 Consider a Template Haskell declaration quotation like this:
  657       module M where
  658         f x = h [d| f = 3 |]
  659 When renaming the declarations inside [d| ...|], we treat the
  660 top level binders specially in two ways
  661 
  662 1.  We give them an Internal Name, not (as usual) an External one.
  663     This is done by GHC.Rename.Env.newTopSrcBinder.
  664 
  665 2.  We make them *shadow* the outer bindings.
  666     See Note [GlobalRdrEnv shadowing]
  667 
  668 3. We find out whether we are inside a [d| ... |] by testing the TH
  669    stage. This is a slight hack, because the stage field was really
  670    meant for the type checker, and here we are not interested in the
  671    fields of Brack, hence the error thunks in thRnBrack.
  672 -}
  673 
  674 extendGlobalRdrEnvRn :: [AvailInfo]
  675                      -> MiniFixityEnv
  676                      -> RnM (TcGblEnv, TcLclEnv)
  677 -- Updates both the GlobalRdrEnv and the FixityEnv
  678 -- We return a new TcLclEnv only because we might have to
  679 -- delete some bindings from it;
  680 -- see Note [Top-level Names in Template Haskell decl quotes]
  681 
  682 extendGlobalRdrEnvRn avails new_fixities
  683   = do  { (gbl_env, lcl_env) <- getEnvs
  684         ; stage <- getStage
  685         ; isGHCi <- getIsGHCi
  686         ; let rdr_env  = tcg_rdr_env gbl_env
  687               fix_env  = tcg_fix_env gbl_env
  688               th_bndrs = tcl_th_bndrs lcl_env
  689               th_lvl   = thLevel stage
  690 
  691               -- Delete new_occs from global and local envs
  692               -- If we are in a TemplateHaskell decl bracket,
  693               --    we are going to shadow them
  694               -- See Note [GlobalRdrEnv shadowing]
  695               inBracket = isBrackStage stage
  696 
  697               lcl_env_TH = lcl_env { tcl_rdr = minusLocalRdrEnv (tcl_rdr lcl_env) new_occs }
  698                            -- See Note [GlobalRdrEnv shadowing]
  699 
  700               lcl_env2 | inBracket = lcl_env_TH
  701                        | otherwise = lcl_env
  702 
  703               -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
  704               want_shadowing = isGHCi || inBracket
  705               rdr_env1 | want_shadowing = shadowNames rdr_env new_occs
  706                        | otherwise      = rdr_env
  707 
  708               lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
  709                                                        [ ( greNameMangledName n
  710                                                          , (TopLevel, th_lvl) )
  711                                                        | n <- new_names ] }
  712 
  713         ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
  714 
  715         ; let fix_env' = foldl' extend_fix_env fix_env new_gres
  716               gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
  717 
  718         ; traceRn "extendGlobalRdrEnvRn 2" (pprGlobalRdrEnv True rdr_env2)
  719         ; return (gbl_env', lcl_env3) }
  720   where
  721     new_names = concatMap availGreNames avails
  722     new_occs  = occSetToEnv (mkOccSet (map occName new_names))
  723 
  724     -- If there is a fixity decl for the gre, add it to the fixity env
  725     extend_fix_env fix_env gre
  726       | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
  727       = extendNameEnv fix_env name (FixItem occ fi)
  728       | otherwise
  729       = fix_env
  730       where
  731         name = greMangledName gre
  732         occ  = greOccName gre
  733 
  734     new_gres :: [GlobalRdrElt]  -- New LocalDef GREs, derived from avails
  735     new_gres = concatMap localGREsFromAvail avails
  736 
  737     add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
  738     -- Extend the GlobalRdrEnv with a LocalDef GRE
  739     -- If there is already a LocalDef GRE with the same OccName,
  740     --    report an error and discard the new GRE
  741     -- This establishes INVARIANT 1 of GlobalRdrEnvs
  742     add_gre env gre
  743       | not (null dups)    -- Same OccName defined twice
  744       = do { addDupDeclErr (gre : dups); return env }
  745 
  746       | otherwise
  747       = return (extendGlobalRdrEnv env gre)
  748       where
  749         -- See Note [Reporting duplicate local declarations]
  750         dups = filter isDupGRE (lookupGlobalRdrEnv env (greOccName gre))
  751         isDupGRE gre' = isLocalGRE gre' && not (isAllowedDup gre')
  752         isAllowedDup gre' =
  753             case (isRecFldGRE gre, isRecFldGRE gre') of
  754               (True,  True)  -> gre_name gre /= gre_name gre'
  755                                   && isDuplicateRecFldGRE gre'
  756               (True,  False) -> isNoFieldSelectorGRE gre
  757               (False, True)  -> isNoFieldSelectorGRE gre'
  758               (False, False) -> False
  759 
  760 {-
  761 Note [Reporting duplicate local declarations]
  762 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  763 In general, a single module may not define the same OccName multiple times. This
  764 is checked in extendGlobalRdrEnvRn: when adding a new locally-defined GRE to the
  765 GlobalRdrEnv we report an error if there are already duplicates in the
  766 environment.  This establishes INVARIANT 1 (see comments on GlobalRdrEnv in
  767 GHC.Types.Name.Reader), which says that for a given OccName, all the
  768 GlobalRdrElts to which it maps must have distinct 'gre_name's.
  769 
  770 For example, the following will be rejected:
  771 
  772   f x = x
  773   g x = x
  774   f x = x  -- Duplicate!
  775 
  776 Two GREs with the same OccName are OK iff:
  777 -------------------------------------------------------------------
  778   Existing GRE     |          Newly-defined GRE
  779                    |  NormalGre            FieldGre
  780 -------------------------------------------------------------------
  781   Imported         |  Always               Always
  782                    |
  783   Local NormalGre  |  Never                NoFieldSelectors
  784                    |
  785   Local FieldGre   |  NoFieldSelectors     DuplicateRecordFields
  786                    |                       and not in same record
  787 -------------------------------------------------------------------            -
  788 In this table "NoFieldSelectors" means "NoFieldSelectors was enabled at the
  789 definition site of the fields; ditto "DuplicateRecordFields".  These facts are
  790 recorded in the 'FieldLabel' (but where both GREs are local, both will
  791 necessarily have the same extensions enabled).
  792 
  793 More precisely:
  794 
  795 * The programmer is allowed to make a new local definition that clashes with an
  796   imported one (although attempting to refer to either may lead to ambiguity
  797   errors at use sites).  For example, the following definition is allowed:
  798 
  799     import M (f)
  800     f x = x
  801 
  802   Thus isDupGRE reports errors only if the existing GRE is a LocalDef.
  803 
  804 * When DuplicateRecordFields is enabled, the same field label may be defined in
  805   multiple records. For example, this is allowed:
  806 
  807     {-# LANGUAGE DuplicateRecordFields #-}
  808     data S1 = MkS1 { f :: Int }
  809     data S2 = MkS2 { f :: Int }
  810 
  811   Even though both fields have the same OccName, this does not violate INVARIANT
  812   1 of the GlobalRdrEnv, because the fields have distinct selector names, which
  813   form part of the gre_name (see Note [GreNames] in GHC.Types.Name.Reader).
  814 
  815 * However, we must be careful to reject the following (#9156):
  816 
  817     {-# LANGUAGE DuplicateRecordFields #-}
  818     data T = MkT { f :: Int, f :: Int }  -- Duplicate!
  819 
  820   In this case, both 'gre_name's are the same (because the fields belong to the
  821   same type), and adding them both to the environment would be a violation of
  822   INVARIANT 1. Thus isAllowedDup checks both GREs have distinct 'gre_name's
  823   if they are both record fields.
  824 
  825 * With DuplicateRecordFields, we reject attempts to define a field and a
  826   non-field with the same OccName (#17965):
  827 
  828     {-# LANGUAGE DuplicateRecordFields #-}
  829     f x = x
  830     data T = MkT { f :: Int}
  831 
  832   In principle this could be supported, but the current "specification" of
  833   DuplicateRecordFields does not allow it. Thus isAllowedDup checks for
  834   DuplicateRecordFields only if *both* GREs being compared are record fields.
  835 
  836 * However, with NoFieldSelectors, it is possible by design to define a field and
  837   a non-field with the same OccName:
  838 
  839     {-# LANGUAGE NoFieldSelectors #-}
  840     f x = x
  841     data T = MkT { f :: Int}
  842 
  843   Thus isAllowedDup checks for NoFieldSelectors if either the existing or the
  844   new GRE are record fields.  See Note [NoFieldSelectors] in GHC.Rename.Env.
  845 
  846 See also Note [Skipping ambiguity errors at use sites of local declarations] in
  847 GHC.Rename.Utils.
  848 -}
  849 
  850 
  851 {- *********************************************************************
  852 *                                                                      *
  853     getLocalDeclBindersd@ returns the names for an HsDecl
  854              It's used for source code.
  855 
  856         *** See Note [The Naming story] in GHC.Hs.Decls ****
  857 *                                                                      *
  858 ********************************************************************* -}
  859 
  860 getLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs
  861     -> RnM ((TcGblEnv, TcLclEnv), NameSet)
  862 -- Get all the top-level binders bound the group *except*
  863 -- for value bindings, which are treated separately
  864 -- Specifically we return AvailInfo for
  865 --      * type decls (incl constructors and record selectors)
  866 --      * class decls (including class ops)
  867 --      * associated types
  868 --      * foreign imports
  869 --      * value signatures (in hs-boot files only)
  870 
  871 getLocalNonValBinders fixity_env
  872      (HsGroup { hs_valds  = binds,
  873                 hs_tyclds = tycl_decls,
  874                 hs_fords  = foreign_decls })
  875   = do  { -- Process all type/class decls *except* family instances
  876         ; let inst_decls = tycl_decls >>= group_instds
  877         ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags
  878         ; has_sel <- xopt_FieldSelectors <$> getDynFlags
  879         ; (tc_avails, tc_fldss)
  880             <- fmap unzip $ mapM (new_tc dup_fields_ok has_sel)
  881                                  (tyClGroupTyClDecls tycl_decls)
  882         ; traceRn "getLocalNonValBinders 1" (ppr tc_avails)
  883         ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
  884         ; setEnvs envs $ do {
  885             -- Bring these things into scope first
  886             -- See Note [Looking up family names in family instances]
  887 
  888           -- Process all family instances
  889           -- to bring new data constructors into scope
  890         ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc dup_fields_ok has_sel)
  891                                                    inst_decls
  892 
  893           -- Finish off with value binders:
  894           --    foreign decls and pattern synonyms for an ordinary module
  895           --    type sigs in case of a hs-boot file only
  896         ; is_boot <- tcIsHsBootOrSig
  897         ; let val_bndrs | is_boot   = hs_boot_sig_bndrs
  898                         | otherwise = for_hs_bndrs
  899         ; val_avails <- mapM new_simple val_bndrs
  900 
  901         ; let avails    = concat nti_availss ++ val_avails
  902               new_bndrs = availsToNameSetWithSelectors avails `unionNameSet`
  903                           availsToNameSetWithSelectors tc_avails
  904               flds      = concat nti_fldss ++ concat tc_fldss
  905         ; traceRn "getLocalNonValBinders 2" (ppr avails)
  906         ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env
  907 
  908         -- Force the field access so that tcg_env is not retained. The
  909         -- selector thunk optimisation doesn't kick-in, see #20139
  910         ; let !old_field_env = tcg_field_env tcg_env
  911         -- Extend tcg_field_env with new fields (this used to be the
  912         -- work of extendRecordFieldEnv)
  913               field_env = extendNameEnvList old_field_env flds
  914               envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)
  915 
  916         ; traceRn "getLocalNonValBinders 3" (vcat [ppr flds, ppr field_env])
  917         ; return (envs, new_bndrs) } }
  918   where
  919     ValBinds _ _val_binds val_sigs = binds
  920 
  921     for_hs_bndrs :: [LocatedN RdrName]
  922     for_hs_bndrs = hsForeignDeclsBinders foreign_decls
  923 
  924     -- In a hs-boot file, the value binders come from the
  925     --  *signatures*, and there should be no foreign binders
  926     hs_boot_sig_bndrs = [ L (l2l decl_loc) (unLoc n)
  927                         | L decl_loc (TypeSig _ ns _) <- val_sigs, n <- ns]
  928 
  929       -- the SrcSpan attached to the input should be the span of the
  930       -- declaration, not just the name
  931     new_simple :: LocatedN RdrName -> RnM AvailInfo
  932     new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
  933                             ; return (avail nm) }
  934 
  935     new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs
  936            -> RnM (AvailInfo, [(Name, [FieldLabel])])
  937     new_tc dup_fields_ok has_sel tc_decl -- NOT for type/data instances
  938         = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
  939              ; names@(main_name : sub_names) <- mapM (newTopSrcBinder . l2n) bndrs
  940              ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds
  941              ; let fld_env = case unLoc tc_decl of
  942                      DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
  943                      _                            -> []
  944              ; return (availTC main_name names flds', fld_env) }
  945 
  946 
  947     -- Calculate the mapping from constructor names to fields, which
  948     -- will go in tcg_field_env. It's convenient to do this here where
  949     -- we are working with a single datatype definition.
  950     mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
  951                -> [(Name, [FieldLabel])]
  952     mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)
  953       where
  954         find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr
  955                                        , con_args = RecCon cdflds }))
  956             = [( find_con_name rdr
  957                , concatMap find_con_decl_flds (unLoc cdflds) )]
  958         find_con_flds (L _ (ConDeclGADT { con_names = rdrs
  959                                         , con_g_args = RecConGADT flds _ }))
  960             = [ ( find_con_name rdr
  961                  , concatMap find_con_decl_flds (unLoc flds))
  962               | L _ rdr <- rdrs ]
  963 
  964         find_con_flds _ = []
  965 
  966         find_con_name rdr
  967           = expectJust "getLocalNonValBinders/find_con_name" $
  968               find (\ n -> nameOccName n == rdrNameOcc rdr) names
  969         find_con_decl_flds (L _ x)
  970           = map find_con_decl_fld (cd_fld_names x)
  971 
  972         find_con_decl_fld  (L _ (FieldOcc _ (L _ rdr)))
  973           = expectJust "getLocalNonValBinders/find_con_decl_fld" $
  974               find (\ fl -> flLabel fl == lbl) flds
  975           where lbl = occNameFS (rdrNameOcc rdr)
  976 
  977     new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
  978               -> RnM ([AvailInfo], [(Name, [FieldLabel])])
  979     new_assoc _ _ (L _ (TyFamInstD {})) = return ([], [])
  980       -- type instances don't bind new names
  981 
  982     new_assoc dup_fields_ok has_sel (L _ (DataFamInstD _ d))
  983       = do { (avail, flds) <- new_di dup_fields_ok has_sel Nothing d
  984            ; return ([avail], flds) }
  985     new_assoc dup_fields_ok has_sel (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty
  986                                                       , cid_datafam_insts = adts })))
  987       = do -- First, attempt to grab the name of the class from the instance.
  988            -- This step could fail if the instance is not headed by a class,
  989            -- such as in the following examples:
  990            --
  991            -- (1) The class is headed by a bang pattern, such as in
  992            --     `instance !Show Int` (#3811c)
  993            -- (2) The class is headed by a type variable, such as in
  994            --     `instance c` (#16385)
  995            --
  996            -- If looking up the class name fails, then mb_cls_nm will
  997            -- be Nothing.
  998            mb_cls_nm <- runMaybeT $ do
  999              -- See (1) above
 1000              L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty
 1001              -- See (2) above
 1002              MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe cls_rdr
 1003            -- Assuming the previous step succeeded, process any associated data
 1004            -- family instances. If the previous step failed, bail out.
 1005            case mb_cls_nm of
 1006              Nothing -> pure ([], [])
 1007              Just cls_nm -> do
 1008                (avails, fldss)
 1009                  <- mapAndUnzipM (new_loc_di dup_fields_ok has_sel (Just cls_nm)) adts
 1010                pure (avails, concat fldss)
 1011 
 1012     new_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> DataFamInstDecl GhcPs
 1013                    -> RnM (AvailInfo, [(Name, [FieldLabel])])
 1014     new_di dup_fields_ok has_sel mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl })
 1015         = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl)
 1016              ; let (bndrs, flds) = hsDataFamInstBinders dfid
 1017              ; sub_names <- mapM (newTopSrcBinder .l2n) bndrs
 1018              ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds
 1019              ; let avail    = availTC (unLoc main_name) sub_names flds'
 1020                                   -- main_name is not bound here!
 1021                    fld_env  = mk_fld_env (feqn_rhs ti_decl) sub_names flds'
 1022              ; return (avail, fld_env) }
 1023 
 1024     new_loc_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> LDataFamInstDecl GhcPs
 1025                    -> RnM (AvailInfo, [(Name, [FieldLabel])])
 1026     new_loc_di dup_fields_ok has_sel mb_cls (L _ d) = new_di dup_fields_ok has_sel mb_cls d
 1027 
 1028 newRecordSelector :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
 1029 newRecordSelector _ _ [] _ = error "newRecordSelector: datatype has no constructors!"
 1030 newRecordSelector dup_fields_ok has_sel (dc:_) (L loc (FieldOcc _ (L _ fld)))
 1031   = do { selName <- newTopSrcBinder $ L (l2l loc) $ field
 1032        ; return $ FieldLabel { flLabel = fieldLabelString
 1033                              , flHasDuplicateRecordFields = dup_fields_ok
 1034                              , flHasFieldSelector = has_sel
 1035                              , flSelector = selName } }
 1036   where
 1037     fieldLabelString = occNameFS $ rdrNameOcc fld
 1038     selOccName = fieldSelectorOccName fieldLabelString (nameOccName dc) dup_fields_ok has_sel
 1039     field | isExact fld = fld
 1040               -- use an Exact RdrName as is to preserve the bindings
 1041               -- of an already renamer-resolved field and its use
 1042               -- sites. This is needed to correctly support record
 1043               -- selectors in Template Haskell. See Note [Binders in
 1044               -- Template Haskell] in "GHC.ThToHs" and Note [Looking up
 1045               -- Exact RdrNames] in "GHC.Rename.Env".
 1046           | otherwise   = mkRdrUnqual selOccName
 1047 
 1048 {-
 1049 Note [Looking up family names in family instances]
 1050 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1051 Consider
 1052 
 1053   module M where
 1054     type family T a :: *
 1055     type instance M.T Int = Bool
 1056 
 1057 We might think that we can simply use 'lookupOccRn' when processing the type
 1058 instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
 1059 the *same* HsGroup as the type instance declaration.  Hence, as we are
 1060 currently collecting the binders declared in that HsGroup, these binders will
 1061 not have been added to the global environment yet.
 1062 
 1063 Solution is simple: process the type family declarations first, extend
 1064 the environment, and then process the type instances.
 1065 
 1066 
 1067 ************************************************************************
 1068 *                                                                      *
 1069 \subsection{Filtering imports}
 1070 *                                                                      *
 1071 ************************************************************************
 1072 
 1073 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 1074 available, and filters it through the import spec (if any).
 1075 
 1076 Note [Dealing with imports]
 1077 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1078 For import M( ies ), we take the mi_exports of M, and make
 1079    imp_occ_env :: OccEnv (NameEnv (GreName, AvailInfo, Maybe Name))
 1080 One entry for each OccName that M exports, mapping each corresponding Name to
 1081 its GreName, the AvailInfo exported from M that exports that Name, and
 1082 optionally a Name for an associated type's parent class. (Typically there will
 1083 be a single Name in the NameEnv, but see Note [Importing DuplicateRecordFields]
 1084 for why we may need more than one.)
 1085 
 1086 The situation is made more complicated by associated types. E.g.
 1087    module M where
 1088      class    C a    where { data T a }
 1089      instance C Int  where { data T Int = T1 | T2 }
 1090      instance C Bool where { data T Int = T3 }
 1091 Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
 1092   C(C,T), T(T,T1,T2,T3)
 1093 Notice that T appears *twice*, once as a child and once as a parent. From
 1094 this list we construct a raw list including
 1095    T -> (T, T( T1, T2, T3 ), Nothing)
 1096    T -> (T, C( C, T ),       Nothing)
 1097 and we combine these (in function 'combine' in 'imp_occ_env' in
 1098 'filterImports') to get
 1099    T  -> (T,  T(T,T1,T2,T3), Just C)
 1100 
 1101 So the overall imp_occ_env is
 1102    C  -> (C,  C(C,T),        Nothing)
 1103    T  -> (T,  T(T,T1,T2,T3), Just C)
 1104    T1 -> (T1, T(T,T1,T2,T3), Nothing)   -- similarly T2,T3
 1105 
 1106 If we say
 1107    import M( T(T1,T2) )
 1108 then we get *two* Avails:  C(T), T(T1,T2)
 1109 
 1110 Note that the imp_occ_env will have entries for data constructors too,
 1111 although we never look up data constructors.
 1112 
 1113 Note [Importing PatternSynonyms]
 1114 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1115 As described in Note [Dealing with imports], associated types can lead to the
 1116 same Name appearing twice, both as a child and once as a parent, when
 1117 constructing the imp_occ_env.  The same thing can happen with pattern synonyms
 1118 if they are exported bundled with a type.
 1119 
 1120 A simplified example, based on #11959:
 1121 
 1122   {-# LANGUAGE PatternSynonyms #-}
 1123   module M (T(P), pattern P) where  -- Duplicate export warning, but allowed
 1124     data T = MkT
 1125     pattern P = MkT
 1126 
 1127 Here we have T(P) and P in export_avails, and construct both
 1128   P -> (P, P, Nothing)
 1129   P -> (P, T(P), Nothing)
 1130 which are 'combine'd to leave
 1131   P -> (P, T(P), Nothing)
 1132 i.e. we simply discard the non-bundled Avail.
 1133 
 1134 Note [Importing DuplicateRecordFields]
 1135 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1136 In filterImports, another complicating factor is DuplicateRecordFields.
 1137 Suppose we have:
 1138 
 1139   {-# LANGUAGE DuplicateRecordFields #-}
 1140   module M (S(foo), T(foo)) where
 1141     data S = MkS { foo :: Int }
 1142     data T = mkT { foo :: Int }
 1143 
 1144   module N where
 1145     import M (foo)    -- this is an ambiguity error (A)
 1146     import M (S(foo)) -- this is allowed (B)
 1147 
 1148 Here M exports the OccName 'foo' twice, so we get an imp_occ_env where 'foo'
 1149 maps to a NameEnv containing an entry for each of the two mangled field selector
 1150 names (see Note [FieldLabel] in GHC.Types.FieldLabel).
 1151 
 1152   foo -> [ $sel:foo:MkS -> (foo, S(foo), Nothing)
 1153          , $sel:foo:MKT -> (foo, T(foo), Nothing)
 1154          ]
 1155 
 1156 Then when we look up 'foo' in lookup_name for case (A) we get both entries and
 1157 hence report an ambiguity error.  Whereas in case (B) we reach the lookup_ie
 1158 case for IEThingWith, which looks up 'S' and then finds the unique 'foo' amongst
 1159 its children.
 1160 
 1161 See T16745 for a test of this.
 1162 
 1163 -}
 1164 
 1165 filterImports
 1166     :: ModIface
 1167     -> ImpDeclSpec                     -- The span for the entire import decl
 1168     -> Maybe (Bool, LocatedL [LIE GhcPs])    -- Import spec; True => hiding
 1169     -> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), -- Import spec w/ Names
 1170             [GlobalRdrElt])                   -- Same again, but in GRE form
 1171 filterImports iface decl_spec Nothing
 1172   = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
 1173   where
 1174     imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
 1175 
 1176 
 1177 filterImports iface decl_spec (Just (want_hiding, L l import_items))
 1178   = do  -- check for errors, convert RdrNames to Names
 1179         items1 <- mapM lookup_lie import_items
 1180 
 1181         let items2 :: [(LIE GhcRn, AvailInfo)]
 1182             items2 = concat items1
 1183                 -- NB the AvailInfo may have duplicates, and several items
 1184                 --    for the same parent; e.g N(x) and N(y)
 1185 
 1186             names  = availsToNameSetWithSelectors (map snd items2)
 1187             keep n = not (n `elemNameSet` names)
 1188             pruned_avails = filterAvails keep all_avails
 1189             hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
 1190 
 1191             gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails
 1192                  | otherwise   = concatMap (gresFromIE decl_spec) items2
 1193 
 1194         return (Just (want_hiding, L l (map fst items2)), gres)
 1195   where
 1196     all_avails = mi_exports iface
 1197 
 1198         -- See Note [Dealing with imports]
 1199     imp_occ_env :: OccEnv (NameEnv (GreName,    -- the name or field
 1200                            AvailInfo,   -- the export item providing it
 1201                            Maybe Name))   -- the parent of associated types
 1202     imp_occ_env = mkOccEnv_C (plusNameEnv_C combine)
 1203                              [ (occName c, mkNameEnv [(greNameMangledName c, (c, a, Nothing))])
 1204                                      | a <- all_avails
 1205                                      , c <- availGreNames a]
 1206     -- See Note [Dealing with imports]
 1207     -- 'combine' may be called for associated data types which appear
 1208     -- twice in the all_avails. In the example, we combine
 1209     --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)
 1210     -- NB: the AvailTC can have fields as well as data constructors (#12127)
 1211     combine :: (GreName, AvailInfo, Maybe Name)
 1212             -> (GreName, AvailInfo, Maybe Name)
 1213             -> (GreName, AvailInfo, Maybe Name)
 1214     combine (NormalGreName name1, a1@(AvailTC p1 _), mb1)
 1215             (NormalGreName name2, a2@(AvailTC p2 _), mb2)
 1216       = assertPpr (name1 == name2 && isNothing mb1 && isNothing mb2)
 1217                   (ppr name1 <+> ppr name2 <+> ppr mb1 <+> ppr mb2) $
 1218         if p1 == name1 then (NormalGreName name1, a1, Just p2)
 1219                        else (NormalGreName name1, a2, Just p1)
 1220     -- 'combine' may also be called for pattern synonyms which appear both
 1221     -- unassociated and associated (see Note [Importing PatternSynonyms]).
 1222     combine (c1, a1, mb1) (c2, a2, mb2)
 1223       = assertPpr (c1 == c2 && isNothing mb1 && isNothing mb2
 1224                           && (isAvailTC a1 || isAvailTC a2))
 1225                   (ppr c1 <+> ppr c2 <+> ppr a1 <+> ppr a2 <+> ppr mb1 <+> ppr mb2) $
 1226         if isAvailTC a1 then (c1, a1, Nothing)
 1227                         else (c1, a2, Nothing)
 1228 
 1229     isAvailTC AvailTC{} = True
 1230     isAvailTC _ = False
 1231 
 1232     lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
 1233     lookup_name ie rdr
 1234        | isQual rdr              = failLookupWith (QualImportError rdr)
 1235        | Just succ <- mb_success = case nonDetNameEnvElts succ of
 1236                                      -- See Note [Importing DuplicateRecordFields]
 1237                                      [(c,a,x)] -> return (greNameMangledName c, a, x)
 1238                                      xs -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs))
 1239        | otherwise               = failLookupWith (BadImport ie)
 1240       where
 1241         mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
 1242 
 1243     lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]
 1244     lookup_lie (L loc ieRdr)
 1245         = do (stuff, warns) <- setSrcSpanA loc $
 1246                                liftM (fromMaybe ([],[])) $
 1247                                run_lookup (lookup_ie ieRdr)
 1248              mapM_ emit_warning warns
 1249              return [ (L loc ie, avail) | (ie,avail) <- stuff ]
 1250         where
 1251             -- Warn when importing T(..) if T was exported abstractly
 1252             emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
 1253               addTcRnDiagnostic (TcRnDodgyImports n)
 1254             emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
 1255               addTcRnDiagnostic (TcRnMissingImportList ieRdr)
 1256             emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $ do
 1257               let msg = TcRnUnknownMessage $
 1258                     mkPlainDiagnostic (WarningWithFlag Opt_WarnDodgyImports)
 1259                                       noHints
 1260                                       (lookup_err_msg (BadImport ie))
 1261               addDiagnostic msg
 1262 
 1263             run_lookup :: IELookupM a -> TcRn (Maybe a)
 1264             run_lookup m = case m of
 1265               Failed err -> do
 1266                 addErr $ TcRnUnknownMessage $ mkPlainError noHints (lookup_err_msg err)
 1267                 return Nothing
 1268               Succeeded a -> return (Just a)
 1269 
 1270             lookup_err_msg err = case err of
 1271               BadImport ie  -> badImportItemErr iface decl_spec ie all_avails
 1272               IllegalImport -> illegalImportItemErr
 1273               QualImportError rdr -> qualImportItemErr rdr
 1274               AmbiguousImport rdr xs -> ambiguousImportItemErr rdr xs
 1275 
 1276         -- For each import item, we convert its RdrNames to Names,
 1277         -- and at the same time construct an AvailInfo corresponding
 1278         -- to what is actually imported by this item.
 1279         -- Returns Nothing on error.
 1280         -- We return a list here, because in the case of an import
 1281         -- item like C, if we are hiding, then C refers to *both* a
 1282         -- type/class and a data constructor.  Moreover, when we import
 1283         -- data constructors of an associated family, we need separate
 1284         -- AvailInfos for the data constructors and the family (as they have
 1285         -- different parents).  See Note [Dealing with imports]
 1286     lookup_ie :: IE GhcPs
 1287               -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
 1288     lookup_ie ie = handle_bad_import $
 1289       case ie of
 1290         IEVar _ (L l n) -> do
 1291             (name, avail, _) <- lookup_name ie $ ieWrappedName n
 1292             return ([(IEVar noExtField (L l (replaceWrappedName n name)),
 1293                                                   trimAvail avail name)], [])
 1294 
 1295         IEThingAll _ (L l tc) -> do
 1296             (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc
 1297             let warns = case avail of
 1298                           Avail {}                     -- e.g. f(..)
 1299                             -> [DodgyImport $ ieWrappedName tc]
 1300 
 1301                           AvailTC _ subs
 1302                             | null (drop 1 subs) -- e.g. T(..) where T is a synonym
 1303                             -> [DodgyImport $ ieWrappedName tc]
 1304 
 1305                             | not (is_qual decl_spec)  -- e.g. import M( T(..) )
 1306                             -> [MissingImportList]
 1307 
 1308                             | otherwise
 1309                             -> []
 1310 
 1311                 renamed_ie = IEThingAll noAnn (L l (replaceWrappedName tc name))
 1312                 sub_avails = case avail of
 1313                                Avail {}           -> []
 1314                                AvailTC name2 subs -> [(renamed_ie, AvailTC name2 (subs \\ [NormalGreName name]))]
 1315             case mb_parent of
 1316               Nothing     -> return ([(renamed_ie, avail)], warns)
 1317                              -- non-associated ty/cls
 1318               Just parent -> return ((renamed_ie, AvailTC parent [NormalGreName name]) : sub_avails, warns)
 1319                              -- associated type
 1320 
 1321         IEThingAbs _ (L l tc')
 1322             | want_hiding   -- hiding ( C )
 1323                        -- Here the 'C' can be a data constructor
 1324                        --  *or* a type/class, or even both
 1325             -> let tc = ieWrappedName tc'
 1326                    tc_name = lookup_name ie tc
 1327                    dc_name = lookup_name ie (setRdrNameSpace tc srcDataName)
 1328                in
 1329                case catIELookupM [ tc_name, dc_name ] of
 1330                  []    -> failLookupWith (BadImport ie)
 1331                  names -> return ([mkIEThingAbs tc' l name | name <- names], [])
 1332             | otherwise
 1333             -> do nameAvail <- lookup_name ie (ieWrappedName tc')
 1334                   return ([mkIEThingAbs tc' l nameAvail]
 1335                          , [])
 1336 
 1337         IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns -> do
 1338            (name, avail, mb_parent)
 1339                <- lookup_name (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc)
 1340 
 1341            -- Look up the children in the sub-names of the parent
 1342            -- See Note [Importing DuplicateRecordFields]
 1343            let subnames = availSubordinateGreNames avail
 1344            case lookupChildren subnames rdr_ns of
 1345 
 1346              Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs))
 1347                                 -- We are trying to import T( a,b,c,d ), and failed
 1348                                 -- to find 'b' and 'd'.  So we make up an import item
 1349                                 -- to report as failing, namely T( b, d ).
 1350                                 -- c.f. #15412
 1351 
 1352              Succeeded (childnames, childflds) ->
 1353                case mb_parent of
 1354                  -- non-associated ty/cls
 1355                  Nothing
 1356                    -> return ([(IEThingWith childflds (L l name') wc childnames',
 1357                                availTC name (name:map unLoc childnames) (map unLoc childflds))],
 1358                               [])
 1359                    where name' = replaceWrappedName rdr_tc name
 1360                          childnames' = map to_ie_post_rn childnames
 1361                          -- childnames' = postrn_ies childnames
 1362                  -- associated ty
 1363                  Just parent
 1364                    -> return ([(IEThingWith childflds (L l name') wc childnames',
 1365                                 availTC name (map unLoc childnames) (map unLoc childflds)),
 1366                                (IEThingWith childflds (L l name') wc childnames',
 1367                                 availTC parent [name] [])],
 1368                               [])
 1369                    where name' = replaceWrappedName rdr_tc name
 1370                          childnames' = map to_ie_post_rn childnames
 1371 
 1372         _other -> failLookupWith IllegalImport
 1373         -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
 1374         -- all errors.
 1375 
 1376       where
 1377         mkIEThingAbs tc l (n, av, Nothing    )
 1378           = (IEThingAbs noAnn (L l (replaceWrappedName tc n)), trimAvail av n)
 1379         mkIEThingAbs tc l (n, _,  Just parent)
 1380           = (IEThingAbs noAnn (L l (replaceWrappedName tc n))
 1381              , availTC parent [n] [])
 1382 
 1383         handle_bad_import m = catchIELookup m $ \err -> case err of
 1384           BadImport ie | want_hiding -> return ([], [BadImportW ie])
 1385           _                          -> failLookupWith err
 1386 
 1387 type IELookupM = MaybeErr IELookupError
 1388 
 1389 data IELookupWarning
 1390   = BadImportW (IE GhcPs)
 1391   | MissingImportList
 1392   | DodgyImport RdrName
 1393   -- NB. use the RdrName for reporting a "dodgy" import
 1394 
 1395 data IELookupError
 1396   = QualImportError RdrName
 1397   | BadImport (IE GhcPs)
 1398   | IllegalImport
 1399   | AmbiguousImport RdrName [AvailInfo] -- e.g. a duplicated field name as a top-level import
 1400 
 1401 failLookupWith :: IELookupError -> IELookupM a
 1402 failLookupWith err = Failed err
 1403 
 1404 catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
 1405 catchIELookup m h = case m of
 1406   Succeeded r -> return r
 1407   Failed err  -> h err
 1408 
 1409 catIELookupM :: [IELookupM a] -> [a]
 1410 catIELookupM ms = [ a | Succeeded a <- ms ]
 1411 
 1412 {-
 1413 ************************************************************************
 1414 *                                                                      *
 1415 \subsection{Import/Export Utils}
 1416 *                                                                      *
 1417 ************************************************************************
 1418 -}
 1419 
 1420 -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
 1421 gresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]
 1422 gresFromIE decl_spec (L loc ie, avail)
 1423   = gresFromAvail prov_fn avail
 1424   where
 1425     is_explicit = case ie of
 1426                     IEThingAll _ name -> \n -> n == lieWrappedName name
 1427                     _                 -> \_ -> True
 1428     prov_fn name
 1429       = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })
 1430       where
 1431         item_spec = ImpSome { is_explicit = is_explicit name
 1432                             , is_iloc = locA loc }
 1433 
 1434 
 1435 {-
 1436 Note [Children for duplicate record fields]
 1437 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1438 Consider the module
 1439 
 1440     {-# LANGUAGE DuplicateRecordFields #-}
 1441     module M (F(foo, MkFInt, MkFBool)) where
 1442       data family F a
 1443       data instance F Int = MkFInt { foo :: Int }
 1444       data instance F Bool = MkFBool { foo :: Bool }
 1445 
 1446 The `foo` in the export list refers to *both* selectors! For this
 1447 reason, lookupChildren builds an environment that maps the FastString
 1448 to a list of items, rather than a single item.
 1449 -}
 1450 
 1451 mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
 1452 mkChildEnv gres = foldr add emptyNameEnv gres
 1453   where
 1454     add gre env = case gre_par gre of
 1455         ParentIs  p -> extendNameEnv_Acc (:) Utils.singleton env p gre
 1456         NoParent    -> env
 1457 
 1458 findChildren :: NameEnv [a] -> Name -> [a]
 1459 findChildren env n = lookupNameEnv env n `orElse` []
 1460 
 1461 lookupChildren :: [GreName] -> [LIEWrappedName RdrName]
 1462                -> MaybeErr [LIEWrappedName RdrName]   -- The ones for which the lookup failed
 1463                            ([LocatedA Name], [Located FieldLabel])
 1464 -- (lookupChildren all_kids rdr_items) maps each rdr_item to its
 1465 -- corresponding Name all_kids, if the former exists
 1466 -- The matching is done by FastString, not OccName, so that
 1467 --    Cls( meth, AssocTy )
 1468 -- will correctly find AssocTy among the all_kids of Cls, even though
 1469 -- the RdrName for AssocTy may have a (bogus) DataName namespace
 1470 -- (Really the rdr_items should be FastStrings in the first place.)
 1471 lookupChildren all_kids rdr_items
 1472   | null fails
 1473   = Succeeded (fmap concat (partitionEithers oks))
 1474        -- This 'fmap concat' trickily applies concat to the /second/ component
 1475        -- of the pair, whose type is ([LocatedA Name], [[Located FieldLabel]])
 1476   | otherwise
 1477   = Failed fails
 1478   where
 1479     mb_xs = map doOne rdr_items
 1480     fails = [ bad_rdr | Failed bad_rdr <- mb_xs ]
 1481     oks   = [ ok      | Succeeded ok   <- mb_xs ]
 1482     oks :: [Either (LocatedA Name) [Located FieldLabel]]
 1483 
 1484     doOne item@(L l r)
 1485        = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc . ieWrappedName) r of
 1486            Just [NormalGreName n]                             -> Succeeded (Left (L l n))
 1487            Just rs | Just fs <- traverse greNameFieldLabel rs -> Succeeded (Right (map (L (locA l)) fs))
 1488            _                                                  -> Failed    item
 1489 
 1490     -- See Note [Children for duplicate record fields]
 1491     kid_env = extendFsEnvList_C (++) emptyFsEnv
 1492               [(occNameFS (occName x), [x]) | x <- all_kids]
 1493 
 1494 
 1495 
 1496 -------------------------------
 1497 
 1498 {-
 1499 *********************************************************
 1500 *                                                       *
 1501 \subsection{Unused names}
 1502 *                                                       *
 1503 *********************************************************
 1504 -}
 1505 
 1506 reportUnusedNames :: TcGblEnv -> HscSource -> RnM ()
 1507 reportUnusedNames gbl_env hsc_src
 1508   = do  { keep <- readTcRef (tcg_keep gbl_env)
 1509         ; traceRn "RUN" (ppr (tcg_dus gbl_env))
 1510         ; warnUnusedImportDecls gbl_env hsc_src
 1511         ; warnUnusedTopBinds $ unused_locals keep
 1512         ; warnMissingSignatures gbl_env
 1513         ; warnMissingKindSignatures gbl_env }
 1514   where
 1515     used_names :: NameSet -> NameSet
 1516     used_names keep = findUses (tcg_dus gbl_env) emptyNameSet `unionNameSet` keep
 1517     -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
 1518     -- Hence findUses
 1519 
 1520     -- Collect the defined names from the in-scope environment
 1521     defined_names :: [GlobalRdrElt]
 1522     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
 1523 
 1524     kids_env = mkChildEnv defined_names
 1525     -- This is done in mkExports too; duplicated work
 1526 
 1527     gre_is_used :: NameSet -> GlobalRdrElt -> Bool
 1528     gre_is_used used_names gre0
 1529         = name `elemNameSet` used_names
 1530           || any (\ gre -> greMangledName gre `elemNameSet` used_names) (findChildren kids_env name)
 1531                 -- A use of C implies a use of T,
 1532                 -- if C was brought into scope by T(..) or T(C)
 1533       where
 1534         name = greMangledName gre0
 1535 
 1536     -- Filter out the ones that are
 1537     --  (a) defined in this module, and
 1538     --  (b) not defined by a 'deriving' clause
 1539     -- The latter have an Internal Name, so we can filter them out easily
 1540     unused_locals :: NameSet -> [GlobalRdrElt]
 1541     unused_locals keep =
 1542       let -- Note that defined_and_used, defined_but_not_used
 1543           -- are both [GRE]; that's why we need defined_and_used
 1544           -- rather than just used_names
 1545           _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 1546           (_defined_and_used, defined_but_not_used)
 1547               = partition (gre_is_used (used_names keep)) defined_names
 1548 
 1549       in filter is_unused_local defined_but_not_used
 1550     is_unused_local :: GlobalRdrElt -> Bool
 1551     is_unused_local gre = isLocalGRE gre && isExternalName (greMangledName gre)
 1552 
 1553 {- *********************************************************************
 1554 *                                                                      *
 1555               Missing signatures
 1556 *                                                                      *
 1557 ********************************************************************* -}
 1558 
 1559 {-
 1560 Note [Missing signatures]
 1561 ~~~~~~~~~~~~~~~~~~~~~~~~~
 1562 There are four warning flags in play:
 1563 
 1564   * -Wmissing-exported-signatures
 1565     Warn about any exported top-level function/value without a type signature.
 1566     Does not include pattern synonyms.
 1567 
 1568   * -Wmissing-signatures
 1569     Warn about any top-level function/value without a type signature. Does not
 1570     include pattern synonyms. Takes priority over -Wmissing-exported-signatures.
 1571 
 1572   * -Wmissing-exported-pattern-synonym-signatures
 1573     Warn about any exported pattern synonym without a type signature.
 1574 
 1575   * -Wmissing-pattern-synonym-signatures
 1576     Warn about any pattern synonym without a type signature. Takes priority over
 1577     -Wmissing-exported-pattern-synonym-signatures.
 1578 
 1579 -}
 1580 
 1581 -- | Warn the user about top level binders that lack type signatures.
 1582 -- Called /after/ type inference, so that we can report the
 1583 -- inferred type of the function
 1584 warnMissingSignatures :: TcGblEnv -> RnM ()
 1585 warnMissingSignatures gbl_env
 1586   = do { let exports = availsToNameSet (tcg_exports gbl_env)
 1587              sig_ns  = tcg_sigs gbl_env
 1588                -- We use sig_ns to exclude top-level bindings that are generated by GHC
 1589              binds    = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env
 1590              pat_syns = tcg_patsyns gbl_env
 1591 
 1592          -- Warn about missing signatures
 1593          -- Do this only when we have a type to offer
 1594        ; warn_binds             <- woptM Opt_WarnMissingSignatures
 1595        ; warn_exported_binds    <- woptM Opt_WarnMissingExportedSignatures
 1596        ; warn_pat_syns          <- woptM Opt_WarnMissingPatternSynonymSignatures
 1597        ; warn_exported_pat_syns <- woptM Opt_WarnMissingExportedPatternSynonymSignatures
 1598 
 1599          -- See Note [Missing signatures]
 1600        ; let add_sig_warns
 1601                = when (warn_pat_syns || warn_exported_pat_syns)
 1602                       (mapM_ add_pat_syn_warn pat_syns) >>
 1603                  when (warn_binds || warn_exported_binds)
 1604                       (mapM_ add_bind_warn binds)
 1605 
 1606              add_pat_syn_warn p
 1607                = when export_check $
 1608                  add_warn name flag $
 1609                  hang (text "Pattern synonym with no type signature:")
 1610                     2 (text "pattern" <+> pprPrefixName name <+> dcolon <+> pp_ty)
 1611                where
 1612                  name  = patSynName p
 1613                  pp_ty = pprPatSynType p
 1614                  export_check = warn_pat_syns || name `elemNameSet` exports
 1615                  flag | warn_pat_syns
 1616                       = Opt_WarnMissingPatternSynonymSignatures
 1617                       | otherwise
 1618                       = Opt_WarnMissingExportedPatternSynonymSignatures
 1619 
 1620              add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()
 1621              add_bind_warn id
 1622                = do { env <- tcInitTidyEnv     -- Why not use emptyTidyEnv?
 1623                     ; let (_, ty) = tidyOpenType env (idType id)
 1624                           ty_msg  = pprSigmaType ty
 1625 
 1626                     ; when export_check $
 1627                       add_warn name flag $
 1628                       hang (text "Top-level binding with no type signature:")
 1629                          2 (pprPrefixName name <+> dcolon <+> ty_msg) }
 1630                where
 1631                  name = idName id
 1632                  export_check = warn_binds || name `elemNameSet` exports
 1633                  flag | warn_binds
 1634                       = Opt_WarnMissingSignatures
 1635                       | otherwise
 1636                       = Opt_WarnMissingExportedSignatures
 1637 
 1638              add_warn name flag msg
 1639                = when not_ghc_generated $ do
 1640                    let dia = TcRnUnknownMessage $
 1641                          mkPlainDiagnostic (WarningWithFlag flag) noHints msg
 1642                    addDiagnosticAt (getSrcSpan name) dia
 1643                where
 1644                  not_ghc_generated
 1645                    = name `elemNameSet` sig_ns
 1646 
 1647        ; add_sig_warns }
 1648 
 1649 -- | Warn the user about tycons that lack kind signatures.
 1650 -- Called /after/ type (and kind) inference, so that we can report the
 1651 -- inferred kinds.
 1652 warnMissingKindSignatures :: TcGblEnv -> RnM ()
 1653 warnMissingKindSignatures gbl_env
 1654   = do { warn_missing_kind_sigs  <- woptM Opt_WarnMissingKindSignatures
 1655        ; cusks_enabled <- xoptM LangExt.CUSKs
 1656        ; when (warn_missing_kind_sigs) (mapM_ (add_ty_warn cusks_enabled) tcs)
 1657        }
 1658   where
 1659     tcs = tcg_tcs gbl_env
 1660     ksig_ns = tcg_ksigs gbl_env
 1661 
 1662     add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
 1663     add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $ do
 1664         let dia = TcRnUnknownMessage $
 1665               mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingKindSignatures) noHints $
 1666                 hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
 1667         addDiagnosticAt (getSrcSpan name) dia
 1668       where
 1669         msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
 1670             | otherwise     = text "Top-level type constructor with no standalone kind signature:"
 1671         name = tyConName tyCon
 1672         ki = tyConKind tyCon
 1673         ki_msg :: SDoc
 1674         ki_msg = pprKind ki
 1675 
 1676 {-
 1677 *********************************************************
 1678 *                                                       *
 1679 \subsection{Unused imports}
 1680 *                                                       *
 1681 *********************************************************
 1682 
 1683 This code finds which import declarations are unused.  The
 1684 specification and implementation notes are here:
 1685   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/unused-imports
 1686 
 1687 See also Note [Choosing the best import declaration] in GHC.Types.Name.Reader
 1688 -}
 1689 
 1690 type ImportDeclUsage
 1691    = ( LImportDecl GhcRn   -- The import declaration
 1692      , [GlobalRdrElt]      -- What *is* used (normalised)
 1693      , [Name] )            -- What is imported but *not* used
 1694 
 1695 warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
 1696 warnUnusedImportDecls gbl_env hsc_src
 1697   = do { uses <- readMutVar (tcg_used_gres gbl_env)
 1698        ; let user_imports = filterOut
 1699                               (ideclImplicit . unLoc)
 1700                               (tcg_rn_imports gbl_env)
 1701                 -- This whole function deals only with *user* imports
 1702                 -- both for warning about unnecessary ones, and for
 1703                 -- deciding the minimal ones
 1704              rdr_env = tcg_rdr_env gbl_env
 1705              fld_env = mkFieldEnv rdr_env
 1706 
 1707        ; let usage :: [ImportDeclUsage]
 1708              usage = findImportUsage user_imports uses
 1709 
 1710        ; traceRn "warnUnusedImportDecls" $
 1711                        (vcat [ text "Uses:" <+> ppr uses
 1712                              , text "Import usage" <+> ppr usage])
 1713 
 1714        ; whenWOptM Opt_WarnUnusedImports $
 1715          mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage
 1716 
 1717        ; whenGOptM Opt_D_dump_minimal_imports $
 1718          printMinimalImports hsc_src usage }
 1719 
 1720 findImportUsage :: [LImportDecl GhcRn]
 1721                 -> [GlobalRdrElt]
 1722                 -> [ImportDeclUsage]
 1723 
 1724 findImportUsage imports used_gres
 1725   = map unused_decl imports
 1726   where
 1727     import_usage :: ImportMap
 1728     import_usage = mkImportMap used_gres
 1729 
 1730     unused_decl :: LImportDecl GhcRn -> (LImportDecl GhcRn, [GlobalRdrElt], [Name])
 1731     unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
 1732       = (decl, used_gres, nameSetElemsStable unused_imps)
 1733       where
 1734         used_gres = lookupSrcLoc (srcSpanEnd $ locA loc) import_usage
 1735                                -- srcSpanEnd: see Note [The ImportMap]
 1736                     `orElse` []
 1737 
 1738         used_names   = mkNameSet (map      greMangledName        used_gres)
 1739         used_parents = mkNameSet (mapMaybe greParent_maybe used_gres)
 1740 
 1741         unused_imps   -- Not trivial; see eg #7454
 1742           = case imps of
 1743               Just (False, L _ imp_ies) ->
 1744                                  foldr (add_unused . unLoc) emptyNameSet imp_ies
 1745               _other -> emptyNameSet -- No explicit import list => no unused-name list
 1746 
 1747         add_unused :: IE GhcRn -> NameSet -> NameSet
 1748         add_unused (IEVar _ n)      acc = add_unused_name (lieWrappedName n) acc
 1749         add_unused (IEThingAbs _ n) acc = add_unused_name (lieWrappedName n) acc
 1750         add_unused (IEThingAll _ n) acc = add_unused_all  (lieWrappedName n) acc
 1751         add_unused (IEThingWith fs p wc ns) acc =
 1752           add_wc_all (add_unused_with pn xs acc)
 1753           where pn = lieWrappedName p
 1754                 xs = map lieWrappedName ns ++ map (flSelector . unLoc) fs
 1755                 add_wc_all = case wc of
 1756                             NoIEWildcard -> id
 1757                             IEWildcard _ -> add_unused_all pn
 1758         add_unused _ acc = acc
 1759 
 1760         add_unused_name n acc
 1761           | n `elemNameSet` used_names = acc
 1762           | otherwise                  = acc `extendNameSet` n
 1763         add_unused_all n acc
 1764           | n `elemNameSet` used_names   = acc
 1765           | n `elemNameSet` used_parents = acc
 1766           | otherwise                    = acc `extendNameSet` n
 1767         add_unused_with p ns acc
 1768           | all (`elemNameSet` acc1) ns = add_unused_name p acc1
 1769           | otherwise = acc1
 1770           where
 1771             acc1 = foldr add_unused_name acc ns
 1772        -- If you use 'signum' from Num, then the user may well have
 1773        -- imported Num(signum).  We don't want to complain that
 1774        -- Num is not itself mentioned.  Hence the two cases in add_unused_with.
 1775 
 1776 
 1777 {- Note [The ImportMap]
 1778 ~~~~~~~~~~~~~~~~~~~~~~~
 1779 The ImportMap is a short-lived intermediate data structure records, for
 1780 each import declaration, what stuff brought into scope by that
 1781 declaration is actually used in the module.
 1782 
 1783 The SrcLoc is the location of the END of a particular 'import'
 1784 declaration.  Why *END*?  Because we don't want to get confused
 1785 by the implicit Prelude import. Consider (#7476) the module
 1786     import Foo( foo )
 1787     main = print foo
 1788 There is an implicit 'import Prelude(print)', and it gets a SrcSpan
 1789 of line 1:1 (just the point, not a span). If we use the *START* of
 1790 the SrcSpan to identify the import decl, we'll confuse the implicit
 1791 import Prelude with the explicit 'import Foo'.  So we use the END.
 1792 It's just a cheap hack; we could equally well use the Span too.
 1793 
 1794 The [GlobalRdrElt] are the things imported from that decl.
 1795 -}
 1796 
 1797 type ImportMap = Map RealSrcLoc [GlobalRdrElt]  -- See [The ImportMap]
 1798      -- If loc :-> gres, then
 1799      --   'loc' = the end loc of the bestImport of each GRE in 'gres'
 1800 
 1801 mkImportMap :: [GlobalRdrElt] -> ImportMap
 1802 -- For each of a list of used GREs, find all the import decls that brought
 1803 -- it into scope; choose one of them (bestImport), and record
 1804 -- the RdrName in that import decl's entry in the ImportMap
 1805 mkImportMap gres
 1806   = foldr add_one Map.empty gres
 1807   where
 1808     add_one gre@(GRE { gre_imp = imp_specs }) imp_map =
 1809       case srcSpanEnd (is_dloc (is_decl best_imp_spec)) of
 1810                               -- For srcSpanEnd see Note [The ImportMap]
 1811        RealSrcLoc decl_loc _ -> Map.insertWith add decl_loc [gre] imp_map
 1812        UnhelpfulLoc _ -> imp_map
 1813        where
 1814           best_imp_spec = bestImport (bagToList imp_specs)
 1815           add _ gres = gre : gres
 1816 
 1817 warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Parent)
 1818                  -> ImportDeclUsage -> RnM ()
 1819 warnUnusedImport flag fld_env (L loc decl, used, unused)
 1820 
 1821   -- Do not warn for 'import M()'
 1822   | Just (False,L _ []) <- ideclHiding decl
 1823   = return ()
 1824 
 1825   -- Note [Do not warn about Prelude hiding]
 1826   | Just (True, L _ hides) <- ideclHiding decl
 1827   , not (null hides)
 1828   , pRELUDE_NAME == unLoc (ideclName decl)
 1829   = return ()
 1830 
 1831   -- Nothing used; drop entire declaration
 1832   | null used
 1833   = let dia = TcRnUnknownMessage $
 1834           mkPlainDiagnostic (WarningWithFlag flag) noHints msg1
 1835     in addDiagnosticAt (locA loc) dia
 1836 
 1837   -- Everything imported is used; nop
 1838   | null unused
 1839   = return ()
 1840 
 1841   -- Only one import is unused, with `SrcSpan` covering only the unused item instead of
 1842   -- the whole import statement
 1843   | Just (_, L _ imports) <- ideclHiding decl
 1844   , length unused == 1
 1845   , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports
 1846   = let dia = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2
 1847     in addDiagnosticAt (locA loc) dia
 1848 
 1849   -- Some imports are unused
 1850   | otherwise
 1851   = let dia = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2
 1852     in addDiagnosticAt (locA loc) dia
 1853 
 1854   where
 1855     msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant
 1856                 , nest 2 (text "except perhaps to import instances from"
 1857                                    <+> quotes pp_mod)
 1858                 , text "To import instances alone, use:"
 1859                                    <+> text "import" <+> pp_mod <> parens Outputable.empty ]
 1860     msg2 = sep [ pp_herald <+> quotes sort_unused
 1861                , text "from module" <+> quotes pp_mod <+> is_redundant]
 1862     pp_herald  = text "The" <+> pp_qual <+> text "import of"
 1863     pp_qual
 1864       | isImportDeclQualified (ideclQualified decl)= text "qualified"
 1865       | otherwise                                  = Outputable.empty
 1866     pp_mod       = ppr (unLoc (ideclName decl))
 1867     is_redundant = text "is redundant"
 1868 
 1869     -- In warning message, pretty-print identifiers unqualified unconditionally
 1870     -- to improve the consistent for ambiguous/unambiguous identifiers.
 1871     -- See trac#14881.
 1872     ppr_possible_field n = case lookupNameEnv fld_env n of
 1873                                Just (fld, ParentIs p) -> pprNameUnqualified p <> parens (ppr fld)
 1874                                Just (fld, NoParent)   -> ppr fld
 1875                                Nothing                -> pprNameUnqualified n
 1876 
 1877     -- Print unused names in a deterministic (lexicographic) order
 1878     sort_unused :: SDoc
 1879     sort_unused = pprWithCommas ppr_possible_field $
 1880                   sortBy (comparing nameOccName) unused
 1881 
 1882 {-
 1883 Note [Do not warn about Prelude hiding]
 1884 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1885 We do not warn about
 1886    import Prelude hiding( x, y )
 1887 because even if nothing else from Prelude is used, it may be essential to hide
 1888 x,y to avoid name-shadowing warnings.  Example (#9061)
 1889    import Prelude hiding( log )
 1890    f x = log where log = ()
 1891 
 1892 
 1893 
 1894 Note [Printing minimal imports]
 1895 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1896 To print the minimal imports we walk over the user-supplied import
 1897 decls, and simply trim their import lists.  NB that
 1898 
 1899   * We do *not* change the 'qualified' or 'as' parts!
 1900 
 1901   * We do not discard a decl altogether; we might need instances
 1902     from it.  Instead we just trim to an empty import list
 1903 -}
 1904 
 1905 getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
 1906 getMinimalImports = fmap combine . mapM mk_minimal
 1907   where
 1908     mk_minimal (L l decl, used_gres, unused)
 1909       | null unused
 1910       , Just (False, _) <- ideclHiding decl
 1911       = return (L l decl)
 1912       | otherwise
 1913       = do { let ImportDecl { ideclName    = L _ mod_name
 1914                             , ideclSource  = is_boot
 1915                             , ideclPkgQual = pkg_qual } = decl
 1916            ; iface <- loadSrcInterface doc mod_name is_boot pkg_qual
 1917            ; let used_avails = gresToAvailInfo used_gres
 1918                  lies = map (L l) (concatMap (to_ie iface) used_avails)
 1919            ; return (L l (decl { ideclHiding = Just (False, L (l2l l) lies) })) }
 1920       where
 1921         doc = text "Compute minimal imports for" <+> ppr decl
 1922 
 1923     to_ie :: ModIface -> AvailInfo -> [IE GhcRn]
 1924     -- The main trick here is that if we're importing all the constructors
 1925     -- we want to say "T(..)", but if we're importing only a subset we want
 1926     -- to say "T(A,B,C)".  So we have to find out what the module exports.
 1927     to_ie _ (Avail c)  -- Note [Overloaded field import]
 1928        = [IEVar noExtField (to_ie_post_rn $ noLocA (greNamePrintableName c))]
 1929     to_ie _ avail@(AvailTC n [_])  -- Exporting the main decl and nothing else
 1930        | availExportsDecl avail = [IEThingAbs noAnn (to_ie_post_rn $ noLocA n)]
 1931     to_ie iface (AvailTC n cs)
 1932       = case [xs | avail@(AvailTC x xs) <- mi_exports iface
 1933                  , x == n
 1934                  , availExportsDecl avail  -- Note [Partial export]
 1935                  ] of
 1936            [xs] | all_used xs ->
 1937                    [IEThingAll noAnn (to_ie_post_rn $ noLocA n)]
 1938                 | otherwise   ->
 1939                    [IEThingWith (map noLoc fs) (to_ie_post_rn $ noLocA n) NoIEWildcard
 1940                                 (map (to_ie_post_rn . noLocA) (filter (/= n) ns))]
 1941                                           -- Note [Overloaded field import]
 1942            _other | all_non_overloaded fs
 1943                            -> map (IEVar noExtField . to_ie_post_rn_var . noLocA) $ ns
 1944                                  ++ map flSelector fs
 1945                   | otherwise ->
 1946                       [IEThingWith (map noLoc fs) (to_ie_post_rn $ noLocA n) NoIEWildcard
 1947                                 (map (to_ie_post_rn . noLocA) (filter (/= n) ns))]
 1948         where
 1949           (ns, fs) = partitionGreNames cs
 1950 
 1951           all_used avail_cs = all (`elem` cs) avail_cs
 1952 
 1953           all_non_overloaded = all (not . flIsOverloaded)
 1954 
 1955     combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
 1956     combine = map merge . groupBy ((==) `on` getKey) . sortOn getKey
 1957 
 1958     getKey :: LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName)
 1959     getKey decl =
 1960       ( isImportDeclQualified . ideclQualified $ idecl -- is this qualified? (important that this be first)
 1961       , unLoc <$> ideclAs idecl -- what is the qualifier (inside Maybe monad)
 1962       , unLoc . ideclName $ idecl -- Module Name
 1963       )
 1964       where
 1965         idecl :: ImportDecl GhcRn
 1966         idecl = unLoc decl
 1967 
 1968     merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn
 1969     merge []                     = error "getMinimalImports: unexpected empty list"
 1970     merge decls@((L l decl) : _) = L l (decl { ideclHiding = Just (False, L (noAnnSrcSpan (locA l)) lies) })
 1971       where lies = concatMap (unLoc . snd) $ mapMaybe (ideclHiding . unLoc) decls
 1972 
 1973 
 1974 printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
 1975 -- See Note [Printing minimal imports]
 1976 printMinimalImports hsc_src imports_w_usage
 1977   = do { imports' <- getMinimalImports imports_w_usage
 1978        ; this_mod <- getModule
 1979        ; dflags   <- getDynFlags
 1980        ; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
 1981           printForUser dflags h neverQualify AllTheWay (vcat (map ppr imports'))
 1982               -- The neverQualify is important.  We are printing Names
 1983               -- but they are in the context of an 'import' decl, and
 1984               -- we never qualify things inside there
 1985               -- E.g.   import Blag( f, b )
 1986               -- not    import Blag( Blag.f, Blag.g )!
 1987        }
 1988   where
 1989     mkFilename dflags this_mod
 1990       | Just d <- dumpDir dflags = d </> basefn
 1991       | otherwise                = basefn
 1992       where
 1993         suffix = case hsc_src of
 1994                      HsBootFile -> ".imports-boot"
 1995                      HsSrcFile  -> ".imports"
 1996                      HsigFile   -> ".imports"
 1997         basefn = moduleNameString (moduleName this_mod) ++ suffix
 1998 
 1999 
 2000 to_ie_post_rn_var :: (HasOccName name) => LocatedA name -> LIEWrappedName name
 2001 to_ie_post_rn_var (L l n)
 2002   | isDataOcc $ occName n = L l (IEPattern (EpaSpan $ la2r l) (L (la2na l) n))
 2003   | otherwise             = L l (IEName                       (L (la2na l) n))
 2004 
 2005 
 2006 to_ie_post_rn :: (HasOccName name) => LocatedA name -> LIEWrappedName name
 2007 to_ie_post_rn (L l n)
 2008   | isTcOcc occ && isSymOcc occ = L l (IEType (EpaSpan $ la2r l) (L (la2na l) n))
 2009   | otherwise                   = L l (IEName                    (L (la2na l) n))
 2010   where occ = occName n
 2011 
 2012 {-
 2013 Note [Partial export]
 2014 ~~~~~~~~~~~~~~~~~~~~~
 2015 Suppose we have
 2016 
 2017    module A( op ) where
 2018      class C a where
 2019        op :: a -> a
 2020 
 2021    module B where
 2022    import A
 2023    f = ..op...
 2024 
 2025 Then the minimal import for module B is
 2026    import A( op )
 2027 not
 2028    import A( C( op ) )
 2029 which we would usually generate if C was exported from B.  Hence
 2030 the availExportsDecl test when deciding what to generate.
 2031 
 2032 
 2033 Note [Overloaded field import]
 2034 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 2035 On the other hand, if we have
 2036 
 2037     {-# LANGUAGE DuplicateRecordFields #-}
 2038     module A where
 2039       data T = MkT { foo :: Int }
 2040 
 2041     module B where
 2042       import A
 2043       f = ...foo...
 2044 
 2045 then the minimal import for module B must be
 2046     import A ( T(foo) )
 2047 because when DuplicateRecordFields is enabled, field selectors are
 2048 not in scope without their enclosing datatype.
 2049 
 2050 On the third hand, if we have
 2051 
 2052     {-# LANGUAGE DuplicateRecordFields #-}
 2053     module A where
 2054       pattern MkT { foo } = Just foo
 2055 
 2056     module B where
 2057       import A
 2058       f = ...foo...
 2059 
 2060 then the minimal import for module B must be
 2061     import A ( foo )
 2062 because foo doesn't have a parent.  This might actually be ambiguous if A
 2063 exports another field called foo, but there is no good answer to return and this
 2064 is a very obscure corner, so it seems to be the best we can do.  See
 2065 DRFPatSynExport for a test of this.
 2066 
 2067 
 2068 ************************************************************************
 2069 *                                                                      *
 2070 \subsection{Errors}
 2071 *                                                                      *
 2072 ************************************************************************
 2073 -}
 2074 
 2075 qualImportItemErr :: RdrName -> SDoc
 2076 qualImportItemErr rdr
 2077   = hang (text "Illegal qualified name in import item:")
 2078        2 (ppr rdr)
 2079 
 2080 ambiguousImportItemErr :: RdrName -> [AvailInfo] -> SDoc
 2081 ambiguousImportItemErr rdr avails
 2082   = hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:")
 2083        2 (vcat (map ppr_avail avails))
 2084   where
 2085     ppr_avail (AvailTC parent _) = ppr parent <> parens (ppr rdr)
 2086     ppr_avail (Avail name)       = ppr name
 2087 
 2088 pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
 2089 pprImpDeclSpec iface decl_spec =
 2090   quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of
 2091     IsBoot -> text "(hi-boot interface)"
 2092     NotBoot -> Outputable.empty
 2093 
 2094 badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc
 2095 badImportItemErrStd iface decl_spec ie
 2096   = sep [text "Module", pprImpDeclSpec iface decl_spec,
 2097          text "does not export", quotes (ppr ie)]
 2098 
 2099 badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs
 2100                         -> SDoc
 2101 badImportItemErrDataCon dataType_occ iface decl_spec ie
 2102   = vcat [ text "In module"
 2103              <+> pprImpDeclSpec iface decl_spec
 2104              <> colon
 2105          , nest 2 $ quotes datacon
 2106              <+> text "is a data constructor of"
 2107              <+> quotes dataType
 2108          , text "To import it use"
 2109          , nest 2 $ text "import"
 2110              <+> ppr (is_mod decl_spec)
 2111              <> parens_sp (dataType <> parens_sp datacon)
 2112          , text "or"
 2113          , nest 2 $ text "import"
 2114              <+> ppr (is_mod decl_spec)
 2115              <> parens_sp (dataType <> text "(..)")
 2116          ]
 2117   where
 2118     datacon_occ = rdrNameOcc $ ieName ie
 2119     datacon = parenSymOcc datacon_occ (ppr datacon_occ)
 2120     dataType = parenSymOcc dataType_occ (ppr dataType_occ)
 2121     parens_sp d = parens (space <> d <> space)  -- T( f,g )
 2122 
 2123 badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc
 2124 badImportItemErr iface decl_spec ie avails
 2125   = case find checkIfDataCon avails of
 2126       Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
 2127       Nothing  -> badImportItemErrStd iface decl_spec ie
 2128   where
 2129     checkIfDataCon (AvailTC _ ns) =
 2130       case find (\n -> importedFS == occNameFS (occName n)) ns of
 2131         Just n  -> isDataConName (greNameMangledName n)
 2132         Nothing -> False
 2133     checkIfDataCon _ = False
 2134     availOccName = occName . availGreName
 2135     importedFS = occNameFS . rdrNameOcc $ ieName ie
 2136 
 2137 illegalImportItemErr :: SDoc
 2138 illegalImportItemErr = text "Illegal import item"
 2139 
 2140 addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
 2141 addDupDeclErr [] = panic "addDupDeclErr: empty list"
 2142 addDupDeclErr gres@(gre : _)
 2143   = addErrAt (getSrcSpan (last sorted_names)) $ TcRnUnknownMessage $ mkPlainError noHints $
 2144     -- Report the error at the later location
 2145     vcat [text "Multiple declarations of" <+>
 2146              quotes (ppr (greOccName gre)),
 2147              -- NB. print the OccName, not the Name, because the
 2148              -- latter might not be in scope in the RdrEnv and so will
 2149              -- be printed qualified.
 2150           text "Declared at:" <+>
 2151                    vcat (map (ppr . nameSrcLoc) sorted_names)]
 2152   where
 2153     sorted_names =
 2154       sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan)
 2155              (map greMangledName gres)
 2156 
 2157 
 2158 
 2159 missingImportListWarn :: ModuleName -> SDoc
 2160 missingImportListWarn mod
 2161   = text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list"
 2162 
 2163 moduleWarn :: ModuleName -> WarningTxt -> SDoc
 2164 moduleWarn mod (WarningTxt _ txt)
 2165   = sep [ text "Module" <+> quotes (ppr mod) <> colon,
 2166           nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
 2167 moduleWarn mod (DeprecatedTxt _ txt)
 2168   = sep [ text "Module" <+> quotes (ppr mod)
 2169                                 <+> text "is deprecated:",
 2170           nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
 2171 
 2172 packageImportErr :: TcRnMessage
 2173 packageImportErr
 2174   = TcRnUnknownMessage $ mkPlainError noHints $
 2175   text "Package-qualified imports are not enabled; use PackageImports"
 2176 
 2177 -- This data decl will parse OK
 2178 --      data T = a Int
 2179 -- treating "a" as the constructor.
 2180 -- It is really hard to make the parser spot this malformation.
 2181 -- So the renamer has to check that the constructor is legal
 2182 --
 2183 -- We can get an operator as the constructor, even in the prefix form:
 2184 --      data T = :% Int Int
 2185 -- from interface files, which always print in prefix form
 2186 
 2187 checkConName :: RdrName -> TcRn ()
 2188 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 2189 
 2190 badDataCon :: RdrName -> TcRnMessage
 2191 badDataCon name
 2192    = TcRnUnknownMessage $ mkPlainError noHints $
 2193    hsep [text "Illegal data constructor name", quotes (ppr name)]