module Data.Edison.Assoc.PatriciaLoMap (
FM,
empty,singleton,fromSeq,insert,insertSeq,union,unionSeq,delete,deleteAll,
deleteSeq,null,size,member,count,lookup,lookupM,lookupAll,
lookupAndDelete,lookupAndDeleteM,lookupAndDeleteAll,strict,strictWith,
lookupWithDefault,adjust,adjustAll,adjustOrInsert,adjustAllOrInsert,map,
fold,fold',fold1,fold1',filter,partition,elements,structuralInvariant,
toSeq,keys,mapWithKey,foldWithKey,foldWithKey',filterWithKey,partitionWithKey,
fromSeqWith,fromSeqWithKey,insertWith,insertWithKey,insertSeqWith,
insertSeqWithKey,unionl,unionr,unionWith,unionSeqWith,intersectionWith,
difference,properSubset,subset,properSubmapBy,submapBy,sameMapBy,
properSubmap,submap,sameMap,
unionWithKey,unionSeqWithKey,intersectionWithKey,
minView, minElem, deleteMin, unsafeInsertMin,
maxView, maxElem, deleteMax, unsafeInsertMax,
foldr, foldr', foldr1, foldr1', foldl, foldl', foldl1, foldl1',
unsafeFromOrdSeq, unsafeAppend, filterLT, filterLE, filterGT, filterGE,
partitionLT_GE, partitionLE_GT, partitionLT_GT,
minViewWithKey, minElemWithKey, maxViewWithKey, maxElemWithKey,
foldrWithKey, foldrWithKey', foldlWithKey, foldlWithKey',
toOrdSeq,
moduleName
) where
import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter)
import qualified Prelude
import Control.Monad.Identity (runIdentity)
import Data.Monoid
import Data.Semigroup as SG
import qualified Data.Edison.Assoc as A
import qualified Data.Edison.Seq as S
import qualified Data.Edison.Seq.ListSeq as L
import Data.Edison.Assoc.Defaults
import Data.Int
import Data.Bits
import Test.QuickCheck (Arbitrary(..), CoArbitrary(..), variant)
moduleName :: String
moduleName = "Data.Edison.Assoc.PatriciaLoMap"
data FM a
= E
| L Int a
| B Int Int !(FM a) !(FM a)
structuralInvariant :: FM a -> Bool
structuralInvariant E = True
structuralInvariant (L _ _) = True
structuralInvariant x = inv 0 0 x
inv :: Int -> Int -> FM a -> Bool
inv _ _ E = False
inv pre msk (L k _) = k .&. msk == pre
inv pre msk (B p m t0 t1) =
(p .&. msk == pre) &&
(bitcount 0 m == 1) &&
(p .&. (complement (m 1)) == 0) &&
inv p0 msk' t0 &&
inv p1 msk' t1
where p0 = p
p1 = p .|. m
msk' = (m `shiftL` 1) 1
bitcount :: Int -> Int -> Int
bitcount a 0 = a
bitcount a x = a `seq` bitcount (a+1) (x .&. (x1))
makeB :: Int -> Int -> FM t -> FM t -> FM t
makeB _ _ E t = t
makeB _ _ t E = t
makeB p m t0 t1 = B p m t0 t1
lmakeB :: Int -> Int -> FM t -> FM t -> FM t
lmakeB _ _ E t = t
lmakeB p m t0 t1 = B p m t0 t1
rmakeB :: Int -> Int -> FM a -> FM a -> FM a
rmakeB _ _ t E = t
rmakeB p m t0 t1 = B p m t0 t1
lowestBit :: Int32 -> Int32
lowestBit x = x .&. (x)
branchingBit :: Int -> Int -> Int
branchingBit p0 p1 =
fromIntegral (lowestBit (fromIntegral p0 `xor` fromIntegral p1))
mask :: Int -> Int -> Int
mask p m = fromIntegral (fromIntegral p .&. (fromIntegral m (1 :: Int32)))
zeroBit :: Int -> Int -> Bool
zeroBit p m = (fromIntegral p) .&. (fromIntegral m) == (0 :: Int32)
matchPrefix :: Int -> Int -> Int -> Bool
matchPrefix k p m = mask k m == p
join :: Int -> FM a -> Int -> FM a -> FM a
join p0 t0 p1 t1 =
let m = branchingBit p0 p1
in if zeroBit p0 m then B (mask p0 m) m t0 t1
else B (mask p0 m) m t1 t0
keepR :: forall t t1. t -> t1 -> t1
keepR _ y = y
empty :: FM a
empty = E
singleton :: Int -> a -> FM a
singleton k x = L k x
fromSeq :: S.Sequence seq => seq (Int,a) -> FM a
fromSeq = S.foldl (\t (k, x) -> insert k x t) E
insert :: Int -> a -> FM a -> FM a
insert k x E = L k x
insert k x t@(L j _) = if j == k then L k x else join k (L k x) j t
insert k x t@(B p m t0 t1) =
if matchPrefix k p m then
if zeroBit k m then B p m (insert k x t0) t1
else B p m t0 (insert k x t1)
else join k (L k x) p t
union :: FM a -> FM a -> FM a
union s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then B p m (union s0 t) s1
else B p m s0 (union s1 t)
else join p s q t
| m > n = if matchPrefix p q n then
if zeroBit p n then B q n (union s t0) t1
else B q n t0 (union s t1)
else join p s q t
| otherwise = if p == q then B p m (union s0 t0) (union s1 t1)
else join p s q t
union s@(B p m s0 s1) (L k x) =
if matchPrefix k p m then
if zeroBit k m then B p m (insert k x s0) s1
else B p m s0 (insert k x s1)
else join k (L k x) p s
union s@(B _ _ _ _) E = s
union (L k x) t = insert k x t
union E t = t
delete :: Int -> FM a -> FM a
delete _ E = E
delete k t@(L j _) = if k == j then E else t
delete k t@(B p m t0 t1) =
if matchPrefix k p m then
if zeroBit k m then lmakeB p m (delete k t0) t1
else rmakeB p m t0 (delete k t1)
else t
null :: FM a -> Bool
null E = True
null _ = False
size :: FM a -> Int
size E = 0
size (L _ _) = 1
size (B _ _ t0 t1) = size t0 + size t1
member :: Int -> FM a -> Bool
member _ E = False
member k (L j _) = (j == k)
member k (B _ m t0 t1) = if zeroBit k m then member k t0 else member k t1
lookup :: Int -> FM a -> a
lookup k m = runIdentity (lookupM k m)
lookupM :: (Monad rm) => Int -> FM a -> rm a
lookupM _ E = fail "PatriciaLoMap.lookup: lookup failed"
lookupM k (L j x)
| j == k = return x
| otherwise = fail "PatriciaLoMap.lookup: lookup failed"
lookupM k (B _ m t0 t1) = if zeroBit k m then lookupM k t0 else lookupM k t1
doLookupAndDelete :: z -> (a -> FM a -> z) -> Int -> FM a -> z
doLookupAndDelete onFail _ _ E = onFail
doLookupAndDelete onFail cont k (L j x)
| j == k = cont x E
| otherwise = onFail
doLookupAndDelete onFail cont k (B p m t0 t1)
| zeroBit k m = doLookupAndDelete onFail (\x t0' -> cont x (makeB p m t0' t1)) k t0
| otherwise = doLookupAndDelete onFail (\x t1' -> cont x (makeB p m t0 t1')) k t1
lookupAndDelete :: Int -> FM a -> (a, FM a)
lookupAndDelete = doLookupAndDelete
(error "PatriciaLoMap.lookupAndDelete: lookup failed")
(,)
lookupAndDeleteM :: Monad m => Int -> FM a -> m (a, FM a)
lookupAndDeleteM = doLookupAndDelete
(fail "PatriciaLoMap.lookupAndDelete: lookup failed")
(\x m -> return (x,m))
lookupAndDeleteAll :: S.Sequence seq => Int -> FM a -> (seq a,FM a)
lookupAndDeleteAll k m = doLookupAndDelete
(S.empty, m)
(\x m' -> (S.singleton x,m'))
k m
adjust :: (a -> a) -> Int -> FM a -> FM a
adjust _ _ E = E
adjust f k t@(L j x) = if k == j then L k (f x) else t
adjust f k t@(B p m t0 t1) =
if matchPrefix k p m then
if zeroBit k m then B p m (adjust f k t0) t1
else B p m t0 (adjust f k t1)
else t
adjustOrInsert :: (a -> a) -> a -> Int -> FM a -> FM a
adjustOrInsert = adjustOrInsertUsingMember
adjustAllOrInsert :: (a -> a) -> a -> Int -> FM a -> FM a
adjustAllOrInsert = adjustOrInsertUsingMember
adjustOrDelete :: (a -> Maybe a) -> Int -> FM a -> FM a
adjustOrDelete = adjustOrDeleteDefault
adjustOrDeleteAll :: (a -> Maybe a) -> Int -> FM a -> FM a
adjustOrDeleteAll = adjustOrDeleteDefault
map :: (a -> b) -> FM a -> FM b
map _ E = E
map f (L k x) = L k (f x)
map f (B p m t0 t1) = B p m (map f t0) (map f t1)
fold :: (a -> b -> b) -> b -> FM a -> b
fold _ c E = c
fold f c (L _ x) = f x c
fold f c (B _ _ t0 t1) = fold f (fold f c t1) t0
fold' :: (a -> b -> b) -> b -> FM a -> b
fold' _ c E = c
fold' f c (L _ x) = c `seq` f x c
fold' f c (B _ _ t0 t1) = c `seq` (fold f $! (fold f c t1)) t0
fold1 :: (a -> a -> a) -> FM a -> a
fold1 _ E = error "PatriciaLoMap.fold1: empty map"
fold1 _ (L _ x) = x
fold1 f (B _ _ t0 t1) = f (fold1 f t0) (fold1 f t1)
fold1' :: (a -> a -> a) -> FM a -> a
fold1' _ E = error "PatriciaLoMap.fold1: empty map"
fold1' _ (L _ x) = x
fold1' f (B _ _ t0 t1) = f (fold1' f t0) $! (fold1' f t1)
filter :: (a -> Bool) -> FM a -> FM a
filter _ E = E
filter g t@(L _ x) = if g x then t else E
filter g (B p m t0 t1) = makeB p m (filter g t0) (filter g t1)
partition :: (a -> Bool) -> FM a -> (FM a, FM a)
partition _ E = (E, E)
partition g t@(L _ x) = if g x then (t, E) else (E, t)
partition g (B p m t0 t1) =
let (t0',t0'') = partition g t0
(t1',t1'') = partition g t1
in (makeB p m t0' t1', makeB p m t0'' t1'')
fromSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> FM a
fromSeqWith f = S.foldl (\t (k, x) -> insertWith f k x t) E
insertWith :: (a -> a -> a) -> Int -> a -> FM a -> FM a
insertWith _ k x E = L k x
insertWith f k x t@(L j y) = if j == k then L k (f x y) else join k (L k x) j t
insertWith f k x t@(B p m t0 t1) =
if matchPrefix k p m then
if zeroBit k m then B p m (insertWith f k x t0) t1
else B p m t0 (insertWith f k x t1)
else join k (L k x) p t
unionl :: FM a -> FM a -> FM a
unionl s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then B p m (unionl s0 t) s1
else B p m s0 (unionl s1 t)
else join p s q t
| m > n = if matchPrefix p q n then
if zeroBit p n then B q n (unionl s t0) t1
else B q n t0 (unionl s t1)
else join p s q t
| otherwise = if p == q then B p m (unionl s0 t0) (unionl s1 t1)
else join p s q t
unionl s@(B p m s0 s1) (L k x) =
if matchPrefix k p m then
if zeroBit k m then B p m (insertWith keepR k x s0) s1
else B p m s0 (insertWith keepR k x s1)
else join k (L k x) p s
unionl s@(B _ _ _ _) E = s
unionl (L k x) t = insert k x t
unionl E t = t
unionr :: FM a -> FM a -> FM a
unionr s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then B p m (unionr s0 t) s1
else B p m s0 (unionr s1 t)
else join p s q t
| m > n = if matchPrefix p q n then
if zeroBit p n then B q n (unionr s t0) t1
else B q n t0 (unionr s t1)
else join p s q t
| otherwise = if p == q then B p m (unionr s0 t0) (unionr s1 t1)
else join p s q t
unionr s@(B p m s0 s1) (L k x) =
if matchPrefix k p m then
if zeroBit k m then B p m (insert k x s0) s1
else B p m s0 (insert k x s1)
else join k (L k x) p s
unionr s@(B _ _ _ _) E = s
unionr (L k x) t = insertWith keepR k x t
unionr E t = t
unionWith :: (a -> a -> a) -> FM a -> FM a -> FM a
unionWith f s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then B p m (unionWith f s0 t) s1
else B p m s0 (unionWith f s1 t)
else join p s q t
| m > n = if matchPrefix p q n then
if zeroBit p n then B q n (unionWith f s t0) t1
else B q n t0 (unionWith f s t1)
else join p s q t
| otherwise = if p == q then B p m (unionWith f s0 t0) (unionWith f s1 t1)
else join p s q t
unionWith f s@(B p m s0 s1) (L k x) =
if matchPrefix k p m then
if zeroBit k m then B p m (insertWith (flip f) k x s0) s1
else B p m s0 (insertWith (flip f) k x s1)
else join k (L k x) p s
unionWith _ s@(B _ _ _ _) E = s
unionWith f (L k x) t = insertWith f k x t
unionWith _ E t = t
intersectionWith :: (a -> b -> c) -> FM a -> FM b -> FM c
intersectionWith f s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then intersectionWith f s0 t
else intersectionWith f s1 t
else E
| m > n = if matchPrefix p q n then
if zeroBit p n then intersectionWith f s t0
else intersectionWith f s t1
else E
| otherwise = if p /= q then E
else makeB p m (intersectionWith f s0 t0) (intersectionWith f s1 t1)
intersectionWith f (B _ m s0 s1) (L k y) =
case lookupM k (if zeroBit k m then s0 else s1) of
Just x -> L k (f x y)
Nothing -> E
intersectionWith _ (B _ _ _ _) E = E
intersectionWith f (L k x) t =
case lookupM k t of
Just y -> L k (f x y)
Nothing -> E
intersectionWith _ E _ = E
difference :: FM a -> FM b -> FM a
difference s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then lmakeB p m (difference s0 t) s1
else rmakeB p m s0 (difference s1 t)
else s
| m > n = if matchPrefix p q n then
if zeroBit p n then difference s t0
else difference s t1
else s
| otherwise = if p /= q then s
else makeB p m (difference s0 t0) (difference s1 t1)
difference s@(B p m s0 s1) (L k _) =
if matchPrefix k p m then
if zeroBit k m then lmakeB p m (delete k s0) s1
else rmakeB p m s0 (delete k s1)
else s
difference s@(B _ _ _ _) E = s
difference s@(L k _) t = if member k t then E else s
difference E _ = E
properSubset :: FM a -> FM b -> Bool
properSubset s t = case subset' s t of {LT -> True; _ -> False}
subset' :: FM t -> FM t1 -> Ordering
subset' s@(B p m s0 s1) (B q n t0 t1)
| m < n = GT
| m > n = if matchPrefix p q n then
if zeroBit p n then subset' s t0
else subset' s t1
else GT
| otherwise = if p == q then case (subset' s0 t0,subset' s1 t1) of
(GT,_) -> GT
(_,GT) -> GT
(EQ,EQ) -> EQ
(_,_) -> LT
else GT
subset' (B _ _ _ _) _ = GT
subset' (L k _) (L j _) = if k == j then EQ else GT
subset' (L k _) t = if member k t then LT else GT
subset' E E = EQ
subset' E _ = LT
subset :: FM a -> FM b -> Bool
subset s@(B p m s0 s1) (B q n t0 t1)
| m < n = False
| m > n = matchPrefix p q n && (if zeroBit p n then subset s t0
else subset s t1)
| otherwise = (p == q) && subset s0 t0 && subset s1 t1
subset (B _ _ _ _) _ = False
subset (L k _) t = member k t
subset E _ = True
properSubmapBy :: (a -> a -> Bool) -> FM a -> FM a -> Bool
properSubmapBy = properSubmapByUsingSubmapBy
submapBy :: (a -> a -> Bool) -> FM a -> FM a -> Bool
submapBy = submapByUsingLookupM
sameMapBy :: (a -> a -> Bool) -> FM a -> FM a -> Bool
sameMapBy = sameMapByUsingSubmapBy
properSubmap :: (Eq a) => FM a -> FM a -> Bool
properSubmap = A.properSubmap
submap :: (Eq a) => FM a -> FM a -> Bool
submap = A.submap
sameMap :: (Eq a) => FM a -> FM a -> Bool
sameMap = A.sameMap
mapWithKey :: (Int -> a -> b) -> FM a -> FM b
mapWithKey _ E = E
mapWithKey f (L k x) = L k (f k x)
mapWithKey f (B p m t0 t1) = B p m (mapWithKey f t0) (mapWithKey f t1)
foldWithKey :: (Int -> a -> b -> b) -> b -> FM a -> b
foldWithKey _ c E = c
foldWithKey f c (L k x) = f k x c
foldWithKey f c (B _ _ t0 t1) = foldWithKey f (foldWithKey f c t1) t0
foldWithKey' :: (Int -> a -> b -> b) -> b -> FM a -> b
foldWithKey' _ c E = c
foldWithKey' f c (L k x) = c `seq` f k x c
foldWithKey' f c (B _ _ t0 t1) = c `seq` (foldWithKey f $! (foldWithKey f c t1)) t0
filterWithKey :: (Int -> a -> Bool) -> FM a -> FM a
filterWithKey _ E = E
filterWithKey g t@(L k x) = if g k x then t else E
filterWithKey g (B p m t0 t1) =
makeB p m (filterWithKey g t0) (filterWithKey g t1)
partitionWithKey :: (Int -> a -> Bool) -> FM a -> (FM a, FM a)
partitionWithKey _ E = (E, E)
partitionWithKey g t@(L k x) = if g k x then (t, E) else (E, t)
partitionWithKey g (B p m t0 t1) =
let (t0',t0'') = partitionWithKey g t0
(t1',t1'') = partitionWithKey g t1
in (makeB p m t0' t1', makeB p m t0'' t1'')
unionWithKey :: (Int -> a -> a -> a) -> FM a -> FM a -> FM a
unionWithKey f s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then B p m (unionWithKey f s0 t) s1
else B p m s0 (unionWithKey f s1 t)
else join p s q t
| m > n = if matchPrefix p q n then
if zeroBit p n then B q n (unionWithKey f s t0) t1
else B q n t0 (unionWithKey f s t1)
else join p s q t
| otherwise = if p == q then B p m (unionWithKey f s0 t0) (unionWithKey f s1 t1)
else join p s q t
unionWithKey f s@(B p m s0 s1) (L k x) =
if matchPrefix k p m then
if zeroBit k m then B p m (insertWith (flip (f k)) k x s0) s1
else B p m s0 (insertWith (flip (f k)) k x s1)
else join k (L k x) p s
unionWithKey _ s@(B _ _ _ _) E = s
unionWithKey f (L k x) t = insertWith (f k) k x t
unionWithKey _ E t = t
intersectionWithKey :: (Int -> a -> b -> c) -> FM a -> FM b -> FM c
intersectionWithKey f s@(B p m s0 s1) t@(B q n t0 t1)
| m < n = if matchPrefix q p m then
if zeroBit q m then intersectionWithKey f s0 t
else intersectionWithKey f s1 t
else E
| m > n = if matchPrefix p q n then
if zeroBit p n then intersectionWithKey f s t0
else intersectionWithKey f s t1
else E
| otherwise = if p /= q then E
else makeB p m (intersectionWithKey f s0 t0) (intersectionWithKey f s1 t1)
intersectionWithKey f (B _ m s0 s1) (L k y) =
case lookupM k (if zeroBit k m then s0 else s1) of
Just x -> L k (f k x y)
Nothing -> E
intersectionWithKey _ (B _ _ _ _) E = E
intersectionWithKey f (L k x) t =
case lookupM k t of
Just y -> L k (f k x y)
Nothing -> E
intersectionWithKey _ E _ = E
strict :: t -> t
strict n = n
strictWith :: (t -> a) -> FM t -> FM t
strictWith _ n@E = n
strictWith f n@(L _ x) = f x `seq` n
strictWith f n@(B _ _ m1 m2) = strictWith f m1 `seq` strictWith f m2 `seq` n
ordListFM :: FM a -> [(Int,a)]
ordListFM E = []
ordListFM (L k x) = [(k,x)]
ordListFM (B _ _ t0 t1) = merge (ordListFM t0) (ordListFM t1)
where merge [] ys = ys
merge xs [] = xs
merge (x@(k1,_):xs) (y@(k2,_):ys) =
case compare k1 k2 of
LT -> x : merge xs (y:ys)
GT -> y : merge (x:xs) ys
EQ -> error "PatriciaLoMap: bug in ordListFM"
ordListFM_rev :: FM a -> [(Int,a)]
ordListFM_rev E = []
ordListFM_rev (L k x) = [(k,x)]
ordListFM_rev (B _ _ t0 t1) = merge (ordListFM_rev t0) (ordListFM_rev t1)
where merge [] ys = ys
merge xs [] = xs
merge (x@(k1,_):xs) (y@(k2,_):ys) =
case compare k1 k2 of
LT -> y : merge (x:xs) ys
GT -> x : merge xs (y:ys)
EQ -> error "PatriciaLoMap: bug in ordListFM_rev"
minView :: Monad m => FM a -> m (a, FM a)
minView fm =
case ordListFM fm of
[] -> fail $ moduleName++".minView: empty map"
((k,x):_) -> return (x,delete k fm)
minViewWithKey :: Monad m => FM a -> m ((Int, a), FM a)
minViewWithKey fm =
case ordListFM fm of
[] -> fail $ moduleName++".minViewWithKey: empty map"
((k,x):_) -> return ((k,x),delete k fm)
maxView :: Monad m => FM a -> m (a, FM a)
maxView fm =
case ordListFM_rev fm of
[] -> fail $ moduleName++".maxView: empty map"
((k,x):_) -> return (x,delete k fm)
maxViewWithKey :: Monad m => FM a -> m ((Int, a), FM a)
maxViewWithKey fm =
case ordListFM_rev fm of
[] -> fail $ moduleName++".maxViewWithKey: empty map"
((k,x):_) -> return ((k,x),delete k fm)
minElem :: FM a -> a
minElem = minElemUsingMinView
minElemWithKey :: FM a -> (Int,a)
minElemWithKey = minElemWithKeyUsingMinViewWithKey
deleteMin :: FM a -> FM a
deleteMin = deleteMinUsingMinView
unsafeInsertMin :: Int -> a -> FM a -> FM a
unsafeInsertMin = insert
maxElem :: FM a -> a
maxElem = maxElemUsingMaxView
deleteMax :: FM a -> FM a
deleteMax = deleteMaxUsingMaxView
maxElemWithKey :: FM a -> (Int,a)
maxElemWithKey = maxElemWithKeyUsingMaxViewWithKey
unsafeInsertMax :: Int -> a -> FM a -> FM a
unsafeInsertMax = insert
foldr :: (a -> b -> b) -> b -> FM a -> b
foldr f z fm = L.foldr f z . L.map snd . ordListFM $ fm
foldr' :: (a -> b -> b) -> b -> FM a -> b
foldr' f z fm = L.foldl' (flip f) z . L.map snd . ordListFM_rev $ fm
foldr1 :: (a -> a -> a) -> FM a -> a
foldr1 f fm = L.foldr1 f . L.map snd . ordListFM $ fm
foldr1' :: (a -> a -> a) -> FM a -> a
foldr1' f fm = L.foldl1' (flip f) . L.map snd . ordListFM_rev $ fm
foldl :: (b -> a -> b) -> b -> FM a -> b
foldl f z fm = L.foldr (flip f) z . L.map snd . ordListFM_rev $ fm
foldl' :: (b -> a -> b) -> b -> FM a -> b
foldl' f z fm = L.foldl' f z . L.map snd . ordListFM $ fm
foldl1 :: (a -> a -> a) -> FM a -> a
foldl1 f fm = L.foldr1 (flip f) . L.map snd . ordListFM_rev $ fm
foldl1' :: (a -> a -> a) -> FM a -> a
foldl1' f fm = L.foldl1' f . L.map snd . ordListFM $ fm
foldrWithKey :: (Int -> a -> b -> b) -> b -> FM a -> b
foldrWithKey f z fm = L.foldr (uncurry f) z . ordListFM $ fm
foldrWithKey' :: (Int -> a -> b -> b) -> b -> FM a -> b
foldrWithKey' f z fm = L.foldl' (flip (uncurry f)) z . ordListFM_rev $ fm
foldlWithKey :: (b -> Int -> a -> b) -> b -> FM a -> b
foldlWithKey f z fm = L.foldr (\(k,x) a -> f a k x) z . ordListFM_rev $ fm
foldlWithKey' :: (b -> Int -> a -> b) -> b -> FM a -> b
foldlWithKey' f z fm = L.foldl' (\a (k,x) -> f a k x) z . ordListFM $ fm
unsafeFromOrdSeq :: S.Sequence seq => seq (Int,a) -> FM a
unsafeFromOrdSeq = fromSeq
unsafeAppend :: FM a -> FM a -> FM a
unsafeAppend = union
filterLT :: Int -> FM a -> FM a
filterLT k = filterWithKey (\k' _ -> k' < k)
filterLE :: Int -> FM a -> FM a
filterLE k = filterWithKey (\k' _ -> k' <= k)
filterGT :: Int -> FM a -> FM a
filterGT k = filterWithKey (\k' _ -> k' > k)
filterGE :: Int -> FM a -> FM a
filterGE k = filterWithKey (\k' _ -> k' >= k)
partitionLT_GE :: Int -> FM a -> (FM a, FM a)
partitionLT_GE k fm = (filterLT k fm,filterGE k fm)
partitionLE_GT :: Int -> FM a -> (FM a,FM a)
partitionLE_GT k fm = (filterLE k fm,filterGT k fm)
partitionLT_GT :: Int -> FM a -> (FM a,FM a)
partitionLT_GT k fm = (filterLT k fm,filterGT k fm)
toOrdSeq :: S.Sequence seq => FM a -> seq (Int,a)
toOrdSeq = L.foldr S.lcons S.empty . ordListFM
insertSeq :: S.Sequence seq => seq (Int,a) -> FM a -> FM a
insertSeq = insertSeqUsingFoldr
unionSeq :: S.Sequence seq => seq (FM a) -> FM a
unionSeq = unionSeqUsingReduce
deleteAll :: Int -> FM a -> FM a
deleteAll = delete
deleteSeq :: S.Sequence seq => seq Int -> FM a -> FM a
deleteSeq = deleteSeqUsingFoldr
count :: Int -> FM a -> Int
count = countUsingMember
lookupAll :: S.Sequence seq => Int -> FM a -> seq a
lookupAll = lookupAllUsingLookupM
lookupWithDefault :: a -> Int -> FM a -> a
lookupWithDefault = lookupWithDefaultUsingLookupM
elements :: S.Sequence seq => FM a -> seq a
elements = elementsUsingFold
fromSeqWithKey ::
S.Sequence seq => (Int -> a -> a -> a) -> seq (Int,a) -> FM a
fromSeqWithKey = fromSeqWithKeyUsingInsertSeqWithKey
insertWithKey :: (Int -> a -> a -> a) -> Int -> a -> FM a -> FM a
insertWithKey = insertWithKeyUsingInsertWith
insertSeqWith ::
S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> FM a -> FM a
insertSeqWith = insertSeqWithUsingInsertWith
insertSeqWithKey ::
S.Sequence seq =>
(Int -> a -> a -> a) -> seq (Int,a) -> FM a -> FM a
insertSeqWithKey = insertSeqWithKeyUsingInsertWithKey
adjustAll :: (a -> a) -> Int -> FM a -> FM a
adjustAll = adjust
unionSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (FM a) -> FM a
unionSeqWith = unionSeqWithUsingReduce
toSeq :: S.Sequence seq => FM a -> seq (Int,a)
toSeq = toSeqUsingFoldWithKey
keys :: S.Sequence seq => FM a -> seq Int
keys = keysUsingFoldWithKey
unionSeqWithKey ::
S.Sequence seq => (Int -> a -> a -> a) -> seq (FM a) -> FM a
unionSeqWithKey = unionSeqWithKeyUsingReduce
instance A.AssocX FM Int where
{empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert;
insertSeq = insertSeq; union = union; unionSeq = unionSeq;
delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;
null = null; size = size; member = member; count = count;
lookup = lookup; lookupM = lookupM; lookupAll = lookupAll;
lookupAndDelete = lookupAndDelete; lookupAndDeleteM = lookupAndDeleteM;
lookupAndDeleteAll = lookupAndDeleteAll;
lookupWithDefault = lookupWithDefault; adjust = adjust;
adjustAll = adjustAll; adjustOrInsert = adjustOrInsert;
adjustAllOrInsert = adjustAllOrInsert;
adjustOrDelete = adjustOrDelete; adjustOrDeleteAll = adjustOrDeleteAll;
fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';
filter = filter; partition = partition; elements = elements;
strict = strict; strictWith = strictWith;
structuralInvariant = structuralInvariant; instanceName _ = moduleName}
instance A.Assoc FM Int where
{toSeq = toSeq; keys = keys; mapWithKey = mapWithKey;
foldWithKey = foldWithKey; foldWithKey' = foldWithKey';
filterWithKey = filterWithKey;
partitionWithKey = partitionWithKey}
instance A.FiniteMapX FM Int where
{fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey;
insertWith = insertWith; insertWithKey = insertWithKey;
insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey;
unionl = unionl; unionr = unionr; unionWith = unionWith;
unionSeqWith = unionSeqWith; intersectionWith = intersectionWith;
difference = difference; properSubset = properSubset; subset = subset;
properSubmapBy = properSubmapBy; submapBy = submapBy;
sameMapBy = sameMapBy}
instance A.FiniteMap FM Int where
{unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey;
intersectionWithKey = intersectionWithKey}
instance A.OrdAssocX FM Int where
{minView = minView; minElem = minElem; deleteMin = deleteMin;
unsafeInsertMin = unsafeInsertMin; maxView = maxView; maxElem = maxElem;
deleteMax = deleteMax; unsafeInsertMax = unsafeInsertMax;
foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';
foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';
unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;
filterLT = filterLT; filterGT = filterGT; filterLE = filterLE;
filterGE = filterGE; partitionLT_GE = partitionLT_GE;
partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}
instance A.OrdAssoc FM Int where
{minViewWithKey = minViewWithKey; minElemWithKey = minElemWithKey;
maxViewWithKey = maxViewWithKey; maxElemWithKey = maxElemWithKey;
foldrWithKey = foldrWithKey; foldrWithKey' = foldrWithKey';
foldlWithKey = foldlWithKey; foldlWithKey' = foldlWithKey';
toOrdSeq = toOrdSeq}
instance A.OrdFiniteMapX FM Int
instance A.OrdFiniteMap FM Int
instance Functor FM where
fmap = map
instance (Show a) => Show (FM a) where
showsPrec = showsPrecUsingToList
instance (Read a) => Read (FM a) where
readsPrec = readsPrecUsingFromList
instance (Eq a) => Eq (FM a) where
(==) = sameMap
instance (Ord a) => Ord (FM a) where
compare = compareUsingToOrdList
instance (Arbitrary a) => Arbitrary (FM a) where
arbitrary = do (xs::[(Int,a)]) <- arbitrary
return (Prelude.foldr (uncurry insert) empty xs)
instance (CoArbitrary a) => CoArbitrary (FM a) where
coarbitrary E = variant 0
coarbitrary (L i a) = variant 1 . coarbitrary i . coarbitrary a
coarbitrary (B i j m n) = variant 2 . coarbitrary i . coarbitrary j
. coarbitrary m . coarbitrary n
instance Semigroup (FM a) where
(<>) = union
instance Monoid (FM a) where
mempty = empty
mappend = (SG.<>)
mconcat = unionSeq