diff options
Diffstat (limited to 'compiler/GHC/Unit/Module/ModIface.hs')
-rw-r--r-- | compiler/GHC/Unit/Module/ModIface.hs | 537 |
1 files changed, 537 insertions, 0 deletions
diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs new file mode 100644 index 0000000000..83bc565b6f --- /dev/null +++ b/compiler/GHC/Unit/Module/ModIface.hs @@ -0,0 +1,537 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# 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 + +{- Note [Interface file stages] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Interface files have two possible stages. + +* A partial stage built from the result of the core pipeline. +* A fully instantiated form. Which also includes fingerprints and + potentially information provided by backends. + +We can build a full interface file two ways: +* Directly from a partial one: + Then we omit backend information and mostly compute fingerprints. +* From a partial one + information produced by a backend. + Then we store the provided information and fingerprint both. +-} + +type PartialModIface = ModIface_ 'ModIfaceCore +type ModIface = ModIface_ 'ModIfaceFinal + +-- | Extends a PartialModIface with information which is either: +-- * Computed after codegen +-- * Or computed just before writing the iface to disk. (Hashes) +-- In order to fully instantiate it. +data ModIfaceBackend = ModIfaceBackend + { mi_iface_hash :: !Fingerprint + -- ^ Hash of the whole interface + , mi_mod_hash :: !Fingerprint + -- ^ Hash of the ABI only + , mi_flag_hash :: !Fingerprint + -- ^ Hash of the important flags used when compiling the module, excluding + -- optimisation flags + , mi_opt_hash :: !Fingerprint + -- ^ Hash of optimisation flags + , mi_hpc_hash :: !Fingerprint + -- ^ Hash of hpc flags + , mi_plugin_hash :: !Fingerprint + -- ^ Hash of plugins + , mi_orphan :: !WhetherHasOrphans + -- ^ Whether this module has orphans + , mi_finsts :: !WhetherHasFamInst + -- ^ Whether this module has family instances. See Note [The type family + -- instance consistency story]. + , mi_exp_hash :: !Fingerprint + -- ^ Hash of export list + , mi_orphan_hash :: !Fingerprint + -- ^ Hash for orphan rules, class and family instances combined + + -- Cached environments for easy lookup. These are computed (lazily) from + -- other fields and are not put into the interface file. + -- Not really produced by the backend but there is no need to create them + -- any earlier. + , mi_warn_fn :: !(OccName -> Maybe WarningTxt) + -- ^ Cached lookup for 'mi_warns' + , mi_fix_fn :: !(OccName -> Maybe Fixity) + -- ^ Cached lookup for 'mi_fixities' + , mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint)) + -- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that + -- the thing isn't in decls. It's useful to know that when seeing if we are + -- up to date wrt. the old interface. The 'OccName' is the parent of the + -- name, if it has one. + } + +data ModIfacePhase + = ModIfaceCore + -- ^ Partial interface built based on output of core pipeline. + | ModIfaceFinal + +-- | Selects a IfaceDecl representation. +-- For fully instantiated interfaces we also maintain +-- a fingerprint, which is used for recompilation checks. +type family IfaceDeclExts (phase :: ModIfacePhase) where + IfaceDeclExts 'ModIfaceCore = IfaceDecl + IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl) + +type family IfaceBackendExts (phase :: ModIfacePhase) where + IfaceBackendExts 'ModIfaceCore = () + IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend + + + +-- | A 'ModIface' plus a 'ModDetails' summarises everything we know +-- about a compiled module. The 'ModIface' is the stuff *before* linking, +-- and can be written out to an interface file. The 'ModDetails is after +-- linking and can be completely recovered from just the 'ModIface'. +-- +-- When we read an interface file, we also construct a 'ModIface' from it, +-- except that we explicitly make the 'mi_decls' and a few other fields empty; +-- as when reading we consolidate the declarations etc. into a number of indexed +-- maps and environments in the 'ExternalPackageState'. +data ModIface_ (phase :: ModIfacePhase) + = ModIface { + mi_module :: !Module, -- ^ Name of the module we are for + mi_sig_of :: !(Maybe Module), -- ^ Are we a sig of another mod? + + mi_hsc_src :: !HscSource, -- ^ Boot? Signature? + + mi_deps :: Dependencies, + -- ^ The dependencies of the module. This is + -- consulted for directly-imported modules, but not + -- for anything else (hence lazy) + + mi_usages :: [Usage], + -- ^ Usages; kept sorted so that it's easy to decide + -- whether to write a new iface file (changing usages + -- doesn't affect the hash of this module) + -- NOT STRICT! we read this field lazily from the interface file + -- It is *only* consulted by the recompilation checker + + mi_exports :: ![IfaceExport], + -- ^ Exports + -- Kept sorted by (mod,occ), to make version comparisons easier + -- Records the modules that are the declaration points for things + -- exported by this module, and the 'OccName's of those things + + + mi_used_th :: !Bool, + -- ^ Module required TH splices when it was compiled. + -- This disables recompilation avoidance (see #481). + + mi_fixities :: [(OccName,Fixity)], + -- ^ Fixities + -- NOT STRICT! we read this field lazily from the interface file + + mi_warns :: Warnings, + -- ^ Warnings + -- NOT STRICT! we read this field lazily from the interface file + + mi_anns :: [IfaceAnnotation], + -- ^ Annotations + -- NOT STRICT! we read this field lazily from the interface file + + + mi_decls :: [IfaceDeclExts phase], + -- ^ Type, class and variable declarations + -- The hash of an Id changes if its fixity or deprecations change + -- (as well as its type of course) + -- Ditto data constructors, class operations, except that + -- the hash of the parent class/tycon changes + + mi_globals :: !(Maybe GlobalRdrEnv), + -- ^ Binds all the things defined at the top level in + -- the /original source/ code for this module. which + -- is NOT the same as mi_exports, nor mi_decls (which + -- may contains declarations for things not actually + -- defined by the user). Used for GHCi and for inspecting + -- the contents of modules via the GHC API only. + -- + -- (We need the source file to figure out the + -- top-level environment, if we didn't compile this module + -- from source then this field contains @Nothing@). + -- + -- Strictly speaking this field should live in the + -- 'HomeModInfo', but that leads to more plumbing. + + -- Instance declarations and rules + mi_insts :: [IfaceClsInst], -- ^ Sorted class instance + mi_fam_insts :: [IfaceFamInst], -- ^ Sorted family instances + mi_rules :: [IfaceRule], -- ^ Sorted rules + + mi_hpc :: !AnyHpcUsage, + -- ^ True if this program uses Hpc at any point in the program. + + mi_trust :: !IfaceTrustInfo, + -- ^ Safe Haskell Trust information for this module. + + mi_trust_pkg :: !Bool, + -- ^ Do we require the package this module resides in be trusted + -- to trust this module? This is used for the situation where a + -- module is Safe (so doesn't require the package be trusted + -- itself) but imports some trustworthy modules from its own + -- package (which does require its own package be trusted). + -- See Note [Trust Own Package] in GHC.Rename.Names + mi_complete_matches :: [IfaceCompleteMatch], + + mi_doc_hdr :: Maybe HsDocString, + -- ^ Module header. + + mi_decl_docs :: DeclDocMap, + -- ^ Docs on declarations. + + mi_arg_docs :: ArgDocMap, + -- ^ Docs on arguments. + + mi_final_exts :: !(IfaceBackendExts phase), + -- ^ Either `()` or `ModIfaceBackend` for + -- a fully instantiated interface. + + mi_ext_fields :: ExtensibleFields + -- ^ Additional optional fields, where the Map key represents + -- the field name, resulting in a (size, serialized data) pair. + -- Because the data is intended to be serialized through the + -- internal `Binary` class (increasing compatibility with types + -- using `Name` and `FastString`, such as HIE), this format is + -- chosen over `ByteString`s. + } + +-- | Old-style accessor for whether or not the ModIface came from an hs-boot +-- file. +mi_boot :: ModIface -> IsBootInterface +mi_boot iface = if mi_hsc_src iface == HsBootFile + then IsBoot + else NotBoot + +-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be +-- found, 'defaultFixity' is returned instead. +mi_fix :: ModIface -> OccName -> Fixity +mi_fix iface name = mi_fix_fn (mi_final_exts iface) name `orElse` defaultFixity + +-- | The semantic module for this interface; e.g., if it's a interface +-- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module' +-- will be @<A>@. +mi_semantic_module :: ModIface_ a -> Module +mi_semantic_module iface = case mi_sig_of iface of + Nothing -> mi_module iface + Just mod -> mod + +-- | The "precise" free holes, e.g., the signatures that this +-- 'ModIface' depends on. +mi_free_holes :: ModIface -> UniqDSet ModuleName +mi_free_holes iface = + case getModuleInstantiation (mi_module iface) of + (_, Just indef) + -- A mini-hack: we rely on the fact that 'renameFreeHoles' + -- drops things that aren't holes. + -> renameFreeHoles (mkUniqDSet cands) (instUnitInsts (moduleUnit indef)) + _ -> emptyUniqDSet + where + cands = map gwib_mod $ dep_mods $ mi_deps iface + +-- | Given a set of free holes, and a unit identifier, rename +-- the free holes according to the instantiation of the unit +-- identifier. For example, if we have A and B free, and +-- our unit identity is @p[A=<C>,B=impl:B]@, the renamed free +-- holes are just C. +renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName +renameFreeHoles fhs insts = + unionManyUniqDSets (map lookup_impl (uniqDSetToList fhs)) + where + hmap = listToUFM insts + lookup_impl mod_name + | Just mod <- lookupUFM hmap mod_name = moduleFreeHoles mod + -- It wasn't actually a hole + | otherwise = emptyUniqDSet + + +instance Binary ModIface where + put_ bh (ModIface { + mi_module = mod, + mi_sig_of = sig_of, + mi_hsc_src = hsc_src, + mi_deps = deps, + mi_usages = usages, + mi_exports = exports, + mi_used_th = used_th, + mi_fixities = fixities, + mi_warns = warns, + mi_anns = anns, + mi_decls = decls, + 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_doc_hdr = doc_hdr, + mi_decl_docs = decl_docs, + mi_arg_docs = arg_docs, + mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we + -- can deal with it's pointer in the header + -- when we write the actual file + mi_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 + }}) = do + put_ bh mod + put_ bh sig_of + put_ bh hsc_src + put_ bh iface_hash + put_ bh mod_hash + put_ bh flag_hash + put_ bh opt_hash + put_ bh hpc_hash + put_ bh plugin_hash + put_ bh orphan + put_ bh hasFamInsts + lazyPut bh deps + lazyPut bh usages + put_ bh exports + put_ bh exp_hash + put_ bh used_th + put_ bh fixities + lazyPut bh warns + lazyPut bh anns + put_ bh decls + put_ bh insts + put_ bh fam_insts + lazyPut bh rules + put_ bh orphan_hash + put_ bh hpc_info + put_ bh trust + put_ bh trust_pkg + put_ bh complete_matches + lazyPut bh doc_hdr + lazyPut bh decl_docs + lazyPut bh arg_docs + + get bh = do + mod <- get 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 + 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 + doc_hdr <- lazyGet bh + decl_docs <- lazyGet bh + arg_docs <- lazyGet bh + return (ModIface { + mi_module = mod, + mi_sig_of = sig_of, + mi_hsc_src = hsc_src, + 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_globals = Nothing, + mi_insts = insts, + mi_fam_insts = fam_insts, + mi_rules = rules, + mi_hpc = hpc_info, + mi_trust = trust, + mi_trust_pkg = trust_pkg, + -- And build the cached values + mi_complete_matches = complete_matches, + mi_doc_hdr = doc_hdr, + mi_decl_docs = decl_docs, + mi_arg_docs = arg_docs, + mi_ext_fields = emptyExtensibleFields, -- placeholder because this is dealt + -- with specially when the file is read + 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_warn_fn = mkIfaceWarnCache warns, + mi_fix_fn = mkIfaceFixCache fixities, + mi_hash_fn = mkIfaceHashCache decls + }}) + +-- | The original names declared of a certain module that are exported +type IfaceExport = AvailInfo + +emptyPartialModIface :: Module -> PartialModIface +emptyPartialModIface mod + = ModIface { mi_module = mod, + mi_sig_of = Nothing, + mi_hsc_src = HsSrcFile, + mi_deps = noDependencies, + mi_usages = [], + mi_exports = [], + mi_used_th = False, + mi_fixities = [], + mi_warns = NoWarnings, + mi_anns = [], + mi_insts = [], + mi_fam_insts = [], + mi_rules = [], + mi_decls = [], + mi_globals = Nothing, + mi_hpc = False, + mi_trust = noIfaceTrustInfo, + mi_trust_pkg = False, + mi_complete_matches = [], + mi_doc_hdr = Nothing, + mi_decl_docs = emptyDeclDocMap, + mi_arg_docs = emptyArgDocMap, + mi_final_exts = (), + mi_ext_fields = emptyExtensibleFields + } + +emptyFullModIface :: Module -> ModIface +emptyFullModIface mod = + (emptyPartialModIface mod) + { mi_decls = [] + , 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_warn_fn = emptyIfaceWarnCache, + mi_fix_fn = emptyIfaceFixCache, + mi_hash_fn = emptyIfaceHashCache } } + +-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' +mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] + -> (OccName -> Maybe (OccName, Fingerprint)) +mkIfaceHashCache pairs + = \occ -> lookupOccEnv env occ + where + env = foldl' add_decl emptyOccEnv pairs + add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d) + where + add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash) + +emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) +emptyIfaceHashCache _occ = Nothing + +-- Take care, this instance only forces to the degree necessary to +-- avoid major space leaks. +instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where + rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 + f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = + rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` + f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq` + rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23 + `seq` rnf f24 + +-- | Records whether a module has orphans. An \"orphan\" is one of: +-- +-- * An instance declaration in a module other than the definition +-- module for one of the type constructors or classes in the instance head +-- +-- * A rewrite rule in a module other than the one defining +-- the function in the head of the rule +-- +type WhetherHasOrphans = Bool + +-- | Does this module define family instances? +type WhetherHasFamInst = Bool + + + |