[commit: ghc] master: Change type of `errMsgSpans` field of `ErrMsg` to `SrcSpan` (e734c18)
git at git.haskell.org
git at git.haskell.org
Sat Oct 26 09:39:24 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/e734c18969de4e41aef6671822c164ee039291d7/ghc
>---------------------------------------------------------------
commit e734c18969de4e41aef6671822c164ee039291d7
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Oct 23 11:24:24 2013 +0200
Change type of `errMsgSpans` field of `ErrMsg` to `SrcSpan`
It was `[SrcSpan]`, but never ever contained more than one span.
>---------------------------------------------------------------
e734c18969de4e41aef6671822c164ee039291d7
compiler/main/ErrUtils.lhs | 15 ++++++---------
1 file changed, 6 insertions(+), 9 deletions(-)
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index f9f4387..12b6bad 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -8,7 +8,7 @@
module ErrUtils (
ErrMsg, WarnMsg, Severity(..),
Messages, ErrorMessages, WarningMessages,
- errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
+ errMsgSpan, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
MsgDoc, mkLocMessage, pprMessageBag, pprErrMsgBag, pprErrMsgBagWithLoc,
pprLocErrMsg, makeIntoWarning,
@@ -63,7 +63,7 @@ type WarningMessages = Bag WarnMsg
type ErrorMessages = Bag ErrMsg
data ErrMsg = ErrMsg {
- errMsgSpans :: [SrcSpan],
+ errMsgSpan :: SrcSpan,
errMsgContext :: PrintUnqualified,
errMsgShortDoc :: MsgDoc, -- errMsgShort* should always
errMsgShortString :: String, -- contain the same text
@@ -115,7 +115,7 @@ makeIntoWarning err = err { errMsgSeverity = SevWarning }
mk_err_msg :: DynFlags -> Severity -> SrcSpan -> PrintUnqualified -> MsgDoc -> SDoc -> ErrMsg
mk_err_msg dflags sev locn print_unqual msg extra
- = ErrMsg { errMsgSpans = [locn], errMsgContext = print_unqual
+ = ErrMsg { errMsgSpan = locn, errMsgContext = print_unqual
, errMsgShortDoc = msg , errMsgShortString = showSDoc dflags msg
, errMsgExtraInfo = extra
, errMsgSeverity = sev }
@@ -165,29 +165,26 @@ pprErrMsgBagWithLoc :: Bag ErrMsg -> [SDoc]
pprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag bag ]
pprLocErrMsg :: ErrMsg -> SDoc
-pprLocErrMsg (ErrMsg { errMsgSpans = spans
+pprLocErrMsg (ErrMsg { errMsgSpan = s
, errMsgShortDoc = d
, errMsgExtraInfo = e
, errMsgSeverity = sev
, errMsgContext = unqual })
= sdocWithDynFlags $ \dflags ->
withPprStyle (mkErrStyle dflags unqual) (mkLocMessage sev s (d $$ e))
- where
- (s : _) = spans -- Should be non-empty
printMsgBag :: DynFlags -> Bag ErrMsg -> IO ()
printMsgBag dflags bag
= sequence_ [ let style = mkErrStyle dflags unqual
in log_action dflags dflags sev s style (d $$ e)
- | ErrMsg { errMsgSpans = s:_,
+ | ErrMsg { errMsgSpan = s,
errMsgShortDoc = d,
errMsgSeverity = sev,
errMsgExtraInfo = e,
errMsgContext = unqual } <- sortMsgBag bag ]
sortMsgBag :: Bag ErrMsg -> [ErrMsg]
-sortMsgBag bag = sortBy (comparing (head . errMsgSpans)) $ bagToList bag
- -- TODO: Why "head ."? Why not compare the whole list?
+sortMsgBag bag = sortBy (comparing errMsgSpan) $ bagToList bag
ghcExit :: DynFlags -> Int -> IO ()
ghcExit dflags val
More information about the ghc-commits
mailing list