X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=a76ec5a8744f7fb478cf8638f472cecad02aaead;hb=6c5705e398947a3b74a3f9b7cfb3dd93ca12b8e0;hp=d6edaeb7d4a359719f808ebe644e22f530e51117;hpb=4af2b117f0fdc6992eb2630df637f12b02e8181b;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index d6edaeb..a76ec5a 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, @@ -209,9 +209,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 +301,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} %************************************************************************ @@ -806,13 +815,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