X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=e6e8e4cba47fb4ba25837f3f5e8ad412f3c0c871;hb=dfcbc18e016540cb136ec3298a07a4a55b488db0;hp=7e30d77f165c83db3b8292d815ce1d2f8fb3a45a;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 7e30d77..e6e8e4c 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -51,14 +51,15 @@ module HscTypes ( GenAvailInfo(..), AvailInfo, RdrAvailInfo, IfaceExport, - Deprecations, DeprecTxt, lookupDeprec, plusDeprecs, + Deprecations, DeprecTxt, plusDeprecs, PackageInstEnv, PackageRuleBase, -- Linker stuff Linkable(..), isObjectLinkable, Unlinked(..), CompiledByteCode, - isObject, nameOfObject, isInterpretable, byteCodeOfObject + isObject, nameOfObject, isInterpretable, byteCodeOfObject, + HpcInfo, noHpcInfo ) where #include "HsVersions.h" @@ -96,7 +97,7 @@ import BasicTypes ( Version, initialVersion, IPName, import IfaceSyn import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) -import Maybes ( orElse, expectJust ) +import Maybes ( orElse, expectJust, catMaybes, seqMaybe ) import Outputable import SrcLoc ( SrcSpan, Located ) import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) @@ -104,7 +105,6 @@ import UniqSupply ( UniqSupply ) import FastString ( FastString ) import StringBuffer ( StringBuffer ) -import Maybes ( catMaybes, seqMaybe ) import System.Time ( ClockTime ) import Data.IORef ( IORef, readIORef ) @@ -295,12 +295,15 @@ hptRules hsc_env deps , mod /= moduleName gHC_PRIM -- Look it up in the HPT - , let mod_info = case lookupUFM hpt mod of - Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps) - Just x -> x + , 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")] + -- This really shouldn't happen, but see Trac #962 -- And get its dfuns - , rule <- md_rules (hm_details mod_info) ] + , rule <- rules ] \end{code} %************************************************************************ @@ -367,6 +370,7 @@ data ModIface mi_mod_vers :: !Version, -- Module version: changes when anything changes mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans + mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts mi_boot :: !IsBootInterface, -- Read from an hi-boot file? mi_deps :: Dependencies, @@ -420,7 +424,8 @@ data ModIface mi_fam_insts :: [IfaceFamInst], -- Sorted mi_rules :: [IfaceRule], -- Sorted mi_rule_vers :: !Version, -- Version number for rules and - -- instances combined + -- instances (for classes and families) + -- combined -- Cached environments for easy lookup -- These are computed (lazily) from other fields @@ -438,12 +443,12 @@ data ModIface -- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { - -- The next three fields are created by the typechecker - md_exports :: [AvailInfo], - md_types :: !TypeEnv, - md_fam_insts :: ![FamInst], -- Cached value extracted from md_types - md_insts :: ![Instance], -- Dfun-ids for the instances in this module - md_rules :: ![CoreRule] -- Domain may include Ids from other modules + -- The next two fields are created by the typechecker + md_exports :: [AvailInfo], + md_types :: !TypeEnv, + md_insts :: ![Instance], -- Dfun-ids for the instances in this module + md_fam_insts :: ![FamInst], + md_rules :: ![CoreRule] -- Domain may include Ids from other modules } emptyModDetails = ModDetails { md_types = emptyTypeEnv, @@ -478,7 +483,8 @@ data ModGuts mg_fam_insts :: ![FamInst], -- Instances mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module - mg_foreign :: !ForeignStubs + mg_foreign :: !ForeignStubs, + mg_hpc_info :: !HpcInfo -- info about coverage tick boxes } -- The ModGuts takes on several slightly different forms: @@ -515,7 +521,8 @@ data CgGuts -- initialisation code cg_foreign :: !ForeignStubs, - cg_dep_pkgs :: ![PackageId] -- Used to generate #includes for C code gen + cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen + cg_hpc_info :: !HpcInfo -- info about coverage tick boxes } ----------------------------------- @@ -550,6 +557,7 @@ emptyModIface mod = ModIface { mi_module = mod, mi_mod_vers = initialVersion, mi_orphan = False, + mi_finsts = False, mi_boot = False, mi_deps = noDependencies, mi_usages = [], @@ -801,13 +809,6 @@ mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName emptyIfaceDepCache :: Name -> Maybe DeprecTxt emptyIfaceDepCache n = Nothing -lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt -lookupDeprec NoDeprecs name = Nothing -lookupDeprec (DeprecAll txt) name = Just txt -lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of - Just (_, txt) -> Just txt - Nothing -> Nothing - plusDeprecs :: Deprecations -> Deprecations -> Deprecations plusDeprecs d NoDeprecs = d plusDeprecs NoDeprecs d = d @@ -854,11 +855,8 @@ instance Outputable n => Outputable (GenAvailInfo n) where ppr = pprAvail pprAvail :: Outputable n => GenAvailInfo n -> SDoc -pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of - [] -> empty - ns' -> braces (hsep (punctuate comma (map ppr ns'))) - -pprAvail (Avail n) = ppr n +pprAvail (Avail n) = ppr n +pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns))) \end{code} \begin{code} @@ -904,22 +902,32 @@ type WhetherHasOrphans = Bool -- * a transformation rule in a module other than the one defining -- the function in the head of the rule. +type WhetherHasFamInst = Bool -- This module defines family instances? + type IsBootInterface = Bool -- Dependency info about modules and packages below this one -- in the import hierarchy. See TcRnTypes.ImportAvails for details. +-- The orphan modules in `dep_orphs' do *not* include family instance orphans, +-- as they are anyway included in `dep_finsts'. -- -- Invariant: the dependencies of a module M never includes M -- Invariant: the lists are unordered, with no duplicates data Dependencies - = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies - dep_pkgs :: [PackageId], -- External package dependencies - dep_orphs :: [Module] } -- Orphan modules (whether home or external pkg) + = Deps { dep_mods :: [(ModuleName, -- Home-package module dependencies + IsBootInterface)] + , dep_pkgs :: [PackageId] -- External package dependencies + , dep_orphs :: [Module] -- Orphan modules (whether home or + -- external pkg) + , dep_finsts :: [Module] -- Modules that contain family + -- instances (whether home or + -- external pkg) + } deriving( Eq ) -- Equality used only for old/new comparison in MkIface.addVersionInfo noDependencies :: Dependencies -noDependencies = Deps [] [] [] +noDependencies = Deps [] [] [] [] data Usage = Usage { usg_name :: ModuleName, -- Name of the module @@ -998,6 +1006,9 @@ data ExternalPackageState eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv + eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family + -- instances of each mod + eps_stats :: !EpsStats } @@ -1126,6 +1137,19 @@ showModMsg target recomp mod_summary %************************************************************************ %* * +\subsection{Hpc Support} +%* * +%************************************************************************ + +\begin{code} +type HpcInfo = Int -- just the number of ticks in a module + +noHpcInfo :: HpcInfo +noHpcInfo = 0 -- default = 0 +\end{code} + +%************************************************************************ +%* * \subsection{Linkable stuff} %* * %************************************************************************