X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=41558079740a77ae315ba1dd6b0f132eecc26d51;hb=209686695e664bc148d4031f746425ffc2d2eecc;hp=d6edaeb7d4a359719f808ebe644e22f530e51117;hpb=4af2b117f0fdc6992eb2630df637f12b02e8181b;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index d6edaeb..4155807 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -51,7 +51,7 @@ module HscTypes ( GenAvailInfo(..), AvailInfo, RdrAvailInfo, IfaceExport, - Deprecations, DeprecTxt, lookupDeprec, plusDeprecs, + Deprecations, DeprecTxt, plusDeprecs, PackageInstEnv, PackageRuleBase, @@ -64,6 +64,7 @@ module HscTypes ( #include "HsVersions.h" +import Breakpoints ( SiteNumber, Coord, noDbgSites ) #ifdef GHCI import ByteCodeAsm ( CompiledByteCode ) #endif @@ -209,9 +210,15 @@ data TargetId pprTarget :: Target -> SDoc pprTarget (Target id _) = pprTargetId id +instance Outputable Target where + ppr = pprTarget + pprTargetId (TargetModule m) = ppr m pprTargetId (TargetFile f _) = text f +instance Outputable TargetId where + ppr = pprTargetId + type HomePackageTable = ModuleNameEnv HomeModInfo -- Domain = modules in the home package -- "home" package name cached here for convenience @@ -295,12 +302,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} %************************************************************************ @@ -445,14 +455,16 @@ data ModDetails 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 + md_rules :: ![CoreRule], -- Domain may include Ids from other modules + md_dbg_sites :: ![(SiteNumber, Coord)] -- Breakpoint sites inserted by the renamer } emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_exports = [], md_insts = [], md_rules = [], - md_fam_insts = [] } + md_fam_insts = [], + md_dbg_sites = noDbgSites} -- A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -481,7 +493,8 @@ data ModGuts mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module mg_foreign :: !ForeignStubs, - mg_hpc_info :: !HpcInfo -- info about coverage tick boxes + mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes + mg_dbg_sites :: ![(SiteNumber, Coord)] -- Bkpts inserted by the renamer } -- The ModGuts takes on several slightly different forms: @@ -806,13 +819,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