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

-}

{-# LANGUAGE BangPatterns, NondecreasingIndentation #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ViewPatterns #-}

-- | Loading interface files
module GHC.Iface.Load (
        -- Importing one thing
        tcLookupImported_maybe, importDecl,
        checkWiredInTyCon, ifCheckWiredInThing,

        -- RnM/TcM functions
        loadModuleInterface, loadModuleInterfaces,
        loadSrcInterface, loadSrcInterface_maybe,
        loadInterfaceForName, loadInterfaceForModule,

        -- IfM functions
        loadInterface,
        loadSysInterface, loadUserInterface, loadPluginInterface,
        findAndReadIface, readIface, writeIface,
        moduleFreeHolesPrecise,
        needWiredInHomeIface, loadWiredInHomeIface,

        pprModIfaceSimple,
        ifaceStats, pprModIface, showIface,

        module Iface_Errors -- avoids boot files in Ppr modules
   ) where

import GHC.Prelude

import GHC.Platform.Profile

import {-# SOURCE #-} GHC.IfaceToCore
   ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
   , tcIfaceAnnotations, tcIfaceCompleteMatches )

import GHC.Driver.Config.Finder
import GHC.Driver.Env
import GHC.Driver.Errors.Types
import GHC.Driver.Session
import GHC.Driver.Hooks
import GHC.Driver.Plugins

import GHC.Iface.Syntax
import GHC.Iface.Ext.Fields
import GHC.Iface.Binary
import GHC.Iface.Rename
import GHC.Iface.Env
import GHC.Iface.Errors as Iface_Errors

import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad

import GHC.Utils.Binary   ( BinData(..) )
import GHC.Utils.Error
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Logger
import GHC.Utils.Trace

import GHC.Settings.Constants

import GHC.Builtin.Names
import GHC.Builtin.Utils
import GHC.Builtin.PrimOps    ( allThePrimOps, primOpFixity, primOpOcc )

import GHC.Core.Rules
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv

import GHC.Types.Id.Make      ( seqId )
import GHC.Types.Annotations
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.SourceError
import GHC.Types.SourceText
import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.DSet
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.PkgQual

import GHC.Unit.External
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Deps
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Home.ModInfo
import GHC.Unit.Finder
import GHC.Unit.Env

import GHC.Data.Maybe

import Control.Monad
import Data.Map ( toList )
import System.FilePath
import System.Directory
import GHC.Driver.Env.KnotVars

{-
************************************************************************
*                                                                      *
*      tcImportDecl is the key function for "faulting in"              *
*      imported things
*                                                                      *
************************************************************************

The main idea is this.  We are chugging along type-checking source code, and
find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
it in the EPS type envt.  So it
        1 loads GHC.Base.hi
        2 gets the decl for GHC.Base.map
        3 typechecks it via tcIfaceDecl
        4 and adds it to the type env in the EPS

Note that DURING STEP 4, we may find that map's type mentions a type
constructor that also

Notice that for imported things we read the current version from the EPS
mutable variable.  This is important in situations like
        ...$(e1)...$(e2)...
where the code that e1 expands to might import some defns that
also turn out to be needed by the code that e2 expands to.
-}

tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
-- Returns (Failed err) if we can't find the interface file for the thing
tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
tcLookupImported_maybe Name
name
  = do  { HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
        ; Maybe TyThing
mb_thing <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupType HscEnv
hsc_env Name
name)
        ; case Maybe TyThing
mb_thing of
            Just TyThing
thing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded TyThing
thing)
            Maybe TyThing
Nothing    -> Name -> TcM (MaybeErr SDoc TyThing)
tcImportDecl_maybe Name
name }

tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
-- Entry point for *source-code* uses of importDecl
tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
tcImportDecl_maybe Name
name
  | Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
  = do  { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyThing -> Bool
needWiredInHomeIface TyThing
thing)
               (forall a. IfG a -> TcRn a
initIfaceTcRn (forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name))
                -- See Note [Loading instances for wired-in things]
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded TyThing
thing) }
  | Bool
otherwise
  = forall a. IfG a -> TcRn a
initIfaceTcRn (forall lcl. Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name)

importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
-- Get the TyThing for this Name from an interface file
-- It's not a wired-in thing -- the caller caught that
importDecl :: forall lcl. Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name
  = forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Name -> Bool
isWiredInName Name
name)) forall a b. (a -> b) -> a -> b
$
    do  { Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
        ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_if Logger
logger SDoc
nd_doc

        -- Load the interface, which should populate the PTE
        ; MaybeErr SDoc ModIface
mb_iface <- forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (forall a. Outputable a => a -> SDoc
ppr Name
name) forall a b. (a -> b) -> a -> b
$
                      forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
nd_doc (HasDebugCallStack => Name -> Module
nameModule Name
name) WhereFrom
ImportBySystem
        ; case MaybeErr SDoc ModIface
mb_iface of {
                Failed SDoc
err_msg  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err_msg) ;
                Succeeded ModIface
_ -> do

        -- Now look it up again; this time we should find it
        { ExternalPackageState
eps <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
        ; case TypeEnv -> Name -> Maybe TyThing
lookupTypeEnv (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) Name
name of
            Just TyThing
thing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall err val. val -> MaybeErr err val
Succeeded TyThing
thing
            Maybe TyThing
Nothing    -> let doc :: SDoc
doc = SDoc -> SDoc
whenPprDebug (ExternalPackageState -> SDoc
found_things_msg ExternalPackageState
eps SDoc -> SDoc -> SDoc
$$ SDoc
empty)
                                    SDoc -> SDoc -> SDoc
$$ SDoc
not_found_msg
                          in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall err val. err -> MaybeErr err val
Failed SDoc
doc
    }}}
  where
    nd_doc :: SDoc
nd_doc = String -> SDoc
text String
"Need decl for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name
    not_found_msg :: SDoc
not_found_msg = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Can't find interface-file declaration for" SDoc -> SDoc -> SDoc
<+>
                                NameSpace -> SDoc
pprNameSpace (Name -> NameSpace
nameNameSpace Name
name) SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name)
                       Int
2 ([SDoc] -> SDoc
vcat [String -> SDoc
text String
"Probable cause: bug in .hi-boot file, or inconsistent .hi file",
                                String -> SDoc
text String
"Use -ddump-if-trace to get an idea of which file caused the error"])
    found_things_msg :: ExternalPackageState -> SDoc
found_things_msg ExternalPackageState
eps =
        SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Found the following declarations in" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Name -> Module
nameModule Name
name) SDoc -> SDoc -> SDoc
<> SDoc
colon)
           Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter TyThing -> Bool
is_interesting forall a b. (a -> b) -> a -> b
$ forall a. NameEnv a -> [a]
nonDetNameEnvElts forall a b. (a -> b) -> a -> b
$ ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps))
      where
        is_interesting :: TyThing -> Bool
is_interesting TyThing
thing = HasDebugCallStack => Name -> Module
nameModule Name
name forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
nameModule (forall a. NamedThing a => a -> Name
getName TyThing
thing)


{-
************************************************************************
*                                                                      *
           Checks for wired-in things
*                                                                      *
************************************************************************

Note [Loading instances for wired-in things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need to make sure that we have at least *read* the interface files
for any module with an instance decl or RULE that we might want.

* If the instance decl is an orphan, we have a whole separate mechanism
  (loadOrphanModules)

* If the instance decl is not an orphan, then the act of looking at the
  TyCon or Class will force in the defining module for the
  TyCon/Class, and hence the instance decl

* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
  but we must make sure we read its interface in case it has instances or
  rules.  That is what GHC.Iface.Load.loadWiredInHomeIface does.  It's called
  from GHC.IfaceToCore.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}

* HOWEVER, only do this for TyCons.  There are no wired-in Classes.  There
  are some wired-in Ids, but we don't want to load their interfaces. For
  example, Control.Exception.Base.recSelError is wired in, but that module
  is compiled late in the base library, and we don't want to force it to
  load before it's been compiled!

All of this is done by the type checker. The renamer plays no role.
(It used to, but no longer.)
-}

checkWiredInTyCon :: TyCon -> TcM ()
-- Ensure that the home module of the TyCon (and hence its instances)
-- are loaded. See Note [Loading instances for wired-in things]
-- It might not be a wired-in tycon (see the calls in GHC.Tc.Utils.Unify),
-- in which case this is a no-op.
checkWiredInTyCon :: TyCon -> TcM ()
checkWiredInTyCon TyCon
tc
  | Bool -> Bool
not (Name -> Bool
isWiredInName Name
tc_name)
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise
  = do  { Module
mod <- forall (m :: * -> *). HasModule m => m Module
getModule
        ; Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
        ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
text String
"checkWiredInTyCon" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr Module
mod)
        ; forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
tc_name )
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module
mod forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
nameModule Name
tc_name)
               (forall a. IfG a -> TcRn a
initIfaceTcRn (forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
tc_name))
                -- Don't look for (non-existent) Float.hi when
                -- compiling Float.hs, which mentions Float of course
                -- A bit yukky to call initIfaceTcRn here
        }
  where
    tc_name :: Name
tc_name = TyCon -> Name
tyConName TyCon
tc

ifCheckWiredInThing :: TyThing -> IfL ()
-- Even though we are in an interface file, we want to make
-- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
-- Ditto want to ensure that RULES are loaded too
-- See Note [Loading instances for wired-in things]
ifCheckWiredInThing :: TyThing -> IfL ()
ifCheckWiredInThing TyThing
thing
  = do  { Module
mod <- IfL Module
getIfModule
                -- Check whether we are typechecking the interface for this
                -- very module.  E.g when compiling the base library in --make mode
                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
                -- the HPT, so without the test we'll demand-load it into the PIT!
                -- C.f. the same test in checkWiredInTyCon above
        ; let name :: Name
name = forall a. NamedThing a => a -> Name
getName TyThing
thing
        ; forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (forall a. Outputable a => a -> SDoc
ppr Name
name) forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyThing -> Bool
needWiredInHomeIface TyThing
thing Bool -> Bool -> Bool
&& Module
mod forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
nameModule Name
name)
               (forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name) }

needWiredInHomeIface :: TyThing -> Bool
-- Only for TyCons; see Note [Loading instances for wired-in things]
needWiredInHomeIface :: TyThing -> Bool
needWiredInHomeIface (ATyCon {}) = Bool
True
needWiredInHomeIface TyThing
_           = Bool
False


{-
************************************************************************
*                                                                      *
        loadSrcInterface, loadOrphanModules, loadInterfaceForName

                These three are called from TcM-land
*                                                                      *
************************************************************************
-}

-- | Load the interface corresponding to an @import@ directive in
-- source code.  On a failure, fail in the monad with an error message.
loadSrcInterface :: SDoc
                 -> ModuleName
                 -> IsBootInterface     -- {-# SOURCE #-} ?
                 -> PkgQual             -- "package", if any
                 -> RnM ModIface

loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> PkgQual -> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
  = do { MaybeErr SDoc ModIface
res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
       ; case MaybeErr SDoc ModIface
res of
           Failed SDoc
err      -> forall a. TcRnMessage -> TcM a
failWithTc (forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints SDoc
err)
           Succeeded ModIface
iface -> forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
iface }

-- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
loadSrcInterface_maybe :: SDoc
                       -> ModuleName
                       -> IsBootInterface     -- {-# SOURCE #-} ?
                       -> PkgQual             -- "package", if any
                       -> RnM (MaybeErr SDoc ModIface)

loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
  -- We must first find which Module this import refers to.  This involves
  -- calling the Finder, which as a side effect will search the filesystem
  -- and create a ModLocation.  If successful, loadIface will read the
  -- interface; it will call the Finder again, but the ModLocation will be
  -- cached from the first search.
  = do HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
       FindResult
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> PkgQual -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod PkgQual
maybe_pkg
       case FindResult
res of
           Found ModLocation
_ Module
mod -> forall a. IfG a -> TcRn a
initIfaceTcRn forall a b. (a -> b) -> a -> b
$ forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc Module
mod (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
want_boot)
           -- TODO: Make sure this error message is good
           FindResult
err         -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed (HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule HscEnv
hsc_env ModuleName
mod FindResult
err))

-- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
-- rare operation, but in particular it is used to load orphan modules
-- in order to pull their instances into the global package table and to
-- handle some operations in GHCi).
loadModuleInterface :: SDoc -> Module -> TcM ModIface
loadModuleInterface :: SDoc -> Module -> RnM ModIface
loadModuleInterface SDoc
doc Module
mod = forall a. IfG a -> TcRn a
initIfaceTcRn (forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod)

-- | Load interfaces for a collection of modules.
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces SDoc
doc [Module]
mods
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
mods = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = forall a. IfG a -> TcRn a
initIfaceTcRn (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Module -> IfM () ModIface
load [Module]
mods)
  where
    load :: Module -> IfM () ModIface
load Module
mod = forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface (SDoc
doc SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr Module
mod)) Module
mod

-- | Loads the interface for a given Name.
-- Should only be called for an imported name;
-- otherwise loadSysInterface may not find the interface
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName :: SDoc -> Name -> RnM ModIface
loadInterfaceForName SDoc
doc Name
name
  = do { forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn forall a b. (a -> b) -> a -> b
$  -- Check pre-condition
         do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
            ; forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Bool -> Bool
not (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name)) (forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens SDoc
doc) }
      ; forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (forall a. Outputable a => a -> SDoc
ppr Name
name) forall a b. (a -> b) -> a -> b
$
        forall a. IfG a -> TcRn a
initIfaceTcRn forall a b. (a -> b) -> a -> b
$ forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc (HasDebugCallStack => Name -> Module
nameModule Name
name) }

-- | Loads the interface for a given Module.
loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
loadInterfaceForModule :: SDoc -> Module -> RnM ModIface
loadInterfaceForModule SDoc
doc Module
m
  = do
    -- Should not be called with this module
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn forall a b. (a -> b) -> a -> b
$ do
      Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
      forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Module
this_mod forall a. Eq a => a -> a -> Bool
/= Module
m) (forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens SDoc
doc)
    forall a. IfG a -> TcRn a
initIfaceTcRn forall a b. (a -> b) -> a -> b
$ forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
m

{-
*********************************************************
*                                                      *
                loadInterface

        The main function to load an interface
        for an imported module, and put it in
        the External Package State
*                                                      *
*********************************************************
-}

-- | An 'IfM' function to load the home interface for a wired-in thing,
-- so that we're sure that we see its instance declarations and rules
-- See Note [Loading instances for wired-in things]
loadWiredInHomeIface :: Name -> IfM lcl ()
loadWiredInHomeIface :: forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name
  = forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isWiredInName Name
name) forall a b. (a -> b) -> a -> b
$
    do ModIface
_ <- forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc (HasDebugCallStack => Name -> Module
nameModule Name
name); forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    doc :: SDoc
doc = String -> SDoc
text String
"Need home interface for wired-in thing" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name

------------------
-- | Loads a system interface and throws an exception if it fails
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface :: forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod_name = forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
ImportBySystem

------------------
-- | Loads a user interface and throws an exception if it fails. The first parameter indicates
-- whether we should import the boot variant of the module
loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface :: forall lcl. IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface IsBootInterface
is_boot SDoc
doc Module
mod_name
  = forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
is_boot)

loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
loadPluginInterface :: forall lcl. SDoc -> Module -> IfM lcl ModIface
loadPluginInterface SDoc
doc Module
mod_name
  = forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
ImportByPlugin

------------------
-- | A wrapper for 'loadInterface' that throws an exception if it fails
loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException :: forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
where_from
  = do
    DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let ctx :: SDocContext
ctx = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultUserStyle
    forall (m :: * -> *) a.
MonadIO m =>
SDocContext -> m (MaybeErr SDoc a) -> m a
withException SDocContext
ctx (forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc Module
mod_name WhereFrom
where_from)

------------------
loadInterface :: SDoc -> Module -> WhereFrom
              -> IfM lcl (MaybeErr SDoc ModIface)

-- loadInterface looks in both the HPT and PIT for the required interface
-- If not found, it loads it, and puts it in the PIT (always).

-- If it can't find a suitable interface file, we
--      a) modify the PackageIfaceTable to have an empty entry
--              (to avoid repeated complaints)
--      b) return (Left message)
--
-- It's not necessarily an error for there not to be an interface
-- file -- perhaps the module has changed, and that interface
-- is no longer used

loadInterface :: forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc_str Module
mod WhereFrom
from
  | forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
  -- Hole modules get special treatment
  = do HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
       let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
       -- Redo search for our local hole module
       forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc_str (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit (forall unit. GenModule unit -> ModuleName
moduleName Module
mod)) WhereFrom
from
  | Bool
otherwise
  = do
    Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
    forall (m :: * -> *) a.
MonadIO m =>
Logger -> SDoc -> (a -> ()) -> m a -> m a
withTimingSilent Logger
logger (String -> SDoc
text String
"loading interface") (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall a b. (a -> b) -> a -> b
$ do
        {       -- Read the state
          (ExternalPackageState
eps,HomeUnitGraph
hug) <- forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomeUnitGraph)
getEpsAndHug
        ; IfGblEnv
gbl_env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv

        ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
text String
"Considering whether to load" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr WhereFrom
from)

                -- Check whether we have the interface already
        ; HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
        ; let mhome_unit :: Maybe HomeUnit
mhome_unit = UnitEnv -> Maybe HomeUnit
ue_homeUnit (HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
        ; case HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hug (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of {
            Just ModIface
iface
                -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ModIface
iface) ;   -- Already loaded
                        -- The (src_imp == mi_boot iface) test checks that the already-loaded
                        -- interface isn't a boot iface.  This can conceivably happen,
                        -- if an earlier import had a before we got to real imports.   I think.
            Maybe ModIface
_ -> do {

        -- READ THE MODULE IN
        ; MaybeErr SDoc (ModIface, String)
read_result <- case Maybe HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr SDoc IsBootInterface
wantHiBootFile Maybe HomeUnit
mhome_unit ExternalPackageState
eps Module
mod WhereFrom
from of
                           Failed SDoc
err             -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err)
                           Succeeded IsBootInterface
hi_boot_file -> do
                             HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
                             forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr SDoc (ModIface, String))
computeInterface HscEnv
hsc_env SDoc
doc_str IsBootInterface
hi_boot_file Module
mod
        ; case MaybeErr SDoc (ModIface, String)
read_result of {
            Failed SDoc
err -> do
                { let fake_iface :: ModIface
fake_iface = Module -> ModIface
emptyFullModIface Module
mod

                ; forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ forall a b. (a -> b) -> a -> b
$ \ExternalPackageState
eps ->
                        ExternalPackageState
eps { eps_PIT :: PackageIfaceTable
eps_PIT = forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
fake_iface) ModIface
fake_iface }
                        -- Not found, so add an empty iface to
                        -- the EPS map so that we don't look again

                ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err) } ;

        -- Found and parsed!
        -- We used to have a sanity check here that looked for:
        --  * System importing ..
        --  * a home package module ..
        --  * that we know nothing about (mb_dep == Nothing)!
        --
        -- But this is no longer valid because thNameToGhcName allows users to
        -- cause the system to load arbitrary interfaces (by supplying an appropriate
        -- Template Haskell original-name).
            Succeeded (ModIface
iface, String
loc) ->
        let
            loc_doc :: SDoc
loc_doc = String -> SDoc
text String
loc
        in
        forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface) SDoc
loc_doc (ModIface -> IsBootInterface
mi_boot ModIface
iface) forall a b. (a -> b) -> a -> b
$

        forall a. IfL a -> IfL a
dontLeakTheHUG forall a b. (a -> b) -> a -> b
$ do

        --      Load the new ModIface into the External Package State
        -- Even home-package interfaces loaded by loadInterface
        --      (which only happens in OneShot mode; in Batch/Interactive
        --      mode, home-package modules are loaded one by one into the HPT)
        -- are put in the EPS.
        --
        -- The main thing is to add the ModIface to the PIT, but
        -- we also take the
        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules,
        -- out of the ModIface and put them into the big EPS pools

        -- NB: *first* we do tcIfaceDecls, so that the provenance of all the locally-defined
        ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
        --     If we do loadExport first the wrong info gets into the cache (unless we
        --      explicitly tag each export which seems a bit of a bore)

        -- Crucial assertion that checks if you are trying to load a HPT module into the EPS.
        -- If you start loading HPT modules into the EPS then you get strange errors about
        -- overlapping instances.
        ; forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr
              ((GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)))
                Bool -> Bool -> Bool
|| Module -> UnitId
moduleUnitId Module
mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env
                Bool -> Bool -> Bool
|| Module
mod forall a. Eq a => a -> a -> Bool
== Module
gHC_PRIM)
                (String -> SDoc
text String
"Attempting to load home package interface into the EPS" SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr HomeUnitGraph
hug SDoc -> SDoc -> SDoc
$$ SDoc
doc_str SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (Module -> UnitId
moduleUnitId Module
mod))
        ; Bool
ignore_prags      <- forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
        ; [(Name, TyThing)]
new_eps_decls     <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
        ; [ClsInst]
new_eps_insts     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IfL ClsInst
tcIfaceInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
        ; [FamInst]
new_eps_fam_insts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IfL FamInst
tcIfaceFamInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
        ; [CoreRule]
new_eps_rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
        ; [Annotation]
new_eps_anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
        ; [CompleteMatch]
new_eps_complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)

        ; let { final_iface :: ModIface
final_iface = ModIface
iface {
                                mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls     = forall a. String -> a
panic String
"No mi_decls in PIT",
                                mi_insts :: [IfaceClsInst]
mi_insts     = forall a. String -> a
panic String
"No mi_insts in PIT",
                                mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = forall a. String -> a
panic String
"No mi_fam_insts in PIT",
                                mi_rules :: [IfaceRule]
mi_rules     = forall a. String -> a
panic String
"No mi_rules in PIT",
                                mi_anns :: [IfaceAnnotation]
mi_anns      = forall a. String -> a
panic String
"No mi_anns in PIT"
                              }
               }

        ; let bad_boot :: Bool
bad_boot = ModIface -> IsBootInterface
mi_boot ModIface
iface forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
                          Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (forall a. KnotVars a -> Module -> Maybe a
lookupKnotVars (IfGblEnv -> KnotVars (IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env) Module
mod)
                            -- Warn against an EPS-updating import
                            -- of one's own boot file! (one-shot only)
                            -- See Note [Loading your own hi-boot file]

        ; forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace Bool
bad_boot String
"loadInterface" (forall a. Outputable a => a -> SDoc
ppr Module
mod) forall a b. (a -> b) -> a -> b
$
          forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_  forall a b. (a -> b) -> a -> b
$ \ ExternalPackageState
eps ->
           if forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
mod (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Bool -> Bool -> Bool
|| Maybe HomeUnit -> ModIface -> Bool
is_external_sig Maybe HomeUnit
mhome_unit ModIface
iface
                then ExternalPackageState
eps
           else if Bool
bad_boot
                -- See Note [Loading your own hi-boot file]
                then ExternalPackageState
eps { eps_PTE :: TypeEnv
eps_PTE = TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) [(Name, TyThing)]
new_eps_decls }
           else
                ExternalPackageState
eps {
                  eps_PIT :: PackageIfaceTable
eps_PIT          = forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod ModIface
final_iface,
                  eps_PTE :: TypeEnv
eps_PTE          = TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE   (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) [(Name, TyThing)]
new_eps_decls,
                  eps_rule_base :: PackageRuleBase
eps_rule_base    = PackageRuleBase -> [CoreRule] -> PackageRuleBase
extendRuleBaseList (ExternalPackageState -> PackageRuleBase
eps_rule_base ExternalPackageState
eps)
                                                        [CoreRule]
new_eps_rules,
                  eps_complete_matches :: [CompleteMatch]
eps_complete_matches
                                   = ExternalPackageState -> [CompleteMatch]
eps_complete_matches ExternalPackageState
eps forall a. [a] -> [a] -> [a]
++ [CompleteMatch]
new_eps_complete_matches,
                  eps_inst_env :: PackageInstEnv
eps_inst_env     = PackageInstEnv -> [ClsInst] -> PackageInstEnv
extendInstEnvList (ExternalPackageState -> PackageInstEnv
eps_inst_env ExternalPackageState
eps)
                                                       [ClsInst]
new_eps_insts,
                  eps_fam_inst_env :: PackageFamInstEnv
eps_fam_inst_env = PackageFamInstEnv -> [FamInst] -> PackageFamInstEnv
extendFamInstEnvList (ExternalPackageState -> PackageFamInstEnv
eps_fam_inst_env ExternalPackageState
eps)
                                                          [FamInst]
new_eps_fam_insts,
                  eps_ann_env :: PackageAnnEnv
eps_ann_env      = PackageAnnEnv -> [Annotation] -> PackageAnnEnv
extendAnnEnvList (ExternalPackageState -> PackageAnnEnv
eps_ann_env ExternalPackageState
eps)
                                                      [Annotation]
new_eps_anns,
                  eps_mod_fam_inst_env :: ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env
                                   = let
                                       fam_inst_env :: PackageFamInstEnv
fam_inst_env =
                                         PackageFamInstEnv -> [FamInst] -> PackageFamInstEnv
extendFamInstEnvList PackageFamInstEnv
emptyFamInstEnv
                                                              [FamInst]
new_eps_fam_insts
                                     in
                                     forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env ExternalPackageState
eps)
                                                     Module
mod
                                                     PackageFamInstEnv
fam_inst_env,
                  eps_stats :: EpsStats
eps_stats        = EpsStats -> Int -> Int -> Int -> EpsStats
addEpsInStats (ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps)
                                                   (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, TyThing)]
new_eps_decls)
                                                   (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
new_eps_insts)
                                                   (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreRule]
new_eps_rules) }

        ; -- invoke plugins with *full* interface, not final_iface, to ensure
          -- that plugins have access to declarations, etc.
          ModIface
res <- forall (m :: * -> *) a.
Monad m =>
Plugins -> PluginOperation m a -> a -> m a
withPlugins (HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env) (\Plugin
p -> Plugin -> forall lcl. [String] -> ModIface -> IfM lcl ModIface
interfaceLoadAction Plugin
p) ModIface
iface
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ModIface
res)
    }}}}

{- Note [Loading your own hi-boot file]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally speaking, when compiling module M, we should not
load M.hi boot into the EPS.  After all, we are very shortly
going to have full information about M.  Moreover, see
Note [Do not update EPS with your own hi-boot] in GHC.Iface.Recomp.

But there is a HORRIBLE HACK here.

* At the end of tcRnImports, we call checkFamInstConsistency to
  check consistency of imported type-family instances
  See Note [The type family instance consistency story] in GHC.Tc.Instance.Family

* Alas, those instances may refer to data types defined in M,
  if there is a M.hs-boot.

* And that means we end up loading M.hi-boot, because those
  data types are not yet in the type environment.

But in this weird case, /all/ we need is the types. We don't need
instances, rules etc.  And if we put the instances in the EPS
we get "duplicate instance" warnings when we compile the "real"
instance in M itself.  Hence the strange business of just updateing
the eps_PTE.

This really happens in practice.  The module "GHC.Hs.Expr" gets
"duplicate instance" errors if this hack is not present.

This is a mess.


Note [HPT space leak] (#15111)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In IfL, we defer some work until it is demanded using forkM, such
as building TyThings from IfaceDecls. These thunks are stored in
the ExternalPackageState, and they might never be poked.  If we're
not careful, these thunks will capture the state of the loaded
program when we read an interface file, and retain all that data
for ever.

Therefore, when loading a package interface file , we use a "clean"
version of the HscEnv with all the data about the currently loaded
program stripped out. Most of the fields can be panics because
we'll never read them, but hsc_HPT needs to be empty because this
interface will cause other interfaces to be loaded recursively, and
when looking up those interfaces we use the HPT in loadInterface.
We know that none of the interfaces below here can refer to
home-package modules however, so it's safe for the HPT to be empty.
-}

-- Note [GHC Heap Invariants]
dontLeakTheHUG :: IfL a -> IfL a
dontLeakTheHUG :: forall a. IfL a -> IfL a
dontLeakTheHUG IfL a
thing_inside = do
  HscEnv
env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
  let
    inOneShot :: Bool
inOneShot =
      GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
env))
    cleanGblEnv :: IfGblEnv -> IfGblEnv
cleanGblEnv IfGblEnv
gbl_env
      | Bool
inOneShot = IfGblEnv
gbl_env
      | Bool
otherwise = IfGblEnv
gbl_env { if_rec_types :: KnotVars (IfG TypeEnv)
if_rec_types = forall a. KnotVars a
emptyKnotVars }
    cleanTopEnv :: HscEnv -> HscEnv
cleanTopEnv HscEnv
hsc_env =

       let
         !maybe_type_vars :: Maybe (KnotVars (IORef TypeEnv))
maybe_type_vars | Bool
inOneShot = forall a. a -> Maybe a
Just (HscEnv -> KnotVars (IORef TypeEnv)
hsc_type_env_vars HscEnv
env)
                          | Bool
otherwise = forall a. Maybe a
Nothing
         -- wrinkle: when we're typechecking in --backpack mode, the
         -- instantiation of a signature might reside in the HPT, so
         -- this case breaks the assumption that EPS interfaces only
         -- refer to other EPS interfaces.
         -- As a temporary (MP Oct 2021 #20509) we only keep the HPT if it
         -- contains any hole modules.
         -- Quite a few tests in testsuite/tests/backpack break without this
         -- tweak.
         old_unit_env :: UnitEnv
old_unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
         keepFor20509 :: HomeModInfo -> Bool
keepFor20509 HomeModInfo
hmi
          | forall u. GenModule (GenUnit u) -> Bool
isHoleModule (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi)) = Bool
True
          | Bool
otherwise = Bool
False
         pruneHomeUnitEnv :: HomeUnitEnv -> HomeUnitEnv
pruneHomeUnitEnv HomeUnitEnv
hme = HomeUnitEnv
hme { homeUnitEnv_hpt :: HomePackageTable
homeUnitEnv_hpt = HomePackageTable
emptyHomePackageTable }
         !unit_env :: UnitEnv
unit_env
          = UnitEnv
old_unit_env
             { ue_home_unit_graph :: HomeUnitGraph
ue_home_unit_graph = if (HomeModInfo -> Bool) -> HomePackageTable -> Bool
anyHpt HomeModInfo -> Bool
keepFor20509 (HasDebugCallStack => UnitEnv -> HomePackageTable
ue_hpt UnitEnv
old_unit_env) then UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
old_unit_env
                                                                                 else forall v. (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_map HomeUnitEnv -> HomeUnitEnv
pruneHomeUnitEnv (UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
old_unit_env)
             }
       in
       HscEnv
hsc_env {  hsc_targets :: [Target]
hsc_targets      = forall a. String -> a
panic String
"cleanTopEnv: hsc_targets"
               ,  hsc_mod_graph :: ModuleGraph
hsc_mod_graph    = forall a. String -> a
panic String
"cleanTopEnv: hsc_mod_graph"
               ,  hsc_IC :: InteractiveContext
hsc_IC           = forall a. String -> a
panic String
"cleanTopEnv: hsc_IC"
               ,  hsc_type_env_vars :: KnotVars (IORef TypeEnv)
hsc_type_env_vars = case Maybe (KnotVars (IORef TypeEnv))
maybe_type_vars of
                                          Just KnotVars (IORef TypeEnv)
vars -> KnotVars (IORef TypeEnv)
vars
                                          Maybe (KnotVars (IORef TypeEnv))
Nothing -> forall a. String -> a
panic String
"cleanTopEnv: hsc_type_env_vars"
               ,  hsc_unit_env :: UnitEnv
hsc_unit_env     = UnitEnv
unit_env
               }

  forall gbl lcl a.
(HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updTopEnv HscEnv -> HscEnv
cleanTopEnv forall a b. (a -> b) -> a -> b
$ forall gbl lcl a.
(gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updGblEnv IfGblEnv -> IfGblEnv
cleanGblEnv forall a b. (a -> b) -> a -> b
$ do
  !HscEnv
_ <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv        -- force the updTopEnv
  !IfGblEnv
_ <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
  IfL a
thing_inside


-- | Returns @True@ if a 'ModIface' comes from an external package.
-- In this case, we should NOT load it into the EPS; the entities
-- should instead come from the local merged signature interface.
is_external_sig :: Maybe HomeUnit -> ModIface -> Bool
is_external_sig :: Maybe HomeUnit -> ModIface -> Bool
is_external_sig Maybe HomeUnit
mhome_unit ModIface
iface =
    -- It's a signature iface...
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface forall a. Eq a => a -> a -> Bool
/= forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface Bool -> Bool -> Bool
&&
    -- and it's not from the local package
    Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)

-- | This is an improved version of 'findAndReadIface' which can also
-- handle the case when a user requests @p[A=<B>]:M@ but we only
-- have an interface for @p[A=<A>]:M@ (the indefinite interface.
-- If we are not trying to build code, we load the interface we have,
-- *instantiating it* according to how the holes are specified.
-- (Of course, if we're actually building code, this is a hard error.)
--
-- In the presence of holes, 'computeInterface' has an important invariant:
-- to load module M, its set of transitively reachable requirements must
-- have an up-to-date local hi file for that requirement.  Note that if
-- we are loading the interface of a requirement, this does not
-- apply to the requirement itself; e.g., @p[A=<A>]:A@ does not require
-- A.hi to be up-to-date (and indeed, we MUST NOT attempt to read A.hi, unless
-- we are actually typechecking p.)
computeInterface
  :: HscEnv
  -> SDoc
  -> IsBootInterface
  -> Module
  -> IO (MaybeErr SDoc (ModIface, FilePath))
computeInterface :: HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr SDoc (ModIface, String))
computeInterface HscEnv
hsc_env SDoc
doc_str IsBootInterface
hi_boot_file Module
mod0 = do
  forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Bool -> Bool
not (forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod0))
  let mhome_unit :: Maybe HomeUnit
mhome_unit  = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
  let find_iface :: GenModule UnitId -> IO (MaybeErr SDoc (ModIface, String))
find_iface GenModule UnitId
m = HscEnv
-> SDoc
-> GenModule UnitId
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface HscEnv
hsc_env SDoc
doc_str
                                      GenModule UnitId
m Module
mod0 IsBootInterface
hi_boot_file
  case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
mod0 of
      (GenModule UnitId
imod, Just InstantiatedModule
indef)
        | Just HomeUnit
home_unit <- Maybe HomeUnit
mhome_unit
        , forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite HomeUnit
home_unit ->
          GenModule UnitId -> IO (MaybeErr SDoc (ModIface, String))
find_iface GenModule UnitId
imod forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Succeeded (ModIface
iface0, String
path) ->
              HscEnv
-> [(ModuleName, Module)]
-> Maybe NameShape
-> ModIface
-> IO (Either (Messages TcRnMessage) ModIface)
rnModIface HscEnv
hsc_env (forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)) forall a. Maybe a
Nothing ModIface
iface0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right ModIface
x   -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded (ModIface
x, String
path))
                Left Messages TcRnMessage
errs -> forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
throwErrors (TcRnMessage -> GhcMessage
GhcTcRnMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages TcRnMessage
errs)
            Failed SDoc
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err)
      (GenModule UnitId
mod, Maybe InstantiatedModule
_) -> GenModule UnitId -> IO (MaybeErr SDoc (ModIface, String))
find_iface GenModule UnitId
mod

-- | Compute the signatures which must be compiled in order to
-- load the interface for a 'Module'.  The output of this function
-- is always a subset of 'moduleFreeHoles'; it is more precise
-- because in signature @p[A=\<A>,B=\<B>]:B@, although the free holes
-- are A and B, B might not depend on A at all!
--
-- If this is invoked on a signature, this does NOT include the
-- signature itself; e.g. precise free module holes of
-- @p[A=\<A>,B=\<B>]:B@ never includes B.
moduleFreeHolesPrecise
    :: SDoc -> Module
    -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise :: forall gbl lcl.
SDoc
-> Module -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise SDoc
doc_str Module
mod
 | Module -> Bool
moduleIsDefinite Module
mod = forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded forall a. UniqDSet a
emptyUniqDSet)
 | Bool
otherwise =
   case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
mod of
    (GenModule UnitId
imod, Just InstantiatedModule
indef) -> do
        Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
        let insts :: [(ModuleName, Module)]
insts = forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
text String
"Considering whether to load" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+>
                 String -> SDoc
text String
"to compute precise free module holes")
        (ExternalPackageState
eps, HomeUnitGraph
hpt) <- forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomeUnitGraph)
getEpsAndHug
        case ExternalPackageState
-> HomeUnitGraph -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomeUnitGraph
hpt forall a. Maybe a -> Maybe a -> Maybe a
`firstJust` ExternalPackageState
-> GenModule UnitId
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps GenModule UnitId
imod [(ModuleName, Module)]
insts of
            Just UniqDSet ModuleName
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
r)
            Maybe (UniqDSet ModuleName)
Nothing -> GenModule UnitId
-> [(ModuleName, Module)]
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
readAndCache GenModule UnitId
imod [(ModuleName, Module)]
insts
    (GenModule UnitId
_, Maybe InstantiatedModule
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded forall a. UniqDSet a
emptyUniqDSet)
  where
    tryEpsAndHpt :: ExternalPackageState
-> HomeUnitGraph -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomeUnitGraph
hpt =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModIface -> UniqDSet ModuleName
mi_free_holes (HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod)
    tryDepsCache :: ExternalPackageState
-> GenModule UnitId
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps GenModule UnitId
imod [(ModuleName, Module)]
insts =
        case forall a. InstalledModuleEnv a -> GenModule UnitId -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) GenModule UnitId
imod of
            Just UniqDSet ModuleName
ifhs  -> forall a. a -> Maybe a
Just (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts)
            Maybe (UniqDSet ModuleName)
_otherwise -> forall a. Maybe a
Nothing
    readAndCache :: GenModule UnitId
-> [(ModuleName, Module)]
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
readAndCache GenModule UnitId
imod [(ModuleName, Module)]
insts = do
        HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
        MaybeErr SDoc (ModIface, String)
mb_iface <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv
-> SDoc
-> GenModule UnitId
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface HscEnv
hsc_env
                                              (String -> SDoc
text String
"moduleFreeHolesPrecise" SDoc -> SDoc -> SDoc
<+> SDoc
doc_str)
                                              GenModule UnitId
imod Module
mod IsBootInterface
NotBoot
        case MaybeErr SDoc (ModIface, String)
mb_iface of
            Succeeded (ModIface
iface, String
_) -> do
                let ifhs :: UniqDSet ModuleName
ifhs = ModIface -> UniqDSet ModuleName
mi_free_holes ModIface
iface
                -- Cache it
                forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\ExternalPackageState
eps ->
                    ExternalPackageState
eps { eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes = forall a.
InstalledModuleEnv a
-> GenModule UnitId -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) GenModule UnitId
imod UniqDSet ModuleName
ifhs })
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts))
            Failed SDoc
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err)

wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom
               -> MaybeErr SDoc IsBootInterface
-- Figure out whether we want Foo.hi or Foo.hi-boot
wantHiBootFile :: Maybe HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr SDoc IsBootInterface
wantHiBootFile Maybe HomeUnit
mhome_unit ExternalPackageState
eps Module
mod WhereFrom
from
  = case WhereFrom
from of
       ImportByUser IsBootInterface
usr_boot
          | IsBootInterface
usr_boot forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot Bool -> Bool -> Bool
&& Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit Module
mod
          -> forall err val. err -> MaybeErr err val
Failed (Module -> SDoc
badSourceImport Module
mod)
          | Bool
otherwise -> forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
usr_boot

       WhereFrom
ImportByPlugin
          -> forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot

       WhereFrom
ImportBySystem
          | Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit Module
mod
          -> forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
             -- If the module to be imported is not from this package
             -- don't look it up in eps_is_boot, because that is keyed
             -- on the ModuleName of *home-package* modules only.
             -- We never import boot modules from other packages!

          | Bool
otherwise
          -> case forall a. InstalledModuleEnv a -> GenModule UnitId -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (Unit -> UnitId
toUnitId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
mod) of
                Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) ->
                  forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
is_boot
                Maybe ModuleNameWithIsBoot
Nothing ->
                  forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
                     -- The boot-ness of the requested interface,
                     -- based on the dependencies in directly-imported modules

badSourceImport :: Module -> SDoc
badSourceImport :: Module -> SDoc
badSourceImport Module
mod
  = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"You cannot {-# SOURCE #-} import a module from another package")
       Int
2 (String -> SDoc
text String
"but" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is from package"
          SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> unit
moduleUnit Module
mod)))

-----------------------------------------------------
--      Loading type/class/value decls
-- We pass the full Module name here, replete with
-- its package info, so that we can build a Name for
-- each binder with the right package info in it
-- All subsequent lookups, including crucially lookups during typechecking
-- the declaration itself, will find the fully-glorious Name
--
-- We handle ATs specially.  They are not main declarations, but also not
-- implicit things (in particular, adding them to `implicitTyThings' would mess
-- things up in the renaming/type checking of source programs).
-----------------------------------------------------

addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE :: TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE TypeEnv
pte [(Name, TyThing)]
things = forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
pte [(Name, TyThing)]
things

{-
*********************************************************
*                                                      *
\subsection{Reading an interface file}
*                                                      *
*********************************************************

Note [Home module load error]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the sought-for interface is in the current package (as determined
by -package-name flag) then it jolly well should already be in the HPT
because we process home-package modules in dependency order.  (Except
in one-shot mode; see notes with hsc_HPT decl in GHC.Driver.Env).

It is possible (though hard) to get this error through user behaviour.
  * Suppose package P (modules P1, P2) depends on package Q (modules Q1,
    Q2, with Q2 importing Q1)
  * We compile both packages.
  * Now we edit package Q so that it somehow depends on P
  * Now recompile Q with --make (without recompiling P).
  * Then Q1 imports, say, P1, which in turn depends on Q2. So Q2
    is a home-package module which is not yet in the HPT!  Disaster.

This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
See #8320.
-}

findAndReadIface
  :: HscEnv
  -> SDoc            -- ^ Reason for loading the iface (used for tracing)
  -> InstalledModule -- ^ The unique identifier of the on-disk module we're looking for
  -> Module          -- ^ The *actual* module we're looking for.  We use
                     -- this to check the consistency of the requirements of the
                     -- module we read out.
  -> IsBootInterface -- ^ Looking for .hi-boot or .hi file
  -> IO (MaybeErr SDoc (ModIface, FilePath))
findAndReadIface :: HscEnv
-> SDoc
-> GenModule UnitId
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface HscEnv
hsc_env SDoc
doc_str GenModule UnitId
mod Module
wanted_mod IsBootInterface
hi_boot_file = do

  let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
      unit_state :: UnitState
unit_state = HasDebugCallStack => HscEnv -> UnitState
hsc_units HscEnv
hsc_env
      fc :: FinderCache
fc         = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
      name_cache :: NameCache
name_cache = HscEnv -> NameCache
hsc_NC HscEnv
hsc_env
      mhome_unit :: Maybe HomeUnit
mhome_unit  = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
      dflags :: DynFlags
dflags     = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
      logger :: Logger
logger     = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
      hooks :: Hooks
hooks      = HscEnv -> Hooks
hsc_hooks HscEnv
hsc_env
      other_fopts :: UnitEnvGraph FinderOpts
other_fopts = DynFlags -> FinderOpts
initFinderOpts forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeUnitEnv -> DynFlags
homeUnitEnv_dflags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env)


  Logger -> SDoc -> IO ()
trace_if Logger
logger ([SDoc] -> SDoc
sep [[SDoc] -> SDoc
hsep [String -> SDoc
text String
"Reading",
                           if IsBootInterface
hi_boot_file forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
                             then String -> SDoc
text String
"[boot]"
                             else SDoc
Outputable.empty,
                           String -> SDoc
text String
"interface for",
                           forall a. Outputable a => a -> SDoc
ppr GenModule UnitId
mod SDoc -> SDoc -> SDoc
<> SDoc
semi],
                     Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"reason:" SDoc -> SDoc -> SDoc
<+> SDoc
doc_str)])

  -- Check for GHC.Prim, and return its static interface
  -- See Note [GHC.Prim] in primops.txt.pp.
  -- TODO: make this check a function
  if GenModule UnitId
mod GenModule UnitId -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
      then do
          let iface :: ModIface
iface = case Hooks -> Maybe ModIface
ghcPrimIfaceHook Hooks
hooks of
                       Maybe ModIface
Nothing -> ModIface
ghcPrimIface
                       Just ModIface
h  -> ModIface
h
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
"<built in interface for GHC.Prim>"))
      else do
          let fopts :: FinderOpts
fopts = DynFlags -> FinderOpts
initFinderOpts DynFlags
dflags
          -- Look for the file
          InstalledFindResult
mb_found <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FinderCache
-> FinderOpts
-> UnitEnvGraph FinderOpts
-> UnitState
-> Maybe HomeUnit
-> GenModule UnitId
-> IO InstalledFindResult
findExactModule FinderCache
fc FinderOpts
fopts UnitEnvGraph FinderOpts
other_fopts UnitState
unit_state Maybe HomeUnit
mhome_unit GenModule UnitId
mod)
          case InstalledFindResult
mb_found of
              InstalledFound (IsBootInterface -> ModLocation -> ModLocation
addBootSuffixLocn_maybe IsBootInterface
hi_boot_file -> ModLocation
loc) GenModule UnitId
mod -> do
                  -- See Note [Home module load error]
                  case Maybe HomeUnit
mhome_unit of
                    Just HomeUnit
home_unit
                      | forall u. GenHomeUnit u -> GenModule UnitId -> Bool
isHomeInstalledModule HomeUnit
home_unit GenModule UnitId
mod
                      , Bool -> Bool
not (GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
                      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed (GenModule UnitId -> ModLocation -> SDoc
homeModError GenModule UnitId
mod ModLocation
loc))
                    Maybe HomeUnit
_ -> do
                        MaybeErr SDoc (ModIface, String)
r <- Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod (ModLocation -> String
ml_hi_file ModLocation
loc)
                        case MaybeErr SDoc (ModIface, String)
r of
                          Failed SDoc
_
                            -> forall (m :: * -> *) a. Monad m => a -> m a
return MaybeErr SDoc (ModIface, String)
r
                          Succeeded (ModIface
iface,String
_fp)
                            -> do
                                MaybeErr SDoc ()
r2 <- Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr SDoc ())
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state
                                                         (DynFlags -> DynFlags
setDynamicNow DynFlags
dflags) Module
wanted_mod
                                                         ModIface
iface ModLocation
loc
                                case MaybeErr SDoc ()
r2 of
                                  Failed SDoc
sdoc -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
sdoc)
                                  Succeeded {} -> forall (m :: * -> *) a. Monad m => a -> m a
return MaybeErr SDoc (ModIface, String)
r
              InstalledFindResult
err -> do
                  Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
text String
"...not found")
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall err val. err -> MaybeErr err val
Failed forall a b. (a -> b) -> a -> b
$ UnitState
-> Maybe HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cannotFindInterface
                                      UnitState
unit_state
                                      Maybe HomeUnit
mhome_unit
                                      Profile
profile
                                      (DynFlags -> [String] -> SDoc
Iface_Errors.mayShowLocations DynFlags
dflags)
                                      (forall unit. GenModule unit -> ModuleName
moduleName GenModule UnitId
mod)
                                      InstalledFindResult
err

-- | Check if we need to try the dynamic interface for -dynamic-too
load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
load_dynamic_too_maybe :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr SDoc ())
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc
  -- Indefinite interfaces are ALWAYS non-dynamic.
  | Bool -> Bool
not (Module -> Bool
moduleIsDefinite (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ())
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildDynamicToo DynFlags
dflags = Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr SDoc ())
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ())

load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
load_dynamic_too :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr SDoc ())
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc = do
  Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod (ModLocation -> String
ml_dyn_hi_file ModLocation
loc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Succeeded (ModIface
dynIface, String
_)
     | ModIfaceBackend -> Fingerprint
mi_mod_hash (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) forall a. Eq a => a -> a -> Bool
== ModIfaceBackend -> Fingerprint
mi_mod_hash (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
dynIface)
     -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ())
     | Bool
otherwise ->
        do forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall err val. err -> MaybeErr err val
Failed forall a b. (a -> b) -> a -> b
$ Module -> ModLocation -> SDoc
dynamicHashMismatchError Module
wanted_mod ModLocation
loc)
    Failed SDoc
err ->
        do forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall err val. err -> MaybeErr err val
Failed forall a b. (a -> b) -> a -> b
$ ((String -> SDoc
text String
"Failed to load dynamic interface file for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod SDoc -> SDoc -> SDoc
<> SDoc
colon) SDoc -> SDoc -> SDoc
$$ SDoc
err))


dynamicHashMismatchError :: Module -> ModLocation -> SDoc
dynamicHashMismatchError :: Module -> ModLocation -> SDoc
dynamicHashMismatchError Module
wanted_mod ModLocation
loc  =
  [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Dynamic hash doesn't match for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod)
       , String -> SDoc
text String
"Normal interface file from"  SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (ModLocation -> String
ml_hi_file ModLocation
loc)
       , String -> SDoc
text String
"Dynamic interface file from" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (ModLocation -> String
ml_dyn_hi_file ModLocation
loc)
       , String -> SDoc
text String
"You probably need to recompile" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod) ]


read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
read_file :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod String
file_path = do
  Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
text String
"readIFace" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
file_path)

  -- Figure out what is recorded in mi_module.  If this is
  -- a fully definite interface, it'll match exactly, but
  -- if it's indefinite, the inside will be uninstantiated!
  let wanted_mod' :: Module
wanted_mod' =
        case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
wanted_mod of
            (GenModule UnitId
_, Maybe InstantiatedModule
Nothing) -> Module
wanted_mod
            (GenModule UnitId
_, Just InstantiatedModule
indef_mod) ->
              UnitState -> InstantiatedModule -> Module
instModuleToModule UnitState
unit_state
                (InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule InstantiatedModule
indef_mod)
  MaybeErr SDoc ModIface
read_result <- DynFlags
-> NameCache -> Module -> String -> IO (MaybeErr SDoc ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod' String
file_path
  case MaybeErr SDoc ModIface
read_result of
    Failed SDoc
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed (String -> SDoc -> SDoc
badIfaceFile String
file_path SDoc
err))
    Succeeded ModIface
iface -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
file_path))
                -- Don't forget to fill in the package name...


-- | Write interface file
writeIface :: Logger -> Profile -> FilePath -> ModIface -> IO ()
writeIface :: Logger -> Profile -> String -> ModIface -> IO ()
writeIface Logger
logger Profile
profile String
hi_file_path ModIface
new_iface
    = do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
hi_file_path)
         let printer :: TraceBinIFace
printer = (SDoc -> IO ()) -> TraceBinIFace
TraceBinIFace (Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3)
         Profile -> TraceBinIFace -> String -> ModIface -> IO ()
writeBinIface Profile
profile TraceBinIFace
printer String
hi_file_path ModIface
new_iface

-- | @readIface@ tries just the one file.
--
-- Failed err    <=> file not found, or unreadable, or illegible
-- Succeeded iface <=> successfully found and parsed
readIface
  :: DynFlags
  -> NameCache
  -> Module
  -> FilePath
  -> IO (MaybeErr SDoc ModIface)
readIface :: DynFlags
-> NameCache -> Module -> String -> IO (MaybeErr SDoc ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod String
file_path = do
  let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
  Either SomeException ModIface
res <- forall a. IO a -> IO (Either SomeException a)
tryMost forall a b. (a -> b) -> a -> b
$ Profile
-> NameCache
-> CheckHiWay
-> TraceBinIFace
-> String
-> IO ModIface
readBinIface Profile
profile NameCache
name_cache CheckHiWay
CheckHiWay TraceBinIFace
QuietBinIFace String
file_path
  case Either SomeException ModIface
res of
    Right ModIface
iface
        -- NB: This check is NOT just a sanity check, it is
        -- critical for correctness of recompilation checking
        -- (it lets us tell when -this-unit-id has changed.)
        | Module
wanted_mod forall a. Eq a => a -> a -> Bool
== Module
actual_mod
                        -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. val -> MaybeErr err val
Succeeded ModIface
iface)
        | Bool
otherwise     -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed SDoc
err)
        where
          actual_mod :: Module
actual_mod = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
          err :: SDoc
err = Module -> Module -> SDoc
hiModuleNameMismatchWarn Module
wanted_mod Module
actual_mod

    Left SomeException
exn    -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall err val. err -> MaybeErr err val
Failed (String -> SDoc
text (forall e. Exception e => e -> String
showException SomeException
exn)))

{-
*********************************************************
*                                                       *
        Wired-in interface for GHC.Prim
*                                                       *
*********************************************************
-}

-- See Note [GHC.Prim] in primops.txt.pp.
ghcPrimIface :: ModIface
ghcPrimIface :: ModIface
ghcPrimIface
  = ModIface
empty_iface {
        mi_exports :: [IfaceExport]
mi_exports  = [IfaceExport]
ghcPrimExports,
        mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls    = [],
        mi_fixities :: [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
        mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
empty_iface){ mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
fixities },
        mi_docs :: Maybe Docs
mi_docs = forall a. a -> Maybe a
Just Docs
ghcPrimDeclDocs -- See Note [GHC.Prim Docs]
        }
  where
    empty_iface :: ModIface
empty_iface = Module -> ModIface
emptyFullModIface Module
gHC_PRIM

    -- The fixity listed here for @`seq`@ should match
    -- those in primops.txt.pp (from which Haddock docs are generated).
    fixities :: [(OccName, Fixity)]
fixities = (forall a. NamedThing a => a -> OccName
getOccName Id
seqId, SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
0 FixityDirection
InfixR)
             forall a. a -> [a] -> [a]
: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PrimOp -> Maybe (OccName, Fixity)
mkFixity [PrimOp]
allThePrimOps
    mkFixity :: PrimOp -> Maybe (OccName, Fixity)
mkFixity PrimOp
op = (,) (PrimOp -> OccName
primOpOcc PrimOp
op) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOp -> Maybe Fixity
primOpFixity PrimOp
op

{-
*********************************************************
*                                                      *
\subsection{Statistics}
*                                                      *
*********************************************************
-}

ifaceStats :: ExternalPackageState -> SDoc
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats ExternalPackageState
eps
  = [SDoc] -> SDoc
hcat [String -> SDoc
text String
"Renamer stats: ", SDoc
msg]
  where
    stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
    msg :: SDoc
msg = [SDoc] -> SDoc
vcat
        [Int -> SDoc
int (EpsStats -> Int
n_ifaces_in EpsStats
stats) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"interfaces read",
         [SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_decls_out EpsStats
stats), String -> SDoc
text String
"type/class/variable imported, out of",
                Int -> SDoc
int (EpsStats -> Int
n_decls_in EpsStats
stats), String -> SDoc
text String
"read"],
         [SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_insts_out EpsStats
stats), String -> SDoc
text String
"instance decls imported, out of",
                Int -> SDoc
int (EpsStats -> Int
n_insts_in EpsStats
stats), String -> SDoc
text String
"read"],
         [SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_rules_out EpsStats
stats), String -> SDoc
text String
"rule decls imported, out of",
                Int -> SDoc
int (EpsStats -> Int
n_rules_in EpsStats
stats), String -> SDoc
text String
"read"]
        ]

{-
************************************************************************
*                                                                      *
                Printing interfaces
*                                                                      *
************************************************************************

Note [Name qualification with --show-iface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

In order to disambiguate between identifiers from different modules, we qualify
all names that don't originate in the current module. In order to keep visual
noise as low as possible, we keep local names unqualified.

For some background on this choice see trac #15269.
-}

-- | Read binary interface, and print it out
showIface :: Logger -> DynFlags -> UnitState -> NameCache -> FilePath -> IO ()
showIface :: Logger -> DynFlags -> UnitState -> NameCache -> String -> IO ()
showIface Logger
logger DynFlags
dflags UnitState
unit_state NameCache
name_cache String
filename = do
   let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
       printer :: SDoc -> IO ()
printer = Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg Logger
logger MessageClass
MCOutput SrcSpan
noSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultDumpStyle

   -- skip the hi way check; we don't want to worry about profiled vs.
   -- non-profiled interfaces, for example.
   ModIface
iface <- Profile
-> NameCache
-> CheckHiWay
-> TraceBinIFace
-> String
-> IO ModIface
readBinIface Profile
profile NameCache
name_cache CheckHiWay
IgnoreHiWay ((SDoc -> IO ()) -> TraceBinIFace
TraceBinIFace SDoc -> IO ()
printer) String
filename

   let -- See Note [Name qualification with --show-iface]
       qualifyImportedNames :: Module -> OccName -> QualifyName
qualifyImportedNames Module
mod OccName
_
           | Module
mod forall a. Eq a => a -> a -> Bool
== forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface = QualifyName
NameUnqual
           | Bool
otherwise              = QualifyName
NameNotInScope1
       print_unqual :: PrintUnqualified
print_unqual = (Module -> OccName -> QualifyName)
-> (Module -> Bool) -> QueryQualifyPackage -> PrintUnqualified
QueryQualify Module -> OccName -> QualifyName
qualifyImportedNames
                                   Module -> Bool
neverQualifyModules
                                   QueryQualifyPackage
neverQualifyPackages
   Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg Logger
logger MessageClass
MCDump SrcSpan
noSrcSpan
      forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle (PrintUnqualified -> PprStyle
mkDumpStyle PrintUnqualified
print_unqual)
      forall a b. (a -> b) -> a -> b
$ UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state ModIface
iface

-- | Show a ModIface but don't display details; suitable for ModIfaces stored in
-- the EPT.
pprModIfaceSimple :: UnitState -> ModIface -> SDoc
pprModIfaceSimple :: UnitState -> ModIface -> SDoc
pprModIfaceSimple UnitState
unit_state ModIface
iface =
    forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
    SDoc -> SDoc -> SDoc
$$ UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
    SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> SDoc
pprExport (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface)))

-- | Show a ModIface
--
-- The UnitState is used to pretty-print units
pprModIface :: UnitState -> ModIface -> SDoc
pprModIface :: UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state iface :: ModIface
iface@ModIface{ mi_final_exts :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts = IfaceBackendExts 'ModIfaceFinal
exts }
 = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"interface"
                SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) SDoc -> SDoc -> SDoc
<+> HscSource -> SDoc
pp_hsc_src (forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface)
                SDoc -> SDoc -> SDoc
<+> (if ModIfaceBackend -> Bool
mi_orphan IfaceBackendExts 'ModIfaceFinal
exts then String -> SDoc
text String
"[orphan module]" else SDoc
Outputable.empty)
                SDoc -> SDoc -> SDoc
<+> (if ModIfaceBackend -> Bool
mi_finsts IfaceBackendExts 'ModIfaceFinal
exts then String -> SDoc
text String
"[family instance module]" else SDoc
Outputable.empty)
                SDoc -> SDoc -> SDoc
<+> (if forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
iface then String -> SDoc
text String
"[hpc]" else SDoc
Outputable.empty)
                SDoc -> SDoc -> SDoc
<+> Integer -> SDoc
integer Integer
hiVersion
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"interface hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_iface_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"ABI hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_mod_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"export-list hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_exp_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"orphan hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_orphan_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"flag hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_flag_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"opt_hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_opt_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"hpc_hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_hpc_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"plugin_hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_plugin_hash IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"src_hash:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash ModIface
iface))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"sig of:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface
iface))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"used TH splices:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_used_th ModIface
iface))
        , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"where")
        , String -> SDoc
text String
"exports:"
        , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> SDoc
pprExport (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface)))
        , UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map Usage -> SDoc
pprUsage (forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages ModIface
iface))
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map IfaceAnnotation -> SDoc
pprIfaceAnnotation (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface))
        , [(OccName, Fixity)] -> SDoc
pprFixities (forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities ModIface
iface)
        , [SDoc] -> SDoc
vcat [forall a. Outputable a => a -> SDoc
ppr Fingerprint
ver SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr IfaceDecl
decl) | (Fingerprint
ver,IfaceDecl
decl) <- forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface]
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface))
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface))
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface))
        , forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns ModIface
iface)
        , IfaceTrustInfo -> SDoc
pprTrustInfo (forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface)
        , Bool -> SDoc
pprTrustPkg (forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg ModIface
iface)
        , [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface))
        , String -> SDoc
text String
"docs:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr (forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs ModIface
iface))
        , String -> SDoc
text String
"extensible fields:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (ExtensibleFields -> SDoc
pprExtensibleFields (forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields ModIface
iface))
        ]
  where
    pp_hsc_src :: HscSource -> SDoc
pp_hsc_src HscSource
HsBootFile = String -> SDoc
text String
"[boot]"
    pp_hsc_src HscSource
HsigFile = String -> SDoc
text String
"[hsig]"
    pp_hsc_src HscSource
HsSrcFile = SDoc
Outputable.empty

{-
When printing export lists, we print like this:
        Avail   f               f
        AvailTC C [C, x, y]     C(x,y)
        AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
-}

pprExport :: IfaceExport -> SDoc
pprExport :: IfaceExport -> SDoc
pprExport (Avail GreName
n)      = forall a. Outputable a => a -> SDoc
ppr GreName
n
pprExport (AvailTC Name
_ []) = SDoc
Outputable.empty
pprExport avail :: IfaceExport
avail@(AvailTC Name
n [GreName]
_) =
    forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
<> SDoc
mark SDoc -> SDoc -> SDoc
<> forall {a}. Outputable a => [a] -> SDoc
pp_export (IfaceExport -> [GreName]
availSubordinateGreNames IfaceExport
avail)
  where
    mark :: SDoc
mark | IfaceExport -> Bool
availExportsDecl IfaceExport
avail = SDoc
Outputable.empty
         | Bool
otherwise              = SDoc
vbar

    pp_export :: [a] -> SDoc
pp_export []    = SDoc
Outputable.empty
    pp_export [a]
names = SDoc -> SDoc
braces ([SDoc] -> SDoc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [a]
names))

pprUsage :: Usage -> SDoc
pprUsage :: Usage -> SDoc
pprUsage usage :: Usage
usage@UsagePackageModule{}
  = forall a. Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage Usage -> Module
usg_mod
pprUsage usage :: Usage
usage@UsageHomeModule{}
  = forall a. Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage (\Usage
u -> forall u. u -> ModuleName -> GenModule u
mkModule (Usage -> UnitId
usg_unit_id Usage
u) (Usage -> ModuleName
usg_mod_name Usage
u)) SDoc -> SDoc -> SDoc
$$
    Int -> SDoc -> SDoc
nest Int
2 (
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
Outputable.empty (\Fingerprint
v -> String -> SDoc
text String
"exports: " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Fingerprint
v) (Usage -> Maybe Fingerprint
usg_exports Usage
usage) SDoc -> SDoc -> SDoc
$$
        [SDoc] -> SDoc
vcat [ forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Fingerprint
v | (OccName
n,Fingerprint
v) <- Usage -> [(OccName, Fingerprint)]
usg_entities Usage
usage ]
        )
pprUsage usage :: Usage
usage@UsageFile{}
  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"addDependentFile",
          SDoc -> SDoc
doubleQuotes (String -> SDoc
text (Usage -> String
usg_file_path Usage
usage)),
          forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_file_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageMergedRequirement{}
  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"merged", forall a. Outputable a => a -> SDoc
ppr (Usage -> Module
usg_mod Usage
usage), forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageHomeModuleInterface{}
  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"implementation", forall a. Outputable a => a -> SDoc
ppr (Usage -> ModuleName
usg_mod_name Usage
usage)
                               , forall a. Outputable a => a -> SDoc
ppr (Usage -> UnitId
usg_unit_id Usage
usage)
                               , forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_iface_hash Usage
usage)]

pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport :: forall a. Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage Usage -> a
usg_mod'
  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"import", SDoc
safe, forall a. Outputable a => a -> SDoc
ppr (Usage -> a
usg_mod' Usage
usage),
                       forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
    where
        safe :: SDoc
safe | Usage -> Bool
usg_safe Usage
usage = String -> SDoc
text String
"safe"
             | Bool
otherwise      = String -> SDoc
text String
" -/ "

pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities []    = SDoc
Outputable.empty
pprFixities [(OccName, Fixity)]
fixes = String -> SDoc
text String
"fixities" SDoc -> SDoc -> SDoc
<+> forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprFix [(OccName, Fixity)]
fixes
                  where
                    pprFix :: (a, a) -> SDoc
pprFix (a
occ,a
fix) = forall a. Outputable a => a -> SDoc
ppr a
fix SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr a
occ

pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo IfaceTrustInfo
trust = String -> SDoc
text String
"trusted:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr IfaceTrustInfo
trust

pprTrustPkg :: Bool -> SDoc
pprTrustPkg :: Bool -> SDoc
pprTrustPkg Bool
tpkg = String -> SDoc
text String
"require own pkg trusted:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Bool
tpkg

instance Outputable (Warnings pass) where
    ppr :: Warnings pass -> SDoc
ppr = forall pass. Warnings pass -> SDoc
pprWarns

pprWarns :: Warnings pass -> SDoc
pprWarns :: forall pass. Warnings pass -> SDoc
pprWarns Warnings pass
NoWarnings         = SDoc
Outputable.empty
pprWarns (WarnAll WarningTxt pass
txt)  = String -> SDoc
text String
"Warn all" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr WarningTxt pass
txt
pprWarns (WarnSome [(OccName, WarningTxt pass)]
prs) = String -> SDoc
text String
"Warnings:"
                        SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprWarning [(OccName, WarningTxt pass)]
prs)
    where pprWarning :: (a, a) -> SDoc
pprWarning (a
name, a
txt) = forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr a
txt

pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnotation -> IfaceAnnTarget
ifAnnotatedTarget = IfaceAnnTarget
target, ifAnnotatedValue :: IfaceAnnotation -> AnnPayload
ifAnnotatedValue = AnnPayload
serialized })
  = forall a. Outputable a => a -> SDoc
ppr IfaceAnnTarget
target SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"annotated by" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr AnnPayload
serialized

pprExtensibleFields :: ExtensibleFields -> SDoc
pprExtensibleFields :: ExtensibleFields -> SDoc
pprExtensibleFields (ExtensibleFields Map String BinData
fs) = [SDoc] -> SDoc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String, BinData) -> SDoc
pprField forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
toList Map String BinData
fs
  where
    pprField :: (String, BinData) -> SDoc
pprField (String
name, (BinData Int
size BinArray
_data)) = String -> SDoc
text String
name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"-" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Int
size SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"bytes"