More DynFlags + SDoc

compiler/HsVersions.h

@@ -56,13 +56,13 @@ name = Util.globalMVar (value);
 #ifdef DEBUG
 #define ASSERT(e)      if (not (e)) then (assertPanic __FILE__ __LINE__) else
 #define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else
-#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
+#define WARN( dflags, e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
 #else
 -- We have to actually use all the variables we are given or we may get
 -- unused variable warnings when DEBUG is off.
 #define ASSERT(e)      if False && (not (e)) then panic "ASSERT" else
 #define ASSERT2(e,msg) if False && (const False (e,msg)) then pprPanic "ASSERT2" (msg) else
-#define WARN(e,msg)    if False && (e) then pprPanic "WARN" (msg) else
+#define WARN(dflags,e,msg)    if False && (e) then pprPanic (dflags) "WARN" (msg) else
 -- Here we deliberately don't use when as Control.Monad might not be imported
 #endif
 

compiler/basicTypes/Name.lhs

@@ -72,6 +72,7 @@ module Name (
 #include "Typeable.h"
 
 import {-# SOURCE #-} TypeRep( TyThing )
+import {-# SOURCE #-} DynFlags (DynFlags)
 
 import OccName
 import Module
@@ -164,7 +165,7 @@ All built-in syntax is for wired-in things.
 \begin{code}
 nameUnique		:: Name -> Unique
 nameOccName		:: Name -> OccName 
-nameModule		:: Name -> Module
+nameModule		:: DynFlags -> Name -> Module
 nameSrcLoc		:: Name -> SrcLoc
 nameSrcSpan		:: Name -> SrcSpan
 
@@ -181,7 +182,7 @@ nameSrcSpan name = n_loc  name
 %************************************************************************
 
 \begin{code}
-nameIsLocalOrFrom :: Module -> Name -> Bool
+nameIsLocalOrFrom :: DynFlags -> Module -> Name -> Bool
 isInternalName	  :: Name -> Bool
 isExternalName	  :: Name -> Bool
 isSystemName	  :: Name -> Bool
@@ -204,14 +205,14 @@ isExternalName _                               = False
 
 isInternalName name = not (isExternalName name)
 
-nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
+nameModule dflags name = nameModule_maybe name `orElse` pprPanic dflags "nameModule" (ppr name)
 nameModule_maybe :: Name -> Maybe Module
 nameModule_maybe (Name { n_sort = External mod})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
 nameModule_maybe _                                  = Nothing
 
-nameIsLocalOrFrom from name
-  | isExternalName name = from == nameModule name
+nameIsLocalOrFrom dflags from name
+  | isExternalName name = from == nameModule dflags name
   | otherwise		= True
 
 isTyVarName :: Name -> Bool
@@ -220,8 +221,8 @@ isTyVarName name = isTvOcc (nameOccName name)
 isTyConName :: Name -> Bool
 isTyConName name = isTcOcc (nameOccName name)
 
-isDataConName :: Name -> Bool
-isDataConName name = isDataOcc (nameOccName name)
+isDataConName :: DynFlags -> Name -> Bool
+isDataConName dflags name = isDataOcc dflags (nameOccName name)
 
 isValName :: Name -> Bool
 isValName name = isValOcc (nameOccName name)
@@ -484,7 +485,9 @@ pprNameLoc name
   | isGoodSrcSpan loc = pprDefnLoc loc
   | isInternalName name || isSystemName name 
                       = ptext (sLit "<no location info>")
-  | otherwise         = ptext (sLit "Defined in ") <> ppr (nameModule name)
+  | otherwise         = sdocWithDynFlags $ \dflags ->
+                        (ptext (sLit "Defined in ") <>
+                         ppr (nameModule dflags name))
   where loc = nameSrcSpan name
 \end{code}
 

compiler/basicTypes/OccName.lhs

@@ -101,6 +101,7 @@ import UniqFM
 import UniqSet
 import FastString
 import Outputable
+import {-# SOURCE #-} DynFlags (DynFlags)
 import Binary
 import StaticFlags( opt_SuppressUniques )
 import Data.Char
@@ -427,7 +428,8 @@ occNameString (OccName _ s) = unpackFS s
 setOccNameSpace :: NameSpace -> OccName -> OccName
 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 
-isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool
+isVarOcc, isTvOcc, isTcOcc :: OccName -> Bool
+isDataOcc :: DynFlags -> OccName -> Bool
 
 isVarOcc (OccName VarName _) = True
 isVarOcc _                   = False
@@ -445,20 +447,20 @@ isValOcc (OccName VarName  _) = True
 isValOcc (OccName DataName _) = True
 isValOcc _                    = False
 
-isDataOcc (OccName DataName _) = True
-isDataOcc (OccName VarName s)  
-  | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
+isDataOcc _      (OccName DataName _) = True
+isDataOcc dflags (OccName VarName s)  
+  | isLexCon s = pprPanic dflags "isDataOcc: check me" (ppr s)
 		-- Jan06: I don't think this should happen
-isDataOcc _                    = False
+isDataOcc _      _                    = False
 
 -- | Test if the 'OccName' is a data constructor that starts with
 -- a symbol (e.g. @:@, or @[]@)
-isDataSymOcc :: OccName -> Bool
-isDataSymOcc (OccName DataName s) = isLexConSym s
-isDataSymOcc (OccName VarName s)  
-  | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
+isDataSymOcc :: DynFlags -> OccName -> Bool
+isDataSymOcc _      (OccName DataName s) = isLexConSym s
+isDataSymOcc dflags (OccName VarName s)
+  | isLexConSym s = pprPanic dflags "isDataSymOcc: check me" (ppr s)
 		-- Jan06: I don't think this should happen
-isDataSymOcc _                    = False
+isDataSymOcc _      _                    = False
 -- Pretty inefficient!
 
 -- | Test if the 'OccName' is that for any operator (whether 

compiler/basicTypes/RdrName.lhs

@@ -67,6 +67,7 @@ import SrcLoc
 import FastString
 import Outputable
 import Util
+import {-# SOURCE #-} DynFlags (DynFlags)
 
 import Data.Data
 \end{code}
@@ -129,7 +130,7 @@ rdrNameOcc (Exact name) = nameOccName name
 rdrNameSpace :: RdrName -> NameSpace
 rdrNameSpace = occNameSpace . rdrNameOcc
 
-setRdrNameSpace :: RdrName -> NameSpace -> RdrName
+setRdrNameSpace :: DynFlags -> RdrName -> NameSpace -> RdrName
 -- ^ This rather gruesome function is used mainly by the parser.
 -- When parsing:
 --
@@ -143,12 +144,12 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 -- > data [] a = [] | a : [a]
 --
 -- For the exact-name case we return an original name.
-setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
-setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
-setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n ) 
-		       	          Orig (nameModule n)
-				       (setOccNameSpace ns (nameOccName n))
+setRdrNameSpace _      (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
+setRdrNameSpace _      (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
+setRdrNameSpace _      (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
+setRdrNameSpace dflags (Exact n)    ns = ASSERT( isExternalName n )
+                                         Orig (nameModule dflags n)
+                                              (setOccNameSpace ns (nameOccName n))
 \end{code}
 
 \begin{code}
@@ -185,9 +186,9 @@ nameRdrName name = Exact name
 -- unique is still there for debug printing, particularly
 -- of Types (which are converted to IfaceTypes before printing)
 
-nukeExact :: Name -> RdrName
-nukeExact n 
-  | isExternalName n = Orig (nameModule n) (nameOccName n)
+nukeExact :: DynFlags -> Name -> RdrName
+nukeExact dflags n
+  | isExternalName n = Orig (nameModule dflags n) (nameOccName n)
   | otherwise	     = Unqual (nameOccName n)
 \end{code}
 
@@ -504,17 +505,17 @@ mkGlobalRdrEnv gres
 				   (nameOccName (gre_name gre)) 
 				   gre
 
-findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
+findLocalDupsRdrEnv :: DynFlags -> GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
 -- ^ For each 'OccName', see if there are multiple local definitions
 -- for it.  If so, remove all but one (to suppress subsequent error messages)
 -- and return a list of the duplicate bindings
-findLocalDupsRdrEnv rdr_env occs 
+findLocalDupsRdrEnv dflags rdr_env occs 
   = go rdr_env [] occs
   where
     go rdr_env dups [] = (rdr_env, dups)
     go rdr_env dups (occ:occs)
       = case filter isLocalGRE gres of
-	  []       -> WARN( True, ppr occ <+> ppr rdr_env ) 
+	  []       -> WARN( dflags, True, ppr occ <+> ppr rdr_env ) 
 		      go rdr_env dups occs	-- Weird!  No binding for occ
 	  [_]      -> go rdr_env dups occs	-- The common case
 	  dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))

compiler/basicTypes/SrcLoc.lhs

@@ -74,6 +74,7 @@ module SrcLoc (
 import Util
 import Outputable
 import FastString
+import {-# SOURCE #-} DynFlags (DynFlags)
 
 import Data.Bits
 import Data.Data
@@ -127,14 +128,14 @@ srcLocFile (SrcLoc fname _ _) = fname
 srcLocFile _other	      = (fsLit "<unknown file")
 
 -- | Raises an error when used on a "bad" 'SrcLoc'
-srcLocLine :: SrcLoc -> Int
-srcLocLine (SrcLoc _ l _) = l
-srcLocLine (UnhelpfulLoc s) = pprPanic "srcLocLine" (ftext s)
+srcLocLine :: DynFlags -> SrcLoc -> Int
+srcLocLine _      (SrcLoc _ l _) = l
+srcLocLine dflags (UnhelpfulLoc s) = pprPanic dflags "srcLocLine" (ftext s)
 
 -- | Raises an error when used on a "bad" 'SrcLoc'
-srcLocCol :: SrcLoc -> Int
-srcLocCol (SrcLoc _ _ c) = c
-srcLocCol (UnhelpfulLoc s) = pprPanic "srcLocCol" (ftext s)
+srcLocCol :: DynFlags -> SrcLoc -> Int
+srcLocCol _      (SrcLoc _ _ c) = c
+srcLocCol dflags (UnhelpfulLoc s) = pprPanic dflags "srcLocCol" (ftext s)
 
 -- | Move the 'SrcLoc' down by one line if the character is a newline,
 -- to the next 8-char tabstop if it is a tab, and across by one
@@ -256,19 +257,19 @@ srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 
 -- | Create a 'SrcSpan' between two points in a file
-mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
-mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
-mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
-mkSrcSpan loc1 loc2
+mkSrcSpan :: DynFlags -> SrcLoc -> SrcLoc -> SrcSpan
+mkSrcSpan _ (UnhelpfulLoc str) _ = UnhelpfulSpan str
+mkSrcSpan _ _ (UnhelpfulLoc str) = UnhelpfulSpan str
+mkSrcSpan dflags loc1 loc2
   | line1 == line2 = if col1 == col2
 			then SrcSpanPoint file line1 col1
 			else SrcSpanOneLine file line1 col1 col2
   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
   where
-	line1 = srcLocLine loc1
-	line2 = srcLocLine loc2
-	col1 = srcLocCol loc1
-	col2 = srcLocCol loc2
+	line1 = srcLocLine dflags loc1
+	line2 = srcLocLine dflags loc2
+	col1 = srcLocCol dflags loc1
+	col2 = srcLocCol dflags loc2
 	file = srcLocFile loc1
 
 -- | Combines two 'SrcSpan' into one that spans at least all the characters

compiler/basicTypes/Var.lhs

@@ -76,6 +76,7 @@ import Util
 import FastTypes
 import FastString
 import Outputable
+import DynFlags
 
 import Data.Data
 \end{code}
@@ -272,9 +273,9 @@ mkTcTyVar name kind details
 		tc_tv_details = details
 	}
 
-tcTyVarDetails :: TyVar -> TcTyVarDetails
-tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details
-tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var)
+tcTyVarDetails :: DynFlags -> TyVar -> TcTyVarDetails
+tcTyVarDetails _ (TcTyVar { tc_tv_details = details }) = details
+tcTyVarDetails dflags var = pprPanic dflags "tcTyVarDetails" (ppr var)
 
 setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
 setTcTyVarDetails tv details = tv { tc_tv_details = details }

compiler/cmm/CmmType.hs

@@ -19,6 +19,7 @@ where
 import Constants
 import FastString
 import Outputable
+import DynFlags
 
 import Data.Word
 import Data.Int
@@ -197,14 +198,14 @@ widthInBytes W64  = 8
 widthInBytes W128 = 16
 widthInBytes W80  = 10
 
-widthFromBytes :: Int -> Width
-widthFromBytes 1  = W8
-widthFromBytes 2  = W16
-widthFromBytes 4  = W32
-widthFromBytes 8  = W64
-widthFromBytes 16 = W128
-widthFromBytes 10 = W80
-widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)
+widthFromBytes :: DynFlags -> Int -> Width
+widthFromBytes _      1  = W8
+widthFromBytes _      2  = W16
+widthFromBytes _      4  = W32
+widthFromBytes _      8  = W64
+widthFromBytes _      16 = W128
+widthFromBytes _      10 = W80
+widthFromBytes dflags n  = pprPanic dflags "no width for given number of bytes" (ppr n)
 
 -- log_2 of the width in bytes, useful for generating shifts.
 widthInLog :: Width -> Int

compiler/cmm/PprC.hs

@@ -775,10 +775,10 @@ pprReg r = case r of
         CmmLocal  local  -> pprLocalReg local
         CmmGlobal global -> pprGlobalReg global
 		
-pprAsPtrReg :: CmmReg -> SDoc
-pprAsPtrReg (CmmGlobal (VanillaReg n gcp)) 
-  = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> ptext (sLit ".p")
-pprAsPtrReg other_reg = pprReg other_reg
+pprAsPtrReg :: DynFlags -> CmmReg -> SDoc
+pprAsPtrReg dflags (CmmGlobal (VanillaReg n gcp)) 
+  = WARN( dflags, gcp /= VGcPtr, ppr n ) char 'R' <> int n <> ptext (sLit ".p")
+pprAsPtrReg _ other_reg = pprReg other_reg
 
 pprGlobalReg :: GlobalReg -> SDoc
 pprGlobalReg gr = case gr of

compiler/codeGen/CgInfoTbls.hs

@@ -211,7 +211,7 @@ mkStackLayout = do
                     [(offset - frame_sp - retAddrSizeW, b)
                     | (offset, b) <- binds]
 
-  WARN( not (all (\bind -> fst bind >= 0) rel_binds),
+  WARN( dflags, not (all (\bind -> fst bind >= 0) rel_binds),
 	ppr binds $$ ppr rel_binds $$
         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
     return $ stack_layout rel_binds frame_size

compiler/codeGen/ClosureInfo.lhs

@@ -636,7 +636,7 @@ getCallMethod _ _ _ (LFUnknown True) _
 
 getCallMethod _ name _ (LFUnknown False) n_args
   | n_args > 0 
-  = WARN( True, ppr name <+> ppr n_args ) 
+  = WARN( dflags, True, ppr name <+> ppr n_args ) 
     SlowCall	-- Note [Unsafe coerce complications]
 
   | otherwise

compiler/coreSyn/CoreArity.lhs

@@ -776,7 +776,7 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
 
        | otherwise	 -- We have an expression of arity > 0, 
        	 		 -- but its type isn't a function. 		   
-       = WARN( True, (ppr orig_n <+> ppr orig_ty) $$ ppr orig_expr )
+       = WARN( dflags, True, (ppr orig_n <+> ppr orig_ty) $$ ppr orig_expr )
          (getTvInScope subst, reverse eis)
     	-- This *can* legitmately happen:
     	-- e.g.  coerce Int (\x. x) Essentially the programmer is

compiler/coreSyn/CorePrep.lhs

@@ -363,7 +363,7 @@ cpePair top_lvl is_rec is_strict_or_unlifted env bndr rhs
        ; (floats3, rhs')
             <- if manifestArity rhs1 <= arity 
 	       then return (floats2, cpeEtaExpand arity rhs2)
-	       else WARN(True, text "CorePrep: silly extra arguments:" <+> ppr bndr)
+	       else WARN(dflags, True, text "CorePrep: silly extra arguments:" <+> ppr bndr)
 	       	    	       -- Note [Silly extra arguments]
 	       	    (do { v <- newVar (idType bndr)
 		        ; let float = mkFloat False False v rhs2

compiler/coreSyn/CoreSubst.lhs

@@ -251,7 +251,7 @@ lookupIdSubst doc (Subst in_scope ids _ _) v
   | Just e  <- lookupVarEnv ids       v = e
   | Just v' <- lookupInScope in_scope v = Var v'
 	-- Vital! See Note [Extending the Subst]
-  | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope $$ doc) 
+  | otherwise = WARN( dflags, True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope $$ doc) 
 		Var v
 
 -- | Find the substitution for a 'TyVar' in the 'Subst'
@@ -645,13 +645,13 @@ substUnfoldingSource (Subst in_scope ids _ _) (InlineWrapper wkr)
   | Just wkr_expr <- lookupVarEnv ids wkr 
   = case wkr_expr of
       Var w1 -> InlineWrapper w1
-      _other -> -- WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr 
+      _other -> -- WARN( dflags, True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr 
                 --             <+> ifPprDebug (equals <+> ppr wkr_expr) )   
 			      -- Note [Worker inlining]
                 InlineStable  -- It's not a wrapper any more, but still inline it!
 
   | Just w1  <- lookupInScope in_scope wkr = InlineWrapper w1
-  | otherwise = -- WARN( True, text "Interesting! CoreSubst.substWorker2:" <+> ppr wkr )
+  | otherwise = -- WARN( dflags, True, text "Interesting! CoreSubst.substWorker2:" <+> ppr wkr )
     	      	-- This can legitimately happen.  The worker has been inlined and
 		-- dropped as dead code, because we don't treat the UnfoldingSource
 		-- as an "occurrence".

compiler/coreSyn/CoreSyn.lhs

@@ -821,7 +821,7 @@ cmpAltCon (DataAlt _)  DEFAULT      = GT
 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
 cmpAltCon (LitAlt _)   DEFAULT      = GT
 
-cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+> 
+cmpAltCon con1 con2 = WARN( dflags, True, text "Comparing incomparable AltCons" <+> 
 			 	  ppr con1 <+> ppr con2 )
 		      LT
 \end{code}

compiler/coreSyn/CoreUtils.lhs

@@ -210,7 +210,7 @@ mkCoerce co expr
 --    if to_ty `eqType` from_ty
 --    then expr
 --    else 
-        WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co))
+        WARN(dflags, not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co))
          (Cast expr co)
 \end{code}
 
@@ -1223,10 +1223,10 @@ hash_expr env (Let (NonRec b r) e)    = hash_expr (extend_env env b) e * fast_ha
 hash_expr env (Let (Rec ((b,_):_)) e) = hash_expr (extend_env env b) e
 hash_expr env (Case e _ _ _)	      = hash_expr env e
 hash_expr env (Lam b e)	              = hash_expr (extend_env env b) e
-hash_expr _   (Type _)                = WARN(True, text "hash_expr: type") 1
+hash_expr _   (Type _)                = WARN(dflags, True, text "hash_expr: type") 1
 -- Shouldn't happen.  Better to use WARN than trace, because trace
 -- prevents the CPR optimisation kicking in for hash_expr.
-hash_expr _   (Coercion _)            = WARN(True, text "hash_expr: coercion") 1
+hash_expr _   (Coercion _)            = WARN(dflags, True, text "hash_expr: coercion") 1
 
 fast_hash_expr :: HashEnv -> CoreExpr -> Word32
 fast_hash_expr env (Var v)     	 = hashVar env v

compiler/main/Finder.lhs

@@ -635,7 +635,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
 
     from_exposed_pkg m = case lookupPackage pkg_map (modulePackageId m) of
                             Just pkg_config -> exposed pkg_config
-                            Nothing         -> WARN( True, ppr m ) -- Should not happen
+                            Nothing         -> WARN( dflags, True, ppr m ) -- Should not happen
                                                False
 
     pp_exp mod = ppr (moduleName mod)

compiler/main/TidyPgm.lhs

@@ -678,7 +678,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
 		-- unfolding in the *definition*; so look up in binder_set
           refined_id = case lookupVarSet binder_set idocc of
                          Just id -> id
-                         Nothing -> WARN( True, ppr idocc ) idocc
+                         Nothing -> WARN( dflags, True, ppr idocc ) idocc
 
           unfold_env' = extendVarEnv unfold_env idocc (name',show_unfold)
           referrer' | isExportedId refined_id = refined_id
@@ -1058,7 +1058,7 @@ tidyTopIdInfo rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_info
 
     --------- Strictness ------------
     final_sig | Just sig <- strictnessInfo idinfo
-              = WARN( _bottom_hidden sig, ppr name ) Just sig
+              = WARN( dflags, _bottom_hidden sig, ppr name ) Just sig
               | Just (_, sig) <- mb_bot_str = Just sig
               | otherwise                   = Nothing
 

compiler/prelude/PrelRules.lhs

@@ -508,7 +508,7 @@ tagToEnumRule _ [Type ty, Lit (MachInt i)]
         (dc:rest) -> ASSERT( null rest )
                      Just (mkTyApps (Var (dataConWorkId dc)) tc_args)
   | otherwise  -- See Note [tagToEnum#]
-  = WARN( True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty )
+  = WARN( dflags, True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty )
     Just (mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type")
   where
     correct_tag dc = (dataConTag dc - fIRST_TAG) == tag

compiler/rename/RnNames.lhs

@@ -122,7 +122,7 @@ rnImportDecl this_mod implicit_prelude
 
         -- Compiler sanity check: if the import didn't say
         -- {-# SOURCE #-} we should not get a hi-boot file
-    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) (do
+    WARN( dflags, not want_boot && mi_boot iface, ppr imp_mod_name ) (do
 
         -- Issue a user warning for a redundant {- SOURCE -} import
         -- NB that we arrange to read all the ordinary imports before

compiler/rename/RnPat.lhs

@@ -513,7 +513,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
       = do { env <- getGlobalRdrEnv
            ; return (case lookupGRE_Name env con of
 	       	       [gre] -> gre_par gre
-               	       gres  -> WARN( True, ppr con <+> ppr gres ) NoParent) }
+               	       gres  -> WARN( dflags, True, ppr con <+> ppr gres ) NoParent) }
       | otherwise = return NoParent
  
     dup_flds :: [[RdrName]]