X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FMkIface.lhs;h=f76ac41773eeb83da6778e3ce73f9a547ff76d3a;hb=0f800dc9f3dc695cd06d0fdd7799a52c37241752;hp=e8fbeb0fd473fd558cb144174dc4dd95ea43ff09;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index e8fbeb0..f76ac41 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/ghc/compiler/iface/MkIface.lhs @@ -4,13 +4,15 @@ \begin{code} module MkIface ( - showIface, -- Print the iface in Foo.hi + 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 @@ -174,64 +176,65 @@ compiled with -O. I think this is the case.] #include "HsVersions.h" import HsSyn +import Packages ( isHomeModule, PackageIdH(..) ) import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), - IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..), + IfaceRule(..), IfaceInst(..), IfaceExtName(..), eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, eqMaybeBy, eqListBy, visibleIfConDecls, - tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule ) -import LoadIface ( readIface, loadInterface, ifaceInstGates ) + tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule ) +import LoadIface ( readIface, loadInterface ) import BasicTypes ( Version, initialVersion, bumpVersion ) import TcRnMonad -import TcRnTypes ( ImportAvails(..), mkModDeps ) -import TcType ( isFFITy ) -import HscTypes ( ModIface(..), TyThing(..), - ModGuts(..), ModGuts, IfaceExport, - GhciMode(..), isOneShot, - HscEnv(..), hscEPS, - Dependencies(..), FixItem(..), +import HscTypes ( ModIface(..), ModDetails(..), + ModGuts(..), IfaceExport, + HscEnv(..), hscEPS, Dependencies(..), FixItem(..), + ModSummary(..), msHiFilePath, mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, typeEnvElts, GenAvailInfo(..), availName, ExternalPackageState(..), Usage(..), IsBootInterface, Deprecs(..), IfaceDeprecs, Deprecations, - lookupIfaceByModName + lookupIfaceByModule ) -import CmdLineOpts -import Name ( Name, nameModule, nameOccName, nameParent, isExternalName, - nameParent_maybe, isWiredInName, NamedThing(..), nameModuleName ) +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, +import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, + extendOccEnv_C, OccSet, emptyOccSet, elemOccSet, occSetElts, extendOccSet, extendOccSetList, isEmptyOccSet, intersectOccSet, intersectsOccSet, occNameFS, isTcOcc ) -import TyCon ( tyConDataCons, isNewTyCon, newTyConRep ) -import Class ( classSelIds ) -import DataCon ( dataConName, dataConFieldLabels ) -import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule, - ModLocation(..), mkSysModuleNameFS, moduleUserString, +import Module ( Module, moduleFS, + ModLocation(..), mkModuleFS, moduleString, ModuleEnv, emptyModuleEnv, lookupModuleEnv, - extendModuleEnv_C, moduleEnvElts + extendModuleEnv_C ) import Outputable -import DriverUtil ( createDirectoryHierarchy, directoryOf ) +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, fromJust, expectJust ) +import Maybes ( orElse, mapCatMaybes, isNothing, isJust, + expectJust, MaybeErr(..) ) \end{code} @@ -244,63 +247,59 @@ import Maybes ( orElse, mapCatMaybes, isNothing, fromJust, expectJust ) \begin{code} mkIface :: HscEnv - -> ModLocation -> Maybe ModIface -- The old interface, if we have it - -> ModGuts -- The compiled, tidied module - -> IO ModIface -- The new one, complete with decls and versions --- mkFinalIface --- a) completes the interface --- b) writes it out to a file if necessary - -mkIface hsc_env location maybe_old_iface - guts@ModGuts{ mg_module = this_mod, - mg_usages = usages, - mg_deps = deps, - mg_exports = exports, + -> 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, - mg_insts = insts, - mg_rules = rules, - mg_types = type_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 { this_mod_name = moduleName this_mod - ; ext_nm = mkExtNameFn hsc_env eps this_mod_name - ; local_things = [thing | thing <- typeEnvElts type_env, - not (isWiredInName (getName thing)) ] - -- Do not export anything about wired-in things - -- (GHC knows about them already) - - ; abstract_tcs :: NameSet -- TyCons and Classes whose representation is not exposed - ; abstract_tcs - | not omit_prags = emptyNameSet -- In the -O case, nothing is abstract - | otherwise = mkNameSet [ getName thing - | thing <- local_things - , not (mustExposeThing exports thing)] - - ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing - | thing <- local_things, wantDeclFor exports abstract_tcs 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 - | omit_prags = [] - | otherwise = sortLe le_rule $ - map (coreRuleToIfaceRule this_mod_name ext_nm) rules - ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts) + ; 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 = opt_InPackage, - mi_boot = False, + mi_package = HomePackage, + mi_boot = is_boot, mi_deps = deps, mi_usages = usages, mi_exports = mkIfaceExports exports, - mi_insts = iface_insts, - mi_rules = iface_rules, + 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, @@ -315,105 +314,90 @@ mkIface hsc_env location maybe_old_iface mi_fix_fn = mkIfaceFixCache fixities } -- Add version information - ; (new_iface, no_change_at_all, pp_diffs) + ; (new_iface, no_change_at_all, pp_diffs, pp_orphs) = _scc_ "versioninfo" addVersionInfo maybe_old_iface intermediate_iface decls } - -- Write the interface file, if necessary - ; when (not no_change_at_all && ghci_mode /= Interactive) $ do - createDirectoryHierarchy (directoryOf hi_file_path) - writeBinIface hi_file_path new_iface - -- 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 } + ; 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 - ghci_mode = hsc_mode hsc_env - hi_file_path = ml_hi_file location - omit_prags = dopt Opt_OmitInterfacePragmas dflags + dflags = hsc_dflags hsc_env + deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) -mustExposeThing :: NameSet -> TyThing -> Bool --- We are compiling without -O, and thus trying to write as little as --- possible into the interface file. But we must expose the details of --- any data types and classes whose constructors, fields, methods are --- visible to an importing module -mustExposeThing exports (ATyCon tc) - = any exported_data_con (tyConDataCons tc) - -- Expose rep if any datacon or field is exported - - || (isNewTyCon tc && isFFITy (snd (newTyConRep tc))) - -- Expose the rep for newtypes if the rep is an FFI type. - -- For a very annoying reason. 'Foreign import' is meant to - -- be able to look through newtypes transparently, but it - -- can only do that if it can "see" the newtype representation - where - exported_data_con con - = any (`elemNameSet` exports) (dataConName con : dataConFieldLabels con) - -mustExposeThing exports (AClass cls) - = any exported_class_op (classSelIds cls) - where -- Expose rep if any classs op is exported - exported_class_op op = getName op `elemNameSet` exports - -mustExposeThing exports other = False - - -wantDeclFor :: NameSet -- User-exported things - -> NameSet -- Abstract things - -> TyThing -> Bool -wantDeclFor exports abstracts thing - | Just parent <- nameParent_maybe name -- An implicit thing - = parent `elemNameSet` abstracts && name `elemNameSet` exports +----------------------------- +writeIfaceFile :: HscEnv -> ModLocation -> ModIface -> Bool -> IO () +-- Write the interface file, if necessary +writeIfaceFile hsc_env location new_iface no_change_at_all + | no_change_at_all = return () + | ghc_mode == Interactive = return () + | ghc_mode == JustTypecheck = return () | otherwise - = True + = do { createDirectoryHierarchy (directoryOf hi_file_path) + ; writeBinIface hi_file_path new_iface } where - name = getName thing - + ghc_mode = ghcMode (hsc_dflags hsc_env) + hi_file_path = ml_hi_file location -deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) ----------------------------- -mkExtNameFn :: HscEnv -> ExternalPackageState -> ModuleName -> Name -> IfaceExtName -mkExtNameFn hsc_env eps this_mod +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_nm == this_mod = case nameParent_maybe name of + | mod == this_mod = case nameParent_maybe name of Nothing -> LocalTop occ Just par -> LocalTopSub occ (nameOccName par) - | isWiredInName name = ExtPkg mod_nm occ - | isHomeModule mod = HomePkg mod_nm occ vers - | otherwise = ExtPkg mod_nm occ + | isWiredInName name = ExtPkg mod occ + | isHomeModule hmods mod = HomePkg mod occ vers + | otherwise = ExtPkg mod occ where mod = nameModule name - mod_nm = moduleName mod occ = nameOccName name par_occ = nameOccName (nameParent name) -- The version of the *parent* is the one want - vers = lookupVersion mod_nm par_occ + vers = lookupVersion mod par_occ - lookupVersion :: ModuleName -> OccName -> Version + 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 = lookupIfaceByModName hpt pit mod `orElse` + 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 @@ -422,19 +406,21 @@ addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi -> [IfaceDecl] -- The new decls -> (ModIface, Bool, -- True <=> no changes at all; no need to write new Iface - SDoc) -- Differences + 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 getInstKey (mi_insts new_iface) - || anyNothing getRuleKey (mi_rules new_iface), + = (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) + False, + ptext SLIT("No old interface file"), + pprOrphans orph_insts orph_rules) where - orph_insts = filter (isNothing . getInstKey) (mi_insts new_iface) - orph_rules = filter (isNothing . getRuleKey) (mi_rules new_iface) + 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, @@ -445,10 +431,9 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, new_iface@(ModIface { mi_fix_fn = new_fixities }) new_decls - | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged") $$ pp_orphs) + | 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, - text "" $$ pp_orphs]) + 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, @@ -460,14 +445,14 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, decls_w_vers = [(add_vers decl, decl) | decl <- new_decls] ------------------- - (old_non_orph_insts, old_orph_insts) = mkRuleMap getInstKey (mi_insts old_iface) - (new_non_orph_insts, new_orph_insts) = mkRuleMap getInstKey (mi_insts new_iface) + (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) = mkRuleMap getRuleKey (mi_rules old_iface) - (new_non_orph_rules, new_orph_rules) = mkRuleMap getRuleKey (mi_rules new_iface) + (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) @@ -482,8 +467,8 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, 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 - -- Question: should we also check for equality of mi_deps? - no_other_changes = mi_usages new_iface == mi_usages old_iface + 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" @@ -572,10 +557,16 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, pp_orphs = pprOrphans new_orph_insts new_orph_rules pprOrphans insts rules - = vcat [if null insts then empty else - ptext SLIT("Orphan instances:") <+> vcat (map ppr insts), - if null rules then empty else - ptext SLIT("Orphan rules:") <+> vcat (map ppr 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 @@ -604,17 +595,17 @@ changedWrt so_far NotEqual = True changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids ---------------------- --- mkRuleMap partitions instance decls or rules into +-- 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 -mkRuleMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ +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 -mkRuleMap get_key decls +mkOrphMap get_key decls = foldl go (emptyOccEnv, []) decls where go (non_orphs, orphs) d @@ -622,22 +613,6 @@ mkRuleMap get_key decls = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs) | otherwise = (non_orphs, d:orphs) --- getXxKey: find at least one local OccName that belongs to this decl - -getInstKey :: IfaceInst -> Maybe OccName -getInstKey (IfaceInst {ifInstHead = inst_ty}) - = case [occ | LocalTop occ <- cls_ext : tc_exts] of - [] -> Nothing - (occ:_) -> Just occ - where - (cls_ext, tcs) = ifaceInstGates inst_ty - tc_exts = [tc | IfaceTc tc <- tcs] - -- Ignore the wired-in IfaceTyCons; the class will do as the key - -getRuleKey :: IfaceRule -> Maybe OccName -getRuleKey (IfaceRule {ifRuleHead = LocalTop occ}) = Just occ -getRuleKey other = Nothing - anyNothing :: (a -> Maybe b) -> [a] -> Bool anyNothing p [] = False anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs @@ -663,21 +638,26 @@ bump_unless False v = bumpVersion v \begin{code} -mkUsageInfo :: HscEnv -> ImportAvails -> NameSet -> IO [Usage] -mkUsageInfo hsc_env - (ImportAvails { imp_mods = dir_imp_mods, - imp_dep_mods = dep_mods }) - used_names +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 - ; return (mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env) - dir_imp_mods dep_mods used_names) } - -mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names - = -- 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. - usages `seqList` usages + ; 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 @@ -695,12 +675,9 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names mod = nameModule name add_item occs _ = occ:occs - usages = mapCatMaybes mkUsage (moduleEnvElts dep_mods) - -- ToDo: do we need to sort into canonical order? - - import_all mod = case lookupModuleEnv dir_imp_mods mod of - Just (_,imp_all,_) -> isNothing imp_all - Nothing -> False + 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 @@ -708,23 +685,23 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names -- (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 :: (ModuleName, Bool) -> Maybe Usage + mkUsage :: (Module, Bool) -> Maybe Usage mkUsage (mod_name, _) | isNothing maybe_iface -- We can't depend on it if we didn't - || not (isHomeModule mod) -- even open the interface! + || not (isHomeModule hmods mod) -- even open the interface! || (null used_occs - && not all_imported + && isNothing export_vers && not orphan_mod) = Nothing -- Record no usage info | otherwise - = Just (Usage { usg_name = moduleName mod, + = Just (Usage { usg_name = mod, usg_mod = mod_vers, usg_exports = export_vers, usg_entities = ent_vers, usg_rules = rules_vers }) where - maybe_iface = lookupIfaceByModName hpt pit mod_name + maybe_iface = lookupIfaceByModule hpt pit mod_name -- In one-shot mode, the interfaces for home-package -- modules accumulate in the PIT not HPT. Sigh. @@ -734,9 +711,8 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names version_env = mi_ver_fn iface mod_vers = mi_mod_vers iface rules_vers = mi_rule_vers iface - all_imported = import_all mod - export_vers | all_imported = Just (mi_exp_vers iface) - | otherwise = Nothing + 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` [] @@ -746,11 +722,11 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names \end{code} \begin{code} -mkIfaceExports :: NameSet -> [(ModuleName, [GenAvailInfo OccName])] +mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])] -- Group by module and sort by occurrence -- This keeps the list in canonical order mkIfaceExports exports - = [ (mkSysModuleNameFS fs, eltsFM avails) + = [ (mkModuleFS fs, eltsFM avails) | (fs, avails) <- fmToList groupFM ] where @@ -763,15 +739,15 @@ mkIfaceExports exports (unitFM avail_fs avail) where occ = nameOccName name - mod_fs = moduleNameFS (nameModuleName 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 (insert occ occs) - add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name) + add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs) + add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name) \end{code} @@ -785,21 +761,20 @@ mkIfaceExports exports \begin{code} checkOldIface :: HscEnv - -> Module - -> FilePath -- Where the interface file is + -> ModSummary -> Bool -- Source unchanged -> Maybe ModIface -- Old interface from compilation manager, if any -> IO (RecompileRequired, Maybe ModIface) -checkOldIface hsc_env mod iface_path source_unchanged maybe_iface +checkOldIface hsc_env mod_summary source_unchanged maybe_iface = do { showPass (hsc_dflags hsc_env) - ("Checking old interface for " ++ moduleUserString mod) ; + ("Checking old interface for " ++ moduleString (ms_mod mod_summary)) ; ; initIfaceCheck hsc_env $ - check_old_iface mod iface_path source_unchanged maybe_iface + check_old_iface mod_summary source_unchanged maybe_iface } -check_old_iface this_mod iface_path 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"))) @@ -808,7 +783,8 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface -- 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. getGhciMode `thenM` \ ghci_mode -> - if (ghci_mode == Interactive) && not source_unchanged then + if (ghci_mode == Interactive || ghci_mode == JustTypecheck) + && not source_unchanged then returnM (outOfDate, maybe_iface) else @@ -821,14 +797,17 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface -- Try and read the old interface for the current module -- from the .hi file left from the last time we compiled it - readIface (moduleName this_mod) iface_path False `thenM` \ read_result -> + let + iface_path = msHiFilePath mod_summary + in + readIface (ms_mod mod_summary) iface_path False `thenM` \ read_result -> case read_result of { - Left err -> -- Old interface file not found, or garbled; give up + 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) - ; Right iface -> + ; Succeeded iface -> -- We have got the old iface; check its versions checkVersions source_unchanged iface `thenM` \ recomp -> @@ -858,20 +837,21 @@ checkVersions source_unchanged iface -- Source code unchanged and no errors yet... carry on - -- First put the dependent-module info in the envt, just temporarily, + -- 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). - ; mode <- getGhciMode - ; ifM (isOneShot mode) - (updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }) + -- + -- 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 (ModuleName, IsBootInterface) + mod_deps :: ModuleEnv (Module, IsBootInterface) mod_deps = mkModDeps (dep_mods (mi_deps iface)) checkModUsage :: Usage -> IfG RecompileRequired @@ -894,13 +874,13 @@ checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers, -- Instead, get an Either back which we can test case mb_iface of { - Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"), + 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 - Right iface -> + Succeeded iface -> let new_mod_vers = mi_mod_vers iface new_decl_vers = mi_ver_fn iface @@ -916,7 +896,7 @@ checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers, -- CHECK EXPORT LIST if checkExportList maybe_old_export_vers new_export_vers then out_of_date_vers (ptext SLIT(" Export list changed")) - (fromJust maybe_old_export_vers) + (expectJust "checkModUsage" maybe_old_export_vers) new_export_vers else @@ -984,7 +964,7 @@ checkList (check:checks) = check `thenM` \ recompile -> \begin{code} showIface :: FilePath -> IO () --- Raad binary interface, and print it out +-- 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. @@ -1000,9 +980,9 @@ pprModIface :: ModIface -> SDoc -- Show a ModIface pprModIface iface = vcat [ ptext SLIT("interface") - <+> doubleQuotes (ftext (mi_package iface)) - <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface) - <+> pp_sub_vers + <+> 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") @@ -1016,6 +996,11 @@ pprModIface 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