X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=0b61295b8d5492109f3e7321b1abc63d03549e84;hb=4b0a3a1f00071367c3316e5bbdf9c1441bb03136;hp=e4559d4a04364fd2c4a7b67cee6a2cc59c287364;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index e4559d4..0b61295 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -4,13 +4,6 @@ \section[ErrsUtils]{Utilities for error reporting} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module ErrUtils ( Message, mkLocMessage, printError, Severity(..), @@ -34,9 +27,10 @@ module ErrUtils ( debugTraceMsg, ) where +-- XXX This define is a bit of a hack, and should be done more nicely +#define FAST_STRING_NOT_NEEDED 1 #include "HsVersions.h" -import Module ( ModLocation(..)) import Bag ( Bag, bagToList, isEmptyBag, emptyBag ) import SrcLoc ( SrcSpan ) import Util ( sortLe ) @@ -91,7 +85,7 @@ errMsgTc :: TyCon errMsgTc = mkTyCon "ErrMsg" {-# NOINLINE errMsgTc #-} instance Typeable ErrMsg where -#if __GLASGOW_HASKELL__ < 603 +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603 typeOf _ = mkAppTy errMsgTc [] #else typeOf _ = mkTyConApp errMsgTc [] @@ -145,7 +139,7 @@ printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO () printBagOfErrors dflags bag_of_errors = sequence_ [ let style = mkErrStyle unqual in log_action dflags SevError s style (d $$ e) - | ErrMsg { errMsgSpans = s:ss, + | ErrMsg { errMsgSpans = s:_, errMsgShortDoc = d, errMsgExtraInfo = e, errMsgContext = unqual } <- sorted_errs ] @@ -163,7 +157,7 @@ printBagOfWarnings :: DynFlags -> Bag ErrMsg -> IO () printBagOfWarnings dflags bag_of_warns = sequence_ [ let style = mkErrStyle unqual in log_action dflags SevWarning s style (d $$ e) - | ErrMsg { errMsgSpans = s:ss, + | ErrMsg { errMsgSpans = s:_, errMsgShortDoc = d, errMsgExtraInfo = e, errMsgContext = unqual } <- sorted_errs ] @@ -223,6 +217,7 @@ dumpIfSet_dyn_or dflags flags hdr doc = printDump (mkDumpDoc hdr doc) | otherwise = return () +mkDumpDoc :: String -> SDoc -> SDoc mkDumpDoc hdr doc = vcat [text "", line <+> text hdr <+> line,