Commit 1a137b03 authored by Ian Lynagh's avatar Ian Lynagh

Change more uses of sortLe to sortBy

parent 0043f07a
......@@ -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 }) }
......
......@@ -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)]
......
......@@ -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)]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
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