{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Unit.Module.ModIface
( ModIface
, ModIface_ (..)
, PartialModIface
, ModIfaceBackend (..)
, IfaceDeclExts
, IfaceBackendExts
, IfaceExport
, WhetherHasOrphans
, WhetherHasFamInst
, mi_boot
, mi_fix
, mi_semantic_module
, mi_free_holes
, renameFreeHoles
, emptyPartialModIface
, emptyFullModIface
, mkIfaceHashCache
, emptyIfaceHashCache
)
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
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
mi_warn_fn :: !(OccName -> Maybe WarningTxt)
, 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) where
IfaceDeclExts 'ModIfaceCore = IfaceDecl
IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl)
type family IfaceBackendExts (phase :: ModIfacePhase) where
IfaceBackendExts 'ModIfaceCore = ()
IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend
data ModIface_ (phase :: ModIfacePhase)
= ModIface {
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 -> Warnings
mi_warns :: Warnings,
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns :: [IfaceAnnotation],
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls :: [IfaceDeclExts phase],
forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe GlobalRdrEnv
mi_globals :: !(Maybe GlobalRdrEnv),
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 HsDocString
mi_doc_hdr :: Maybe HsDocString,
forall (phase :: ModIfacePhase). ModIface_ phase -> DeclDocMap
mi_decl_docs :: DeclDocMap,
forall (phase :: ModIfacePhase). ModIface_ phase -> ArgDocMap
mi_arg_docs :: ArgDocMap,
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts :: !(IfaceBackendExts phase),
forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields :: ExtensibleFields
}
mi_boot :: ModIface -> IsBootInterface
mi_boot :: ModIface -> IsBootInterface
mi_boot ModIface
iface = if forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface forall a. Eq a => a -> a -> WhetherHasOrphans
== HscSource
HsBootFile
then IsBootInterface
IsBoot
else IsBootInterface
NotBoot
mi_fix :: ModIface -> OccName -> Fixity
mi_fix :: ModIface -> OccName -> Fixity
mi_fix ModIface
iface OccName
name = ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) OccName
name 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 forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface_ a
iface of
Maybe Module
Nothing -> 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 (forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) of
(InstalledModule
_, Just InstantiatedModule
indef)
-> UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles (forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet [ModuleName]
cands) (forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef))
(InstalledModule, Maybe InstantiatedModule)
_ -> forall a. UniqDSet a
emptyUniqDSet
where
cands :: [ModuleName]
cands = forall a b. (a -> b) -> [a] -> [b]
map forall mod. GenWithIsBoot mod -> mod
gwib_mod forall a b. (a -> b) -> a -> b
$ Dependencies -> [ModuleNameWithIsBoot]
dep_mods forall a b. (a -> b) -> a -> b
$ 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 =
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> UniqDSet ModuleName
lookup_impl (forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet ModuleName
fhs))
where
hmap :: UniqFM ModuleName Module
hmap = 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 <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM ModuleName Module
hmap ModuleName
mod_name = forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles Module
mod
| WhetherHasOrphans
otherwise = forall a. UniqDSet a
emptyUniqDSet
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_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 -> Warnings
mi_warns = Warnings
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_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_doc_hdr :: forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe HsDocString
mi_doc_hdr = Maybe HsDocString
doc_hdr,
mi_decl_docs :: forall (phase :: ModIfacePhase). ModIface_ phase -> DeclDocMap
mi_decl_docs = DeclDocMap
decl_docs,
mi_arg_docs :: forall (phase :: ModIfacePhase). ModIface_ phase -> ArgDocMap
mi_arg_docs = ArgDocMap
arg_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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
mod
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Module
sig_of
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HscSource
hsc_src
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
iface_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mod_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
flag_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
opt_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
hpc_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
plugin_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
orphan
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
hasFamInsts
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Dependencies
deps
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [Usage]
usages
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExport]
exports
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
exp_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
used_th
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, Fixity)]
fixities
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Warnings
warns
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceAnnotation]
anns
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceDeclExts 'ModIfaceFinal]
decls
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceClsInst]
insts
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceFamInst]
fam_insts
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceRule]
rules
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
orphan_hash
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
hpc_info
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTrustInfo
trust
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WhetherHasOrphans
trust_pkg
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCompleteMatch]
complete_matches
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Maybe HsDocString
doc_hdr
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh DeclDocMap
decl_docs
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh ArgDocMap
arg_docs
get :: BinHandle -> IO ModIface
get BinHandle
bh = do
Module
mod <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe Module
sig_of <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
HscSource
hsc_src <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
iface_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
flag_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
opt_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hpc_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
plugin_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WhetherHasOrphans
orphan <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WhetherHasOrphans
hasFamInsts <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Dependencies
deps <- forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[Usage]
usages <- {-# SCC "bin_usages" #-} forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[IfaceExport]
exports <- {-# SCC "bin_exports" #-} forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
exp_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WhetherHasOrphans
used_th <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(OccName, Fixity)]
fixities <- {-# SCC "bin_fixities" #-} forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings
warns <- {-# SCC "bin_warns" #-} forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[IfaceAnnotation]
anns <- {-# SCC "bin_anns" #-} forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[(Fingerprint, IfaceDecl)]
decls <- {-# SCC "bin_tycldecls" #-} forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceClsInst]
insts <- {-# SCC "bin_insts" #-} forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceFamInst]
fam_insts <- {-# SCC "bin_fam_insts" #-} forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceRule]
rules <- {-# SCC "bin_rules" #-} forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
Fingerprint
orphan_hash <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WhetherHasOrphans
hpc_info <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTrustInfo
trust <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
WhetherHasOrphans
trust_pkg <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCompleteMatch]
complete_matches <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe HsDocString
doc_hdr <- forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
DeclDocMap
decl_docs <- forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
ArgDocMap
arg_docs <- forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
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_usages :: [Usage]
mi_usages = [Usage]
usages,
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
mi_warns = Warnings
warns,
mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = [(Fingerprint, IfaceDecl)]
decls,
mi_globals :: Maybe GlobalRdrEnv
mi_globals = 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,
mi_complete_matches :: [IfaceCompleteMatch]
mi_complete_matches = [IfaceCompleteMatch]
complete_matches,
mi_doc_hdr :: Maybe HsDocString
mi_doc_hdr = Maybe HsDocString
doc_hdr,
mi_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
decl_docs,
mi_arg_docs :: ArgDocMap
mi_arg_docs = ArgDocMap
arg_docs,
mi_ext_fields :: ExtensibleFields
mi_ext_fields = ExtensibleFields
emptyExtensibleFields,
mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = ModIfaceBackend {
mi_iface_hash :: Fingerprint
mi_iface_hash = Fingerprint
iface_hash,
mi_mod_hash :: Fingerprint
mi_mod_hash = Fingerprint
mod_hash,
mi_flag_hash :: Fingerprint
mi_flag_hash = Fingerprint
flag_hash,
mi_opt_hash :: Fingerprint
mi_opt_hash = Fingerprint
opt_hash,
mi_hpc_hash :: Fingerprint
mi_hpc_hash = Fingerprint
hpc_hash,
mi_plugin_hash :: Fingerprint
mi_plugin_hash = Fingerprint
plugin_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
mi_warn_fn = Warnings -> OccName -> Maybe WarningTxt
mkIfaceWarnCache Warnings
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
}})
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 = forall a. Maybe a
Nothing,
mi_hsc_src :: HscSource
mi_hsc_src = HscSource
HsSrcFile,
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 :: Warnings
mi_warns = Warnings
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_globals :: Maybe GlobalRdrEnv
mi_globals = 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_doc_hdr :: Maybe HsDocString
mi_doc_hdr = forall a. Maybe a
Nothing,
mi_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
emptyDeclDocMap,
mi_arg_docs :: ArgDocMap
mi_arg_docs = ArgDocMap
emptyArgDocMap,
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 :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = []
, mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = ModIfaceBackend
{ mi_iface_hash :: Fingerprint
mi_iface_hash = Fingerprint
fingerprint0,
mi_mod_hash :: Fingerprint
mi_mod_hash = Fingerprint
fingerprint0,
mi_flag_hash :: Fingerprint
mi_flag_hash = Fingerprint
fingerprint0,
mi_opt_hash :: Fingerprint
mi_opt_hash = Fingerprint
fingerprint0,
mi_hpc_hash :: Fingerprint
mi_hpc_hash = Fingerprint
fingerprint0,
mi_plugin_hash :: Fingerprint
mi_plugin_hash = Fingerprint
fingerprint0,
mi_orphan :: WhetherHasOrphans
mi_orphan = WhetherHasOrphans
False,
mi_finsts :: WhetherHasOrphans
mi_finsts = WhetherHasOrphans
False,
mi_exp_hash :: Fingerprint
mi_exp_hash = Fingerprint
fingerprint0,
mi_orphan_hash :: Fingerprint
mi_orphan_hash = Fingerprint
fingerprint0,
mi_warn_fn :: OccName -> Maybe WarningTxt
mi_warn_fn = OccName -> Maybe WarningTxt
emptyIfaceWarnCache,
mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = OccName -> Maybe Fixity
emptyIfaceFixCache,
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn = OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache } }
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
-> (OccName -> Maybe (OccName, Fingerprint))
mkIfaceHashCache :: [(Fingerprint, IfaceDecl)]
-> OccName -> Maybe (OccName, Fingerprint)
mkIfaceHashCache [(Fingerprint, IfaceDecl)]
pairs
= \OccName
occ -> forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (OccName, Fingerprint)
env OccName
occ
where
env :: OccEnv (OccName, Fingerprint)
env = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint)
add_decl 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) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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) = 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 = forall a. Maybe a
Nothing
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 [Usage]
f5 [IfaceExport]
f6 WhetherHasOrphans
f7 [(OccName, Fixity)]
f8 Warnings
f9 [IfaceAnnotation]
f10 [IfaceDeclExts phase]
f11 Maybe GlobalRdrEnv
f12
[IfaceClsInst]
f13 [IfaceFamInst]
f14 [IfaceRule]
f15 WhetherHasOrphans
f16 IfaceTrustInfo
f17 WhetherHasOrphans
f18 [IfaceCompleteMatch]
f19 Maybe HsDocString
f20 DeclDocMap
f21 ArgDocMap
f22 IfaceBackendExts phase
f23 ExtensibleFields
f24) =
forall a. NFData a => a -> ()
rnf Module
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Module
f2 seq :: forall a b. a -> b -> b
`seq` HscSource
f3 seq :: forall a b. a -> b -> b
`seq` Dependencies
f4 seq :: forall a b. a -> b -> b
`seq` [Usage]
f5 seq :: forall a b. a -> b -> b
`seq` [IfaceExport]
f6 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f7 seq :: forall a b. a -> b -> b
`seq` [(OccName, Fixity)]
f8 seq :: forall a b. a -> b -> b
`seq`
Warnings
f9 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceAnnotation]
f10 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceDeclExts phase]
f11 seq :: forall a b. a -> b -> b
`seq` Maybe GlobalRdrEnv
f12 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceClsInst]
f13 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceFamInst]
f14 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceRule]
f15 seq :: forall a b. a -> b -> b
`seq`
forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f16 seq :: forall a b. a -> b -> b
`seq` IfaceTrustInfo
f17 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf WhetherHasOrphans
f18 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceCompleteMatch]
f19 seq :: forall a b. a -> b -> b
`seq` Maybe HsDocString
f20 seq :: forall a b. a -> b -> b
`seq` DeclDocMap
f21 seq :: forall a b. a -> b -> b
`seq` ArgDocMap
f22 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceBackendExts phase
f23
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ExtensibleFields
f24
type WhetherHasOrphans = Bool
type WhetherHasFamInst = Bool