Playing with closures

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index d6edaeb..a76ec5a 100644 (file)
--- 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