diff options
Diffstat (limited to 'compiler/iface/MkIface.lhs')
| -rw-r--r-- | compiler/iface/MkIface.lhs | 1066 |
1 files changed, 1066 insertions, 0 deletions
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs new file mode 100644 index 0000000000..cafb6b6692 --- /dev/null +++ b/compiler/iface/MkIface.lhs @@ -0,0 +1,1066 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 +% + +\begin{code} +module MkIface ( + pprModIface, showIface, -- Print the iface in Foo.hi + + mkUsageInfo, -- Construct the usage info for a module + + mkIface, -- Build a ModIface from a ModGuts, + -- including computing version information + + writeIfaceFile, -- Write the interface file + + checkOldIface -- See if recompilation is required, by + -- comparing version information + ) where +\end{code} + + ----------------------------------------------- + MkIface.lhs deals with versioning + ----------------------------------------------- + +Here's the version-related info in an interface file + + module Foo 8 -- module-version + 3 -- export-list-version + 2 -- rule-version + Usages: -- Version info for what this compilation of Foo imported + Baz 3 -- Module version + [4] -- The export-list version if Foo depended on it + (g,2) -- Function and its version + (T,1) -- Type and its version + + <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -} + -- The [2] says that f's unfolding + -- mentions verison 2 of Wib.t + + ----------------------------------------------- + Basic idea + ----------------------------------------------- + +Basic idea: + * In the mi_usages information in an interface, we record the + version number of each free variable of the module + + * In mkIface, we compute the version number of each exported thing A.f + by comparing its A.f's info with its new info, and bumping its + version number if it differs. If A.f mentions B.g, and B.g's version + number has changed, then we count A.f as having changed too. + + * In checkOldIface we compare the mi_usages for the module with + the actual version info for all each thing recorded in mi_usages + + +Fixities +~~~~~~~~ +We count A.f as changing if its fixity changes + +Rules +~~~~~ +If a rule changes, we want to recompile any module that might be +affected by that rule. For non-orphan rules, this is relatively easy. +If module M defines f, and a rule for f, just arrange that the version +number for M.f changes if any of the rules for M.f change. Any module +that does not depend on M.f can't be affected by the rule-change +either. + +Orphan rules (ones whose 'head function' is not defined in M) are +harder. Here's what we do. + + * We have a per-module orphan-rule version number which changes if + any orphan rule changes. (It's unaffected by non-orphan rules.) + + * We record usage info for any orphan module 'below' this one, + giving the orphan-rule version number. We recompile if this + changes. + +The net effect is that if an orphan rule changes, we recompile every +module above it. That's very conservative, but it's devilishly hard +to know what it might affect, so we just have to be conservative. + +Instance decls +~~~~~~~~~~~~~~ +In an iface file we have + module A where + instance Eq a => Eq [a] = dfun29 + dfun29 :: ... + +We have a version number for dfun29, covering its unfolding +etc. Suppose we are compiling a module M that imports A only +indirectly. If typechecking M uses this instance decl, we record the +dependency on A.dfun29 as if it were a free variable of the module +(via the tcg_inst_usages accumulator). That means that A will appear +in M's usage list. If the shape of the instance declaration changes, +then so will dfun29's version, triggering a recompilation. + +Adding an instance declaration, or changing an instance decl that is +not currently used, is more tricky. (This really only makes a +difference when we have overlapping instance decls, because then the +new instance decl might kick in to override the old one.) We handle +this in a very similar way that we handle rules above. + + * For non-orphan instance decls, identify one locally-defined tycon/class + mentioned in the decl. Treat the instance decl as part of the defn of that + tycon/class, so that if the shape of the instance decl changes, so does the + tycon/class; that in turn will force recompilation of anything that uses + that tycon/class. + + * For orphan instance decls, act the same way as for orphan rules. + Indeed, we use the same global orphan-rule version number. + +mkUsageInfo +~~~~~~~~~~~ +mkUsageInfo figures out what the ``usage information'' for this +moudule is; that is, what it must record in its interface file as the +things it uses. + +We produce a line for every module B below the module, A, currently being +compiled: + import B <n> ; +to record the fact that A does import B indirectly. This is used to decide +to look to look for B.hi rather than B.hi-boot when compiling a module that +imports A. This line says that A imports B, but uses nothing in it. +So we'll get an early bale-out when compiling A if B's version changes. + +The usage information records: + +\begin{itemize} +\item (a) anything reachable from its body code +\item (b) any module exported with a @module Foo@ +\item (c) anything reachable from an exported item +\end{itemize} + +Why (b)? Because if @Foo@ changes then this module's export list +will change, so we must recompile this module at least as far as +making a new interface file --- but in practice that means complete +recompilation. + +Why (c)? Consider this: +\begin{verbatim} + module A( f, g ) where | module B( f ) where + import B( f ) | f = h 3 + g = ... | h = ... +\end{verbatim} + +Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in +@A@'s usages? Our idea is that we aren't going to touch A.hi if it is +*identical* to what it was before. If anything about @B.f@ changes +than anyone who imports @A@ should be recompiled in case they use +@B.f@ (they'll get an early exit if they don't). So, if anything +about @B.f@ changes we'd better make sure that something in A.hi +changes, and the convenient way to do that is to record the version +number @B.f@ in A.hi in the usage list. If B.f changes that'll force a +complete recompiation of A, which is overkill but it's the only way to +write a new, slightly different, A.hi. + +But the example is tricker. Even if @B.f@ doesn't change at all, +@B.h@ may do so, and this change may not be reflected in @f@'s version +number. But with -O, a module that imports A must be recompiled if +@B.h@ changes! So A must record a dependency on @B.h@. So we treat +the occurrence of @B.f@ in the export list *just as if* it were in the +code of A, and thereby haul in all the stuff reachable from it. + + *** Conclusion: if A mentions B.f in its export list, + behave just as if A mentioned B.f in its source code, + and slurp in B.f and all its transitive closure *** + +[NB: If B was compiled with -O, but A isn't, we should really *still* +haul in all the unfoldings for B, in case the module that imports A *is* +compiled with -O. I think this is the case.] + + +\begin{code} +#include "HsVersions.h" + +import HsSyn +import Packages ( isHomeModule, PackageIdH(..) ) +import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), + IfaceRule(..), IfaceInst(..), IfaceExtName(..), + eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, + eqMaybeBy, eqListBy, visibleIfConDecls, + tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule ) +import LoadIface ( readIface, loadInterface ) +import BasicTypes ( Version, initialVersion, bumpVersion ) +import TcRnMonad +import HscTypes ( ModIface(..), ModDetails(..), + ModGuts(..), IfaceExport, + HscEnv(..), hscEPS, Dependencies(..), FixItem(..), + ModSummary(..), msHiFilePath, + mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, + typeEnvElts, + GenAvailInfo(..), availName, + ExternalPackageState(..), + Usage(..), IsBootInterface, + Deprecs(..), IfaceDeprecs, Deprecations, + lookupIfaceByModule + ) + + +import Packages ( HomeModules ) +import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt ) +import StaticFlags ( opt_HiVersion ) +import Name ( Name, nameModule, nameOccName, nameParent, + isExternalName, isInternalName, nameParent_maybe, isWiredInName, + isImplicitName, NamedThing(..) ) +import NameEnv +import NameSet +import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, + extendOccEnv_C, + OccSet, emptyOccSet, elemOccSet, occSetElts, + extendOccSet, extendOccSetList, + isEmptyOccSet, intersectOccSet, intersectsOccSet, + occNameFS, isTcOcc ) +import Module ( Module, moduleFS, + ModLocation(..), mkModuleFS, moduleString, + ModuleEnv, emptyModuleEnv, lookupModuleEnv, + extendModuleEnv_C + ) +import Outputable +import Util ( createDirectoryHierarchy, directoryOf ) +import Util ( sortLe, seqList ) +import Binary ( getBinFileWithDict ) +import BinIface ( writeBinIface, v_IgnoreHiWay ) +import Unique ( Unique, Uniquable(..) ) +import ErrUtils ( dumpIfSet_dyn, showPass ) +import Digraph ( stronglyConnComp, SCC(..) ) +import SrcLoc ( SrcSpan ) +import FiniteMap +import FastString + +import DATA_IOREF ( writeIORef ) +import Monad ( when ) +import List ( insert ) +import Maybes ( orElse, mapCatMaybes, isNothing, isJust, + expectJust, MaybeErr(..) ) +\end{code} + + + +%************************************************************************ +%* * +\subsection{Completing an interface} +%* * +%************************************************************************ + +\begin{code} +mkIface :: HscEnv + -> Maybe ModIface -- The old interface, if we have it + -> ModGuts -- Usages, deprecations, etc + -> ModDetails -- The trimmed, tidied interface + -> IO (ModIface, -- The new one, complete with decls and versions + Bool) -- True <=> there was an old Iface, and the new one + -- is identical, so no need to write it + +mkIface hsc_env maybe_old_iface + (ModGuts{ mg_module = this_mod, + mg_boot = is_boot, + mg_usages = usages, + mg_deps = deps, + mg_home_mods = home_mods, + mg_rdr_env = rdr_env, + mg_fix_env = fix_env, + mg_deprecs = src_deprecs }) + (ModDetails{ md_insts = insts, + md_rules = rules, + md_types = type_env, + md_exports = exports }) + +-- NB: notice that mkIface does not look at the bindings +-- only at the TypeEnv. The previous Tidy phase has +-- put exactly the info into the TypeEnv that we want +-- to expose in the interface + + = do { eps <- hscEPS hsc_env + ; let { ext_nm_rhs = mkExtNameFn hsc_env home_mods eps this_mod + ; ext_nm_lhs = mkLhsNameFn this_mod + + ; decls = [ tyThingToIfaceDecl ext_nm_rhs thing + | thing <- typeEnvElts type_env, + not (isImplicitName (getName thing)) ] + -- Don't put implicit Ids and class tycons in the interface file + + ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env] + ; deprecs = mkIfaceDeprec src_deprecs + ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules + ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts + + ; intermediate_iface = ModIface { + mi_module = this_mod, + mi_package = HomePackage, + mi_boot = is_boot, + mi_deps = deps, + mi_usages = usages, + mi_exports = mkIfaceExports exports, + mi_insts = sortLe le_inst iface_insts, + mi_rules = sortLe le_rule iface_rules, + mi_fixities = fixities, + mi_deprecs = deprecs, + mi_globals = Just rdr_env, + + -- Left out deliberately: filled in by addVersionInfo + mi_mod_vers = initialVersion, + mi_exp_vers = initialVersion, + mi_rule_vers = initialVersion, + mi_orphan = False, -- Always set by addVersionInfo, but + -- it's a strict field, so we can't omit it. + mi_decls = deliberatelyOmitted "decls", + mi_ver_fn = deliberatelyOmitted "ver_fn", + + -- And build the cached values + mi_dep_fn = mkIfaceDepCache deprecs, + mi_fix_fn = mkIfaceFixCache fixities } + + -- Add version information + ; (new_iface, no_change_at_all, pp_diffs, pp_orphs) + = _scc_ "versioninfo" + addVersionInfo maybe_old_iface intermediate_iface decls + } + + -- Debug printing + ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) + (printDump (expectJust "mkIface" pp_orphs)) + ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs) + ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" + (pprModIface new_iface) + + ; return (new_iface, no_change_at_all) } + where + r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2 + i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2 + + dflags = hsc_dflags hsc_env + deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) + + +----------------------------- +writeIfaceFile :: ModLocation -> ModIface -> IO () +writeIfaceFile location new_iface + = do createDirectoryHierarchy (directoryOf hi_file_path) + writeBinIface hi_file_path new_iface + where hi_file_path = ml_hi_file location + + +----------------------------- +mkExtNameFn :: HscEnv -> HomeModules -> ExternalPackageState -> Module -> Name -> IfaceExtName +mkExtNameFn hsc_env hmods eps this_mod + = ext_nm + where + hpt = hsc_HPT hsc_env + pit = eps_PIT eps + + ext_nm name + | mod == this_mod = case nameParent_maybe name of + Nothing -> LocalTop occ + Just par -> LocalTopSub occ (nameOccName par) + | isWiredInName name = ExtPkg mod occ + | isHomeModule hmods mod = HomePkg mod occ vers + | otherwise = ExtPkg mod occ + where + mod = nameModule name + occ = nameOccName name + par_occ = nameOccName (nameParent name) + -- The version of the *parent* is the one want + vers = lookupVersion mod par_occ + + lookupVersion :: Module -> OccName -> Version + -- Even though we're looking up a home-package thing, in + -- one-shot mode the imported interfaces may be in the PIT + lookupVersion mod occ + = mi_ver_fn iface occ `orElse` + pprPanic "lookupVers1" (ppr mod <+> ppr occ) + where + iface = lookupIfaceByModule hpt pit mod `orElse` + pprPanic "lookupVers2" (ppr mod <+> ppr occ) + + +--------------------- +-- mkLhsNameFn ignores versioning info altogether +-- It is used for the LHS of instance decls and rules, where we +-- there's no point in recording version info +mkLhsNameFn :: Module -> Name -> IfaceExtName +mkLhsNameFn this_mod name + | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $ + LocalTop occ -- Should not happen + | mod == this_mod = LocalTop occ + | otherwise = ExtPkg mod occ + where + mod = nameModule name + occ = nameOccName name + + +----------------------------- +-- Compute version numbers for local decls + +addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi + -> ModIface -- The new interface decls (lacking decls) + -> [IfaceDecl] -- The new decls + -> (ModIface, + Bool, -- True <=> no changes at all; no need to write new Iface + SDoc, -- Differences + Maybe SDoc) -- Warnings about orphans + +addVersionInfo Nothing new_iface new_decls +-- No old interface, so definitely write a new one! + = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface) + || anyNothing ifRuleOrph (mi_rules new_iface), + mi_decls = [(initialVersion, decl) | decl <- new_decls], + mi_ver_fn = \n -> Just initialVersion }, + False, + ptext SLIT("No old interface file"), + pprOrphans orph_insts orph_rules) + where + orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface) + orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface) + +addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, + mi_exp_vers = old_exp_vers, + mi_rule_vers = old_rule_vers, + mi_decls = old_decls, + mi_ver_fn = old_decl_vers, + mi_fix_fn = old_fixities })) + new_iface@(ModIface { mi_fix_fn = new_fixities }) + new_decls + + | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged"), pp_orphs) + | otherwise = (final_iface, False, vcat [ptext SLIT("Interface file has changed"), + nest 2 pp_diffs], pp_orphs) + where + final_iface = new_iface { mi_mod_vers = bump_unless no_output_change old_mod_vers, + mi_exp_vers = bump_unless no_export_change old_exp_vers, + mi_rule_vers = bump_unless no_rule_change old_rule_vers, + mi_orphan = not (null new_orph_rules && null new_orph_insts), + mi_decls = decls_w_vers, + mi_ver_fn = mkIfaceVerCache decls_w_vers } + + decls_w_vers = [(add_vers decl, decl) | decl <- new_decls] + + ------------------- + (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface) + (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface) + same_insts occ = eqMaybeBy (eqListBy eqIfInst) + (lookupOccEnv old_non_orph_insts occ) + (lookupOccEnv new_non_orph_insts occ) + + (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface) + (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface) + same_rules occ = eqMaybeBy (eqListBy eqIfRule) + (lookupOccEnv old_non_orph_rules occ) + (lookupOccEnv new_non_orph_rules occ) + ------------------- + -- Computing what changed + no_output_change = no_decl_change && no_rule_change && + no_export_change && no_deprec_change + no_export_change = mi_exports new_iface == mi_exports old_iface -- Kept sorted + no_decl_change = isEmptyOccSet changed_occs + no_rule_change = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules) + || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts)) + no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface + + -- If the usages havn't changed either, we don't need to write the interface file + no_other_changes = mi_usages new_iface == mi_usages old_iface && + mi_deps new_iface == mi_deps old_iface + no_change_at_all = no_output_change && no_other_changes + + pp_diffs = vcat [pp_change no_export_change "Export list" + (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)), + pp_change no_rule_change "Rules" + (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)), + pp_change no_deprec_change "Deprecations" empty, + pp_change no_other_changes "Usages" empty, + pp_decl_diffs] + pp_change True what info = empty + pp_change False what info = text what <+> ptext SLIT("changed") <+> info + + ------------------- + old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls] + same_fixity n = bool (old_fixities n == new_fixities n) + + ------------------- + -- Adding version info + new_version = bumpVersion old_mod_vers + add_vers decl | occ `elemOccSet` changed_occs = new_version + | otherwise = expectJust "add_vers" (old_decl_vers occ) + -- If it's unchanged, there jolly well + where -- should be an old version number + occ = ifName decl + + ------------------- + changed_occs :: OccSet + changed_occs = computeChangedOccs eq_info + + eq_info :: [(OccName, IfaceEq)] + eq_info = map check_eq new_decls + check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ + = (occ, new_decl `eqIfDecl` old_decl &&& + eq_indirects new_decl) + | otherwise {- No corresponding old decl -} + = (occ, NotEqual) + where + occ = ifName new_decl + + eq_indirects :: IfaceDecl -> IfaceEq + -- When seeing if two decls are the same, remember to + -- check whether any relevant fixity or rules have changed + eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ + eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs}) + = same_insts cls_occ &&& + eq_ind_occs [op | IfaceClassOp op _ _ <- sigs] + eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons}) + = same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too + eq_ind_occs (map ifConOcc (visibleIfConDecls cons)) + eq_indirects other = Equal -- Synonyms and foreign declarations + + eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules + eq_ind_occ occ = same_fixity occ &&& same_rules occ + eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal + + ------------------- + -- Diffs + pp_decl_diffs :: SDoc -- Nothing => no changes + pp_decl_diffs + | isEmptyOccSet changed_occs = empty + | otherwise + = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs), + ptext SLIT("Version change for these decls:"), + nest 2 (vcat (map show_change new_decls))] + + eq_env = mkOccEnv eq_info + show_change new_decl + | not (occ `elemOccSet` changed_occs) = empty + | otherwise + = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version, + nest 2 why] + where + occ = ifName new_decl + why = case lookupOccEnv eq_env occ of + Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"), + nest 2 (braces (fsep (map ppr (occSetElts + (occs `intersectOccSet` changed_occs)))))] + Just NotEqual + | Just old_decl <- lookupOccEnv old_decl_env occ + -> vcat [ptext SLIT("Old:") <+> ppr old_decl, + ptext SLIT("New:") <+> ppr new_decl] + | otherwise + -> ppr occ <+> ptext SLIT("only in new interface") + other -> pprPanic "MkIface.show_change" (ppr occ) + + pp_orphs = pprOrphans new_orph_insts new_orph_rules + +pprOrphans insts rules + | null insts && null rules = Nothing + | otherwise + = Just $ vcat [ + if null insts then empty else + hang (ptext SLIT("Warning: orphan instances:")) + 2 (vcat (map ppr insts)), + if null rules then empty else + hang (ptext SLIT("Warning: orphan rules:")) + 2 (vcat (map ppr rules)) + ] + +computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet +computeChangedOccs eq_info + = foldl add_changes emptyOccSet (stronglyConnComp edges) + where + edges :: [((OccName,IfaceEq), Unique, [Unique])] + edges = [ (node, getUnique occ, map getUnique occs) + | node@(occ, iface_eq) <- eq_info + , let occs = case iface_eq of + EqBut occ_set -> occSetElts occ_set + other -> [] ] + + -- Changes in declarations + add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet + add_changes so_far (AcyclicSCC (occ, iface_eq)) + | changedWrt so_far iface_eq -- This one has changed + = extendOccSet so_far occ + add_changes so_far (CyclicSCC pairs) + | changedWrt so_far (foldr1 (&&&) (map snd pairs)) -- One of this group has changed + = extendOccSetList so_far (map fst pairs) + add_changes so_far other = so_far + +changedWrt :: OccSet -> IfaceEq -> Bool +changedWrt so_far Equal = False +changedWrt so_far NotEqual = True +changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids + +---------------------- +-- mkOrphMap partitions instance decls or rules into +-- (a) an OccEnv for ones that are not orphans, +-- mapping the local OccName to a list of its decls +-- (b) a list of orphan decls +mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ + -- Nothing for an orphan decl + -> [decl] -- Sorted into canonical order + -> (OccEnv [decl], -- Non-orphan decls associated with their key; + -- each sublist in canonical order + [decl]) -- Orphan decls; in canonical order +mkOrphMap get_key decls + = foldl go (emptyOccEnv, []) decls + where + go (non_orphs, orphs) d + | Just occ <- get_key d + = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs) + | otherwise = (non_orphs, d:orphs) + +anyNothing :: (a -> Maybe b) -> [a] -> Bool +anyNothing p [] = False +anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs + +---------------------- +mkIfaceDeprec :: Deprecations -> IfaceDeprecs +mkIfaceDeprec NoDeprecs = NoDeprecs +mkIfaceDeprec (DeprecAll t) = DeprecAll t +mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env)) + +---------------------- +bump_unless :: Bool -> Version -> Version +bump_unless True v = v -- True <=> no change +bump_unless False v = bumpVersion v +\end{code} + + +%********************************************************* +%* * +\subsection{Keeping track of what we've slurped, and version numbers} +%* * +%********************************************************* + + +\begin{code} +mkUsageInfo :: HscEnv + -> HomeModules + -> ModuleEnv (Module, Bool, SrcSpan) + -> [(Module, IsBootInterface)] + -> NameSet -> IO [Usage] +mkUsageInfo hsc_env hmods dir_imp_mods dep_mods used_names + = do { eps <- hscEPS hsc_env + ; let usages = mk_usage_info (eps_PIT eps) hsc_env hmods + dir_imp_mods dep_mods used_names + ; usages `seqList` return usages } + -- seq the list of Usages returned: occasionally these + -- don't get evaluated for a while and we can end up hanging on to + -- the entire collection of Ifaces. + +mk_usage_info pit hsc_env hmods dir_imp_mods dep_mods proto_used_names + = mapCatMaybes mkUsage dep_mods + -- ToDo: do we need to sort into canonical order? + where + hpt = hsc_HPT hsc_env + + used_names = mkNameSet $ -- Eliminate duplicates + [ nameParent n -- Just record usage on the 'main' names + | n <- nameSetToList proto_used_names + , not (isWiredInName n) -- Don't record usages for wired-in names + , isExternalName n -- Ignore internal names + ] + + -- ent_map groups together all the things imported and used + -- from a particular module in this package + ent_map :: ModuleEnv [OccName] + ent_map = foldNameSet add_mv emptyModuleEnv used_names + add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ] + where + occ = nameOccName name + mod = nameModule name + add_item occs _ = occ:occs + + depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of + Just (_,no_imp,_) -> not no_imp + Nothing -> True + + -- We want to create a Usage for a home module if + -- a) we used something from; has something in used_names + -- b) we imported all of it, even if we used nothing from it + -- (need to recompile if its export list changes: export_vers) + -- c) is a home-package orphan module (need to recompile if its + -- instance decls change: rules_vers) + mkUsage :: (Module, Bool) -> Maybe Usage + mkUsage (mod_name, _) + | isNothing maybe_iface -- We can't depend on it if we didn't + || not (isHomeModule hmods mod) -- even open the interface! + || (null used_occs + && isNothing export_vers + && not orphan_mod) + = Nothing -- Record no usage info + + | otherwise + = Just (Usage { usg_name = mod, + usg_mod = mod_vers, + usg_exports = export_vers, + usg_entities = ent_vers, + usg_rules = rules_vers }) + where + maybe_iface = lookupIfaceByModule hpt pit mod_name + -- In one-shot mode, the interfaces for home-package + -- modules accumulate in the PIT not HPT. Sigh. + + Just iface = maybe_iface + mod = mi_module iface + orphan_mod = mi_orphan iface + version_env = mi_ver_fn iface + mod_vers = mi_mod_vers iface + rules_vers = mi_rule_vers iface + export_vers | depend_on_exports mod = Just (mi_exp_vers iface) + | otherwise = Nothing + + -- The sort is to put them into canonical order + used_occs = lookupModuleEnv ent_map mod `orElse` [] + ent_vers :: [(OccName,Version)] + ent_vers = [ (occ, version_env occ `orElse` initialVersion) + | occ <- sortLe (<=) used_occs] +\end{code} + +\begin{code} +mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])] + -- Group by module and sort by occurrence + -- This keeps the list in canonical order +mkIfaceExports exports + = [ (mkModuleFS fs, eltsFM avails) + | (fs, avails) <- fmToList groupFM + ] + where + groupFM :: FiniteMap FastString (FiniteMap FastString (GenAvailInfo OccName)) + -- Deliberately use the FastString so we + -- get a canonical ordering + groupFM = foldl add emptyFM (nameSetToList exports) + + add env name = addToFM_C add_avail env mod_fs + (unitFM avail_fs avail) + where + occ = nameOccName name + mod_fs = moduleFS (nameModule name) + avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ] + | isTcOcc occ = AvailTC occ [occ] + | otherwise = Avail occ + avail_fs = occNameFS (availName avail) + add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail + + add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs) + add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name) +\end{code} + + +%************************************************************************ +%* * + Load the old interface file for this module (unless + we have it aleady), and check whether it is up to date + +%* * +%************************************************************************ + +\begin{code} +checkOldIface :: HscEnv + -> ModSummary + -> Bool -- Source unchanged + -> Maybe ModIface -- Old interface from compilation manager, if any + -> IO (RecompileRequired, Maybe ModIface) + +checkOldIface hsc_env mod_summary source_unchanged maybe_iface + = do { showPass (hsc_dflags hsc_env) + ("Checking old interface for " ++ moduleString (ms_mod mod_summary)) ; + + ; initIfaceCheck hsc_env $ + check_old_iface mod_summary source_unchanged maybe_iface + } + +check_old_iface mod_summary source_unchanged maybe_iface + = -- CHECK WHETHER THE SOURCE HAS CHANGED + ifM (not source_unchanged) + (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off"))) + `thenM_` + + -- If the source has changed and we're in interactive mode, avoid reading + -- an interface; just return the one we might have been supplied with. + getGhcMode `thenM` \ ghc_mode -> + if (ghc_mode == Interactive || ghc_mode == JustTypecheck) + && not source_unchanged then + returnM (outOfDate, maybe_iface) + else + + case maybe_iface of { + Just old_iface -> -- Use the one we already have + checkVersions source_unchanged old_iface `thenM` \ recomp -> + returnM (recomp, Just old_iface) + + ; Nothing -> + + -- Try and read the old interface for the current module + -- from the .hi file left from the last time we compiled it + let + iface_path = msHiFilePath mod_summary + in + readIface (ms_mod mod_summary) iface_path False `thenM` \ read_result -> + case read_result of { + Failed err -> -- Old interface file not found, or garbled; give up + traceIf (text "FYI: cannot read old interface file:" + $$ nest 4 err) `thenM_` + returnM (outOfDate, Nothing) + + ; Succeeded iface -> + + -- We have got the old iface; check its versions + checkVersions source_unchanged iface `thenM` \ recomp -> + returnM (recomp, Just iface) + }} +\end{code} + +@recompileRequired@ is called from the HscMain. It checks whether +a recompilation is required. It needs access to the persistent state, +finder, etc, because it may have to load lots of interface files to +check their versions. + +\begin{code} +type RecompileRequired = Bool +upToDate = False -- Recompile not required +outOfDate = True -- Recompile required + +checkVersions :: Bool -- True <=> source unchanged + -> ModIface -- Old interface + -> IfG RecompileRequired +checkVersions source_unchanged iface + | not source_unchanged + = returnM outOfDate + | otherwise + = do { traceHiDiffs (text "Considering whether compilation is required for" <+> + ppr (mi_module iface) <> colon) + + -- Source code unchanged and no errors yet... carry on + + -- First put the dependent-module info, read from the old interface, into the envt, + -- so that when we look for interfaces we look for the right one (.hi or .hi-boot) + -- + -- It's just temporary because either the usage check will succeed + -- (in which case we are done with this module) or it'll fail (in which + -- case we'll compile the module from scratch anyhow). + -- + -- We do this regardless of compilation mode + ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } + + ; checkList [checkModUsage u | u <- mi_usages iface] + } + where + -- This is a bit of a hack really + mod_deps :: ModuleEnv (Module, IsBootInterface) + mod_deps = mkModDeps (dep_mods (mi_deps iface)) + +checkModUsage :: Usage -> IfG RecompileRequired +-- Given the usage information extracted from the old +-- M.hi file for the module being compiled, figure out +-- whether M needs to be recompiled. + +checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers, + usg_rules = old_rule_vers, + usg_exports = maybe_old_export_vers, + usg_entities = old_decl_vers }) + = -- Load the imported interface is possible + let + doc_str = sep [ptext SLIT("need version info for"), ppr mod_name] + in + traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_` + + loadInterface doc_str mod_name ImportBySystem `thenM` \ mb_iface -> + -- Load the interface, but don't complain on failure; + -- Instead, get an Either back which we can test + + case mb_iface of { + Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"), + ppr mod_name])); + -- Couldn't find or parse a module mentioned in the + -- old interface file. Don't complain -- it might just be that + -- the current module doesn't need that import and it's been deleted + + Succeeded iface -> + let + new_mod_vers = mi_mod_vers iface + new_decl_vers = mi_ver_fn iface + new_export_vers = mi_exp_vers iface + new_rule_vers = mi_rule_vers iface + in + -- CHECK MODULE + checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile -> + if not recompile then + returnM upToDate + else + + -- CHECK EXPORT LIST + if checkExportList maybe_old_export_vers new_export_vers then + out_of_date_vers (ptext SLIT(" Export list changed")) + (expectJust "checkModUsage" maybe_old_export_vers) + new_export_vers + else + + -- CHECK RULES + if old_rule_vers /= new_rule_vers then + out_of_date_vers (ptext SLIT(" Rules changed")) + old_rule_vers new_rule_vers + else + + -- CHECK ITEMS ONE BY ONE + checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile -> + if recompile then + returnM outOfDate -- This one failed, so just bail out now + else + up_to_date (ptext SLIT(" Great! The bits I use are up to date")) + } + +------------------------ +checkModuleVersion old_mod_vers new_mod_vers + | new_mod_vers == old_mod_vers + = up_to_date (ptext SLIT("Module version unchanged")) + + | otherwise + = out_of_date_vers (ptext SLIT(" Module version has changed")) + old_mod_vers new_mod_vers + +------------------------ +checkExportList Nothing new_vers = upToDate +checkExportList (Just v) new_vers = v /= new_vers + +------------------------ +checkEntityUsage new_vers (name,old_vers) + = case new_vers name of + + Nothing -> -- We used it before, but it ain't there now + out_of_date (sep [ptext SLIT("No longer exported:"), ppr name]) + + Just new_vers -- It's there, but is it up to date? + | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_` + returnM upToDate + | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name) + old_vers new_vers + +up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate +out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate +out_of_date_vers msg old_vers new_vers + = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers]) + +---------------------- +checkList :: [IfG RecompileRequired] -> IfG RecompileRequired +-- This helper is used in two places +checkList [] = returnM upToDate +checkList (check:checks) = check `thenM` \ recompile -> + if recompile then + returnM outOfDate + else + checkList checks +\end{code} + +%************************************************************************ +%* * + Printing interfaces +%* * +%************************************************************************ + +\begin{code} +showIface :: FilePath -> IO () +-- Read binary interface, and print it out +showIface filename = do + -- skip the version check; we don't want to worry about profiled vs. + -- non-profiled interfaces, for example. + writeIORef v_IgnoreHiWay True + iface <- Binary.getBinFileWithDict filename + printDump (pprModIface iface) + where +\end{code} + + +\begin{code} +pprModIface :: ModIface -> SDoc +-- Show a ModIface +pprModIface iface + = vcat [ ptext SLIT("interface") + <+> ppr_package (mi_package iface) + <+> ppr (mi_module iface) <+> pp_boot + <+> ppr (mi_mod_vers iface) <+> pp_sub_vers + <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty) + <+> int opt_HiVersion + <+> ptext SLIT("where") + , vcat (map pprExport (mi_exports iface)) + , pprDeps (mi_deps iface) + , vcat (map pprUsage (mi_usages iface)) + , pprFixities (mi_fixities iface) + , vcat (map pprIfaceDecl (mi_decls iface)) + , vcat (map ppr (mi_insts iface)) + , vcat (map ppr (mi_rules iface)) + , pprDeprecs (mi_deprecs iface) + ] + where + pp_boot | mi_boot iface = ptext SLIT("[boot]") + | otherwise = empty + ppr_package HomePackage = empty + ppr_package (ExtPackage id) = doubleQuotes (ppr id) + + exp_vers = mi_exp_vers iface + rule_vers = mi_rule_vers iface + + pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty + | otherwise = brackets (ppr exp_vers <+> ppr rule_vers) +\end{code} + +When printing export lists, we print like this: + Avail f f + AvailTC C [C, x, y] C(x,y) + AvailTC C [x, y] C!(x,y) -- Exporting x, y but not C + +\begin{code} +pprExport :: IfaceExport -> SDoc +pprExport (mod, items) + = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ] + where + pp_avail :: GenAvailInfo OccName -> SDoc + pp_avail (Avail occ) = ppr occ + pp_avail (AvailTC _ []) = empty + pp_avail (AvailTC n (n':ns)) + | n==n' = ppr n <> pp_export ns + | otherwise = ppr n <> char '|' <> pp_export (n':ns) + + pp_export [] = empty + pp_export names = braces (hsep (map ppr names)) + +pprUsage :: Usage -> SDoc +pprUsage usage + = hsep [ptext SLIT("import"), ppr (usg_name usage), + int (usg_mod usage), + pp_export_version (usg_exports usage), + int (usg_rules usage), + pp_versions (usg_entities usage) ] + where + pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ] + pp_export_version Nothing = empty + pp_export_version (Just v) = int v + +pprDeps :: Dependencies -> SDoc +pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs}) + = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods), + ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), + ptext SLIT("orphans:") <+> fsep (map ppr orphs) + ] + where + ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot + ppr_boot True = text "[boot]" + ppr_boot False = empty + +pprIfaceDecl :: (Version, IfaceDecl) -> SDoc +pprIfaceDecl (ver, decl) + = ppr_vers ver <+> ppr decl + where + -- Print the version for the decl + ppr_vers v | v == initialVersion = empty + | otherwise = int v + +pprFixities :: [(OccName, Fixity)] -> SDoc +pprFixities [] = empty +pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes + where + pprFix (occ,fix) = ppr fix <+> ppr occ + +pprDeprecs NoDeprecs = empty +pprDeprecs (DeprecAll txt) = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt) +pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs) + where + pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt) +\end{code} |