Skip to content

Commit

Permalink
singleton, insert, insertWith and insertWithKey now operate on subtrees
Browse files Browse the repository at this point in the history
  • Loading branch information
@bovinespirit
bovinespirit committed Nov 5, 2012
1 parent ea1ece0 commit 5091d4c
Show file tree
Hide file tree
Showing 6 changed files with 238 additions and 154 deletions.
58 changes: 33 additions & 25 deletions Data/EnumMapMap/Base.hs
View file
Expand Up @@ -153,7 +153,13 @@ type family Plus k1 k2 :: *
type instance Plus (k1 :& t) k2 = k1 :& Plus t k2 type instance Plus (k1 :& t) k2 = k1 :& Plus t k2


class SubKey k1 k2 v where 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 :: * 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'. -- | Lookup up the value at a key in the 'EnumMapMap'.
-- --
-- > emm = fromList [(3 :& K 1, "a")] -- > emm = fromList [(3 :& K 1, "a")]
Expand All @@ -168,6 +174,18 @@ class SubKey k1 k2 v where
-- --
lookup :: (IsKey k1, IsKey k2) => lookup :: (IsKey k1, IsKey k2) =>
k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v) 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 -- | Remove a key and it's value from the 'EnumMapMap'. If the key is not
-- present the original 'EnumMapMap' is returned. -- present the original 'EnumMapMap' is returned.
delete :: (IsKey k1, IsKey k2) => delete :: (IsKey k1, IsKey k2) =>
Expand All @@ -176,6 +194,9 @@ class SubKey k1 k2 v where
instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) => instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
SubKey (k :& t1) (k :& t2) v where SubKey (k :& t1) (k :& t2) v where
type Result (k :& t1) (k :& t2) v = Result t1 t2 v 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 lookup !(key' :& nxt) (KCC emm) = key `seq` go emm
where where
go (Bin _ m l r) go (Bin _ m l r)
Expand All @@ -187,6 +208,15 @@ instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
False -> Nothing False -> Nothing
go Nil = Nothing go Nil = Nothing
key = fromEnum key' 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) = delete !(key :& nxt) (KCC emm) =
KCC $ alter_ (delete nxt) (fromEnum key) emm KCC $ alter_ (delete nxt) (fromEnum key) emm


Expand Down Expand Up @@ -265,19 +295,6 @@ class (Eq k) => IsKey k where
size :: EnumMapMap k v -> Int size :: EnumMapMap k v -> Int
-- | Is the key present in the 'EnumMapMap'? -- | Is the key present in the 'EnumMapMap'?
member :: k -> EnumMapMap k v -> Bool 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. -- | 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' 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 alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v
Expand All @@ -293,10 +310,11 @@ class (Eq k) => IsKey k where
-- binary operator. -- binary operator.
foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t
-- | Convert the 'EnumMapMap' to a list of key\/value pairs. -- | 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) [] toList = foldrWithKey (\k x xs -> (k, x):xs) []
-- | Create a 'EnumMapMap' from a list of key\/value pairs. -- | 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 fromList = foldlStrict (\t (k, x) -> insert k x t) empty
-- | List of elements in ascending order of keys -- | List of elements in ascending order of keys
elems :: EnumMapMap k v -> [v] elems :: EnumMapMap k v -> [v]
Expand Down Expand Up @@ -400,16 +418,6 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
Nil -> False Nil -> False
key = fromEnum key' 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) = alter f !(key :& nxt) (KCC emm) =
KCC $ alter_ (alter f nxt) (fromEnum key) emm KCC $ alter_ (alter f nxt) (fromEnum key) emm


Expand Down
65 changes: 37 additions & 28 deletions Data/EnumMapMap/Lazy.hs
View file
Expand Up @@ -143,33 +143,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False Nil -> False
key = fromEnum key' 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 alter f !(K key') (KEC emm) = KEC $ go emm
where where
go t = case t of go t = case t of
Expand Down Expand Up @@ -275,12 +248,20 @@ instance IsSplit (k :& t) Z where


instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v 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 delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm


instance (Enum k) => SubKey (K k) (K k) v where instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v type Result (K k) (K k) v = v
singleton !(K key) = KEC . Tip (fromEnum key)
lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm 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 delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm


lookup_ :: Key -> EMM k v -> Maybe v lookup_ :: Key -> EMM k v -> Maybe v
Expand All @@ -292,6 +273,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing Tip kx x -> if kx == key then Just x else Nothing
Nil -> 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 k v -> EMM k v
delete_ !key emm = delete_ !key emm =
case emm of case emm of
Expand Down
63 changes: 36 additions & 27 deletions Data/EnumMapMap/Strict.hs
View file
Expand Up @@ -144,33 +144,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> False Nil -> False
key = fromEnum key' 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 alter f !(K key') (KEC emm) = KEC $ go emm
where where
go t = case t of go t = case t of
Expand Down Expand Up @@ -276,12 +249,20 @@ instance IsSplit (k :& t) Z where


instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v 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 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 delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm


instance (Enum k) => SubKey (K k) (K k) v where instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v 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 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 delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm


lookup_ :: Key -> EMM k v -> Maybe v lookup_ :: Key -> EMM k v -> Maybe v
Expand All @@ -293,6 +274,34 @@ lookup_ !key emm =
Tip kx x -> if kx == key then Just x else Nothing Tip kx x -> if kx == key then Just x else Nothing
Nil -> 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 k v -> EMM k v
delete_ !key emm = delete_ !key emm =
case emm of case emm of
Expand Down

0 comments on commit 5091d4c

Please sign in to comment.