diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs index 6e6e99aae994a429a77e28cb450246bfad37c7d7..486cb6ed072f3137f1bef3c7e277baf01420d6a2 100644 --- a/ghc/compiler/main/ErrUtils.lhs +++ b/ghc/compiler/main/ErrUtils.lhs @@ -12,14 +12,15 @@ module ErrUtils ( addShortErrLocLine, addShortWarnLocLine, dontAddErrLoc, pprBagOfErrors, - ghcExit + ghcExit, + doIfSet, dumpIfSet ) where IMP_Ubiq(){-uitous-} import CmdLineOpts ( opt_PprUserLength ) import Bag --( bagToList ) -import Outputable ( PprStyle(..), Outputable(..) ) +import Outputable ( PprStyle(..), Outputable(..), printErrs ) import Pretty import SrcLoc ( noSrcLoc, SrcLoc{-instance-} ) \end{code} @@ -53,7 +54,8 @@ dontAddErrLoc title rest_of_err_msg sty pprBagOfErrors :: PprStyle -> Bag Error -> Doc pprBagOfErrors sty bag_of_errors - = let pretties = map ( \ e -> e sty ) (bagToList bag_of_errors) in + = let pretties = map ( \ e -> e sty ) (bagToList bag_of_errors) + in vcat (map (\ p -> ($$) space p) pretties) \end{code} @@ -65,3 +67,23 @@ ghcExit val then error "Compilation had errors\n" else return () \end{code} + +\begin{code} +doIfSet :: Bool -> IO () -> IO () +doIfSet flag action | flag = action + | otherwise = return () +\end{code} + +\begin{code} +dumpIfSet :: Bool -> String -> Doc -> IO () +dumpIfSet flag hdr doc + | not flag = return () + | otherwise = printErrs dump + where + dump = (line <+> text hdr <+> line) + $$ + doc + $$ + text "" + line = text (take 20 (repeat '=')) +\end{code}