TrieMap 0.5.0 → 0.5.1

raw patch · 11 files changed

+102/−38 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/TrieMap.hs +13/−0
• Data/TrieMap/Class/Instances.hs +30/−8
• Data/TrieMap/IntMap.hs +17/−12
• Data/TrieMap/MultiRec/Class.hs +2/−2
• Data/TrieMap/OrdMap.hs +4/−4
• Data/TrieMap/Regular/Base.hs +9/−7
• Data/TrieMap/Regular/ConstMap.hs +5/−0
• Data/TrieMap/Regular/ProdMap.hs +6/−0
• Data/TrieMap/Regular/RadixTrie.hs +10/−2
• Data/TrieMap/TrieKey.hs +5/−2
• TrieMap.cabal +1/−1

@@ -16,6 +16,7 @@ 	findWithDefault, 	-- * Construction 	empty,+	showMap, 	singleton, 	-- ** Insertion 	insert,@@ -122,6 +123,15 @@  import Prelude hiding (lookup, foldr, null, map, filter) +instance (Show k, Show a, TKey k) => Show (TMap k a) where+	show m = "fromList " ++ show (assocs m)++instance (Eq k, TKey k, Eq a) => Eq (TMap k a) where+	m1 == m2 = assocs m1 == assocs m2++instance (Ord k, TKey k, Ord a) => Ord (TMap k a) where+	m1 `compare` m2 = assocs m1 `compare` assocs m2+ -- newtype Elem a k = Elem {getElem :: a} empty :: TKey k => TMap k a empty = TMap emptyM@@ -353,3 +363,6 @@  notMember :: TKey k => k -> TMap k a -> Bool notMember = not .: member++showMap :: (TKey k, Show (TrieMap (Rep k) (K0 a) (Rep k))) => TMap k a -> String+showMap (TMap m) = show m

@@ -1,8 +1,9 @@-{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}  module Data.TrieMap.Class.Instances where  import Data.TrieMap.Class+import Data.TrieMap.TrieKey -- import Data.TrieMap.RadixTrie() import Data.TrieMap.MultiRec.Instances import Data.TrieMap.IntMap()@@ -24,16 +25,24 @@ import Data.Word  import Prelude hiding (foldr)++#if __GLASGOW_HASKELL__+import GHC.Exts (build)+#else++build :: (forall b . (a -> b -> b) -> b -> b) -> [a]+build f = f (:) []+#endif {- instance TKey k => TKey [k] where 	type Rep [k] = L I0 (Rep k) 	toRep = map toRep 	fromRep = map fromRep-} -type instance Rep Int = Ordered Int+type instance Rep Int = Int instance TKey Int where-	toRep = Ord-	fromRep = unOrd+	toRep = id+	fromRep = id  type instance Rep Double = Ordered Double instance TKey Double where@@ -85,13 +94,14 @@ -- 	toRep (a :+ b) = toRep (a, b) -- 	fromRep = uncurry (:+) . fromRep -type instance Rep Integer = Rep [Int32]+type instance Rep Integer = (I0 :+: I0) (Rep [Int32]) instance TKey Integer where-	toRep = toRep . unroll-	fromRep = roll . fromRep+	toRep x = (if x >= 0 then R . I0 else L . I0) (toRep (unroll x))+	fromRep (L (I0 xs)) = - roll (map negate (fromRep xs))+	fromRep (R (I0 xs)) = roll (fromRep xs)  unroll :: Integer -> [Int32]-unroll = unfoldr step where+unroll x = if x >= 0 then unfoldr step x else map negate (unfoldr step (negate x)) where  	step 0 = Nothing 	step i = Just (fromIntegral i,  i `shiftR` 32) @@ -134,6 +144,13 @@ 	toRep (a, b, c, d, e) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: K0 (toRep d) :*: I0 (toRep e) 	fromRep (K0 a :*: K0 b :*: K0 c :*: K0 d :*: I0 e) = (fromRep a, fromRep b, fromRep c, fromRep d, fromRep e) +type instance Rep Bool = (U0 :+: U0) (U0 ())+instance TKey Bool where+	toRep False = L U0+	toRep True = R U0+	fromRep L{} = False+	fromRep R{} = True+ type instance Rep (Maybe a) = (U0 :+: I0) (Rep a) instance TKey a => TKey (Maybe a) where 	toRep = maybe (L U0) (R . I0 . toRep)@@ -178,3 +195,8 @@ instance TKey r => TKey (I0 r) where 	toRep = fmap toRep 	fromRep = fmap fromRep++type instance Rep (TMap k a) = L (K0 (Rep k) :*: I0) (Rep a)+instance (TKey k, TKey a) => TKey (TMap k a) where+	toRep (TMap m) = List [K0 k :*: I0 (toRep a) | (k, K0 a) <- foldWithKeyM (curry (:)) m []]+	fromRep (List xs) = TMap (fromDistAscListM (const 1) [(k, K0 (fromRep a)) | K0 k :*: I0 a <- xs])

@@ -30,6 +30,7 @@ data IntMap a ix = Nil               | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key (a ix)               | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a ix) !(IntMap a ix) +		deriving (Show) type instance TrieMap Int = IntMap  type Prefix = Int@@ -148,7 +149,7 @@ alter :: Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> Int -> IntMap a ix -> IntMap a ix alter s f k t = case t of 	Bin sz p m l r-		| nomatch k p m	-> singletonMaybe s k (f Nothing)+		| nomatch k p m	-> join k (singletonMaybe s k (f Nothing)) p t 		| zero k m	-> bin p m (alter s f k l) r 		| otherwise	-> bin p m l (alter s f k r) 	Tip sz ky y@@ -203,8 +204,8 @@   = case t of       Bin _ _ m l r           | m < 0 -> (if k >= 0 -- handle negative numbers.-                      then let (lt,found,gt) = splitLookup' s f k l in (union r lt,found, gt)-                      else let (lt,found,gt) = splitLookup' s f k r in (lt,found, union gt l))+                      then let (lt,found,gt) = splitLookup' s f k l in (union s r lt,found, gt)+                      else let (lt,found,gt) = splitLookup' s f k r in (lt,found, union s gt l))           | otherwise   -> splitLookup' s f k t       Tip _ ky y          | k>ky      -> (t,Nothing,Nil)@@ -217,28 +218,32 @@   = case t of       Bin _ p m l r         | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)-        | zero k m  -> let (lt,found,gt) = splitLookup s f k l in (lt,found,union gt r)-        | otherwise -> let (lt,found,gt) = splitLookup s f k r in (union l lt,found,gt)+        | zero k m  -> let (lt,found,gt) = splitLookup s f k l in (lt,found,union s gt r)+        | otherwise -> let (lt,found,gt) = splitLookup s f k r in (union s l lt,found,gt)       Tip _ ky y          | k>ky      -> (t,Nothing,Nil)         | k<ky      -> (Nil,Nothing,t)         | otherwise -> singletonMaybe s k `sides` f y       Nil -> (Nil,Nothing,Nil) -union :: IntMap a ix -> IntMap a ix -> IntMap a ix-union t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)+union :: Sized a -> IntMap a ix -> IntMap a ix -> IntMap a ix+union s t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)   | shorter m1 m2  = union1   | shorter m2 m1  = union2-  | p1 == p2       = bin p1 m1 (union l1 l2) (union r1 r2)+  | p1 == p2       = bin p1 m1 (union s l1 l2) (union s r1 r2)   | otherwise      = join p1 t1 p2 t2   where     union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2-            | zero p2 m1        = bin p1 m1 (union l1 t2) r1-            | otherwise         = bin p1 m1 l1 (union r1 t2)+            | zero p2 m1        = bin p1 m1 (union s l1 t2) r1+            | otherwise         = bin p1 m1 l1 (union s r1 t2)      union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2-            | zero p1 m2        = bin p2 m2 (union t1 l2) r2-            | otherwise         = bin p2 m2 l2 (union t1 r2)+            | zero p1 m2        = bin p2 m2 (union s t1 l2) r2+            | otherwise         = bin p2 m2 l2 (union s t1 r2)+union s (Tip _ k x) t = alter s (const (Just x)) k t+union s t (Tip _ k x) = alter s (Just . fromMaybe x) k t  -- right bias+union _ Nil t       = t+union _ t Nil       = t  unionWithKey :: Sized a -> UnionFunc Key (a ix) -> IntMap a ix -> IntMap a ix -> IntMap a ix unionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)

@@ -15,7 +15,7 @@ type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> (* -> *) -> * -> * type family HTrieMap (phi :: * -> *) (r :: * -> *) :: (* -> *) -> * -> * -class HOrd phi f => HTrieKeyT (phi :: * -> *) (f :: (* -> *) -> * -> *) m | phi f -> m, m -> phi f where+class HOrd phi f => HTrieKeyT (phi :: * -> *) (f :: (* -> *) -> * -> *) m | m -> phi f where 	emptyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r a ix 	nullT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r a ix -> Bool 	sizeT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => HSized phi a -> m r a ix -> Int@@ -66,7 +66,7 @@ 	updateAtT pf s f i m = case assocAtT pf s i m of 		(i', k, a) -> alterT pf s (const (f i' k a)) k m -class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | phi r -> m, m -> phi r where+class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where 	emptyH :: m ~ HTrieMap phi r => phi ix -> m a ix 	nullH :: m ~ HTrieMap phi r => phi ix -> m a ix -> Bool 	sizeH :: (m ~ HTrieMap phi r) => HSized phi a -> m a ix -> Int

@@ -378,15 +378,15 @@ -- basic rotations singleL, singleR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix singleL s k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin s k2 x2 (bin s k1 x1 t1 t2) t3-singleL _ _ _ _ Tip = error "singleL Tip"+singleL s k1 x1 t1 Tip = bin s k1 x1 t1 Tip singleR s k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin s k2 x2 t1 (bin s k1 x1 t2 t3)-singleR _ _ _ Tip _ = error "singleR Tip"+singleR s k1 x1 Tip t2 = bin s k1 x1 Tip t2  doubleL, doubleR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix doubleL s k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin s k3 x3 (bin s k1 x1 t1 t2) (bin s k2 x2 t3 t4)-doubleL _ _ _ _ _ = error "doubleL"+doubleL s k1 x1 t1 t2 = singleL s k1 x1 t1 t2 doubleR s k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin s k3 x3 (bin s k2 x2 t1 t2) (bin s k1 x1 t3 t4)-doubleR _ _ _ _ _ = error "doubleR"+doubleR s k1 x1 t1 t2 = singleR s k1 x1 t1 t2  bin :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix bin s k x l r

@@ -2,13 +2,15 @@  module Data.TrieMap.Regular.Base where -newtype K0 a r = K0 {unK0 :: a}-newtype I0 r = I0 {unI0 :: r}-data U0 r = U0-data (f :*: g) r = f r :*: g r-data (f :+: g) r = L (f r) | R (g r)-newtype L f r = List [f r]-newtype Reg r = Reg {unReg :: r}+import Data.TrieMap.TrieKey++newtype K0 a r = K0 {unK0 :: a} deriving (Show)+newtype I0 r = I0 {unI0 :: r} deriving (Show)+data U0 r = U0 deriving (Show)+data (f :*: g) r = f r :*: g r deriving (Show)+data (f :+: g) r = L (f r) | R (g r) deriving (Show)+newtype L f r = List [f r] deriving (Show)+newtype Reg r = Reg {unReg :: r} deriving (Show)  newtype Fix f = In {out :: f (Fix f)} 

@@ -15,6 +15,11 @@ newtype KMap m k (a :: * -> *) ix = KMap (m a ix) type instance TrieMapT (K0 a) = KMap (TrieMap a) type instance TrieMap (K0 a r) = TrieMapT (K0 a) r+type instance PF (KMap m k a ix) = PF (m a ix)++instance (Regular (m a ix), Functor (PF (m a ix))) => Regular (KMap m k a ix) where+	from (KMap m) = fmap KMap (from m)+	to = KMap . to . fmap (\ (KMap m) -> m)  instance (TrieKey k m, m ~ TrieMap k) => TrieKey (K0 k r) (KMap m r) where 	emptyM = KMap emptyM

@@ -16,6 +16,12 @@ type instance TrieMapT (f :*: g) = PMap (TrieMapT f) (TrieMapT g) type instance TrieMap ((f :*: g) r) = TrieMapT (f :*: g) r +type instance PF (PMap m1 m2 k a ix) = PF (m1 k (m2 k a) ix)++instance (Regular (m1 k (m2 k a) ix), Functor (PF (m1 k (m2 k a) ix))) => Regular (PMap m1 m2 k a ix) where+	from (PMap m) = fmap PMap (from m)+	to = PMap . to . fmap (\ (PMap m) -> m)+ instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :*: g) (PMap m1 m2) where 	emptyT = PMap emptyT 	nullT (PMap m) = nullT m

@@ -25,6 +25,13 @@ type Edge' f k a ix = Edge f (TrieMapT f) k a ix type MEdge f k m a ix = Maybe (Edge f m k a ix) type MEdge' f k a ix = Maybe (Edge' f k a ix)++-- type instance PF (Edge f m k a ix) = (K0 (L f k) :*: K0 (Maybe (a ix)) :*: L (K0 k :*: I0) :*: K0 Int)+-- type instance (RadixTrie f k a ix) = U0 :+: PF (Edge f m k a ix)++-- instance (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Regular (Edge f m k a ix) where+-- 	from (Edge n ks v ts) = K0 (List ks) :*: K0 v :*: + newtype RadixTrie f k a ix = Radix (MEdge' f k a ix) -- newtype K0 a b = K0 a @@ -266,8 +273,9 @@  filterer :: (k -> k -> Bool) -> (a -> a -> a) -> [([k], a)] -> (Maybe a, [(k, [([k], a)])]) filterer (==) f = filterer' where-	filterer' (([], a):xs) = first (Just . maybe a (f a)) (filterer' xs)+	filterer' (([], a):xs) = first (Just . maybe a (flip f a)) (filterer' xs) 	filterer' ((k:ks, a):xs) = second (cons k ks a) (filterer' xs)+	filterer' [] = (Nothing, []) 	cons k ks a [] = [(k, [(ks, a)])] 	cons k ks a ys0@((k', xs):ys) 		| k == k'	= (k', (ks,a):xs):ys@@ -278,7 +286,7 @@ fromListE s f xs = case filterer eqT (f []) xs of 	(Nothing, [(k, xs)]) -> cons k <$> fromListE s (f . (k:)) xs 	(v, xss) -> Just (edge s [] v (mapWithKeyT edgeSize (\ k (K0 xs) -> fromJust (fromListE s (f . (k:)) xs))-				(fromListT (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (xs ++ ys)) [(k, K0 xs) | (k, xs) <- xss])))+				(fromListT (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (ys ++ xs)) [(k, K0 xs) | (k, xs) <- xss])))  fromAscListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>  	Sized a -> ([f k] -> a ix -> a ix -> a ix) -> [([f k], a ix)] -> MEdge' f k a ix

@@ -8,8 +8,11 @@ import Control.Applicative  import Data.Monoid+import Data.List  type family TrieMap k :: (* -> *) -> * -> *++type family MapPF (m :: (* -> *) -> * -> *) ix :: (* -> *) -> * -- data Fixer f  type EitherMap k a b c = k -> a -> (Maybe b, Maybe c)@@ -24,7 +27,7 @@ -- toFixer :: a -> Fixer a -- toFixer _ = undefined -class Ord k => TrieKey k m | k -> m, m -> k where+class Ord k => TrieKey k m | m -> k where 	emptyM :: TrieMap k ~ m => m a ix 	nullM :: TrieMap k ~ m => m a ix -> Bool 	sizeM :: (TrieMap k ~ m) => Sized a -> m a ix -> Int@@ -51,7 +54,7 @@ 	fromDistAscListM :: (TrieMap k ~ m) => Sized a -> [(k, a ix)] -> m a ix 	 	sizeM s m = foldWithKeyM (\ _ a n -> s a + n) m 0-	fromListM s f = foldr (uncurry (insertWithKeyM s f)) emptyM+	fromListM s f = foldl' (flip (uncurry (insertWithKeyM s f))) emptyM 	fromAscListM = fromListM 	fromDistAscListM s = fromAscListM s (const const) 	updateAtM s f i m = case assocAtM s i m of

@@ -1,5 +1,5 @@ name:		     TrieMap-version:             0.5.0+version:             0.5.1 tested-with:	     GHC category:            Algorithms synopsis:	     Automatic type inference of generalized tries.