{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}

module GHC.Unit.Module.ModIface
   ( ModIface
   , ModIface_ (..)
   , PartialModIface
   , ModIfaceBackend (..)
   , ModIfaceSelfRecompBackend (..)
   , ModIfaceSelfRecomp (..)
   , isSelfRecompilationInterface
   , IfaceDeclExts
   , IfaceBackendExts
   , IfaceExport
   , WhetherHasOrphans
   , WhetherHasFamInst
   , mi_boot
   , mi_fix
   , mi_semantic_module
   , mi_free_holes
   , mi_mnwib
   , mi_flag_hash
   , mi_iface_hash
   , mi_opt_hash
   , mi_hpc_hash
   , mi_plugin_hash
   , mi_usages
   , mi_src_hash
   , renameFreeHoles
   , emptyPartialModIface
   , emptyFullModIface
   , mkIfaceHashCache
   , emptyIfaceHashCache
   , forceModIface
   )
where

import GHC.Prelude

import GHC.Hs

import GHC.Iface.Syntax
import GHC.Iface.Ext.Fields

import GHC.Unit
import GHC.Unit.Module.Deps
import GHC.Unit.Module.Warnings

import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.HpcInfo
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.SafeHaskell
import GHC.Types.SourceFile
import GHC.Types.Unique.DSet
import GHC.Types.Unique.FM

import GHC.Data.Maybe

import GHC.Utils.Fingerprint
import GHC.Utils.Binary

import Control.DeepSeq
import Control.Exception
import GHC.Utils.Panic
import GHC.Utils.Outputable
import GHC.Utils.Misc

{- Note [Interface file stages]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Interface files have two possible stages.

* A partial stage built from the result of the core pipeline.
* A fully instantiated form. Which also includes fingerprints and
  potentially information provided by backends.

We can build a full interface file two ways:
* Directly from a partial one:
  Then we omit backend information and mostly compute fingerprints.
* From a partial one + information produced by a backend.
  Then we store the provided information and fingerprint both.
-}

type PartialModIface = ModIface_ 'ModIfaceCore
type ModIface = ModIface_ 'ModIfaceFinal

-- | Extends a PartialModIface with information which is either:
-- * Computed after codegen
-- * Or computed just before writing the iface to disk. (Hashes)
-- In order to fully instantiate it.
data ModIfaceBackend = ModIfaceBackend
  { ModIfaceBackend -> Fingerprint
mi_mod_hash :: !Fingerprint
    -- ^ Hash of the ABI only
  , ModIfaceBackend -> ModIfaceSelfRecompBackend
mi_self_recomp_backend_info :: !ModIfaceSelfRecompBackend
    -- ^ Information needed for checking self-recompilation.
    -- See Note [Self recompilation information in interface files]
  , ModIfaceBackend -> WhetherHasOrphans
mi_orphan :: !WhetherHasOrphans
    -- ^ Whether this module has orphans
  , ModIfaceBackend -> WhetherHasOrphans
mi_finsts :: !WhetherHasFamInst
    -- ^ Whether this module has family instances. See Note [The type family
    -- instance consistency story].
  , ModIfaceBackend -> Fingerprint
mi_exp_hash :: !Fingerprint
    -- ^ Hash of export list
  , ModIfaceBackend -> Fingerprint
mi_orphan_hash :: !Fingerprint
    -- ^ Hash for orphan rules, class and family instances combined

    -- Cached environments for easy lookup. These are computed (lazily) from
    -- other fields and are not put into the interface file.
    -- Not really produced by the backend but there is no need to create them
    -- any earlier.
  , ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn))
    -- ^ Cached lookup for 'mi_warns'
  , ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn :: !(OccName -> Maybe Fixity)
    -- ^ Cached lookup for 'mi_fixities'
  , ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))
    -- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that
    -- the thing isn't in decls. It's useful to know that when seeing if we are
    -- up to date wrt. the old interface. The 'OccName' is the parent of the
    -- name, if it has one.
  }

data ModIfacePhase
  = ModIfaceCore
  -- ^ Partial interface built based on output of core pipeline.
  | ModIfaceFinal

-- | Selects a IfaceDecl representation.
-- For fully instantiated interfaces we also maintain
-- a fingerprint, which is used for recompilation checks.
type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where
  IfaceDeclExts 'ModIfaceCore = IfaceDecl
  IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl)

type family IfaceBackendExts (phase :: ModIfacePhase) = bk | bk -> phase where
  IfaceBackendExts 'ModIfaceCore = ()
  IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend

-- | The information for a module which is only used when deciding whether to recompile
-- itself. In particular the external interface of a module is recorded by the ABI
-- hash
data ModIfaceSelfRecompBackend = NoSelfRecompBackend | ModIfaceSelfRecompBackend {
    ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_flag_hash :: !Fingerprint
    -- ^ Hash of the important flags used when compiling the module, excluding
    -- optimisation flags
  , ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_iface_hash :: !Fingerprint
    -- ^ Hash of the whole interface
  , ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_opt_hash :: !Fingerprint
    -- ^ Hash of optimisation flags
  , ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_hpc_hash :: !Fingerprint
    -- ^ Hash of hpc flags
  , ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_plugin_hash :: !Fingerprint
    -- ^ Hash of plugins
}
withSelfRecompBackend :: HasCallStack => (ModIfaceSelfRecompBackend-> t) -> ModIfaceBackend-> t

withSelfRecompBackend :: forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> t
f ModIfaceBackend
mi =
  case ModIfaceBackend -> ModIfaceSelfRecompBackend
mi_self_recomp_backend_info ModIfaceBackend
mi of
    ModIfaceSelfRecompBackend
NoSelfRecompBackend -> String -> t
forall a. HasCallStack => String -> a
panic String
"Trying to use self-recomp info"
    ModIfaceSelfRecompBackend
x -> ModIfaceSelfRecompBackend -> t
f ModIfaceSelfRecompBackend
x

mi_flag_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_flag_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_flag_hash = (ModIfaceSelfRecompBackend -> Fingerprint)
-> ModIfaceBackend -> Fingerprint
forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_flag_hash
mi_iface_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_iface_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_iface_hash = (ModIfaceSelfRecompBackend -> Fingerprint)
-> ModIfaceBackend -> Fingerprint
forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_iface_hash
mi_opt_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_opt_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_opt_hash   = (ModIfaceSelfRecompBackend -> Fingerprint)
-> ModIfaceBackend -> Fingerprint
forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_opt_hash
mi_hpc_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_hpc_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_hpc_hash   = (ModIfaceSelfRecompBackend -> Fingerprint)
-> ModIfaceBackend -> Fingerprint
forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_hpc_hash
mi_plugin_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_plugin_hash :: HasCallStack => ModIfaceBackend -> Fingerprint
mi_plugin_hash = (ModIfaceSelfRecompBackend -> Fingerprint)
-> ModIfaceBackend -> Fingerprint
forall t.
HasCallStack =>
(ModIfaceSelfRecompBackend -> t) -> ModIfaceBackend -> t
withSelfRecompBackend ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_plugin_hash

isSelfRecompilationInterface :: ModIface -> Bool
isSelfRecompilationInterface :: ModIface -> WhetherHasOrphans
isSelfRecompilationInterface ModIface
iface =
  case ModIface -> ModIfaceSelfRecomp
forall (phase :: ModIfacePhase).
ModIface_ phase -> ModIfaceSelfRecomp
mi_self_recomp_info ModIface
iface of
    ModIfaceSelfRecomp
NoSelfRecomp -> WhetherHasOrphans
False
    ModIfaceSelfRecomp {} -> WhetherHasOrphans
True

{-
Note [Self recompilation information in interface files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The flag -fwrite-self-recomp-info controls whether
interface files contain the information necessary to answer the
question:

  Do I need to recompile myself or is this current interface file
  suitable?

Why? Most packages are only built once either by a distribution or cabal
and then placed into an immutable store, after which we will never ask
this question. Therefore we can derive two benefits from omitting this
information.

* Primary motivation: It vastly reduces the surface area for creating
  non-deterministic interface files. See issue #10424 which motivated a
  proper fix to that issue. Distributions have long contained versions
  of GHC which just have broken self-recompilation checking (in order to
  get deterministic interface files).

* Secondary motivation: This reduces the size of interface files
  slightly.. the `mi_usages` field can be quite big but probably this
  isn't such a great benefit.

* Third motivation: Conceptually clarity about which parts of an
  interface file are used in order to **communicate** with subsequent
  packages about the **interface** for a module. And which parts are
  used to self-communicate during recompilation checking.

The main tracking issue is #22188 but fixes issues such as #10424 in a
proper way.

-}


-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
-- and can be written out to an interface file. The 'ModDetails is after
-- linking and can be completely recovered from just the 'ModIface'.
--
-- When we read an interface file, we also construct a 'ModIface' from it,
-- except that we explicitly make the 'mi_decls' and a few other fields empty;
-- as when reading we consolidate the declarations etc. into a number of indexed
-- maps and environments in the 'ExternalPackageState'.
--
-- See Note [Strictness in ModIface] to learn about why some fields are
-- strict and others are not.
data ModIface_ (phase :: ModIfacePhase)
  = ModIface {
        forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module     :: !Module,             -- ^ Name of the module we are for
        forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?

        forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?

        forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps     :: Dependencies,
                -- ^ The dependencies of the module.  This is
                -- consulted for directly-imported modules, but not
                -- for anything else (hence lazy)


        forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports  :: ![IfaceExport],
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
                -- exported by this module, and the 'OccName's of those things


        forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).

        forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities :: [(OccName,Fixity)],
                -- ^ Fixities
                -- NOT STRICT!  we read this field lazily from the interface file

        forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns    :: (Warnings GhcRn),
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file

        forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns     :: [IfaceAnnotation],
                -- ^ Annotations
                -- NOT STRICT!  we read this field lazily from the interface file


        forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls    :: [IfaceDeclExts phase],
                -- ^ Type, class and variable declarations
                -- The hash of an Id changes if its fixity or deprecations change
                --      (as well as its type of course)
                -- Ditto data constructors, class operations, except that
                -- the hash of the parent class/tycon changes

        forall (phase :: ModIfacePhase).
ModIface_ phase
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],
                -- ^ Extra variable definitions which are **NOT** exposed but when
                -- combined with mi_decls allows us to restart code generation.
                -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs]

        forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe GlobalRdrEnv
mi_globals  :: !(Maybe GlobalRdrEnv),
                -- ^ Binds all the things defined at the top level in
                -- the /original source/ code for this module. which
                -- is NOT the same as mi_exports, nor mi_decls (which
                -- may contains declarations for things not actually
                -- defined by the user).  Used for GHCi and for inspecting
                -- the contents of modules via the GHC API only.
                --
                -- (We need the source file to figure out the
                -- top-level environment, if we didn't compile this module
                -- from source then this field contains @Nothing@).
                --
                -- Strictly speaking this field should live in the
                -- 'HomeModInfo', but that leads to more plumbing.

                -- Instance declarations and rules
        forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance
        forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances
        forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules       :: [IfaceRule],     -- ^ Sorted rules

        forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_hpc       :: !AnyHpcUsage,
                -- ^ True if this program uses Hpc at any point in the program.

        forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust     :: !IfaceTrustInfo,
                -- ^ Safe Haskell Trust information for this module.

        forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_trust_pkg :: !Bool,
                -- ^ Do we require the package this module resides in be trusted
                -- to trust this module? This is used for the situation where a
                -- module is Safe (so doesn't require the package be trusted
                -- itself) but imports some trustworthy modules from its own
                -- package (which does require its own package be trusted).
                -- See Note [Trust Own Package] in GHC.Rename.Names
        forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches :: ![IfaceCompleteMatch],

        forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs :: !(Maybe Docs),
                -- ^ Docstrings and related data for use by haddock, the ghci
                -- @:doc@ command, and other tools.
                --
                -- @Just _@ @<=>@ the module was built with @-haddock@.

        forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts :: !(IfaceBackendExts phase),
                -- ^ Either `()` or `ModIfaceBackend` for
                -- a fully instantiated interface.

        forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields :: !ExtensibleFields,
                -- ^ Additional optional fields, where the Map key represents
                -- the field name, resulting in a (size, serialized data) pair.
                -- Because the data is intended to be serialized through the
                -- internal `Binary` class (increasing compatibility with types
                -- using `Name` and `FastString`, such as HIE), this format is
                -- chosen over `ByteString`s.
                --

        forall (phase :: ModIfacePhase).
ModIface_ phase -> ModIfaceSelfRecomp
mi_self_recomp_info :: !ModIfaceSelfRecomp
                -- ^ Information needed for checking self-recompilation.
                -- See Note [Self recompilation information in interface files]
     }

data ModIfaceSelfRecomp = NoSelfRecomp
  | ModIfaceSelfRecomp { ModIfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: !Fingerprint
                       -- ^ Hash of the .hs source, used for recompilation checking.
                       , ModIfaceSelfRecomp -> [Usage]
mi_sr_usages   :: [Usage]
                       -- ^ Usages; kept sorted so that it's easy to decide
                       -- whether to write a new iface file (changing usages
                       -- doesn't affect the hash of this module)
                       -- NOT STRICT!  we read this field lazily from the interface file
                       -- It is *only* consulted by the recompilation checker
                       }

instance Outputable ModIfaceSelfRecomp where
  ppr :: ModIfaceSelfRecomp -> SDoc
ppr ModIfaceSelfRecomp
NoSelfRecomp = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoSelfRecomp"
  ppr (ModIfaceSelfRecomp{Fingerprint
mi_sr_src_hash :: ModIfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: Fingerprint
mi_sr_src_hash, [Usage]
mi_sr_usages :: ModIfaceSelfRecomp -> [Usage]
mi_sr_usages :: [Usage]
mi_sr_usages}) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Self-Recomp"
                                                                , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"src hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
mi_sr_src_hash
                                                                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"usages:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Usage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Usage]
mi_sr_usages)])]

withSelfRecomp :: HasCallStack => (ModIfaceSelfRecomp-> t) -> ModIface_ phase -> t
withSelfRecomp :: forall t (phase :: ModIfacePhase).
HasCallStack =>
(ModIfaceSelfRecomp -> t) -> ModIface_ phase -> t
withSelfRecomp ModIfaceSelfRecomp -> t
f ModIface_ phase
mi =
  case ModIface_ phase -> ModIfaceSelfRecomp
forall (phase :: ModIfacePhase).
ModIface_ phase -> ModIfaceSelfRecomp
mi_self_recomp_info ModIface_ phase
mi of
    ModIfaceSelfRecomp
NoSelfRecomp -> String -> t
forall a. HasCallStack => String -> a
panic String
"Trying to use self-recomp info"
    ModIfaceSelfRecomp
x -> ModIfaceSelfRecomp -> t
f ModIfaceSelfRecomp
x

mi_usages :: HasCallStack => ModIface_ phase -> [Usage]
mi_usages :: forall (phase :: ModIfacePhase).
HasCallStack =>
ModIface_ phase -> [Usage]
mi_usages = (ModIfaceSelfRecomp -> [Usage]) -> ModIface_ phase -> [Usage]
forall t (phase :: ModIfacePhase).
HasCallStack =>
(ModIfaceSelfRecomp -> t) -> ModIface_ phase -> t
withSelfRecomp ModIfaceSelfRecomp -> [Usage]
mi_sr_usages
mi_src_hash :: HasCallStack => ModIface_ phase -> Fingerprint
mi_src_hash :: forall (phase :: ModIfacePhase).
HasCallStack =>
ModIface_ phase -> Fingerprint
mi_src_hash = (ModIfaceSelfRecomp -> Fingerprint)
-> ModIface_ phase -> Fingerprint
forall t (phase :: ModIfacePhase).
HasCallStack =>
(ModIfaceSelfRecomp -> t) -> ModIface_ phase -> t
withSelfRecomp ModIfaceSelfRecomp -> Fingerprint
mi_sr_src_hash


{-
Note [Strictness in ModIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The ModIface is the Haskell representation of an interface (.hi) file.

* During compilation we write out ModIface values to disk for files
  that we have just compiled
* For packages that we depend on we load the ModIface from disk.

Some fields in the ModIface are deliberately lazy because when we read
an interface file we don't always need all the parts. For example, an
interface file contains information about documentation which is often
not needed during compilation. This is achieved using the lazyPut/lazyGet pair.
If the field was strict then we would pointlessly load this information into memory.

On the other hand, if we create a ModIface but **don't** write it to
disk then to avoid space leaks we need to make sure to deepseq all these lazy fields
because the ModIface might live for a long time (for instance in a GHCi session).
That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to
forceModIface.
-}

-- | Old-style accessor for whether or not the ModIface came from an hs-boot
-- file.
mi_boot :: ModIface -> IsBootInterface
mi_boot :: ModIface -> IsBootInterface
mi_boot ModIface
iface = if ModIface -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface HscSource -> HscSource -> WhetherHasOrphans
forall a. Eq a => a -> a -> WhetherHasOrphans
== HscSource
HsBootFile
    then IsBootInterface
IsBoot
    else IsBootInterface
NotBoot

mi_mnwib :: ModIface -> ModuleNameWithIsBoot
mi_mnwib :: ModIface -> ModuleNameWithIsBoot
mi_mnwib ModIface
iface = ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) (ModIface -> IsBootInterface
mi_boot ModIface
iface)

-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be
-- found, 'defaultFixity' is returned instead.
mi_fix :: ModIface -> OccName -> Fixity
mi_fix :: ModIface -> OccName -> Fixity
mi_fix ModIface
iface OccName
name = ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) OccName
name Maybe Fixity -> Fixity -> Fixity
forall a. Maybe a -> a -> a
`orElse` Fixity
defaultFixity

-- | The semantic module for this interface; e.g., if it's a interface
-- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module'
-- will be @<A>@.
mi_semantic_module :: ModIface_ a -> Module
mi_semantic_module :: forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface_ a
iface = case ModIface_ a -> Maybe Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface_ a
iface of
                            Maybe Module
Nothing -> ModIface_ a -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface_ a
iface
                            Just Module
mod -> Module
mod

-- | The "precise" free holes, e.g., the signatures that this
-- 'ModIface' depends on.
mi_free_holes :: ModIface -> UniqDSet ModuleName
mi_free_holes :: ModIface -> UniqDSet ModuleName
mi_free_holes ModIface
iface =
  case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) of
    (InstalledModule
_, Just InstantiatedModule
indef)
        -- A mini-hack: we rely on the fact that 'renameFreeHoles'
        -- drops things that aren't holes.
        -> UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles ([ModuleName] -> UniqDSet ModuleName
forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet [ModuleName]
cands) (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef))
    (InstalledModule, Maybe InstantiatedModule)
_   -> UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet
  where
    cands :: [ModuleName]
cands = Dependencies -> [ModuleName]
dep_sig_mods (Dependencies -> [ModuleName]) -> Dependencies -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface

-- | Given a set of free holes, and a unit identifier, rename
-- the free holes according to the instantiation of the unit
-- identifier.  For example, if we have A and B free, and
-- our unit identity is @p[A=<C>,B=impl:B]@, the renamed free
-- holes are just C.
renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles :: UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
fhs [(ModuleName, Module)]
insts =
    [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets ((ModuleName -> UniqDSet ModuleName)
-> [ModuleName] -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> UniqDSet ModuleName
lookup_impl (UniqDSet ModuleName -> [ModuleName]
forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet ModuleName
fhs))
  where
    hmap :: UniqFM ModuleName Module
hmap = [(ModuleName, Module)] -> UniqFM ModuleName Module
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM [(ModuleName, Module)]
insts
    lookup_impl :: ModuleName -> UniqDSet ModuleName
lookup_impl ModuleName
mod_name
        | Just Module
mod <- UniqFM ModuleName Module -> ModuleName -> Maybe Module
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM ModuleName Module
hmap ModuleName
mod_name = Module -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles Module
mod
        -- It wasn't actually a hole
        | WhetherHasOrphans
otherwise                           = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet

instance Binary ModIfaceSelfRecompBackend where
  put_ :: BinHandle -> ModIfaceSelfRecompBackend -> IO ()
put_ BinHandle
bh ModIfaceSelfRecompBackend
NoSelfRecompBackend = BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Int
0 :: Int)
  put_ BinHandle
bh (ModIfaceSelfRecompBackend {Fingerprint
mi_sr_flag_hash :: ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_flag_hash :: Fingerprint
mi_sr_flag_hash, Fingerprint
mi_sr_iface_hash :: ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_iface_hash :: Fingerprint
mi_sr_iface_hash, Fingerprint
mi_sr_plugin_hash :: ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_plugin_hash :: Fingerprint
mi_sr_plugin_hash, Fingerprint
mi_sr_opt_hash :: ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_opt_hash :: Fingerprint
mi_sr_opt_hash, Fingerprint
mi_sr_hpc_hash :: ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_hpc_hash :: Fingerprint
mi_sr_hpc_hash}) = do
    BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Int
1 :: Int)
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_flag_hash
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_iface_hash
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_plugin_hash
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_opt_hash
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_hpc_hash

  get :: BinHandle -> IO ModIfaceSelfRecompBackend
get BinHandle
bh = do
    (Int
tag :: Int) <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    case Int
tag of
      Int
0 -> ModIfaceSelfRecompBackend -> IO ModIfaceSelfRecompBackend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIfaceSelfRecompBackend
NoSelfRecompBackend
      Int
1 -> do
        Fingerprint
mi_sr_flag_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
mi_sr_iface_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
mi_sr_plugin_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
mi_sr_opt_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
mi_sr_hpc_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        ModIfaceSelfRecompBackend -> IO ModIfaceSelfRecompBackend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIfaceSelfRecompBackend {Fingerprint
mi_sr_flag_hash :: Fingerprint
mi_sr_flag_hash :: Fingerprint
mi_sr_flag_hash, Fingerprint
mi_sr_iface_hash :: Fingerprint
mi_sr_iface_hash :: Fingerprint
mi_sr_iface_hash, Fingerprint
mi_sr_plugin_hash :: Fingerprint
mi_sr_plugin_hash :: Fingerprint
mi_sr_plugin_hash, Fingerprint
mi_sr_opt_hash :: Fingerprint
mi_sr_opt_hash :: Fingerprint
mi_sr_opt_hash, Fingerprint
mi_sr_hpc_hash :: Fingerprint
mi_sr_hpc_hash :: Fingerprint
mi_sr_hpc_hash})
      Int
x -> String -> SDoc -> IO ModIfaceSelfRecompBackend
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"get_ModIfaceSelfRecomp" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
x)

instance Binary ModIfaceSelfRecomp where
  put_ :: BinHandle -> ModIfaceSelfRecomp -> IO ()
put_ BinHandle
bh ModIfaceSelfRecomp
NoSelfRecomp = BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Int
0 :: Int)
  put_ BinHandle
bh (ModIfaceSelfRecomp{Fingerprint
mi_sr_src_hash :: ModIfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: Fingerprint
mi_sr_src_hash, [Usage]
mi_sr_usages :: ModIfaceSelfRecomp -> [Usage]
mi_sr_usages :: [Usage]
mi_sr_usages}) = do
    BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Int
1 :: Int)
    BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mi_sr_src_hash
    BinHandle -> [Usage] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [Usage]
mi_sr_usages

  get :: BinHandle -> IO ModIfaceSelfRecomp
get BinHandle
bh = do
    (Int
tag :: Int) <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    case Int
tag of
      Int
0 -> ModIfaceSelfRecomp -> IO ModIfaceSelfRecomp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIfaceSelfRecomp
NoSelfRecomp
      Int
1 -> do
        Fingerprint
src_hash    <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [Usage]
usages      <- {-# SCC "bin_usages" #-} BinHandle -> IO [Usage]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
        ModIfaceSelfRecomp -> IO ModIfaceSelfRecomp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIfaceSelfRecomp -> IO ModIfaceSelfRecomp)
-> ModIfaceSelfRecomp -> IO ModIfaceSelfRecomp
forall a b. (a -> b) -> a -> b
$ ModIfaceSelfRecomp { mi_sr_src_hash :: Fingerprint
mi_sr_src_hash = Fingerprint
src_hash, mi_sr_usages :: [Usage]
mi_sr_usages = [Usage]
usages }
      Int
x -> String -> SDoc -> IO ModIfaceSelfRecomp
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"get_ModIfaceSelfRecomp" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
x)

-- See Note [Strictness in ModIface] about where we use lazyPut vs put
instance Binary ModIface where
   put_ :: BinHandle -> ModIface -> IO ()
put_ BinHandle
bh (ModIface {
                 mi_module :: forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module    = Module
mod,
                 mi_sig_of :: forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of    = Maybe Module
sig_of,
                 mi_hsc_src :: forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src   = HscSource
hsc_src,
                 mi_deps :: forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps      = Dependencies
deps,
                 mi_exports :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports   = [IfaceExport]
exports,
                 mi_used_th :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_used_th   = WhetherHasOrphans
used_th,
                 mi_fixities :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities  = [(OccName, Fixity)]
fixities,
                 mi_warns :: forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns     = Warnings GhcRn
warns,
                 mi_anns :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns      = [IfaceAnnotation]
anns,
                 mi_decls :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls     = [IfaceDeclExts 'ModIfaceFinal]
decls,
                 mi_extra_decls :: forall (phase :: ModIfacePhase).
ModIface_ phase
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls = Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls,
                 mi_insts :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts     = [IfaceClsInst]
insts,
                 mi_fam_insts :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts = [IfaceFamInst]
fam_insts,
                 mi_rules :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules     = [IfaceRule]
rules,
                 mi_hpc :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_hpc       = WhetherHasOrphans
hpc_info,
                 mi_trust :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust     = IfaceTrustInfo
trust,
                 mi_trust_pkg :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_trust_pkg = WhetherHasOrphans
trust_pkg,
                 mi_complete_matches :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches = [IfaceCompleteMatch]
complete_matches,
                 mi_docs :: forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs      = Maybe Docs
docs,
                 mi_ext_fields :: forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields = ExtensibleFields
_ext_fields, -- Don't `put_` this in the instance so we
                                              -- can deal with it's pointer in the header
                                              -- when we write the actual file
                 mi_self_recomp_info :: forall (phase :: ModIfacePhase).
ModIface_ phase -> ModIfaceSelfRecomp
mi_self_recomp_info = ModIfaceSelfRecomp
self_recomp,
                 mi_final_exts :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts = ModIfaceBackend {
                   mi_self_recomp_backend_info :: ModIfaceBackend -> ModIfaceSelfRecompBackend
mi_self_recomp_backend_info = ModIfaceSelfRecompBackend
self_recomp_backend,
                   mi_mod_hash :: ModIfaceBackend -> Fingerprint
mi_mod_hash = Fingerprint
mod_hash,
                   mi_orphan :: ModIfaceBackend -> WhetherHasOrphans
mi_orphan = WhetherHasOrphans
orphan,
                   mi_finsts :: ModIfaceBackend -> WhetherHasOrphans
mi_finsts = WhetherHasOrphans
hasFamInsts,
                   mi_exp_hash :: ModIfaceBackend -> Fingerprint
mi_exp_hash = Fingerprint
exp_hash,
                   mi_orphan_hash :: ModIfaceBackend -> Fingerprint
mi_orphan_hash = Fingerprint
orphan_hash
                 }}) = do
        BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
mod
        BinHandle -> Maybe Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Module
sig_of
        BinHandle -> HscSource -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HscSource
hsc_src
        BinHandle -> ModIfaceSelfRecomp -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ModIfaceSelfRecomp
self_recomp
        BinHandle -> ModIfaceSelfRecompBackend -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ModIfaceSelfRecompBackend
self_recomp_backend
        BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mod_hash
        BinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
orphan
        BinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
hasFamInsts
        BinHandle -> Dependencies -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Dependencies
deps
        BinHandle -> [IfaceExport] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExport]
exports
        BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
exp_hash
        BinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
used_th
        BinHandle -> [(OccName, Fixity)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, Fixity)]
fixities
        BinHandle -> Warnings GhcRn -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Warnings GhcRn
warns
        BinHandle -> [IfaceAnnotation] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceAnnotation]
anns
        BinHandle -> [(Fingerprint, IfaceDecl)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(Fingerprint, IfaceDecl)]
[IfaceDeclExts 'ModIfaceFinal]
decls
        BinHandle
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls
        BinHandle -> [IfaceClsInst] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceClsInst]
insts
        BinHandle -> [IfaceFamInst] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceFamInst]
fam_insts
        BinHandle -> [IfaceRule] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceRule]
rules
        BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
orphan_hash
        BinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
hpc_info
        BinHandle -> IfaceTrustInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTrustInfo
trust
        BinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
trust_pkg
        BinHandle -> [IfaceCompleteMatch] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCompleteMatch]
complete_matches
        BinHandle -> Maybe Docs -> IO ()
forall a. Binary a => BinHandle -> Maybe a -> IO ()
lazyPutMaybe BinHandle
bh Maybe Docs
docs

   get :: BinHandle -> IO ModIface
get BinHandle
bh = do
        Module
mod         <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe Module
sig_of      <- BinHandle -> IO (Maybe Module)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        HscSource
hsc_src     <- BinHandle -> IO HscSource
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        ModIfaceSelfRecomp
self_recomp_info <- BinHandle -> IO ModIfaceSelfRecomp
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        ModIfaceSelfRecompBackend
self_recomp_backend_info <- BinHandle -> IO ModIfaceSelfRecompBackend
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
mod_hash    <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        WhetherHasOrphans
orphan      <- BinHandle -> IO WhetherHasOrphans
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        WhetherHasOrphans
hasFamInsts <- BinHandle -> IO WhetherHasOrphans
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Dependencies
deps        <- BinHandle -> IO Dependencies
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
        [IfaceExport]
exports     <- {-# SCC "bin_exports" #-} BinHandle -> IO [IfaceExport]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Fingerprint
exp_hash    <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        WhetherHasOrphans
used_th     <- BinHandle -> IO WhetherHasOrphans
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [(OccName, Fixity)]
fixities    <- {-# SCC "bin_fixities" #-} BinHandle -> IO [(OccName, Fixity)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Warnings GhcRn
warns       <- {-# SCC "bin_warns" #-} BinHandle -> IO (Warnings GhcRn)
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
        [IfaceAnnotation]
anns        <- {-# SCC "bin_anns" #-} BinHandle -> IO [IfaceAnnotation]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
        [(Fingerprint, IfaceDecl)]
decls       <- {-# SCC "bin_tycldecls" #-} BinHandle -> IO [(Fingerprint, IfaceDecl)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls <- BinHandle
-> IO (Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceClsInst]
insts       <- {-# SCC "bin_insts" #-} BinHandle -> IO [IfaceClsInst]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceFamInst]
fam_insts   <- {-# SCC "bin_fam_insts" #-} BinHandle -> IO [IfaceFamInst]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceRule]
rules       <- {-# SCC "bin_rules" #-} BinHandle -> IO [IfaceRule]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
        Fingerprint
orphan_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        WhetherHasOrphans
hpc_info    <- BinHandle -> IO WhetherHasOrphans
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceTrustInfo
trust       <- BinHandle -> IO IfaceTrustInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        WhetherHasOrphans
trust_pkg   <- BinHandle -> IO WhetherHasOrphans
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceCompleteMatch]
complete_matches <- BinHandle -> IO [IfaceCompleteMatch]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe Docs
docs        <- BinHandle -> IO (Maybe Docs)
forall a. Binary a => BinHandle -> IO (Maybe a)
lazyGetMaybe BinHandle
bh
        ModIface -> IO ModIface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface {
                 mi_module :: Module
mi_module      = Module
mod,
                 mi_sig_of :: Maybe Module
mi_sig_of      = Maybe Module
sig_of,
                 mi_hsc_src :: HscSource
mi_hsc_src     = HscSource
hsc_src,
                 mi_deps :: Dependencies
mi_deps        = Dependencies
deps,
                 mi_exports :: [IfaceExport]
mi_exports     = [IfaceExport]
exports,
                 mi_used_th :: WhetherHasOrphans
mi_used_th     = WhetherHasOrphans
used_th,
                 mi_anns :: [IfaceAnnotation]
mi_anns        = [IfaceAnnotation]
anns,
                 mi_fixities :: [(OccName, Fixity)]
mi_fixities    = [(OccName, Fixity)]
fixities,
                 mi_warns :: Warnings GhcRn
mi_warns       = Warnings GhcRn
warns,
                 mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls       = [(Fingerprint, IfaceDecl)]
[IfaceDeclExts 'ModIfaceFinal]
decls,
                 mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls = Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls,
                 mi_globals :: Maybe GlobalRdrEnv
mi_globals     = Maybe GlobalRdrEnv
forall a. Maybe a
Nothing,
                 mi_insts :: [IfaceClsInst]
mi_insts       = [IfaceClsInst]
insts,
                 mi_fam_insts :: [IfaceFamInst]
mi_fam_insts   = [IfaceFamInst]
fam_insts,
                 mi_rules :: [IfaceRule]
mi_rules       = [IfaceRule]
rules,
                 mi_hpc :: WhetherHasOrphans
mi_hpc         = WhetherHasOrphans
hpc_info,
                 mi_trust :: IfaceTrustInfo
mi_trust       = IfaceTrustInfo
trust,
                 mi_trust_pkg :: WhetherHasOrphans
mi_trust_pkg   = WhetherHasOrphans
trust_pkg,
                        -- And build the cached values
                 mi_complete_matches :: [IfaceCompleteMatch]
mi_complete_matches = [IfaceCompleteMatch]
complete_matches,
                 mi_docs :: Maybe Docs
mi_docs        = Maybe Docs
docs,
                 mi_ext_fields :: ExtensibleFields
mi_ext_fields  = ExtensibleFields
emptyExtensibleFields, -- placeholder because this is dealt
                                                         -- with specially when the file is read
                 mi_self_recomp_info :: ModIfaceSelfRecomp
mi_self_recomp_info = ModIfaceSelfRecomp
self_recomp_info,
                 mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = ModIfaceBackend {
                   mi_self_recomp_backend_info :: ModIfaceSelfRecompBackend
mi_self_recomp_backend_info = ModIfaceSelfRecompBackend
self_recomp_backend_info,
                   mi_mod_hash :: Fingerprint
mi_mod_hash = Fingerprint
mod_hash,
                   mi_orphan :: WhetherHasOrphans
mi_orphan = WhetherHasOrphans
orphan,
                   mi_finsts :: WhetherHasOrphans
mi_finsts = WhetherHasOrphans
hasFamInsts,
                   mi_exp_hash :: Fingerprint
mi_exp_hash = Fingerprint
exp_hash,
                   mi_orphan_hash :: Fingerprint
mi_orphan_hash = Fingerprint
orphan_hash,
                   mi_warn_fn :: OccName -> Maybe (WarningTxt GhcRn)
mi_warn_fn = Warnings GhcRn -> OccName -> Maybe (WarningTxt GhcRn)
forall p. Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceWarnCache Warnings GhcRn
warns,
                   mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
fixities,
                   mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn = [(Fingerprint, IfaceDecl)]
-> OccName -> Maybe (OccName, Fingerprint)
mkIfaceHashCache [(Fingerprint, IfaceDecl)]
decls
                 }})

-- | The original names declared of a certain module that are exported
type IfaceExport = AvailInfo

emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface Module
mod
  = ModIface { mi_module :: Module
mi_module      = Module
mod,
               mi_sig_of :: Maybe Module
mi_sig_of      = Maybe Module
forall a. Maybe a
Nothing,
               mi_hsc_src :: HscSource
mi_hsc_src     = HscSource
HsSrcFile,
               mi_deps :: Dependencies
mi_deps        = Dependencies
noDependencies,
               mi_exports :: [IfaceExport]
mi_exports     = [],
               mi_used_th :: WhetherHasOrphans
mi_used_th     = WhetherHasOrphans
False,
               mi_fixities :: [(OccName, Fixity)]
mi_fixities    = [],
               mi_warns :: Warnings GhcRn
mi_warns       = Warnings GhcRn
forall pass. Warnings pass
NoWarnings,
               mi_anns :: [IfaceAnnotation]
mi_anns        = [],
               mi_insts :: [IfaceClsInst]
mi_insts       = [],
               mi_fam_insts :: [IfaceFamInst]
mi_fam_insts   = [],
               mi_rules :: [IfaceRule]
mi_rules       = [],
               mi_decls :: [IfaceDeclExts 'ModIfaceCore]
mi_decls       = [],
               mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls = Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall a. Maybe a
Nothing,
               mi_globals :: Maybe GlobalRdrEnv
mi_globals     = Maybe GlobalRdrEnv
forall a. Maybe a
Nothing,
               mi_hpc :: WhetherHasOrphans
mi_hpc         = WhetherHasOrphans
False,
               mi_trust :: IfaceTrustInfo
mi_trust       = IfaceTrustInfo
noIfaceTrustInfo,
               mi_trust_pkg :: WhetherHasOrphans
mi_trust_pkg   = WhetherHasOrphans
False,
               mi_complete_matches :: [IfaceCompleteMatch]
mi_complete_matches = [],
               mi_docs :: Maybe Docs
mi_docs        = Maybe Docs
forall a. Maybe a
Nothing,
               mi_final_exts :: IfaceBackendExts 'ModIfaceCore
mi_final_exts  = (),
               mi_self_recomp_info :: ModIfaceSelfRecomp
mi_self_recomp_info = ModIfaceSelfRecomp
NoSelfRecomp,
               mi_ext_fields :: ExtensibleFields
mi_ext_fields  = ExtensibleFields
emptyExtensibleFields
             }

emptyFullModIface :: Module -> ModIface
emptyFullModIface :: Module -> ModIface
emptyFullModIface Module
mod =
    (Module -> PartialModIface
emptyPartialModIface Module
mod)
      { mi_decls = []
      , mi_final_exts = ModIfaceBackend {
          mi_mod_hash = fingerprint0,
          mi_self_recomp_backend_info = NoSelfRecompBackend, -- TODO
          mi_orphan = False,
          mi_finsts = False,
          mi_exp_hash = fingerprint0,
          mi_orphan_hash = fingerprint0,
          mi_warn_fn = emptyIfaceWarnCache,
          mi_fix_fn = emptyIfaceFixCache,
          mi_hash_fn = emptyIfaceHashCache } }

-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
                 -> (OccName -> Maybe (OccName, Fingerprint))
mkIfaceHashCache :: [(Fingerprint, IfaceDecl)]
-> OccName -> Maybe (OccName, Fingerprint)
mkIfaceHashCache [(Fingerprint, IfaceDecl)]
pairs
  = \OccName
occ -> OccEnv (OccName, Fingerprint)
-> OccName -> Maybe (OccName, Fingerprint)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (OccName, Fingerprint)
env OccName
occ
  where
    env :: OccEnv (OccName, Fingerprint)
env = (OccEnv (OccName, Fingerprint)
 -> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint))
-> OccEnv (OccName, Fingerprint)
-> [(Fingerprint, IfaceDecl)]
-> OccEnv (OccName, Fingerprint)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint)
add_decl OccEnv (OccName, Fingerprint)
forall a. OccEnv a
emptyOccEnv [(Fingerprint, IfaceDecl)]
pairs
    add_decl :: OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint)
add_decl OccEnv (OccName, Fingerprint)
env0 (Fingerprint
v,IfaceDecl
d) = (OccEnv (OccName, Fingerprint)
 -> (OccName, Fingerprint) -> OccEnv (OccName, Fingerprint))
-> OccEnv (OccName, Fingerprint)
-> [(OccName, Fingerprint)]
-> OccEnv (OccName, Fingerprint)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv (OccName, Fingerprint)
-> (OccName, Fingerprint) -> OccEnv (OccName, Fingerprint)
forall {b}.
OccEnv (OccName, b) -> (OccName, b) -> OccEnv (OccName, b)
add OccEnv (OccName, Fingerprint)
env0 (Fingerprint -> IfaceDecl -> [(OccName, Fingerprint)]
ifaceDeclFingerprints Fingerprint
v IfaceDecl
d)
      where
        add :: OccEnv (OccName, b) -> (OccName, b) -> OccEnv (OccName, b)
add OccEnv (OccName, b)
env0 (OccName
occ,b
hash) = OccEnv (OccName, b)
-> OccName -> (OccName, b) -> OccEnv (OccName, b)
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv (OccName, b)
env0 OccName
occ (OccName
occ,b
hash)

emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache OccName
_occ = Maybe (OccName, Fingerprint)
forall a. Maybe a
Nothing

-- Take care, this instance only forces to the degree necessary to
-- avoid major space leaks.
instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where
  rnf :: ModIface_ phase -> ()
rnf (ModIface Module
f1 Maybe Module
f2 HscSource
f3 Dependencies
f4 [IfaceExport]
f6 WhetherHasOrphans
f7 [(OccName, Fixity)]
f8 Warnings GhcRn
f9 [IfaceAnnotation]
f10 [IfaceDeclExts phase]
f11 Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
f12
                Maybe GlobalRdrEnv
f13 [IfaceClsInst]
f14 [IfaceFamInst]
f15 [IfaceRule]
f16 WhetherHasOrphans
f17 IfaceTrustInfo
f18 WhetherHasOrphans
f19 [IfaceCompleteMatch]
f20 Maybe Docs
f21 IfaceBackendExts phase
f22 ExtensibleFields
f23 ModIfaceSelfRecomp
f24) =
    Module -> ()
forall a. NFData a => a -> ()
rnf Module
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Module -> ()
forall a. NFData a => a -> ()
rnf Maybe Module
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` HscSource
f3 HscSource -> () -> ()
forall a b. a -> b -> b
`seq` Dependencies
f4 Dependencies -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceExport]
f6 [IfaceExport] -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f7 () -> () -> ()
forall a b. a -> b -> b
`seq` [(OccName, Fixity)]
f8 [(OccName, Fixity)] -> () -> ()
forall a b. a -> b -> b
`seq`
    Warnings GhcRn
f9 Warnings GhcRn -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceAnnotation] -> ()
forall a. NFData a => a -> ()
rnf [IfaceAnnotation]
f10 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceDeclExts phase] -> ()
forall a. NFData a => a -> ()
rnf [IfaceDeclExts phase]
f11 () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ()
forall a. NFData a => a -> ()
rnf Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
f12 () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe GlobalRdrEnv
f13 Maybe GlobalRdrEnv -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceClsInst] -> ()
forall a. NFData a => a -> ()
rnf [IfaceClsInst]
f14 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceFamInst] -> ()
forall a. NFData a => a -> ()
rnf [IfaceFamInst]
f15 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceRule] -> ()
forall a. NFData a => a -> ()
rnf [IfaceRule]
f16 () -> () -> ()
forall a b. a -> b -> b
`seq`
    WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f17 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTrustInfo
f18 IfaceTrustInfo -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f19 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCompleteMatch] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCompleteMatch]
f20 () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Docs -> ()
forall a. NFData a => a -> ()
rnf Maybe Docs
f21 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceBackendExts phase
f22 IfaceBackendExts phase -> () -> ()
forall a b. a -> b -> b
`seq` ExtensibleFields
f23 ExtensibleFields -> () -> ()
forall a b. a -> b -> b
`seq` ModIfaceSelfRecomp -> ()
forall a. NFData a => a -> ()
rnf ModIfaceSelfRecomp
f24
    () -> () -> ()
forall a b. a -> b -> b
`seq` ()


instance NFData (ModIfaceBackend) where
  rnf :: ModIfaceBackend -> ()
rnf (ModIfaceBackend Fingerprint
f1 ModIfaceSelfRecompBackend
f2 WhetherHasOrphans
f3 WhetherHasOrphans
f4 Fingerprint
f5 Fingerprint
f6 OccName -> Maybe (WarningTxt GhcRn)
f7 OccName -> Maybe Fixity
f8 OccName -> Maybe (OccName, Fingerprint)
f9)
    = Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` ModIfaceSelfRecompBackend -> ()
forall a. NFData a => a -> ()
rnf ModIfaceSelfRecompBackend
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f4 () -> () -> ()
forall a b. a -> b -> b
`seq`
      Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
f5 () -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
f6 () -> () -> ()
forall a b. a -> b -> b
`seq` (OccName -> Maybe (WarningTxt GhcRn)) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe (WarningTxt GhcRn)
f7 () -> () -> ()
forall a b. a -> b -> b
`seq` (OccName -> Maybe Fixity) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe Fixity
f8 () -> () -> ()
forall a b. a -> b -> b
`seq`
      (OccName -> Maybe (OccName, Fingerprint)) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe (OccName, Fingerprint)
f9

instance NFData ModIfaceSelfRecompBackend where
  -- Sufficient as all fields are strict (and simple)
  rnf :: ModIfaceSelfRecompBackend -> ()
rnf ModIfaceSelfRecompBackend
NoSelfRecompBackend = ()
  -- Written like this so if you add another field you have to think about it
  rnf !(ModIfaceSelfRecompBackend Fingerprint
_ Fingerprint
_ Fingerprint
_ Fingerprint
_ Fingerprint
_) = ()
instance NFData ModIfaceSelfRecomp where
  -- Sufficient as all fields are strict (and simple)
  rnf :: ModIfaceSelfRecomp -> ()
rnf ModIfaceSelfRecomp
NoSelfRecomp = ()
  -- MP: Note does not deeply force Usages but the old ModIface logic didn't either, so
  -- I left it as a shallow force.
  rnf (ModIfaceSelfRecomp Fingerprint
src_hash [Usage]
usages) = Fingerprint
src_hash Fingerprint -> () -> ()
forall a b. a -> b -> b
`seq` [Usage]
usages [Usage] -> () -> ()
forall a b. a -> b -> b
`seq` ()


forceModIface :: ModIface -> IO ()
forceModIface :: ModIface -> IO ()
forceModIface ModIface
iface = () () -> IO ModIface -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ModIface -> IO ModIface
forall a. a -> IO a
evaluate (ModIface -> IO ModIface) -> ModIface -> IO ModIface
forall a b. (a -> b) -> a -> b
$ ModIface -> ModIface
forall a. NFData a => a -> a
force ModIface
iface)

-- | Records whether a module has orphans. An \"orphan\" is one of:
--
-- * An instance declaration in a module other than the definition
--   module for one of the type constructors or classes in the instance head
--
-- * A rewrite rule in a module other than the one defining
--   the function in the head of the rule
--
type WhetherHasOrphans   = Bool

-- | Does this module define family instances?
type WhetherHasFamInst = Bool