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


Loading interface files
-}

{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Iface.Load (
        -- Importing one thing
        tcLookupImported_maybe, importDecl,
        checkWiredInTyCon, ifCheckWiredInThing,

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

        -- IfM functions
        loadInterface,
        loadSysInterface, loadUserInterface, loadPluginInterface,
        findAndReadIface, readIface, writeIface,
        loadDecls,      -- Should move to GHC.IfaceToCore and be renamed
        initExternalPackageState,
        moduleFreeHolesPrecise,
        needWiredInHomeIface, loadWiredInHomeIface,

        pprModIfaceSimple,
        ifaceStats, pprModIface, showIface
   ) where

#include "HsVersions.h"

import GHC.Prelude

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

import GHC.Driver.Session
import GHC.Driver.Hooks
import GHC.Driver.Plugins

import GHC.Iface.Syntax
import GHC.Iface.Env
import GHC.Driver.Types

import GHC.Types.Basic hiding (SuccessFlag(..))
import GHC.Tc.Utils.Monad

import GHC.Utils.Binary   ( BinData(..) )
import GHC.Settings.Constants
import GHC.Builtin.Names
import GHC.Builtin.Utils
import GHC.Builtin.PrimOps    ( allThePrimOps, primOpFixity, primOpOcc )
import GHC.Types.Id.Make      ( seqId, EnableBignumRules(..) )
import GHC.Core.Rules
import GHC.Core.TyCon
import GHC.Types.Annotations
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Unit.Module
import GHC.Unit.State
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Driver.Finder
import GHC.Types.Unique.FM
import GHC.Types.SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Iface.Binary
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Utils.Fingerprint
import GHC.Types.FieldLabel
import GHC.Iface.Rename
import GHC.Types.Unique.DSet

import Control.Monad
import Control.Exception
import Data.IORef
import Data.Map ( toList )
import System.FilePath
import System.Directory

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

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

importDecl :: Name -> IfM lcl (MaybeErr MsgDoc 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 MsgDoc TyThing)
importDecl Name
name
  = ASSERT( not (isWiredInName name) )
    do  { MsgDoc -> TcRnIf IfGblEnv lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf MsgDoc
nd_doc

        -- Load the interface, which should populate the PTE
        ; MaybeErr MsgDoc ModIface
mb_iface <- ASSERT2( isExternalName name, ppr name )
                      MsgDoc
-> Module
-> WhereFrom
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
nd_doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) WhereFrom
ImportBySystem
        ; case MaybeErr MsgDoc ModIface
mb_iface of {
                Failed MsgDoc
err_msg  -> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc TyThing
forall err val. err -> MaybeErr err val
Failed MsgDoc
err_msg) ;
                Succeeded ModIface
_ -> do

        -- Now look it up again; this time we should find it
        { ExternalPackageState
eps <- TcRnIf IfGblEnv lcl ExternalPackageState
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 -> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing))
-> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall a b. (a -> b) -> a -> b
$ TyThing -> MaybeErr MsgDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing
            Maybe TyThing
Nothing    -> let doc :: MsgDoc
doc = MsgDoc -> MsgDoc
whenPprDebug (ExternalPackageState -> MsgDoc
found_things_msg ExternalPackageState
eps MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
empty)
                                    MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
not_found_msg
                          in MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing))
-> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> MaybeErr MsgDoc TyThing
forall err val. err -> MaybeErr err val
Failed MsgDoc
doc
    }}}
  where
    nd_doc :: MsgDoc
nd_doc = String -> MsgDoc
text String
"Need decl for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name
    not_found_msg :: MsgDoc
not_found_msg = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Can't find interface-file declaration for" MsgDoc -> MsgDoc -> MsgDoc
<+>
                                NameSpace -> MsgDoc
pprNameSpace (Name -> NameSpace
nameNameSpace Name
name) MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name)
                       Int
2 ([MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"Probable cause: bug in .hi-boot file, or inconsistent .hi file",
                                String -> MsgDoc
text String
"Use -ddump-if-trace to get an idea of which file caused the error"])
    found_things_msg :: ExternalPackageState -> MsgDoc
found_things_msg ExternalPackageState
eps =
        MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Found the following declarations in" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon)
           Int
2 ([MsgDoc] -> MsgDoc
vcat ((TyThing -> MsgDoc) -> [TyThing] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ([TyThing] -> [MsgDoc]) -> [TyThing] -> [MsgDoc]
forall a b. (a -> b) -> a -> b
$ (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filter TyThing -> Bool
is_interesting ([TyThing] -> [TyThing]) -> [TyThing] -> [TyThing]
forall a b. (a -> b) -> a -> b
$ TypeEnv -> [TyThing]
forall a. NameEnv a -> [a]
nameEnvElts (TypeEnv -> [TyThing]) -> TypeEnv -> [TyThing]
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
Name -> Module
nameModule Name
name Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule (TyThing -> Name
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 -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkWiredInTyCon TyCon
tc
  | Bool -> Bool
not (Name -> Bool
isWiredInName Name
tc_name)
  = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise
  = do  { Module
mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
        ; MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"checkWiredInTyCon" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
tc_name MsgDoc -> MsgDoc -> MsgDoc
$$ Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod)
        ; ASSERT( isExternalName tc_name )
          Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
tc_name)
               (IfG () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG ()
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 = TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing
        ; ASSERT2( isExternalName name, ppr name )
          Bool -> IfL () -> IfL ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyThing -> Bool
needWiredInHomeIface TyThing
thing Bool -> Bool -> Bool
&& Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
               (Name -> IfL ()
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 #-} ?
                 -> Maybe FastString    -- "package", if any
                 -> RnM ModIface

loadSrcInterface :: MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface MsgDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
maybe_pkg
  = do { MaybeErr MsgDoc ModIface
res <- MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe MsgDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
maybe_pkg
       ; case MaybeErr MsgDoc ModIface
res of
           Failed MsgDoc
err      -> MsgDoc -> RnM ModIface
forall a. MsgDoc -> TcM a
failWithTc MsgDoc
err
           Succeeded ModIface
iface -> ModIface -> RnM ModIface
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
iface }

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

loadSrcInterface_maybe :: MsgDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe MsgDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
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 <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
       ; FindResult
res <- IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult)
-> IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod Maybe FastString
maybe_pkg
       ; case FindResult
res of
           Found ModLocation
_ Module
mod -> IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface)
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface))
-> IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> WhereFrom -> IfG (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc Module
mod (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
want_boot)
           -- TODO: Make sure this error message is good
           FindResult
err         -> MaybeErr MsgDoc ModIface -> RnM (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed (DynFlags -> ModuleName -> FindResult -> MsgDoc
cannotFindModule (HscEnv -> DynFlags
hsc_dflags 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 :: MsgDoc -> Module -> RnM ModIface
loadModuleInterface MsgDoc
doc Module
mod = IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc Module
mod)

-- | Load interfaces for a collection of modules.
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces :: MsgDoc -> [Module] -> IOEnv (Env TcGblEnv TcLclEnv) ()
loadModuleInterfaces MsgDoc
doc [Module]
mods
  | [Module] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
mods = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = IfG () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IfG a -> TcRn a
initIfaceTcRn ((Module -> IfG ModIface) -> [Module] -> IfG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Module -> IfG ModIface
load [Module]
mods)
  where
    load :: Module -> IfG ModIface
load Module
mod = MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface (MsgDoc
doc MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
parens (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 :: MsgDoc -> Name -> RnM ModIface
loadInterfaceForName MsgDoc
doc Name
name
  = do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$  -- Check pre-condition
         do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
            ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) }
      ; ASSERT2( isExternalName name, ppr name )
        IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModIface -> RnM ModIface) -> IfG ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) }

-- | Only loads the interface for external non-local names.
loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe :: MsgDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe MsgDoc
doc Name
name
  = do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
       ; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name Bool -> Bool -> Bool
|| Bool -> Bool
not (Name -> Bool
isExternalName Name
name)
         then Maybe ModIface -> TcRn (Maybe ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModIface
forall a. Maybe a
Nothing
         else ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just (ModIface -> Maybe ModIface)
-> RnM ModIface -> TcRn (Maybe ModIface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModIface -> RnM ModIface) -> IfG ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name))
       }

-- | Loads the interface for a given Module.
loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
loadInterfaceForModule :: MsgDoc -> Module -> RnM ModIface
loadInterfaceForModule MsgDoc
doc Module
m
  = do
    -- Should not be called with this module
    Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
      Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
      MASSERT2( this_mod /= m, ppr m <+> parens doc )
    IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModIface -> RnM ModIface) -> IfG ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
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
  = ASSERT( isWiredInName name )
    do ModIface
_ <- MsgDoc -> Module -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name); () -> IfM lcl ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    doc :: MsgDoc
doc = String -> MsgDoc
text String
"Need home interface for wired-in thing" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name

------------------
-- | Loads a system interface and throws an exception if it fails
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface :: forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc Module
mod_name = MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
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 -> MsgDoc -> Module -> IfM lcl ModIface
loadUserInterface IsBootInterface
is_boot MsgDoc
doc Module
mod_name
  = MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
doc Module
mod_name (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
is_boot)

loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
loadPluginInterface :: forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadPluginInterface MsgDoc
doc Module
mod_name
  = MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
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. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
doc Module
mod_name WhereFrom
where_from
  = TcRnIf IfGblEnv lcl (MaybeErr MsgDoc ModIface)
-> TcRnIf IfGblEnv lcl ModIface
forall gbl lcl a.
TcRnIf gbl lcl (MaybeErr MsgDoc a) -> TcRnIf gbl lcl a
withException (MsgDoc
-> Module
-> WhereFrom
-> TcRnIf IfGblEnv lcl (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc Module
mod_name WhereFrom
where_from)

------------------
loadInterface :: SDoc -> Module -> WhereFrom
              -> IfM lcl (MaybeErr MsgDoc 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.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc_str Module
mod WhereFrom
from
  | Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
  -- Hole modules get special treatment
  = do DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       -- Redo search for our local hole module
       MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc_str (DynFlags -> ModuleName -> Module
mkHomeModule DynFlags
dflags (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)) WhereFrom
from
  | Bool
otherwise
  = MsgDoc
-> (MaybeErr MsgDoc ModIface -> ())
-> IfM lcl (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a.
(MonadIO m, HasDynFlags m) =>
MsgDoc -> (a -> ()) -> m a -> m a
withTimingSilentD (String -> MsgDoc
text String
"loading interface") (() -> MaybeErr MsgDoc ModIface -> ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IfM lcl (MaybeErr MsgDoc ModIface)
 -> IfM lcl (MaybeErr MsgDoc ModIface))
-> IfM lcl (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$
    do  {       -- Read the state
          (ExternalPackageState
eps,HomePackageTable
hpt) <- TcRnIf IfGblEnv lcl (ExternalPackageState, HomePackageTable)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
        ; IfGblEnv
gbl_env <- TcRnIf IfGblEnv lcl IfGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv

        ; MsgDoc -> TcRnIf IfGblEnv lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"Considering whether to load" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod MsgDoc -> MsgDoc -> MsgDoc
<+> WhereFrom -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr WhereFrom
from)

                -- Check whether we have the interface already
        ; DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; case HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of {
            Just ModIface
iface
                -> MaybeErr MsgDoc ModIface -> IfM lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
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 MsgDoc (ModIface, String)
read_result <- case (DynFlags
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr MsgDoc IsBootInterface
wantHiBootFile DynFlags
dflags ExternalPackageState
eps Module
mod WhereFrom
from) of
                           Failed MsgDoc
err             -> MaybeErr MsgDoc (ModIface, String)
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
                           Succeeded IsBootInterface
hi_boot_file -> MsgDoc
-> IsBootInterface
-> Module
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> IsBootInterface
-> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
computeInterface MsgDoc
doc_str IsBootInterface
hi_boot_file Module
mod
        ; case MaybeErr MsgDoc (ModIface, String)
read_result of {
            Failed MsgDoc
err -> do
                { let fake_iface :: ModIface
fake_iface = Module -> ModIface
emptyFullModIface Module
mod

                ; (ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv lcl ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ ((ExternalPackageState -> ExternalPackageState)
 -> TcRnIf IfGblEnv lcl ())
-> (ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv lcl ()
forall a b. (a -> b) -> a -> b
$ \ExternalPackageState
eps ->
                        ExternalPackageState
eps { eps_PIT :: PackageIfaceTable
eps_PIT = PackageIfaceTable -> Module -> ModIface -> PackageIfaceTable
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) (ModIface -> Module
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

                ; MaybeErr MsgDoc ModIface -> IfM lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed MsgDoc
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 :: MsgDoc
loc_doc = String -> MsgDoc
text String
loc
        in
        Module
-> MsgDoc
-> IsBootInterface
-> IfL (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall a lcl.
Module -> MsgDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface) MsgDoc
loc_doc (ModIface -> IsBootInterface
mi_boot ModIface
iface) (IfL (MaybeErr MsgDoc ModIface)
 -> IfM lcl (MaybeErr MsgDoc ModIface))
-> IfL (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ do

        IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc ModIface)
forall a. IfL a -> IfL a
dontLeakTheHPT (IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc ModIface))
-> IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc ModIface)
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 loadDecl, 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)

        ; Bool
ignore_prags      <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
        ; [(Name, TyThing)]
new_eps_decls     <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
        ; [ClsInst]
new_eps_insts     <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
        ; [FamInst]
new_eps_fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
        ; [CoreRule]
new_eps_rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
        ; [Annotation]
new_eps_anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
        ; [CompleteMatch]
new_eps_complete_sigs <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface)

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

        ; let bad_boot :: Bool
bad_boot = ModIface -> IsBootInterface
mi_boot ModIface
iface IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot Bool -> Bool -> Bool
&& ((Module, IfG TypeEnv) -> Module)
-> Maybe (Module, IfG TypeEnv) -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, IfG TypeEnv) -> Module
forall a b. (a, b) -> a
fst (IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env) Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just 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]

        ; WARN( bad_boot, ppr mod )
          (ExternalPackageState -> ExternalPackageState) -> IfL ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_  ((ExternalPackageState -> ExternalPackageState) -> IfL ())
-> (ExternalPackageState -> ExternalPackageState) -> IfL ()
forall a b. (a -> b) -> a -> b
$ \ ExternalPackageState
eps ->
           if Module -> PackageIfaceTable -> Bool
forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
mod (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Bool -> Bool -> Bool
|| DynFlags -> ModIface -> Bool
is_external_sig DynFlags
dflags 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          = PackageIfaceTable -> Module -> ModIface -> PackageIfaceTable
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 :: PackageCompleteMatchMap
eps_complete_matches
                                   = PackageCompleteMatchMap
-> [CompleteMatch] -> PackageCompleteMatchMap
extendCompleteMatchMap
                                         (ExternalPackageState -> PackageCompleteMatchMap
eps_complete_matches ExternalPackageState
eps)
                                         [CompleteMatch]
new_eps_complete_sigs,
                  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
                                     ModuleEnv PackageFamInstEnv
-> Module -> PackageFamInstEnv -> ModuleEnv PackageFamInstEnv
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)
                                                   ([(Name, TyThing)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, TyThing)]
new_eps_decls)
                                                   ([ClsInst] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
new_eps_insts)
                                                   ([CoreRule] -> Int
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 <- DynFlags
-> PluginOperation (IOEnv (Env IfGblEnv IfLclEnv)) ModIface
-> ModIface
-> IOEnv (Env IfGblEnv IfLclEnv) ModIface
forall (m :: * -> *) a.
Monad m =>
DynFlags -> PluginOperation m a -> a -> m a
withPlugins DynFlags
dflags (\Plugin
p -> Plugin -> forall lcl. [String] -> ModIface -> IfM lcl ModIface
interfaceLoadAction Plugin
p) ModIface
iface
        ; MaybeErr MsgDoc ModIface -> IfL (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
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.
-}

dontLeakTheHPT :: IfL a -> IfL a
dontLeakTheHPT :: forall a. IfL a -> IfL a
dontLeakTheHPT IfL a
thing_inside = do
  let
    cleanTopEnv :: HscEnv -> HscEnv
cleanTopEnv HscEnv{[Target]
Maybe (Module, IORef TypeEnv)
Maybe Interp
IORef FinderCache
IORef NameCache
IORef ExternalPackageState
DynFlags
HomePackageTable
DynLinker
InteractiveContext
ModuleGraph
hsc_type_env_var :: HscEnv -> Maybe (Module, IORef TypeEnv)
hsc_targets :: HscEnv -> [Target]
hsc_mod_graph :: HscEnv -> ModuleGraph
hsc_interp :: HscEnv -> Maybe Interp
hsc_dynLinker :: HscEnv -> DynLinker
hsc_NC :: HscEnv -> IORef NameCache
hsc_IC :: HscEnv -> InteractiveContext
hsc_HPT :: HscEnv -> HomePackageTable
hsc_FC :: HscEnv -> IORef FinderCache
hsc_EPS :: HscEnv -> IORef ExternalPackageState
hsc_dynLinker :: DynLinker
hsc_interp :: Maybe Interp
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_FC :: IORef FinderCache
hsc_NC :: IORef NameCache
hsc_EPS :: IORef ExternalPackageState
hsc_HPT :: HomePackageTable
hsc_IC :: InteractiveContext
hsc_mod_graph :: ModuleGraph
hsc_targets :: [Target]
hsc_dflags :: DynFlags
hsc_dflags :: HscEnv -> DynFlags
..} =
       let
         -- 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.
         keepFor20509 :: HomeModInfo -> Bool
keepFor20509 HomeModInfo
hmi
          | Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi)) = Bool
True
          | Bool
otherwise = Bool
False
         !hpt :: HomePackageTable
hpt | (HomeModInfo -> Bool) -> HomePackageTable -> Bool
anyHpt HomeModInfo -> Bool
keepFor20509 HomePackageTable
hsc_HPT  = HomePackageTable
hsc_HPT
              | Bool
otherwise = HomePackageTable
emptyHomePackageTable
       in
       HscEnv :: DynFlags
-> [Target]
-> ModuleGraph
-> InteractiveContext
-> HomePackageTable
-> IORef ExternalPackageState
-> IORef NameCache
-> IORef FinderCache
-> Maybe (Module, IORef TypeEnv)
-> Maybe Interp
-> DynLinker
-> HscEnv
HscEnv {  hsc_targets :: [Target]
hsc_targets      = String -> [Target]
forall a. String -> a
panic String
"cleanTopEnv: hsc_targets"
              ,  hsc_mod_graph :: ModuleGraph
hsc_mod_graph    = String -> ModuleGraph
forall a. String -> a
panic String
"cleanTopEnv: hsc_mod_graph"
              ,  hsc_IC :: InteractiveContext
hsc_IC           = String -> InteractiveContext
forall a. String -> a
panic String
"cleanTopEnv: hsc_IC"
              ,  hsc_HPT :: HomePackageTable
hsc_HPT          = HomePackageTable
hpt
              , Maybe (Module, IORef TypeEnv)
Maybe Interp
IORef FinderCache
IORef NameCache
IORef ExternalPackageState
DynFlags
DynLinker
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_interp :: Maybe Interp
hsc_dynLinker :: DynLinker
hsc_NC :: IORef NameCache
hsc_FC :: IORef FinderCache
hsc_EPS :: IORef ExternalPackageState
hsc_dynLinker :: DynLinker
hsc_interp :: Maybe Interp
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_FC :: IORef FinderCache
hsc_NC :: IORef NameCache
hsc_EPS :: IORef ExternalPackageState
hsc_dflags :: DynFlags
hsc_dflags :: DynFlags
.. }

  (HscEnv -> HscEnv) -> IfL a -> IfL a
forall gbl lcl a.
(HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updTopEnv HscEnv -> HscEnv
cleanTopEnv (IfL a -> IfL a) -> IfL a -> IfL a
forall a b. (a -> b) -> a -> b
$ do
  !HscEnv
_ <- TcRnIf IfGblEnv IfLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv        -- force the updTopEnv
  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 :: DynFlags -> ModIface -> Bool
is_external_sig :: DynFlags -> ModIface -> Bool
is_external_sig DynFlags
dflags ModIface
iface =
    -- It's a signature iface...
    ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface Bool -> Bool -> Bool
&&
    -- and it's not from the local package
    Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> Unit
homeUnit DynFlags
dflags

-- | 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 ::
       SDoc -> IsBootInterface -> Module
    -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
computeInterface :: forall gbl lcl.
MsgDoc
-> IsBootInterface
-> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
computeInterface MsgDoc
doc_str IsBootInterface
hi_boot_file Module
mod0 = do
    MASSERT( not (isHoleModule mod0) )
    DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod0 of
        (InstalledModule
imod, Just InstantiatedModule
indef) | DynFlags -> Bool
homeUnitIsIndefinite DynFlags
dflags -> do
            MaybeErr MsgDoc (ModIface, String)
r <- MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface MsgDoc
doc_str InstalledModule
imod Module
mod0 IsBootInterface
hi_boot_file
            case MaybeErr MsgDoc (ModIface, String)
r of
                Succeeded (ModIface
iface0, String
path) -> do
                    HscEnv
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
                    Either ErrorMessages ModIface
r <- IO (Either ErrorMessages ModIface)
-> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ErrorMessages ModIface)
 -> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface))
-> IO (Either ErrorMessages ModIface)
-> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface)
forall a b. (a -> b) -> a -> b
$
                        HscEnv
-> [(ModuleName, Module)]
-> Maybe NameShape
-> ModIface
-> IO (Either ErrorMessages ModIface)
rnModIface HscEnv
hsc_env (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef))
                                   Maybe NameShape
forall a. Maybe a
Nothing ModIface
iface0
                    case Either ErrorMessages ModIface
r of
                        Right ModIface
x -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
x, String
path))
                        Left ErrorMessages
errs -> IO (MaybeErr MsgDoc (ModIface, String))
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MaybeErr MsgDoc (ModIface, String))
 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String)))
-> (ErrorMessages -> IO (MaybeErr MsgDoc (ModIface, String)))
-> ErrorMessages
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> IO (MaybeErr MsgDoc (ModIface, String))
forall e a. Exception e => e -> IO a
throwIO (SourceError -> IO (MaybeErr MsgDoc (ModIface, String)))
-> (ErrorMessages -> SourceError)
-> ErrorMessages
-> IO (MaybeErr MsgDoc (ModIface, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> SourceError
mkSrcErr (ErrorMessages
 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String)))
-> ErrorMessages
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ ErrorMessages
errs
                Failed MsgDoc
err -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
        (InstalledModule
mod, Maybe InstantiatedModule
_) ->
            MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface MsgDoc
doc_str InstalledModule
mod Module
mod0 IsBootInterface
hi_boot_file

-- | 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 MsgDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise :: forall gbl lcl.
MsgDoc
-> Module -> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise MsgDoc
doc_str Module
mod
 | Module -> Bool
moduleIsDefinite Module
mod = MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
 | Bool
otherwise =
   case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod of
    (InstalledModule
imod, Just InstantiatedModule
indef) -> do
        let insts :: [(ModuleName, Module)]
insts = GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)
        MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"Considering whether to load" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod MsgDoc -> MsgDoc -> MsgDoc
<+>
                 String -> MsgDoc
text String
"to compute precise free module holes")
        (ExternalPackageState
eps, HomePackageTable
hpt) <- TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
        case ExternalPackageState
-> HomePackageTable -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomePackageTable
hpt Maybe (UniqDSet ModuleName)
-> Maybe (UniqDSet ModuleName) -> Maybe (UniqDSet ModuleName)
forall a. Maybe a -> Maybe a -> Maybe a
`firstJust` ExternalPackageState
-> InstalledModule
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps InstalledModule
imod [(ModuleName, Module)]
insts of
            Just UniqDSet ModuleName
r -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
r)
            Maybe (UniqDSet ModuleName)
Nothing -> InstalledModule
-> [(ModuleName, Module)]
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
readAndCache InstalledModule
imod [(ModuleName, Module)]
insts
    (InstalledModule
_, Maybe InstantiatedModule
Nothing) -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
  where
    tryEpsAndHpt :: ExternalPackageState
-> HomePackageTable -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomePackageTable
hpt =
        (ModIface -> UniqDSet ModuleName)
-> Maybe ModIface -> Maybe (UniqDSet ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModIface -> UniqDSet ModuleName
mi_free_holes (HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod)
    tryDepsCache :: ExternalPackageState
-> InstalledModule
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps InstalledModule
imod [(ModuleName, Module)]
insts =
        case InstalledModuleEnv (UniqDSet ModuleName)
-> InstalledModule -> Maybe (UniqDSet ModuleName)
forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) InstalledModule
imod of
            Just UniqDSet ModuleName
ifhs  -> UniqDSet ModuleName -> Maybe (UniqDSet ModuleName)
forall a. a -> Maybe a
Just (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts)
            Maybe (UniqDSet ModuleName)
_otherwise -> Maybe (UniqDSet ModuleName)
forall a. Maybe a
Nothing
    readAndCache :: InstalledModule
-> [(ModuleName, Module)]
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
readAndCache InstalledModule
imod [(ModuleName, Module)]
insts = do
        MaybeErr MsgDoc (ModIface, String)
mb_iface <- MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface (String -> MsgDoc
text String
"moduleFreeHolesPrecise" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
doc_str) InstalledModule
imod Module
mod IsBootInterface
NotBoot
        case MaybeErr MsgDoc (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
                (ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\ExternalPackageState
eps ->
                    ExternalPackageState
eps { eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes = InstalledModuleEnv (UniqDSet ModuleName)
-> InstalledModule
-> UniqDSet ModuleName
-> InstalledModuleEnv (UniqDSet ModuleName)
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) InstalledModule
imod UniqDSet ModuleName
ifhs })
                MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts))
            Failed MsgDoc
err -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)

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

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

       WhereFrom
ImportBySystem
          | Bool -> Bool
not Bool
this_package   -- If the module to be imported is not from this package
          -> IsBootInterface -> MaybeErr MsgDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot -- 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 UniqFM ModuleName ModuleNameWithIsBoot
-> ModuleName -> Maybe ModuleNameWithIsBoot
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> UniqFM ModuleName ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
                Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) ->
                  IsBootInterface -> MaybeErr MsgDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
is_boot
                Maybe ModuleNameWithIsBoot
Nothing ->
                  IsBootInterface -> MaybeErr MsgDoc IsBootInterface
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
  where
    this_package :: Bool
this_package = DynFlags -> Unit
homeUnit DynFlags
dflags Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod

badSourceImport :: Module -> SDoc
badSourceImport :: Module -> MsgDoc
badSourceImport Module
mod
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"You cannot {-# SOURCE #-} import a module from another package")
       Int
2 (String -> MsgDoc
text String
"but" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"is from package")
          MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Module -> Unit
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 = TypeEnv -> [(Name, TyThing)] -> TypeEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
pte [(Name, TyThing)]
things

loadDecls :: Bool
          -> [(Fingerprint, IfaceDecl)]
          -> IfL [(Name,TyThing)]
loadDecls :: Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags [(Fingerprint, IfaceDecl)]
ver_decls
   = ((Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)])
-> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
loadDecl Bool
ignore_prags) [(Fingerprint, IfaceDecl)]
ver_decls

loadDecl :: Bool                    -- Don't load pragmas into the decl pool
          -> (Fingerprint, IfaceDecl)
          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
                                    -- TyThings are forkM'd thunks
loadDecl :: Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
loadDecl Bool
ignore_prags (Fingerprint
_version, IfaceDecl
decl)
  = do  {       -- Populate the name cache with final versions of all
                -- the names associated with the decl
          let main_name :: Name
main_name = IfaceDecl -> Name
ifName IfaceDecl
decl

        -- Typecheck the thing, lazily
        -- NB. Firstly, the laziness is there in case we never need the
        -- declaration (in one-shot mode), and secondly it is there so that
        -- we don't look up the occurrence of a name before calling mk_new_bndr
        -- on the binder.  This is important because we must get the right name
        -- which includes its nameParent.

        ; TyThing
thing <- MsgDoc -> IfL TyThing -> IfL TyThing
forall a. MsgDoc -> IfL a -> IfL a
forkM MsgDoc
doc (IfL TyThing -> IfL TyThing) -> IfL TyThing -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ do { Name -> IfL ()
bumpDeclStats Name
main_name
                                  ; Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
ignore_prags IfaceDecl
decl }

        -- Populate the type environment with the implicitTyThings too.
        --
        -- Note [Tricky iface loop]
        -- ~~~~~~~~~~~~~~~~~~~~~~~~
        -- Summary: The delicate point here is that 'mini-env' must be
        -- buildable from 'thing' without demanding any of the things
        -- 'forkM'd by tcIfaceDecl.
        --
        -- In more detail: Consider the example
        --      data T a = MkT { x :: T a }
        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
        -- (plus their workers, wrappers, coercions etc etc)
        --
        -- We want to return an environment
        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
        -- (where the "MkT" is the *Name* associated with MkT, etc.)
        --
        -- We do this by mapping the implicit_names to the associated
        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
        -- implicitTyThings, we can use getOccName on the implicit
        -- TyThings to make this association: each Name's OccName should
        -- be the OccName of exactly one implicitTyThing.  So the key is
        -- to define a "mini-env"
        --
        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
        -- where the 'MkT' here is the *OccName* associated with MkT.
        --
        -- However, there is a subtlety: due to how type checking needs
        -- to be staged, we can't poke on the forkM'd thunks inside the
        -- implicitTyThings while building this mini-env.
        -- If we poke these thunks too early, two problems could happen:
        --    (1) When processing mutually recursive modules across
        --        hs-boot boundaries, poking too early will do the
        --        type-checking before the recursive knot has been tied,
        --        so things will be type-checked in the wrong
        --        environment, and necessary variables won't be in
        --        scope.
        --
        --    (2) Looking up one OccName in the mini_env will cause
        --        others to be looked up, which might cause that
        --        original one to be looked up again, and hence loop.
        --
        -- The code below works because of the following invariant:
        -- getOccName on a TyThing does not force the suspended type
        -- checks in order to extract the name. For example, we don't
        -- poke on the "T a" type of <selector x> on the way to
        -- extracting <selector x>'s OccName. Of course, there is no
        -- reason in principle why getting the OccName should force the
        -- thunks, but this means we need to be careful in
        -- implicitTyThings and its helper functions.
        --
        -- All a bit too finely-balanced for my liking.

        -- This mini-env and lookup function mediates between the
        --'Name's n and the map from 'OccName's to the implicit TyThings
        ; let mini_env :: OccEnv TyThing
mini_env = [(OccName, TyThing)] -> OccEnv TyThing
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyThing
t, TyThing
t) | TyThing
t <- TyThing -> [TyThing]
implicitTyThings TyThing
thing]
              lookup :: Name -> TyThing
lookup Name
n = case OccEnv TyThing -> OccName -> Maybe TyThing
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv TyThing
mini_env (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n) of
                           Just TyThing
thing -> TyThing
thing
                           Maybe TyThing
Nothing    ->
                             String -> MsgDoc -> TyThing
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"loadDecl" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
main_name MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n MsgDoc -> MsgDoc -> MsgDoc
$$ IfaceDecl -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (IfaceDecl
decl))

        ; [Name]
implicit_names <- (OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name)
-> [OccName] -> IOEnv (Env IfGblEnv IfLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
lookupIfaceTop (IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
decl)

--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
        ; [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> IfL [(Name, TyThing)])
-> [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall a b. (a -> b) -> a -> b
$ (Name
main_name, TyThing
thing) (Name, TyThing) -> [(Name, TyThing)] -> [(Name, TyThing)]
forall a. a -> [a] -> [a]
:
                      -- uses the invariant that implicit_names and
                      -- implicitTyThings are bijective
                      [(Name
n, Name -> TyThing
lookup Name
n) | Name
n <- [Name]
implicit_names]
        }
  where
    doc :: MsgDoc
doc = String -> MsgDoc
text String
"Declaration for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (IfaceDecl -> Name
ifName IfaceDecl
decl)

bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
bumpDeclStats :: Name -> IfL ()
bumpDeclStats Name
name
  = do  { MsgDoc -> IfL ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"Loading decl for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name)
        ; (ExternalPackageState -> ExternalPackageState) -> IfL ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\ExternalPackageState
eps -> let stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
                              in ExternalPackageState
eps { eps_stats :: EpsStats
eps_stats = EpsStats
stats { n_decls_out :: Int
n_decls_out = EpsStats -> Int
n_decls_out EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 } })
        }

{-
*********************************************************
*                                                      *
\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.Types).

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 :: SDoc
                 -- The unique identifier of the on-disk module we're
                 -- looking for
                 -> InstalledModule
                 -- The *actual* module we're looking for.  We use
                 -- this to check the consistency of the requirements
                 -- of the module we read out.
                 -> Module
                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                        -- False <=> Look for .hi file
                 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed

        -- It *doesn't* add an error to the monad, because
        -- sometimes it's ok to fail... see notes with loadInterface
findAndReadIface :: forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface MsgDoc
doc_str InstalledModule
mod Module
wanted_mod_with_insts IsBootInterface
hi_boot_file
  = do MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf ([MsgDoc] -> MsgDoc
sep [[MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text String
"Reading",
                           if IsBootInterface
hi_boot_file IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
                             then String -> MsgDoc
text String
"[boot]"
                             else MsgDoc
Outputable.empty,
                           String -> MsgDoc
text String
"interface for",
                           InstalledModule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr InstalledModule
mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
semi],
                     Int -> MsgDoc -> MsgDoc
nest Int
4 (String -> MsgDoc
text String
"reason:" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
doc_str)])

       -- Check for GHC.Prim, and return its static interface
       -- TODO: make this check a function
       if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
           then do
               ModIface
iface <- (Hooks -> Maybe ModIface)
-> ModIface -> IOEnv (Env gbl lcl) ModIface
forall (f :: * -> *) a.
(Functor f, HasDynFlags f) =>
(Hooks -> Maybe a) -> a -> f a
getHooked Hooks -> Maybe ModIface
ghcPrimIfaceHook ModIface
ghcPrimIface
               MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface,
                                   String
"<built in interface for GHC.Prim>"))
           else do
               DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
               -- Look for the file
               HscEnv
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
               InstalledFindResult
mb_found <- IO InstalledFindResult -> IOEnv (Env gbl lcl) InstalledFindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule HscEnv
hsc_env InstalledModule
mod)
               case InstalledFindResult
mb_found of
                   InstalledFound ModLocation
loc InstalledModule
mod -> do
                       -- Found file, so read it
                       let file_path :: String
file_path = IsBootInterface -> String -> String
addBootSuffix_maybe IsBootInterface
hi_boot_file
                                                           (ModLocation -> String
ml_hi_file ModLocation
loc)

                       -- See Note [Home module load error]
                       if InstalledModule -> UnitId
forall unit. GenModule unit -> unit
moduleUnit InstalledModule
mod UnitId -> Unit -> Bool
`unitIdEq` DynFlags -> Unit
homeUnit DynFlags
dflags Bool -> Bool -> Bool
&&
                          Bool -> Bool
not (GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
                           then MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (InstalledModule -> ModLocation -> MsgDoc
homeModError InstalledModule
mod ModLocation
loc))
                           else do MaybeErr MsgDoc (ModIface, String)
r <- String -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
read_file String
file_path
                                   MaybeErr MsgDoc (ModIface, String) -> TcRnIf gbl lcl ()
checkBuildDynamicToo MaybeErr MsgDoc (ModIface, String)
r
                                   MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeErr MsgDoc (ModIface, String)
r
                   InstalledFindResult
err -> do
                       MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"...not found")
                       DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                       MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (DynFlags -> ModuleName -> InstalledFindResult -> MsgDoc
cannotFindInterface DynFlags
dflags
                                           (InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod) InstalledFindResult
err))
    where read_file :: String -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
read_file String
file_path = do
              MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"readIFace" MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
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!
              DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
              let wanted_mod :: Module
wanted_mod =
                    case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
wanted_mod_with_insts of
                        (InstalledModule
_, Maybe InstantiatedModule
Nothing) -> Module
wanted_mod_with_insts
                        (InstalledModule
_, Just InstantiatedModule
indef_mod) ->
                          UnitState -> InstantiatedModule -> Module
instModuleToModule (DynFlags -> UnitState
unitState DynFlags
dflags)
                            (InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule InstantiatedModule
indef_mod)
              MaybeErr MsgDoc ModIface
read_result <- Module -> String -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall gbl lcl.
Module -> String -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
readIface Module
wanted_mod String
file_path
              case MaybeErr MsgDoc ModIface
read_result of
                Failed MsgDoc
err -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (String -> MsgDoc -> MsgDoc
badIfaceFile String
file_path MsgDoc
err))
                Succeeded ModIface
iface -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
file_path))
                            -- Don't forget to fill in the package name...
          checkBuildDynamicToo :: MaybeErr MsgDoc (ModIface, String) -> TcRnIf gbl lcl ()
checkBuildDynamicToo (Succeeded (ModIface
iface, String
filePath)) = do
              DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
              -- Indefinite interfaces are ALWAYS non-dynamic, and
              -- that's OK.
              let is_definite_iface :: Bool
is_definite_iface = Module -> Bool
moduleIsDefinite (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
              Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
is_definite_iface (TcRnIf gbl lcl () -> TcRnIf gbl lcl ())
-> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall a b. (a -> b) -> a -> b
$
                DynFlags -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall (m :: * -> *). MonadIO m => DynFlags -> m () -> m ()
whenGeneratingDynamicToo DynFlags
dflags (TcRnIf gbl lcl () -> TcRnIf gbl lcl ())
-> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall a b. (a -> b) -> a -> b
$ TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
withDoDynamicToo (TcRnIf gbl lcl () -> TcRnIf gbl lcl ())
-> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
forall a b. (a -> b) -> a -> b
$ do
                  let ref :: IORef Bool
ref = DynFlags -> IORef Bool
canGenerateDynamicToo DynFlags
dflags
                      dynFilePath :: String
dynFilePath = IsBootInterface -> String -> String
addBootSuffix_maybe IsBootInterface
hi_boot_file
                                  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceExtension String
filePath (DynFlags -> String
dynHiSuf DynFlags
dflags)
                  MaybeErr MsgDoc (ModIface, String)
r <- String -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
read_file String
dynFilePath
                  case MaybeErr MsgDoc (ModIface, String)
r of
                      Succeeded (ModIface
dynIface, String
_)
                       | ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
dynIface) ->
                          () -> TcRnIf gbl lcl ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                       | Bool
otherwise ->
                          do MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"Dynamic hash doesn't match")
                             IO () -> TcRnIf gbl lcl ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TcRnIf gbl lcl ()) -> IO () -> TcRnIf gbl lcl ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
                      Failed MsgDoc
err ->
                          do MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text String
"Failed to load dynamic interface file:" MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
err)
                             IO () -> TcRnIf gbl lcl ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TcRnIf gbl lcl ()) -> IO () -> TcRnIf gbl lcl ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
          checkBuildDynamicToo MaybeErr MsgDoc (ModIface, String)
_ = () -> TcRnIf gbl lcl ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Write interface file
writeIface :: DynFlags -> FilePath -> ModIface -> IO ()
writeIface :: DynFlags -> String -> ModIface -> IO ()
writeIface DynFlags
dflags String
hi_file_path ModIface
new_iface
    = do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
hi_file_path)
         DynFlags -> String -> ModIface -> IO ()
writeBinIface DynFlags
dflags String
hi_file_path ModIface
new_iface

-- @readIface@ tries just the one file.
readIface :: Module -> FilePath
          -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
        -- Failed err    <=> file not found, or unreadable, or illegible
        -- Succeeded iface <=> successfully found and parsed

readIface :: forall gbl lcl.
Module -> String -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
readIface Module
wanted_mod String
file_path
  = do  { Either SomeException ModIface
res <- IOEnv (Env gbl lcl) ModIface
-> IOEnv (Env gbl lcl) (Either SomeException ModIface)
forall env r. IOEnv env r -> IOEnv env (Either SomeException r)
tryMostM (IOEnv (Env gbl lcl) ModIface
 -> IOEnv (Env gbl lcl) (Either SomeException ModIface))
-> IOEnv (Env gbl lcl) ModIface
-> IOEnv (Env gbl lcl) (Either SomeException ModIface)
forall a b. (a -> b) -> a -> b
$
                 CheckHiWay
-> TraceBinIFaceReading -> String -> IOEnv (Env gbl lcl) ModIface
forall a b.
CheckHiWay -> TraceBinIFaceReading -> String -> TcRnIf a b ModIface
readBinIface CheckHiWay
CheckHiWay TraceBinIFaceReading
QuietBinIFaceReading 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 Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
actual_mod
                                -> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface)
                | Bool
otherwise     -> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
                where
                  actual_mod :: Module
actual_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
                  err :: MsgDoc
err = Module -> Module -> MsgDoc
hiModuleNameMismatchWarn Module
wanted_mod Module
actual_mod

            Left SomeException
exn    -> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed (String -> MsgDoc
text (SomeException -> String
forall e. Exception e => e -> String
showException SomeException
exn)))
    }

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

initExternalPackageState :: DynFlags -> ExternalPackageState
initExternalPackageState :: DynFlags -> ExternalPackageState
initExternalPackageState DynFlags
dflags
  = EPS :: UniqFM ModuleName ModuleNameWithIsBoot
-> PackageIfaceTable
-> InstalledModuleEnv (UniqDSet ModuleName)
-> TypeEnv
-> PackageInstEnv
-> PackageFamInstEnv
-> PackageRuleBase
-> PackageAnnEnv
-> PackageCompleteMatchMap
-> ModuleEnv PackageFamInstEnv
-> EpsStats
-> ExternalPackageState
EPS {
      eps_is_boot :: UniqFM ModuleName ModuleNameWithIsBoot
eps_is_boot          = UniqFM ModuleName ModuleNameWithIsBoot
forall key elt. UniqFM key elt
emptyUFM,
      eps_PIT :: PackageIfaceTable
eps_PIT              = PackageIfaceTable
emptyPackageIfaceTable,
      eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes       = InstalledModuleEnv (UniqDSet ModuleName)
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv,
      eps_PTE :: TypeEnv
eps_PTE              = TypeEnv
emptyTypeEnv,
      eps_inst_env :: PackageInstEnv
eps_inst_env         = PackageInstEnv
emptyInstEnv,
      eps_fam_inst_env :: PackageFamInstEnv
eps_fam_inst_env     = PackageFamInstEnv
emptyFamInstEnv,
      eps_rule_base :: PackageRuleBase
eps_rule_base        = [CoreRule] -> PackageRuleBase
mkRuleBase [CoreRule]
builtinRules',
        -- Initialise the EPS rule pool with the built-in rules
      eps_mod_fam_inst_env :: ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env
                           = ModuleEnv PackageFamInstEnv
forall a. ModuleEnv a
emptyModuleEnv,
      eps_complete_matches :: PackageCompleteMatchMap
eps_complete_matches = PackageCompleteMatchMap
forall key elt. UniqFM key elt
emptyUFM,
      eps_ann_env :: PackageAnnEnv
eps_ann_env          = PackageAnnEnv
emptyAnnEnv,
      eps_stats :: EpsStats
eps_stats = EpsStats :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> EpsStats
EpsStats { n_ifaces_in :: Int
n_ifaces_in = Int
0, n_decls_in :: Int
n_decls_in = Int
0, n_decls_out :: Int
n_decls_out = Int
0
                           , n_insts_in :: Int
n_insts_in = Int
0, n_insts_out :: Int
n_insts_out = Int
0
                           , n_rules_in :: Int
n_rules_in = [CoreRule] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreRule]
builtinRules', n_rules_out :: Int
n_rules_out = Int
0 }
    }
    where
      enableBignumRules :: EnableBignumRules
enableBignumRules
         | DynFlags -> UnitId
homeUnitId DynFlags
dflags UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
primUnitId   = Bool -> EnableBignumRules
EnableBignumRules Bool
False
         | DynFlags -> UnitId
homeUnitId DynFlags
dflags UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
bignumUnitId = Bool -> EnableBignumRules
EnableBignumRules Bool
False
         | Bool
otherwise                         = Bool -> EnableBignumRules
EnableBignumRules Bool
True
      builtinRules' :: [CoreRule]
builtinRules' = EnableBignumRules -> [CoreRule]
builtinRules EnableBignumRules
enableBignumRules

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

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 = (ModIface -> IfaceBackendExts 'ModIfaceFinal
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_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
ghcPrimDeclDocs -- See Note [GHC.Prim Docs]
        }
  where
    empty_iface :: ModIface
empty_iface = Module -> ModIface
emptyFullModIface Module
gHC_PRIM

    -- The fixities listed here for @`seq`@ or @->@ should match
    -- those in primops.txt.pp (from which Haddock docs are generated).
    fixities :: [(OccName, Fixity)]
fixities = (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
seqId, SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
0 FixityDirection
InfixR)
             (OccName, Fixity) -> [(OccName, Fixity)] -> [(OccName, Fixity)]
forall a. a -> [a] -> [a]
: (PrimOp -> Maybe (OccName, Fixity))
-> [PrimOp] -> [(OccName, Fixity)]
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) (Fixity -> (OccName, Fixity))
-> Maybe Fixity -> Maybe (OccName, Fixity)
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 -> MsgDoc
ifaceStats ExternalPackageState
eps
  = [MsgDoc] -> MsgDoc
hcat [String -> MsgDoc
text String
"Renamer stats: ", MsgDoc
msg]
  where
    stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
    msg :: MsgDoc
msg = [MsgDoc] -> MsgDoc
vcat
        [Int -> MsgDoc
int (EpsStats -> Int
n_ifaces_in EpsStats
stats) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"interfaces read",
         [MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_decls_out EpsStats
stats), String -> MsgDoc
text String
"type/class/variable imported, out of",
                Int -> MsgDoc
int (EpsStats -> Int
n_decls_in EpsStats
stats), String -> MsgDoc
text String
"read"],
         [MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_insts_out EpsStats
stats), String -> MsgDoc
text String
"instance decls imported, out of",
                Int -> MsgDoc
int (EpsStats -> Int
n_insts_in EpsStats
stats), String -> MsgDoc
text String
"read"],
         [MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_rules_out EpsStats
stats), String -> MsgDoc
text String
"rule decls imported, out of",
                Int -> MsgDoc
int (EpsStats -> Int
n_rules_in EpsStats
stats), String -> MsgDoc
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 :: HscEnv -> FilePath -> IO ()
showIface :: HscEnv -> String -> IO ()
showIface HscEnv
hsc_env String
filename = do
   -- skip the hi way check; we don't want to worry about profiled vs.
   -- non-profiled interfaces, for example.
   ModIface
iface <- Char -> HscEnv -> () -> () -> TcRnIf () () ModIface -> IO ModIface
forall gbl lcl a.
Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
initTcRnIf Char
's' HscEnv
hsc_env () () (TcRnIf () () ModIface -> IO ModIface)
-> TcRnIf () () ModIface -> IO ModIface
forall a b. (a -> b) -> a -> b
$
       CheckHiWay
-> TraceBinIFaceReading -> String -> TcRnIf () () ModIface
forall a b.
CheckHiWay -> TraceBinIFaceReading -> String -> TcRnIf a b ModIface
readBinIface CheckHiWay
IgnoreHiWay TraceBinIFaceReading
TraceBinIFaceReading String
filename
   let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
       -- See Note [Name qualification with --show-iface]
       qualifyImportedNames :: Module -> OccName -> QualifyName
qualifyImportedNames Module
mod OccName
_
           | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== ModIface -> Module
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) -> (Unit -> Bool) -> PrintUnqualified
QueryQualify Module -> OccName -> QualifyName
qualifyImportedNames
                                   Module -> Bool
neverQualifyModules
                                   Unit -> Bool
neverQualifyPackages
   DynFlags -> WarnReason -> Severity -> SrcSpan -> MsgDoc -> IO ()
putLogMsg DynFlags
dflags WarnReason
NoReason Severity
SevDump SrcSpan
noSrcSpan
      (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> MsgDoc -> MsgDoc
withPprStyle (PrintUnqualified -> PprStyle
mkDumpStyle PrintUnqualified
print_unqual) (ModIface -> MsgDoc
pprModIface ModIface
iface)

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

pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface :: ModIface -> MsgDoc
pprModIface iface :: ModIface
iface@ModIface{ mi_final_exts :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts = IfaceBackendExts 'ModIfaceFinal
exts }
 = [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"interface"
                MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) MsgDoc -> MsgDoc -> MsgDoc
<+> HscSource -> MsgDoc
pp_hsc_src (ModIface -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface)
                MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIfaceBackend -> Bool
mi_orphan ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts then String -> MsgDoc
text String
"[orphan module]" else MsgDoc
Outputable.empty)
                MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIfaceBackend -> Bool
mi_finsts ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts then String -> MsgDoc
text String
"[family instance module]" else MsgDoc
Outputable.empty)
                MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
iface then String -> MsgDoc
text String
"[hpc]" else MsgDoc
Outputable.empty)
                MsgDoc -> MsgDoc -> MsgDoc
<+> Integer -> MsgDoc
integer Integer
hiVersion
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"interface hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_iface_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"ABI hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_mod_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"export-list hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_exp_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"orphan hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_orphan_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"flag hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_flag_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"opt_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_opt_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"hpc_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_hpc_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"plugin_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIfaceBackend -> Fingerprint
mi_plugin_hash ModIfaceBackend
IfaceBackendExts 'ModIfaceFinal
exts))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"sig of:" MsgDoc -> MsgDoc -> MsgDoc
<+> Maybe Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Maybe Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface
iface))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"used TH splices:" MsgDoc -> MsgDoc -> MsgDoc
<+> Bool -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_used_th ModIface
iface))
        , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"where")
        , String -> MsgDoc
text String
"exports:"
        , Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
vcat ((IfaceExport -> MsgDoc) -> [IfaceExport] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> MsgDoc
pprExport (ModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface)))
        , Dependencies -> MsgDoc
pprDeps (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
        , [MsgDoc] -> MsgDoc
vcat ((Usage -> MsgDoc) -> [Usage] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Usage -> MsgDoc
pprUsage (ModIface -> [Usage]
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages ModIface
iface))
        , [MsgDoc] -> MsgDoc
vcat ((IfaceAnnotation -> MsgDoc) -> [IfaceAnnotation] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAnnotation -> MsgDoc
pprIfaceAnnotation (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface))
        , [(OccName, Fixity)] -> MsgDoc
pprFixities (ModIface -> [(OccName, Fixity)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities ModIface
iface)
        , [MsgDoc] -> MsgDoc
vcat [Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Fingerprint
ver MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
2 (IfaceDecl -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IfaceDecl
decl) | (Fingerprint
ver,IfaceDecl
decl) <- ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface]
        , [MsgDoc] -> MsgDoc
vcat ((IfaceClsInst -> MsgDoc) -> [IfaceClsInst] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface))
        , [MsgDoc] -> MsgDoc
vcat ((IfaceFamInst -> MsgDoc) -> [IfaceFamInst] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceFamInst -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface))
        , [MsgDoc] -> MsgDoc
vcat ((IfaceRule -> MsgDoc) -> [IfaceRule] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceRule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface))
        , Warnings -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Warnings
forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings
mi_warns ModIface
iface)
        , IfaceTrustInfo -> MsgDoc
pprTrustInfo (ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface)
        , Bool -> MsgDoc
pprTrustPkg (ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg ModIface
iface)
        , [MsgDoc] -> MsgDoc
vcat ((IfaceCompleteMatch -> MsgDoc) -> [IfaceCompleteMatch] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCompleteMatch -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface))
        , String -> MsgDoc
text String
"module header:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
2 (Maybe HsDocString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Maybe HsDocString
forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe HsDocString
mi_doc_hdr ModIface
iface))
        , String -> MsgDoc
text String
"declaration docs:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
2 (DeclDocMap -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> DeclDocMap
forall (phase :: ModIfacePhase). ModIface_ phase -> DeclDocMap
mi_decl_docs ModIface
iface))
        , String -> MsgDoc
text String
"arg docs:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
2 (ArgDocMap -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> ArgDocMap
forall (phase :: ModIfacePhase). ModIface_ phase -> ArgDocMap
mi_arg_docs ModIface
iface))
        , String -> MsgDoc
text String
"extensible fields:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
2 (ExtensibleFields -> MsgDoc
pprExtensibleFields (ModIface -> ExtensibleFields
forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields ModIface
iface))
        ]
  where
    pp_hsc_src :: HscSource -> MsgDoc
pp_hsc_src HscSource
HsBootFile = String -> MsgDoc
text String
"[boot]"
    pp_hsc_src HscSource
HsigFile = String -> MsgDoc
text String
"[hsig]"
    pp_hsc_src HscSource
HsSrcFile = MsgDoc
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 -> MsgDoc
pprExport (Avail Name
n)         = Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
pprExport (AvailTC Name
_ [] []) = MsgDoc
Outputable.empty
pprExport (AvailTC Name
n [Name]
ns0 [FieldLabel]
fs)
  = case [Name]
ns0 of
      (Name
n':[Name]
ns) | Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
n' -> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n MsgDoc -> MsgDoc -> MsgDoc
<> [Name] -> [FieldLabel] -> MsgDoc
forall {a} {a}. Outputable a => [a] -> [FieldLbl a] -> MsgDoc
pp_export [Name]
ns [FieldLabel]
fs
      [Name]
_               -> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
vbar MsgDoc -> MsgDoc -> MsgDoc
<> [Name] -> [FieldLabel] -> MsgDoc
forall {a} {a}. Outputable a => [a] -> [FieldLbl a] -> MsgDoc
pp_export [Name]
ns0 [FieldLabel]
fs
  where
    pp_export :: [a] -> [FieldLbl a] -> MsgDoc
pp_export []    [] = MsgDoc
Outputable.empty
    pp_export [a]
names [FieldLbl a]
fs = MsgDoc -> MsgDoc
braces ([MsgDoc] -> MsgDoc
hsep ((a -> MsgDoc) -> [a] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [a]
names [MsgDoc] -> [MsgDoc] -> [MsgDoc]
forall a. [a] -> [a] -> [a]
++ (FieldLbl a -> MsgDoc) -> [FieldLbl a] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (FieldLbl a -> FastString) -> FieldLbl a -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl a -> FastString
forall a. FieldLbl a -> FastString
flLabel) [FieldLbl a]
fs))

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

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

pprDeps :: Dependencies -> SDoc
pprDeps :: Dependencies -> MsgDoc
pprDeps (Deps { dep_mods :: Dependencies -> [ModuleNameWithIsBoot]
dep_mods = [ModuleNameWithIsBoot]
mods, dep_pkgs :: Dependencies -> [(UnitId, Bool)]
dep_pkgs = [(UnitId, Bool)]
pkgs, dep_orphs :: Dependencies -> [Module]
dep_orphs = [Module]
orphs,
                dep_finsts :: Dependencies -> [Module]
dep_finsts = [Module]
finsts })
  = [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"module dependencies:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep ((ModuleNameWithIsBoot -> MsgDoc)
-> [ModuleNameWithIsBoot] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleNameWithIsBoot -> MsgDoc
forall {a}. Outputable a => GenWithIsBoot a -> MsgDoc
ppr_mod [ModuleNameWithIsBoot]
mods),
          String -> MsgDoc
text String
"package dependencies:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep (((UnitId, Bool) -> MsgDoc) -> [(UnitId, Bool)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, Bool) -> MsgDoc
forall {a}. Outputable a => (a, Bool) -> MsgDoc
ppr_pkg [(UnitId, Bool)]
pkgs),
          String -> MsgDoc
text String
"orphans:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep ((Module -> MsgDoc) -> [Module] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Module]
orphs),
          String -> MsgDoc
text String
"family instance modules:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep ((Module -> MsgDoc) -> [Module] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Module]
finsts)
        ]
  where
    ppr_mod :: GenWithIsBoot a -> MsgDoc
ppr_mod (GWIB { gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod = a
mod_name, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
boot }) = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
mod_name MsgDoc -> MsgDoc -> MsgDoc
<+> IsBootInterface -> MsgDoc
ppr_boot IsBootInterface
boot
    ppr_pkg :: (a, Bool) -> MsgDoc
ppr_pkg (a
pkg,Bool
trust_req)  = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
pkg MsgDoc -> MsgDoc -> MsgDoc
<>
                               (if Bool
trust_req then String -> MsgDoc
text String
"*" else MsgDoc
Outputable.empty)
    ppr_boot :: IsBootInterface -> MsgDoc
ppr_boot IsBootInterface
IsBoot  = String -> MsgDoc
text String
"[boot]"
    ppr_boot IsBootInterface
NotBoot = MsgDoc
Outputable.empty

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

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

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

instance Outputable Warnings where
    ppr :: Warnings -> MsgDoc
ppr = Warnings -> MsgDoc
pprWarns

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

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

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

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

badIfaceFile :: String -> SDoc -> SDoc
badIfaceFile :: String -> MsgDoc -> MsgDoc
badIfaceFile String
file MsgDoc
err
  = [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"Bad interface file:" MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
file,
          Int -> MsgDoc -> MsgDoc
nest Int
4 MsgDoc
err]

hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
hiModuleNameMismatchWarn Module
requested_mod Module
read_mod
 | Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
requested_mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
read_mod =
    [MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text String
"Interface file contains module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
read_mod) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
comma,
         String -> MsgDoc
text String
"but we were expecting module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
requested_mod),
         [MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text String
"Probable cause: the source code which generated interface file",
             String -> MsgDoc
text String
"has an incompatible module name"
            ]
        ]
 | Bool
otherwise =
  -- ToDo: This will fail to have enough qualification when the package IDs
  -- are the same
  PprStyle -> MsgDoc -> MsgDoc
withPprStyle (PrintUnqualified -> Depth -> PprStyle
mkUserStyle PrintUnqualified
alwaysQualify Depth
AllTheWay) (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
    -- we want the Modules below to be qualified with package names,
    -- so reset the PrintUnqualified setting.
    [MsgDoc] -> MsgDoc
hsep [ String -> MsgDoc
text String
"Something is amiss; requested module "
         , Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
requested_mod
         , String -> MsgDoc
text String
"differs from name found in the interface file"
         , Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
read_mod
         , MsgDoc -> MsgDoc
parens (String -> MsgDoc
text String
"if these names look the same, try again with -dppr-debug")
         ]

homeModError :: InstalledModule -> ModLocation -> SDoc
-- See Note [Home module load error]
homeModError :: InstalledModule -> ModLocation -> MsgDoc
homeModError InstalledModule
mod ModLocation
location
  = String -> MsgDoc
text String
"attempting to use module " MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
quotes (InstalledModule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr InstalledModule
mod)
    MsgDoc -> MsgDoc -> MsgDoc
<> (case ModLocation -> Maybe String
ml_hs_file ModLocation
location of
           Just String
file -> MsgDoc
space MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens (String -> MsgDoc
text String
file)
           Maybe String
Nothing   -> MsgDoc
Outputable.empty)
    MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"which is not loaded"