Continue refactoring the core-to-core pipeline

[ghc-hetmet.git] / compiler / main / ErrUtils.lhs

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index dd7f2ac..f1328e0 100644 (file)
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -5,19 +5,20 @@
 
 \begin{code}
 module ErrUtils (
-       Message, mkLocMessage, printError,
+       Message, mkLocMessage, printError, pprMessageBag,
        Severity(..),
 
        ErrMsg, WarnMsg,
         ErrorMessages, WarningMessages,
+        errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
        Messages, errorsFound, emptyMessages,
        mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
        printErrorsAndWarnings, printBagOfErrors, printBagOfWarnings,
-       warnIsErrorMsg,
+       warnIsErrorMsg, mkLongWarnMsg,
 
        ghcExit,
        doIfSet, doIfSet_dyn, 
-       dumpIfSet, dumpIf_core, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or,
+       dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_or,
         mkDumpDoc, dumpSDoc,
 
        --  * Messages during compilation
@@ -48,6 +49,9 @@ import System.IO
 
 type Message = SDoc
 
+pprMessageBag :: Bag Message -> SDoc
+pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))
+
 data Severity
   = SevInfo
   | SevWarning
@@ -105,6 +109,9 @@ mkLongErrMsg locn print_unqual msg extra
 mkWarnMsg :: SrcSpan -> PrintUnqualified -> Message -> WarnMsg
 mkWarnMsg = mkErrMsg
 
+mkLongWarnMsg :: SrcSpan -> PrintUnqualified -> Message -> Message -> ErrMsg
+mkLongWarnMsg = mkLongErrMsg
+
 -- Variant that doesn't care about qualified/unqualified names
 mkPlainWarnMsg :: SrcSpan -> Message -> ErrMsg
 mkPlainWarnMsg locn msg = mkWarnMsg locn alwaysQualify msg
@@ -198,19 +205,6 @@ 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
-  = dumpIf_core (dopt flag dflags) dflags flag hdr doc
-
 dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
 dumpIfSet_dyn dflags flag hdr doc
   | dopt flag dflags || verbosity dflags >= 4 
@@ -227,10 +221,10 @@ dumpIfSet_dyn_or dflags flags hdr doc
 
 mkDumpDoc :: String -> SDoc -> SDoc
 mkDumpDoc hdr doc 
-   = vcat [text "", 
+   = vcat [blankLine,
           line <+> text hdr <+> line,
           doc,
-          text ""]
+          blankLine]
      where 
         line = text (replicate 20 '=')