Dhall.Map: Remove the keys list when sorting (#1066)
Also add the unorderedSingleton and unorderedFromList functions. This speeds up the "issue 412" benchmark by ~9% and "union performance" by ~2%.
This commit is contained in:
Simon Jakobi
mergify[bot]
parent
c116207663
commit
3b4f826eda
|
|
@ -15,6 +15,10 @@ module Dhall.Map
|
|||
, fromList
|
||||
, fromListWithKey
|
||||
|
||||
-- * Constructing unordered 'Map's
|
||||
, unorderedSingleton
|
||||
, unorderedFromList
|
||||
|
||||
-- * Sorting
|
||||
, sort
|
||||
, isSorted
|
||||
|
|
@ -60,6 +64,7 @@ import Data.Data (Data)
|
|||
import Data.Semigroup
|
||||
import Prelude hiding (filter, lookup)
|
||||
|
||||
import qualified Data.List
|
||||
import qualified Data.Map
|
||||
import qualified Data.Set
|
||||
import qualified GHC.Exts
|
||||
|
|
@ -72,11 +77,18 @@ import qualified Prelude
|
|||
This is done primarily to avoid a dependency on @insert-ordered-containers@
|
||||
and also to improve performance
|
||||
-}
|
||||
data Map k v = Map (Data.Map.Map k v) [k]
|
||||
data Map k v = Map (Data.Map.Map k v) (Keys k)
|
||||
deriving (Data)
|
||||
|
||||
instance (Eq k, Eq v) => Eq (Map k v) where
|
||||
Map m1 ks == Map m2 ks' = m1 == m2 && ks == ks'
|
||||
data Keys a
|
||||
= Sorted
|
||||
| Original [a]
|
||||
deriving (Data)
|
||||
|
||||
instance (Ord k, Eq v) => Eq (Map k v) where
|
||||
m1 == m2 =
|
||||
Data.Map.size (toMap m1) == Data.Map.size (toMap m2)
|
||||
&& toList m1 == toList m2
|
||||
{-# INLINABLE (==) #-}
|
||||
|
||||
{-|
|
||||
|
|
@ -92,12 +104,10 @@ instance Functor (Map k) where
|
|||
{-# INLINABLE fmap #-}
|
||||
|
||||
instance Ord k => Foldable (Map k) where
|
||||
foldr f z m = foldr f z (elems m)
|
||||
foldr f z (Map m Sorted) = foldr f z m
|
||||
foldr f z m = foldr f z (elems m)
|
||||
{-# INLINABLE foldr #-}
|
||||
|
||||
foldMap f m = foldMap f (elems m)
|
||||
{-# INLINABLE foldMap #-}
|
||||
|
||||
length m = size m
|
||||
{-# INLINABLE length #-}
|
||||
|
||||
|
|
@ -117,7 +127,7 @@ prop> \x -> x <> mempty == (x :: Map Int Int)
|
|||
prop> \x -> mempty <> x == (x :: Map Int Int)
|
||||
-}
|
||||
instance Ord k => Monoid (Map k v) where
|
||||
mempty = Map Data.Map.empty []
|
||||
mempty = Map Data.Map.empty (Original [])
|
||||
{-# INLINABLE mempty #-}
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
|
|
@ -148,7 +158,7 @@ singleton k v = Map m ks
|
|||
where
|
||||
m = Data.Map.singleton k v
|
||||
|
||||
ks = pure k
|
||||
ks = Original [k]
|
||||
{-# INLINABLE singleton #-}
|
||||
|
||||
{-| Create a `Map` from a list of key-value pairs
|
||||
|
|
@ -172,7 +182,7 @@ fromList kvs = Map m ks
|
|||
where
|
||||
m = Data.Map.fromList kvs
|
||||
|
||||
ks = nubOrd (map fst kvs)
|
||||
ks = Original (nubOrd (map fst kvs))
|
||||
{-# INLINABLE fromList #-}
|
||||
|
||||
{-| Create a `Map` from a list of key-value pairs with a combining function.
|
||||
|
|
@ -185,7 +195,7 @@ fromListWithKey f kvs = Map m ks
|
|||
where
|
||||
m = Data.Map.fromListWithKey f kvs
|
||||
|
||||
ks = nubOrd (map fst kvs)
|
||||
ks = Original (nubOrd (map fst kvs))
|
||||
{-# INLINABLE fromListWithKey #-}
|
||||
|
||||
{-| Remove duplicates from a list
|
||||
|
|
@ -204,6 +214,36 @@ nubOrd = go Data.Set.empty
|
|||
| otherwise = k : go (Data.Set.insert k set) ks
|
||||
{-# INLINABLE nubOrd #-}
|
||||
|
||||
{-| Create a `Map` from a single key-value pair.
|
||||
|
||||
Any further operations on this map will not retain the order of the keys.
|
||||
|
||||
>>> unorderedSingleton "A" 1
|
||||
fromList [("A",1)]
|
||||
-}
|
||||
unorderedSingleton :: k -> v -> Map k v
|
||||
unorderedSingleton k v = Map m Sorted
|
||||
where
|
||||
m = Data.Map.singleton k v
|
||||
{-# INLINABLE unorderedSingleton #-}
|
||||
|
||||
{-| Create a `Map` from a list of key-value pairs
|
||||
|
||||
Any further operations on this map will not retain the order of the keys.
|
||||
|
||||
>>> unorderedFromList []
|
||||
fromList []
|
||||
>>> unorderedFromList [("B",1),("A",2)] -- The map /doesn't/ preserve order
|
||||
fromList [("A",2),("B",1)]
|
||||
>>> unorderedFromList [("A",1),("A",2)] -- For duplicates, later values take precedence
|
||||
fromList [("A",2)]
|
||||
-}
|
||||
unorderedFromList :: Ord k => [(k, v)] -> Map k v
|
||||
unorderedFromList kvs = Map m Sorted
|
||||
where
|
||||
m = Data.Map.fromList kvs
|
||||
{-# INLINABLE unorderedFromList #-}
|
||||
|
||||
{-| Sort the keys of a `Map`, forgetting the original ordering
|
||||
|
||||
> sort (sort x) = sort x
|
||||
|
|
@ -211,10 +251,8 @@ nubOrd = go Data.Set.empty
|
|||
>>> sort (fromList [("B",1),("A",2)])
|
||||
fromList [("A",2),("B",1)]
|
||||
-}
|
||||
sort :: Ord k => Map k v -> Map k v
|
||||
sort (Map m _) = Map m ks
|
||||
where
|
||||
ks = Data.Map.keys m
|
||||
sort :: Map k v -> Map k v
|
||||
sort (Map m _) = Map m Sorted
|
||||
{-# INLINABLE sort #-}
|
||||
|
||||
{-| Check if the keys of a `Map` are already sorted
|
||||
|
|
@ -227,7 +265,8 @@ False
|
|||
True
|
||||
-}
|
||||
isSorted :: Eq k => Map k v -> Bool
|
||||
isSorted (Map m k) = Data.Map.keys m == k
|
||||
isSorted (Map _ Sorted) = True
|
||||
isSorted (Map m (Original ks)) = Data.Map.keys m == ks -- Or shortcut to False here?
|
||||
{-# INLINABLE isSorted #-}
|
||||
|
||||
{-| Insert a key-value pair into a `Map`, overriding any previous value stored
|
||||
|
|
@ -241,12 +280,13 @@ fromList [("C",1),("B",2),("A",3)]
|
|||
fromList [("C",1),("A",3)]
|
||||
-}
|
||||
insert :: Ord k => k -> v -> Map k v -> Map k v
|
||||
insert k v (Map m ks) = Map m' ks'
|
||||
insert k v (Map m Sorted) = Map (Data.Map.insert k v m) Sorted
|
||||
insert k v (Map m (Original ks)) = Map m' (Original ks')
|
||||
where
|
||||
m' = Data.Map.insert k v m
|
||||
(mayOldV, m') = Data.Map.insertLookupWithKey (\_k new _old -> new) k v m
|
||||
|
||||
ks' | elem k ks = ks
|
||||
| otherwise = k : ks
|
||||
ks' | Just _ <- mayOldV = ks
|
||||
| otherwise = k : ks
|
||||
{-# INLINABLE insert #-}
|
||||
|
||||
{-| Insert a key-value pair into a `Map`, using the supplied function to combine
|
||||
|
|
@ -258,12 +298,13 @@ fromList [("C",1),("B",2),("A",3)]
|
|||
fromList [("C",3),("A",3)]
|
||||
-}
|
||||
insertWith :: Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v
|
||||
insertWith f k v (Map m ks) = Map m' ks'
|
||||
insertWith f k v (Map m Sorted) = Map (Data.Map.insertWith f k v m) Sorted
|
||||
insertWith f k v (Map m (Original ks)) = Map m' (Original ks')
|
||||
where
|
||||
m' = Data.Map.insertWith f k v m
|
||||
(mayOldV, m') = Data.Map.insertLookupWithKey (\_k new old -> f new old) k v m
|
||||
|
||||
ks' | elem k ks = ks
|
||||
| otherwise = k : ks
|
||||
ks' | Just _ <- mayOldV = ks
|
||||
| otherwise = k : ks
|
||||
{-# INLINABLE insertWith #-}
|
||||
|
||||
{-| Delete a key from a `Map` if present, otherwise return the original `Map`
|
||||
|
|
@ -278,7 +319,9 @@ delete k (Map m ks) = Map m' ks'
|
|||
where
|
||||
m' = Data.Map.delete k m
|
||||
|
||||
ks' = Prelude.filter (k /=) ks
|
||||
ks' = case ks of
|
||||
Sorted -> Sorted
|
||||
Original ks'' -> Original (Data.List.delete k ks'')
|
||||
{-# INLINABLE delete #-}
|
||||
|
||||
{-| Keep all values that satisfy the given predicate
|
||||
|
|
@ -293,9 +336,7 @@ filter predicate (Map m ks) = Map m' ks'
|
|||
where
|
||||
m' = Data.Map.filter predicate m
|
||||
|
||||
set = Data.Map.keysSet m'
|
||||
|
||||
ks' = Prelude.filter (\k -> Data.Set.member k set) ks
|
||||
ks' = filterKeys (\k -> Data.Map.member k m') ks
|
||||
{-# INLINABLE filter #-}
|
||||
|
||||
{-| Transform all values in a `Map` using the supplied function, deleting the
|
||||
|
|
@ -309,9 +350,7 @@ mapMaybe f (Map m ks) = Map m' ks'
|
|||
where
|
||||
m' = Data.Map.mapMaybe f m
|
||||
|
||||
set = Data.Map.keysSet m'
|
||||
|
||||
ks' = Prelude.filter (\k -> Data.Set.member k set) ks
|
||||
ks' = filterKeys (\k -> Data.Map.member k m') ks
|
||||
{-# INLINABLE mapMaybe #-}
|
||||
|
||||
{-| Retrieve a key from a `Map`
|
||||
|
|
@ -342,8 +381,12 @@ Just ("C",1,fromList [("B",2),("A",3)])
|
|||
Nothing
|
||||
-}
|
||||
uncons :: Ord k => Map k v -> Maybe (k, v, Map k v)
|
||||
uncons (Map _ []) = Nothing
|
||||
uncons (Map m (k:ks)) = Just (k, m Data.Map.! k, Map (Data.Map.delete k m) ks)
|
||||
uncons (Map _ (Original [])) = Nothing
|
||||
uncons (Map m (Original (k:ks))) =
|
||||
Just (k, m Data.Map.! k, Map (Data.Map.delete k m) (Original ks))
|
||||
uncons (Map m Sorted)
|
||||
| Just ((k, v), m') <- Data.Map.minViewWithKey m = Just (k, v, Map m' Sorted)
|
||||
| otherwise = Nothing
|
||||
{-# INLINABLE uncons #-}
|
||||
|
||||
{-| Check if a key belongs to a `Map`
|
||||
|
|
@ -383,9 +426,10 @@ union (Map mL ksL) (Map mR ksR) = Map m ks
|
|||
where
|
||||
m = Data.Map.union mL mR
|
||||
|
||||
setL = Data.Map.keysSet mL
|
||||
|
||||
ks = ksL <|> Prelude.filter (\k -> Data.Set.notMember k setL) ksR
|
||||
ks = case (ksL, ksR) of
|
||||
(Original l, Original r) -> Original $
|
||||
l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r
|
||||
_ -> Sorted
|
||||
{-# INLINABLE union #-}
|
||||
|
||||
{-| Combine two `Map`s using a combining function for colliding keys
|
||||
|
|
@ -400,9 +444,10 @@ unionWith combine (Map mL ksL) (Map mR ksR) = Map m ks
|
|||
where
|
||||
m = Data.Map.unionWith combine mL mR
|
||||
|
||||
setL = Data.Map.keysSet mL
|
||||
|
||||
ks = ksL <|> Prelude.filter (\k -> Data.Set.notMember k setL) ksR
|
||||
ks = case (ksL, ksR) of
|
||||
(Original l, Original r) -> Original $
|
||||
l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r
|
||||
_ -> Sorted
|
||||
{-# INLINABLE unionWith #-}
|
||||
|
||||
{-| Combine two `Map` on their shared keys, keeping the value from the first
|
||||
|
|
@ -418,10 +463,8 @@ intersection (Map mL ksL) (Map mR _) = Map m ks
|
|||
where
|
||||
m = Data.Map.intersection mL mR
|
||||
|
||||
setL = Data.Map.keysSet mL
|
||||
setR = Data.Map.keysSet mR
|
||||
set = Data.Set.intersection setL setR
|
||||
ks = Prelude.filter (\k -> Data.Set.member k set) ksL
|
||||
-- Or forget order unless both maps are ordered?!
|
||||
ks = filterKeys (\k -> Data.Map.member k m) ksL
|
||||
{-# INLINABLE intersection #-}
|
||||
|
||||
{-| Combine two `Map`s on their shared keys, using the supplied function to
|
||||
|
|
@ -435,10 +478,8 @@ intersectionWith combine (Map mL ksL) (Map mR _) = Map m ks
|
|||
where
|
||||
m = Data.Map.intersectionWith combine mL mR
|
||||
|
||||
setL = Data.Map.keysSet mL
|
||||
setR = Data.Map.keysSet mR
|
||||
set = Data.Set.intersection setL setR
|
||||
ks = Prelude.filter (\k -> Data.Set.member k set) ksL
|
||||
-- Or forget order unless both maps are ordered?!
|
||||
ks = filterKeys (\k -> Data.Map.member k m) ksL
|
||||
{-# INLINABLE intersectionWith #-}
|
||||
|
||||
{-| Compute the difference of two `Map`s by subtracting all keys from the
|
||||
|
|
@ -452,9 +493,7 @@ difference (Map mL ksL) (Map mR _) = Map m ks
|
|||
where
|
||||
m = Data.Map.difference mL mR
|
||||
|
||||
setR = Data.Map.keysSet mR
|
||||
|
||||
ks = Prelude.filter (\k -> Data.Set.notMember k setR) ksL
|
||||
ks = filterKeys (\k -> Data.Map.notMember k mR) ksL
|
||||
{-# INLINABLE difference #-}
|
||||
|
||||
{-| Fold all of the key-value pairs in a `Map`, in their original order
|
||||
|
|
@ -463,7 +502,8 @@ difference (Map mL ksL) (Map mR _) = Map m ks
|
|||
("BA",[1,2])
|
||||
-}
|
||||
foldMapWithKey :: (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m
|
||||
foldMapWithKey f m = foldMap (uncurry f) (toList m)
|
||||
foldMapWithKey f (Map m Sorted) = Data.Map.foldMapWithKey f m
|
||||
foldMapWithKey f m = foldMap (uncurry f) (toList m)
|
||||
{-# INLINABLE foldMapWithKey #-}
|
||||
|
||||
{-| Transform the values of a `Map` using their corresponding key
|
||||
|
|
@ -492,6 +532,8 @@ mapWithKey f (Map m ks) = Map m' ks
|
|||
-}
|
||||
traverseWithKey
|
||||
:: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b)
|
||||
traverseWithKey f (Map m Sorted) =
|
||||
fmap (\m' -> Map m' Sorted) (Data.Map.traverseWithKey f m)
|
||||
traverseWithKey f m =
|
||||
fmap fromList (traverse f' (toList m))
|
||||
where
|
||||
|
|
@ -525,7 +567,8 @@ unorderedTraverseWithKey_ f (Map m _) =
|
|||
[("B",1),("A",2)]
|
||||
-}
|
||||
toList :: Ord k => Map k v -> [(k, v)]
|
||||
toList (Map m ks) = fmap (\k -> (k, m Data.Map.! k)) ks
|
||||
toList (Map m Sorted) = Data.Map.toList m
|
||||
toList (Map m (Original ks)) = fmap (\k -> (k, m Data.Map.! k)) ks
|
||||
{-# INLINABLE toList #-}
|
||||
|
||||
{-| Convert a @"Dhall.Map".`Map`@ to a @"Data.Map".`Data.Map.Map`@
|
||||
|
|
@ -543,7 +586,8 @@ toMap (Map m _) = m
|
|||
["B","A"]
|
||||
-}
|
||||
keys :: Map k v -> [k]
|
||||
keys (Map _ ks) = ks
|
||||
keys (Map m Sorted) = Data.Map.keys m
|
||||
keys (Map _ (Original ks)) = ks
|
||||
{-# INLINABLE keys #-}
|
||||
|
||||
{-| Return the values from a `Map` in their original order.
|
||||
|
|
@ -552,13 +596,19 @@ keys (Map _ ks) = ks
|
|||
[1,2]
|
||||
-}
|
||||
elems :: Ord k => Map k v -> [v]
|
||||
elems (Map m ks) = fmap (\k -> m Data.Map.! k) ks
|
||||
elems (Map m Sorted) = Data.Map.elems m
|
||||
elems (Map m (Original ks)) = fmap (\k -> m Data.Map.! k) ks
|
||||
{-# INLINABLE elems #-}
|
||||
|
||||
filterKeys :: (a -> Bool) -> Keys a -> Keys a
|
||||
filterKeys _ Sorted = Sorted
|
||||
filterKeys f (Original ks) = Original (Prelude.filter f ks)
|
||||
{-# INLINABLE filterKeys #-}
|
||||
|
||||
{- $setup
|
||||
>>> import Test.QuickCheck (Arbitrary(..))
|
||||
>>> import Test.QuickCheck (Arbitrary(..), oneof)
|
||||
>>> :{
|
||||
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
|
||||
arbitrary = fromList <$> arbitrary
|
||||
arbitrary = oneof [fromList <$> arbitrary, unorderedFromList <$> arbitrary]
|
||||
:}
|
||||
-}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user