{-# 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
type PartialModIface = ModIface_ 'ModIfaceCore
type ModIface = ModIface_ 'ModIfaceFinal
data ModIfaceBackend = ModIfaceBackend
{ ModIfaceBackend -> Fingerprint
mi_mod_hash :: !Fingerprint
, ModIfaceBackend -> ModIfaceSelfRecompBackend
mi_self_recomp_backend_info :: !ModIfaceSelfRecompBackend
, 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_warn_fn :: !(OccName -> 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 ModIfaceSelfRecompBackend = NoSelfRecompBackend | ModIfaceSelfRecompBackend {
ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_flag_hash :: !Fingerprint
, ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_iface_hash :: !Fingerprint
, ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_opt_hash :: !Fingerprint
, ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_hpc_hash :: !Fingerprint
, ModIfaceSelfRecompBackend -> Fingerprint
mi_sr_plugin_hash :: !Fingerprint
}
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
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 -> [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 GhcRn
mi_warns :: (Warnings GhcRn),
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 -> 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 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 -> ModIfaceSelfRecomp
mi_self_recomp_info :: !ModIfaceSelfRecomp
}
data ModIfaceSelfRecomp = NoSelfRecomp
| ModIfaceSelfRecomp { ModIfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: !Fingerprint
, ModIfaceSelfRecomp -> [Usage]
mi_sr_usages :: [Usage]
}
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
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 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)
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,
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,
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,
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
}})
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,
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 } }
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 (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
rnf :: ModIfaceSelfRecompBackend -> ()
rnf ModIfaceSelfRecompBackend
NoSelfRecompBackend = ()
rnf !(ModIfaceSelfRecompBackend Fingerprint
_ Fingerprint
_ Fingerprint
_ Fingerprint
_ Fingerprint
_) = ()
instance NFData ModIfaceSelfRecomp where
rnf :: ModIfaceSelfRecomp -> ()
rnf ModIfaceSelfRecomp
NoSelfRecomp = ()
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)
type WhetherHasOrphans = Bool
type WhetherHasFamInst = Bool