Commit 0043f07a authored by Ian Lynagh's avatar Ian Lynagh

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.
parent 585ff572
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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) )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment