Skip to content
Snippets Groups Projects
Unverified Commit d86f6886 authored by Niklas Haas's avatar Niklas Haas Committed by Mateusz Kowalczyk
Browse files

Get rid of re-implementation of sortBy


I have no idea what this was doing lying around here, and due to the
usage of tuples it's actually slower, too.

Signed-off-by: default avatarMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
parent 7e53f628
No related branches found
No related tags found
5 merge requests!38Make --no-tmp-comp-dir the default,!37Adapt to latest xhtml version, various optimizations,!31Support HsToken in DataDecl and ClassDecl,!12Drop orphan instance when defined upstream.,!10Haddock interfaces produced from `.hi` files
......@@ -19,6 +19,7 @@ import Haddock.Convert
import Control.Arrow
import Data.List
import Data.Ord (comparing)
import qualified Data.Map as Map
import qualified Data.Set as Set
......@@ -67,12 +68,12 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
case mb_info of
Just (_, _, cls_instances, fam_instances) ->
let fam_insts = [ (synifyFamInst i, n)
| i <- sortImage instFam fam_instances
| i <- sortBy (comparing instFam) fam_instances
, let n = lookupInstDoc (getName i) iface ifaceMap instIfaceMap
]
cls_insts = [ (synifyInstHead i, lookupInstDoc n iface ifaceMap instIfaceMap)
| let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
, (i@(_,_,cls,tys), n) <- sortImage (first instHead) is
, (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
, not $ isInstanceHidden expInfo cls tys
]
in cls_insts ++ fam_insts
......@@ -163,11 +164,6 @@ instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
= (map argCount ts, n, map simplify ts, argCount t, simplify t)
-- sortImage f = sortBy (\x y -> compare (f x) (f y))
sortImage :: Ord b => (a -> b) -> [a] -> [a]
sortImage f xs = map snd $ sortBy cmp_fst [(f x, x) | x <- xs]
where cmp_fst (x,_) (y,_) = compare x y
funTyConName :: Name
funTyConName = mkWiredInName gHC_PRIM
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment