X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FMkIface.lhs;h=354e31e4056d9ad88ee7b680e23faa3fd822cbd7;hb=c5baccd2b0fc8b987f6c9145a68f06f1d73036bb;hp=8fa008f82a7012379e947ae34fe9094a8941f261;hpb=ac80e0dececb68ed6385e3b34765fd8f9c019767;p=ghc-hetmet.git diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index 8fa008f..354e31e 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/ghc/compiler/iface/MkIface.lhs @@ -4,7 +4,7 @@ \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 @@ -189,6 +189,7 @@ import HscTypes ( ModIface(..), TyThing(..), ModGuts(..), ModGuts, IfaceExport, GhciMode(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..), + ModSummary(..), msHiFilePath, mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, typeEnvElts, GenAvailInfo(..), availName, @@ -258,16 +259,19 @@ mkIface :: HscEnv mkIface hsc_env location maybe_old_iface guts@ModGuts{ mg_module = this_mod, + mg_boot = is_boot, mg_usages = usages, mg_deps = deps, mg_exports = exports, + mg_rdr_env = rdr_env, mg_fix_env = fix_env, mg_deprecs = src_deprecs, mg_insts = insts, mg_rules = rules, mg_types = type_env } = do { eps <- hscEPS hsc_env - ; let { ext_nm = mkExtNameFn hsc_env eps this_mod + ; let { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod + ; ext_nm_lhs = mkLhsNameFn this_mod ; local_things = [thing | thing <- typeEnvElts type_env, not (isWiredInName (getName thing)) ] -- Do not export anything about wired-in things @@ -280,7 +284,7 @@ mkIface hsc_env location maybe_old_iface | thing <- local_things , not (mustExposeThing exports thing)] - ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing + ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm_rhs thing | thing <- local_things, wantDeclFor exports abstract_tcs thing ] -- Don't put implicit Ids and class tycons in the interface file @@ -289,13 +293,13 @@ mkIface hsc_env location maybe_old_iface ; iface_rules | omit_prags = [] | otherwise = sortLe le_rule $ - map (coreRuleToIfaceRule this_mod ext_nm) rules - ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts) + map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules + ; iface_insts = sortLe le_inst (map (dfunToIfaceInst ext_nm_lhs) insts) ; intermediate_iface = ModIface { mi_module = this_mod, mi_package = HomePackage, - mi_boot = False, + mi_boot = is_boot, mi_deps = deps, mi_usages = usages, mi_exports = mkIfaceExports exports, @@ -303,7 +307,8 @@ mkIface hsc_env location maybe_old_iface mi_rules = 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, @@ -340,10 +345,10 @@ mkIface hsc_env location maybe_old_iface 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 + dflags = hsc_dflags hsc_env + ghci_mode = hsc_mode hsc_env + omit_prags = dopt Opt_OmitInterfacePragmas dflags hi_file_path = ml_hi_file location - omit_prags = dopt Opt_OmitInterfacePragmas dflags mustExposeThing :: NameSet -> TyThing -> Bool @@ -419,6 +424,20 @@ mkExtNameFn hsc_env eps this_mod 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 + | mod == this_mod = LocalTop occ + | otherwise = ExtPkg mod occ + where + mod = nameModule name + occ = nameOccName name + + ----------------------------- -- Compute version numbers for local decls @@ -799,21 +818,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 " ++ moduleUserString (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"))) @@ -835,7 +853,10 @@ 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 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 { Failed err -> -- Old interface file not found, or garbled; give up traceIf (text "FYI: cannot read old interface file:" @@ -1016,8 +1037,8 @@ pprModIface :: ModIface -> SDoc pprModIface iface = vcat [ ptext SLIT("interface") <+> ppr_package (mi_package iface) - <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface) - <+> pp_sub_vers + <+> 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") @@ -1031,6 +1052,8 @@ 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)