import Outputable
import UniqSupply ( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply )
import Unique ( Unique )
-import CmdLineOpts ( DynFlags, DynFlag(..), dopt, opt_PprStyle_Debug )
+import CmdLineOpts ( DynFlags, DynFlag(..), dopt, opt_PprStyle_Debug, dopt_set )
import Bag ( snocBag, unionBags )
import Panic ( showException )
tcg_deprecs = NoDeprecs,
tcg_insts = [],
tcg_rules = [],
- tcg_fords = []
+ tcg_fords = [],
+ tcg_keep = emptyNameSet
} ;
lcl_env = TcLclEnv {
tcl_errs = errs_var,
doptM :: DynFlag -> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
+setOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
+ env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
+
ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -- Do it flag is true
ifOptM flag thing_inside = do { b <- doptM flag;
if b then thing_inside else return () }
where
add (loc,msg) = addErrAt loc msg
-addWarn :: Message -> TcRn ()
-addWarn msg
+addReport :: Message -> TcRn ()
+addReport msg
= do { errs_var <- getErrsVar ;
loc <- getSrcLocM ;
rdr_env <- getGlobalRdrEnv ;
(warns, errs) <- readMutVar errs_var ;
writeMutVar errs_var (warns `snocBag` warn, errs) }
+addWarn :: Message -> TcRn ()
+addWarn msg = addReport (ptext SLIT("Warning:") <+> msg)
+
checkErr :: Bool -> Message -> TcRn ()
-- Add the error if the bool is False
checkErr ok msg = checkM ok (addErr msg)
-- With -dppr-debug, the effects is switched off, so you can still see
-- what warnings derived code would give
discardWarnings thing_inside
+ | opt_PprStyle_Debug = thing_inside
+ | otherwise
= do { errs_var <- newMutVar emptyMessages
; result <- setErrsVar errs_var thing_inside
; (_warns, errs) <- readMutVar errs_var