X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=72d0e930bcb347de0c015a0b0cc2988beb892a69;hb=b4229ab662b6d87b1477bafa85d2db46e5a9a152;hp=0b61295b8d5492109f3e7321b1abc63d03549e84;hpb=aed0554eb789d949b196230a9d25c38e2c6e14d9;p=ghc-hetmet.git diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 0b61295..72d0e93 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -16,7 +16,8 @@ module ErrUtils ( ghcExit, doIfSet, doIfSet_dyn, - dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, dumpSDoc, + dumpIfSet, dumpIf_core, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, + mkDumpDoc, dumpSDoc, -- * Messages during compilation putMsg, @@ -195,13 +196,18 @@ dumpIfSet flag hdr doc | not flag = return () | otherwise = printDump (mkDumpDoc hdr doc) +dumpIf_core :: Bool -> DynFlags -> DynFlag -> String -> SDoc -> IO () +dumpIf_core cond dflags dflag hdr doc + | cond + || verbosity dflags >= 4 + || dopt Opt_D_verbose_core2core dflags + = dumpSDoc dflags dflag hdr doc + + | otherwise = return () + dumpIfSet_core :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpIfSet_core dflags flag hdr doc - | dopt flag dflags - || verbosity dflags >= 4 - || dopt Opt_D_verbose_core2core dflags - = dumpSDoc dflags flag hdr doc - | otherwise = return () + = dumpIf_core (dopt flag dflags) dflags flag hdr doc dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpIfSet_dyn dflags flag hdr doc