Change more uses of sortLe to sortBy
authorIan Lynagh <igloo@earth.li>
Fri, 22 Jun 2012 20:55:49 +0000 (21:55 +0100)
committerIan Lynagh <igloo@earth.li>
Fri, 22 Jun 2012 20:55:49 +0000 (21:55 +0100)
compiler/codeGen/CgStackery.lhs
compiler/codeGen/CgUtils.hs
compiler/codeGen/StgCmmUtils.hs
compiler/hsSyn/HsBinds.lhs
compiler/rename/RnEnv.lhs
compiler/simplStg/SRT.lhs
compiler/specialise/Rules.lhs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/utils/ListSetOps.lhs

index 2628760..a869795 100644 (file)
@@ -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 }) }
 
index f971a05..e7d17c1 100644 (file)
@@ -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)]
index dda2260..bb4a653 100644 (file)
@@ -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)]
index 7de9018..26097df 100644 (file)
@@ -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
index 65b34ac..6b01da4 100644 (file)
@@ -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
index bd2fb5e..0d474c5 100644 (file)
@@ -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
index 42c1eda..498302a 100644 (file)
@@ -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}
 
 
index bbda3cf..dd797ab 100644 (file)
@@ -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
 
index d4eb931..eaa3554 100644 (file)
@@ -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
index 930e57d..077eae2 100644 (file)
@@ -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