Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0043f07ad8c9611a905379c2abd40bda0f39ebf9 >--------------------------------------------------------------- commit 0043f07ad8c9611a905379c2abd40bda0f39ebf9 Author: Ian Lynagh <[email protected]> Date: Fri Jun 22 20:48:48 2012 +0100 Remove some uses of sortLe Technically the behaviour of sortWith has changed, as it used x `le` y = get_key x < get_key y (note "<" rather than "<="), but I assume that that was just a mistake. >--------------------------------------------------------------- compiler/basicTypes/SrcLoc.lhs | 6 +++--- compiler/cmm/CmmBuildInfoTables.hs | 2 +- compiler/ghci/ByteCodeGen.lhs | 2 +- compiler/main/ErrUtils.lhs | 11 +++-------- compiler/utils/Digraph.lhs | 8 ++++---- compiler/utils/Util.lhs | 4 +--- 6 files changed, 13 insertions(+), 20 deletions(-) diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index a7399ab..2c008f5 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -82,6 +82,8 @@ import FastString import Data.Bits import Data.Data +import Data.List +import Data.Ord import System.FilePath \end{code} @@ -176,9 +178,7 @@ instance Ord RealSrcLoc where compare = cmpRealSrcLoc sortLocated :: [Located a] -> [Located a] -sortLocated things = sortLe le things - where - le (L l1 _) (L l2 _) = l1 <= l2 +sortLocated things = sortBy (comparing getLoc) things cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2 diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index ab829de..011947f 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -315,7 +315,7 @@ procpointSRT top_srt top_table entries = return (top, srt) where ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries - sorted_ints = sortLe (<=) ints + sorted_ints = sort ints offset = head sorted_ints bitmap_entries = map (subtract offset) sorted_ints len = P.last bitmap_entries + 1 diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 3e4860c..230c094 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -875,7 +875,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple bitmap_size' :: Int bitmap_size' = fromIntegral bitmap_size bitmap = intsToReverseBitmap bitmap_size'{-size-} - (sortLe (<=) (filter (< bitmap_size') rel_slots)) + (sort (filter (< bitmap_size') rel_slots)) where binds = Map.toList p -- NB: unboxed tuple cases bind the scrut binder to the same offset diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 5f5769d..daa66f9 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -37,7 +37,6 @@ module ErrUtils ( import Bag ( Bag, bagToList, isEmptyBag, emptyBag ) import Exception -import Util import Outputable import Panic import FastString @@ -51,6 +50,7 @@ import System.FilePath import Data.List import qualified Data.Set as Set import Data.IORef +import Data.Ord import Control.Monad import System.IO @@ -178,13 +178,8 @@ printMsgBag dflags bag errMsgContext = unqual } <- sortMsgBag bag ] sortMsgBag :: Bag ErrMsg -> [ErrMsg] -sortMsgBag bag = sortLe srcOrder $ bagToList bag - where - srcOrder err1 err2 = - case compare (head (errMsgSpans err1)) (head (errMsgSpans err2)) of - LT -> True - EQ -> True - GT -> False +sortMsgBag bag = sortBy (comparing (head . errMsgSpans)) $ bagToList bag + -- TODO: Why "head ."? Why not compare the whole list? ghcExit :: DynFlags -> Int -> IO () ghcExit dflags val diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index f7bdff2..9ae84a7 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -47,7 +47,7 @@ module Digraph( ------------------------------------------------------------------------------ -import Util ( sortLe, minWith, count ) +import Util ( minWith, count ) import Outputable import Maybes ( expectJust ) import MonadUtils ( allM ) @@ -59,7 +59,8 @@ import Control.Monad.ST -- std interfaces import Data.Maybe import Data.Array -import Data.List ( (\\) ) +import Data.List hiding (transpose) +import Data.Ord import Data.Array.ST import qualified Data.Map as Map import qualified Data.Set as Set @@ -140,8 +141,7 @@ reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_verte max_v = length nodes - 1 bounds = (0, max_v) :: (Vertex, Vertex) - sorted_nodes = let n1 `le` n2 = (key_extractor n1 `compare` key_extractor n2) /= GT - in sortLe le nodes + sorted_nodes = sortBy (comparing key_extractor) nodes numbered_nodes = zipWith (,) [0..] sorted_nodes key_map = array bounds [(i, key_extractor node) | (i, node) <- numbered_nodes] diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 1268c52..b750a54 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -569,9 +569,7 @@ sortLe :: (a->a->Bool) -> [a] -> [a] sortLe le = generalNaturalMergeSort le sortWith :: Ord b => (a->b) -> [a] -> [a] -sortWith get_key xs = sortLe le xs - where - x `le` y = get_key x < get_key y +sortWith get_key xs = sortBy (comparing get_key) xs minWith :: Ord b => (a -> b) -> [a] -> a minWith get_key xs = ASSERT( not (null xs) ) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
