Add a WARNING pragma

3 files changed, 56 insertions, 37 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 75e0d642fd..a544b625e9 100644
--- 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_deprecs   = deprecs,
+		 mi_warns     = warns,
 		 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
-	lazyPut bh deprecs
+	lazyPut bh warns
         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
-	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
@@ -433,7 +433,7 @@ instance Binary ModIface where
 		 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,
@@ -443,7 +443,7 @@ instance Binary ModIface where
                  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 })
 
@@ -515,23 +515,39 @@ instance Binary Usage where
             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
-	    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
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 3e42fd455a..73b0222f9b 100644
--- 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)
-	, pprDeprecs (mi_deprecs iface)
+	, ppr (mi_warns iface)
  	]
   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)
   ]
 
-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}
 
 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 79c09a8d6e..f7f7348e20 100644
--- 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_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 
-                   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
@@ -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_deprecs = deprecs,
+                      tcg_warns = warns,
                       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 
-                   fix_env deprecs hpc_info (imp_mods imports) mod_details
+                   fix_env warns hpc_info (imp_mods imports) mod_details
         
 
 mkUsedNames :: TcGblEnv -> IO NameSet
@@ -208,12 +208,12 @@ mkDependencies
 
 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 
-         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,
@@ -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]
-		; 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
@@ -262,7 +262,7 @@ mkIface_ hsc_env maybe_old_fingerprint
                         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
@@ -278,7 +278,7 @@ mkIface_ hsc_env maybe_old_fingerprint
 			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 }
 		}
 
@@ -522,7 +522,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                       (map fst sorted_decls,
                        export_hash,
                        orphan_hash,
-                       mi_deprecs iface0)
+                       mi_warns iface0)
 
    -- The interface hash depends on:
    --    - the ABI hash, plus