X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=a76ec5a8744f7fb478cf8638f472cecad02aaead;hb=526a19e90100eadb36185f3bd2c6ac263b7d25ad;hp=4dc78941336440e9a0d83e8822f6e9d2d093a938;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 4dc7894..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, @@ -97,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 ) @@ -105,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 ) @@ -210,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 @@ -296,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} %************************************************************************ @@ -807,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