Add a WARNING pragma
[ghc-hetmet.git] / compiler / rename / RnNames.lhs
index ae730c7..7aad117 100644 (file)
@@ -7,7 +7,7 @@
 module RnNames (
        rnImports, getLocalNonValBinders,
        rnExports, extendGlobalRdrEnvRn,
-       reportUnusedNames, finishDeprecations,
+       reportUnusedNames, finishWarnings,
     ) where
 
 #include "HsVersions.h"
@@ -33,7 +33,7 @@ import Maybes
 import SrcLoc
 import FiniteMap
 import ErrUtils
-import BasicTypes      ( DeprecTxt )
+import BasicTypes      ( WarningTxt(..) )
 import DriverPhases    ( isHsBoot )
 import Util
 import FastString
@@ -143,7 +143,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
 
     let
        imp_mod    = mi_module iface
-       deprecs    = mi_deprecs iface
+       warns      = mi_warns iface
        orph_iface = mi_orphan iface 
        has_finsts = mi_finsts iface 
        deps       = mi_deps iface
@@ -225,7 +225,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
                        _                    -> False
 
        imports   = ImportAvails { 
-                       imp_mods     = unitModuleEnv imp_mod (imp_mod, [(qual_mod_name, import_all, loc)]),
+                       imp_mods     = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)],
                        imp_orphs    = orphans,
                        imp_finsts   = finsts,
                        imp_dep_mods = mkModDeps dependent_mods,
@@ -233,10 +233,10 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
                    }
 
        -- Complain if we import a deprecated module
-    ifOptM Opt_WarnDeprecations        (
-       case deprecs of 
-         DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
-         _             -> return ()
+    ifOptM Opt_WarnWarningsDeprecations        (
+       case warns of   
+         WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
+         _           -> return ()
      )
 
     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot
@@ -805,7 +805,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
     kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
 
     imported_modules = [ qual_name
-                       | (_, xs) <- moduleEnvElts $ imp_mods imports,
+                       | xs <- moduleEnvElts $ imp_mods imports,
                          (qual_name, _, _) <- xs ]
 
     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
@@ -926,7 +926,7 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov })
        -- They just clutter up the environment (esp tuples), and the parser
        -- will generate Exact RdrNames for them, so the cluttered
        -- envt is no use.  To avoid doing this filter all the time,
-       -- we use -fno-implicit-prelude as a clue that the filter is
+       -- we use -XNoImplicitPrelude as a clue that the filter is
        -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
        --
        -- It's worth doing because it makes the environment smaller for
@@ -966,23 +966,23 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
-finishDeprecations :: DynFlags -> Maybe DeprecTxt 
-                  -> TcGblEnv -> RnM TcGblEnv
--- (a) Report usasge of deprecated imports
--- (b) If the whole module is deprecated, update tcg_deprecs
---             All this happens only once per module
-finishDeprecations dflags mod_deprec tcg_env
+finishWarnings :: DynFlags -> Maybe WarningTxt 
+               -> TcGblEnv -> RnM TcGblEnv
+-- (a) Report usage of imports that are deprecated or have other warnings
+-- (b) If the whole module is warned about or deprecated, update tcg_warns
+--     All this happens only once per module
+finishWarnings dflags mod_warn tcg_env
   = do { (eps,hpt) <- getEpsAndHpt
-       ; ifOptM Opt_WarnDeprecations   $
+       ; ifOptM Opt_WarnWarningsDeprecations $
          mapM_ (check hpt (eps_PIT eps)) all_gres
                -- By this time, typechecking is complete, 
                -- so the PIT is fully populated
 
-       -- Deal with a module deprecation; it overrides all existing deprecs
-       ; let new_deprecs = case mod_deprec of
-                               Just txt -> DeprecAll txt
-                               Nothing  -> tcg_deprecs tcg_env
-       ; return (tcg_env { tcg_deprecs = new_deprecs }) }
+       -- Deal with a module deprecation; it overrides all existing warns
+       ; let new_warns = case mod_warn of
+                               Just txt -> WarnAll txt
+                               Nothing  -> tcg_warns tcg_env
+       ; return (tcg_env { tcg_warns = new_warns }) }
   where
     used_names = allUses (tcg_dus tcg_env) 
        -- Report on all deprecated uses; hence allUses
@@ -992,7 +992,7 @@ finishDeprecations dflags mod_deprec tcg_env
       | name `elemNameSet` used_names
       ,        Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
       = addWarnAt (importSpecLoc imp_spec)
-                 (sep [ptext (sLit "Deprecated use of") <+> 
+                 (sep [ptext (sLit "In the use of") <+> 
                        pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
                        quotes (ppr name),
                      (parens imp_msg) <> colon,
@@ -1013,13 +1013,13 @@ finishDeprecations dflags mod_deprec tcg_env
            -- interface
 
 lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
-               -> GlobalRdrElt -> Maybe DeprecTxt
+               -> GlobalRdrElt -> Maybe WarningTxt
 -- The name is definitely imported, so look in HPT, PIT
 lookupImpDeprec dflags hpt pit gre
   = case lookupIfaceByModule dflags hpt pit (nameModule name) of
-       Just iface -> mi_dep_fn iface name `mplus`      -- Bleat if the thing, *or
+       Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
                      case gre_par gre of       
-                       ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd
+                       ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd
                        NoParent   -> Nothing
 
        Nothing -> Nothing      -- See Note [Used names with interface not loaded]
@@ -1038,7 +1038,7 @@ a) It might be a WiredInName; in that case we may not load
    its interface (although we could).
 
 b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
-   These are seen as "used" by the renamer (if -fno-implicit-prelude) 
+   These are seen as "used" by the renamer (if -XNoImplicitPrelude) 
    is on), but the typechecker may discard their uses 
    if in fact the in-scope fromRational is GHC.Read.fromRational,
    (see tcPat.tcOverloadedLit), and the typechecker sees that the type 
@@ -1176,7 +1176,7 @@ reportUnusedNames export_decls gbl_env
 
     direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])]
        -- See the type of the imp_mods for this triple
-    direct_import_mods = moduleEnvElts (imp_mods imports)
+    direct_import_mods = fmToList (imp_mods imports)
 
     -- unused_imp_mods are the directly-imported modules 
     -- that are not mentioned in minimal_imports1
@@ -1428,10 +1428,14 @@ nullModuleExport :: ModuleName -> SDoc
 nullModuleExport mod
   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
 
-moduleDeprec :: ModuleName -> DeprecTxt -> SDoc
-moduleDeprec mod txt
-  = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), 
-         nest 4 (ppr txt) ]      
+moduleWarn :: ModuleName -> WarningTxt -> SDoc
+moduleWarn mod (WarningTxt txt)
+  = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), 
+          nest 4 (ppr txt) ]
+moduleWarn mod (DeprecatedTxt txt)
+  = sep [ ptext (sLit "Module") <+> quotes (ppr mod)
+                                <+> ptext (sLit "is deprecated:"), 
+          nest 4 (ppr txt) ]
 
 implicitPreludeWarn :: SDoc
 implicitPreludeWarn