never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 
    5 -}
    6 
    7 {-# LANGUAGE BangPatterns, NondecreasingIndentation #-}
    8 {-# LANGUAGE TypeFamilies #-}
    9 {-# LANGUAGE LambdaCase #-}
   10 {-# LANGUAGE FlexibleContexts #-}
   11 
   12 {-# OPTIONS_GHC -fno-warn-orphans #-}
   13 {-# LANGUAGE ViewPatterns #-}
   14 
   15 -- | Loading interface files
   16 module GHC.Iface.Load (
   17         -- Importing one thing
   18         tcLookupImported_maybe, importDecl,
   19         checkWiredInTyCon, ifCheckWiredInThing,
   20 
   21         -- RnM/TcM functions
   22         loadModuleInterface, loadModuleInterfaces,
   23         loadSrcInterface, loadSrcInterface_maybe,
   24         loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule,
   25 
   26         -- IfM functions
   27         loadInterface,
   28         loadSysInterface, loadUserInterface, loadPluginInterface,
   29         findAndReadIface, readIface, writeIface,
   30         moduleFreeHolesPrecise,
   31         needWiredInHomeIface, loadWiredInHomeIface,
   32 
   33         pprModIfaceSimple,
   34         ifaceStats, pprModIface, showIface,
   35 
   36         module Iface_Errors -- avoids boot files in Ppr modules
   37    ) where
   38 
   39 import GHC.Prelude
   40 
   41 import GHC.Platform.Profile
   42 
   43 import {-# SOURCE #-} GHC.IfaceToCore
   44    ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
   45    , tcIfaceAnnotations, tcIfaceCompleteMatches )
   46 
   47 import GHC.Driver.Config.Finder
   48 import GHC.Driver.Env
   49 import GHC.Driver.Errors.Types
   50 import GHC.Driver.Session
   51 import GHC.Driver.Hooks
   52 import GHC.Driver.Plugins
   53 
   54 import GHC.Iface.Syntax
   55 import GHC.Iface.Ext.Fields
   56 import GHC.Iface.Binary
   57 import GHC.Iface.Rename
   58 import GHC.Iface.Env
   59 import GHC.Iface.Errors as Iface_Errors
   60 
   61 import GHC.Tc.Errors.Types
   62 import GHC.Tc.Utils.Monad
   63 
   64 import GHC.Utils.Binary   ( BinData(..) )
   65 import GHC.Utils.Error
   66 import GHC.Utils.Outputable as Outputable
   67 import GHC.Utils.Panic
   68 import GHC.Utils.Panic.Plain
   69 import GHC.Utils.Constants (debugIsOn)
   70 import GHC.Utils.Logger
   71 import GHC.Utils.Trace
   72 
   73 import GHC.Settings.Constants
   74 
   75 import GHC.Builtin.Names
   76 import GHC.Builtin.Utils
   77 import GHC.Builtin.PrimOps    ( allThePrimOps, primOpFixity, primOpOcc )
   78 
   79 import GHC.Core.Rules
   80 import GHC.Core.TyCon
   81 import GHC.Core.InstEnv
   82 import GHC.Core.FamInstEnv
   83 
   84 import GHC.Types.Id.Make      ( seqId )
   85 import GHC.Types.Annotations
   86 import GHC.Types.Name
   87 import GHC.Types.Name.Cache
   88 import GHC.Types.Name.Env
   89 import GHC.Types.Avail
   90 import GHC.Types.Fixity
   91 import GHC.Types.Fixity.Env
   92 import GHC.Types.SourceError
   93 import GHC.Types.SourceText
   94 import GHC.Types.SourceFile
   95 import GHC.Types.SafeHaskell
   96 import GHC.Types.TypeEnv
   97 import GHC.Types.Unique.FM
   98 import GHC.Types.Unique.DSet
   99 import GHC.Types.SrcLoc
  100 import GHC.Types.TyThing
  101 import GHC.Types.PkgQual
  102 
  103 import GHC.Unit.External
  104 import GHC.Unit.Module
  105 import GHC.Unit.Module.Warnings
  106 import GHC.Unit.Module.ModIface
  107 import GHC.Unit.Module.Deps
  108 import GHC.Unit.State
  109 import GHC.Unit.Home
  110 import GHC.Unit.Home.ModInfo
  111 import GHC.Unit.Finder
  112 import GHC.Unit.Env ( ue_hpt )
  113 
  114 import GHC.Data.Maybe
  115 
  116 import Control.Monad
  117 import Data.Map ( toList )
  118 import System.FilePath
  119 import System.Directory
  120 import GHC.Driver.Env.KnotVars
  121 
  122 {-
  123 ************************************************************************
  124 *                                                                      *
  125 *      tcImportDecl is the key function for "faulting in"              *
  126 *      imported things
  127 *                                                                      *
  128 ************************************************************************
  129 
  130 The main idea is this.  We are chugging along type-checking source code, and
  131 find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
  132 it in the EPS type envt.  So it
  133         1 loads GHC.Base.hi
  134         2 gets the decl for GHC.Base.map
  135         3 typechecks it via tcIfaceDecl
  136         4 and adds it to the type env in the EPS
  137 
  138 Note that DURING STEP 4, we may find that map's type mentions a type
  139 constructor that also
  140 
  141 Notice that for imported things we read the current version from the EPS
  142 mutable variable.  This is important in situations like
  143         ...$(e1)...$(e2)...
  144 where the code that e1 expands to might import some defns that
  145 also turn out to be needed by the code that e2 expands to.
  146 -}
  147 
  148 tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
  149 -- Returns (Failed err) if we can't find the interface file for the thing
  150 tcLookupImported_maybe name
  151   = do  { hsc_env <- getTopEnv
  152         ; mb_thing <- liftIO (lookupType hsc_env name)
  153         ; case mb_thing of
  154             Just thing -> return (Succeeded thing)
  155             Nothing    -> tcImportDecl_maybe name }
  156 
  157 tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
  158 -- Entry point for *source-code* uses of importDecl
  159 tcImportDecl_maybe name
  160   | Just thing <- wiredInNameTyThing_maybe name
  161   = do  { when (needWiredInHomeIface thing)
  162                (initIfaceTcRn (loadWiredInHomeIface name))
  163                 -- See Note [Loading instances for wired-in things]
  164         ; return (Succeeded thing) }
  165   | otherwise
  166   = initIfaceTcRn (importDecl name)
  167 
  168 importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
  169 -- Get the TyThing for this Name from an interface file
  170 -- It's not a wired-in thing -- the caller caught that
  171 importDecl name
  172   = assert (not (isWiredInName name)) $
  173     do  { logger <- getLogger
  174         ; liftIO $ trace_if logger nd_doc
  175 
  176         -- Load the interface, which should populate the PTE
  177         ; mb_iface <- assertPpr (isExternalName name) (ppr name) $
  178                       loadInterface nd_doc (nameModule name) ImportBySystem
  179         ; case mb_iface of {
  180                 Failed err_msg  -> return (Failed err_msg) ;
  181                 Succeeded _ -> do
  182 
  183         -- Now look it up again; this time we should find it
  184         { eps <- getEps
  185         ; case lookupTypeEnv (eps_PTE eps) name of
  186             Just thing -> return $ Succeeded thing
  187             Nothing    -> let doc = whenPprDebug (found_things_msg eps $$ empty)
  188                                     $$ not_found_msg
  189                           in return $ Failed doc
  190     }}}
  191   where
  192     nd_doc = text "Need decl for" <+> ppr name
  193     not_found_msg = hang (text "Can't find interface-file declaration for" <+>
  194                                 pprNameSpace (nameNameSpace name) <+> ppr name)
  195                        2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
  196                                 text "Use -ddump-if-trace to get an idea of which file caused the error"])
  197     found_things_msg eps =
  198         hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon)
  199            2 (vcat (map ppr $ filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps))
  200       where
  201         is_interesting thing = nameModule name == nameModule (getName thing)
  202 
  203 
  204 {-
  205 ************************************************************************
  206 *                                                                      *
  207            Checks for wired-in things
  208 *                                                                      *
  209 ************************************************************************
  210 
  211 Note [Loading instances for wired-in things]
  212 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  213 We need to make sure that we have at least *read* the interface files
  214 for any module with an instance decl or RULE that we might want.
  215 
  216 * If the instance decl is an orphan, we have a whole separate mechanism
  217   (loadOrphanModules)
  218 
  219 * If the instance decl is not an orphan, then the act of looking at the
  220   TyCon or Class will force in the defining module for the
  221   TyCon/Class, and hence the instance decl
  222 
  223 * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
  224   but we must make sure we read its interface in case it has instances or
  225   rules.  That is what GHC.Iface.Load.loadWiredInHomeIface does.  It's called
  226   from GHC.IfaceToCore.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
  227 
  228 * HOWEVER, only do this for TyCons.  There are no wired-in Classes.  There
  229   are some wired-in Ids, but we don't want to load their interfaces. For
  230   example, Control.Exception.Base.recSelError is wired in, but that module
  231   is compiled late in the base library, and we don't want to force it to
  232   load before it's been compiled!
  233 
  234 All of this is done by the type checker. The renamer plays no role.
  235 (It used to, but no longer.)
  236 -}
  237 
  238 checkWiredInTyCon :: TyCon -> TcM ()
  239 -- Ensure that the home module of the TyCon (and hence its instances)
  240 -- are loaded. See Note [Loading instances for wired-in things]
  241 -- It might not be a wired-in tycon (see the calls in GHC.Tc.Utils.Unify),
  242 -- in which case this is a no-op.
  243 checkWiredInTyCon tc
  244   | not (isWiredInName tc_name)
  245   = return ()
  246   | otherwise
  247   = do  { mod <- getModule
  248         ; logger <- getLogger
  249         ; liftIO $ trace_if logger (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
  250         ; assert (isExternalName tc_name )
  251           when (mod /= nameModule tc_name)
  252                (initIfaceTcRn (loadWiredInHomeIface tc_name))
  253                 -- Don't look for (non-existent) Float.hi when
  254                 -- compiling Float.hs, which mentions Float of course
  255                 -- A bit yukky to call initIfaceTcRn here
  256         }
  257   where
  258     tc_name = tyConName tc
  259 
  260 ifCheckWiredInThing :: TyThing -> IfL ()
  261 -- Even though we are in an interface file, we want to make
  262 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
  263 -- Ditto want to ensure that RULES are loaded too
  264 -- See Note [Loading instances for wired-in things]
  265 ifCheckWiredInThing thing
  266   = do  { mod <- getIfModule
  267                 -- Check whether we are typechecking the interface for this
  268                 -- very module.  E.g when compiling the base library in --make mode
  269                 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
  270                 -- the HPT, so without the test we'll demand-load it into the PIT!
  271                 -- C.f. the same test in checkWiredInTyCon above
  272         ; let name = getName thing
  273         ; assertPpr (isExternalName name) (ppr name) $
  274           when (needWiredInHomeIface thing && mod /= nameModule name)
  275                (loadWiredInHomeIface name) }
  276 
  277 needWiredInHomeIface :: TyThing -> Bool
  278 -- Only for TyCons; see Note [Loading instances for wired-in things]
  279 needWiredInHomeIface (ATyCon {}) = True
  280 needWiredInHomeIface _           = False
  281 
  282 
  283 {-
  284 ************************************************************************
  285 *                                                                      *
  286         loadSrcInterface, loadOrphanModules, loadInterfaceForName
  287 
  288                 These three are called from TcM-land
  289 *                                                                      *
  290 ************************************************************************
  291 -}
  292 
  293 -- | Load the interface corresponding to an @import@ directive in
  294 -- source code.  On a failure, fail in the monad with an error message.
  295 loadSrcInterface :: SDoc
  296                  -> ModuleName
  297                  -> IsBootInterface     -- {-# SOURCE #-} ?
  298                  -> PkgQual             -- "package", if any
  299                  -> RnM ModIface
  300 
  301 loadSrcInterface doc mod want_boot maybe_pkg
  302   = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
  303        ; case res of
  304            Failed err      -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)
  305            Succeeded iface -> return iface }
  306 
  307 -- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
  308 loadSrcInterface_maybe :: SDoc
  309                        -> ModuleName
  310                        -> IsBootInterface     -- {-# SOURCE #-} ?
  311                        -> PkgQual             -- "package", if any
  312                        -> RnM (MaybeErr SDoc ModIface)
  313 
  314 loadSrcInterface_maybe doc mod want_boot maybe_pkg
  315   -- We must first find which Module this import refers to.  This involves
  316   -- calling the Finder, which as a side effect will search the filesystem
  317   -- and create a ModLocation.  If successful, loadIface will read the
  318   -- interface; it will call the Finder again, but the ModLocation will be
  319   -- cached from the first search.
  320   = do hsc_env <- getTopEnv
  321        let fc = hsc_FC hsc_env
  322        let dflags = hsc_dflags hsc_env
  323        let fopts = initFinderOpts dflags
  324        let units = hsc_units hsc_env
  325        let home_unit = hsc_home_unit hsc_env
  326        res <- liftIO $ findImportedModule fc fopts units home_unit mod maybe_pkg
  327        case res of
  328            Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
  329            -- TODO: Make sure this error message is good
  330            err         -> return (Failed (cannotFindModule hsc_env mod err))
  331 
  332 -- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
  333 -- rare operation, but in particular it is used to load orphan modules
  334 -- in order to pull their instances into the global package table and to
  335 -- handle some operations in GHCi).
  336 loadModuleInterface :: SDoc -> Module -> TcM ModIface
  337 loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod)
  338 
  339 -- | Load interfaces for a collection of modules.
  340 loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
  341 loadModuleInterfaces doc mods
  342   | null mods = return ()
  343   | otherwise = initIfaceTcRn (mapM_ load mods)
  344   where
  345     load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
  346 
  347 -- | Loads the interface for a given Name.
  348 -- Should only be called for an imported name;
  349 -- otherwise loadSysInterface may not find the interface
  350 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
  351 loadInterfaceForName doc name
  352   = do { when debugIsOn $  -- Check pre-condition
  353          do { this_mod <- getModule
  354             ; massertPpr (not (nameIsLocalOrFrom this_mod name)) (ppr name <+> parens doc) }
  355       ; assertPpr (isExternalName name) (ppr name) $
  356         initIfaceTcRn $ loadSysInterface doc (nameModule name) }
  357 
  358 -- | Only loads the interface for external non-local names.
  359 loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
  360 loadInterfaceForNameMaybe doc name
  361   = do { this_mod <- getModule
  362        ; if nameIsLocalOrFrom this_mod name || not (isExternalName name)
  363          then return Nothing
  364          else Just <$> (initIfaceTcRn $ loadSysInterface doc (nameModule name))
  365        }
  366 
  367 -- | Loads the interface for a given Module.
  368 loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
  369 loadInterfaceForModule doc m
  370   = do
  371     -- Should not be called with this module
  372     when debugIsOn $ do
  373       this_mod <- getModule
  374       massertPpr (this_mod /= m) (ppr m <+> parens doc)
  375     initIfaceTcRn $ loadSysInterface doc m
  376 
  377 {-
  378 *********************************************************
  379 *                                                      *
  380                 loadInterface
  381 
  382         The main function to load an interface
  383         for an imported module, and put it in
  384         the External Package State
  385 *                                                      *
  386 *********************************************************
  387 -}
  388 
  389 -- | An 'IfM' function to load the home interface for a wired-in thing,
  390 -- so that we're sure that we see its instance declarations and rules
  391 -- See Note [Loading instances for wired-in things]
  392 loadWiredInHomeIface :: Name -> IfM lcl ()
  393 loadWiredInHomeIface name
  394   = assert (isWiredInName name) $
  395     do _ <- loadSysInterface doc (nameModule name); return ()
  396   where
  397     doc = text "Need home interface for wired-in thing" <+> ppr name
  398 
  399 ------------------
  400 -- | Loads a system interface and throws an exception if it fails
  401 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
  402 loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem
  403 
  404 ------------------
  405 -- | Loads a user interface and throws an exception if it fails. The first parameter indicates
  406 -- whether we should import the boot variant of the module
  407 loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
  408 loadUserInterface is_boot doc mod_name
  409   = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
  410 
  411 loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
  412 loadPluginInterface doc mod_name
  413   = loadInterfaceWithException doc mod_name ImportByPlugin
  414 
  415 ------------------
  416 -- | A wrapper for 'loadInterface' that throws an exception if it fails
  417 loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
  418 loadInterfaceWithException doc mod_name where_from
  419   = do
  420     dflags <- getDynFlags
  421     let ctx = initSDocContext dflags defaultUserStyle
  422     withException ctx (loadInterface doc mod_name where_from)
  423 
  424 ------------------
  425 loadInterface :: SDoc -> Module -> WhereFrom
  426               -> IfM lcl (MaybeErr SDoc ModIface)
  427 
  428 -- loadInterface looks in both the HPT and PIT for the required interface
  429 -- If not found, it loads it, and puts it in the PIT (always).
  430 
  431 -- If it can't find a suitable interface file, we
  432 --      a) modify the PackageIfaceTable to have an empty entry
  433 --              (to avoid repeated complaints)
  434 --      b) return (Left message)
  435 --
  436 -- It's not necessarily an error for there not to be an interface
  437 -- file -- perhaps the module has changed, and that interface
  438 -- is no longer used
  439 
  440 loadInterface doc_str mod from
  441   | isHoleModule mod
  442   -- Hole modules get special treatment
  443   = do hsc_env <- getTopEnv
  444        let home_unit = hsc_home_unit hsc_env
  445        -- Redo search for our local hole module
  446        loadInterface doc_str (mkHomeModule home_unit (moduleName mod)) from
  447   | otherwise
  448   = do
  449     logger <- getLogger
  450     withTimingSilent logger (text "loading interface") (pure ()) $ do
  451         {       -- Read the state
  452           (eps,hpt) <- getEpsAndHpt
  453         ; gbl_env <- getGblEnv
  454 
  455         ; liftIO $ trace_if logger (text "Considering whether to load" <+> ppr mod <+> ppr from)
  456 
  457                 -- Check whether we have the interface already
  458         ; hsc_env <- getTopEnv
  459         ; let home_unit = hsc_home_unit hsc_env
  460         ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
  461             Just iface
  462                 -> return (Succeeded iface) ;   -- Already loaded
  463                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
  464                         -- interface isn't a boot iface.  This can conceivably happen,
  465                         -- if an earlier import had a before we got to real imports.   I think.
  466             _ -> do {
  467 
  468         -- READ THE MODULE IN
  469         ; read_result <- case (wantHiBootFile home_unit eps mod from) of
  470                            Failed err             -> return (Failed err)
  471                            Succeeded hi_boot_file -> do
  472                              hsc_env <- getTopEnv
  473                              liftIO $ computeInterface hsc_env doc_str hi_boot_file mod
  474         ; case read_result of {
  475             Failed err -> do
  476                 { let fake_iface = emptyFullModIface mod
  477 
  478                 ; updateEps_ $ \eps ->
  479                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
  480                         -- Not found, so add an empty iface to
  481                         -- the EPS map so that we don't look again
  482 
  483                 ; return (Failed err) } ;
  484 
  485         -- Found and parsed!
  486         -- We used to have a sanity check here that looked for:
  487         --  * System importing ..
  488         --  * a home package module ..
  489         --  * that we know nothing about (mb_dep == Nothing)!
  490         --
  491         -- But this is no longer valid because thNameToGhcName allows users to
  492         -- cause the system to load arbitrary interfaces (by supplying an appropriate
  493         -- Template Haskell original-name).
  494             Succeeded (iface, loc) ->
  495         let
  496             loc_doc = text loc
  497         in
  498         initIfaceLcl (mi_semantic_module iface) loc_doc (mi_boot iface) $
  499 
  500         dontLeakTheHPT $ do
  501 
  502         --      Load the new ModIface into the External Package State
  503         -- Even home-package interfaces loaded by loadInterface
  504         --      (which only happens in OneShot mode; in Batch/Interactive
  505         --      mode, home-package modules are loaded one by one into the HPT)
  506         -- are put in the EPS.
  507         --
  508         -- The main thing is to add the ModIface to the PIT, but
  509         -- we also take the
  510         --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules,
  511         -- out of the ModIface and put them into the big EPS pools
  512 
  513         -- NB: *first* we do tcIfaceDecls, so that the provenance of all the locally-defined
  514         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
  515         --     If we do loadExport first the wrong info gets into the cache (unless we
  516         --      explicitly tag each export which seems a bit of a bore)
  517 
  518         ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas
  519         ; new_eps_decls     <- tcIfaceDecls ignore_prags (mi_decls iface)
  520         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
  521         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
  522         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
  523         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
  524         ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
  525 
  526         ; let { final_iface = iface {
  527                                 mi_decls     = panic "No mi_decls in PIT",
  528                                 mi_insts     = panic "No mi_insts in PIT",
  529                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
  530                                 mi_rules     = panic "No mi_rules in PIT",
  531                                 mi_anns      = panic "No mi_anns in PIT"
  532                               }
  533                }
  534 
  535         ; let bad_boot = mi_boot iface == IsBoot
  536                           && isJust (lookupKnotVars (if_rec_types gbl_env) mod)
  537                             -- Warn against an EPS-updating import
  538                             -- of one's own boot file! (one-shot only)
  539                             -- See Note [Loading your own hi-boot file]
  540 
  541         ; warnPprTrace bad_boot (ppr mod) $
  542           updateEps_  $ \ eps ->
  543            if elemModuleEnv mod (eps_PIT eps) || is_external_sig home_unit iface
  544                 then eps
  545            else if bad_boot
  546                 -- See Note [Loading your own hi-boot file]
  547                 then eps { eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls }
  548            else
  549                 eps {
  550                   eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
  551                   eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
  552                   eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
  553                                                         new_eps_rules,
  554                   eps_complete_matches
  555                                    = eps_complete_matches eps ++ new_eps_complete_matches,
  556                   eps_inst_env     = extendInstEnvList (eps_inst_env eps)
  557                                                        new_eps_insts,
  558                   eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
  559                                                           new_eps_fam_insts,
  560                   eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
  561                                                       new_eps_anns,
  562                   eps_mod_fam_inst_env
  563                                    = let
  564                                        fam_inst_env =
  565                                          extendFamInstEnvList emptyFamInstEnv
  566                                                               new_eps_fam_insts
  567                                      in
  568                                      extendModuleEnv (eps_mod_fam_inst_env eps)
  569                                                      mod
  570                                                      fam_inst_env,
  571                   eps_stats        = addEpsInStats (eps_stats eps)
  572                                                    (length new_eps_decls)
  573                                                    (length new_eps_insts)
  574                                                    (length new_eps_rules) }
  575 
  576         ; -- invoke plugins with *full* interface, not final_iface, to ensure
  577           -- that plugins have access to declarations, etc.
  578           res <- withPlugins hsc_env (\p -> interfaceLoadAction p) iface
  579         ; return (Succeeded res)
  580     }}}}
  581 
  582 {- Note [Loading your own hi-boot file]
  583 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  584 Generally speaking, when compiling module M, we should not
  585 load M.hi boot into the EPS.  After all, we are very shortly
  586 going to have full information about M.  Moreover, see
  587 Note [Do not update EPS with your own hi-boot] in GHC.Iface.Recomp.
  588 
  589 But there is a HORRIBLE HACK here.
  590 
  591 * At the end of tcRnImports, we call checkFamInstConsistency to
  592   check consistency of imported type-family instances
  593   See Note [The type family instance consistency story] in GHC.Tc.Instance.Family
  594 
  595 * Alas, those instances may refer to data types defined in M,
  596   if there is a M.hs-boot.
  597 
  598 * And that means we end up loading M.hi-boot, because those
  599   data types are not yet in the type environment.
  600 
  601 But in this weird case, /all/ we need is the types. We don't need
  602 instances, rules etc.  And if we put the instances in the EPS
  603 we get "duplicate instance" warnings when we compile the "real"
  604 instance in M itself.  Hence the strange business of just updateing
  605 the eps_PTE.
  606 
  607 This really happens in practice.  The module "GHC.Hs.Expr" gets
  608 "duplicate instance" errors if this hack is not present.
  609 
  610 This is a mess.
  611 
  612 
  613 Note [HPT space leak] (#15111)
  614 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  615 In IfL, we defer some work until it is demanded using forkM, such
  616 as building TyThings from IfaceDecls. These thunks are stored in
  617 the ExternalPackageState, and they might never be poked.  If we're
  618 not careful, these thunks will capture the state of the loaded
  619 program when we read an interface file, and retain all that data
  620 for ever.
  621 
  622 Therefore, when loading a package interface file , we use a "clean"
  623 version of the HscEnv with all the data about the currently loaded
  624 program stripped out. Most of the fields can be panics because
  625 we'll never read them, but hsc_HPT needs to be empty because this
  626 interface will cause other interfaces to be loaded recursively, and
  627 when looking up those interfaces we use the HPT in loadInterface.
  628 We know that none of the interfaces below here can refer to
  629 home-package modules however, so it's safe for the HPT to be empty.
  630 -}
  631 
  632 -- Note [GHC Heap Invariants]
  633 dontLeakTheHPT :: IfL a -> IfL a
  634 dontLeakTheHPT thing_inside = do
  635   env <- getTopEnv
  636   let
  637     inOneShot =
  638       isOneShot (ghcMode (hsc_dflags env))
  639     cleanGblEnv gbl_env
  640       | inOneShot = gbl_env
  641       | otherwise = gbl_env { if_rec_types = emptyKnotVars }
  642     cleanTopEnv hsc_env =
  643 
  644        let
  645          !maybe_type_vars | inOneShot = Just (hsc_type_env_vars env)
  646                           | otherwise = Nothing
  647          -- wrinkle: when we're typechecking in --backpack mode, the
  648          -- instantiation of a signature might reside in the HPT, so
  649          -- this case breaks the assumption that EPS interfaces only
  650          -- refer to other EPS interfaces.
  651          -- As a temporary (MP Oct 2021 #20509) we only keep the HPT if it
  652          -- contains any hole modules.
  653          -- Quite a few tests in testsuite/tests/backpack break without this
  654          -- tweak.
  655          old_unit_env = hsc_unit_env hsc_env
  656          keepFor20509 hmi
  657           | isHoleModule (mi_semantic_module (hm_iface hmi)) = True
  658           | otherwise = False
  659          !unit_env
  660           = old_unit_env
  661              { ue_hpt = if anyHpt keepFor20509 (ue_hpt old_unit_env) then ue_hpt old_unit_env
  662                                                                      else emptyHomePackageTable
  663              }
  664        in
  665        hsc_env {  hsc_targets      = panic "cleanTopEnv: hsc_targets"
  666                ,  hsc_mod_graph    = panic "cleanTopEnv: hsc_mod_graph"
  667                ,  hsc_IC           = panic "cleanTopEnv: hsc_IC"
  668                ,  hsc_type_env_vars = case maybe_type_vars of
  669                                           Just vars -> vars
  670                                           Nothing -> panic "cleanTopEnv: hsc_type_env_vars"
  671                ,  hsc_unit_env     = unit_env
  672                }
  673 
  674   updTopEnv cleanTopEnv $ updGblEnv cleanGblEnv $ do
  675   !_ <- getTopEnv        -- force the updTopEnv
  676   !_ <- getGblEnv
  677   thing_inside
  678 
  679 
  680 -- | Returns @True@ if a 'ModIface' comes from an external package.
  681 -- In this case, we should NOT load it into the EPS; the entities
  682 -- should instead come from the local merged signature interface.
  683 is_external_sig :: HomeUnit -> ModIface -> Bool
  684 is_external_sig home_unit iface =
  685     -- It's a signature iface...
  686     mi_semantic_module iface /= mi_module iface &&
  687     -- and it's not from the local package
  688     not (isHomeModule home_unit (mi_module iface))
  689 
  690 -- | This is an improved version of 'findAndReadIface' which can also
  691 -- handle the case when a user requests @p[A=<B>]:M@ but we only
  692 -- have an interface for @p[A=<A>]:M@ (the indefinite interface.
  693 -- If we are not trying to build code, we load the interface we have,
  694 -- *instantiating it* according to how the holes are specified.
  695 -- (Of course, if we're actually building code, this is a hard error.)
  696 --
  697 -- In the presence of holes, 'computeInterface' has an important invariant:
  698 -- to load module M, its set of transitively reachable requirements must
  699 -- have an up-to-date local hi file for that requirement.  Note that if
  700 -- we are loading the interface of a requirement, this does not
  701 -- apply to the requirement itself; e.g., @p[A=<A>]:A@ does not require
  702 -- A.hi to be up-to-date (and indeed, we MUST NOT attempt to read A.hi, unless
  703 -- we are actually typechecking p.)
  704 computeInterface
  705   :: HscEnv
  706   -> SDoc
  707   -> IsBootInterface
  708   -> Module
  709   -> IO (MaybeErr SDoc (ModIface, FilePath))
  710 computeInterface hsc_env doc_str hi_boot_file mod0 = do
  711   massert (not (isHoleModule mod0))
  712   let name_cache = hsc_NC hsc_env
  713   let fc         = hsc_FC hsc_env
  714   let home_unit  = hsc_home_unit hsc_env
  715   let units      = hsc_units hsc_env
  716   let dflags     = hsc_dflags hsc_env
  717   let logger     = hsc_logger hsc_env
  718   let hooks      = hsc_hooks hsc_env
  719   let find_iface m = findAndReadIface logger name_cache fc hooks units home_unit dflags doc_str
  720                                       m mod0 hi_boot_file
  721   case getModuleInstantiation mod0 of
  722       (imod, Just indef) | isHomeUnitIndefinite home_unit ->
  723         find_iface imod >>= \case
  724           Succeeded (iface0, path) ->
  725             rnModIface hsc_env (instUnitInsts (moduleUnit indef)) Nothing iface0 >>= \case
  726               Right x   -> return (Succeeded (x, path))
  727               Left errs -> throwErrors (GhcTcRnMessage <$> errs)
  728           Failed err -> return (Failed err)
  729       (mod, _) -> find_iface mod
  730 
  731 -- | Compute the signatures which must be compiled in order to
  732 -- load the interface for a 'Module'.  The output of this function
  733 -- is always a subset of 'moduleFreeHoles'; it is more precise
  734 -- because in signature @p[A=\<A>,B=\<B>]:B@, although the free holes
  735 -- are A and B, B might not depend on A at all!
  736 --
  737 -- If this is invoked on a signature, this does NOT include the
  738 -- signature itself; e.g. precise free module holes of
  739 -- @p[A=\<A>,B=\<B>]:B@ never includes B.
  740 moduleFreeHolesPrecise
  741     :: SDoc -> Module
  742     -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
  743 moduleFreeHolesPrecise doc_str mod
  744  | moduleIsDefinite mod = return (Succeeded emptyUniqDSet)
  745  | otherwise =
  746    case getModuleInstantiation mod of
  747     (imod, Just indef) -> do
  748         logger <- getLogger
  749         let insts = instUnitInsts (moduleUnit indef)
  750         liftIO $ trace_if logger (text "Considering whether to load" <+> ppr mod <+>
  751                  text "to compute precise free module holes")
  752         (eps, hpt) <- getEpsAndHpt
  753         case tryEpsAndHpt eps hpt `firstJust` tryDepsCache eps imod insts of
  754             Just r -> return (Succeeded r)
  755             Nothing -> readAndCache imod insts
  756     (_, Nothing) -> return (Succeeded emptyUniqDSet)
  757   where
  758     tryEpsAndHpt eps hpt =
  759         fmap mi_free_holes (lookupIfaceByModule hpt (eps_PIT eps) mod)
  760     tryDepsCache eps imod insts =
  761         case lookupInstalledModuleEnv (eps_free_holes eps) imod of
  762             Just ifhs  -> Just (renameFreeHoles ifhs insts)
  763             _otherwise -> Nothing
  764     readAndCache imod insts = do
  765         hsc_env <- getTopEnv
  766         let nc        = hsc_NC hsc_env
  767         let fc        = hsc_FC hsc_env
  768         let home_unit = hsc_home_unit hsc_env
  769         let units     = hsc_units hsc_env
  770         let dflags    = hsc_dflags hsc_env
  771         let logger    = hsc_logger hsc_env
  772         let hooks     = hsc_hooks hsc_env
  773         mb_iface <- liftIO $ findAndReadIface logger nc fc hooks units home_unit dflags
  774                                               (text "moduleFreeHolesPrecise" <+> doc_str)
  775                                               imod mod NotBoot
  776         case mb_iface of
  777             Succeeded (iface, _) -> do
  778                 let ifhs = mi_free_holes iface
  779                 -- Cache it
  780                 updateEps_ (\eps ->
  781                     eps { eps_free_holes = extendInstalledModuleEnv (eps_free_holes eps) imod ifhs })
  782                 return (Succeeded (renameFreeHoles ifhs insts))
  783             Failed err -> return (Failed err)
  784 
  785 wantHiBootFile :: HomeUnit -> ExternalPackageState -> Module -> WhereFrom
  786                -> MaybeErr SDoc IsBootInterface
  787 -- Figure out whether we want Foo.hi or Foo.hi-boot
  788 wantHiBootFile home_unit eps mod from
  789   = case from of
  790        ImportByUser usr_boot
  791           | usr_boot == IsBoot && notHomeModule home_unit mod
  792           -> Failed (badSourceImport mod)
  793           | otherwise -> Succeeded usr_boot
  794 
  795        ImportByPlugin
  796           -> Succeeded NotBoot
  797 
  798        ImportBySystem
  799           | notHomeModule home_unit mod
  800           -> Succeeded NotBoot
  801              -- If the module to be imported is not from this package
  802              -- don't look it up in eps_is_boot, because that is keyed
  803              -- on the ModuleName of *home-package* modules only.
  804              -- We never import boot modules from other packages!
  805 
  806           | otherwise
  807           -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
  808                 Just (GWIB { gwib_isBoot = is_boot }) ->
  809                   Succeeded is_boot
  810                 Nothing ->
  811                   Succeeded NotBoot
  812                      -- The boot-ness of the requested interface,
  813                      -- based on the dependencies in directly-imported modules
  814 
  815 badSourceImport :: Module -> SDoc
  816 badSourceImport mod
  817   = hang (text "You cannot {-# SOURCE #-} import a module from another package")
  818        2 (text "but" <+> quotes (ppr mod) <+> text "is from package"
  819           <+> quotes (ppr (moduleUnit mod)))
  820 
  821 -----------------------------------------------------
  822 --      Loading type/class/value decls
  823 -- We pass the full Module name here, replete with
  824 -- its package info, so that we can build a Name for
  825 -- each binder with the right package info in it
  826 -- All subsequent lookups, including crucially lookups during typechecking
  827 -- the declaration itself, will find the fully-glorious Name
  828 --
  829 -- We handle ATs specially.  They are not main declarations, but also not
  830 -- implicit things (in particular, adding them to `implicitTyThings' would mess
  831 -- things up in the renaming/type checking of source programs).
  832 -----------------------------------------------------
  833 
  834 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
  835 addDeclsToPTE pte things = extendNameEnvList pte things
  836 
  837 {-
  838 *********************************************************
  839 *                                                      *
  840 \subsection{Reading an interface file}
  841 *                                                      *
  842 *********************************************************
  843 
  844 Note [Home module load error]
  845 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  846 If the sought-for interface is in the current package (as determined
  847 by -package-name flag) then it jolly well should already be in the HPT
  848 because we process home-package modules in dependency order.  (Except
  849 in one-shot mode; see notes with hsc_HPT decl in GHC.Driver.Env).
  850 
  851 It is possible (though hard) to get this error through user behaviour.
  852   * Suppose package P (modules P1, P2) depends on package Q (modules Q1,
  853     Q2, with Q2 importing Q1)
  854   * We compile both packages.
  855   * Now we edit package Q so that it somehow depends on P
  856   * Now recompile Q with --make (without recompiling P).
  857   * Then Q1 imports, say, P1, which in turn depends on Q2. So Q2
  858     is a home-package module which is not yet in the HPT!  Disaster.
  859 
  860 This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
  861 See #8320.
  862 -}
  863 
  864 findAndReadIface
  865   :: Logger
  866   -> NameCache
  867   -> FinderCache
  868   -> Hooks
  869   -> UnitState
  870   -> HomeUnit
  871   -> DynFlags
  872   -> SDoc            -- ^ Reason for loading the iface (used for tracing)
  873   -> InstalledModule -- ^ The unique identifier of the on-disk module we're looking for
  874   -> Module          -- ^ The *actual* module we're looking for.  We use
  875                      -- this to check the consistency of the requirements of the
  876                      -- module we read out.
  877   -> IsBootInterface -- ^ Looking for .hi-boot or .hi file
  878   -> IO (MaybeErr SDoc (ModIface, FilePath))
  879 findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str mod wanted_mod hi_boot_file = do
  880   let profile = targetProfile dflags
  881 
  882   trace_if logger (sep [hsep [text "Reading",
  883                            if hi_boot_file == IsBoot
  884                              then text "[boot]"
  885                              else Outputable.empty,
  886                            text "interface for",
  887                            ppr mod <> semi],
  888                      nest 4 (text "reason:" <+> doc_str)])
  889 
  890   -- Check for GHC.Prim, and return its static interface
  891   -- See Note [GHC.Prim] in primops.txt.pp.
  892   -- TODO: make this check a function
  893   if mod `installedModuleEq` gHC_PRIM
  894       then do
  895           let iface = case ghcPrimIfaceHook hooks of
  896                        Nothing -> ghcPrimIface
  897                        Just h  -> h
  898           return (Succeeded (iface, "<built in interface for GHC.Prim>"))
  899       else do
  900           let fopts = initFinderOpts dflags
  901           -- Look for the file
  902           mb_found <- liftIO (findExactModule fc fopts unit_state home_unit mod)
  903           case mb_found of
  904               InstalledFound (addBootSuffixLocn_maybe hi_boot_file -> loc) mod -> do
  905                   -- See Note [Home module load error]
  906                   if isHomeInstalledModule home_unit mod &&
  907                      not (isOneShot (ghcMode dflags))
  908                       then return (Failed (homeModError mod loc))
  909                       else do
  910                         r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
  911                         case r of
  912                           Failed _
  913                             -> return r
  914                           Succeeded (iface,_fp)
  915                             -> do
  916                                 r2 <- load_dynamic_too_maybe logger name_cache unit_state
  917                                                          (setDynamicNow dflags) wanted_mod
  918                                                          iface loc
  919                                 case r2 of
  920                                   Failed sdoc -> return (Failed sdoc)
  921                                   Succeeded {} -> return r
  922               err -> do
  923                   trace_if logger (text "...not found")
  924                   return $ Failed $ cannotFindInterface
  925                                       unit_state
  926                                       home_unit
  927                                       profile
  928                                       (Iface_Errors.mayShowLocations dflags)
  929                                       (moduleName mod)
  930                                       err
  931 
  932 -- | Check if we need to try the dynamic interface for -dynamic-too
  933 load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
  934 load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
  935   -- Indefinite interfaces are ALWAYS non-dynamic.
  936   | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
  937   | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
  938   | otherwise = return (Succeeded ())
  939 
  940 load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
  941 load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
  942   read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
  943     Succeeded (dynIface, _)
  944      | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
  945      -> return (Succeeded ())
  946      | otherwise ->
  947         do return $ (Failed $ dynamicHashMismatchError wanted_mod loc)
  948     Failed err ->
  949         do return $ (Failed $ ((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err))
  950 
  951 
  952 dynamicHashMismatchError :: Module -> ModLocation -> SDoc
  953 dynamicHashMismatchError wanted_mod loc  =
  954   vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod)
  955        , text "Normal interface file from"  <+> text (ml_hi_file loc)
  956        , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc)
  957        , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ]
  958 
  959 
  960 read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
  961 read_file logger name_cache unit_state dflags wanted_mod file_path = do
  962   trace_if logger (text "readIFace" <+> text file_path)
  963 
  964   -- Figure out what is recorded in mi_module.  If this is
  965   -- a fully definite interface, it'll match exactly, but
  966   -- if it's indefinite, the inside will be uninstantiated!
  967   let wanted_mod' =
  968         case getModuleInstantiation wanted_mod of
  969             (_, Nothing) -> wanted_mod
  970             (_, Just indef_mod) ->
  971               instModuleToModule unit_state
  972                 (uninstantiateInstantiatedModule indef_mod)
  973   read_result <- readIface dflags name_cache wanted_mod' file_path
  974   case read_result of
  975     Failed err -> return (Failed (badIfaceFile file_path err))
  976     Succeeded iface -> return (Succeeded (iface, file_path))
  977                 -- Don't forget to fill in the package name...
  978 
  979 
  980 -- | Write interface file
  981 writeIface :: Logger -> Profile -> FilePath -> ModIface -> IO ()
  982 writeIface logger profile hi_file_path new_iface
  983     = do createDirectoryIfMissing True (takeDirectory hi_file_path)
  984          let printer = TraceBinIFace (debugTraceMsg logger 3)
  985          writeBinIface profile printer hi_file_path new_iface
  986 
  987 -- | @readIface@ tries just the one file.
  988 --
  989 -- Failed err    <=> file not found, or unreadable, or illegible
  990 -- Succeeded iface <=> successfully found and parsed
  991 readIface
  992   :: DynFlags
  993   -> NameCache
  994   -> Module
  995   -> FilePath
  996   -> IO (MaybeErr SDoc ModIface)
  997 readIface dflags name_cache wanted_mod file_path = do
  998   let profile = targetProfile dflags
  999   res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
 1000   case res of
 1001     Right iface
 1002         -- NB: This check is NOT just a sanity check, it is
 1003         -- critical for correctness of recompilation checking
 1004         -- (it lets us tell when -this-unit-id has changed.)
 1005         | wanted_mod == actual_mod
 1006                         -> return (Succeeded iface)
 1007         | otherwise     -> return (Failed err)
 1008         where
 1009           actual_mod = mi_module iface
 1010           err = hiModuleNameMismatchWarn wanted_mod actual_mod
 1011 
 1012     Left exn    -> return (Failed (text (showException exn)))
 1013 
 1014 {-
 1015 *********************************************************
 1016 *                                                       *
 1017         Wired-in interface for GHC.Prim
 1018 *                                                       *
 1019 *********************************************************
 1020 -}
 1021 
 1022 -- See Note [GHC.Prim] in primops.txt.pp.
 1023 ghcPrimIface :: ModIface
 1024 ghcPrimIface
 1025   = empty_iface {
 1026         mi_exports  = ghcPrimExports,
 1027         mi_decls    = [],
 1028         mi_fixities = fixities,
 1029         mi_final_exts = (mi_final_exts empty_iface){ mi_fix_fn = mkIfaceFixCache fixities },
 1030         mi_decl_docs = ghcPrimDeclDocs -- See Note [GHC.Prim Docs]
 1031         }
 1032   where
 1033     empty_iface = emptyFullModIface gHC_PRIM
 1034 
 1035     -- The fixity listed here for @`seq`@ should match
 1036     -- those in primops.txt.pp (from which Haddock docs are generated).
 1037     fixities = (getOccName seqId, Fixity NoSourceText 0 InfixR)
 1038              : mapMaybe mkFixity allThePrimOps
 1039     mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
 1040 
 1041 {-
 1042 *********************************************************
 1043 *                                                      *
 1044 \subsection{Statistics}
 1045 *                                                      *
 1046 *********************************************************
 1047 -}
 1048 
 1049 ifaceStats :: ExternalPackageState -> SDoc
 1050 ifaceStats eps
 1051   = hcat [text "Renamer stats: ", msg]
 1052   where
 1053     stats = eps_stats eps
 1054     msg = vcat
 1055         [int (n_ifaces_in stats) <+> text "interfaces read",
 1056          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 1057                 int (n_decls_in stats), text "read"],
 1058          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 1059                 int (n_insts_in stats), text "read"],
 1060          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 1061                 int (n_rules_in stats), text "read"]
 1062         ]
 1063 
 1064 {-
 1065 ************************************************************************
 1066 *                                                                      *
 1067                 Printing interfaces
 1068 *                                                                      *
 1069 ************************************************************************
 1070 
 1071 Note [Name qualification with --show-iface]
 1072 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1073 
 1074 In order to disambiguate between identifiers from different modules, we qualify
 1075 all names that don't originate in the current module. In order to keep visual
 1076 noise as low as possible, we keep local names unqualified.
 1077 
 1078 For some background on this choice see trac #15269.
 1079 -}
 1080 
 1081 -- | Read binary interface, and print it out
 1082 showIface :: Logger -> DynFlags -> UnitState -> NameCache -> FilePath -> IO ()
 1083 showIface logger dflags unit_state name_cache filename = do
 1084    let profile = targetProfile dflags
 1085        printer = logMsg logger MCOutput noSrcSpan . withPprStyle defaultDumpStyle
 1086 
 1087    -- skip the hi way check; we don't want to worry about profiled vs.
 1088    -- non-profiled interfaces, for example.
 1089    iface <- readBinIface profile name_cache IgnoreHiWay (TraceBinIFace printer) filename
 1090 
 1091    let -- See Note [Name qualification with --show-iface]
 1092        qualifyImportedNames mod _
 1093            | mod == mi_module iface = NameUnqual
 1094            | otherwise              = NameNotInScope1
 1095        print_unqual = QueryQualify qualifyImportedNames
 1096                                    neverQualifyModules
 1097                                    neverQualifyPackages
 1098    logMsg logger MCDump noSrcSpan
 1099       $ withPprStyle (mkDumpStyle print_unqual)
 1100       $ pprModIface unit_state iface
 1101 
 1102 -- | Show a ModIface but don't display details; suitable for ModIfaces stored in
 1103 -- the EPT.
 1104 pprModIfaceSimple :: UnitState -> ModIface -> SDoc
 1105 pprModIfaceSimple unit_state iface =
 1106     ppr (mi_module iface)
 1107     $$ pprDeps unit_state (mi_deps iface)
 1108     $$ nest 2 (vcat (map pprExport (mi_exports iface)))
 1109 
 1110 -- | Show a ModIface
 1111 --
 1112 -- The UnitState is used to pretty-print units
 1113 pprModIface :: UnitState -> ModIface -> SDoc
 1114 pprModIface unit_state iface@ModIface{ mi_final_exts = exts }
 1115  = vcat [ text "interface"
 1116                 <+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src iface)
 1117                 <+> (if mi_orphan exts then text "[orphan module]" else Outputable.empty)
 1118                 <+> (if mi_finsts exts then text "[family instance module]" else Outputable.empty)
 1119                 <+> (if mi_hpc iface then text "[hpc]" else Outputable.empty)
 1120                 <+> integer hiVersion
 1121         , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash exts))
 1122         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts))
 1123         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash exts))
 1124         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash exts))
 1125         , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash exts))
 1126         , nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash exts))
 1127         , nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash exts))
 1128         , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash exts))
 1129         , nest 2 (text "src_hash:" <+> ppr (mi_src_hash iface))
 1130         , nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
 1131         , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
 1132         , nest 2 (text "where")
 1133         , text "exports:"
 1134         , nest 2 (vcat (map pprExport (mi_exports iface)))
 1135         , pprDeps unit_state (mi_deps iface)
 1136         , vcat (map pprUsage (mi_usages iface))
 1137         , vcat (map pprIfaceAnnotation (mi_anns iface))
 1138         , pprFixities (mi_fixities iface)
 1139         , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
 1140         , vcat (map ppr (mi_insts iface))
 1141         , vcat (map ppr (mi_fam_insts iface))
 1142         , vcat (map ppr (mi_rules iface))
 1143         , ppr (mi_warns iface)
 1144         , pprTrustInfo (mi_trust iface)
 1145         , pprTrustPkg (mi_trust_pkg iface)
 1146         , vcat (map ppr (mi_complete_matches iface))
 1147         , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface))
 1148         , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface))
 1149         , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface))
 1150         , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface))
 1151         ]
 1152   where
 1153     pp_hsc_src HsBootFile = text "[boot]"
 1154     pp_hsc_src HsigFile = text "[hsig]"
 1155     pp_hsc_src HsSrcFile = Outputable.empty
 1156 
 1157 {-
 1158 When printing export lists, we print like this:
 1159         Avail   f               f
 1160         AvailTC C [C, x, y]     C(x,y)
 1161         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 1162 -}
 1163 
 1164 pprExport :: IfaceExport -> SDoc
 1165 pprExport (Avail n)      = ppr n
 1166 pprExport (AvailTC _ []) = Outputable.empty
 1167 pprExport avail@(AvailTC n _) =
 1168     ppr n <> mark <> pp_export (availSubordinateGreNames avail)
 1169   where
 1170     mark | availExportsDecl avail = Outputable.empty
 1171          | otherwise              = vbar
 1172 
 1173     pp_export []    = Outputable.empty
 1174     pp_export names = braces (hsep (map ppr names))
 1175 
 1176 pprUsage :: Usage -> SDoc
 1177 pprUsage usage@UsagePackageModule{}
 1178   = pprUsageImport usage usg_mod
 1179 pprUsage usage@UsageHomeModule{}
 1180   = pprUsageImport usage usg_mod_name $$
 1181     nest 2 (
 1182         maybe Outputable.empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
 1183         vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
 1184         )
 1185 pprUsage usage@UsageFile{}
 1186   = hsep [text "addDependentFile",
 1187           doubleQuotes (text (usg_file_path usage)),
 1188           ppr (usg_file_hash usage)]
 1189 pprUsage usage@UsageMergedRequirement{}
 1190   = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
 1191 pprUsage usage@UsageHomeModuleInterface{}
 1192   = hsep [text "implementation", ppr (usg_mod_name usage), ppr (usg_iface_hash usage)]
 1193 
 1194 pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
 1195 pprUsageImport usage usg_mod'
 1196   = hsep [text "import", safe, ppr (usg_mod' usage),
 1197                        ppr (usg_mod_hash usage)]
 1198     where
 1199         safe | usg_safe usage = text "safe"
 1200              | otherwise      = text " -/ "
 1201 
 1202 pprFixities :: [(OccName, Fixity)] -> SDoc
 1203 pprFixities []    = Outputable.empty
 1204 pprFixities fixes = text "fixities" <+> pprWithCommas pprFix fixes
 1205                   where
 1206                     pprFix (occ,fix) = ppr fix <+> ppr occ
 1207 
 1208 pprTrustInfo :: IfaceTrustInfo -> SDoc
 1209 pprTrustInfo trust = text "trusted:" <+> ppr trust
 1210 
 1211 pprTrustPkg :: Bool -> SDoc
 1212 pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg
 1213 
 1214 instance Outputable Warnings where
 1215     ppr = pprWarns
 1216 
 1217 pprWarns :: Warnings -> SDoc
 1218 pprWarns NoWarnings         = Outputable.empty
 1219 pprWarns (WarnAll txt)  = text "Warn all" <+> ppr txt
 1220 pprWarns (WarnSome prs) = text "Warnings"
 1221                         <+> vcat (map pprWarning prs)
 1222     where pprWarning (name, txt) = ppr name <+> ppr txt
 1223 
 1224 pprIfaceAnnotation :: IfaceAnnotation -> SDoc
 1225 pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
 1226   = ppr target <+> text "annotated by" <+> ppr serialized
 1227 
 1228 pprExtensibleFields :: ExtensibleFields -> SDoc
 1229 pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs
 1230   where
 1231     pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes"