diff options
author | Siddhanathan Shanmugam <siddhanathan@gmail.com> | 2015-10-26 20:42:43 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-10-26 21:43:01 +0100 |
commit | 499ce291b6bab252c63f0791276c38012280f0b4 (patch) | |
tree | 88fdc52de4d76aea3fbe3d405829619600273dcb | |
parent | 23e344bbbd27418bb84bdc588374b3e44f6d23a6 (diff) | |
download | haskell-499ce291b6bab252c63f0791276c38012280f0b4.tar.gz |
Add flag to reverse errors in GHC/GHCi
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1367
GHC Trac Issues: #10848
-rw-r--r-- | compiler/main/DynFlags.hs | 13 | ||||
-rw-r--r-- | compiler/main/ErrUtils.hs | 15 | ||||
-rw-r--r-- | utils/mkUserGuidePart/Options/Misc.hs | 7 |
3 files changed, 29 insertions, 6 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 438586595e..4af16cfbc5 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -897,7 +897,10 @@ data DynFlags = DynFlags { -- | Only inline memset if it generates no more than this many -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool } class HasDynFlags m where @@ -1558,7 +1561,9 @@ defaultDynFlags mySettings = maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32 + maxInlineMemsetInsns = 32, + + reverseErrors = False } defaultWays :: Settings -> [Way] @@ -2397,6 +2402,10 @@ dynamic_flags = [ deprecate "Use -fno-force-recomp instead")) , defGhcFlag "no-recomp" (NoArg (do setGeneralFlag Opt_ForceRecomp deprecate "Use -fforce-recomp instead")) + , defGhcFlag "freverse-errors" + (noArg (\d -> d {reverseErrors = True} )) + , defGhcFlag "fno-reverse-errors" + (noArg (\d -> d {reverseErrors = False} )) ------ HsCpp opts --------------------------------------------------- , defFlag "D" (AnySuffix (upd . addOptP)) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index fd10694234..11c8c9d0db 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -54,6 +54,7 @@ import System.FilePath ( takeDirectory, (</>) ) import Data.List import qualified Data.Set as Set import Data.IORef +import Data.Maybe ( fromMaybe ) import Data.Ord import Data.Time import Control.Monad @@ -198,10 +199,12 @@ printBagOfErrors dflags bag_of_errors errMsgShortDoc = d, errMsgSeverity = sev, errMsgExtraInfo = e, - errMsgContext = unqual } <- sortMsgBag bag_of_errors ] + errMsgContext = unqual } <- sortMsgBag (Just dflags) + bag_of_errors + ] pprErrMsgBagWithLoc :: Bag ErrMsg -> [SDoc] -pprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag bag ] +pprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag Nothing bag ] pprLocErrMsg :: ErrMsg -> SDoc pprLocErrMsg (ErrMsg { errMsgSpan = s @@ -213,8 +216,12 @@ pprLocErrMsg (ErrMsg { errMsgSpan = s withPprStyle (mkErrStyle dflags unqual) $ mkLocMessage sev s (d $$ e) -sortMsgBag :: Bag ErrMsg -> [ErrMsg] -sortMsgBag bag = sortBy (comparing errMsgSpan) $ bagToList bag +sortMsgBag :: Maybe DynFlags -> Bag ErrMsg -> [ErrMsg] +sortMsgBag dflags = sortBy (maybeFlip $ comparing errMsgSpan) . bagToList + where maybeFlip :: (a -> a -> b) -> (a -> a -> b) + maybeFlip + | fromMaybe False (fmap reverseErrors dflags) = flip + | otherwise = id ghcExit :: DynFlags -> Int -> IO () ghcExit dflags val diff --git a/utils/mkUserGuidePart/Options/Misc.hs b/utils/mkUserGuidePart/Options/Misc.hs index d6a4c4eaec..141a9caf1c 100644 --- a/utils/mkUserGuidePart/Options/Misc.hs +++ b/utils/mkUserGuidePart/Options/Misc.hs @@ -29,4 +29,11 @@ miscOptions = "the main thread, rather than a forked thread." , flagType = DynamicFlag } + , flag { flagName = "-freverse-errors" + , flagDescription = + "Display errors in GHC/GHCi sorted by reverse order of "++ + "source code line numbers." + , flagType = DynamicFlag + , flagReverse = "-fno-reverse-errors" + } ] |