Permalink
Browse files

singleton, insert, insertWith and insertWithKey now operate on subtrees

  • Loading branch information...
bovinespirit committed Nov 5, 2012
1 parent ea1ece0 commit 5091d4c3f7944176abb6d2c273885457d48617de
Showing with 238 additions and 154 deletions.
  1. +33 −25 Data/EnumMapMap/Base.hs
  2. +37 −28 Data/EnumMapMap/Lazy.hs
  3. +36 −27 Data/EnumMapMap/Strict.hs
  4. +52 −25 Data/EnumMapSet/Base.hs
  5. +1 −1 test/EnumMapSetVsIntSet.hs
  6. +79 −48 test/UnitEnumMapMap.hs
View
@@ -153,7 +153,13 @@ type family Plus k1 k2 :: *
type instance Plus (k1 :& t) k2 = k1 :& Plus t k2
class SubKey k1 k2 v where
+ -- k1 should be a prefix of k2. If @k1 ~ k2@ then the 'Result' will be @v@.
type Result k1 k2 v :: *
+ -- | An 'EnumMapMap' with one element
+ --
+ -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
+ -- > singleton (K 5) $ singleton (K 2) "a" == fromList [(5 :& K 3, "a")]
+ singleton :: k1 -> Result k1 k2 v -> EnumMapMap k2 v
-- | Lookup up the value at a key in the 'EnumMapMap'.
--
-- > emm = fromList [(3 :& K 1, "a")]
@@ -168,6 +174,18 @@ class SubKey k1 k2 v where
--
lookup :: (IsKey k1, IsKey k2) =>
k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v)
+ -- | Insert a new key\/value pair into the 'EnumMapMap'. Can also insert submaps.
+ insert :: (IsKey k1, IsKey k2) =>
+ k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+ -- | Insert with a combining function. Can also insert submaps.
+ insertWith :: (IsKey k1, IsKey k2) =>
+ (Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
+ -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+ insertWith f = insertWithKey (\_ -> f)
+ -- | Insert with a combining function. Can also insert submaps.
+ insertWithKey :: (IsKey k1, IsKey k2) =>
+ (k1 -> Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
+ -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
-- | Remove a key and it's value from the 'EnumMapMap'. If the key is not
-- present the original 'EnumMapMap' is returned.
delete :: (IsKey k1, IsKey k2) =>
@@ -176,6 +194,9 @@ class SubKey k1 k2 v where
instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
SubKey (k :& t1) (k :& t2) v where
type Result (k :& t1) (k :& t2) v = Result t1 t2 v
+
+ singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
+
lookup !(key' :& nxt) (KCC emm) = key `seq` go emm
where
go (Bin _ m l r)
@@ -187,6 +208,15 @@ instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
False -> Nothing
go Nil = Nothing
key = fromEnum key'
+
+ insert (key :& nxt) val (KCC emm) =
+ KCC $ insertWith_ (insert nxt val) key (singleton nxt val) emm
+
+ insertWithKey f k@(key :& nxt) val (KCC emm) =
+ KCC $ insertWith_ go key (singleton nxt val) emm
+ where
+ go = insertWithKey (\_ -> f k) nxt val
+
delete !(key :& nxt) (KCC emm) =
KCC $ alter_ (delete nxt) (fromEnum key) emm
@@ -265,19 +295,6 @@ class (Eq k) => IsKey k where
size :: EnumMapMap k v -> Int
-- | Is the key present in the 'EnumMapMap'?
member :: k -> EnumMapMap k v -> Bool
- -- | An 'EnumMapMap' with one element
- --
- -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
- singleton :: k -> v -> EnumMapMap k v
- -- | Insert a new key\/value pair into the 'EnumMapMap'.
- insert :: k -> v -> EnumMapMap k v -> EnumMapMap k v
- -- | Insert with a combining function.
- insertWith :: (v -> v -> v)
- -> k -> v -> EnumMapMap k v -> EnumMapMap k v
- insertWith f = insertWithKey (\_ -> f)
- -- | Insert with a combining function.
- insertWithKey :: (k -> v -> v -> v)
- -> k -> v -> EnumMapMap k v -> EnumMapMap k v
-- | The expression (@'alter' f k emm@) alters the value at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in an 'EnumMapMap'.
alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v
@@ -293,10 +310,11 @@ class (Eq k) => IsKey k where
-- binary operator.
foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t
-- | Convert the 'EnumMapMap' to a list of key\/value pairs.
- toList :: EnumMapMap k v -> [(k, v)]
+ toList :: SubKey k k v =>
+ EnumMapMap k v -> [(k, v)]
toList = foldrWithKey (\k x xs -> (k, x):xs) []
-- | Create a 'EnumMapMap' from a list of key\/value pairs.
- fromList :: [(k, v)] -> EnumMapMap k v
+ fromList :: (SubKey k k v, Result k k v ~ v) => [(k, v)] -> EnumMapMap k v
fromList = foldlStrict (\t (k, x) -> insert k x t) empty
-- | List of elements in ascending order of keys
elems :: EnumMapMap k v -> [v]
@@ -400,16 +418,6 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
Nil -> False
key = fromEnum key'
- singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
-
- insert (key :& nxt) val (KCC emm)
- = KCC $ insertWith_ (insert nxt val) key (singleton nxt val) emm
-
- insertWithKey f k@(key :& nxt) val (KCC emm) =
- KCC $ insertWith_ go key (singleton nxt val) emm
- where
- go = insertWithKey (\_ -> f k) nxt val
-
alter f !(key :& nxt) (KCC emm) =
KCC $ alter_ (alter f nxt) (fromEnum key) emm
View
@@ -143,33 +143,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False
key = fromEnum key'
- singleton !(K key) = KEC . Tip (fromEnum key)
-
- insert !(K key') val (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky _
- | key == ky -> Tip key val
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
- insertWithKey f k@(K key') val (KEC emm) = KEC $ go emm
- where go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky y
- | key == ky -> Tip key (f k val y)
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -275,12 +248,20 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
- lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ singleton !(K key) = KCC . Tip (fromEnum key)
+ lookup !(K key') (KCC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KCC emm) =
+ KCC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
+ singleton !(K key) = KEC . Tip (fromEnum key)
lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KEC emm) =
+ KEC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
lookup_ :: Key -> EMM k v -> Maybe v
@@ -292,6 +273,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing
Nil -> Nothing
+insert_ :: Key -> v -> EMM k v -> EMM k v
+insert_ !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky _
+ | key == ky -> Tip key val
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
+insertWK :: (v -> v -> v) -> Key -> v -> EMM k v -> EMM k v
+insertWK f !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky y
+ | key == ky -> Tip key (f val y)
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
delete_ :: Key -> EMM k v -> EMM k v
delete_ !key emm =
case emm of
View
@@ -144,33 +144,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False
key = fromEnum key'
- singleton !(K key) !val = KEC $ Tip (fromEnum key) val
-
- insert !(K key') !val (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky _
- | key == ky -> Tip key val
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
- insertWithKey f k@(K key') !val (KEC emm) = KEC $ go emm
- where go t = case t of
- Bin p m l r
- | nomatch key p m -> join key (Tip key val) p t
- | zero key m -> Bin p m (go l) r
- | otherwise -> Bin p m l (go r)
- Tip ky y
- | key == ky -> Tip key $! (f k val y)
- | otherwise -> join key (Tip key val) ky t
- Nil -> Tip key val
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -276,12 +249,20 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
+ singleton !(K key) = KCC . Tip (fromEnum key)
lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') val (KCC emm) =
+ KCC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
+ singleton !(K key) !val = KEC $! Tip (fromEnum key) val
lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ insert !(K key') !val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
+ insertWithKey f !k@(K key') !val (KEC emm) =
+ KEC $ insertWK (f k) (fromEnum key') val emm
delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
lookup_ :: Key -> EMM k v -> Maybe v
@@ -293,6 +274,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing
Nil -> Nothing
+insert_ :: Key -> v -> EMM k v -> EMM k v
+insert_ !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky _
+ | key == ky -> Tip key val
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
+insertWK :: (v -> v -> v) -> Key -> v -> EMM k v -> EMM k v
+insertWK f !key val = go
+ where
+ go emm =
+ case emm of
+ Bin p m l r
+ | nomatch key p m -> join key (Tip key val) p emm
+ | zero key m -> Bin p m (go l) r
+ | otherwise -> Bin p m l (go r)
+ Tip ky y
+ | key == ky -> Tip key (f val y)
+ | otherwise -> join key (Tip key val) ky emm
+ Nil -> Tip key val
+
delete_ :: Key -> EMM k v -> EMM k v
delete_ !key emm =
case emm of
Oops, something went wrong.

0 comments on commit 5091d4c

Please sign in to comment.