X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=b6297a2d6d163da49365c617f6da2fb4d7590e5d;hb=d45197aabb22178066a8ec50d29331786a0c518c;hp=15b142b15d6d9b344a855558636186264c68142f;hpb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;p=ghc-hetmet.git

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index 15b142b..b6297a2 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -22,7 +22,7 @@ module ErrUtils (
         mkDumpDoc, dumpSDoc,
 
 	--  * Messages during compilation
-	putMsg,
+        putMsg, putMsgWith,
 	errorMsg,
 	fatalErrorMsg,
 	compilationProgressMsg,
@@ -67,7 +67,8 @@ mkLocMessage locn msg
   -- would look strange.  Better to say explicitly "<no location info>".
 
 printError :: SrcSpan -> Message -> IO ()
-printError span msg = printErrs (mkLocMessage span msg $ defaultErrStyle)
+printError span msg =
+  printErrs (mkLocMessage span msg) defaultErrStyle
 
 
 -- -----------------------------------------------------------------------------
@@ -275,6 +276,12 @@ ifVerbose dflags val act
 putMsg :: DynFlags -> Message -> IO ()
 putMsg dflags msg = log_action dflags SevInfo noSrcSpan defaultUserStyle msg
 
+putMsgWith :: DynFlags -> PrintUnqualified -> Message -> IO ()
+putMsgWith dflags print_unqual msg
+  = log_action dflags SevInfo noSrcSpan sty msg
+  where
+    sty = mkUserStyle print_unqual AllTheWay
+
 errorMsg :: DynFlags -> Message -> IO ()
 errorMsg dflags msg = log_action dflags SevError noSrcSpan defaultErrStyle msg