X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FMkIface.lhs;h=abfc67d5c1a7d35d48f8f8b0166bd8ae52c92514;hb=f4c9d2b23bd63b48566e0ca3b13c8bdfc4cd0c0b;hp=f93737999d80545c6acae9dc4551b3f827520550;hpb=49ac6c398f2915de9eadff3cd2631bc31f806ec8;p=ghc-hetmet.git diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index f937379..abfc67d 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/ghc/compiler/iface/MkIface.lhs @@ -177,7 +177,7 @@ import HsSyn import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..), eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, - eqMaybeBy, eqListBy, + eqMaybeBy, eqListBy, visibleIfConDecls, tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule ) import LoadIface ( readIface, loadInterface, ifaceInstGates ) import BasicTypes ( Version, initialVersion, bumpVersion ) @@ -186,12 +186,12 @@ import TcRnTypes ( ImportAvails(..), mkModDeps ) import TcType ( isFFITy ) import HscTypes ( ModIface(..), TyThing(..), ModGuts(..), ModGuts, IfaceExport, - GhciMode(..), + GhciMode(..), isOneShot, HscEnv(..), hscEPS, Dependencies(..), FixItem(..), mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, typeEnvElts, - Avails, AvailInfo, GenAvailInfo(..), availName, + GenAvailInfo(..), availName, ExternalPackageState(..), Usage(..), IsBootInterface, Deprecs(..), IfaceDeprecs, Deprecations, @@ -209,10 +209,9 @@ import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOc extendOccSet, extendOccSetList, isEmptyOccSet, intersectOccSet, intersectsOccSet, occNameFS, isTcOcc ) -import TyCon ( visibleDataCons, tyConDataCons, isNewTyCon, newTyConRep ) +import TyCon ( tyConDataCons, isNewTyCon, newTyConRep ) import Class ( classSelIds ) import DataCon ( dataConName, dataConFieldLabels ) -import FieldLabel ( fieldLabelName ) import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule, ModLocation(..), mkSysModuleNameFS, moduleUserString, ModuleEnv, emptyModuleEnv, lookupModuleEnv, @@ -220,12 +219,13 @@ import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule, ) import Outputable import DriverUtil ( createDirectoryHierarchy, directoryOf ) -import Util ( sortLt, seqList ) +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 @@ -286,9 +286,9 @@ mkIface hsc_env location maybe_old_iface ; deprecs = mkIfaceDeprec src_deprecs ; iface_rules | omit_prags = [] - | otherwise = sortLt lt_rule $ + | otherwise = sortLe le_rule $ map (coreRuleToIfaceRule this_mod_name ext_nm) rules - ; iface_insts = sortLt lt_inst (map (dfunToIfaceInst this_mod_name) insts) + ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts) ; intermediate_iface = ModIface { mi_module = this_mod, @@ -333,8 +333,8 @@ mkIface hsc_env location maybe_old_iface ; return new_iface } where - r1 `lt_rule` r2 = ifRuleName r1 < ifRuleName r2 - i1 `lt_inst` i2 = ifDFun i1 < ifDFun i2 + 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 @@ -358,9 +358,7 @@ mustExposeThing exports (ATyCon tc) -- can only do that if it can "see" the newtype representation where exported_data_con con - = any (`elemNameSet` exports) (dataConName con : field_names) - where - field_names = map fieldLabelName (dataConFieldLabels con) + = any (`elemNameSet` exports) (dataConName con : dataConFieldLabels con) mustExposeThing exports (AClass cls) = any exported_class_op (classSelIds cls) @@ -485,8 +483,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" @@ -535,7 +533,7 @@ addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, 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 [occ | IfaceConDecl occ _ _ _ _ _ <- visibleDataCons cons] + 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 @@ -649,7 +647,7 @@ 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 (sortLt (<) (nameEnvElts env)) +mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env)) ---------------------- bump_unless :: Bool -> Version -> Version @@ -666,20 +664,22 @@ 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 + -> ModuleEnv (Module, Maybe Bool, SrcSpan) + -> [(ModuleName, IsBootInterface)] + -> NameSet -> IO [Usage] +mkUsageInfo hsc_env 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) } + ; let usages = mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env) + 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 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 + = mapCatMaybes mkUsage dep_mods + -- ToDo: do we need to sort into canonical order? where used_names = mkNameSet $ -- Eliminate duplicates [ nameParent n -- Just record usage on the 'main' names @@ -698,12 +698,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 + Just (_,imp_all,_) -> isNothing imp_all + Nothing -> False -- We want to create a Usage for a home module if -- a) we used something from; has something in used_names @@ -745,7 +742,7 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names used_occs = lookupModuleEnv ent_map mod `orElse` [] ent_vers :: [(OccName,Version)] ent_vers = [ (occ, version_env occ `orElse` initialVersion) - | occ <- sortLt (<) used_occs] + | occ <- sortLe (<=) used_occs] \end{code} \begin{code} @@ -766,7 +763,6 @@ mkIfaceExports exports (unitFM avail_fs avail) where occ = nameOccName name - occ_fs = occNameFS occ mod_fs = moduleNameFS (nameModuleName name) avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ] | isTcOcc occ = AvailTC occ [occ] @@ -857,18 +853,23 @@ checkVersions source_unchanged iface | not source_unchanged = returnM outOfDate | otherwise - = traceHiDiffs (text "Considering whether compilation is required for" <+> - ppr (mi_module iface) <> colon) `thenM_` + = 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 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). - updGblEnv (\ gbl -> gbl { if_is_boot = mod_deps }) ( - checkList [checkModUsage u | u <- mi_usages iface] - ) + -- + -- 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)