TrieMap 2.0.2 → 2.0.3

raw patch · 10 files changed

+213/−9 lines, 10 files

Files

• Data/TrieMap/IntMap.hs +1/−0
• Data/TrieMap/Key.hs +1/−0
• Data/TrieMap/OrdMap.hs +8/−8
• Data/TrieMap/ProdMap.hs +1/−0
• Data/TrieMap/RadixTrie.hs +2/−0
• Data/TrieMap/ReverseMap.hs +1/−0
• Data/TrieMap/TrieKey.hs +194/−0
• Data/TrieMap/UnionMap.hs +2/−0
• Data/TrieMap/UnitMap.hs +1/−0
• TrieMap.cabal +2/−1

@@ -28,6 +28,7 @@ 	| LeftBin !Prefix !Mask !(Path a) !(TrieMap Word a) 	| RightBin !Prefix !Mask !(TrieMap Word a) !(Path a) +-- | @'TrieMap' 'Word' a@ is based on "Data.IntMap". instance TrieKey Word where 	(=?) = (==) 	cmp = compare

@@ -15,6 +15,7 @@ import Data.TrieMap.OrdMap() import Data.TrieMap.RadixTrie() +-- | @'TrieMap' ('Key' k) a@ is a wrapper around a @TrieMap (Rep k) a@. instance TKey k => TrieKey (Key k) where 	Key k1 =? Key k2 = toRep k1 =? toRep k2 	Key k1 `cmp` Key k2 = toRep k1 `cmp` toRep k2

@@ -26,6 +26,7 @@ singletonMaybe :: Sized a => k -> Maybe a -> OrdMap k a singletonMaybe k = maybe Tip (singleton k) +-- | @'TrieMap' ('Ordered' k) a@ is based on "Data.Map". instance Ord k => TrieKey (Ordered k) where 	Ord k1 =? Ord k2	= k1 == k2 	Ord k1 `cmp` Ord k2	= k1 `compare` k2@@ -134,22 +135,21 @@   where !(# aL, aR #) = f a; !(# lL, lR #) = mapEither f l; !(# rL, rR #) = mapEither f r mapEither _ _ = (# Tip, Tip #) -splitLookup :: (Ord k, Sized a) => SplitMap a x -> k -> OrdMap k a -> (# OrdMap k a, Maybe x, OrdMap k a #)-splitLookup  f k m = case m of+splitLookup :: (Ord k, Sized a) => k -> OrdMap k a -> (# OrdMap k a, Maybe a, OrdMap k a #)+splitLookup k m = case m of 	Tip	-> (# Tip, Nothing, Tip #) 	Bin _ kx x l r -> case compare k kx of-		LT	-> let !(# lL, ans, lR #) = splitLookup f k l in (# lL, ans, join kx x lR r #)-		EQ	-> let !(# xL, ans, xR #) = f x in-			(# maybe l (\ xL -> insertMax kx xL l) xL, ans, maybe r (\ xR -> insertMin kx xR r) xR #)-		GT	-> let !(# rL, ans, rR #) = splitLookup f k r in (# join kx x l rL, ans, rR #)+		LT	-> let !(# lL, ans, lR #) = splitLookup k l in (# lL, ans, join kx x lR r #)+		EQ	-> (# l, Just x, r #)+		GT	-> let !(# rL, ans, rR #) = splitLookup k r in (# join kx x l rL, ans, rR #)  isSubmap :: (Ord k, Sized a, Sized b) => LEq a b -> LEq (OrdMap k a) (OrdMap k b) isSubmap _ Tip _ = True isSubmap _ _ Tip = False isSubmap (<=) (Bin _ kx x l r) t = case found of 	  Nothing	-> False-	  Just (Elem y)	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt-  where !(# lt, found, gt #) = splitLookup (\ x -> (# Nothing, Just (Elem x), Nothing #)) kx t+	  Just y	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt+  where !(# lt, found, gt #) = splitLookup kx t  fromAscList :: (Eq k, Sized a) => (a -> a -> a) -> [(k, a)] -> OrdMap k a fromAscList f xs = fromDistinctAscList (combineEq xs) where

@@ -13,6 +13,7 @@ import Data.Sequence ((|>)) import qualified Data.Sequence as Seq +-- | @'TrieMap' (k1, k2) a@ is implemented as a @'TrieMap' k1 ('TrieMap' k2 a)@. instance (TrieKey k1, TrieKey k2) => TrieKey (k1, k2) where 	(k11, k12) =? (k21, k22) = k11 =? k21 && k12 =? k22 	(k11, k12) `cmp` (k21, k22) = (k11 `cmp` k21) `mappend` (k12 `cmp` k22)

@@ -26,6 +26,7 @@  import Prelude hiding (length, and, zip, zipWith, foldr, foldl) +-- | @'TrieMap' ('Vector' k) a@ is a traditional radix trie. instance TrieKey k => TrieKey (Vector k) where 	ks =? ls	= length ks == length ls && and (zipWith (=?) ks ls) 	ks `cmp` ls	= V.foldr (\ (k, l) z -> (k `cmp` l) `mappend` z) (comparing length ks ls) (zip ks ls)@@ -79,6 +80,7 @@ vZipWith :: (Storable a, Storable b) => (a -> b -> c) -> S.Vector a -> S.Vector b -> Vector c vZipWith f xs ys = V.zipWith f (convert xs) (convert ys) +-- | @'TrieMap' ('S.Vector' Word) a@ is a traditional radix trie specialized for word arrays. instance TrieKey (S.Vector Word) where 	ks =? ls	= length ks == length ls && and (vZipWith (=?) ks ls) 	ks `cmp` ls	= V.foldr (\ (k, l) z -> (k `cmp` l) `mappend` z) (comparing length ks ls) (vZipWith (,) ks ls)

@@ -10,6 +10,7 @@  import GHC.Exts +-- | @'TrieMap' ('Rev' k) a@ is a wrapper around a @'TrieMap' k a@ that reverses the order of the operations. instance TrieKey k => TrieKey (Rev k) where 	newtype TrieMap (Rev k) a = RevMap (TrieMap k a) 	newtype Hole (Rev k) a = RHole (Hole k a)

@@ -0,0 +1,194 @@+{-# LANGUAGE TupleSections, TypeFamilies, UnboxedTuples, MagicHash #-}++module Data.TrieMap.TrieKey where++import Data.TrieMap.Sized++import Control.Applicative+import Control.Monad++import Data.Monoid+import Data.Foldable hiding (foldrM, foldlM)++import Prelude hiding (foldr, foldl)++import GHC.Exts++type LEq a b = a -> b -> Bool+type Unified k a = Either (Hole k a) (TrieMap k a)++data Simple a = Null | Singleton a | NonSimple++instance Monad Simple where+	return = Singleton+	Null >>= _ = Null+	Singleton a >>= k = k a+	NonSimple >>= _ = NonSimple++instance MonadPlus Simple where+	mzero = Null+	Null `mplus` simple	= simple+	simple `mplus` Null	= simple+	_ `mplus` _		= NonSimple++onSnd :: (c -> d) -> (a -> (# b, c #)) -> a -> (# b, d #)+onSnd g f a = case f a of+	(# b, c #) -> (# b, g c #)++onThird :: (d -> e) -> (a -> (# Int#, c, d #)) -> a -> (# Int#, c, e #)+onThird g f a = case f a of+	(# b, c, d #) -> (# b, c, g d #)++instance TrieKey k => Foldable (TrieMap k) where+	foldr f = flip $ foldrM f+	foldl f = flip $ foldlM f++-- | A @TrieKey k@ instance implies that @k@ is a standardized representation for which a+-- generalized trie structure can be derived.+class TrieKey k where+	(=?) :: k -> k -> Bool+	cmp :: k -> k -> Ordering++	data TrieMap k :: * -> *+	emptyM :: TrieMap k a+	singletonM :: Sized a => k -> a -> TrieMap k a+	getSimpleM :: TrieMap k a -> Simple a+	sizeM :: Sized a => TrieMap k a -> Int#+	lookupM :: k -> TrieMap k a -> Maybe a+	fmapM :: Sized b => (a -> b) -> TrieMap k a -> TrieMap k b+	traverseM :: (Applicative f, Sized b) =>+		(a -> f b) -> TrieMap k a -> f (TrieMap k b)+	foldrM :: (a -> b -> b) -> TrieMap k a -> b -> b+	foldlM :: (b -> a -> b) -> TrieMap k a -> b -> b+	mapMaybeM :: Sized b => (a -> Maybe b) -> TrieMap k a -> TrieMap k b+	mapEitherM :: (Sized b, Sized c) => (a -> (# Maybe b, Maybe c #)) -> TrieMap k a -> (# TrieMap k b, TrieMap k c #)+	unionM :: Sized a => (a -> a -> Maybe a) -> TrieMap k a -> TrieMap k a -> TrieMap k a+	isectM :: (Sized a, Sized b, Sized c) =>+		(a -> b -> Maybe c) -> TrieMap k a -> TrieMap k b -> TrieMap k c+	diffM :: Sized a => (a -> b -> Maybe a) -> TrieMap k a -> TrieMap k b -> TrieMap k a+	isSubmapM :: (Sized a, Sized b) => LEq a b -> LEq (TrieMap k a) (TrieMap k b)+	fromListM, fromAscListM :: Sized a => (a -> a -> a) -> [(k, a)] -> TrieMap k a+	fromDistAscListM :: Sized a => [(k, a)] -> TrieMap k a+	+	data Hole k :: * -> *+	singleHoleM :: k -> Hole k a+	beforeM :: Sized a => Maybe a -> Hole k a -> TrieMap k a+	afterM :: Sized a => Maybe a -> Hole k a -> TrieMap k a+	searchM :: k -> TrieMap k a -> (# Maybe a, Hole k a #)+	indexM :: Sized a => Int# -> TrieMap k a -> (# Int#, a, Hole k a #)+	{-# SPECIALIZE extractHoleM :: Sized a => TrieMap k a -> First (a, Hole k a) #-}+	{-# SPECIALIZE extractHoleM :: Sized a => TrieMap k a -> Last (a, Hole k a) #-}+	extractHoleM :: MonadPlus m => Sized a => TrieMap k a -> m (a, Hole k a)+	assignM :: Sized a => Maybe a -> Hole k a -> TrieMap k a++	fromListM f = foldr (\ (k, a) -> insertWithM f k a) emptyM+	fromAscListM = fromListM+	fromDistAscListM = fromAscListM const+	+	unifyM :: Sized a => k -> a -> k -> a -> Unified k a++instance (TrieKey k, Sized a) => Sized (TrieMap k a) where+	getSize# = sizeM++singletonM' :: (TrieKey k, Sized a) => k -> Maybe a -> TrieMap k a+singletonM' k = maybe emptyM (singletonM k)++mapMaybeM' :: (TrieKey k, Sized b) => (a -> Maybe b) -> TrieMap k a -> Maybe (TrieMap k b)+mapMaybeM' f = guardNullM . mapMaybeM f++mapEitherM' :: (TrieKey k, Sized b, Sized c) => (a -> (# Maybe b, Maybe c #)) -> TrieMap k a ->+	(# Maybe (TrieMap k b), Maybe (TrieMap k c) #)+mapEitherM' f = both guardNullM guardNullM (mapEitherM f)++mapEitherM'' :: (TrieKey k, Sized b, Sized c) => (a -> (# Maybe b, Maybe c #)) -> Maybe (TrieMap k a) ->+	(# Maybe (TrieMap k b), Maybe (TrieMap k c) #)+mapEitherM'' f = mapEitherMaybe (mapEitherM' f)++unionM' :: (TrieKey k, Sized a) => (a -> a -> Maybe a) -> TrieMap k a -> TrieMap k a -> Maybe (TrieMap k a)+unionM' f m1 m2 = guardNullM (unionM f m1 m2)++isectM' :: (TrieKey k, Sized a, Sized b, Sized c) => (a -> b -> Maybe c) -> TrieMap k a -> TrieMap k b -> Maybe (TrieMap k c)+isectM' f m1 m2 = guardNullM (isectM f m1 m2)++diffM' :: (TrieKey k, Sized a) => (a -> b -> Maybe a) -> TrieMap k a -> TrieMap k b -> Maybe (TrieMap k a)+diffM' f m1 m2 = guardNullM (diffM f m1 m2)++beforeM' :: (TrieKey k, Sized a) => Maybe a -> Hole k a -> Maybe (TrieMap k a)+beforeM' v hole = guardNullM (beforeM v hole)++afterM' :: (TrieKey k, Sized a) => Maybe a -> Hole k a -> Maybe (TrieMap k a)+afterM' v hole = guardNullM (afterM v hole)++searchM' :: TrieKey k => k -> Maybe (TrieMap k a) -> (# Maybe a, Hole k a #)+searchM' k Nothing = (# Nothing, singleHoleM k #)+searchM' k (Just m) = searchM k m++extractHoleM' :: (TrieKey k, MonadPlus m, Sized a) => Maybe (TrieMap k a) -> m (a, Hole k a)+extractHoleM' Nothing = mzero+extractHoleM' (Just m) = extractHoleM m++{-# INLINE assignM' #-}+assignM' :: (TrieKey k, Sized a) => Maybe a -> Hole k a -> Maybe (TrieMap k a)+assignM' v@Just{} hole	= Just (assignM v hole)+assignM' Nothing hole	= guardNullM (assignM Nothing hole)++{-# INLINE alterM #-}+alterM :: (TrieKey k, Sized a) => (Maybe a -> Maybe a) -> k -> TrieMap k a -> TrieMap k a+alterM f k m = case searchM k m of+	(# Nothing, hole #)	-> case f Nothing of+		Nothing		-> m+		a		-> assignM a hole+	(# a, hole #)		-> assignM (f a) hole++nullM :: TrieKey k => TrieMap k a -> Bool+nullM m = case getSimpleM m of+	Null	-> True+	_	-> False++guardNullM :: TrieKey k => TrieMap k a -> Maybe (TrieMap k a)+guardNullM m+	| nullM m	= Nothing+	| otherwise	= Just m++sides :: (b -> d) -> (a -> (# b, c, b #)) -> a -> (# d, c, d #)+sides g f a = case f a of+	(# x, y, z #) -> (# g x, y, g z #)++both :: (b -> b') -> (c -> c') -> (a -> (# b, c #)) -> a -> (# b', c' #)+both g1 g2 f a = case f a of+	(# x, y #) -> (# g1 x, g2 y #)++elemsM :: TrieKey k => TrieMap k a -> [a]+elemsM m = build (\ f z -> foldrM f m z)++insertWithM :: (TrieKey k, Sized a) => (a -> a -> a) -> k -> a -> TrieMap k a -> TrieMap k a+insertWithM f k a m = case searchM k m of+	(# a', hole #)	-> assignM (Just $ maybe a (f a) a') hole++mapEitherMaybe :: (a -> (# Maybe b, Maybe c #)) -> Maybe a -> (# Maybe b, Maybe c #)+mapEitherMaybe f (Just a) = f a+mapEitherMaybe _ _ = (# Nothing, Nothing #)++{-# INLINE unionMaybe #-}+unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a+unionMaybe f (Just x) (Just y) = f x y+unionMaybe _ Nothing y = y+unionMaybe _ x Nothing = x++isectMaybe :: (a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe c+isectMaybe f (Just x) (Just y) = f x y+isectMaybe _ _ _ = Nothing++diffMaybe :: (a -> b -> Maybe a) -> Maybe a -> Maybe b -> Maybe a+diffMaybe _ Nothing _ = Nothing+diffMaybe _ (Just x) Nothing = Just x+diffMaybe f (Just x) (Just y) = f x y++subMaybe :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool+subMaybe _ Nothing _ = True+subMaybe (<=) (Just a) (Just b) = a <= b+subMaybe _ _ _ = False++indexFail :: a -> (# Int#, b, c #)+indexFail _ = (# error err, error err, error err #) where+	err = "Error: not a valid index"

@@ -58,6 +58,8 @@  #define UVIEW uView -> UView +-- | @'TrieMap' ('Either' k1 k2) a@ is essentially a @(TrieMap k1 a, TrieMap k2 a)@, but+-- specialized for the cases where one or both maps are empty. instance (TrieKey k1, TrieKey k2) => TrieKey (Either k1 k2) where 	{-# SPECIALIZE instance TrieKey (Either () ()) #-} 	{-# SPECIALIZE instance TrieKey k => TrieKey (Either () k) #-}

@@ -14,6 +14,7 @@  import Prelude hiding (foldr, foldl) +-- | @'TrieMap' () a@ is implemented as @'Maybe' a@. instance TrieKey () where 	_ =? _ = True 	_ `cmp` _ = EQ

@@ -1,5 +1,5 @@ name:		     TrieMap-version:             2.0.2+version:             2.0.3 cabal-version:       >= 1.6 tested-with:	     GHC category:            Algorithms@@ -32,6 +32,7 @@   Data.TrieMap.Representation,   Data.TrieMap.Modifiers other-modules:+  Data.TrieMap.TrieKey,   Data.TrieMap.Utils,   Data.TrieMap.Sized,   Data.TrieMap.Applicative,