| ... |
... |
@@ -83,7 +83,7 @@ import Data.List (sortBy) |
|
83
|
83
|
import Data.Function (on)
|
|
84
|
84
|
import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM)
|
|
85
|
85
|
import GHC.Data.SmallArray
|
|
86
|
|
-import GHC.Exts (State#)
|
|
|
86
|
+import GHC.Exts (State#, build)
|
|
87
|
87
|
import GHC.ST (ST(..), runST)
|
|
88
|
88
|
import Unsafe.Coerce
|
|
89
|
89
|
import qualified GHC.Data.Word64Set as W
|
| ... |
... |
@@ -388,10 +388,17 @@ if you don't need the deterministic order at all, use the nonDet functions. |
|
388
|
388
|
--
|
|
389
|
389
|
-- See Note [Sorting a UDFM] and Note [Cost of deterministic iteration].
|
|
390
|
390
|
eltsUDFM :: UniqDFM key elt -> [elt]
|
|
|
391
|
+{-# INLINE eltsUDFM #-} -- so the small case is a good producer
|
|
391
|
392
|
eltsUDFM (UDFM m ub)
|
|
392
|
|
- | M.compareSize m 1 /= GT = map taggedFst (M.elems m)
|
|
393
|
|
- | usePlacement m ub = placementSort ub (\_ tv -> tv) m
|
|
394
|
|
- | otherwise = map taggedFst (sort_it m)
|
|
|
393
|
+ -- n <= 1: any order is trivially tag order, so read straight off the map
|
|
|
394
|
+ | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m)
|
|
|
395
|
+ | otherwise = elts_nonempty m ub
|
|
|
396
|
+
|
|
|
397
|
+-- Precondition: m is non-empty
|
|
|
398
|
+elts_nonempty :: M.Word64Map (TaggedVal elt) -> Int -> [elt]
|
|
|
399
|
+elts_nonempty m ub
|
|
|
400
|
+ | usePlacement m ub = placementSort ub (\_ tv -> tv) m
|
|
|
401
|
+ | otherwise = map taggedFst (sort_it m)
|
|
395
|
402
|
|
|
396
|
403
|
sort_it :: M.Word64Map (TaggedVal elt) -> [TaggedVal elt]
|
|
397
|
404
|
sort_it m = sortBy (compare `on` taggedSnd) (M.elems m)
|
| ... |
... |
@@ -497,11 +504,18 @@ udfmRestrictKeysSet (UDFM val_set i) set = |
|
497
|
504
|
-- as this already incurs most of the cost of returning the full list.
|
|
498
|
505
|
-- See Note [Cost of deterministic iteration].
|
|
499
|
506
|
udfmToList :: UniqDFM key elt -> [(Unique, elt)]
|
|
|
507
|
+{-# INLINE udfmToList #-} -- so the small case is a good producer
|
|
500
|
508
|
udfmToList (UDFM m ub)
|
|
|
509
|
+ -- n <= 1: any order is trivially tag order, so read straight off the map
|
|
501
|
510
|
| M.compareSize m 1 /= GT =
|
|
502
|
|
- [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ]
|
|
503
|
|
-
|
|
504
|
|
- -- Unlike eltsUDFM, this allocates a fresh TaggedVal + pair per element
|
|
|
511
|
+ build (\c n ->
|
|
|
512
|
+ M.foldrWithKey (\k tv r -> c (mkUniqueGrimily k, taggedFst tv) r) n m)
|
|
|
513
|
+ | otherwise = to_list_nonempty m ub
|
|
|
514
|
+
|
|
|
515
|
+-- Precondition: m is non-empty
|
|
|
516
|
+to_list_nonempty :: M.Word64Map (TaggedVal elt) -> Int -> [(Unique, elt)]
|
|
|
517
|
+to_list_nonempty m ub
|
|
|
518
|
+ -- Unlike elts_nonempty, this allocates a fresh TaggedVal + pair per element
|
|
505
|
519
|
-- (they make up the result).
|
|
506
|
520
|
| usePlacement m ub = placementSort ub
|
|
507
|
521
|
(\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m
|