X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=00e1b4951d19c15cb98702243c53fe0ee5749a05;hb=1187e57fab2b5904a808ac973e5d04b91f880920;hp=726c020648d0b9235239920bebe36028944bd908;hpb=6f7ad1accd1ef7e7394ae083797a89d2bb416ef7;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 726c020..00e1b49 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -12,7 +12,7 @@ module HscTypes ( ModuleGraph, emptyMG, ModDetails(..), emptyModDetails, - ModGuts(..), ModImports(..), ForeignStubs(..), + ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..), ModSummary(..), showModMsg, isBootSummary, msHsFilePath, msHiFilePath, msObjFilePath, @@ -45,8 +45,6 @@ module HscTypes ( WhetherHasOrphans, IsBootInterface, Usage(..), Dependencies(..), noDependencies, - InstPool, Gated, addInstsToPool, - RulePool, addRulesToPool, NameCache(..), OrigNameCache, OrigIParamCache, Avails, availsToNameSet, availName, availNames, GenAvailInfo(..), AvailInfo, RdrAvailInfo, @@ -54,7 +52,6 @@ module HscTypes ( Deprecations, DeprecTxt, lookupDeprec, plusDeprecs, - InstEnv, DFunId, PackageInstEnv, PackageRuleBase, -- Linker stuff @@ -78,7 +75,7 @@ import NameSet import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, extendOccEnv ) import Module -import InstEnv ( InstEnv, DFunId ) +import InstEnv ( InstEnv, Instance ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import Id ( Id ) @@ -87,19 +84,20 @@ import Type ( TyThing(..) ) import Class ( Class, classSelIds, classTyCon ) import TyCon ( TyCon, tyConSelIds, tyConDataCons ) import DataCon ( dataConImplicitIds ) -import Packages ( PackageIdH, PackageId, PackageConfig ) +import PrelNames ( gHC_PRIM ) +import Packages ( PackageIdH, PackageId, PackageConfig, HomeModules ) import DynFlags ( DynFlags(..), isOneShot ) -import DriverPhases ( HscSource(..), isHsBoot, hscSourceString ) +import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) ) import FiniteMap ( FiniteMap ) -import CoreSyn ( IdCoreRule ) -import Maybes ( orElse, fromJust, expectJust ) +import CoreSyn ( CoreRule ) +import Maybes ( orElse, expectJust, expectJust ) import Outputable -import SrcLoc ( SrcSpan ) +import SrcLoc ( SrcSpan, Located ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) @@ -191,15 +189,20 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env) data Target = Target TargetId (Maybe (StringBuffer,ClockTime)) data TargetId - = TargetModule Module -- ^ A module name: search for the file - | TargetFile FilePath -- ^ A filename: parse it to find the module name. + = TargetModule Module + -- ^ A module name: search for the file + | TargetFile FilePath (Maybe Phase) + -- ^ A filename: preprocess & parse it to find the module name. + -- If specified, the Phase indicates how to compile this file + -- (which phase to start from). Nothing indicates the starting phase + -- should be determined from the suffix of the filename. deriving Eq pprTarget :: Target -> SDoc pprTarget (Target id _) = pprTargetId id pprTargetId (TargetModule m) = ppr m -pprTargetId (TargetFile f) = text f +pprTargetId (TargetFile f _) = text f type FinderCache = ModuleEnv FinderCacheEntry type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool)) @@ -223,6 +226,10 @@ data HomeModInfo -- the old linkable because it was out of date. -- after a complete compilation (GHC.load), all hm_linkable -- fields in the HPT will be Just. + -- + -- When re-linking a module (hscNoRecomp), we construct + -- the HomModInfo by building a new ModDetails from the + -- old ModIface (only). \end{code} Simple lookups in the symbol table. @@ -245,18 +252,18 @@ lookupIfaceByModule hpt pit mod \begin{code} -hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId] +hptInstances :: HscEnv -> (Module -> Bool) -> [Instance] -- Find all the instance declarations that are in modules imported -- by this one, directly or indirectly, and are in the Home Package Table -- This ensures that we don't see instances from modules --make compiled -- before this one, but which are not below this one hptInstances hsc_env want_this_module - = [ dfun + = [ ispec | mod_info <- moduleEnvElts (hsc_HPT hsc_env) , want_this_module (mi_module (hm_iface mod_info)) - , dfun <- md_insts (hm_details mod_info) ] + , ispec <- md_insts (hm_details mod_info) ] -hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule] +hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [CoreRule] -- Get rules from modules "below" this one (in the dependency sense) -- C.f Inst.hptInstances hptRules hsc_env deps @@ -269,9 +276,17 @@ hptRules hsc_env deps | -- Find each non-hi-boot module below me (mod, False) <- deps + -- unsavoury: when compiling the base package with --make, we + -- sometimes try to look up RULES for GHC.Prim. GHC.Prim won't + -- be in the HPT, because we never compile it; it's in the EPT + -- instead. ToDo: clean up, and remove this slightly bogus + -- filter: + , mod /= gHC_PRIM + -- Look it up in the HPT - , let mod_info = ASSERT( mod `elemModuleEnv` hpt ) - fromJust (lookupModuleEnv hpt mod) + , let mod_info = case lookupModuleEnv hpt mod of + Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps) + Just x -> x -- And get its dfuns , rule <- md_rules (hm_details mod_info) ] @@ -335,9 +350,19 @@ data ModIface mi_decls :: [(Version,IfaceDecl)], -- Sorted mi_globals :: !(Maybe GlobalRdrEnv), - -- Its top level environment or Nothing if we read this - -- interface from an interface file. (We need the source - -- file to figure out the top-level environment.) + -- Binds all the things defined at the top level in + -- the *original source* code for this module. which + -- is NOT the same as mi_exports, nor mi_decls (which + -- may contains declarations for things not actually + -- defined by the user). Used for GHCi and for inspecting + -- the contents of modules via the GHC API only. + -- + -- (We need the source file to figure out the + -- top-level environment, if we didn't compile this module + -- from source then this field contains Nothing). + -- + -- Strictly speaking this field should live in the + -- HomeModInfo, but that leads to more plumbing. -- Instance declarations and rules mi_insts :: [IfaceInst], -- Sorted @@ -359,10 +384,10 @@ data ModIface data ModDetails = ModDetails { -- The next three fields are created by the typechecker - md_types :: !TypeEnv, md_exports :: NameSet, - md_insts :: ![DFunId], -- Dfun-ids for the instances in this module - md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules + md_types :: !TypeEnv, + md_insts :: ![Instance], -- Dfun-ids for the instances in this module + md_rules :: ![CoreRule] -- Domain may include Ids from other modules } emptyModDetails = ModDetails { md_types = emptyTypeEnv, @@ -381,6 +406,7 @@ data ModGuts mg_boot :: IsBootInterface, -- Whether it's an hs-boot module mg_exports :: !NameSet, -- What it exports mg_deps :: !Dependencies, -- What is below it, directly or otherwise + mg_home_mods :: !HomeModules, -- For calling isHomeModule etc. mg_dir_imps :: ![Module], -- Directly-imported modules; used to -- generate initialisation code mg_usages :: ![Usage], -- Version info for what it needed @@ -390,8 +416,8 @@ data ModGuts mg_deprecs :: !Deprecations, -- Deprecations declared in the module mg_types :: !TypeEnv, - mg_insts :: ![DFunId], -- Instances - mg_rules :: ![IdCoreRule], -- Rules from this module + mg_insts :: ![Instance], -- Instances + mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module mg_foreign :: !ForeignStubs } @@ -401,24 +427,40 @@ data ModGuts -- After simplification, the following fields change slightly: -- mg_rules Orphan rules only (local ones now attached to binds) -- mg_binds With rules attached --- --- After CoreTidy, the following fields change slightly: --- mg_types Now contains Ids as well, replete with final IdInfo --- The Ids are only the ones that are visible from --- importing modules. Without -O that means only --- exported Ids, but with -O importing modules may --- see ids mentioned in unfoldings of exported Ids --- --- mg_insts Same DFunIds as before, but with final IdInfo, --- and the unique might have changed; remember that --- CoreTidy links up the uniques of old and new versions --- --- mg_rules All rules for exported things, substituted with final Ids --- --- mg_binds Tidied +--------------------------------------------------------- +-- The Tidy pass forks the information about this module: +-- * one lot goes to interface file generation (ModIface) +-- and later compilations (ModDetails) +-- * the other lot goes to code generation (CgGuts) +data CgGuts + = CgGuts { + cg_module :: !Module, + + cg_tycons :: [TyCon], + -- Algebraic data types (including ones that started + -- life as classes); generate constructors and info + -- tables Includes newtypes, just for the benefit of + -- External Core + + cg_binds :: [CoreBind], + -- The tidied main bindings, including + -- previously-implicit bindings for record and class + -- selectors, and data construtor wrappers. But *not* + -- data constructor workers; reason: we we regard them + -- as part of the code-gen of tycons + + cg_dir_imps :: ![Module], + -- Directly-imported modules; used to generate + -- initialisation code + + cg_foreign :: !ForeignStubs, + cg_home_mods :: !HomeModules, -- for calling isHomeModule etc. + cg_dep_pkgs :: ![PackageId] -- Used to generate #includes for C code gen + } +----------------------------------- data ModImports = ModImports { imp_direct :: ![(Module,Bool)], -- Explicitly-imported modules @@ -430,6 +472,7 @@ data ModImports -- directly or indirectly } +----------------------------------- data ForeignStubs = NoStubs | ForeignStubs SDoc -- Header file prototypes for @@ -643,6 +686,11 @@ data Deprecs a type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)] type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt)) + -- Keep the OccName so we can flatten the NameEnv to + -- get an IfaceDeprecs from a Deprecations + -- Only an OccName is needed, because a deprecation always + -- applies to things defined in the module in which the + -- deprecation appears. mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt mkIfaceDepCache NoDeprecs = \n -> Nothing @@ -783,9 +831,16 @@ data Usage -- time round, but if someone has added a new rule you might need it this time -- The export list field is (Just v) if we depend on the export list: - -- i.e. we imported the module without saying exactly what we imported - -- We need to recompile if the module exports changes, because we might - -- now have a name clash in the importing module. + -- i.e. we imported the module directly, whether or not we + -- 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(x) M might no longer export x + -- The only way we don't depend on the export list is if we have + -- import M() + -- And of course, for modules that aren't imported directly we don't + -- depend on their export lists \end{code} @@ -817,7 +872,7 @@ data ExternalPackageState -- The ModuleIFaces for modules in external packages -- whose interfaces we have opened -- The declarations in these interface files are held in - -- eps_decls, eps_insts, eps_rules (below), not in the + -- eps_decls, eps_inst_env, eps_rules (below), not in the -- mi_decls fields of the iPIT. -- What _is_ in the iPIT is: -- * The Module @@ -832,18 +887,6 @@ data ExternalPackageState -- all the external-package modules eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv - - -- Holding pens for stuff that has been read in from file, - -- but not yet slurped into the renamer - eps_insts :: !InstPool, - -- The as-yet un-slurped instance decls - -- Decls move from here to eps_inst_env - -- Each instance is 'gated' by the names that must be - -- available before this instance decl is needed. - - eps_rules :: !RulePool, - -- The as-yet un-slurped rules - eps_stats :: !EpsStats } @@ -853,6 +896,14 @@ data EpsStats = EpsStats { n_ifaces_in , n_decls_in, n_decls_out , n_rules_in, n_rules_out , n_insts_in, n_insts_out :: !Int } + +addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats +-- Add stats for one newly-read interface +addEpsInStats stats n_decls n_insts n_rules + = stats { n_ifaces_in = n_ifaces_in stats + 1 + , n_decls_in = n_decls_in stats + n_decls + , n_insts_in = n_insts_in stats + n_insts + , n_rules_in = n_rules_in stats + n_rules } \end{code} The NameCache makes sure that there is just one Unique assigned for @@ -863,10 +914,6 @@ name, we might not be at its binding site (e.g. we are reading an interface file); so we give it 'noSrcLoc' then. Later, when we find its binding site, we fix it up. -Exactly the same is true of the Module stored in the Name. When we first -encounter the occurrence, we may not know the details of the module, so -we just store junk. Then when we find the binding site, we fix it up. - \begin{code} data NameCache = NameCache { nsUniqs :: UniqSupply, @@ -881,47 +928,6 @@ type OrigNameCache = ModuleEnv (OccEnv Name) type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) \end{code} -\begin{code} -type Gated d = ([Name], (Module, SDoc, d)) - -- The [Name] 'gate' the declaration; always non-empty - -- Module records which module this decl belongs to - -- SDoc records the pathname of the file, or similar err-ctxt info - -type RulePool = [Gated IfaceRule] - -addRulesToPool :: RulePool - -> [Gated IfaceRule] - -> RulePool -addRulesToPool rules new_rules = new_rules ++ rules - -------------------------- -addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats --- Add stats for one newly-read interface -addEpsInStats stats n_decls n_insts n_rules - = stats { n_ifaces_in = n_ifaces_in stats + 1 - , n_decls_in = n_decls_in stats + n_decls - , n_insts_in = n_insts_in stats + n_insts - , n_rules_in = n_rules_in stats + n_rules } - -------------------------- -type InstPool = NameEnv [Gated IfaceInst] - -- The key of the Pool is the Class - -- The Names are the TyCons in the instance head - -- For example, suppose this is in an interface file - -- instance C T where ... - -- We want to slurp this decl if both C and T are "visible" in - -- the importing module. See "The gating story" in RnIfaces for details. - - -addInstsToPool :: InstPool -> [(Name, Gated IfaceInst)] -> InstPool -addInstsToPool insts new_insts - = foldr add insts new_insts - where - add :: (Name, Gated IfaceInst) -> NameEnv [Gated IfaceInst] -> NameEnv [Gated IfaceInst] - add (cls,new_inst) insts = extendNameEnv_C combine insts cls [new_inst] - where - combine old_insts _ = new_inst : old_insts -\end{code} %************************************************************************ @@ -954,8 +960,8 @@ data ModSummary ms_location :: ModLocation, -- Location ms_hs_date :: ClockTime, -- Timestamp of source file ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe - ms_srcimps :: [Module], -- Source imports - ms_imps :: [Module], -- Non-source imports + ms_srcimps :: [Located Module], -- Source imports + ms_imps :: [Located Module], -- Non-source imports ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source, -- once we have preprocessed it. ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe. @@ -999,7 +1005,7 @@ showModMsg use_object mod_summary char ')']) where mod = ms_mod mod_summary - mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary) + mod_str = moduleString mod ++ hscSourceString (ms_hsc_src mod_summary) \end{code} @@ -1022,7 +1028,12 @@ data Linkable = LM { } isObjectLinkable :: Linkable -> Bool -isObjectLinkable l = all isObject (linkableUnlinked l) +isObjectLinkable l = not (null unlinked) && all isObject unlinked + where unlinked = linkableUnlinked l + -- A linkable with no Unlinked's is treated as a BCO. We can + -- generate a linkable with no Unlinked's as a result of + -- compiling a module in HscNothing mode, and this choice + -- happens to work well with checkStability in module GHC. instance Outputable Linkable where ppr (LM when_made mod unlinkeds)