[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