Change more uses of sortLe to sortBy

compiler/codeGen/CgStackery.lhs

@@ -43,6 +43,7 @@ import OrdList
 import Outputable
 
 import Control.Monad
+import Data.List
 \end{code}
 
 %************************************************************************
@@ -333,7 +334,7 @@ Explicitly free some stack space.
 freeStackSlots :: [VirtualSpOffset] -> Code
 freeStackSlots extra_free
   = do	{ stk_usg <- getStkUsage
-	; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
+	; let all_free = addFreeSlots (freeStk stk_usg) (sort extra_free)
 	; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
 	; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
 

compiler/codeGen/CgUtils.hs

@@ -72,7 +72,9 @@ import Outputable
 
 import Data.Char
 import Data.Word
+import Data.List
 import Data.Maybe
+import Data.Ord
 
 -------------------------------------------------------------------------
 --
@@ -527,12 +529,10 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag
         ; let via_C | HscC <- hscTarget dflags = True
                     | otherwise                = False
 
-        ; stmts <- mk_switch tag_expr (sortLe le branches)
+        ; stmts <- mk_switch tag_expr (sortBy (comparing fst) branches)
                         mb_deflt_id lo_tag hi_tag via_C
         ; emitCgStmts stmts
         }
-  where
-    (t1,_) `le` (t2,_) = t1 <= t2
 
 
 mk_switch :: CmmExpr -> [(ConTagZ, CgStmts)]
@@ -699,10 +699,8 @@ emitLitSwitch _     []       deflt = emitCgStmts deflt
 emitLitSwitch scrut branches deflt_blk
   = do  { scrut' <- assignTemp scrut
         ; deflt_blk_id <- forkCgStmts deflt_blk
-        ; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
+        ; blk <- mk_lit_switch scrut' deflt_blk_id (sortBy (comparing fst) branches)
         ; emitCgStmts blk }
-  where
-    le (t1,_) (t2,_) = t1 <= t2
 
 mk_lit_switch :: CmmExpr -> BlockId
               -> [(Literal,CgStmts)]

compiler/codeGen/StgCmmUtils.hs

@@ -79,6 +79,8 @@ import FastString
 import Outputable
 
 import Data.Char
+import Data.List
+import Data.Ord
 import Data.Word
 import Data.Maybe
 
@@ -574,14 +576,11 @@ mkCmmSwitch via_C tag_expr branches mb_deflt lo_tag hi_tag
     label_branches join_lbl branches	$ \ branches ->
     assignTemp' tag_expr		$ \tag_expr' -> 
     
-    mk_switch tag_expr' (sortLe le branches) mb_deflt 
+    mk_switch tag_expr' (sortBy (comparing fst) branches) mb_deflt 
 	      lo_tag hi_tag via_C
 	  -- Sort the branches before calling mk_switch
     <*> mkLabel join_lbl
 
-  where
-    (t1,_) `le` (t2,_) = t1 <= t2
-
 mk_switch :: CmmExpr -> [(ConTagZ, BlockId)]
 	  -> Maybe BlockId 
 	  -> ConTagZ -> ConTagZ -> Bool
@@ -731,10 +730,8 @@ mkCmmLitSwitch scrut  branches deflt
     withFreshLabel "switch join" 	$ \ join_lbl ->
     label_code join_lbl deflt		$ \ deflt ->
     label_branches join_lbl branches	$ \ branches ->
-    mk_lit_switch scrut' deflt (sortLe le branches)
+    mk_lit_switch scrut' deflt (sortBy (comparing fst) branches)
     <*> mkLabel join_lbl
-  where
-    le (t1,_) (t2,_) = t1 <= t2
 
 mk_lit_switch :: CmmExpr -> BlockId 
  	      -> [(Literal,BlockId)]

compiler/hsSyn/HsBinds.lhs

@@ -34,13 +34,13 @@ import NameSet
 import BasicTypes
 import Outputable	
 import SrcLoc
-import Util
 import Var
 import Bag
 import FastString
 
 import Data.Data hiding ( Fixity )
-import Data.List ( intersect )
+import Data.List
+import Data.Ord
 \end{code}
 
 %************************************************************************
@@ -267,7 +267,7 @@ pprLHsBindsForUser binds sigs
     decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
             [(loc, ppr bind) | L loc bind <- bagToList binds]
 
-    sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls
+    sort_by_loc decls = sortBy (comparing fst) decls
 
 pprDeclList :: [SDoc] -> SDoc   -- Braces with a space
 -- Print a bunch of declarations

compiler/rename/RnEnv.lhs

@@ -73,6 +73,7 @@ import ListSetOps	( removeDups )
 import DynFlags
 import FastString
 import Control.Monad
+import Data.List
 import qualified Data.Set as Set
 import Constants	( mAX_TUPLE_SIZE )
 \end{code}
@@ -1641,7 +1642,7 @@ dupNamesErr get_loc names
   where
     locs      = map get_loc names
     big_loc   = foldr1 combineSrcSpans locs
-    locations = ptext (sLit "Bound at:") <+> vcat (map ppr (sortLe (<=) locs))
+    locations = ptext (sLit "Bound at:") <+> vcat (map ppr (sort locs))
 
 kindSigErr :: Outputable a => a -> SDoc
 kindSigErr thing

compiler/simplStg/SRT.lhs

@@ -20,7 +20,7 @@ import Bitmap
 
 import Outputable
 
-import Util
+import Data.List
 \end{code}
 
 \begin{code}
@@ -148,7 +148,7 @@ constructSRT table (SRTEntries entries)
   where
     ints = map (expectJust "constructSRT" . lookupVarEnv table)
                 (varSetElems entries)
-    sorted_ints = sortLe (<=) ints
+    sorted_ints = sort ints
     offset = head sorted_ints
     bitmap_entries = map (subtract offset) sorted_ints
     len = last bitmap_entries + 1

compiler/specialise/Rules.lhs

@@ -54,6 +54,7 @@ import Maybes
 import Bag
 import Util
 import Data.List
+import Data.Ord
 \end{code}
 
 Note [Overall plumbing for rules]
@@ -239,10 +240,8 @@ pprRulesForUser :: [CoreRule] -> SDoc
 pprRulesForUser rules
   = withPprStyle defaultUserStyle $
     pprRules $
-    sortLe le_rule  $
+    sortBy (comparing ru_name) $
     tidyRules emptyTidyEnv rules
-  where
-    le_rule r1 r2 = ru_name r1 <= ru_name r2
 \end{code}
 
 

compiler/typecheck/TcDeriv.lhs

@@ -62,6 +62,7 @@ import FastString
 import Bag
 
 import Control.Monad
+import Data.List
 \end{code}
 
 %************************************************************************
@@ -1406,7 +1407,7 @@ inferInstanceContexts oflag infer_specs
 		-- Claim: the result instance declaration is guaranteed valid
 		-- Hence no need to call:
 		--   checkValidInstance tyvars theta clas inst_tys
-	   ; return (sortLe (\p1 p2 -> cmpType p1 p2 /= GT) theta) }	-- Canonicalise before returning the solution
+	   ; return (sortBy cmpType theta) }	-- Canonicalise before returning the solution
       where
         the_pred = mkClassPred clas inst_tys
 

compiler/typecheck/TcRnDriver.lhs

@@ -82,6 +82,7 @@ import TcType   ( orphNamesOfDFunHead )
 import Inst     ( tcGetInstEnvs )
 import Data.List ( sortBy )
 import Data.IORef ( readIORef )
+import Data.Ord
 
 #ifdef GHCI
 import TcType   ( isUnitTy, isTauTy )
@@ -1879,17 +1880,15 @@ ppr_fam_insts fam_insts =
 ppr_sigs :: [Var] -> SDoc
 ppr_sigs ids
         -- Print type signatures; sort by OccName
-  = vcat (map ppr_sig (sortLe le_sig ids))
+  = vcat (map ppr_sig (sortBy (comparing getOccName) ids))
   where
-    le_sig id1 id2 = getOccName id1 <= getOccName id2
     ppr_sig id = hang (ppr id <+> dcolon) 2 (ppr (tidyTopType (idType id)))
 
 ppr_tydecls :: [TyCon] -> SDoc
 ppr_tydecls tycons
         -- Print type constructor info; sort by OccName
-  = vcat (map ppr_tycon (sortLe le_sig tycons))
+  = vcat (map ppr_tycon (sortBy (comparing getOccName) tycons))
   where
-    le_sig tycon1 tycon2 = getOccName tycon1 <= getOccName tycon2
     ppr_tycon tycon = ppr (tyThingToIfaceDecl (ATyCon tycon))
 
 ppr_rules :: [CoreRule] -> SDoc

compiler/utils/ListSetOps.lhs

@@ -113,10 +113,9 @@ equivClasses :: (a -> a -> Ordering) -- Comparison
 
 equivClasses _         []  = []
 equivClasses _   stuff@[_] = [stuff]
-equivClasses cmp items     = runs eq (sortLe le items)
+equivClasses cmp items     = runs eq (sortBy cmp items)
   where
     eq a b = case cmp a b of { EQ -> True; _ -> False }
-    le a b = case cmp a b of { LT -> True; EQ -> True; GT -> False }
 \end{code}
 
 The first cases in @equivClasses@ above are just to cut to the point