Add a WARNING pragma

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 9d5b481..f782da3 100644 (file)
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -19,7 +19,7 @@ module BasicTypes(
 
        Arity, 
        
 
        Arity, 
        

-       DeprecTxt,
+       WarningTxt(..),

 
        Fixity(..), FixityDirection(..),
        defaultFixity, maxPrecedence, 
 
        Fixity(..), FixityDirection(..),
        defaultFixity, maxPrecedence, 

@@ -95,7 +95,14 @@ initialVersion = 1
 
 
 \begin{code}
 
 
 \begin{code}

-type DeprecTxt = FastString    -- reason/explanation for deprecation
+-- reason/explanation from a WARNING or DEPRECATED pragma
+data WarningTxt = WarningTxt FastString
+                | DeprecatedTxt FastString
+    deriving Eq
+
+instance Outputable WarningTxt where
+    ppr (WarningTxt    w) =                        doubleQuotes (ftext w)
+    ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 742bcb3..80b0dcb 100644 (file)
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -64,7 +64,7 @@ deSugar hsc_env
                            tcg_fix_env      = fix_env,
                            tcg_inst_env     = inst_env,
                            tcg_fam_inst_env = fam_inst_env,
                            tcg_fix_env      = fix_env,
                            tcg_inst_env     = inst_env,
                            tcg_fam_inst_env = fam_inst_env,

-                           tcg_deprecs      = deprecs,
+                           tcg_warns      = warns,

                            tcg_binds        = binds,
                            tcg_fords        = fords,
                            tcg_rules        = rules,
                            tcg_binds        = binds,
                            tcg_fords        = fords,
                            tcg_rules        = rules,

@@ -129,7 +129,7 @@ deSugar hsc_env
                mg_dir_imps     = imp_mods imports,
                mg_rdr_env      = rdr_env,
                mg_fix_env      = fix_env,
                mg_dir_imps     = imp_mods imports,
                mg_rdr_env      = rdr_env,
                mg_fix_env      = fix_env,

-               mg_deprecs      = deprecs,
+               mg_warns        = warns,

                mg_types        = type_env,
                mg_insts        = insts,
                mg_fam_insts    = fam_insts,
                mg_types        = type_env,
                mg_insts        = insts,
                mg_fam_insts    = fam_insts,

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 9df546a..3a615f0 100644 (file)
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -27,7 +27,7 @@ module HsDecls (
        ConDecl(..), ResType(..), ConDeclField(..), LConDecl,   
        HsConDeclDetails, hsConDeclArgTys,
        DocDecl(..), LDocDecl, docDeclDoc,
        ConDecl(..), ResType(..), ConDeclField(..), LConDecl,   
        HsConDeclDetails, hsConDeclArgTys,
        DocDecl(..), LDocDecl, docDeclDoc,

-       DeprecDecl(..),  LDeprecDecl,
+       WarnDecl(..),  LWarnDecl,

        HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
        tcdName, tyClDeclNames, tyClDeclTyVars,
        isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
        HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
        tcdName, tyClDeclNames, tyClDeclTyVars,
        isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,

@@ -79,7 +79,7 @@ data HsDecl id
   | SigD       (Sig id)
   | DefD       (DefaultDecl id)
   | ForD        (ForeignDecl id)
   | SigD       (Sig id)
   | DefD       (DefaultDecl id)
   | ForD        (ForeignDecl id)

-  | DeprecD    (DeprecDecl id)
+  | WarningD   (WarnDecl id)

   | RuleD      (RuleDecl id)
   | SpliceD    (SpliceDecl id)
   | DocD       (DocDecl id)
   | RuleD      (RuleDecl id)
   | SpliceD    (SpliceDecl id)
   | DocD       (DocDecl id)

@@ -113,7 +113,7 @@ data HsGroup id
 
        hs_defds  :: [LDefaultDecl id],
        hs_fords  :: [LForeignDecl id],
 
        hs_defds  :: [LDefaultDecl id],
        hs_fords  :: [LForeignDecl id],

-       hs_depds  :: [LDeprecDecl id],
+       hs_warnds :: [LWarnDecl id],

        hs_ruleds :: [LRuleDecl id],
 
        hs_docs   :: [LDocDecl id]
        hs_ruleds :: [LRuleDecl id],
 
        hs_docs   :: [LDocDecl id]

@@ -125,7 +125,7 @@ emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 
 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
                       hs_fixds = [], hs_defds = [], hs_fords = [], 
 
 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
                       hs_fixds = [], hs_defds = [], hs_fords = [], 

-                      hs_depds = [], hs_ruleds = [],
+                      hs_warnds = [], hs_ruleds = [],

                       hs_valds = error "emptyGroup hs_valds: Can't happen",
                        hs_docs = [] }
 
                       hs_valds = error "emptyGroup hs_valds: Can't happen",
                        hs_docs = [] }
 

@@ -139,7 +139,7 @@ appendGroups
        hs_fixds  = fixds1, 
        hs_defds  = defds1,
        hs_fords  = fords1, 
        hs_fixds  = fixds1, 
        hs_defds  = defds1,
        hs_fords  = fords1, 

-       hs_depds  = depds1,
+       hs_warnds = warnds1,

        hs_ruleds = rulds1,
   hs_docs   = docs1 }
     HsGroup { 
        hs_ruleds = rulds1,
   hs_docs   = docs1 }
     HsGroup { 

@@ -150,7 +150,7 @@ appendGroups
        hs_fixds  = fixds2, 
        hs_defds  = defds2,
        hs_fords  = fords2, 
        hs_fixds  = fixds2, 
        hs_defds  = defds2,
        hs_fords  = fords2, 

-       hs_depds  = depds2,
+       hs_warnds = warnds2,

        hs_ruleds = rulds2,
   hs_docs   = docs2 }
   = 
        hs_ruleds = rulds2,
   hs_docs   = docs2 }
   = 

@@ -162,7 +162,7 @@ appendGroups
        hs_fixds  = fixds1 ++ fixds2, 
        hs_defds  = defds1 ++ defds2,
        hs_fords  = fords1 ++ fords2, 
        hs_fixds  = fixds1 ++ fixds2, 
        hs_defds  = defds1 ++ defds2,
        hs_fords  = fords1 ++ fords2, 

-       hs_depds  = depds1 ++ depds2,
+       hs_warnds = warnds1 ++ warnds2,

        hs_ruleds = rulds1 ++ rulds2,
   hs_docs   = docs1  ++ docs2 }
 \end{code}
        hs_ruleds = rulds1 ++ rulds2,
   hs_docs   = docs1  ++ docs2 }
 \end{code}

@@ -177,7 +177,7 @@ instance OutputableBndr name => Outputable (HsDecl name) where
     ppr (ForD fd)               = ppr fd
     ppr (SigD sd)               = ppr sd
     ppr (RuleD rd)              = ppr rd
     ppr (ForD fd)               = ppr fd
     ppr (SigD sd)               = ppr sd
     ppr (RuleD rd)              = ppr rd

-    ppr (DeprecD dd)            = ppr dd
+    ppr (WarningD wd)           = ppr wd

     ppr (SpliceD dd)            = ppr dd
     ppr (DocD doc)              = ppr doc
 
     ppr (SpliceD dd)            = ppr dd
     ppr (DocD doc)              = ppr doc
 

@@ -187,7 +187,7 @@ instance OutputableBndr name => Outputable (HsGroup name) where
                   hs_instds = inst_decls,
                    hs_derivds = deriv_decls,
                   hs_fixds  = fix_decls,
                   hs_instds = inst_decls,
                    hs_derivds = deriv_decls,
                   hs_fixds  = fix_decls,

-                  hs_depds  = deprec_decls,
+                  hs_warnds = deprec_decls,

                   hs_fords  = foreign_decls,
                   hs_defds  = default_decls,
                   hs_ruleds = rule_decls })
                   hs_fords  = foreign_decls,
                   hs_defds  = default_decls,
                   hs_ruleds = rule_decls })

@@ -994,11 +994,11 @@ docDeclDoc (DocGroup _ d) = d
 We use exported entities for things to deprecate.
 
 \begin{code}
 We use exported entities for things to deprecate.
 
 \begin{code}

-type LDeprecDecl name = Located (DeprecDecl name)
+type LWarnDecl name = Located (WarnDecl name)

 
 

-data DeprecDecl name = Deprecation name DeprecTxt
+data WarnDecl name = Warning name WarningTxt

 
 

-instance OutputableBndr name => Outputable (DeprecDecl name) where
-    ppr (Deprecation thing txt)
+instance OutputableBndr name => Outputable (WarnDecl name) where
+    ppr (Warning thing txt)

       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 \end{code}
       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 \end{code}

diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs
index 507eab6..6277f5c 100644 (file)
--- a/compiler/hsSyn/HsSyn.lhs
+++ b/compiler/hsSyn/HsSyn.lhs
@@ -35,7 +35,7 @@ import HsImpExp
 import HsLit
 import HsPat
 import HsTypes
 import HsLit
 import HsPat
 import HsTypes

-import BasicTypes      ( Fixity, DeprecTxt )
+import BasicTypes      ( Fixity, WarningTxt )

 import HsUtils
 import HsDoc
 
 import HsUtils
 import HsDoc
 

@@ -61,7 +61,7 @@ data HsModule name
                                -- info to TyDecls/etc; so this list is
                                -- often empty, downstream.
        [LHsDecl name]          -- Type, class, value, and interface signature decls
                                -- info to TyDecls/etc; so this list is
                                -- often empty, downstream.
        [LHsDecl name]          -- Type, class, value, and interface signature decls

-       (Maybe DeprecTxt)       -- reason/explanation for deprecation of this module
+       (Maybe WarningTxt)      -- reason/explanation for warning/deprecation of this module

        (HaddockModInfo name)   -- Haddock module info
        (Maybe (HsDoc name))    -- Haddock module description
 
        (HaddockModInfo name)   -- Haddock module info
        (Maybe (HsDoc name))    -- Haddock module description
 

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 75e0d64..a544b62 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -373,7 +373,7 @@ instance Binary ModIface where
                 mi_exports   = exports,
                 mi_exp_hash  = exp_hash,
                 mi_fixities  = fixities,
                 mi_exports   = exports,
                 mi_exp_hash  = exp_hash,
                 mi_fixities  = fixities,

-                mi_deprecs   = deprecs,
+                mi_warns     = warns,

                 mi_decls     = decls,
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,
                 mi_decls     = decls,
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,

@@ -392,7 +392,7 @@ instance Binary ModIface where
        put_ bh exports
        put_ bh exp_hash
        put_ bh fixities
        put_ bh exports
        put_ bh exp_hash
        put_ bh fixities

-       lazyPut bh deprecs
+       lazyPut bh warns

         put_ bh decls
        put_ bh insts
        put_ bh fam_insts
         put_ bh decls
        put_ bh insts
        put_ bh fam_insts

@@ -413,7 +413,7 @@ instance Binary ModIface where
        exports   <- {-# SCC "bin_exports" #-} get bh
        exp_hash  <- get bh
        fixities  <- {-# SCC "bin_fixities" #-} get bh
        exports   <- {-# SCC "bin_exports" #-} get bh
        exp_hash  <- get bh
        fixities  <- {-# SCC "bin_fixities" #-} get bh

-       deprecs   <- {-# SCC "bin_deprecs" #-} lazyGet bh
+       warns     <- {-# SCC "bin_warns" #-} lazyGet bh

         decls    <- {-# SCC "bin_tycldecls" #-} get bh
        insts     <- {-# SCC "bin_insts" #-} get bh
        fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
         decls    <- {-# SCC "bin_tycldecls" #-} get bh
        insts     <- {-# SCC "bin_insts" #-} get bh
        fam_insts <- {-# SCC "bin_fam_insts" #-} get bh

@@ -433,7 +433,7 @@ instance Binary ModIface where
                 mi_exports   = exports,
                 mi_exp_hash  = exp_hash,
                 mi_fixities  = fixities,
                 mi_exports   = exports,
                 mi_exp_hash  = exp_hash,
                 mi_fixities  = fixities,

-                mi_deprecs   = deprecs,
+                mi_warns     = warns,

                 mi_decls     = decls,
                 mi_globals   = Nothing,
                 mi_insts     = insts,
                 mi_decls     = decls,
                 mi_globals   = Nothing,
                 mi_insts     = insts,

@@ -443,7 +443,7 @@ instance Binary ModIface where
                  mi_vect_info = vect_info,
                 mi_hpc       = hpc_info,
                        -- And build the cached values
                  mi_vect_info = vect_info,
                 mi_hpc       = hpc_info,
                        -- And build the cached values

-                mi_dep_fn    = mkIfaceDepCache deprecs,
+                mi_warn_fn   = mkIfaceWarnCache warns,

                 mi_fix_fn    = mkIfaceFixCache fixities,
                 mi_hash_fn   = mkIfaceHashCache decls })
 
                 mi_fix_fn    = mkIfaceFixCache fixities,
                 mi_hash_fn   = mkIfaceHashCache decls })
 

@@ -515,23 +515,39 @@ instance Binary Usage where
             return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
                             usg_exports = exps, usg_entities = ents }
 
             return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
                             usg_exports = exps, usg_entities = ents }
 

-instance Binary Deprecations where
-    put_ bh NoDeprecs     = putByte bh 0
-    put_ bh (DeprecAll t) = do
-           putByte bh 1
-           put_ bh t
-    put_ bh (DeprecSome ts) = do
-           putByte bh 2
-           put_ bh ts
+instance Binary Warnings where
+    put_ bh NoWarnings     = putByte bh 0
+    put_ bh (WarnAll t) = do
+            putByte bh 1
+            put_ bh t
+    put_ bh (WarnSome ts) = do
+            putByte bh 2
+            put_ bh ts

 
     get bh = do
 
     get bh = do

-           h <- getByte bh
-           case h of
-             0 -> return NoDeprecs
-             1 -> do aa <- get bh
-                     return (DeprecAll aa)
-             _ -> do aa <- get bh
-                     return (DeprecSome aa)
+            h <- getByte bh
+            case h of
+              0 -> return NoWarnings
+              1 -> do aa <- get bh
+                      return (WarnAll aa)
+              _ -> do aa <- get bh
+                      return (WarnSome aa)
+
+instance Binary WarningTxt where
+    put_ bh (WarningTxt w) = do
+            putByte bh 0
+            put_ bh w
+    put_ bh (DeprecatedTxt d) = do
+            putByte bh 1
+            put_ bh d
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do w <- get bh
+                      return (WarningTxt w)
+              _ -> do d <- get bh
+                      return (DeprecatedTxt d)

 
 -------------------------------------------------------------------------
 --             Types from: BasicTypes
 
 -------------------------------------------------------------------------
 --             Types from: BasicTypes

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 3e42fd4..73b0222 100644 (file)
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -636,7 +636,7 @@ pprModIface iface
        , vcat (map ppr (mi_fam_insts iface))
        , vcat (map ppr (mi_rules iface))
         , pprVectInfo (mi_vect_info iface)
        , vcat (map ppr (mi_fam_insts iface))
        , vcat (map ppr (mi_rules iface))
         , pprVectInfo (mi_vect_info iface)

-       , pprDeprecs (mi_deprecs iface)
+       , ppr (mi_warns iface)

        ]
   where
     pp_boot | mi_boot iface = ptext (sLit "[boot]")
        ]
   where
     pp_boot | mi_boot iface = ptext (sLit "[boot]")

@@ -709,12 +709,15 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
   ]
 
   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
   ]
 

-pprDeprecs :: Deprecations -> SDoc
-pprDeprecs NoDeprecs       = empty
-pprDeprecs (DeprecAll txt)  = ptext (sLit "Deprecate all") <+> doubleQuotes (ftext txt)
-pprDeprecs (DeprecSome prs) = ptext (sLit "Deprecate") <+> vcat (map pprDeprec prs)
-                           where
-                             pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
+instance Outputable Warnings where
+    ppr = pprWarns
+
+pprWarns :: Warnings -> SDoc
+pprWarns NoWarnings        = empty
+pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
+pprWarns (WarnSome prs) = ptext (sLit "Warnings")
+                        <+> vcat (map pprWarning prs)
+    where pprWarning (name, txt) = ppr name <+> ppr txt

 \end{code}
 
 
 \end{code}
 
 

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 79c09a8..f7f7348 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -126,11 +126,11 @@ mkIface hsc_env maybe_old_fingerprint mod_details
                       mg_dir_imps  = dir_imp_mods,
                      mg_rdr_env   = rdr_env,
                      mg_fix_env   = fix_env,
                       mg_dir_imps  = dir_imp_mods,
                      mg_rdr_env   = rdr_env,
                      mg_fix_env   = fix_env,

-                     mg_deprecs   = deprecs,
+                     mg_warns   = warns,

                      mg_hpc_info  = hpc_info }
         = mkIface_ hsc_env maybe_old_fingerprint
                    this_mod is_boot used_names deps rdr_env 
                      mg_hpc_info  = hpc_info }
         = mkIface_ hsc_env maybe_old_fingerprint
                    this_mod is_boot used_names deps rdr_env 

-                   fix_env deprecs hpc_info dir_imp_mods mod_details
+                   fix_env warns hpc_info dir_imp_mods mod_details

        
 -- | make an interface from the results of typechecking only.  Useful
 -- for non-optimising compilation, or where we aren't generating any
        
 -- | make an interface from the results of typechecking only.  Useful
 -- for non-optimising compilation, or where we aren't generating any

@@ -147,7 +147,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details
                       tcg_imports = imports,
                       tcg_rdr_env = rdr_env,
                       tcg_fix_env = fix_env,
                       tcg_imports = imports,
                       tcg_rdr_env = rdr_env,
                       tcg_fix_env = fix_env,

-                      tcg_deprecs = deprecs,
+                      tcg_warns = warns,

                       tcg_hpc = other_hpc_info
                     }
   = do
                       tcg_hpc = other_hpc_info
                     }
   = do

@@ -156,7 +156,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details
           let hpc_info = emptyHpcInfo other_hpc_info
           mkIface_ hsc_env maybe_old_fingerprint
                    this_mod (isHsBoot hsc_src) used_names deps rdr_env 
           let hpc_info = emptyHpcInfo other_hpc_info
           mkIface_ hsc_env maybe_old_fingerprint
                    this_mod (isHsBoot hsc_src) used_names deps rdr_env 

-                   fix_env deprecs hpc_info (imp_mods imports) mod_details
+                   fix_env warns hpc_info (imp_mods imports) mod_details

         
 
 mkUsedNames :: TcGblEnv -> IO NameSet
         
 
 mkUsedNames :: TcGblEnv -> IO NameSet

@@ -208,12 +208,12 @@ mkDependencies
 
 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
          -> NameSet -> Dependencies -> GlobalRdrEnv
 
 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
          -> NameSet -> Dependencies -> GlobalRdrEnv

-         -> NameEnv FixItem -> Deprecations -> HpcInfo
+         -> NameEnv FixItem -> Warnings -> HpcInfo

          -> ImportedMods
          -> ModDetails
          -> IO (ModIface, Bool)
 mkIface_ hsc_env maybe_old_fingerprint 
          -> ImportedMods
          -> ModDetails
          -> IO (ModIface, Bool)
 mkIface_ hsc_env maybe_old_fingerprint 

-         this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
+         this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info

          dir_imp_mods
         ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,
          dir_imp_mods
         ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,

@@ -240,7 +240,7 @@ mkIface_ hsc_env maybe_old_fingerprint
                                -- Sigh: see Note [Root-main Id] in TcRnDriver
 
                ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
                                -- Sigh: see Note [Root-main Id] in TcRnDriver
 
                ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]

-               ; deprecs     = src_deprecs
+               ; warns     = src_warns

                ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
                ; iface_insts = map instanceToIfaceInst insts
                ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
                ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
                ; iface_insts = map instanceToIfaceInst insts
                ; iface_fam_insts = map famInstToIfaceFamInst fam_insts

@@ -262,7 +262,7 @@ mkIface_ hsc_env maybe_old_fingerprint
                         mi_vect_info = iface_vect_info,
 
                        mi_fixities = fixities,
                         mi_vect_info = iface_vect_info,
 
                        mi_fixities = fixities,

-                       mi_deprecs  = deprecs,
+                       mi_warns  = warns,

                        mi_globals  = Just rdr_env,
 
                        -- Left out deliberately: filled in by addVersionInfo
                        mi_globals  = Just rdr_env,
 
                        -- Left out deliberately: filled in by addVersionInfo

@@ -278,7 +278,7 @@ mkIface_ hsc_env maybe_old_fingerprint
                        mi_hpc       = isHpcUsed hpc_info,
 
                        -- And build the cached values
                        mi_hpc       = isHpcUsed hpc_info,
 
                        -- And build the cached values

-                       mi_dep_fn = mkIfaceDepCache deprecs,
+                       mi_warn_fn = mkIfaceWarnCache warns,

                        mi_fix_fn = mkIfaceFixCache fixities }
                }
 
                        mi_fix_fn = mkIfaceFixCache fixities }
                }
 

@@ -522,7 +522,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                       (map fst sorted_decls,
                        export_hash,
                        orphan_hash,
                       (map fst sorted_decls,
                        export_hash,
                        orphan_hash,

-                       mi_deprecs iface0)
+                       mi_warns iface0)

 
    -- The interface hash depends on:
    --    - the ABI hash, plus
 
    -- The interface hash depends on:
    --    - the ABI hash, plus

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 18c5f89..ad327bd 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -169,7 +169,7 @@ data DynFlag
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches

-   | Opt_WarnDeprecations
+   | Opt_WarnWarningsDeprecations

    | Opt_WarnDeprecatedFlags
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnDeprecatedFlags
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans

@@ -756,7 +756,7 @@ optLevelFlags
 
 standardWarnings :: [DynFlag]
 standardWarnings
 
 standardWarnings :: [DynFlag]
 standardWarnings

-    = [ Opt_WarnDeprecations,
+    = [ Opt_WarnWarningsDeprecations,

         Opt_WarnDeprecatedFlags,
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnDeprecatedFlags,
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,

@@ -1407,7 +1407,7 @@ fFlags = [
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),

-  ( "warn-deprecations",                Opt_WarnDeprecations, const Supported ),
+  ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, const Supported ),

   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 37e9047..87d07de 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -994,7 +994,7 @@ mkModGuts coreModule = ModGuts {
   mg_rules = [],
   mg_binds = cm_binds coreModule,
   mg_foreign = NoStubs,
   mg_rules = [],
   mg_binds = cm_binds coreModule,
   mg_foreign = NoStubs,

-  mg_deprecs = NoDeprecs,
+  mg_warns = NoWarnings,

   mg_hpc_info = emptyHpcInfo False,
   mg_modBreaks = emptyModBreaks,
   mg_vect_info = noVectInfo,
   mg_hpc_info = emptyHpcInfo False,
   mg_modBreaks = emptyModBreaks,
   mg_vect_info = noVectInfo,

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 244b312..d5b6231 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -32,8 +32,8 @@ module HscTypes (
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
         substInteractiveContext,
 
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
         substInteractiveContext,
 

-       ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache,
-       emptyIfaceDepCache,
+       ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
+       emptyIfaceWarnCache,

 
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 
 
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 

@@ -52,7 +52,7 @@ module HscTypes (
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        IfaceExport,
 
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        IfaceExport,
 

-       Deprecations(..), DeprecTxt, plusDeprecs,
+       Warnings(..), WarningTxt(..), plusWarns,

 
        PackageInstEnv, PackageRuleBase,
 
 
        PackageInstEnv, PackageRuleBase,
 

@@ -101,7 +101,7 @@ import PrelNames    ( gHC_PRIM )
 import Packages hiding ( Version(..) )
 import DynFlags                ( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )
 import Packages hiding ( Version(..) )
 import DynFlags                ( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )

-import BasicTypes      ( IPName, Fixity, defaultFixity, DeprecTxt )
+import BasicTypes      ( IPName, Fixity, defaultFixity, WarningTxt(..) )

 import OptimizationFuel        ( OptFuelState )
 import IfaceSyn
 import FiniteMap       ( FiniteMap )
 import OptimizationFuel        ( OptFuelState )
 import IfaceSyn
 import FiniteMap       ( FiniteMap )

@@ -445,8 +445,8 @@ data ModIface
         mi_fixities :: [(OccName,Fixity)],
                -- NOT STRICT!  we read this field lazily from the interface file
 
         mi_fixities :: [(OccName,Fixity)],
                -- NOT STRICT!  we read this field lazily from the interface file
 

-               -- Deprecations
-       mi_deprecs  :: Deprecations,
+               -- Warnings
+       mi_warns  :: Warnings,

                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations

@@ -485,7 +485,7 @@ data ModIface
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
                -- and are not put into the interface file
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
                -- and are not put into the interface file

-       mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
+       mi_warn_fn  :: Name -> Maybe WarningTxt,        -- Cached lookup for mi_warns

        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities
        mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
                         -- Cached lookup for mi_decls
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities
        mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
                         -- Cached lookup for mi_decls

@@ -546,7 +546,7 @@ data ModGuts
         mg_rules     :: ![CoreRule],    -- Rules from this module
        mg_binds     :: ![CoreBind],     -- Bindings for this module
        mg_foreign   :: !ForeignStubs,
         mg_rules     :: ![CoreRule],    -- Rules from this module
        mg_binds     :: ![CoreBind],     -- Bindings for this module
        mg_foreign   :: !ForeignStubs,

-       mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
+       mg_warns     :: !Warnings,       -- Warnings declared in the module

        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,
         mg_vect_info :: !VectInfo,        -- Pool of vectorised declarations
        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,
         mg_vect_info :: !VectInfo,        -- Pool of vectorised declarations

@@ -656,7 +656,7 @@ emptyModIface mod
               mi_exports  = [],
               mi_exp_hash = fingerprint0,
               mi_fixities = [],
               mi_exports  = [],
               mi_exp_hash = fingerprint0,
               mi_fixities = [],

-              mi_deprecs  = NoDeprecs,
+              mi_warns    = NoWarnings,

               mi_insts     = [],
               mi_fam_insts = [],
               mi_rules     = [],
               mi_insts     = [],
               mi_fam_insts = [],
               mi_rules     = [],

@@ -664,7 +664,7 @@ emptyModIface mod
               mi_globals   = Nothing,
               mi_orphan_hash = fingerprint0,
                mi_vect_info = noIfaceVectInfo,
               mi_globals   = Nothing,
               mi_orphan_hash = fingerprint0,
                mi_vect_info = noIfaceVectInfo,

-              mi_dep_fn    = emptyIfaceDepCache,
+              mi_warn_fn    = emptyIfaceWarnCache,

               mi_fix_fn    = emptyIfaceFixCache,
               mi_hash_fn   = emptyIfaceHashCache,
               mi_hpc       = False
               mi_fix_fn    = emptyIfaceFixCache,
               mi_hash_fn   = emptyIfaceHashCache,
               mi_hpc       = False

@@ -1004,11 +1004,11 @@ These types are defined here because they are mentioned in ModDetails,
 but they are mostly elaborated elsewhere
 
 \begin{code}
 but they are mostly elaborated elsewhere
 
 \begin{code}

------------------- Deprecations -------------------------
-data Deprecations
-  = NoDeprecs
-  | DeprecAll DeprecTxt                -- Whole module deprecated
-  | DeprecSome [(OccName,DeprecTxt)] -- Some specific things deprecated
+------------------ Warnings -------------------------
+data Warnings
+  = NoWarnings
+  | WarnAll WarningTxt         -- Whole module deprecated
+  | WarnSome [(OccName,WarningTxt)] -- Some specific things deprecated

      -- Only an OccName is needed because
      --    (1) a deprecation always applies to a binding
      --        defined in the module in which the deprecation appears.
      -- Only an OccName is needed because
      --    (1) a deprecation always applies to a binding
      --        defined in the module in which the deprecation appears.

@@ -1031,20 +1031,20 @@ data Deprecations
      --        a Name to its fixity declaration.
   deriving( Eq )
 
      --        a Name to its fixity declaration.
   deriving( Eq )
 

-mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt
-mkIfaceDepCache NoDeprecs        = \_ -> Nothing
-mkIfaceDepCache (DeprecAll t)    = \_ -> Just t
-mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
+mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt
+mkIfaceWarnCache NoWarnings  = \_ -> Nothing
+mkIfaceWarnCache (WarnAll t) = \_ -> Just t
+mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName

 
 

-emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache _ = Nothing
+emptyIfaceWarnCache :: Name -> Maybe WarningTxt
+emptyIfaceWarnCache _ = Nothing

 
 

-plusDeprecs :: Deprecations -> Deprecations -> Deprecations
-plusDeprecs d NoDeprecs = d
-plusDeprecs NoDeprecs d = d
-plusDeprecs _ (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) _ = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2)
+plusWarns :: Warnings -> Warnings -> Warnings
+plusWarns d NoWarnings = d
+plusWarns NoWarnings d = d
+plusWarns _ (WarnAll t) = WarnAll t
+plusWarns (WarnAll t) _ = WarnAll t
+plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)

 \end{code}
 
 
 \end{code}
 
 

@@ -1230,7 +1230,7 @@ data ExternalPackageState
                --      * Fingerprint info
                --      * Its exports
                --      * Fixities
                --      * Fingerprint info
                --      * Its exports
                --      * Fixities

-               --      * Deprecations
+               --      * Warnings

 
        eps_PTE :: !PackageTypeEnv,        -- Domain = external-package modules
 
 
        eps_PTE :: !PackageTypeEnv,        -- Domain = external-package modules
 

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 525d50b..b3cab49 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -248,6 +248,8 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
        $whitechar* (NO(T?)INLINE|no(t?)inline)
                                        { token (ITspec_inline_prag False) }
   "{-#" $whitechar* (SOURCE|source)    { token ITsource_prag }
        $whitechar* (NO(T?)INLINE|no(t?)inline)
                                        { token (ITspec_inline_prag False) }
   "{-#" $whitechar* (SOURCE|source)    { token ITsource_prag }

+  "{-#" $whitechar* (WARNING|warning)
+                                       { token ITwarning_prag }

   "{-#" $whitechar* (DEPRECATED|deprecated)
                                        { token ITdeprecated_prag }
   "{-#" $whitechar* (SCC|scc)          { token ITscc_prag }
   "{-#" $whitechar* (DEPRECATED|deprecated)
                                        { token ITdeprecated_prag }
   "{-#" $whitechar* (SCC|scc)          { token ITscc_prag }

@@ -466,6 +468,7 @@ data Token
   | ITspec_inline_prag Bool    -- SPECIALISE INLINE (or NOINLINE)
   | ITsource_prag
   | ITrules_prag
   | ITspec_inline_prag Bool    -- SPECIALISE INLINE (or NOINLINE)
   | ITsource_prag
   | ITrules_prag

+  | ITwarning_prag

   | ITdeprecated_prag
   | ITline_prag
   | ITscc_prag
   | ITdeprecated_prag
   | ITline_prag
   | ITscc_prag

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 4552fe2..86ce98c 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -28,7 +28,7 @@ module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
 
 import HsSyn
 import RdrHsSyn
 
 import HsSyn
 import RdrHsSyn

-import HscTypes                ( IsBootInterface, DeprecTxt )
+import HscTypes                ( IsBootInterface, WarningTxt(..) )

 import Lexer
 import RdrName
 import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
 import Lexer
 import RdrName
 import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,

@@ -262,6 +262,7 @@ incorrect.
  '{-# SCC'        { L _ ITscc_prag }
  '{-# GENERATED'   { L _ ITgenerated_prag }
  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
  '{-# SCC'        { L _ ITscc_prag }
  '{-# GENERATED'   { L _ ITgenerated_prag }
  '{-# DEPRECATED'  { L _ ITdeprecated_prag }

+ '{-# WARNING'  { L _ ITwarning_prag }

  '{-# UNPACK'      { L _ ITunpack_prag }
  '#-}'            { L _ ITclose_prag }
 
  '{-# UNPACK'      { L _ ITunpack_prag }
  '#-}'            { L _ ITclose_prag }
 

@@ -375,7 +376,7 @@ identifier :: { Located RdrName }
 -- know what they are doing. :-)
 
 module         :: { Located (HsModule RdrName) }
 -- know what they are doing. :-)
 
 module         :: { Located (HsModule RdrName) }

-       : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body
+       : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body

                {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
                   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
                           info doc) )}}
                {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
                   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
                           info doc) )}}

@@ -392,9 +393,10 @@ maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
 missing_module_keyword :: { () }
        : {- empty -}                           {% pushCurrentContext }
 
 missing_module_keyword :: { () }
        : {- empty -}                           {% pushCurrentContext }
 

-maybemoddeprec :: { Maybe DeprecTxt }
-       : '{-# DEPRECATED' STRING '#-}'         { Just (getSTRING $2) }
-       |  {- empty -}                          { Nothing }
+maybemodwarning :: { Maybe WarningTxt }
+    : '{-# DEPRECATED' STRING '#-}' { Just (DeprecatedTxt (getSTRING $2)) }
+    | '{-# WARNING' STRING '#-}'    { Just (WarningTxt (getSTRING $2)) }
+    |  {- empty -}                  { Nothing }

 
 body   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{'            top '}'               { $2 }
 
 body   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
        :  '{'            top '}'               { $2 }

@@ -416,7 +418,7 @@ cvtopdecls :: { [LHsDecl RdrName] }
 -- Module declaration & imports only
 
 header         :: { Located (HsModule RdrName) }
 -- Module declaration & imports only
 
 header         :: { Located (HsModule RdrName) }

-       : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body
+       : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body

                {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
                   return (L loc (HsModule (Just $3) $5 $7 [] $4
                    info doc))}}
                {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
                   return (L loc (HsModule (Just $3) $5 $7 [] $4
                    info doc))}}

@@ -550,7 +552,8 @@ topdecl :: { OrdList (LHsDecl RdrName) }
         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }

-       | '{-# DEPRECATED' deprecations '#-}'   { $2 }
+    | '{-# DEPRECATED' deprecations '#-}' { $2 }
+    | '{-# WARNING' warnings '#-}'        { $2 }

        | '{-# RULES' rules '#-}'               { $2 }
        | decl                                  { unLoc $1 }
 
        | '{-# RULES' rules '#-}'               { $2 }
        | decl                                  { unLoc $1 }
 

@@ -891,7 +894,19 @@ rule_var :: { RuleBndr RdrName }
                | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 
 -----------------------------------------------------------------------------
                | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 
 -----------------------------------------------------------------------------

--- Deprecations (c.f. rules)
+-- Warnings and deprecations (c.f. rules)
+
+warnings :: { OrdList (LHsDecl RdrName) }
+       : warnings ';' warning          { $1 `appOL` $3 }
+       | warnings ';'                  { $1 }
+       | warning                               { $1 }
+       | {- empty -}                           { nilOL }
+
+-- SUP: TEMPORARY HACK, not checking for `module Foo'
+warning :: { OrdList (LHsDecl RdrName) }
+       : namelist STRING
+               { toOL [ LL $ WarningD (Warning n (WarningTxt (getSTRING $2)))
+                      | n <- unLoc $1 ] }

 
 deprecations :: { OrdList (LHsDecl RdrName) }
        : deprecations ';' deprecation          { $1 `appOL` $3 }
 
 deprecations :: { OrdList (LHsDecl RdrName) }
        : deprecations ';' deprecation          { $1 `appOL` $3 }

@@ -901,8 +916,8 @@ deprecations :: { OrdList (LHsDecl RdrName) }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 deprecation :: { OrdList (LHsDecl RdrName) }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 deprecation :: { OrdList (LHsDecl RdrName) }

-       : depreclist STRING
-               { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2)) 
+       : namelist STRING
+               { toOL [ LL $ WarningD (Warning n (DeprecatedTxt (getSTRING $2)))

                       | n <- unLoc $1 ] }
 
 
                       | n <- unLoc $1 ] }
 
 

@@ -1316,7 +1331,7 @@ exp10 :: { LHsExpr RdrName }
        | fexp                                  { $1 }
 
 scc_annot :: { Located FastString }
        | fexp                                  { $1 }
 
 scc_annot :: { Located FastString }

-       : '_scc_' STRING                        {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
+       : '_scc_' STRING                        {% (addWarning Opt_WarnWarningsDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->

                                    ( do scc <- getSCC $2; return $ LL scc ) }
        | '{-# SCC' STRING '#-}'                {% do scc <- getSCC $2; return $ LL scc }
 
                                    ( do scc <- getSCC $2; return $ LL scc ) }
        | '{-# SCC' STRING '#-}'                {% do scc <- getSCC $2; return $ LL scc }
 

@@ -1648,15 +1663,15 @@ ipvar   :: { Located (IPName RdrName) }
        : IPDUPVARID            { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
 
 -----------------------------------------------------------------------------
        : IPDUPVARID            { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
 
 -----------------------------------------------------------------------------

--- Deprecations
+-- Warnings and deprecations

 
 

-depreclist :: { Located [RdrName] }
-depreclist : deprec_var                        { L1 [unLoc $1] }
-          | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
+namelist :: { Located [RdrName] }
+namelist : name_var              { L1 [unLoc $1] }
+         | name_var ',' namelist { LL (unLoc $1 : unLoc $3) }

 
 

-deprec_var :: { Located RdrName }
-deprec_var : var                       { $1 }
-          | con                        { $1 }
+name_var :: { Located RdrName }
+name_var : var { $1 }
+         | con { $1 }

 
 -----------------------------------------
 -- Data constructors
 
 -----------------------------------------
 -- Data constructors

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index aeb80a2..7b9dc14 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -347,8 +347,8 @@ add gp@(HsGroup {hs_defds  = ts})  l (DefD d) ds
   = addl (gp { hs_defds = L l d : ts }) ds
 add gp@(HsGroup {hs_fords  = ts}) l (ForD d) ds
   = addl (gp { hs_fords = L l d : ts }) ds
   = addl (gp { hs_defds = L l d : ts }) ds
 add gp@(HsGroup {hs_fords  = ts}) l (ForD d) ds
   = addl (gp { hs_fords = L l d : ts }) ds

-add gp@(HsGroup {hs_depds  = ts})  l (DeprecD d) ds
-  = addl (gp { hs_depds = L l d : ts }) ds
+add gp@(HsGroup {hs_warnds  = ts})  l (WarningD d) ds
+  = addl (gp { hs_warnds = L l d : ts }) ds

 add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD d) ds
   = addl (gp { hs_ruleds = L l d : ts }) ds
 
 add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD d) ds
   = addl (gp { hs_ruleds = L l d : ts }) ds
 

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index e79bfba..7aad117 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -7,7 +7,7 @@
 module RnNames (
        rnImports, getLocalNonValBinders,
        rnExports, extendGlobalRdrEnvRn,
 module RnNames (
        rnImports, getLocalNonValBinders,
        rnExports, extendGlobalRdrEnvRn,

-       reportUnusedNames, finishDeprecations,
+       reportUnusedNames, finishWarnings,

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -33,7 +33,7 @@ import Maybes
 import SrcLoc
 import FiniteMap
 import ErrUtils
 import SrcLoc
 import FiniteMap
 import ErrUtils

-import BasicTypes      ( DeprecTxt )
+import BasicTypes      ( WarningTxt(..) )

 import DriverPhases    ( isHsBoot )
 import Util
 import FastString
 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
 
     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
        orph_iface = mi_orphan iface 
        has_finsts = mi_finsts iface 
        deps       = mi_deps iface

@@ -233,10 +233,10 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
                    }
 
        -- Complain if we import a deprecated module
                    }
 
        -- 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
      )
 
     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot

@@ -966,23 +966,23 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \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
   = 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
 
          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
   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)
       | 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,
                        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 
            -- 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
 -- 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       
                      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]
                        NoParent   -> Nothing
 
        Nothing -> Nothing      -- See Note [Used names with interface not loaded]

@@ -1428,10 +1428,14 @@ nullModuleExport :: ModuleName -> SDoc
 nullModuleExport mod
   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
 
 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
 
 implicitPreludeWarn :: SDoc
 implicitPreludeWarn

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index b64782d..6210a17 100644 (file)
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -34,7 +34,7 @@ import HscTypes       ( GenAvailInfo(..) )
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 

-import HscTypes                ( Deprecations(..), plusDeprecs )
+import HscTypes                ( Warnings(..), plusWarns )

 import Class           ( FunDep )
 import Name            ( Name, nameOccName )
 import NameSet
 import Class           ( FunDep )
 import Name            ( Name, nameOccName )
 import NameSet

@@ -104,7 +104,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
                                    hs_instds = inst_decls,
                                    hs_derivds = deriv_decls,
                                    hs_fixds  = fix_decls,
                                    hs_instds = inst_decls,
                                    hs_derivds = deriv_decls,
                                    hs_fixds  = fix_decls,

-                                   hs_depds  = deprec_decls,
+                                   hs_warnds  = warn_decls,

                                    hs_fords  = foreign_decls,
                                    hs_defds  = default_decls,
                                    hs_ruleds = rule_decls,
                                    hs_fords  = foreign_decls,
                                    hs_defds  = default_decls,
                                    hs_ruleds = rule_decls,

@@ -169,7 +169,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
    -- rename deprec decls;
    -- check for duplicates and ensure that deprecated things are defined locally
    -- at the moment, we don't keep these around past renaming
    -- rename deprec decls;
    -- check for duplicates and ensure that deprecated things are defined locally
    -- at the moment, we don't keep these around past renaming

-   rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
+   rn_warns <- rnSrcWarnDecls warn_decls ;

 
    -- (H) Rename Everything else
 
 
    -- (H) Rename Everything else
 

@@ -187,7 +187,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
                             hs_instds = rn_inst_decls,
                              hs_derivds = rn_deriv_decls,
                             hs_fixds  = rn_fix_decls,
                             hs_instds = rn_inst_decls,
                              hs_derivds = rn_deriv_decls,
                             hs_fixds  = rn_fix_decls,

-                            hs_depds  = [], -- deprecs are returned in the tcg_env
+                            hs_warnds = [], -- warns are returned in the tcg_env

                                             -- (see below) not in the HsGroup
                             hs_fords  = rn_foreign_decls,
                             hs_defds  = rn_default_decls,
                                             -- (see below) not in the HsGroup
                             hs_fords  = rn_foreign_decls,
                             hs_defds  = rn_default_decls,

@@ -204,7 +204,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
 
        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
                        in -- we return the deprecs in the env, not in the HsGroup above
 
        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
                        in -- we return the deprecs in the env, not in the HsGroup above

-                         tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
+                         tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };

        } ;
 
    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
        } ;
 
    traceRn (text "finish rnSrc" <+> ppr rn_group) ;

@@ -300,17 +300,17 @@ gather them together.
 
 \begin{code}
 -- checks that the deprecations are defined locally, and that there are no duplicates
 
 \begin{code}
 -- checks that the deprecations are defined locally, and that there are no duplicates

-rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
-rnSrcDeprecDecls [] 
-  = returnM NoDeprecs
+rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings
+rnSrcWarnDecls [] 
+  = returnM NoWarnings

 
 

-rnSrcDeprecDecls decls 
+rnSrcWarnDecls decls 

   = do { -- check for duplicates
   = do { -- check for duplicates

-       ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
+       ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups

        ; mappM (addLocM rn_deprec) decls       `thenM` \ pairs_s ->
        ; mappM (addLocM rn_deprec) decls       `thenM` \ pairs_s ->

-         returnM (DeprecSome ((concat pairs_s))) }
+         returnM (WarnSome ((concat pairs_s))) }

  where
  where

-   rn_deprec (Deprecation rdr_name txt)
+   rn_deprec (Warning rdr_name txt)

        -- ensures that the names are defined locally
      = lookupLocalDataTcNames rdr_name `thenM` \ names ->
        returnM [(nameOccName name, txt) | name <- names]
        -- ensures that the names are defined locally
      = lookupLocalDataTcNames rdr_name `thenM` \ names ->
        returnM [(nameOccName name, txt) | name <- names]

@@ -318,13 +318,13 @@ rnSrcDeprecDecls decls
    -- look for duplicates among the OccNames;
    -- we check that the names are defined above
    -- invt: the lists returned by findDupsEq always have at least two elements
    -- look for duplicates among the OccNames;
    -- we check that the names are defined above
    -- invt: the lists returned by findDupsEq always have at least two elements

-   deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
-                     (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
+   warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
+                     (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)

                
                

-dupDeprecDecl :: Located RdrName -> RdrName -> SDoc
+dupWarnDecl :: Located RdrName -> RdrName -> SDoc

 -- Located RdrName -> DeprecDecl RdrName -> SDoc
 -- Located RdrName -> DeprecDecl RdrName -> SDoc

-dupDeprecDecl (L loc _) rdr_name
-  = vcat [ptext (sLit "Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
+dupWarnDecl (L loc _) rdr_name
+  = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),

           ptext (sLit "also at ") <+> ppr loc]
 
 \end{code}
           ptext (sLit "also at ") <+> ppr loc]
 
 \end{code}

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 88695bc..bd76303 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -168,9 +168,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                -- thing (especially via 'module Foo' export item)
                -- That is, only uses in the *body* of the module are complained about
        traceRn (text "rn3") ;
                -- thing (especially via 'module Foo' export item)
                -- That is, only uses in the *body* of the module are complained about
        traceRn (text "rn3") ;

-       failIfErrsM ;   -- finishDeprecations crashes sometimes 
+       failIfErrsM ;   -- finishWarnings crashes sometimes 

                        -- as a result of typechecker repairs (e.g. unboundNames)
                        -- as a result of typechecker repairs (e.g. unboundNames)

-       tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
+       tcg_env <- finishWarnings (hsc_dflags hsc_env) mod_deprec tcg_env ;

 
                -- Process the export list
         traceRn (text "rn4a: before exports");
 
                -- Process the export list
         traceRn (text "rn4a: before exports");

@@ -338,7 +338,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                -- Stubs
                                mg_rdr_env   = emptyGlobalRdrEnv,
                                mg_fix_env   = emptyFixityEnv,
                                -- Stubs
                                mg_rdr_env   = emptyGlobalRdrEnv,
                                mg_fix_env   = emptyFixityEnv,

-                               mg_deprecs   = NoDeprecs,
+                               mg_warns     = NoWarnings,

                                mg_foreign   = NoStubs,
                                mg_hpc_info  = emptyHpcInfo False,
                                 mg_modBreaks = emptyModBreaks,
                                mg_foreign   = NoStubs,
                                mg_hpc_info  = emptyHpcInfo False,
                                 mg_modBreaks = emptyModBreaks,

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 7f1a7fe..abdb44e 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -103,7 +103,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
                tcg_rn_decls   = maybe_rn_syntax emptyRnGroup,
 
                tcg_binds    = emptyLHsBinds,
                tcg_rn_decls   = maybe_rn_syntax emptyRnGroup,
 
                tcg_binds    = emptyLHsBinds,

-               tcg_deprecs  = NoDeprecs,
+               tcg_warns  = NoWarnings,

                tcg_insts    = [],
                tcg_fam_insts= [],
                tcg_rules    = [],
                tcg_insts    = [],
                tcg_fam_insts= [],
                tcg_rules    = [],

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 20262c9..e70161c 100644 (file)
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -219,7 +219,7 @@ data TcGblEnv
                -- Nothing <=> Don't retain renamed decls
 
        tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
                -- Nothing <=> Don't retain renamed decls
 
        tcg_binds     :: LHsBinds Id,       -- Value bindings in this module

-       tcg_deprecs   :: Deprecations,      -- ...Deprecations 
+       tcg_warns     :: Warnings,          -- ...Warnings and deprecations

        tcg_insts     :: [Instance],        -- ...Instances
        tcg_fam_insts :: [FamInst],         -- ...Family instances
        tcg_rules     :: [LRuleDecl Id],    -- ...Rules
        tcg_insts     :: [Instance],        -- ...Instances
        tcg_fam_insts :: [FamInst],         -- ...Family instances
        tcg_rules     :: [LRuleDecl Id],    -- ...Rules

diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 8da67f8..f13d34c 100644 (file)
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1005,10 +1005,10 @@
          </row>
 
          <row>
          </row>
 
          <row>

-           <entry><option>-fwarn-deprecations</option></entry>
-           <entry>warn about uses of functions &amp; types that are deprecated</entry>
+           <entry><option>-fwarn-warnings-deprecations</option></entry>
+           <entry>warn about uses of functions &amp; types that have warnings or deprecated pragmas</entry>

            <entry>dynamic</entry>
            <entry>dynamic</entry>

-           <entry><option>-fno-warn-deprecations</option></entry>
+           <entry><option>-fno-warn-warnings-deprecations</option></entry>

          </row>
 
          <row>
          </row>
 
          <row>

diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index a100e43..0f55b9b 100644 (file)
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -6162,56 +6162,63 @@ Assertion failures can be caught, see the documentation for the
        don't recommend using this approach with GHC.</para>
     </sect2>
 
        don't recommend using this approach with GHC.</para>
     </sect2>
 

-    <sect2 id="deprecated-pragma">
-      <title>DEPRECATED pragma</title>
-      <indexterm><primary>DEPRECATED</primary>
-      </indexterm>
+    <sect2 id="warning-deprecated-pragma">
+      <title>WARNING and DEPRECATED pragmas</title>
+      <indexterm><primary>WARNING</primary></indexterm>
+      <indexterm><primary>DEPRECATED</primary></indexterm>

 
 

-      <para>The DEPRECATED pragma lets you specify that a particular
-      function, class, or type, is deprecated.  There are two
-      forms.
+      <para>The WARNING pragma allows you to attach an arbitrary warning
+      to a particular function, class, or type.
+      A DEPRECATED pragma lets you specify that
+      a particular function, class, or type is deprecated.
+      There are two ways of using these pragmas.

 
       <itemizedlist>
        <listitem>
 
       <itemizedlist>
        <listitem>

-         <para>You can deprecate an entire module thus:</para>
+         <para>You can work on an entire module thus:</para>

 <programlisting>
    module Wibble {-# DEPRECATED "Use Wobble instead" #-} where
      ...
 </programlisting>
 <programlisting>
    module Wibble {-# DEPRECATED "Use Wobble instead" #-} where
      ...
 </programlisting>

+      <para>Or:</para>
+<programlisting>
+   module Wibble {-# WARNING "This is an unstable interface." #-} where
+     ...
+</programlisting>

          <para>When you compile any module that import
           <literal>Wibble</literal>, GHC will print the specified
           message.</para>
        </listitem>
 
        <listitem>
          <para>When you compile any module that import
           <literal>Wibble</literal>, GHC will print the specified
           message.</para>
        </listitem>
 
        <listitem>

-         <para>You can deprecate a function, class, type, or data constructor, with the
-         following top-level declaration:</para>
+         <para>You can attach a warning to a function, class, type, or data constructor, with the
+         following top-level declarations:</para>

 <programlisting>
    {-# DEPRECATED f, C, T "Don't use these" #-}
 <programlisting>
    {-# DEPRECATED f, C, T "Don't use these" #-}

+   {-# WARNING unsafePerformIO "This is unsafe; I hope you know what you're doing" #-}

 </programlisting>
          <para>When you compile any module that imports and uses any
           of the specified entities, GHC will print the specified
           message.</para>
 </programlisting>
          <para>When you compile any module that imports and uses any
           of the specified entities, GHC will print the specified
           message.</para>

-         <para> You can only deprecate entities declared at top level in the module
+         <para> You can only attach to entities declared at top level in the module

          being compiled, and you can only use unqualified names in the list of
          being compiled, and you can only use unqualified names in the list of

-         entities being deprecated.  A capitalised name, such as <literal>T</literal>
+         entities. A capitalised name, such as <literal>T</literal>

          refers to <emphasis>either</emphasis> the type constructor <literal>T</literal>
          <emphasis>or</emphasis> the data constructor <literal>T</literal>, or both if
          refers to <emphasis>either</emphasis> the type constructor <literal>T</literal>
          <emphasis>or</emphasis> the data constructor <literal>T</literal>, or both if

-         both are in scope.  If both are in scope, there is currently no way to deprecate 
-         one without the other (c.f. fixities <xref linkend="infix-tycons"/>).</para>
+         both are in scope.  If both are in scope, there is currently no way to
+      specify one without the other (c.f. fixities
+      <xref linkend="infix-tycons"/>).</para>

        </listitem>
       </itemizedlist>
        </listitem>
       </itemizedlist>

-      Any use of the deprecated item, or of anything from a deprecated
-      module, will be flagged with an appropriate message.  However,
-      deprecations are not reported for
-      (a) uses of a deprecated function within its defining module, and
-      (b) uses of a deprecated function in an export list.
+      Warnings and deprecations are not reported for
+      (a) uses within the defining module, and
+      (b) uses in an export list.

       The latter reduces spurious complaints within a library
       in which one module gathers together and re-exports 
       the exports of several others.
       </para>
       <para>You can suppress the warnings with the flag
       The latter reduces spurious complaints within a library
       in which one module gathers together and re-exports 
       the exports of several others.
       </para>
       <para>You can suppress the warnings with the flag

-      <option>-fno-warn-deprecations</option>.</para>
+      <option>-fno-warn-warnings-deprecations</option>.</para>

     </sect2>
 
     <sect2 id="inline-noinline-pragma">
     </sect2>
 
     <sect2 id="inline-noinline-pragma">

diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 3c19be5..4b3024a 100644 (file)
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -841,7 +841,7 @@ ghc -c Foo.hs</screen>
     of warnings which are generally likely to indicate bugs in your
     program.  These are:
     <option>-fwarn-overlapping-patterns</option>,
     of warnings which are generally likely to indicate bugs in your
     program.  These are:
     <option>-fwarn-overlapping-patterns</option>,

-    <option>-fwarn-deprecations</option>,
+    <option>-fwarn-warnings-deprecations</option>,

     <option>-fwarn-deprecated-flags</option>,
     <option>-fwarn-duplicate-exports</option>,
     <option>-fwarn-missing-fields</option>,
     <option>-fwarn-deprecated-flags</option>,
     <option>-fwarn-duplicate-exports</option>,
     <option>-fwarn-missing-fields</option>,

@@ -919,15 +919,16 @@ ghc -c Foo.hs</screen>
     <variablelist>
 
       <varlistentry>
     <variablelist>
 
       <varlistentry>

-       <term><option>-fwarn-deprecations</option>:</term>
+       <term><option>-fwarn-warnings-deprecations</option>:</term>

        <listitem>
        <listitem>

-         <indexterm><primary><option>-fwarn-deprecations</option></primary>
+         <indexterm><primary><option>-fwarn-warnings-deprecations</option></primary>

          </indexterm>
          </indexterm>

+         <indexterm><primary>warnings</primary></indexterm>

          <indexterm><primary>deprecations</primary></indexterm>
          <indexterm><primary>deprecations</primary></indexterm>

-         <para>Causes a warning to be emitted when a deprecated
-         function or type is used.  Entities can be marked as
-         deprecated using a pragma, see <xref
-         linkend="deprecated-pragma"/>.</para>
+         <para>Causes a warning to be emitted when a
+         module, function or type with a WARNING or DEPRECATED pragma
+      is used. See <xref linkend="warning-deprecated-pragma"/> for more
+      details on the pragmas.</para>

 
          <para>This option is on by default.</para>
        </listitem>
 
          <para>This option is on by default.</para>
        </listitem>