{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
module GHC.Unit.Module.ModIface
( ModIface
, ModIface_
( mi_module
, mi_sig_of
, mi_hsc_src
, mi_deps
, mi_usages
, mi_exports
, mi_used_th
, mi_fixities
, mi_warns
, mi_anns
, mi_decls
, mi_defaults
, mi_extra_decls
, mi_foreign
, mi_top_env
, mi_insts
, mi_fam_insts
, mi_rules
, mi_hpc
, mi_trust
, mi_trust_pkg
, mi_complete_matches
, mi_docs
, mi_final_exts
, mi_ext_fields
, mi_src_hash
, mi_hi_bytes
)
, pattern ModIface
, restoreFromOldModIface
, addSourceFingerprint
, set_mi_module
, set_mi_sig_of
, set_mi_hsc_src
, set_mi_src_hash
, set_mi_hi_bytes
, set_mi_deps
, set_mi_usages
, set_mi_exports
, set_mi_used_th
, set_mi_fixities
, set_mi_warns
, set_mi_anns
, set_mi_insts
, set_mi_fam_insts
, set_mi_rules
, set_mi_decls
, set_mi_defaults
, set_mi_extra_decls
, set_mi_foreign
, set_mi_top_env
, set_mi_hpc
, set_mi_trust
, set_mi_trust_pkg
, set_mi_complete_matches
, set_mi_docs
, set_mi_final_exts
, set_mi_ext_fields
, completePartialModIface
, IfaceBinHandle(..)
, PartialModIface
, ModIfaceBackend (..)
, IfaceDeclExts
, IfaceBackendExts
, IfaceExport
, WhetherHasOrphans
, WhetherHasFamInst
, IfaceTopEnv (..)
, IfaceImport(..)
, mi_boot
, mi_fix
, mi_semantic_module
, mi_free_holes
, mi_mnwib
, 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.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign)
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 (IfGlobalRdrEnv)
import GHC.Types.SafeHaskell
import GHC.Types.SourceFile
import GHC.Types.Unique.DSet
import GHC.Types.Unique.FM
import GHC.Data.Maybe
import qualified GHC.Data.Strict as Strict
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
import Control.DeepSeq
import Control.Exception
type PartialModIface = ModIface_ 'ModIfaceCore
type ModIface = ModIface_ 'ModIfaceFinal
data ModIfaceBackend = ModIfaceBackend
{ ModIfaceBackend -> Fingerprint
mi_iface_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_mod_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_flag_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_opt_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_hpc_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_plugin_hash :: !Fingerprint
, ModIfaceBackend -> WhetherHasOrphans
mi_orphan :: !WhetherHasOrphans
, ModIfaceBackend -> WhetherHasOrphans
mi_finsts :: !WhetherHasFamInst
, ModIfaceBackend -> Fingerprint
mi_exp_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_orphan_hash :: !Fingerprint
, ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn))
, ModIfaceBackend -> Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn :: !(Name -> Maybe (WarningTxt GhcRn))
, ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn :: !(OccName -> Maybe Fixity)
, ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))
}
data ModIfacePhase
= ModIfaceCore
| ModIfaceFinal
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
data IfaceBinHandle (phase :: ModIfacePhase) where
PartialIfaceBinHandle :: IfaceBinHandle 'ModIfaceCore
FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal
data ModIface_ (phase :: ModIfacePhase)
= PrivateModIface {
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module_ :: !Module,
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of_ :: !(Maybe Module),
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src_ :: !HscSource,
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps_ :: Dependencies,
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages_ :: [Usage],
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports_ :: ![IfaceExport],
forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_used_th_ :: !Bool,
forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities_ :: [(OccName,Fixity)],
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceWarnings
mi_warns_ :: IfaceWarnings,
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns_ :: [IfaceAnnotation],
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls_ :: [IfaceDeclExts phase],
:: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceForeign
mi_foreign_ :: !IfaceForeign,
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceDefault]
mi_defaults_ :: [IfaceDefault],
forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe IfaceTopEnv
mi_top_env_ :: !(Maybe IfaceTopEnv),
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts_ :: [IfaceClsInst],
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts_ :: [IfaceFamInst],
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules_ :: [IfaceRule],
forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_hpc_ :: !AnyHpcUsage,
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust_ :: !IfaceTrustInfo,
forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_trust_pkg_ :: !Bool,
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches_ :: ![IfaceCompleteMatch],
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs_ :: !(Maybe Docs),
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts_ :: !(IfaceBackendExts phase),
forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields_ :: !ExtensibleFields,
forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash_ :: !Fingerprint,
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBinHandle phase
mi_hi_bytes_ :: !(IfaceBinHandle phase)
}
data IfaceTopEnv
= IfaceTopEnv
{ IfaceTopEnv -> IfGlobalRdrEnv
ifaceTopExports :: !IfGlobalRdrEnv
, IfaceTopEnv -> [IfaceImport]
ifaceImports :: ![IfaceImport]
}
instance NFData IfaceTopEnv where
rnf :: IfaceTopEnv -> ()
rnf (IfaceTopEnv IfGlobalRdrEnv
a [IfaceImport]
b) = IfGlobalRdrEnv -> ()
forall a. NFData a => a -> ()
rnf IfGlobalRdrEnv
a () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceImport] -> ()
forall a. NFData a => a -> ()
rnf [IfaceImport]
b
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)
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
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
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)
-> 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
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
| WhetherHasOrphans
otherwise = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet
instance Binary ModIface where
put_ :: WriteBinHandle -> ModIface -> IO ()
put_ WriteBinHandle
bh (PrivateModIface {
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_src_hash_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash_ = Fingerprint
_src_hash,
mi_hi_bytes_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBinHandle phase
mi_hi_bytes_ = IfaceBinHandle 'ModIfaceFinal
_hi_bytes,
mi_deps_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps_ = Dependencies
deps,
mi_usages_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages_ = [Usage]
usages,
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 -> IfaceWarnings
mi_warns_ = IfaceWarnings
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_foreign_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceForeign
mi_foreign_ = IfaceForeign
foreign_,
mi_defaults_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceDefault]
mi_defaults_ = [IfaceDefault]
defaults,
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,
mi_final_exts_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts_ = ModIfaceBackend {
mi_iface_hash :: ModIfaceBackend -> Fingerprint
mi_iface_hash = Fingerprint
iface_hash,
mi_mod_hash :: ModIfaceBackend -> Fingerprint
mi_mod_hash = Fingerprint
mod_hash,
mi_flag_hash :: ModIfaceBackend -> Fingerprint
mi_flag_hash = Fingerprint
flag_hash,
mi_opt_hash :: ModIfaceBackend -> Fingerprint
mi_opt_hash = Fingerprint
opt_hash,
mi_hpc_hash :: ModIfaceBackend -> Fingerprint
mi_hpc_hash = Fingerprint
hpc_hash,
mi_plugin_hash :: ModIfaceBackend -> Fingerprint
mi_plugin_hash = Fingerprint
plugin_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
WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
mod
WriteBinHandle -> Maybe Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe Module
sig_of
WriteBinHandle -> HscSource -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh HscSource
hsc_src
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
iface_hash
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
mod_hash
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
flag_hash
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
opt_hash
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
hpc_hash
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
plugin_hash
WriteBinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WhetherHasOrphans
orphan
WriteBinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WhetherHasOrphans
hasFamInsts
WriteBinHandle -> Dependencies -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh Dependencies
deps
WriteBinHandle -> [Usage] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [Usage]
usages
WriteBinHandle -> [IfaceExport] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceExport]
exports
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
exp_hash
WriteBinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WhetherHasOrphans
used_th
WriteBinHandle -> [(OccName, Fixity)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [(OccName, Fixity)]
fixities
WriteBinHandle -> IfaceWarnings -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh IfaceWarnings
warns
WriteBinHandle -> [IfaceAnnotation] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [IfaceAnnotation]
anns
WriteBinHandle -> [(Fingerprint, IfaceDecl)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [(Fingerprint, IfaceDecl)]
[IfaceDeclExts 'ModIfaceFinal]
decls
WriteBinHandle
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls
WriteBinHandle -> [IfaceDefault] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceDefault]
defaults
WriteBinHandle -> IfaceForeign -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceForeign
foreign_
WriteBinHandle -> [IfaceClsInst] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceClsInst]
insts
WriteBinHandle -> [IfaceFamInst] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceFamInst]
fam_insts
WriteBinHandle -> [IfaceRule] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [IfaceRule]
rules
WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
orphan_hash
WriteBinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WhetherHasOrphans
hpc_info
WriteBinHandle -> IfaceTrustInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTrustInfo
trust
WriteBinHandle -> WhetherHasOrphans -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WhetherHasOrphans
trust_pkg
WriteBinHandle -> [IfaceCompleteMatch] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCompleteMatch]
complete_matches
WriteBinHandle -> Maybe Docs -> IO ()
forall a. Binary a => WriteBinHandle -> Maybe a -> IO ()
lazyPutMaybe WriteBinHandle
bh Maybe Docs
docs
get :: ReadBinHandle -> IO ModIface
get ReadBinHandle
bh = do
mod <- ReadBinHandle -> IO Module
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
sig_of <- get bh
hsc_src <- get bh
iface_hash <- get bh
mod_hash <- get bh
flag_hash <- get bh
opt_hash <- get bh
hpc_hash <- get bh
plugin_hash <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
usages <- {-# SCC "bin_usages" #-} lazyGet bh
exports <- {-# SCC "bin_exports" #-} get bh
exp_hash <- get bh
used_th <- get bh
fixities <- {-# SCC "bin_fixities" #-} get bh
warns <- {-# SCC "bin_warns" #-} lazyGet bh
anns <- {-# SCC "bin_anns" #-} lazyGet bh
decls <- {-# SCC "bin_tycldecls" #-} get bh
extra_decls <- get bh
defaults <- get bh
foreign_ <- get bh
insts <- {-# SCC "bin_insts" #-} get bh
fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
rules <- {-# SCC "bin_rules" #-} lazyGet bh
orphan_hash <- get bh
hpc_info <- get bh
trust <- get bh
trust_pkg <- get bh
complete_matches <- get bh
docs <- lazyGetMaybe bh
return (PrivateModIface {
mi_module_ = mod,
mi_sig_of_ = sig_of,
mi_hsc_src_ = hsc_src,
mi_src_hash_ = fingerprint0,
mi_hi_bytes_ =
FullIfaceBinHandle Strict.Nothing,
mi_deps_ = deps,
mi_usages_ = usages,
mi_exports_ = exports,
mi_used_th_ = used_th,
mi_anns_ = anns,
mi_fixities_ = fixities,
mi_warns_ = warns,
mi_decls_ = decls,
mi_extra_decls_ = extra_decls,
mi_foreign_ = foreign_,
mi_top_env_ = Nothing,
mi_defaults_ = defaults,
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
mi_rules_ = rules,
mi_hpc_ = hpc_info,
mi_trust_ = trust,
mi_trust_pkg_ = trust_pkg,
mi_complete_matches_ = complete_matches,
mi_docs_ = docs,
mi_ext_fields_ = emptyExtensibleFields,
mi_final_exts_ = ModIfaceBackend {
mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
mi_flag_hash = flag_hash,
mi_opt_hash = opt_hash,
mi_hpc_hash = hpc_hash,
mi_plugin_hash = plugin_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_exp_hash = exp_hash,
mi_orphan_hash = orphan_hash,
mi_decl_warn_fn = mkIfaceDeclWarnCache $ fromIfaceWarnings warns,
mi_export_warn_fn = mkIfaceExportWarnCache $ fromIfaceWarnings warns,
mi_fix_fn = mkIfaceFixCache fixities,
mi_hash_fn = mkIfaceHashCache decls
}})
type IfaceExport = AvailInfo
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface Module
mod
= PrivateModIface
{ 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_src_hash_ :: Fingerprint
mi_src_hash_ = Fingerprint
fingerprint0,
mi_hi_bytes_ :: IfaceBinHandle 'ModIfaceCore
mi_hi_bytes_ = IfaceBinHandle 'ModIfaceCore
PartialIfaceBinHandle,
mi_deps_ :: Dependencies
mi_deps_ = Dependencies
noDependencies,
mi_usages_ :: [Usage]
mi_usages_ = [],
mi_exports_ :: [IfaceExport]
mi_exports_ = [],
mi_used_th_ :: WhetherHasOrphans
mi_used_th_ = WhetherHasOrphans
False,
mi_fixities_ :: [(OccName, Fixity)]
mi_fixities_ = [],
mi_warns_ :: IfaceWarnings
mi_warns_ = [(OccName, IfaceWarningTxt)]
-> [(Name, IfaceWarningTxt)] -> IfaceWarnings
IfWarnSome [] [],
mi_anns_ :: [IfaceAnnotation]
mi_anns_ = [],
mi_defaults_ :: [IfaceDefault]
mi_defaults_ = [],
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_foreign_ :: IfaceForeign
mi_foreign_ = IfaceForeign
emptyIfaceForeign,
mi_top_env_ :: Maybe IfaceTopEnv
mi_top_env_ = Maybe IfaceTopEnv
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_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_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
, mi_final_exts_ = ModIfaceBackend
{ mi_iface_hash = fingerprint0,
mi_mod_hash = fingerprint0,
mi_flag_hash = fingerprint0,
mi_opt_hash = fingerprint0,
mi_hpc_hash = fingerprint0,
mi_plugin_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_exp_hash = fingerprint0,
mi_orphan_hash = fingerprint0,
mi_decl_warn_fn = emptyIfaceWarnCache,
mi_export_warn_fn = emptyIfaceWarnCache,
mi_fix_fn = emptyIfaceFixCache,
mi_hash_fn = emptyIfaceHashCache } }
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
instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
, NFData (IfaceDeclExts (phase :: ModIfacePhase))
) => NFData (ModIface_ phase) where
rnf :: ModIface_ phase -> ()
rnf (PrivateModIface
{ Module
mi_module_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module_ :: Module
mi_module_, Maybe Module
mi_sig_of_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of_ :: Maybe Module
mi_sig_of_, HscSource
mi_hsc_src_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src_ :: HscSource
mi_hsc_src_, IfaceBinHandle phase
mi_hi_bytes_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBinHandle phase
mi_hi_bytes_ :: IfaceBinHandle phase
mi_hi_bytes_, Dependencies
mi_deps_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps_ :: Dependencies
mi_deps_, [Usage]
mi_usages_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages_ :: [Usage]
mi_usages_
, [IfaceExport]
mi_exports_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports_ :: [IfaceExport]
mi_exports_, WhetherHasOrphans
mi_used_th_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_used_th_ :: WhetherHasOrphans
mi_used_th_, [(OccName, Fixity)]
mi_fixities_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities_ :: [(OccName, Fixity)]
mi_fixities_, IfaceWarnings
mi_warns_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceWarnings
mi_warns_ :: IfaceWarnings
mi_warns_, [IfaceAnnotation]
mi_anns_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns_ :: [IfaceAnnotation]
mi_anns_
, [IfaceDeclExts phase]
mi_decls_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls_ :: [IfaceDeclExts phase]
mi_decls_, [IfaceDefault]
mi_defaults_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceDefault]
mi_defaults_ :: [IfaceDefault]
mi_defaults_, Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls_ :: forall (phase :: ModIfacePhase).
ModIface_ phase
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls_ :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls_, IfaceForeign
mi_foreign_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceForeign
mi_foreign_ :: IfaceForeign
mi_foreign_, Maybe IfaceTopEnv
mi_top_env_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe IfaceTopEnv
mi_top_env_ :: Maybe IfaceTopEnv
mi_top_env_, [IfaceClsInst]
mi_insts_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts_ :: [IfaceClsInst]
mi_insts_
, [IfaceFamInst]
mi_fam_insts_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts_ :: [IfaceFamInst]
mi_fam_insts_, [IfaceRule]
mi_rules_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules_ :: [IfaceRule]
mi_rules_, WhetherHasOrphans
mi_hpc_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_hpc_ :: WhetherHasOrphans
mi_hpc_, IfaceTrustInfo
mi_trust_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust_ :: IfaceTrustInfo
mi_trust_, WhetherHasOrphans
mi_trust_pkg_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_trust_pkg_ :: WhetherHasOrphans
mi_trust_pkg_
, [IfaceCompleteMatch]
mi_complete_matches_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches_ :: [IfaceCompleteMatch]
mi_complete_matches_, Maybe Docs
mi_docs_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs_ :: Maybe Docs
mi_docs_, IfaceBackendExts phase
mi_final_exts_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts_ :: IfaceBackendExts phase
mi_final_exts_
, ExtensibleFields
mi_ext_fields_ :: forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields_ :: ExtensibleFields
mi_ext_fields_, Fingerprint
mi_src_hash_ :: forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash_ :: Fingerprint
mi_src_hash_ })
= Module -> ()
forall a. NFData a => a -> ()
rnf Module
mi_module_
() -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Module -> ()
forall a. NFData a => a -> ()
rnf Maybe Module
mi_sig_of_
() -> () -> ()
forall a b. a -> b -> b
`seq` HscSource
mi_hsc_src_
HscSource -> () -> ()
forall a b. a -> b -> b
`seq` IfaceBinHandle phase
mi_hi_bytes_
IfaceBinHandle phase -> () -> ()
forall a b. a -> b -> b
`seq` Dependencies
mi_deps_
Dependencies -> () -> ()
forall a b. a -> b -> b
`seq` [Usage]
mi_usages_
[Usage] -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceExport]
mi_exports_
[IfaceExport] -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
mi_used_th_
() -> () -> ()
forall a b. a -> b -> b
`seq` [(OccName, Fixity)]
mi_fixities_
[(OccName, Fixity)] -> () -> ()
forall a b. a -> b -> b
`seq` IfaceWarnings -> ()
forall a. NFData a => a -> ()
rnf IfaceWarnings
mi_warns_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceAnnotation] -> ()
forall a. NFData a => a -> ()
rnf [IfaceAnnotation]
mi_anns_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceDeclExts phase] -> ()
forall a. NFData a => a -> ()
rnf [IfaceDeclExts phase]
mi_decls_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceDefault] -> ()
forall a. NFData a => a -> ()
rnf [IfaceDefault]
mi_defaults_
() -> () -> ()
forall a b. a -> b -> b
`seq` Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ()
forall a. NFData a => a -> ()
rnf Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls_
() -> () -> ()
forall a b. a -> b -> b
`seq` IfaceForeign -> ()
forall a. NFData a => a -> ()
rnf IfaceForeign
mi_foreign_
() -> () -> ()
forall a b. a -> b -> b
`seq` Maybe IfaceTopEnv -> ()
forall a. NFData a => a -> ()
rnf Maybe IfaceTopEnv
mi_top_env_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceClsInst] -> ()
forall a. NFData a => a -> ()
rnf [IfaceClsInst]
mi_insts_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceFamInst] -> ()
forall a. NFData a => a -> ()
rnf [IfaceFamInst]
mi_fam_insts_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceRule] -> ()
forall a. NFData a => a -> ()
rnf [IfaceRule]
mi_rules_
() -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
mi_hpc_
() -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTrustInfo
mi_trust_
IfaceTrustInfo -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
mi_trust_pkg_
() -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCompleteMatch] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCompleteMatch]
mi_complete_matches_
() -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Docs -> ()
forall a. NFData a => a -> ()
rnf Maybe Docs
mi_docs_
() -> () -> ()
forall a b. a -> b -> b
`seq` IfaceBackendExts phase
mi_final_exts_
IfaceBackendExts phase -> () -> ()
forall a b. a -> b -> b
`seq` ExtensibleFields
mi_ext_fields_
ExtensibleFields -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_src_hash_
() -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance NFData (ModIfaceBackend) where
rnf :: ModIfaceBackend -> ()
rnf (ModIfaceBackend{ Fingerprint
mi_iface_hash :: ModIfaceBackend -> Fingerprint
mi_iface_hash :: Fingerprint
mi_iface_hash, Fingerprint
mi_mod_hash :: ModIfaceBackend -> Fingerprint
mi_mod_hash :: Fingerprint
mi_mod_hash, Fingerprint
mi_flag_hash :: ModIfaceBackend -> Fingerprint
mi_flag_hash :: Fingerprint
mi_flag_hash, Fingerprint
mi_opt_hash :: ModIfaceBackend -> Fingerprint
mi_opt_hash :: Fingerprint
mi_opt_hash
, Fingerprint
mi_hpc_hash :: ModIfaceBackend -> Fingerprint
mi_hpc_hash :: Fingerprint
mi_hpc_hash, Fingerprint
mi_plugin_hash :: ModIfaceBackend -> Fingerprint
mi_plugin_hash :: Fingerprint
mi_plugin_hash, WhetherHasOrphans
mi_orphan :: ModIfaceBackend -> WhetherHasOrphans
mi_orphan :: WhetherHasOrphans
mi_orphan, WhetherHasOrphans
mi_finsts :: ModIfaceBackend -> WhetherHasOrphans
mi_finsts :: WhetherHasOrphans
mi_finsts, Fingerprint
mi_exp_hash :: ModIfaceBackend -> Fingerprint
mi_exp_hash :: Fingerprint
mi_exp_hash
, Fingerprint
mi_orphan_hash :: ModIfaceBackend -> Fingerprint
mi_orphan_hash :: Fingerprint
mi_orphan_hash, OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn :: ModIfaceBackend -> OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn :: OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn, Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn :: ModIfaceBackend -> Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn :: Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn, OccName -> Maybe Fixity
mi_fix_fn :: ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn
, OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn :: ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn})
= Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_iface_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_mod_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_flag_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_opt_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_hpc_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_plugin_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
mi_orphan
() -> () -> ()
forall a b. a -> b -> b
`seq` WhetherHasOrphans -> ()
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
mi_finsts
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_exp_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
mi_orphan_hash
() -> () -> ()
forall a b. a -> b -> b
`seq` (OccName -> Maybe (WarningTxt GhcRn)) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe (WarningTxt GhcRn)
mi_decl_warn_fn
() -> () -> ()
forall a b. a -> b -> b
`seq` (Name -> Maybe (WarningTxt GhcRn)) -> ()
forall a. NFData a => a -> ()
rnf Name -> Maybe (WarningTxt GhcRn)
mi_export_warn_fn
() -> () -> ()
forall a b. a -> b -> b
`seq` (OccName -> Maybe Fixity) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe Fixity
mi_fix_fn
() -> () -> ()
forall a b. a -> b -> b
`seq` (OccName -> Maybe (OccName, Fingerprint)) -> ()
forall a. NFData a => a -> ()
rnf OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn
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)
type WhetherHasOrphans = Bool
type WhetherHasFamInst = Bool
completePartialModIface :: PartialModIface
-> [(Fingerprint, IfaceDecl)]
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> ModIfaceBackend
-> ModIface
completePartialModIface :: PartialModIface
-> [(Fingerprint, IfaceDecl)]
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> ModIfaceBackend
-> ModIface
completePartialModIface PartialModIface
partial [(Fingerprint, IfaceDecl)]
decls Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls ModIfaceBackend
final_exts = PartialModIface
partial
{ mi_decls_ = decls
, mi_extra_decls_ = extra_decls
, mi_final_exts_ = final_exts
, mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing
}
addSourceFingerprint :: Fingerprint -> ModIface_ phase -> ModIface_ phase
addSourceFingerprint :: forall (phase :: ModIfacePhase).
Fingerprint -> ModIface_ phase -> ModIface_ phase
addSourceFingerprint Fingerprint
val ModIface_ phase
iface = ModIface_ phase
iface { mi_src_hash_ = val }
restoreFromOldModIface :: ModIface_ phase -> ModIface_ phase -> ModIface_ phase
restoreFromOldModIface :: forall (phase :: ModIfacePhase).
ModIface_ phase -> ModIface_ phase -> ModIface_ phase
restoreFromOldModIface ModIface_ phase
old ModIface_ phase
new = ModIface_ phase
new
{ mi_top_env_ = mi_top_env_ old
, mi_hsc_src_ = mi_hsc_src_ old
, mi_src_hash_ = mi_src_hash_ old
}
set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase
set_mi_module :: forall (phase :: ModIfacePhase).
Module -> ModIface_ phase -> ModIface_ phase
set_mi_module Module
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_module_ = val }
set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase
set_mi_sig_of :: forall (phase :: ModIfacePhase).
Maybe Module -> ModIface_ phase -> ModIface_ phase
set_mi_sig_of Maybe Module
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_sig_of_ = val }
set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase
set_mi_hsc_src :: forall (phase :: ModIfacePhase).
HscSource -> ModIface_ phase -> ModIface_ phase
set_mi_hsc_src HscSource
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_hsc_src_ = val }
set_mi_src_hash :: Fingerprint -> ModIface_ phase -> ModIface_ phase
set_mi_src_hash :: forall (phase :: ModIfacePhase).
Fingerprint -> ModIface_ phase -> ModIface_ phase
set_mi_src_hash Fingerprint
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_src_hash_ = val }
set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
set_mi_hi_bytes :: forall (phase :: ModIfacePhase).
IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
set_mi_hi_bytes IfaceBinHandle phase
val ModIface_ phase
iface = ModIface_ phase
iface { mi_hi_bytes_ = val }
set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase
set_mi_deps :: forall (phase :: ModIfacePhase).
Dependencies -> ModIface_ phase -> ModIface_ phase
set_mi_deps Dependencies
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_deps_ = val }
set_mi_usages :: [Usage] -> ModIface_ phase -> ModIface_ phase
set_mi_usages :: forall (phase :: ModIfacePhase).
[Usage] -> ModIface_ phase -> ModIface_ phase
set_mi_usages [Usage]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_usages_ = val }
set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase
set_mi_exports :: forall (phase :: ModIfacePhase).
[IfaceExport] -> ModIface_ phase -> ModIface_ phase
set_mi_exports [IfaceExport]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_exports_ = val }
set_mi_used_th :: Bool -> ModIface_ phase -> ModIface_ phase
set_mi_used_th :: forall (phase :: ModIfacePhase).
WhetherHasOrphans -> ModIface_ phase -> ModIface_ phase
set_mi_used_th WhetherHasOrphans
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_used_th_ = val }
set_mi_fixities :: [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
set_mi_fixities :: forall (phase :: ModIfacePhase).
[(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
set_mi_fixities [(OccName, Fixity)]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_fixities_ = val }
set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase
set_mi_warns :: forall (phase :: ModIfacePhase).
IfaceWarnings -> ModIface_ phase -> ModIface_ phase
set_mi_warns IfaceWarnings
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_warns_ = val }
set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
set_mi_anns :: forall (phase :: ModIfacePhase).
[IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
set_mi_anns [IfaceAnnotation]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_anns_ = val }
set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
set_mi_insts :: forall (phase :: ModIfacePhase).
[IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
set_mi_insts [IfaceClsInst]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_insts_ = val }
set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
set_mi_fam_insts :: forall (phase :: ModIfacePhase).
[IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
set_mi_fam_insts [IfaceFamInst]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_fam_insts_ = val }
set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase
set_mi_rules :: forall (phase :: ModIfacePhase).
[IfaceRule] -> ModIface_ phase -> ModIface_ phase
set_mi_rules [IfaceRule]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_rules_ = val }
set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
set_mi_decls :: forall (phase :: ModIfacePhase).
[IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
set_mi_decls [IfaceDeclExts phase]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_decls_ = val }
set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase
set_mi_defaults :: forall (phase :: ModIfacePhase).
[IfaceDefault] -> ModIface_ phase -> ModIface_ phase
set_mi_defaults [IfaceDefault]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_defaults_ = val }
set_mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_extra_decls_ = val }
set_mi_foreign :: IfaceForeign -> ModIface_ phase -> ModIface_ phase
set_mi_foreign :: forall (phase :: ModIfacePhase).
IfaceForeign -> ModIface_ phase -> ModIface_ phase
set_mi_foreign IfaceForeign
foreign_ ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_foreign_ = foreign_ }
set_mi_top_env :: Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env :: forall (phase :: ModIfacePhase).
Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env Maybe IfaceTopEnv
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_top_env_ = val }
set_mi_hpc :: AnyHpcUsage -> ModIface_ phase -> ModIface_ phase
set_mi_hpc :: forall (phase :: ModIfacePhase).
WhetherHasOrphans -> ModIface_ phase -> ModIface_ phase
set_mi_hpc WhetherHasOrphans
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_hpc_ = val }
set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
set_mi_trust :: forall (phase :: ModIfacePhase).
IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
set_mi_trust IfaceTrustInfo
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_trust_ = val }
set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase
set_mi_trust_pkg :: forall (phase :: ModIfacePhase).
WhetherHasOrphans -> ModIface_ phase -> ModIface_ phase
set_mi_trust_pkg WhetherHasOrphans
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_trust_pkg_ = val }
set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase
set_mi_complete_matches :: forall (phase :: ModIfacePhase).
[IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase
set_mi_complete_matches [IfaceCompleteMatch]
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_complete_matches_ = val }
set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase
set_mi_docs :: forall (phase :: ModIfacePhase).
Maybe Docs -> ModIface_ phase -> ModIface_ phase
set_mi_docs Maybe Docs
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_docs_ = val }
set_mi_final_exts :: IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase
set_mi_final_exts :: forall (phase :: ModIfacePhase).
IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase
set_mi_final_exts IfaceBackendExts phase
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_final_exts_ = val }
set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase
set_mi_ext_fields :: forall (phase :: ModIfacePhase).
ExtensibleFields -> ModIface_ phase -> ModIface_ phase
set_mi_ext_fields ExtensibleFields
val ModIface_ phase
iface = ModIface_ phase -> ModIface_ phase
forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes (ModIface_ phase -> ModIface_ phase)
-> ModIface_ phase -> ModIface_ phase
forall a b. (a -> b) -> a -> b
$ ModIface_ phase
iface { mi_ext_fields_ = val }
clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes :: forall (phase :: ModIfacePhase). ModIface_ phase -> ModIface_ phase
clear_mi_hi_bytes ModIface_ phase
iface = ModIface_ phase
iface
{ mi_hi_bytes_ = case mi_hi_bytes iface of
IfaceBinHandle phase
PartialIfaceBinHandle -> IfaceBinHandle phase
IfaceBinHandle 'ModIfaceCore
PartialIfaceBinHandle
FullIfaceBinHandle Maybe FullBinData
_ -> Maybe FullBinData -> IfaceBinHandle 'ModIfaceFinal
FullIfaceBinHandle Maybe FullBinData
forall a. Maybe a
Strict.Nothing
}
{-# INLINE ModIface #-}
{-# INLINE mi_module #-}
{-# INLINE mi_sig_of #-}
{-# INLINE mi_hsc_src #-}
{-# INLINE mi_deps #-}
{-# INLINE mi_usages #-}
{-# INLINE mi_exports #-}
{-# INLINE mi_used_th #-}
{-# INLINE mi_fixities #-}
{-# INLINE mi_warns #-}
{-# INLINE mi_anns #-}
{-# INLINE mi_decls #-}
{-# INLINE mi_extra_decls #-}
{-# INLINE mi_foreign #-}
{-# INLINE mi_top_env #-}
{-# INLINE mi_insts #-}
{-# INLINE mi_fam_insts #-}
{-# INLINE mi_rules #-}
{-# INLINE mi_hpc #-}
{-# INLINE mi_trust #-}
{-# INLINE mi_trust_pkg #-}
{-# INLINE mi_complete_matches #-}
{-# INLINE mi_docs #-}
{-# INLINE mi_final_exts #-}
{-# INLINE mi_ext_fields #-}
{-# INLINE mi_src_hash #-}
{-# INLINE mi_hi_bytes #-}
{-# COMPLETE ModIface #-}
pattern ModIface ::
Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] ->
[IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings ->
[IfaceAnnotation] -> [IfaceDeclExts phase] ->
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->
[IfaceDefault] -> Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase ->
ModIface_ phase
pattern $mModIface :: forall {r} {phase :: ModIfacePhase}.
ModIface_ phase
-> (Module
-> Maybe Module
-> HscSource
-> Dependencies
-> [Usage]
-> [IfaceExport]
-> WhetherHasOrphans
-> [(OccName, Fixity)]
-> IfaceWarnings
-> [IfaceAnnotation]
-> [IfaceDeclExts phase]
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> IfaceForeign
-> [IfaceDefault]
-> Maybe IfaceTopEnv
-> [IfaceClsInst]
-> [IfaceFamInst]
-> [IfaceRule]
-> WhetherHasOrphans
-> IfaceTrustInfo
-> WhetherHasOrphans
-> [IfaceCompleteMatch]
-> Maybe Docs
-> IfaceBackendExts phase
-> ExtensibleFields
-> Fingerprint
-> IfaceBinHandle phase
-> r)
-> ((# #) -> r)
-> r
ModIface
{ forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module
, forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of
, forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src
, forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps
, forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages
, forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports
, forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_used_th
, forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities
, forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceWarnings
mi_warns
, forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns
, forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls
,
, forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceForeign
mi_foreign
, forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceDefault]
mi_defaults
, forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe IfaceTopEnv
mi_top_env
, forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts
, forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts
, forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules
, forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_hpc
, forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust
, forall (phase :: ModIfacePhase).
ModIface_ phase -> WhetherHasOrphans
mi_trust_pkg
, forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches
, forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs
, forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts
, forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields
, forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash
, forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBinHandle phase
mi_hi_bytes
} <- PrivateModIface
{ mi_module_ = mi_module
, mi_sig_of_ = mi_sig_of
, mi_hsc_src_ = mi_hsc_src
, mi_deps_ = mi_deps
, mi_usages_ = mi_usages
, mi_exports_ = mi_exports
, mi_used_th_ = mi_used_th
, mi_fixities_ = mi_fixities
, mi_warns_ = mi_warns
, mi_anns_ = mi_anns
, mi_decls_ = mi_decls
, mi_extra_decls_ = mi_extra_decls
, mi_foreign_ = mi_foreign
, mi_defaults_ = mi_defaults
, mi_top_env_ = mi_top_env
, mi_insts_ = mi_insts
, mi_fam_insts_ = mi_fam_insts
, mi_rules_ = mi_rules
, mi_hpc_ = mi_hpc
, mi_trust_ = mi_trust
, mi_trust_pkg_ = mi_trust_pkg
, mi_complete_matches_ = mi_complete_matches
, mi_docs_ = mi_docs
, mi_final_exts_ = mi_final_exts
, mi_ext_fields_ = mi_ext_fields
, mi_src_hash_ = mi_src_hash
, mi_hi_bytes_ = mi_hi_bytes
}