X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=244b312127b36624ba7f01ea43496e73324c9e35;hp=7ad34ace635c4fc315e9a0e8302676d168e7f7dd;hb=refs%2Ftags%2F2008-06-01;hpb=206b4dec78250efef3cd927d64dc6cbc54a16c3d diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 7ad34ac..244b312 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -32,7 +32,7 @@ module HscTypes ( icPrintUnqual, mkPrintUnqualified, extendInteractiveContext, substInteractiveContext, - ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, + ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache, emptyIfaceDepCache, FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv, @@ -101,24 +101,27 @@ import PrelNames ( gHC_PRIM ) import Packages hiding ( Version(..) ) import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) -import BasicTypes ( Version, initialVersion, IPName, - Fixity, defaultFixity, DeprecTxt ) +import BasicTypes ( IPName, Fixity, defaultFixity, DeprecTxt ) +import OptimizationFuel ( OptFuelState ) import IfaceSyn import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) -import Maybes ( orElse, expectJust, catMaybes, seqMaybe ) +import Maybes ( orElse, expectJust, catMaybes ) import Outputable import BreakArray import SrcLoc ( SrcSpan, Located ) -import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) +import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) -import FastString ( FastString ) +import FastString import StringBuffer ( StringBuffer ) +import Fingerprint +import System.FilePath import System.Time ( ClockTime ) import Data.IORef import Data.Array ( Array, array ) import Data.List +import Control.Monad ( mplus ) \end{code} @@ -198,6 +201,15 @@ data HscEnv -- The finder's cache. This caches the location of modules, -- so we don't have to search the filesystem multiple times. + hsc_OptFuel :: OptFuelState, + -- Settings to control the use of optimization fuel: + -- by limiting the number of transformations, + -- we can use binary search to help find compiler bugs. + + hsc_type_env_var :: Maybe (Module, IORef TypeEnv), + -- Used for one-shot compilation only, to initialise + -- the IfGblEnv. See TcRnTypes.TcGblEnv.tcg_type_env_var + hsc_global_rdr_env :: GlobalRdrEnv, hsc_global_type_env :: TypeEnv } @@ -276,7 +288,7 @@ lookupIfaceByModule dflags hpt pit mod -- in the HPT. If it's not from the home package it's wrong to look -- in the HPT, because the HPT is indexed by *ModuleName* not Module fmap hm_iface (lookupUFM hpt (moduleName mod)) - `seqMaybe` lookupModuleEnv pit mod + `mplus` lookupModuleEnv pit mod | otherwise = lookupModuleEnv pit mod -- Look in PIT only @@ -328,8 +340,8 @@ hptRules hsc_env deps , let rules = case lookupUFM hpt mod of Just info -> md_rules (hm_details info) Nothing -> pprTrace "WARNING in hptRules" msg [] - msg = vcat [ptext SLIT("missing module") <+> ppr mod, - ptext SLIT("Probable cause: out-of-date interface files")] + msg = vcat [ptext (sLit "missing module") <+> ppr mod, + ptext (sLit "Probable cause: out-of-date interface files")] -- This really shouldn't happen, but see Trac #962 -- And get its dfuns @@ -406,7 +418,8 @@ the declarations into a single indexed map in the @PersistentRenamerState@. data ModIface = ModIface { mi_module :: !Module, - mi_mod_vers :: !Version, -- Module version: changes when anything changes + mi_iface_hash :: !Fingerprint, -- Hash of the whole interface + mi_mod_hash :: !Fingerprint, -- Hash of the ABI only mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts @@ -418,7 +431,7 @@ data ModIface -- Usages; kept sorted so that it's easy to decide -- whether to write a new iface file (changing usages - -- doesn't affect the version of this module) + -- doesn't affect the hash of this module) mi_usages :: [Usage], -- NOT STRICT! we read this field lazily from the interface file -- It is *only* consulted by the recompilation checker @@ -426,7 +439,7 @@ data ModIface -- Exports -- Kept sorted by (mod,occ), to make version comparisons easier mi_exports :: ![IfaceExport], - mi_exp_vers :: !Version, -- Version number of export list + mi_exp_hash :: !Fingerprint, -- Hash of export list -- Fixities mi_fixities :: [(OccName,Fixity)], @@ -437,11 +450,11 @@ data ModIface -- NOT STRICT! we read this field lazily from the interface file -- Type, class and variable declarations - -- The version of an Id changes if its fixity or deprecations change + -- 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 version of the parent class/tycon changes - mi_decls :: [(Version,IfaceDecl)], -- Sorted + -- the hash of the parent class/tycon changes + mi_decls :: [(Fingerprint,IfaceDecl)], -- Sorted mi_globals :: !(Maybe GlobalRdrEnv), -- Binds all the things defined at the top level in @@ -462,7 +475,7 @@ data ModIface mi_insts :: [IfaceInst], -- Sorted mi_fam_insts :: [IfaceFamInst], -- Sorted mi_rules :: [IfaceRule], -- Sorted - mi_rule_vers :: !Version, -- Version number for rules and + mi_orphan_hash :: !Fingerprint, -- Hash for orphan rules and -- instances (for classes and families) -- combined @@ -474,9 +487,9 @@ data ModIface -- and are not put into the interface file mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities - mi_ver_fn :: OccName -> Maybe (OccName, Version), + mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint), -- Cached lookup for mi_decls - -- The Nothing in mi_ver_fn means that the thing + -- 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. @@ -510,7 +523,7 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv, -- being compiled right now. Once it is compiled, a ModIface and -- ModDetails are extracted and the ModGuts is dicarded. -type ImportedMods = ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]) +type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)] data ModGuts = ModGuts { @@ -627,23 +640,21 @@ data ForeignStubs = NoStubs -- "foreign exported" functions SDoc -- C stubs to use when calling -- "foreign exported" functions - [FastString] -- Headers that need to be included - -- into C code generated for this module - \end{code} \begin{code} emptyModIface :: Module -> ModIface emptyModIface mod = ModIface { mi_module = mod, - mi_mod_vers = initialVersion, + mi_iface_hash = fingerprint0, + mi_mod_hash = fingerprint0, mi_orphan = False, mi_finsts = False, mi_boot = False, mi_deps = noDependencies, mi_usages = [], mi_exports = [], - mi_exp_vers = initialVersion, + mi_exp_hash = fingerprint0, mi_fixities = [], mi_deprecs = NoDeprecs, mi_insts = [], @@ -651,12 +662,12 @@ emptyModIface mod mi_rules = [], mi_decls = [], mi_globals = Nothing, - mi_rule_vers = initialVersion, + mi_orphan_hash = fingerprint0, mi_vect_info = noIfaceVectInfo, - mi_dep_fn = emptyIfaceDepCache, - mi_fix_fn = emptyIfaceFixCache, - mi_ver_fn = emptyIfaceVerCache, - mi_hpc = False + mi_dep_fn = emptyIfaceDepCache, + mi_fix_fn = emptyIfaceFixCache, + mi_hash_fn = emptyIfaceHashCache, + mi_hpc = False } \end{code} @@ -966,19 +977,10 @@ tyThingId (ADataCon dc) = dataConWrapId dc tyThingId other = pprPanic "tyThingId" (pprTyThing other) \end{code} -%************************************************************************ -%* * -\subsection{Auxiliary types} -%* * -%************************************************************************ - -These types are defined here because they are mentioned in ModDetails, -but they are mostly elaborated elsewhere - \begin{code} -mkIfaceVerCache :: [(Version,IfaceDecl)] - -> (OccName -> Maybe (OccName, Version)) -mkIfaceVerCache pairs +mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] + -> (OccName -> Maybe (OccName, Fingerprint)) +mkIfaceHashCache pairs = \occ -> lookupOccEnv env occ where env = foldr add_decl emptyOccEnv pairs @@ -988,9 +990,20 @@ mkIfaceVerCache pairs env1 = extendOccEnv env0 decl_name (decl_name, v) add_imp bndr env = extendOccEnv env bndr (decl_name, v) -emptyIfaceVerCache :: OccName -> Maybe (OccName, Version) -emptyIfaceVerCache _occ = Nothing +emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) +emptyIfaceHashCache _occ = Nothing +\end{code} + +%************************************************************************ +%* * +\subsection{Auxiliary types} +%* * +%************************************************************************ +These types are defined here because they are mentioned in ModDetails, +but they are mostly elaborated elsewhere + +\begin{code} ------------------ Deprecations ------------------------- data Deprecations = NoDeprecs @@ -1147,26 +1160,29 @@ noDependencies :: Dependencies noDependencies = Deps [] [] [] [] data Usage - = Usage { usg_name :: ModuleName, -- Name of the module - usg_mod :: Version, -- Module version - usg_entities :: [(OccName,Version)], -- Sorted by occurrence name - -- NB. usages are for parent names only, eg. tycon but not constructors. - usg_exports :: Maybe Version, -- Export-list version, if we depend on it - usg_rules :: Version -- Orphan-rules version (for non-orphan - -- modules this will always be initialVersion) - } deriving( Eq ) - -- This type doesn't let you say "I imported f but none of the rules in - -- the module". If you use anything in the module you get its rule version - -- So if the rules change, you'll recompile, even if you don't use them. - -- This is easy to implement, and it's safer: you might not have used the rules last - -- time round, but if someone has added a new rule you might need it this time - + = UsagePackageModule { + usg_mod :: Module, + usg_mod_hash :: Fingerprint + } + | UsageHomeModule { + usg_mod_name :: ModuleName, -- Name of the module + usg_mod_hash :: Fingerprint, -- Module fingerprint + -- (optimisation only) + usg_entities :: [(OccName,Fingerprint)], + -- Sorted by occurrence name. + -- NB. usages are for parent names only, + -- eg. tycon but not constructors. + usg_exports :: Maybe Fingerprint + -- Export-list fingerprint, if we depend on it + } + deriving( Eq ) -- The export list field is (Just v) if we depend on the export list: -- i.e. we imported the module directly, whether or not we - -- enumerated the things we imported, or just imported everything + -- enumerated the things we imported, or just imported + -- everything -- We need to recompile if M's exports change, because - -- if the import was import M, we might now have a name clash in the - -- importing module. + -- if the import was import M, we might now have a name clash + -- in the importing module. -- if the import was import M(x) M might no longer export x -- The only way we don't depend on the export list is if we have -- import M() @@ -1211,7 +1227,7 @@ data ExternalPackageState -- (below), not in the mi_decls fields of the iPIT. -- What _is_ in the iPIT is: -- * The Module - -- * Version info + -- * Fingerprint info -- * Its exports -- * Fixities -- * Deprecations @@ -1342,14 +1358,15 @@ instance Outputable ModSummary where showModMsg :: HscTarget -> Bool -> ModSummary -> String showModMsg target recomp mod_summary - = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), - char '(', text (msHsFilePath mod_summary) <> comma, - case target of - HscInterpreted | recomp - -> text "interpreted" - HscNothing -> text "nothing" - _other -> text (msObjFilePath mod_summary), - char ')']) + = showSDoc $ + hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), + char '(', text (normalise $ msHsFilePath mod_summary) <> comma, + case target of + HscInterpreted | recomp + -> text "interpreted" + HscNothing -> text "nothing" + _ -> text (normalise $ msObjFilePath mod_summary), + char ')'] where mod = moduleName (ms_mod mod_summary) mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)