packages feed

TrieMap 0.5.2 → 0.5.3

raw patch · 44 files changed

+1728/−1077 lines, 44 files

Files

Data/TrieMap.hs view
@@ -119,22 +119,26 @@ import Data.TrieMap.TrieKey import Data.TrieMap.Applicative import Data.TrieMap.Rep+import Data.TrieMap.Rep.Instances+import Data.TrieMap.Modifiers+-- import Data.TrieMap.ReverseMap import Data.TrieMap.Sized+import Data.TrieMap.CPair  import Control.Applicative hiding (empty) import Control.Arrow import Control.Monad import Data.Maybe hiding (mapMaybe)-import Data.Monoid(First(..), Last(..))+import Data.Monoid(Monoid(..), First(..), Last(..)) -- import Data.Foldable -- import Data.Traversable  -- import Generics.MultiRec.Base-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Sized+-- import Data.TrieMap.Regular.Base+-- import Data.TrieMap.Regular.Sized import GHC.Exts (build) -import Prelude hiding (lookup, foldr, null, map, filter)+import Prelude hiding (lookup, foldr, null, map, filter, reverse)  instance (Show k, Show a, TKey k) => Show (TMap k a) where 	show m = "fromList " ++ show (assocs m)@@ -145,6 +149,10 @@ instance (Ord k, TKey k, Ord a) => Ord (TMap k a) where 	m1 `compare` m2 = assocs m1 `compare` assocs m2 +instance TKey k => Monoid (TMap k a) where+	mempty = empty+	mappend = union+ -- newtype Elem a k = Elem {getElem :: a} empty :: TKey k => TMap k a empty = TMap emptyM@@ -167,8 +175,8 @@ alter :: TKey k => (Maybe a -> Maybe a) -> k -> TMap k a -> TMap k a alter f k (TMap m) = TMap (alterM elemSize (fmap Elem . f . fmap getElem) (toRep k) m) --- | Projects information out of an individual association pair, over all alternatives in the map.--- For example, +-- | Projects information out of, and modifies or deletes, an individual association pair, +-- alternating over all associations in the map. --  -- > minViewWithKey == getFirst (extract (\ k a -> return ((k, a), Nothing))) -- > updateMaxWithKey f m == maybe m snd (getLast (extract (\ k a -> return ((), f k a)) m))@@ -184,7 +192,7 @@  -- | Generalization of 'extract' for 'Alternative' functors. extractA :: (TKey k, Alternative f) => (k -> a -> f (x, Maybe a)) -> TMap k a -> f (x, TMap k a)-extractA f (TMap m) = second TMap <$> extractM elemSize (\ k (Elem a) -> second (fmap Elem) <$> f (fromRep k) a) m+extractA f (TMap m) = pairFromC <$> fmap TMap <$> extractM elemSize (\ k (Elem a) -> fmap (\ (x, y) -> x `cP` (Elem <$> y)) (f (fromRep k) a)) m  -- | Like 'extract', but does not modify the map. about :: (TKey k, MonadPlus m) => (k -> a -> m x) -> TMap k a -> m x@@ -416,7 +424,7 @@ thd3 (a, b, c) = c  findIndex :: TKey k => k -> TMap k a -> Int-findIndex k m = fromMaybe (error "element is not in the map") (lookupIndex k m)+k `findIndex`  m = fromMaybe (error "element is not in the map") (k `lookupIndex` m)  lookupWithIndex :: TKey k => k -> TMap k a -> Maybe (Int, k, a) lookupWithIndex k m = snd3 (neighborhood k m)@@ -445,3 +453,9 @@  keysSet :: TKey k => TMap k a -> TSet k keysSet = TSet . map (const ())++-- reverseMap :: TKey k => TMap k a -> TMap (Rev k) a+-- reverseMap (TMap m) = TMap (reverse m)++-- unReverseMap :: TKey k => TMap (Rev k) a -> TMap k a+-- unReverseMap (TMap m) = TMap (unreverse m)
+ Data/TrieMap/CPair.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE Rank2Types #-}++module Data.TrieMap.CPair where++newtype CPair a b = CP (forall r . (a -> b -> r) -> r)++pairFromC :: CPair a b -> (a, b)+pairFromC (CP k) = k (,)++pairToC :: (a, b) -> CPair a b+pairToC p = CP (\ k -> uncurry k p)++instance Functor (CPair a) where+	fmap f (CP k) = CP (\ g -> k (\ x -> g x . f))++on1st :: (a -> b) -> CPair a c -> CPair b c+on1st f (CP k) = CP (\ g -> k (g . f))++on2nd :: (b -> c) -> CPair a b -> CPair a c+on2nd f (CP k) = CP (\ g -> k (\ x -> g x . f))++cP :: a -> b -> CPair a b+x `cP` y = CP (\ k -> k x y)++cpFst :: CPair a b -> a+cpFst = cpUncurry const++cpSnd :: CPair a b -> b+cpSnd = cpUncurry (flip const)++cpUncurry :: (a -> b -> r) -> CPair a b -> r+cpUncurry f (CP k) = k f++cpCurry :: (CPair a b -> r) -> a -> b -> r+cpCurry f a b = f (a `cP` b)
Data/TrieMap/Class.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, TypeFamilies, FlexibleContexts, UndecidableInstances #-}  module Data.TrieMap.Class (TMap(..), TSet (..), TKey, TKeyT, Rep, TrieMap, TrieKey) where @@ -25,7 +25,11 @@ -- 	toRep :: k -> Rep k -- 	fromRep :: Rep k -> k +instance (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k+ class (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f++instance (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f  instance TKey k => Functor (TMap k) where 	fmap = fmapDefault
Data/TrieMap/Class/Instances.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell, CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}  module Data.TrieMap.Class.Instances where @@ -8,7 +8,7 @@ import Data.TrieMap.Rep.TH import Data.TrieMap.Rep.Instances import Data.TrieMap.Sized--- import Data.TrieMap.RadixTrie()+import Data.TrieMap.RadixTrie() import Data.TrieMap.MultiRec.Instances import Data.TrieMap.IntMap import Data.TrieMap.OrdMap@@ -21,7 +21,7 @@ import Data.TrieMap.Regular.Class import Data.TrieMap.Regular.Instances -- import Data.TrieMap.UnionMap()--- import Data.TrieMap.UnitMap()+import Data.TrieMap.UnitMap()  import Data.Bits import Data.Char@@ -50,62 +50,65 @@ 	toRep = map toRep 	fromRep = map fromRep-} -instance TKey Int-instance TKey Double-instance TKey Char-instance TKey Bool-instance TKey Word-instance TKey Int32-instance TKey Word32-instance TKey Word16-instance TKey Word8-instance TKey Int8-instance TKey Int16-instance TKey Word64-instance TKey Int64-instance TKey ()-instance TKey a => TKeyT ((,) a)-instance (TKey a, TKey b) => TKey (a, b)-instance (TKey a, TKey b) => TKeyT ((,,) a b)-instance (TKey a, TKey b, TKey c) => TKey (a, b, c)-instance (TKey a, TKey b, TKey c) => TKeyT ((,,,) a b c)-instance (TKey a, TKey b, TKey c, TKey d) => TKey (a, b, c, d)-instance TKey a => TKey (I0 a)-instance TKeyT I0-instance TKey (U0 a)-instance TKeyT U0-instance TKey a => TKey (K0 a b)-instance TKey a => TKeyT (K0 a)-instance TKeyT f => TKeyT (L f)-instance (TKeyT f, TKey a) => TKey (L f a)-instance (Functor f, TKeyT f, TKeyT g) => TKeyT (f `O` g)-instance (TKeyT f, TKeyT g, TKey a) => TKey ((f `O` g) a)-instance (TKeyT f, TKeyT g) => TKeyT (f :*: g)-instance (TKeyT f, TKeyT g, TKey a) => TKey ((f :*: g) a)-instance (TKey a, TKey b) => TKey (Either a b)-instance TKey a => TKeyT (Either a)-instance TKey a => TKey [a]-instance TKeyT []-instance TKey a => TKey (Maybe a)-instance TKeyT Maybe-instance (TKey k, TKey a) => TKey (TMap k a)-instance TKey k => TKeyT (TMap k)-instance TKeyT Set-instance TKeyT Rev-instance TKey a => TKey (Rev a)-instance TKey a => TKey (Set a)-instance TKey k => TKeyT (Map k)-instance (TKey k, TKey a) => TKey (Map k a)-instance (TKey i, Ix i) => TKeyT (Array i)-instance (TKey i, Ix i, TKey e) => TKey (Array i e)+-- instance TKey Int+-- instance TKey Double+-- instance TKey Char+-- instance TKey Bool+-- instance TKey Word+-- instance TKey Int32+-- instance TKey Word32+-- instance TKey Word16+-- instance TKey Word8+-- instance TKey Int8+-- instance TKey Int16+-- instance TKey Word64+-- instance TKey Int64+-- instance TKey ()+-- instance TKey a => TKeyT ((,) a)+-- instance (TKey a, TKey b) => TKey (a, b)+-- instance (TKey a, TKey b) => TKeyT ((,,) a b)+-- instance (TKey a, TKey b, TKey c) => TKey (a, b, c)+-- instance (TKey a, TKey b, TKey c) => TKeyT ((,,,) a b c)+-- instance (TKey a, TKey b, TKey c, TKey d) => TKey (a, b, c, d)+-- instance TKey a => TKey (I0 a)+-- instance TKeyT I0+-- instance TKey (U0 a)+-- instance TKeyT U0+-- instance TKey a => TKey (K0 a b)+-- instance TKey a => TKeyT (K0 a)+-- instance TKeyT f => TKeyT (L f)+-- instance (TKeyT f, TKey a) => TKey (L f a)+-- instance (Functor f, TKeyT f, TKeyT g) => TKeyT (f `O` g)+-- instance (TKeyT f, TKeyT g, TKey a) => TKey ((f `O` g) a)+-- instance (TKeyT f, TKeyT g) => TKeyT (f :*: g)+-- instance (TKeyT f, TKeyT g, TKey a) => TKey ((f :*: g) a)+-- instance (TKey a, TKey b) => TKey (Either a b)+-- instance TKey a => TKeyT (Either a)+-- instance TKey a => TKey [a]+-- instance TKeyT []+-- instance TKey a => TKey (Maybe a)+-- instance TKeyT Maybe+-- instance (TKey k, TKey a) => TKey (TMap k a)+-- instance TKey k => TKeyT (TMap k)+-- instance TKeyT Set+-- instance TKeyT Rev+-- instance TKey a => TKey (Rev a)+-- instance TKey a => TKey (Set a)+-- instance TKey k => TKeyT (Map k)+-- instance (TKey k, TKey a) => TKey (Map k a)+-- instance (TKey i, Ix i) => TKeyT (Array i)+-- instance (TKey i, Ix i, TKey e) => TKey (Array i e)  type instance RepT (TMap k) = L (K0 (Rep k) :*: I0) type instance Rep (TMap k a) = RepT (TMap k) (Rep a) +-- instance (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k+-- instance (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f+ instance TKey k => ReprT (TMap k) where 	toRepTMap f (TMap m) = List (foldWithKeyM (\ k (Elem a) xs -> (K0 k :*: I0 (f a)):xs) m []) 	fromRepTMap f (List xs) = TMap (fromDistAscListM (const 1) [(k, Elem (f a)) | (K0 k :*: I0 a) <- xs])-+{- instance (TKey k, Repr a) => Repr (TMap k a) where 	toRep = toRepTMap toRep-	fromRep = fromRepTMap fromRep+	fromRep = fromRepTMap fromRep-}
Data/TrieMap/IntMap.hs view
@@ -3,10 +3,11 @@ module Data.TrieMap.IntMap () where  import Data.TrieMap.TrieKey-import Data.TrieMap.MultiRec.Base-import Data.TrieMap.Applicative+-- import Data.TrieMap.MultiRec.Base+-- import Data.TrieMap.Applicative import Data.TrieMap.Sized-import Data.TrieMap.ReverseMap+import Data.TrieMap.CPair+-- import Data.TrieMap.ReverseMap -- import Data.TrieMap.Rep -- import Data.TrieMap.Rep.TH @@ -18,16 +19,16 @@ import Data.Maybe import Data.Monoid import Data.Word-import Data.Int+-- import Data.Int -#if __GLASGOW_HASKELL__ >= 503-import GHC.Exts ( Word(..), Int(..), shiftRL# )-#elif __GLASGOW_HASKELL__-import Word-import GlaExts ( Word(..), Int(..), shiftRL# )-#else-import Data.Word-#endif+-- #if __GLASGOW_HASKELL__ >= 503+-- import GHC.Exts ( Word(..), Int(..), shiftRL# )+-- #elif __GLASGOW_HASKELL__+-- import Word+-- import GlaExts ( Word(..), Int(..), shiftRL# )+-- #else+-- import Data.Word+-- #endif  import Prelude hiding (lookup, null, foldl, foldr) @@ -72,6 +73,7 @@ 	assocAtM s = assocAt s 0 -- 	updateAtM s r = updateAt s r 0 	alterM = alter+	alterLookupM = alterLookup 	traverseWithKeyM = traverseWithKey 	foldWithKeyM = foldr 	foldlWithKeyM = foldl@@ -161,22 +163,7 @@ 	| k == kx	= Just x lookup _ _ = Nothing -{--lookupIx :: Nat -> WordMap a -> Maybe (Int, a)-lookupIx k t = case t of-	Bin _ 0 m l r | m < 0	-> if zeroN k (natFromInt m) then lookupIx' (size r) k l else lookupIx' 0 k r-	Bin{}	-> lookupIx' 0 k t-	Tip _ k x -> return (0, x)-	Nil	-> Nothing-} --- assocAt :: Int -> WordMap a -> Maybe (Int, Key, a)--- assocAt !i t = case t of--- 	Bin _ 0 m l r | m < 0	-> let sr = size r in--- 		if i < sr then assocAt' 0 i r else assocAt' sr (i - sr) l--- 	Bin{} -> assocAt' 0 i t--- 	Tip _ k x -> return (0, k, x)--- 	_	-> Nothing- assocAt :: Sized a -> Int -> Int -> WordMap a -> IndexPos Key a assocAt s !i0 !i (Bin _ _ _ l r) 	| i < sl, (lb, x, ub) <- assocAt s i0 i l@@ -187,14 +174,6 @@ assocAt _ i0 _ (Tip _ k x) = (mzero, return (Asc i0 k x), mzero) assocAt _ _ _ _ = (mzero, mzero, mzero) --- updateAt :: Sized a -> (Int -> Key -> a -> Maybe (a)) -> Int -> WordMap a -> WordMap a--- updateAt s f !i t = case t of--- 	Bin _ 0 m l r | m < 0	-> let sr = size r in--- 		if i < sr then updateAt' s 0 f i r else updateAt' s sr f (i - sr) l--- 	Bin{}	-> updateAt' s 0 f i t--- 	Tip _ kx x -> singletonMaybe s kx (f 0 kx x)--- 	Nil	-> Nil- updateAt :: Sized a -> Round -> Int -> (Int -> Key -> a -> Maybe (a)) -> Int -> WordMap a -> WordMap a updateAt s True !i0 f !i t = case t of 	Bin _ p m l r -> let sl = size l in@@ -240,20 +219,26 @@ 		| otherwise	-> Tip sz ky y 	Nil	-> singletonMaybe s k (f Nothing) +alterLookup :: Sized a -> (Maybe a -> CPair x (Maybe a)) -> Key -> WordMap a -> CPair x (WordMap a)+alterLookup s f k t = case t of+	Bin sz p m l r+		| nomatch k p m+			-> fmap (\ v -> join k (singletonMaybe s k v) p t) (f Nothing)+		| zero k m+			-> fmap (\ l' -> bin p m l' r) (alterLookup s f k l)+		| otherwise+			-> fmap (\ r' -> bin p m l r') (alterLookup s f k r)+	Tip sz ky y+		| k == ky	-> singletonMaybe s k <$> f (Just y)+		| otherwise	-> fmap (\ v -> join k (singletonMaybe s k v) ky t) (f Nothing)+	Nil	-> singletonMaybe s k <$> f Nothing+ traverseWithKey :: Applicative f => Sized b -> (Key -> a -> f (b)) -> WordMap a -> f (WordMap b) traverseWithKey s f t = case t of 	Nil		-> pure Nil 	Tip _ kx x	-> singleton s kx <$> f kx x 	Bin _ p m l r	-> bin p m <$> traverseWithKey s f l <*> traverseWithKey s f r --- foldr :: (Key -> a -> b -> b) -> WordMap a -> b -> b--- foldr f t---   = case t of---       Bin _ 0 m l r | m < 0 -> foldr' f r . foldr' f l  -- put negative numbers before.---       Bin _ _ _ _ _ -> foldr' f t---       Tip _ k x     -> f k x---       Nil         -> id- foldr :: (Key -> a -> b -> b) -> WordMap a -> b -> b foldr f t   = case t of@@ -261,13 +246,7 @@       Tip _ k x     -> f k x       Nil         -> id -foldl{-, foldl' -}:: (Key -> b -> a -> b) -> WordMap a -> b -> b-{-foldl f t-  = case t of-      Bin _ 0 m l r | m < 0 -> foldl' f l . foldl' f r  -- put negative numbers before.-      Bin _ _ _ _ _ -> foldl' f t-      Tip _ k x     -> flip (f k) x-      Nil           -> id-}+foldl :: (Key -> b -> a -> b) -> WordMap a -> b -> b foldl f t   = case t of       Bin _ _ _ l r -> foldl f r . foldl f l@@ -281,20 +260,6 @@ mapEither s1 s2 f (Tip _ kx x) = (singletonMaybe s1 kx *** singletonMaybe s2 kx) (f kx x)  splitLookup :: Sized a -> SplitMap (a) x -> Key -> WordMap a -> (WordMap a ,Maybe x,WordMap a)-{-splitLookup s f k t-  = 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 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)-        | k<ky      -> (Nil,Nothing,t)-        | otherwise -> singletonMaybe s k `sides` f y-      Nil -> (Nil,Nothing,Nil)--splitLookup' :: Sized a -> SplitMap (a) x -> Key -> WordMap a -> (WordMap a ,Maybe x,WordMap a)-} splitLookup s f k t   = case t of       Bin _ p m l r@@ -398,17 +363,16 @@ isSubmapOfBy (<=) (Tip _ k x) t     = maybe False (x <=) (lookup (natFromInt k) t) isSubmapOfBy _         Nil _           = True -extract :: Alternative f => Sized a -> (Key -> a -> f (x, Maybe a)) -> WordMap a -> f (x, WordMap a)+extract :: Alternative f => Sized a -> (Key -> a -> f (CPair x (Maybe a))) -> WordMap a -> f (CPair x (WordMap a)) extract s f t = case t of-	Bin _ p m l r -> second (\ l' -> bin p m l' r) <$> extract s f l-				<|> second (bin p m l) <$> extract s f r-	Tip _ k x -> second (singletonMaybe s k) <$> f k x+	Bin _ p m l r -> fmap (\ l' -> bin p m l' r) <$> extract s f l+				<|> fmap (bin p m l) <$> extract s f r+	Tip _ k x -> fmap (singletonMaybe s k) <$> f k x 	Nil -> empty  maxViewWithKey, minViewWithKey :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> Maybe (x, WordMap a) maxViewWithKey s f t     = case t of---         Bin _ p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in Just (result, bin p m t' r)         Bin _ p m l r         -> let (result, t') = maxViewUnsigned s f r in Just (result, bin p m l t')         Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)         Nil -> Nothing@@ -420,16 +384,12 @@         Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)         Nil -> error "maxViewUnsigned Nil" --- --- minViewWithKey :: WordMap a -> Maybe ((Key, a), WordMap a) minViewWithKey s f t     = case t of---         Bin _ p m l r | m < 0 -> let (result, t') = minViewUnsigned r in Just (result, bin p m l t')-        Bin _ p m l r         -> let (result, t') = minViewUnsigned s f l in Just (result, bin p m t' r)+        Bin _ p m l r -> let (result, t') = minViewUnsigned s f l in Just (result, bin p m t' r)         Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)         Nil -> Nothing --- minViewUnsigned :: WordMap a -> ((Key, a), WordMap a) minViewUnsigned s f t      = case t of         Bin _ p m l r -> let (result,t') = minViewUnsigned s f l in (result,bin p m t' r)@@ -439,7 +399,6 @@ updateMinWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a updateMinWithKey s f t     = case t of---         Bin _ p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned s f r in bin p m l t'         Bin _ p m l r         -> let t' = updateMinWithKeyUnsigned s f l in bin p m t' r         Tip _ k y -> singletonMaybe s k (f k y)         Nil -> Nil@@ -454,7 +413,6 @@ updateMaxWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a updateMaxWithKey s f t     = case t of---         Bin _ p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned s f l in bin p m t' r         Bin _ p m l r         -> let t' = updateMaxWithKeyUnsigned s f r in bin p m l t'         Tip _ k y -> singletonMaybe s k (f k y)         Nil -> Nil@@ -518,53 +476,3 @@ bin _ _ l Nil = l bin _ _ Nil r = r bin p m l r   = Bin (size l + size r) p m l r---- import Data.Monoid--- import Data.WordMap--- import qualified Data.WordMap as IMap--- import Data.Traversable--- --- newtype IntTMap a = ITMap (WordMap (a))--- type instance TrieMap Int = IntTMap--- newtype MaybeF a = MF {unF :: Maybe (a)}--- --- instance TrieKey Int IntTMap where--- 	emptyM = ITMap empty--- 	nullM (ITMap m) = IMap.null m--- 	alterM _ f k (ITMap m) = ITMap (IMap.alter f k m)--- 	lookupM k (ITMap m) = IMap.lookup k m--- 	traverseWithKeyM _ f (ITMap m) = (ITMap . IMap.fromDistinctAscList) <$>--- 		sequenceA (IMap.foldWithKey (\ k a xs -> (((,) k) <$> f k a):xs) [] m)--- 	foldWithKeyM f (ITMap m) z = IMap.foldWithKey f z m--- 	foldlWithKeyM f (ITMap m) z = foldl (\ z (k, a) -> f k z a) z (IMap.assocs m)--- 	mapEitherM _ _ f (ITMap m) = (ITMap (mapMaybe fst m'), ITMap (mapMaybe snd m')) where--- 		m' = mapWithKey f m--- 	splitLookupM _ f k (ITMap m) = ITMap `sides` case splitLookup k m of--- 		(mL, x, mR)--- 			| Nothing <- x	-> (mL, Nothing, mR)--- 			| Just x <- x, (xL, x, xR) <- f x--- 				-> (mIns k mL xL, x, mIns k mR xR)--- 		where	mIns k m = maybe m (\ x -> IMap.insert k x m)--- 	unionM _ f (ITMap m1) (ITMap m2) = ITMap (mapMaybe unF (unionWithKey f' m1' m2')) where--- 		f' k (MF a) (MF b) = MF (unionMaybe (f k) a b)--- 		m1' = fmap (MF . Just) m1--- 		m2' = fmap (MF . Just) m2--- 	isectM _ f (ITMap m1) (ITMap m2) = ITMap (mapMaybe unF (intersectionWithKey f' m1' m2')) where--- 		f' k (MF a) (MF b) = MF (isectMaybe (f k) a b)--- 		m1' = fmap (MF . Just) m1--- 		m2' = fmap (MF . Just) m2--- 	diffM _ f (ITMap m1) (ITMap m2) = ITMap (differenceWithKey f m1 m2)--- 	extractMinM _ (ITMap m) = fmap ITMap <$> First (minViewWithKey m)--- 	extractMaxM _ (ITMap m) = fmap ITMap <$> Last (maxViewWithKey m)--- 	alterMinM _ f (ITMap m) = ITMap $ case minViewWithKey m of--- 		Just ((k, v), m') --- 				-> maybe m' (\ v' -> updateMin (const v') m) (f k v)--- 		Nothing		-> m--- 	alterMaxM _ f (ITMap m) = ITMap $ case maxViewWithKey m of--- 		Just ((k, v), m')--- 				-> maybe m' (\ v' -> updateMax (const v') m) (f k v)--- 		Nothing		-> m--- 	isSubmapM (<=) (ITMap m1) (ITMap m2) = isSubmapOfBy (<=) m1 m2--- 	fromListM _ = ITMap .: fromListWithKey--- 	fromAscListM _ = ITMap .: fromAscListWithKey--- 	fromDistAscListM _ = ITMap . fromDistinctAscList
Data/TrieMap/MultiRec.hs view
@@ -1,4 +1,4 @@-module Data.TrieMap.MultiRec (HTrieKey, HTrieKeyT, Family(..), HEq0(..), HOrd0(..), HOrd(..)) where+module Data.TrieMap.MultiRec (HTrieKeyT, HTrieKey, HTrieMapT, HTrieMap, Family(..), HOrd(..)) where  import Data.TrieMap.MultiRec.Class import Data.TrieMap.MultiRec.FamMap
Data/TrieMap/MultiRec/Base.hs view
@@ -1,26 +1,26 @@ {-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, ExistentialQuantification, KindSignatures, FlexibleInstances, MultiParamTypeClasses #-} -module Data.TrieMap.MultiRec.Base (module Generics.MultiRec.Base, module Generics.MultiRec.HFix, {-A0(..), X(..), -}Family(..), FamT(..), KeyFam(..), FunctorT (..), breakEither) where+module Data.TrieMap.MultiRec.Base (module Generics.MultiRec.Base, module Generics.MultiRec.HFix, {-A0(..), X(..), -}Family(..)) where --, FamT(..), KeyFam(..), FunctorT (..), breakEither) where -import Data.TrieMap.TrieKey+-- import Data.TrieMap.TriseKey -import Generics.MultiRec+-- import Generics.MultiRec import Generics.MultiRec.Base import Generics.MultiRec.HFix -import Control.Applicative+-- import Control.Applicative  -- newtype A f (r :: * -> *) ix = A {unA :: f r ix} -- newtype A0 (r :: * -> *) ix = A0 {unA0 :: r ix} -- newtype R (r1 :: * -> *) (r :: * -> *) ix = Rec {unRec :: r1 (r ix)} -- newtype X (r :: * -> *) ix = X {unX :: ix}-newtype Family (phi :: * -> *) ix = F ix+newtype Family (phi :: * -> *) ix = F {unF :: ix} -data KeyFam k = TrieKey k (TrieMap k) => KF-newtype FamT (phi :: * -> *) f ix = FamT (f ix)+-- data KeyFam k = TrieKey k (TrieMap k) => KF+-- newtype FamT (phi :: * -> *) f ix = FamT (f ix) -instance TrieKey k (TrieMap k) => El KeyFam k where-	proof = KF+-- instance TrieKey k (TrieMap k) => El KeyFam k where+-- 	proof = KF  -- instance HFunctor phi f => HFunctor phi (A f) where -- 	hmapA f pf (A x) = A <$> hmapA f pf x@@ -33,21 +33,21 @@  -- instance HEq phi A0 where -- 	heq f pf (A0 x) (A0 y) = f pf x y-+{- class FunctorT f where 	fmapp :: Functor r => (a -> b) -> f r a -> f r b -instance FunctorT (FamT phi) where-	fmapp f (FamT x) = FamT (fmap f x)+-- instance FunctorT (FamT phi) where+-- 	fmapp f (FamT x) = FamT (fmap f x)  instance Functor (Family phi) where 	fmap f (F x) = F (f x) -instance Functor f => Functor (FamT phi f) where-	fmap = fmapp+-- instance Functor f => Functor (FamT phi f) where+-- 	fmap = fmapp -instance FunctorT (K k) where-	fmapp = fmap+-- instance FunctorT (K k) where+-- 	fmapp = fmap  instance Functor (K k r) where 	fmap f (K a) = K a@@ -98,6 +98,7 @@  instance FunctorT f => Functor (HFix f) where 	fmap f (HIn x) = HIn (fmapp f x)+-}  breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)]) breakEither = foldr breakEither' ([], []) where
Data/TrieMap/MultiRec/Class.hs view
@@ -1,135 +1,179 @@-{-# LANGUAGE Rank2Types, FunctionalDependencies, FlexibleContexts, KindSignatures, TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators, Rank2Types, FunctionalDependencies, FlexibleContexts, KindSignatures, TypeFamilies, MultiParamTypeClasses #-}  module Data.TrieMap.MultiRec.Class where +-- import Data.TrieMap.Regular.Class+import Data.TrieMap.CPair import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.MultiRec.Eq+-- import Data.TrieMap.MultiRec.Eq import Data.TrieMap.MultiRec.Ord+-- import Data.TrieMap.Regular.Ord+import Data.TrieMap.MultiRec.Base+-- import Data.TrieMap.MultiRec.KeyFam import Data.TrieMap.TrieKey import Data.TrieMap.Applicative  import Control.Applicative-import Data.Monoid-import Generics.MultiRec.Eq+-- import Data.Monoid+-- import Generics.MultiRec.Eq  type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> * -> * -> * type family HTrieMap (phi :: * -> *) (r :: * -> *) :: * -> * -> *  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 ix a-	nullT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a -> Bool-	sizeT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> m r ix a -> Int-	lookupT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> f r ix -> m r ix a -> Maybe a-	lookupIxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> f r ix -> m r ix a -> IndexPos (f r ix) a-	assocAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> Int -> m r ix a -> IndexPos (f r ix) a--- 	updateAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	emptyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a+	nullH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a -> Bool+	sizeH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> m r ix a -> Int+	lookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> f r ix -> m r ix a -> Maybe a+	lookupIxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> f r ix -> m r ix a -> IndexPos (f r ix) a+	assocAtH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> Int -> m r ix a -> IndexPos (f r ix) a+-- 	updateAtH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  -- 		phi ix -> HSized phi a -> Round -> (Int -> f r ix -> a -> Maybe a) -> Int -> m r ix a -> m r ix a-	alterT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => -		phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> f r ix ->-			m r ix a -> m r ix a-	{-# SPECIALIZE traverseWithKeyT :: HTrieKey phi r =>-		phi ix -> HSized phi b -> (f r ix -> ix a -> Id b) -> m r ix a -> Id (m r ix b) #-}-	traverseWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Applicative t) =>+	alterH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +		phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> f r ix -> m r ix a -> m r ix a+	alterLookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>+		phi ix -> HSized phi a -> (Maybe a -> CPair x (Maybe a)) -> f r ix ->+			m r ix a -> CPair x (m r ix a)+-- 	{-# SPECIALIZE traverseWithKeyH :: HTrieKey phi r (HTrieMap phi r) =>+-- 		phi ix -> HSized phi b -> (f r ix -> ix a -> Id b) -> m r ix a -> Id (m r ix b) #-}+	traverseWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Applicative t) => 		phi ix -> HSized phi b -> (f r ix -> a -> t b) -> m r ix a -> t (m r ix b)-	foldWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	foldWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> (f r ix -> a -> b -> b) -> m r ix a -> b -> b-	foldlWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>+	foldlWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 		phi ix -> (f r ix -> b -> a -> b) -> m r ix a -> b -> b-	mapEitherT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> +	mapEitherH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix ->  		HSized phi b -> HSized phi c -> EitherMap (f r ix) a b c -> m r ix a -> (m r ix b, m r ix c)-	splitLookupT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	splitLookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> HSized phi a -> SplitMap a x -> f r ix -> 			m r ix a -> (m r ix a, Maybe x, m r ix a)-	unionT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	unionH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> HSized phi a -> UnionFunc (f r ix) a -> 			m r ix a -> m r ix a -> m r ix a-	isectT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	isectH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> HSized phi c -> IsectFunc (f r ix) a b c -> m r ix a -> m r ix b -> m r ix c-	diffT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>+	diffH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 		phi ix -> HSized phi a -> DiffFunc (f r ix) a b -> m r ix a -> m r ix b -> m r ix a-	extractT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Alternative t) =>+	extractH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Alternative t) => 		phi ix -> HSized phi a -> ExtractFunc t (m r ix a) (f r ix) a x--- 	extractMinT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +-- 	extractMinH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  -- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) First a (m r ix a) x--- 	extractMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +-- 	extractMaxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  -- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) Last a (m r ix a) x -- 	alterMinT:: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  -- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> First (m r ix a)--- 	alterMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +-- 	alterMaxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  -- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> Last (m r ix a)-	isSubmapT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	isSubmapH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> LEq a b -> LEq (m r ix a) (m r ix b)-	fromListT, fromAscListT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	fromListH, fromAscListH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> HSized phi a -> (f r ix -> a -> a -> a ) -> [(f r ix, a )] -> m r ix a-	fromDistAscListT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => +	fromDistAscListH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		phi ix -> HSized phi a -> [(f r ix, a )] -> m r ix a-	sizeT pf s m = foldWithKeyT pf (\ _ x n -> s x + n) m 0-	fromListT pf s f = foldr (\ (k, a) -> alterT pf s (Just . maybe a (f k a)) k) (emptyT pf)-	fromAscListT = fromListT-	fromDistAscListT pf s = fromAscListT pf s (const const)--class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where-	emptyH :: m ~ HTrieMap phi r => phi ix -> m ix a-	nullH :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool-	sizeH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> m ix a -> Int-	lookupH :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a-	alterH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a-	lookupIxH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a-	assocAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a--- 	updateAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Round -> (Int -> r ix -> a -> Maybe a) -> Int -> m ix a -> m ix a-	{-# SPECIALIZE traverseWithKeyH :: phi ix -> (r ix -> ix a -> Id b) ->-		m ix a -> Id (m ix b) #-}-	traverseWithKeyH :: (m ~ HTrieMap phi r, Applicative f) => -		phi ix -> HSized phi b -> (r ix -> a -> f b) -> m ix a -> f (m ix b)-	foldWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b-	foldlWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b-	mapEitherH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi b -> HSized phi c ->-		EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)-	splitLookupH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> SplitMap a x -> r ix -> m ix a ->-				(m ix a, Maybe x, m ix a)-	unionH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> UnionFunc (r ix) a -> m ix a -> m ix a-			-> m ix a-	isectH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi c -> IsectFunc (r ix) a b c ->-			m ix a -> m ix b -> m ix c-	diffH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->-			m ix a -> m ix b -> m ix a-	extractH :: (m ~ HTrieMap phi r, Alternative t) =>-		phi ix -> HSized phi a -> ExtractFunc t (m ix a) (r ix) a x--- 	extractMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) First a (m ix a) x--- 	extractMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) Last a (m ix a) x--- 	alterMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->--- 		m ix a -> First (m ix a)--- 	alterMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->--- 		m ix a -> Last (m ix a)-	isSubmapH :: m ~ HTrieMap phi r => -		phi ix -> LEq a b -> LEq (m ix a) (m ix b)-	fromListH, fromAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> a -> a) ->-		[(r ix, a)] -> m ix a-	fromDistAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a 	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s x + n) m 0 	fromListH pf s f = foldr (\ (k, a) -> alterH pf s (Just . maybe a (f k a)) k) (emptyH pf) 	fromAscListH = fromListH 	fromDistAscListH pf s = fromAscListH pf s (const const) -mapWithKeyT :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) =>-	phi ix -> HSized phi b -> (f r ix -> a -> b ) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b-mapWithKeyT pf s f m = unId (traverseWithKeyT pf s (Id .: f) m)+class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where+	empty0 :: m ~ HTrieMap phi r => phi ix -> m ix a+	null0 :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool+	size0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> m ix a -> Int+	lookup0 :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a+	lookupIx0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a+	assocAt0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a+	alter0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a+	alterLookup0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (Maybe a -> CPair z (Maybe a))+				-> r ix -> m ix a -> CPair z (m ix a)+	extract0 :: (m ~ HTrieMap phi r, Alternative t) => phi ix -> HSized phi a ->+		ExtractFunc t (m ix a) (r ix) a x+	traverseWithKey0 :: (m ~ HTrieMap phi r, Applicative t) => phi ix -> HSized phi b ->+		(r ix -> a -> t b) -> m ix a -> t (m ix b)+	foldWithKey0 :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b+	foldlWithKey0 :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b+	mapEither0 :: m ~ HTrieMap phi r => phi ix -> HSized phi b -> HSized phi c -> EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)+	splitLookup0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> SplitMap a x ->+		r ix -> m ix a -> (m ix a, Maybe x, m ix a)+	union0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> UnionFunc (r ix) a ->+		m ix a -> m ix a -> m ix a+	isect0 :: m ~ HTrieMap phi r => phi ix -> HSized phi c -> IsectFunc (r ix) a b c->+		m ix a -> m ix b -> m ix c+	diff0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->+		m ix a -> m ix b -> m ix a+	isSubmap0 :: m ~ HTrieMap phi r => phi ix -> LEq a b -> LEq (m ix a) (m ix b)+	fromList0, fromAscList0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (r ix -> a -> a -> a) -> [(r ix, a)] -> m ix a+	fromDistAscList0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a+	 -mapWithKeyH :: (HTrieKey phi r (HTrieMap phi r)) =>-	phi ix -> HSized phi b -> (r ix -> a -> b) -> HTrieMap phi r ix a -> HTrieMap phi r ix b+-- class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where+-- 	emptyH :: m ~ HTrieMap phi r => phi ix -> m ix a+-- 	nullH :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool+-- 	sizeH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> m ix a -> Int+-- 	lookupH :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a+-- 	alterH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a+-- 	lookupIxH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a+-- 	assocAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a+-- -- 	updateAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Round -> (Int -> r ix -> a -> Maybe a) -> Int -> m ix a -> m ix a+-- 	{-# SPECIALIZE traverseWithKeyH :: phi ix -> (r ix -> ix a -> Id b) ->+-- 		m ix a -> Id (m ix b) #-}+-- 	traverseWithKeyH :: (m ~ HTrieMap phi r, Applicative f) => +-- 		phi ix -> HSized phi b -> (r ix -> a -> f b) -> m ix a -> f (m ix b)+-- 	foldWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b+-- 	foldlWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b+-- 	mapEitherH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi b -> HSized phi c ->+-- 		EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)+-- 	splitLookupH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> SplitMap a x -> r ix -> m ix a ->+-- 				(m ix a, Maybe x, m ix a)+-- 	unionH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> UnionFunc (r ix) a -> m ix a -> m ix a+-- 			-> m ix a+-- 	isectH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi c -> IsectFunc (r ix) a b c ->+-- 			m ix a -> m ix b -> m ix c+-- 	diffH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->+-- 			m ix a -> m ix b -> m ix a+-- 	extractH :: (m ~ HTrieMap phi r, Alternative t) =>+-- 		phi ix -> HSized phi a -> ExtractFunc t (m ix a) (r ix) a x+-- -- 	extractMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) First a (m ix a) x+-- -- 	extractMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) Last a (m ix a) x+-- -- 	alterMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->+-- -- 		m ix a -> First (m ix a)+-- -- 	alterMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->+-- -- 		m ix a -> Last (m ix a)+-- 	isSubmapH :: m ~ HTrieMap phi r => +-- 		phi ix -> LEq a b -> LEq (m ix a) (m ix b)+-- 	fromListH, fromAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> a -> a) ->+-- 		[(r ix, a)] -> m ix a+-- 	fromDistAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a+-- 	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s x + n) m 0+-- 	fromListH pf s f = foldr (\ (k, a) -> alterH pf s (Just . maybe a (f k a)) k) (emptyH pf)+-- 	fromAscListH = fromListH+-- 	fromDistAscListH pf s = fromAscListH pf s (const const)+-- +-- mapWithKeyH :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) =>+-- 	phi ix -> HSized phi b -> (f r ix -> a -> b ) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b+-- mapWithKeyT pf s f m = unId (traverseWithKeyT pf s (Id .: f) m)+-- +-- mapWithKeyH :: (HTrieKey phi r (HTrieMap phi r), HTrieKeyT phi f (HTrieMapT phi f)) =>+-- 	phi ix -> HSized phi b -> (r ix -> a -> b) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b mapWithKeyH pf s f m = unId (traverseWithKeyH pf s (Id .: f) m)--guardNullT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) => +-- +guardNullH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) =>  	phi ix -> m r ix a -> Maybe (m r ix a)-guardNullT pf m-	| nullT pf m	= Nothing+guardNullH pf m+	| nullH pf m	= Nothing 	| otherwise	= Just m---- alterMaxT, alterMinT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) =>--- 	phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> m r ix a--- alterMaxT pf s f m = maybe m snd $ getLast (extractMaxT pf s (\ k a -> ((), f k a)) m)--- alterMinT pf s f m = maybe m snd $ getFirst (extractMinT pf s (\ k a -> ((), f k a)) m)--aboutT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r), Alternative t) =>+-- +-- -- alterMaxT, alterMinH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) =>+-- -- 	phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> m r ix a+-- -- alterMaxT pf s f m = maybe m snd $ getLast (extractMaxT pf s (\ k a -> ((), f k a)) m)+-- -- alterMinT pf s f m = maybe m snd $ getFirst (extractMinT pf s (\ k a -> ((), f k a)) m)+-- +aboutH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r), Alternative t) => 	phi ix -> (f r ix -> a -> t z) -> m r ix a -> t z-aboutT pf f m = fst <$> extractT pf (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a)) m+aboutH pf f m = cpFst <$> extractH pf (const 0) (\ k a -> fmap (flip cP Nothing) (f k a)) m++breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)])+breakEither [] = ([], [])+breakEither ((L k, a):xs) = case breakEither xs of+	(ys, zs) -> ((k, a):ys, zs)+breakEither ((R k, a):xs) = case breakEither xs of+	(ys, zs) -> (ys, (k, a):zs)
Data/TrieMap/MultiRec/ConstMap.hs view
@@ -3,9 +3,10 @@ module Data.TrieMap.MultiRec.ConstMap () where  import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.Applicative+-- import Data.TrieMap.MultiRec.Eq+-- import Data.TrieMap.MultiRec.Sized+-- import Data.TrieMap.MultiRec.KeyFam+-- import Data.TrieMap.Applicative import Data.TrieMap.TrieKey -- import Data.TrieMap.Rep -- import Data.TrieMap.Rep.TH@@ -14,13 +15,13 @@ import Control.Arrow import Control.Monad -import Data.Maybe-import Data.Foldable+-- import Data.Maybe+-- import Data.Foldable import Generics.MultiRec  newtype KMap (phi :: * -> *) m (r :: * -> *) ix a = KMap (m a) type instance HTrieMapT phi (K k) = KMap phi (TrieMap k)-type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r+-- type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r  -- type instance RepT (KMap phi m r ix) = RepT m -- type instance Rep (KMap phi m r ix a) = RepT m (Rep a)@@ -31,55 +32,20 @@ -- 	fromRepT = KMap . fromRepT |])  instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where-	emptyT = emptyH-	nullT = nullH-	sizeT = sizeH-	lookupT = lookupH-	lookupIxT = lookupIxH-	assocAtT = assocAtH--- 	updateAtT = updateAtH-	alterT = alterH-	traverseWithKeyT = traverseWithKeyH-	foldWithKeyT = foldWithKeyH-	foldlWithKeyT = foldlWithKeyH-	mapEitherT = mapEitherH-	splitLookupT = splitLookupH-	unionT = unionH-	isectT = isectH-	diffT = diffH-	extractT = extractH--- 	extractMinT = extractMinH--- 	extractMaxT = extractMaxH--- 	alterMinT = alterMinH--- 	alterMaxT = alterMaxH-	isSubmapT = isSubmapH-	fromListT = fromListH-	fromAscListT = fromAscListH-	fromDistAscListT = fromDistAscListH--instance TrieKey k m => HTrieKey phi (K k r) (KMap phi m r) where 	emptyH _ = KMap emptyM 	nullH _ (KMap m) = nullM m-	sizeH _ s (KMap m) = sizeM (s) m 	lookupH _ (K k) (KMap m) = lookupM k m 	lookupIxH _ s (K k) (KMap m) = onKey K (lookupIxM s k m) 	assocAtH _ s i (KMap m) = onKey K (assocAtM s i m)--- 	updateAtH _ s r f i (KMap m) = KMap (updateAtM s r (\ i -> f i . K) i m)-	alterH pf s f (K k) (KMap m) = KMap (alterM (s) f k m)-	traverseWithKeyH pf s f (KMap m) = KMap <$> traverseWithKeyM (s) (f . K) m+	alterH _ s f (K k) (KMap m) = KMap (alterM s f k m)+	alterLookupH _ s f (K k) (KMap m) = KMap <$> alterLookupM s f k m+	traverseWithKeyH _ s f (KMap m) = KMap <$> traverseWithKeyM s (f . K) m 	foldWithKeyH _ f (KMap m) = foldWithKeyM (f . K) m 	foldlWithKeyH _ f (KMap m) = foldlWithKeyM (f . K) m-	mapEitherH pf s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM (s1) (s2) (f . K) m)-	splitLookupH pf s f (K k) (KMap m) = KMap `sides` splitLookupM (s) f k m-	unionH pf s f (KMap m1) (KMap m2) = KMap (unionM (s) (f . K) m1 m2)-	isectH pf s f (KMap m1) (KMap m2) = KMap (isectM (s) (f . K) m1 m2)-	diffH pf s f (KMap m1) (KMap m2) = KMap (diffM (s) (f . K) m1 m2)-	extractH pf s f (KMap m) = second KMap <$> extractM s (f . K) m--- 	extractMinH pf s f (KMap m) = second KMap <$> extractMinM (s) (f . K) m--- 	extractMaxH pf s f (KMap m) = second KMap <$> extractMaxM s (f . K) m--- 	alterMinH pf s f (KMap m) = KMap <$> alterMinM (s) (f . K) m--- 	alterMaxH pf s f (KMap m) = KMap <$> alterMaxM (s) (f . K) m+	mapEitherH _ s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM s1 s2 (f . K) m)+	splitLookupH _ s f (K k) (KMap m) = KMap `sides` splitLookupM s f k m+	unionH _ s f (KMap m1) (KMap m2) = KMap (unionM s (f . K) m1 m2)+	isectH _ s f (KMap m1) (KMap m2) = KMap (isectM s (f . K) m1 m2)+	diffH _ s f (KMap m1) (KMap m2) = KMap (diffM s (f . K) m1 m2)+	extractH _ s f (KMap m) = fmap KMap <$> extractM s (f . K) m 	isSubmapH _ (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2-	fromListH pf s f xs = KMap (fromListM (s) (f . K) [(k, a) | (K k, a) <- xs])-	fromAscListH pf s f xs = KMap (fromAscListM (s) (f . K) [(k, a) | (K k, a) <- xs])-	fromDistAscListH pf s xs = KMap (fromDistAscListM (s) [(k, a) | (K k, a) <- xs])
Data/TrieMap/MultiRec/Eq.hs view
@@ -2,18 +2,28 @@  module Data.TrieMap.MultiRec.Eq where -import Data.TrieMap.MultiRec.Base-import Generics.MultiRec.HFix+-- import Data.TrieMap.MultiRec.Base+-- import Generics.MultiRec.HFix import Generics.MultiRec.Eq+-- import Data.TrieMap.Regular.Eq +-- class HEq phi r where+-- 	heqH :: phi ix -> r ix -> r ix -> Bool++-- class EqFam phi where+-- 	eqF :: phi ix -> (ix -> ix -> Bool)+ class HEq0 phi r where-	heqH :: phi ix -> r ix -> r ix -> Bool+	heq0 :: phi ix -> r ix -> r ix -> Bool  heqT :: (HEq phi f, HEq0 phi r) => phi ix -> f r ix -> f r ix -> Bool+heqT = heq heq0+{-+heqT :: (HEq phi f, HEq0 phi r) => phi ix -> f r ix -> f r ix -> Bool heqT = heq heqH  instance Eq k => HEq0 phi (K k r) where-	heqH _ (K x) (K y) = x == y+	heqH _ (K x) (K y) = x == y-} {- instance HEq0 phi r => HEq0 phi (A0 r) where 	heqH pf (A0 x) (A0 y) = heqH pf x y-}@@ -21,24 +31,24 @@ -- instance (HEq phi f, HEq0 phi r) => HEq0 phi (A f r) where -- 	heqH pf (A x) (A y) = heqT pf x y -instance (El phi xi, HEq0 phi r) => HEq0 phi (I xi r) where-	heqH pf (I x) (I y) = heqH (proofOn pf) x y where-		proofOn :: El phi xi => phi ix -> phi xi-		proofOn _ = proof--instance HEq0 phi (U r) where-	heqH _ _ _ = True--instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :*: g) r) where-	heqH pf (x1 :*: y1) (x2 :*: y2) = heqT pf x1 x2 && heqT pf y1 y2--instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :+: g) r) where-	heqH pf (L x) (L y) = heqT pf x y-	heqH pf (R x) (R y) = heqT pf x y-	heqH _ _ _ = False--instance (HEq phi f, HEq0 phi r) => HEq0 phi ((f :>: ix) r) where-	heqH pf (Tag x) (Tag y) = heqT pf x y--instance HEq phi f => HEq0 phi (HFix f) where-	heqH pf (HIn x) (HIn y) = heqT pf x y+-- instance (El phi xi, HEq0 phi r) => HEq0 phi (I xi r) where+-- 	heqH pf (I x) (I y) = heqH (proofOn pf) x y where+-- 		proofOn :: El phi xi => phi ix -> phi xi+-- 		proofOn _ = proof+-- +-- instance HEq0 phi (U r) where+-- 	heqH _ _ _ = True+-- +-- instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :*: g) r) where+-- 	heqH pf (x1 :*: y1) (x2 :*: y2) = heqT pf x1 x2 && heqT pf y1 y2+-- +-- instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :+: g) r) where+-- 	heqH pf (L x) (L y) = heqT pf x y+-- 	heqH pf (R x) (R y) = heqT pf x y+-- 	heqH _ _ _ = False+-- +-- instance (HEq phi f, HEq0 phi r) => HEq0 phi ((f :>: ix) r) where+-- 	heqH pf (Tag x) (Tag y) = heqT pf x y+-- +-- instance HEq phi f => HEq0 phi (HFix f) where+-- 	heqH pf (HIn x) (HIn y) = heqT pf x y
Data/TrieMap/MultiRec/FamMap.hs view
@@ -7,150 +7,95 @@ import Data.TrieMap.MultiRec.Ord import Data.TrieMap.MultiRec.Sized import Data.TrieMap.MultiRec.Base-import Data.TrieMap.Sized-import Data.TrieMap.Applicative+-- import Data.TrieMap.Sized+-- import Data.TrieMap.Applicative import Data.TrieMap.TrieKey-import qualified Data.TrieMap.Regular.Class as Reg+-- import qualified Data.TrieMap.Regular.Class as Reg  import Control.Applicative import Control.Arrow -import Data.Maybe-import Data.Foldable-import Data.Sequence ((|>))-import qualified Data.Sequence as Seq+-- import Data.Maybe+-- import Data.Foldable+-- import Data.Sequence ((|>))+-- import qualified Data.Sequence as Seq  import Generics.MultiRec  newtype FamMap (phi :: * -> *) m ix a = FamMap (m (Family phi) ix a) type instance HTrieMap phi (Family phi) = FamMap phi (HTrieMapT phi (PF phi))--instance (Fam phi, HEq phi (PF phi), HFunctor phi (PF phi)) => HEq0 phi (Family phi) where-	heqH pf (F x) (F y) = heqT pf (from' pf x) (from' pf y)--instance (Fam phi, HOrd phi (PF phi), HFunctor phi (PF phi)) => HOrd0 phi (Family phi) where-	compareH0 pf (F x) (F y) = hcompare pf (from' pf x) (from' pf y)--instance (El phi ix, Fam phi, HEq phi (PF phi), HFunctor phi (PF phi)) => Eq (Family phi ix) where-	x == y = heqH (prove x) x y--instance (El phi ix, Fam phi, HOrd phi (PF phi), HFunctor phi (PF phi)) => Ord (Family phi ix) where-	x `compare` y = compareH0 (prove x) x y--instance HEq0 phi r => HEq0 phi (FamT phi r) where-	heqH pf (FamT x) (FamT y) = heqH pf x y+type instance TrieMap (Family phi ix) = FamMap phi (HTrieMapT phi (PF phi)) ix -instance HOrd0 phi r => HOrd0 phi (FamT phi r) where-	compareH0 pf (FamT x) (FamT y) = compareH0 pf x y+to' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> PF phi (Family phi) ix -> Family phi ix+to' pf = F . to pf . hmap (\ _ (F x) -> I0 x) pf -instance (El phi ix, HEq0 phi r) => Eq (FamT phi r ix) where-	x == y = heqH (prove' x) x y+push :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> (Family phi ix -> a) -> PF phi (Family phi) ix -> a+push pf f = f . to' pf -instance (El phi ix, HOrd0 phi r) => Ord (FamT phi r ix) where-	x `compare` y = compareH0 (prove' x) x y+from' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> Family phi ix -> PF phi (Family phi) ix+from' pf (F x) = hmap (const (F . unI0)) pf (from pf x) -prove' :: El phi ix => FamT phi r ix -> phi ix-prove' _ = proof+from'' :: (Fam phi, HFunctor phi (PF phi), El phi ix) => Family phi ix -> PF phi (Family phi) ix+from'' = from' proof -prove :: El phi ix => Family phi ix -> phi ix-prove _ = proof+instance (Fam phi, HFunctor phi (PF phi), HEq phi (PF phi)) => HEq0 phi (Family phi) where+	heq0 pf a b = heqT pf (from' pf a) (from' pf b) -from' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> ix -> PF phi (Family phi) ix-from' pf = hmap (const (F . unI0)) pf . from pf+instance (Fam phi, HFunctor phi (PF phi), HOrd phi (PF phi)) => HOrd0 phi (Family phi) where+	compare0 pf a b = hcompare pf (from' pf a) (from' pf b) -to' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> PF phi (Family phi) ix -> ix-to' pf = to pf . hmap (\ _ (F x) -> I0 x) pf+instance (Fam phi, HFunctor phi (PF phi), HEq phi (PF phi), El phi ix) => Eq (Family phi ix) where+	a == b = heq0 (prove a) a b where+		prove :: El phi ix => Family phi ix -> phi ix+		prove _ = proof -push :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> (Family phi ix -> a) -> PF phi (Family phi) ix -> a-push pf f = f . F . to' pf+instance (Fam phi, HFunctor phi (PF phi), HOrd phi (PF phi), El phi ix) => Ord (Family phi ix) where+	compare a b = compare0 (prove a) a b where+		prove :: El phi ix => Family phi ix -> phi ix+		prove _ = proof  instance (Fam phi, HFunctor phi (PF phi), HTrieKeyT phi (PF phi) m) => HTrieKey phi (Family phi) (FamMap phi m) where-	emptyH pf = FamMap (emptyT pf)-	nullH pf (FamMap m) = nullT pf m-	sizeH pf s (FamMap m) = sizeT pf s m-	lookupH pf (F k) (FamMap m) = lookupT pf (from' pf k) m-	lookupIxH pf s (F k) (FamMap m) = onKey (F . to' pf) (lookupIxT pf s (from' pf k) m)-	assocAtH pf s i (FamMap m) = onKey (F . to' pf) (assocAtT pf s i m)--- 	updateAtH pf s r f i (FamMap m) = FamMap (updateAtT pf s r (\ i -> f i . F . to' pf) i m)-	alterH pf s f (F k) (FamMap m) = FamMap (alterT pf s f (from' pf k) m)-	traverseWithKeyH pf s f (FamMap m) =-		FamMap <$> traverseWithKeyT pf s (push pf f) m-	foldWithKeyH pf f (FamMap m) = foldWithKeyT pf (push pf f) m-	foldlWithKeyH pf f (FamMap m) = foldlWithKeyT pf (push pf f) m-	mapEitherH pf s1 s2 f (FamMap m) = (FamMap *** FamMap) (mapEitherT pf s1 s2 (push pf f) m)-	splitLookupH pf s f (F k) (FamMap m) = FamMap `sides` splitLookupT pf s f (from' pf k) m-	unionH pf s f (FamMap m1) (FamMap m2) = FamMap (unionT pf s (push pf f) m1 m2)-	isectH pf s f (FamMap m1) (FamMap m2) = FamMap (isectT pf s (push pf f) m1 m2)-	diffH pf s f (FamMap m1) (FamMap m2) = FamMap (diffT pf s (push pf f) m1 m2)-	extractH pf s f (FamMap m) = second FamMap <$> extractT pf s (f . F . to' pf) m--- 	extractMinH pf s f (FamMap m) = second FamMap <$> extractMinT pf s (f . F . to' pf) m--- 	extractMaxH pf s f (FamMap m) = second FamMap <$> extractMaxT pf s (f . F . to' pf) m--- 	alterMinH pf s f (FamMap m) = FamMap (alterMinT pf s (push pf f) m)--- 	alterMaxH pf s f (FamMap m) = FamMap (alterMaxT pf s (push pf f) m)-	isSubmapH pf (<=) (FamMap m1) (FamMap m2) = isSubmapT pf (<=) m1 m2-	fromListH pf s f xs = FamMap (fromListT pf s (push pf f) [(from' pf k, a) | (F k, a) <- xs])-	fromAscListH pf s f xs = FamMap (fromAscListT pf s (push pf f) [(from' pf k, a) | (F k, a) <- xs])-	fromDistAscListH pf s xs = FamMap (fromDistAscListT pf s [(from' pf k, a) | (F k, a) <- xs])---- type family UniqueFam ix :: * -> *-newtype FMap (phi :: * -> *) m ix a = FMap (m ix a)-type instance TrieMap (Family phi ix) = FMap phi (HTrieMap phi (Family phi)) ix--instance (El phi ix, Fam phi, HFunctor phi (PF phi), HTrieKey phi (Family phi) m, m ~ HTrieMap phi (Family phi),-		HOrd phi (PF phi)) => TrieKey (Family phi ix) (FMap phi m ix) where-	emptyM = FMap (emptyH proof)-	nullM (FMap m) = nullH proof m-	sizeM s (FMap m) = sizeH proof s m-	lookupM k (FMap m) = lookupH proof k m-	lookupIxM s k (FMap m) = lookupIxH proof s k m-	assocAtM s i (FMap m) = assocAtH proof s i m--- 	updateAtM s r f i (FMap m) = FMap (updateAtH proof s r f i m)-	alterM s f k (FMap m) = FMap (alterH proof s f k m)-	traverseWithKeyM s f (FMap m) = FMap <$> traverseWithKeyH proof s f m-	foldWithKeyM f (FMap m) = foldWithKeyH proof f m-	foldlWithKeyM f (FMap m) = foldlWithKeyH proof f m-	mapEitherM s1 s2 f (FMap m) = -		(FMap *** FMap) (mapEitherH proof s1 s2 f m)-	splitLookupM s f k (FMap m) = FMap `sides` splitLookupH proof s (f) k m-	unionM s f (FMap m1) (FMap m2) = FMap (unionH proof s f m1 m2) -	isectM s f (FMap m1) (FMap m2) = FMap (isectH proof s f m1 m2) -	diffM s f (FMap m1) (FMap m2) = FMap (diffH proof s f m1 m2) -	extractM s f (FMap m) = second FMap <$> extractH proof s f m--- 	extractMinM s f (FMap m) = second FMap <$> extractMinH proof s f m--- 	extractMaxM s f (FMap m) = second FMap <$> extractMaxH proof s f m--- 	alterMinM s f (FMap m) = FMap (alterMinH proof s f m)--- 	alterMaxM s f (FMap m) = FMap (alterMaxH proof s f m)-	isSubmapM (<=) (FMap m1) (FMap m2) = isSubmapH proof (<=) m1 m2 -	fromListM s f xs = FMap (fromListH proof s f xs)-	fromAscListM s f xs = FMap (fromAscListH proof s f xs)-	fromDistAscListM s xs = FMap (fromDistAscListH proof s xs)--newtype FTMap (phi :: * -> *) (r :: * -> *) ix a = FTMap (HTrieMap phi r ix a)-type instance TrieMap (FamT phi r ix) = FTMap phi r ix---- instance (HTrieKey KeyFam r (HTrieMap KeyFam r)) => Reg.TrieKeyT (FamT KeyFam r) (FTMap KeyFam r) where--- 	emptyT = FTMap (emptyH KF)+	empty0 pf = FamMap (emptyH pf)+	null0 pf (FamMap m) = nullH pf m +	size0 pf s (FamMap m) = sizeH pf s m+	lookup0 pf k (FamMap m) = lookupH pf (from' pf k) m+	lookupIx0 pf s k (FamMap m) = onKey (to' pf) (lookupIxH pf s (from' pf k) m)+	assocAt0 pf s i (FamMap m) = onKey (to' pf) (assocAtH pf s i m)+	alter0 pf s f k (FamMap m) = FamMap (alterH pf s f (from' pf k) m)+	extract0 pf s f (FamMap m) = fmap FamMap <$> extractH pf s (push pf f) m+	alterLookup0 pf s f k (FamMap m) = FamMap <$> alterLookupH pf s f (from' pf k) m+	traverseWithKey0 pf s f (FamMap m) = FamMap <$> traverseWithKeyH pf s (push pf f) m+	foldWithKey0 pf f (FamMap m) = foldWithKeyH pf (push pf f) m+	foldlWithKey0 pf f (FamMap m) = foldlWithKeyH pf (push pf f) m+	mapEither0 pf s1 s2 f (FamMap m) = (FamMap *** FamMap) (mapEitherH pf s1 s2 (push pf f) m)+	splitLookup0 pf s f k (FamMap m) = FamMap `sides` splitLookupH pf s f (from' pf k) m+	union0 pf s f (FamMap m1) (FamMap m2) = FamMap (unionH pf s (push pf f) m1 m2)+	isect0 pf s f (FamMap m1) (FamMap m2) = FamMap (isectH pf s (push pf f) m1 m2)+	diff0 pf s f (FamMap m1) (FamMap m2) = FamMap (diffH pf s (push pf f) m1 m2)+	isSubmap0 pf (<=) (FamMap m1) (FamMap m2) = isSubmapH pf (<=) m1 m2+	fromList0 pf s f xs = FamMap (fromListH pf s (push pf f) [(from' pf k, a) | (k, a) <- xs])+	fromAscList0 pf s f xs = FamMap (fromAscListH pf s (push pf f) [(from' pf k, a) | (k, a) <- xs])+	fromDistAscList0 pf s xs = FamMap (fromDistAscListH pf s [(from' pf k, a) | (k, a) <- xs]) -instance (El phi ix, HTrieKey phi r (HTrieMap phi r)) => TrieKey (FamT phi r ix) (FTMap phi r ix) where-	emptyM = FTMap (emptyH proof)-	nullM (FTMap m) = nullH proof m-	sizeM s (FTMap m) = sizeH proof s m-	lookupM (FamT k) (FTMap m) = lookupH proof k m-	lookupIxM s (FamT k) (FTMap m) = onKey FamT (lookupIxH proof s k m)-	assocAtM s i (FTMap m) = onKey FamT (assocAtH proof s i m)--- 	updateAtM s r f i (FTMap m) = FTMap (updateAtH proof s r (\ i' -> f i' . FamT) i m)-	alterM s f (FamT k) (FTMap m) = FTMap (alterH proof s f k m)-	foldWithKeyM f (FTMap m) = foldWithKeyH proof (f . FamT) m-	foldlWithKeyM f (FTMap m) = foldlWithKeyH proof (f . FamT) m-	traverseWithKeyM s f (FTMap m) = FTMap <$> traverseWithKeyH proof s (f . FamT) m-	mapEitherM s1 s2 f (FTMap m) = (FTMap *** FTMap) (mapEitherH proof s1 s2 (f . FamT) m)-	splitLookupM s f (FamT k) (FTMap m) = FTMap `sides` splitLookupH proof s f k m-	unionM s f (FTMap m1) (FTMap m2) = FTMap (unionH proof s (f . FamT) m1 m2)-	isectM s f (FTMap m1) (FTMap m2) = FTMap (isectH proof s (f . FamT) m1 m2)-	diffM s f (FTMap m1) (FTMap m2) = FTMap (diffH proof s (f . FamT) m1 m2)-	isSubmapM (<=) (FTMap m1) (FTMap m2) = isSubmapH proof (<=) m1 m2-	extractM s f (FTMap m) = second FTMap <$> extractH proof s (f . FamT) m--- 	extractMinM s f (FTMap m){--} = second FTMap <$> extractMinH proof s (f . FamT) m--- 	extractMaxM s f (FTMap m) = second FTMap <$> extractMaxH proof s (f . FamT) m--- 	alterMinM s f (FTMap m) = FTMap (alterMinH proof s (f . FamT) m)--- 	alterMaxM s f (FTMap m) = FTMap (alterMaxH proof s (f . FamT) m)+instance (Fam phi, HFunctor phi (PF phi), El phi ix, HTrieKeyT phi (PF phi) m) => TrieKey (Family phi ix) (FamMap phi m ix) where+	emptyM = empty0 proof+	nullM = null0 proof+	sizeM = size0 proof+	lookupM = lookup0 proof+	lookupIxM = lookupIx0 proof+	assocAtM = assocAt0 proof+	alterM = alter0 proof+	alterLookupM = alterLookup0 proof+	extractM = extract0 proof+	traverseWithKeyM = traverseWithKey0 proof+	foldWithKeyM = foldWithKey0 proof+	foldlWithKeyM = foldlWithKey0 proof+	mapEitherM = mapEither0 proof+	splitLookupM = splitLookup0 proof+	unionM = union0 proof+	isectM = isect0 proof+	diffM = diff0 proof+	isSubmapM = isSubmap0 proof+	fromListM = fromList0 proof+	fromAscListM = fromAscList0 proof+	fromDistAscListM = fromDistAscList0 proof
− Data/TrieMap/MultiRec/FixMap.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeFamilies, MultiParamTypeClasses #-}--module Data.TrieMap.MultiRec.FixMap () where--import Data.TrieMap.MultiRec.Base-import Data.TrieMap.MultiRec.Class-import Data.TrieMap.TrieKey--import Control.Applicative-import Control.Arrow--newtype HFixMap (phi :: * -> *) (f :: (* -> *) -> * -> *) a ix = HFixMap (HTrieMapT phi f (HFix f) a ix)-type instance HTrieMap phi (HFix f) = HFixMap phi f--instance HTrieKeyT phi f (HTrieMapT phi f) => HTrieKey phi (HFix f) (HFixMap phi f) where-	emptyH = HFixMap . emptyT-	nullH pf (HFixMap m) = nullT pf m-	sizeH pf s (HFixMap m) = sizeT pf s m-	lookupH pf (HIn k) (HFixMap m) = lookupT pf k m-	lookupIxH pf s (HIn k) (HFixMap m) = onKey HIn (lookupIxT pf s k m)-	assocAtH pf s i (HFixMap m) = onKey HIn (assocAtT pf s i m)--- 	updateAtH pf s r f i (HFixMap m) = HFixMap (updateAtT pf s r (\ i' -> f i' . HIn) i m)-	alterH pf s f (HIn k) (HFixMap m) = HFixMap (alterT pf s f k m)-	traverseWithKeyH pf s f (HFixMap m) = HFixMap <$> traverseWithKeyT pf s (f . HIn) m-	foldWithKeyH pf f (HFixMap m) = foldWithKeyT pf (f . HIn) m-	foldlWithKeyH pf f (HFixMap m) = foldlWithKeyT pf (f . HIn) m-	unionH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (unionT pf s (f . HIn) m1 m2)-	isectH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (isectT pf s (f . HIn) m1 m2)-	diffH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (diffT pf s (f . HIn) m1 m2)-	isSubmapH pf (<=) (HFixMap m1) (HFixMap m2) = isSubmapT pf (<=) m1 m2-	mapEitherH pf s1 s2 f (HFixMap m) = (HFixMap *** HFixMap) (mapEitherT pf s1 s2 (f . HIn) m)-	splitLookupH pf s f (HIn k) (HFixMap m) = HFixMap `sides` splitLookupT pf s f k m-	extractH pf s f (HFixMap m) = second HFixMap <$> extractT pf s (f . HIn) m--- 	extractMinH pf s f (HFixMap m) = second HFixMap <$> extractMinT pf s (f . HIn) m--- 	extractMaxH pf s f (HFixMap m) = second HFixMap <$> extractMaxT pf s (f . HIn) m--- 	alterMinH pf s f (HFixMap m) = HFixMap <$> alterMinT pf s (f . HIn) m--- 	alterMaxH pf s f (HFixMap m) = HFixMap <$> alterMaxT pf s (f . HIn) m
Data/TrieMap/MultiRec/IMap.hs view
@@ -4,8 +4,9 @@  import Data.TrieMap.MultiRec.Class import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.MultiRec.TH--- import Data.TrieMap.Rep.TH+-- import Data.TrieMap.MultiRec.KeyFam+-- import Data.TrieMap.MultiRec.TT+-- import Data.TrieMap.Rep.TT -- import Data.TrieMap.Rep import Data.TrieMap.TrieKey @@ -16,41 +17,40 @@  newtype IMap phi xi r ix a = IMap (HTrieMap phi r xi a) type instance HTrieMapT phi (I xi) = IMap phi xi-type instance HTrieMap phi (I xi r) = HTrieMapT phi (I xi) r+-- type instance TTrieMap phi (I xi r) = TTrieMapH phi (I xi) r --- type instance RepT (IMap phi xi r ix) = RepT (HTrieMap phi r xi)--- type instance Rep (IMap phi xi r ix a) = RepT (IMap phi xi r ix) (Rep a)+-- type instance RepH (IMap phi xi r ix) = RepH (TTrieMap phi r xi)+-- type instance Rep (IMap phi xi r ix a) = RepH (IMap phi xi r ix) (Rep a) -- --- -- $(genRepT [d|---   instance ReprT (HTrieMap phi r xi) => ReprT (IMap phi xi r ix) where--- 	toRepT (IMap m) = toRepT m--- 	fromRepT = IMap . fromRepT |] )-+-- -- $(genRepH [d|+--   instance ReprH (TTrieMap phi r xi) => ReprH (IMap phi xi r ix) where+-- 	toRepH (IMap m) = toRepH m+-- 	fromRepH = IMap . fromRepH |] ) -$(inferH [d|-   instance El phi xi => HTrieKeyT phi (I xi) (IMap phi xi) where-	emptyT _ = IMap (emptyH proof)-	nullT _ (IMap m) = nullH proof m-	sizeT _ s (IMap m) = sizeH proof s m-	lookupT _ (I k) (IMap m) = lookupH proof k m-	lookupIxT _ s (I k) (IMap m) = onKey I (lookupIxH proof s k m)-	assocAtT _ s i (IMap m) = onKey I (assocAtH proof s i m)--- 	updateAtT _ s r f i (IMap m) = IMap (updateAtH proof s r (\ i' -> f i' . I) i m)-	alterT _ s f (I k) (IMap m) = IMap (alterH proof s f k m)-	traverseWithKeyT _ s f (IMap m) = IMap <$> traverseWithKeyH proof s (f . I) m-	foldWithKeyT _ f (IMap m) = foldWithKeyH proof (f . I) m-	foldlWithKeyT _ f (IMap m) = foldlWithKeyH proof (f . I) m-	mapEitherT _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherH proof s1 s2 (f . I) m)-	splitLookupT pf s f (I k) (IMap m) = IMap `sides` splitLookupH proof s (f) k m-	unionT pf s f (IMap m1) (IMap m2) = IMap (unionH proof s (f . I) m1 m2)-	isectT pf s f (IMap m1) (IMap m2) = IMap (isectH proof s (f . I) m1 m2)-	diffT pf s f (IMap m1) (IMap m2) = IMap (diffH proof s (f . I) m1 m2)-	extractT pf s f (IMap m) = second IMap <$> extractH proof s (f . I) m--- 	extractMinT pf s f (IMap m) = second IMap <$> extractMinH proof s (f . I) m--- 	extractMaxT pf s f (IMap m) = second IMap <$> extractMaxH proof s (f . I) m--- 	alterMinT pf s f (IMap m) = IMap <$> alterMinH proof s (f . I) m--- 	alterMaxT pf s f (IMap m) = IMap <$> alterMaxH proof s (f . I) m-	isSubmapT pf (<=) (IMap m1) (IMap m2) = isSubmapH proof (<=) m1 m2 -	fromListT _ s f xs = IMap (fromListH proof s (f . I) [(k, a) | (I k, a) <- xs])-	fromAscListT _ s f xs = IMap (fromAscListH proof s (f . I) [(k, a) | (I k, a) <- xs])-	fromDistAscListT _ s xs = IMap (fromDistAscListH proof s [(k, a) | (I k, a) <- xs]) |])+instance (El phi xi) => HTrieKeyT phi (I xi) (IMap phi xi) where+	emptyH _ = IMap (empty0 proof)+	nullH _ (IMap m) = null0 proof m+	sizeH _ s (IMap m) = size0 proof s m+	lookupH _ (I k) (IMap m) = lookup0 proof k m+	lookupIxH _ s (I k) (IMap m) = onKey I (lookupIx0 proof s k m)+	assocAtH _ s i (IMap m) = onKey I (assocAt0 proof s i m)+-- 	updateAtH _ s r f i (IMap m) = IMap (updateAtH proof s r (\ i' -> f i' . I) i m)+	alterH _ s f (I k) (IMap m) = IMap (alter0 proof s f k m)+	alterLookupH _ s f (I k) (IMap m) = IMap <$> alterLookup0 proof s f k m+	traverseWithKeyH _ s f (IMap m) = IMap <$> traverseWithKey0 proof s (f . I) m+	foldWithKeyH _ f (IMap m) = foldWithKey0 proof (f . I) m+	foldlWithKeyH _ f (IMap m) = foldlWithKey0 proof (f . I) m+	mapEitherH _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEither0 proof s1 s2 (f . I) m)+	splitLookupH pf s f (I k) (IMap m) = IMap `sides` splitLookup0 proof s (f) k m+	unionH pf s f (IMap m1) (IMap m2) = IMap (union0 proof s (f . I) m1 m2)+	isectH pf s f (IMap m1) (IMap m2) = IMap (isect0 proof s (f . I) m1 m2)+	diffH pf s f (IMap m1) (IMap m2) = IMap (diff0 proof s (f . I) m1 m2)+	extractH pf s f (IMap m) = fmap IMap <$> extract0 proof s (f . I) m+-- 	extractMinH pf s f (IMap m) = second IMap <$> extractMinH proof s (f . I) m+-- 	extractMaxH pf s f (IMap m) = second IMap <$> extractMaxH proof s (f . I) m+-- 	alterMinH pf s f (IMap m) = IMap <$> alterMinH proof s (f . I) m+-- 	alterMaxH pf s f (IMap m) = IMap <$> alterMaxH proof s (f . I) m+	isSubmapH pf (<=) (IMap m1) (IMap m2) = isSubmap0 proof (<=) m1 m2 +	fromListH _ s f xs = IMap (fromList0 proof s (f . I) [(k, a) | (I k, a) <- xs])+	fromAscListH _ s f xs = IMap (fromAscList0 proof s (f . I) [(k, a) | (I k, a) <- xs])+	fromDistAscListH _ s xs = IMap (fromDistAscList0 proof s [(k, a) | (I k, a) <- xs])
Data/TrieMap/MultiRec/Instances.hs view
@@ -9,4 +9,4 @@ import Data.TrieMap.MultiRec.FamMap -- import Data.TrieMap.MultiRec.AppMap -- import Data.TrieMap.MultiRec.XMap-import Data.TrieMap.MultiRec.FixMap+-- import Data.TrieMap.MultiRec.FixMap
Data/TrieMap/MultiRec/Ord.hs view
@@ -4,69 +4,98 @@  import Data.TrieMap.MultiRec.Eq import Data.TrieMap.MultiRec.Base+import Data.TrieMap.Regular.Ord import Generics.MultiRec  import Data.Monoid -type Comparator a = a -> a -> Ordering+-- type Comparator a = a -> a -> Ordering  class HEq phi f => HOrd phi f where 	compareH :: (forall ix . phi ix -> Comparator (r ix)) -> phi ix -> Comparator (f r ix) -hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)-hcompare = compareH compareH0- class HEq0 phi r => HOrd0 phi r where-	compareH0 :: phi ix -> Comparator (r ix)---- instance HOrd0 phi r => HOrd0 phi (A0 r) where--- 	compareH0 pf (A0 a) (A0 b) = compareH0 pf a b---- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi (A f r) where--- 	compareH0 pf (A a) (A b) = hcompare pf a b+	compare0 :: phi ix -> Comparator (r ix) --- instance HOrd phi A0 where--- 	compareH cmp pf (A0 a) (A0 b) = cmp pf a b+hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)+hcompare = compareH compare0  instance Ord k => HOrd phi (K k) where-	compareH _ = compareH0--instance Ord k => HOrd0 phi (K k r) where-	compareH0 _ (K a) (K b) = compare a b+	compareH _ _ (K a) (K b) = compare a b  instance El phi xi => HOrd phi (I xi) where 	compareH cmp _ (I a) (I b) = cmp proof a b -instance (El phi xi, HOrd0 phi r) => HOrd0 phi (I xi r) where-	compareH0 = hcompare--instance HOrd phi U where-	compareH _ = compareH0--instance HOrd0 phi (U r) where-	compareH0 _ _ _ = EQ- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :*: g) where 	compareH cmp pf (x1 :*: y1) (x2 :*: y2) = compareH cmp pf x1 x2 `mappend` compareH cmp pf y1 y2 -instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :*: g) r) where-	compareH0 = hcompare- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :+: g) where-	compareH cmp pf x y = case (x, y) of-		(L x, L y) -> compareH cmp pf x y-		(R x, R y) -> compareH cmp pf x y+	compareH cmp pf a b = case (a, b) of+		(L a, L b) -> compareH cmp pf a b+		(R a, R b) -> compareH cmp pf a b 		(L _, R _) -> LT-		(R _, L _) -> GT--instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :+: g) r) where-	compareH0 = hcompare+		_	   -> GT  instance HOrd phi f => HOrd phi (f :>: ix) where 	compareH cmp pf (Tag a) (Tag b) = compareH cmp pf a b -instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi ((f :>: ix) r) where-	compareH0 pf (Tag a) (Tag b) = hcompare pf a b+instance HOrd phi U where+	compareH _ _ _ _ = EQ -instance HOrd phi f => HOrd0 phi (HFix f) where-	compareH0 pf (HIn a) (HIn b) = hcompare pf a b+-- hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)+-- hcompare = compareH compareH0+-- +-- class HEq0 phi r => HOrd0 phi r where+-- 	compareH0 :: phi ix -> Comparator (r ix)+-- +-- -- instance HOrd0 phi r => HOrd0 phi (A0 r) where+-- -- 	compareH0 pf (A0 a) (A0 b) = compareH0 pf a b+-- +-- -- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi (A f r) where+-- -- 	compareH0 pf (A a) (A b) = hcompare pf a b+-- +-- -- instance HOrd phi A0 where+-- -- 	compareH cmp pf (A0 a) (A0 b) = cmp pf a b+-- +-- instance Ord k => HOrd phi (K k) where+-- 	compareH _ = compareH0+-- +-- instance Ord k => HOrd0 phi (K k r) where+-- 	compareH0 _ (K a) (K b) = compare a b+-- +-- instance El phi xi => HOrd phi (I xi) where+-- 	compareH cmp _ (I a) (I b) = cmp proof a b+-- +-- instance (El phi xi, HOrd0 phi r) => HOrd0 phi (I xi r) where+-- 	compareH0 = hcompare+-- +-- instance HOrd phi U where+-- 	compareH _ = compareH0+-- +-- instance HOrd0 phi (U r) where+-- 	compareH0 _ _ _ = EQ+-- +-- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :*: g) where+-- 	compareH cmp pf (x1 :*: y1) (x2 :*: y2) = compareH cmp pf x1 x2 `mappend` compareH cmp pf y1 y2+-- +-- instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :*: g) r) where+-- 	compareH0 = hcompare+-- +-- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :+: g) where+-- 	compareH cmp pf x y = case (x, y) of+-- 		(L x, L y) -> compareH cmp pf x y+-- 		(R x, R y) -> compareH cmp pf x y+-- 		(L _, R _) -> LT+-- 		(R _, L _) -> GT+-- +-- instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :+: g) r) where+-- 	compareH0 = hcompare+-- +-- instance HOrd phi f => HOrd phi (f :>: ix) where+-- 	compareH cmp pf (Tag a) (Tag b) = compareH cmp pf a b+-- +-- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi ((f :>: ix) r) where+-- 	compareH0 pf (Tag a) (Tag b) = hcompare pf a b+-- +-- instance HOrd phi f => HOrd0 phi (HFix f) where+-- 	compareH0 pf (HIn a) (HIn b) = hcompare pf a b
Data/TrieMap/MultiRec/ProdMap.hs view
@@ -4,10 +4,12 @@  import Data.TrieMap.MultiRec.Class import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.MultiRec.Ord+-- import Data.TrieMap.MultiRec.Ord import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.MultiRec.TH-import Data.TrieMap.Regular.Base (O(..))+-- import Data.TrieMap.MultiRec.TH+-- import Data.TrieMap.Regular.Eq+-- import Data.TrieMap.Regular.Ord+-- import Data.TrieMap.Regular.Base (O(..)) import Data.TrieMap.Applicative import Data.TrieMap.TrieKey -- import Data.TrieMap.Rep@@ -26,113 +28,114 @@  newtype ProdMap (phi :: * -> *) f g (r :: * -> *) ix a = PMap (HTrieMapT phi f r ix (HTrieMapT phi g r ix a)) type instance HTrieMapT phi (f :*: g) = ProdMap phi f g--(HTrieMapT phi f) (HTrieMapT phi g)-type instance HTrieMap phi ((f :*: g) r) = HTrieMapT phi (f :*: g) r+-- type instance HTrieMap phi ((f :*: g) r) = HTrieMapT phi (f :*: g) r --- type instance RepT (ProdMap phi f g r ix) = RepT (HTrieMapT phi f r ix) `O` RepT (HTrieMapT phi g r ix)--- type instance Rep (ProdMap phi f g r ix a) = RepT (ProdMap phi f g r ix) (Rep a)+-- type instance RepH (ProdMap phi f g r ix) = RepH (HTrieMapT phi f r ix) `O` RepH (HTrieMapT phi g r ix)+-- type instance Rep (ProdMap phi f g r ix a) = RepH (ProdMap phi f g r ix) (Rep a) --- -- $(genRepT [d|--- 	instance (ReprT (HTrieMapT phi f r ix), ReprT (HTrieMapT phi g r ix)) =>--- 			ReprT (ProdMap phi f g r ix) where--- 		toRepT (PMap m) = O (fmap toRepT (toRepT m))--- 		fromRepT (O m) = PMap (fromRepT (fmap fromRepT m)) |] )+-- -- $(genRepH [d|+-- 	instance (ReprH (HTrieMapT phi f r ix), ReprH (HTrieMapT phi g r ix)) =>+-- 			ReprH (ProdMap phi f g r ix) where+-- 		toRepH (PMap m) = O (fmap toRepH (toRepH m))+-- 		fromRepH (O m) = PMap (fromRepH (fmap fromRepH m)) |] )  maxIx :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a ->  		HTrieMapT phi f r ix a -> Int-maxIx pf s m = fromMaybe (sizeT pf s m) (getFirst (aboutT pf (\ _ a -> return (sizeT pf s m - s a)) m))+maxIx pf s m = fromMaybe (sizeH pf s m) (getFirst (aboutH pf (\ _ a -> return (sizeH pf s m - s a)) m)) -$(inferH [d|-	instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => -			HTrieKeyT phi (f :*: g) (ProdMap phi f g) where-		emptyT = PMap . emptyT-		nullT pf (PMap m) = nullT pf m-		sizeT pf s (PMap m) = sizeT pf (sizeT pf s) m-		lookupT pf (a :*: b) (PMap m) = lookupT pf a m >>= lookupT pf b-		lookupIxT pf s (a :*: b) (PMap m) = case lookupIxT pf (sizeT pf s) a m of-			(lb, x, rb) -> let lookupX = do	Asc i a' m' <- x-							let (lb', x', rb') = lookupIxT pf s b m'-							let f = onIndexA (i +) . onKeyA (a' :*:)-							return (f <$> lb', f <$> x', f <$> rb')-			   in 	((do	Asc iA aL mL <- lb-					fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>-				 (do	(lb', _, _) <- Last lookupX-					lb'),-				 (do	(_, x', _) <- lookupX-					x'),-				 (do	(_, _, rb') <- First lookupX-					rb') <|>-				 (do	Asc iA aR mR <- rb-				  	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))-			where 	getLast pf s m = aboutT pf (\ k a -> return (Asc (sizeT pf s m - s a) k a)) m-				getFirst pf s m = aboutT pf (\ k a -> return (Asc 0 k a)) m-		assocAtT pf s i (PMap m) = case assocAtT pf (sizeT pf s) i m of-			(lb, x, rb) -> let lookupX = do	Asc i' a' m' <- x-							let (lb', x', rb') = assocAtT pf s (i - i') m'-							let f = onIndexA (i' +) . onKeyA (a' :*:)-							return (f <$> lb', f <$> x', f <$> rb')-				in ((do	Asc iA aL mL <- lb-					fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>-				    (do	(lb', _, _) <- Last lookupX-				    	lb'),-				    (do	(_, x', _) <- lookupX-				    	x'),-				    (do	(_, _, rb') <- First lookupX-				    	rb') <|>-				    (do	Asc iA aR mR <- rb-				    	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))-			where 	getLast pf s m = aboutT pf (\ k a -> return (Asc (sizeT pf s m - s a) k a)) m-				getFirst pf s m = aboutT pf (\ k a -> return (Asc 0 k a)) m--- 		updateAtT pf s r f i (PMap m) = PMap (updateAtT pf (sizeT pf s) r g i m) where--- 			g iA a m --- 				| i >= iA && i <= iA + maxIx pf s m--- 					= (guardNullT pf . updateAtT pf s r (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)) m+instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => +	HTrieKeyT phi (f :*: g) (ProdMap phi f g) where+	emptyH = PMap . emptyH+	nullH pf (PMap m) = nullH pf m+	sizeH pf s (PMap m) = sizeH pf (sizeH pf s) m+	lookupH pf (a :*: b) (PMap m) = lookupH pf a m >>= lookupH pf b+	lookupIxH pf s (a :*: b) (PMap m) = case lookupIxH pf (sizeH pf s) a m of+		(lb, x, rb) -> let lookupX = do	Asc i a' m' <- x+						let (lb', x', rb') = lookupIxH pf s b m'+						let f = onIndexA (i +) . onKeyA (a' :*:)+						return (f <$> lb', f <$> x', f <$> rb')+		   in 	((do	Asc iA aL mL <- lb+				fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>+			 (do	(lb', _, _) <- Last lookupX+				lb'),+			 (do	(_, x', _) <- lookupX+				x'),+			 (do	(_, _, rb') <- First lookupX+				rb') <|>+			 (do	Asc iA aR mR <- rb+			  	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))+		where 	getLast pf s m = aboutH pf (\ k a -> return (Asc (sizeH pf s m - s a) k a)) m+			getFirst pf s m = aboutH pf (\ k a -> return (Asc 0 k a)) m+	assocAtH pf s i (PMap m) = case assocAtH pf (sizeH pf s) i m of+		(lb, x, rb) -> let lookupX = do	Asc i' a' m' <- x+						let (lb', x', rb') = assocAtH pf s (i - i') m'+						let f = onIndexA (i' +) . onKeyA (a' :*:)+						return (f <$> lb', f <$> x', f <$> rb')+			in ((do	Asc iA aL mL <- lb+				fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>+			    (do	(lb', _, _) <- Last lookupX+			    	lb'),+			    (do	(_, x', _) <- lookupX+			    	x'),+			    (do	(_, _, rb') <- First lookupX+			    	rb') <|>+			    (do	Asc iA aR mR <- rb+			    	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))+		where 	getLast pf s m = aboutH pf (\ k a -> return (Asc (sizeH pf s m - s a) k a)) m+			getFirst pf s m = aboutH pf (\ k a -> return (Asc 0 k a)) m+-- 	updateAtH pf s r f i (PMap m) = PMap (updateAtH pf (sizeH pf s) r g i m) where+-- 		g iA a m +-- 			| i >= iA && i <= iA + maxIx pf s m+-- 					= (guardNullH pf . updateAtH pf s r (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)) m -- 				| i < iA--- 					= guardNullT pf $--- 						alterMaxT pf s (\ b v -> f (iA + sizeT pf s m - s v) (a :*: b) v) m+-- 					= guardNullH pf $+-- 						alterMaxH pf s (\ b v -> f (iA + sizeH pf s m - s v) (a :*: b) v) m -- 				| otherwise--- 					= guardNullT pf $ alterMinT pf s (f iA . (a :*:)) m-		alterT pf s f (a :*: b) (PMap m) = PMap (alterT pf (sizeT pf s) (guardNullT pf . g) a m) where-			g = alterT pf s f b . fromMaybe (emptyT pf)-		traverseWithKeyT pf s f (PMap m) = -			PMap <$> traverseWithKeyT pf (sizeT pf s) (\ a -> traverseWithKeyT pf s (\ b -> f (a :*: b))) m-		foldWithKeyT pf f (PMap m) =-			foldWithKeyT pf (\ a -> foldWithKeyT pf (\ b -> f (a :*: b))) m-		foldlWithKeyT pf f (PMap m) =-			foldlWithKeyT pf (\ a -> flip (foldlWithKeyT pf (\ b -> f (a :*: b)))) m-		mapEitherT pf s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherT pf (sizeT pf s1) (sizeT pf s2) g m) where-			g a = (guardNullT pf *** guardNullT pf) . mapEitherT pf s1 s2 (\ b -> f (a :*: b))-		splitLookupT pf s f (a :*: b) (PMap m) = PMap `sides` splitLookupT pf (sizeT pf s) g a m where-			g = sides (guardNullT pf) . splitLookupT pf s f b-		unionT pf s f (PMap m1) (PMap m2) = PMap (unionT pf (sizeT pf s) g m1 m2) where-			g a = guardNullT pf .: unionT pf s (\ b -> f (a :*: b))-		isectT pf s f (PMap m1) (PMap m2) = PMap (isectT pf (sizeT pf s) g m1 m2) where-			g a = guardNullT pf .: isectT pf s (\ b -> f (a :*: b))-		diffT pf s f (PMap m1) (PMap m2) = PMap (diffT pf (sizeT pf s) g m1 m2) where-			g a = guardNullT pf .: diffT pf s (\ b -> f (a :*: b))-		extractT pf s f (PMap m) = second PMap <$> extractT pf (sizeT pf s) g m where-			g a = second (guardNullT pf) <.> extractT pf s (\ b -> f (a :*: b))--- 		extractMinT pf s f (PMap m) = second PMap <$> extractMinT pf (sizeT pf s) g m where --- 			g a m1 = fromJust $ getFirst $ second (guardNullT pf) <$> extractMinT pf s (f . (a :*:)) m1--- 		extractMaxT pf s f (PMap m) = second PMap <$> extractMaxT pf (sizeT pf s) g m where --- 			g a m1 = fromJust $ getLast $ second (guardNullT pf) <$> extractMaxT pf s (f . (a :*:)) m1--- 		alterMinT pf s f (PMap m) = PMap (alterMinT pf (sizeT pf s) g m) where--- 			g a = guardNullT pf . alterMinT pf s (\ b -> f (a :*: b))--- 		alterMaxT pf s f (PMap m) = PMap (alterMaxT pf (sizeT pf s) g m) where--- 			g a = guardNullT pf . alterMaxT pf s (\ b -> f (a :*: b))-		isSubmapT pf (<=) (PMap m1) (PMap m2) = isSubmapT pf (isSubmapT pf (<=)) m1 m2-		fromListT pf s f xs = PMap (mapWithKeyT pf (sizeT pf s) (\ a -> fromListT pf s (\ b -> f (a :*: b)))-					(fromListT pf (const 1) (\ _ (xs) (ys) -> (xs ++ ys))-						[(a, ts) | (a, ts) <- breakFst pf xs]))-		fromAscListT pf s f xs = PMap (fromDistAscListT pf (sizeT pf s)-			[(a, fromAscListT pf s (\ b -> f (a :*: b)) ts) | (a, ts) <- breakFst pf xs])-		fromDistAscListT pf s xs = PMap (fromDistAscListT pf (sizeT pf s)-			[(a, fromDistAscListT pf s ts) | (a, ts) <- breakFst pf xs])+-- 					= guardNullH pf $ alterMinH pf s (f iA . (a :*:)) m+	alterH pf s f (a :*: b) (PMap m) = PMap (alterH pf (sizeH pf s) (guardNullH pf . g) a m) where+		g = alterH pf s f b . fromMaybe (emptyH pf)+	alterLookupH pf s f (a :*: b) (PMap m) = PMap <$> alterLookupH pf (sizeH pf s) g a m where+		g = fmap (guardNullH pf) . alterLookupH pf s f b . fromMaybe (emptyH pf)+	traverseWithKeyH pf s f (PMap m) = +		PMap <$> traverseWithKeyH pf (sizeH pf s) (\ a -> traverseWithKeyH pf s (\ b -> f (a :*: b))) m+	foldWithKeyH pf f (PMap m) =+		foldWithKeyH pf (\ a -> foldWithKeyH pf (\ b -> f (a :*: b))) m+	foldlWithKeyH pf f (PMap m) =+		foldlWithKeyH pf (\ a -> flip (foldlWithKeyH pf (\ b -> f (a :*: b)))) m+	mapEitherH pf s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherH pf (sizeH pf s1) (sizeH pf s2) g m) where+		g a = (guardNullH pf *** guardNullH pf) . mapEitherH pf s1 s2 (\ b -> f (a :*: b))+	splitLookupH pf s f (a :*: b) (PMap m) = PMap `sides` splitLookupH pf (sizeH pf s) g a m where+		g = sides (guardNullH pf) . splitLookupH pf s f b+	unionH pf s f (PMap m1) (PMap m2) = PMap (unionH pf (sizeH pf s) g m1 m2) where+		g a = guardNullH pf .: unionH pf s (\ b -> f (a :*: b))+	isectH pf s f (PMap m1) (PMap m2) = PMap (isectH pf (sizeH pf s) g m1 m2) where+		g a = guardNullH pf .: isectH pf s (\ b -> f (a :*: b))+	diffH pf s f (PMap m1) (PMap m2) = PMap (diffH pf (sizeH pf s) g m1 m2) where+		g a = guardNullH pf .: diffH pf s (\ b -> f (a :*: b))+	extractH pf s f (PMap m) = fmap PMap <$> extractH pf (sizeH pf s) g m where+		g a = fmap (guardNullH pf) <.> extractH pf s (\ b -> f (a :*: b))+-- 	extractMinH pf s f (PMap m) = second PMap <$> extractMinH pf (sizeH pf s) g m where +-- 			g a m1 = fromJust $ getFirst $ second (guardNullH pf) <$> extractMinH pf s (f . (a :*:)) m1+-- 		extractMaxH pf s f (PMap m) = second PMap <$> extractMaxH pf (sizeH pf s) g m where +-- 			g a m1 = fromJust $ getLast $ second (guardNullH pf) <$> extractMaxH pf s (f . (a :*:)) m1+-- 		alterMinH pf s f (PMap m) = PMap (alterMinH pf (sizeH pf s) g m) where+-- 			g a = guardNullH pf . alterMinH pf s (\ b -> f (a :*: b))+-- 		alterMaxH pf s f (PMap m) = PMap (alterMaxH pf (sizeH pf s) g m) where+-- 			g a = guardNullH pf . alterMaxH pf s (\ b -> f (a :*: b))+	isSubmapH pf (<=) (PMap m1) (PMap m2) = isSubmapH pf (isSubmapH pf (<=)) m1 m2+	fromListH pf s f xs = PMap (mapWithKeyH pf (sizeH pf s) (\ a -> fromListH pf s (\ b -> f (a :*: b)))+				(fromListH pf (const 1) (\ _ (xs) (ys) -> (xs ++ ys))+					[(a, ts) | (a, ts) <- breakFst pf xs]))+	fromAscListH pf s f xs = PMap (fromDistAscListH pf (sizeH pf s)+		[(a, fromAscListH pf s (\ b -> f (a :*: b)) ts) | (a, ts) <- breakFst pf xs])+	fromDistAscListH pf s xs = PMap (fromDistAscListH pf (sizeH pf s)+		[(a, fromDistAscListH pf s ts) | (a, ts) <- breakFst pf xs]) -	breakFst :: (HEq phi f, HEq0 phi r) => phi ix -> [((f :*: g) r ix, a)] -> [(f r ix, [(g r ix, a)])]-	breakFst pf [] = []-	breakFst pf ((a :*: b, x):xs) = breakFst' a (Seq.singleton (b, x)) xs where-		breakFst' a0 ts ((a :*: b, x):xs)-			| heqT pf a0 a	= breakFst' a0 (ts |> (b, x)) xs-			| otherwise	= (a0, toList ts):breakFst' a (Seq.singleton (b,x)) xs-		breakFst' a ts [] = [(a, toList ts)]-	|])+breakFst :: (HEq phi f, HEq0 phi r) => phi ix -> [((f :*: g) r ix, a)] -> [(f r ix, [(g r ix, a)])]+breakFst pf [] = []+breakFst pf ((a :*: b, x):xs) = breakFst' a (Seq.singleton (b, x)) xs where+	breakFst' a0 ts ((a :*: b, x):xs)+		| heqT pf a0 a+				= breakFst' a0 (ts |> (b, x)) xs+		| otherwise	= (a0, toList ts):breakFst' a (Seq.singleton (b,x)) xs+	breakFst' a ts [] = [(a, toList ts)]
− Data/TrieMap/MultiRec/TH.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, QuasiQuotes, TemplateHaskell #-}--module Data.TrieMap.MultiRec.TH where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Ord-import Language.Haskell.TH-import Language.Haskell.TH.Ppr-import Control.Monad-import Debug.Trace--data Scheme = Sch {empt, nul, siz, look, lookIx, assocAt, updateAt, alter, traverse, fold, foldl, mapE, splitL, union, isect, diff, extractMi, extractMa, alterMi, alterMa, isSub, fromL, fromAL, fromDAL :: String}--htriekeyT :: Scheme-htriekeyT = Sch "emptyT" "nullT" "sizeT" "lookupT" "lookupIxT" "assocAtT" "updateAtT" "alterT" "traverseWithKeyT" "foldWithKeyT" "foldlWithKeyT"-	"mapEitherT" "splitLookupT" "unionT" "isectT" "diffT" "extractMinT" "extractMaxT" "alterMinT" "alterMaxT" "isSubmapT" -	"fromListT" "fromAscListT" "fromDistAscListT"--htriekey :: Scheme-htriekey = Sch "emptyH" "nullH" "sizeH" "lookupH" "lookupIxH" "assocAtH" "updateAtH" "alterH" "traverseWithKeyH" "foldWithKeyH" "foldlWithKeyH"-	"mapEitherH" "splitLookupH" "unionH" "isectH" "diffH" "extractHinH" "extractHaxH" "alterHinH" "alterHaxH" "isSubmapH" -	"fromListH" "fromAscListH" "fromDistAscListH"--{-inferNewtype :: Name -> Name -> Scheme -> Scheme -> Q [Dec] -> Q [Dec]-inferNewtype kCon mCon sch1 sch2 decl = do-	decs@(InstanceD cxt t _:_) <- decl-	let fund = FunD . mkName-	let mcon = ConE mCon-	mapV <- newName "m"-	let mapVar = VarE mapV-	let mapPat = ConP mCon [VarP mapV]-	pfV <- newName "pf"-	let pfPat = VarP pfV-	let pfVar = VarE pfV-	szV <- newName "s"-	let szPat = VarP szV-	let szVar = VarE szV-	let empty = fund (empt sch1) [pfPat] (AppE mcon (AppE (VarE (empt sch2)) pfVar))-	let null = fund (nul sch1) [pfPat, mapPat] (VarE (nul sch2) `AppE` pfVar `AppE` mapVar)-	let size = fund (siz sch1) [pfPat, szPat, mapPat] (VarE (siz sch2) `AppE` pfVar `AppE` szPat `AppE` mapVar-	return [InstanceD cxt t [empty, null, size]]-}-	--inferH :: Q [Dec] -> Q [Dec]-inferH instanceT = do-	iT@(InstanceD cxt0 (htriekeyt `AppT` phi `AppT` f `AppT` m) _:_) <- instanceT-	(InstanceD _ _ decs:_) <- [d|-	  instance (HTrieKeyT phi f m, HTrieKey phi r mm, HOrd0 phi (f r)) => HTrieKey phi (f r) (m r) where-		emptyH = emptyT-		nullH = nullT-		sizeH = sizeT-		lookupH = lookupT-		lookupIxH = lookupIxT-		assocAtH = assocAtT--- 		updateAtH = updateAtT-		alterH = alterT-		traverseWithKeyH = traverseWithKeyT-		foldWithKeyH = foldWithKeyT-		foldlWithKeyH = foldlWithKeyT-		mapEitherH = mapEitherT-		splitLookupH = splitLookupT-		unionH = unionT-		isectH = isectT-		diffH = diffT-		extractH = extractT--- 		alterMinH = alterMinT--- 		alterMaxH = alterMaxT--- 		extractMinH = extractMinT--- 		extractMaxH = extractMaxT-		isSubmapH = isSubmapT-		fromListH = fromListT-		fromAscListH = fromAscListT-		fromDistAscListH = fromDistAscListT |]-	let r = mkName "r"-	let mm = mkName "mm"--- 	let phiT = varT phi-	let rT = varT r-	let mmT = varT mm--- 	let mT = varT m-	let htriekey = conT ''HTrieKey-	let hord = conT ''HOrd-	let hord0 = conT ''HOrd0-	let htriemap = conT ''HTrieMap-	ans <- instanceD (cxt (map return cxt0 ++ [htriekey `appQ` phi `appT` rT `appT` (htriemap `appQ` phi `appT` rT)]))-		(htriekey `appT` return phi `appT` (return f `appT` rT) `appT` (return m `appT` rT)) (map return decs)-	return (ans:iT)--appQ :: TypeQ -> Type -> TypeQ-t1 `appQ` t2 = t1 `appT` return t2
Data/TrieMap/MultiRec/TagMap.hs view
@@ -5,8 +5,9 @@ import Data.TrieMap.MultiRec.Class import Data.TrieMap.MultiRec.Eq import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.MultiRec.TH-import Data.TrieMap.Applicative+import Data.TrieMap.CPair+-- import Data.TrieMap.MultiRec.TH+-- import Data.TrieMap.Applicative import Data.TrieMap.TrieKey -- import Data.TrieMap.Rep @@ -15,8 +16,8 @@ import Control.Monad  import Data.Maybe-import Data.Monoid-import Data.Foldable+-- import Data.Monoid+-- import Data.Foldable import Generics.MultiRec  data TagF a ix xi where@@ -27,7 +28,7 @@  newtype TagMap (phi :: * -> *) f ix (r :: * -> *) xi a = TagMap (HTrieMapT phi f r xi (TagF a ix xi)) type instance HTrieMapT phi (f :>: ix) = TagMap phi f ix-type instance HTrieMap phi ((f :>: ix) r) = HTrieMapT phi (f :>: ix) r+-- type instance HTrieMap phi ((f :>: ix) r) = HTrieMapT phi (f :>: ix) r  -- type instance RepT (TagMap phi f ix r xi) = RepT (HTrieMapT phi f r xi) -- type instance Rep (TagMap phi f ix r xi a) = RepT (HTrieMapT phi f r xi) (Rep a)@@ -54,60 +55,59 @@ 	((f r ix, TagF a xi ix), HTrieMapT phi f r ix (TagF a xi ix)) -> (((f :>: xi) r ix, a), TagMap phi f xi r ix a) restructure ((k, TagF a), m) = ((Tag k, a), TagMap m) -restructure' :: Applicative t => ((f :>: xi) r ix -> a -> t (x, Maybe a)) -> f r ix -> TagF a xi ix -> t (x, Maybe (TagF a xi ix))-restructure' f k (TagF a) = second (fmap TagF) <$> f (Tag k) a+restructure' :: Applicative t => ((f :>: xi) r ix -> a -> t (CPair x (Maybe a))) -> f r ix -> TagF a xi ix -> t (CPair x (Maybe (TagF a xi ix)))+restructure' f k (TagF a) = fmap (fmap TagF) <$> f (Tag k) a  retag :: (f r ix, TagF a xi ix) -> ((f :>: xi) r ix, a) retag (k, TagF a) = (Tag k, a) -$(inferH [d|-  instance (HTrieKeyT phi f (HTrieMapT phi f)) => HTrieKeyT phi (f :>: ix) (TagMap phi m ix) where-	emptyT = TagMap . emptyT-	nullT pf (TagMap m) = nullT pf m-	sizeT pf s (TagMap m) = sizeT pf (sizeTag s) m-	lookupT pf (Tag k) (TagMap m) = unTagF <$> lookupT pf k m-	lookupIxT pf s (Tag k) (TagMap m) = onValue retag (lookupIxT pf (sizeTag s) k m)-	assocAtT pf s i (TagMap m) = onValue retag (assocAtT pf (sizeTag s) i m) +instance (HTrieKeyT phi f (HTrieMapT phi f)) => HTrieKeyT phi (f :>: ix) (TagMap phi m ix) where+	emptyH = TagMap . emptyH+	nullH pf (TagMap m) = nullH pf m+	sizeH pf s (TagMap m) = sizeH pf (sizeTag s) m+	lookupH pf (Tag k) (TagMap m) = unTagF <$> lookupH pf k m+	lookupIxH pf s (Tag k) (TagMap m) = onValue retag (lookupIxH pf (sizeTag s) k m)+	assocAtH pf s i (TagMap m) = onValue retag (assocAtH pf (sizeTag s) i m)  -- 	updateAtT pf s r f i (TagMap m) = TagMap (updateAtT pf (sizeTag s) r (f' f) i m) where -- 		f' :: (Int -> (f :>: xi) r ix -> a -> Maybe (a)) -> Int -> f r ix -> TagF a xi ix -> Maybe (TagF a xi ix) -- 		f' f i k (TagF a) = TagF <$> f i (Tag k) a-	alterT pf s f (Tag k) (TagMap m) = TagMap (alterT pf (sizeTag s) (fmap TagF . f . fmap unTagF) k m)-	traverseWithKeyT pf s f (TagMap m) = TagMap <$> traverseWithKeyT pf (sizeTag s) (mapTag f) m where+	alterH pf s f (Tag k) (TagMap m) = TagMap (alterH pf (sizeTag s) (fmap TagF . f . fmap unTagF) k m)+	alterLookupH pf s f (Tag k) (TagMap m) = TagMap <$> alterLookupH pf (sizeTag s) (fmap (fmap TagF) . f . fmap unTagF) k m+	traverseWithKeyH pf s f (TagMap m) = TagMap <$> traverseWithKeyH pf (sizeTag s) (mapTag f) m where 		f' :: Applicative t => ((f :>: ix) r xi -> a -> t (b )) -> f r xi -> TagF a ix xi -> t (TagF b ix xi) 		f' f k (TagF a) = TagF <$> f (Tag k) a-	foldWithKeyT pf f (TagMap m) = foldWithKeyT pf (f' f) m where+	foldWithKeyH pf f (TagMap m) = foldWithKeyH pf (f' f) m where 		f' :: ((f :>: ix) r xi -> a -> b -> b) -> f r xi -> TagF a ix xi -> b -> b 		f' f k (TagF a) = f (Tag k) a-	foldlWithKeyT pf f (TagMap m) = foldlWithKeyT pf (f' f) m where+	foldlWithKeyH pf f (TagMap m) = foldlWithKeyH pf (f' f) m where 		f' :: ((f :>: ix) r xi -> b -> a -> b) -> f r xi -> b -> TagF a ix xi -> b 		f' f k z (TagF a) = f (Tag k) z a-	mapEitherT pf s1 s2 f (TagMap m) = (TagMap *** TagMap) (mapEitherT pf (sizeTag s1) (sizeTag s2) (f' f) m) where+	mapEitherH pf s1 s2 f (TagMap m) = (TagMap *** TagMap) (mapEitherH pf (sizeTag s1) (sizeTag s2) (f' f) m) where 		f' :: EitherMap ((f :>: ix) r xi) (a ) (b) (c) -> EitherMap (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi) 		f' f k (TagF a) = (fmap TagF *** fmap TagF) (f (Tag k) a)-	splitLookupT pf s f (Tag k) (TagMap m) = TagMap `sides` splitLookupT pf (sizeTag s) (f' f) k m where+	splitLookupH pf s f (Tag k) (TagMap m) = TagMap `sides` splitLookupH pf (sizeTag s) (f' f) k m where 		f' :: SplitMap (a) x -> SplitMap (TagF a xi ix) x 		f' f (TagF a) = fmap TagF `sides` f a-	unionT pf s f (TagMap m1) (TagMap m2) = TagMap (unionT pf (sizeTag s) (combineTag f) m1 m2) -	isectT pf s f (TagMap m1) (TagMap m2) = TagMap (isectT pf (sizeTag s) (combineTag f) m1 m2)-	diffT pf s f (TagMap m1) (TagMap m2) = TagMap (diffT pf (sizeTag s) (combineTag f) m1 m2)+	unionH pf s f (TagMap m1) (TagMap m2) = TagMap (unionH pf (sizeTag s) (combineTag f) m1 m2) +	isectH pf s f (TagMap m1) (TagMap m2) = TagMap (isectH pf (sizeTag s) (combineTag f) m1 m2)+	diffH pf s f (TagMap m1) (TagMap m2) = TagMap (diffH pf (sizeTag s) (combineTag f) m1 m2) -- 	extractMinT pf s f (TagMap m) = second TagMap <$> extractMinT pf (sizeTag s) (restructure' f) m -- 	extractMaxT pf s f (TagMap m) = second TagMap <$> extractMaxT pf (sizeTag s) (restructure' f) m-	extractT pf s f (TagMap m) = second TagMap <$> extractT pf (sizeTag s) (restructure' f) m+	extractH pf s f (TagMap m) = fmap TagMap <$> extractH pf (sizeTag s) (restructure' f) m -- 	alterMinT pf s f (TagMap m) = TagMap <$> alterMinT pf (sizeTag s) (mapTag f) m -- 	alterMaxT pf s f (TagMap m) = TagMap <$> alterMaxT pf (sizeTag s) (mapTag f) m-	isSubmapT pf (<=) (TagMap m1) (TagMap m2) = isSubmapT pf (le (<=)) m1 m2 where+	isSubmapH pf (<=) (TagMap m1) (TagMap m2) = isSubmapH pf (le (<=)) m1 m2 where 		le :: LEq a b -> LEq (TagF a xi ix) (TagF b xi ix) 		le (<=) (TagF a) (TagF b) = a <= b-	fromListT pf s f xs = TagMap (fromListT pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where+	fromListH pf s f xs = TagMap (fromListH pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where 		f' :: ((f :>: ix) r xi -> a -> a -> a) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi 		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)-	fromAscListT pf s f xs = TagMap (fromAscListT pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where+	fromAscListH pf s f xs = TagMap (fromAscListH pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where 		f' :: ((f :>: ix) r xi -> a -> a -> a ) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi 		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)-	fromDistAscListT pf s xs = TagMap (fromDistAscListT pf (sizeTag s) (map f xs)) where+	fromDistAscListH pf s xs = TagMap (fromDistAscListH pf (sizeTag s) (map f xs)) where 		f :: ((f :>: ix) r xi, a) -> (f r xi, TagF a ix xi) 		f (Tag k, a) = (k, TagF a)-  |] ) {- instance (HTrieKeyT phi f m, m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>  		HTrieKey phi ((f :>: ix) r) (TagMap phi f ix r) where
Data/TrieMap/MultiRec/UnionMap.hs view
@@ -3,112 +3,114 @@ module Data.TrieMap.MultiRec.UnionMap () where  import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.MultiRec.Base-import Data.TrieMap.Applicative+-- import Data.TrieMap.MultiRec.Eq+-- import Data.TrieMap.MultiRec.Base+-- import Data.TrieMap.Applicative import Data.TrieMap.TrieKey -- import Data.TrieMap.Rep -- import Data.TrieMap.Rep.TH-import Data.TrieMap.MultiRec.TH-import qualified Data.TrieMap.Regular.Base as Reg+-- import Data.TrieMap.MultiRec.TH+-- import qualified Data.TrieMap.Regular.Base as Reg  import Control.Applicative-import Control.Arrow+-- import Control.Arrow import Control.Monad -import Data.Maybe-import Data.Monoid-import Data.Foldable+-- import Data.Maybe+-- import Data.Monoid+-- import Data.Foldable import Generics.MultiRec  import Prelude hiding (foldr)  data UnionMap (phi :: * -> *) f g (r :: * -> *) ix a = HTrieMapT phi f r ix a :&: HTrieMapT phi g r ix a type instance HTrieMapT phi (f :+: g) = UnionMap phi f g--HTrieMap phi (f r) :*: HTrieMap phi (g r)-type instance HTrieMap phi ((f :+: g) r) = HTrieMapT phi (f :+: g) r+-- type instance HTrieMap phi ((f :+: g) r) = HTrieMapH phi (f :+: g) r --- type instance RepT (UnionMap phi f g r ix) = (Reg.:*:) (RepT (HTrieMapT phi f r ix)) (RepT (HTrieMapT phi g r ix))--- type instance Rep (UnionMap phi f g r ix a) = RepT (UnionMap phi f g r ix) (Rep a)+-- type instance RepH (UnionMap phi f g r ix) = (Reg.:*:) (RepH (HTrieMapH phi f r ix)) (RepH (HTrieMapH phi g r ix))+-- type instance Rep (UnionMap phi f g r ix a) = RepH (UnionMap phi f g r ix) (Rep a) --- -- $(genRepT [d|---     instance (ReprT (HTrieMapT phi f r ix), ReprT (HTrieMapT phi g r ix)) => ReprT (UnionMap phi f g r ix) where--- 	toRepT (m1 :&: m2) = (Reg.:*:) (toRepT m1) (toRepT m2)--- 	fromRepT ((Reg.:*:) m1 m2) = fromRepT m1 :&: fromRepT m2+-- -- $(genRepH [d|+--     instance (ReprH (HTrieMapH phi f r ix), ReprH (HTrieMapH phi g r ix)) => ReprH (UnionMap phi f g r ix) where+-- 	toRepH (m1 :&: m2) = (Reg.:*:) (toRepH m1) (toRepH m2)+-- 	fromRepH ((Reg.:*:) m1 m2) = fromRepH m1 :&: fromRepH m2 -- 	|]) -$(inferH [d|-    instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => HTrieKeyT phi (f :+: g) (UnionMap phi f g) where-	emptyT = liftM2 (:&:) emptyT emptyT-	nullT pf (m1 :&: m2) = nullT pf m1 && nullT pf m2-	sizeT pf s (m1 :&: m2) = sizeT pf s m1 + sizeT pf s m2-	lookupT pf k (m1 :&: m2)-		| L k <- k	= lookupT pf k m1-		| R k <- k	= lookupT pf k m2-	lookupIxT pf s k (m1 :&: m2)-		| L k <- k	= case onKey L (lookupIxT pf s k m1) of-			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ sizeT pf s m1)) <$> getMin pf s m2))-		| R k <- k	= case onIndex (sizeT pf s m1 +) (onKey R (lookupIxT pf s k m2)) of+instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => HTrieKeyT phi (f :+: g) (UnionMap phi f g) where+	emptyH = liftM2 (:&:) emptyH emptyH+	nullH pf (m1 :&: m2) = nullH pf m1 && nullH pf m2+	sizeH pf s (m1 :&: m2) = sizeH pf s m1 + sizeH pf s m2+	lookupH pf k (m1 :&: m2)+		| L k <- k	= lookupH pf k m1+		| R k <- k	= lookupH pf k m2+	lookupIxH pf s k (m1 :&: m2)+		| L k <- k	= case onKey L (lookupIxH pf s k m1) of+			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ sizeH pf s m1)) <$> getMin pf s m2))+		| R k <- k	= case onIndex (sizeH pf s m1 +) (onKey R (lookupIxH pf s k m2)) of 			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)-			where	getMin pf s m = aboutT pf (\ k a -> return $ Asc 0 k a) m-				getMax pf s m = aboutT pf (\ k a -> return $ Asc (sizeT pf s m - s a) k a) m-	assocAtT pf s i (m1 :&: m2)-		| i < s1	= case onKey L (assocAtT pf s i m1) of+			where	getMin pf s m = aboutH pf (\ k a -> return $ Asc 0 k a) m+				getMax pf s m = aboutH pf (\ k a -> return $ Asc (sizeH pf s m - s a) k a) m+	assocAtH pf s i (m1 :&: m2)+		| i < s1	= case onKey L (assocAtH pf s i m1) of 			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ s1)) <$> getMin pf s m2))-		| otherwise	= case onKey R (onIndex (s1 +) (assocAtT pf s (i - s1) m2)) of+		| otherwise	= case onKey R (onIndex (s1 +) (assocAtH pf s (i - s1) m2)) of 			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)-		where	getMin pf s m = aboutT pf (\ k a -> return $ Asc 0 k a) m-			getMax pf s m = aboutT pf (\ k a -> return $ Asc (sizeT pf s m - s a) k a) m-			s1 = sizeT pf s m1-{-	updateAtT pf s r f i (m1 :&: m2)+		where	getMin pf s m = aboutH pf (\ k a -> return $ Asc 0 k a) m+			getMax pf s m = aboutH pf (\ k a -> return $ Asc (sizeH pf s m - s a) k a) m+			s1 = sizeH pf s m1+{-	updateAtH pf s r f i (m1 :&: m2) 		| not r && i >= lastIx m1-			= m1 :&: updateAtT pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2+			= m1 :&: updateAtH pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2 		| i < s1-			= updateAtT pf s r (\ i' -> f i' . L) i m1 :&: m2+			= updateAtH pf s r (\ i' -> f i' . L) i m1 :&: m2 		| otherwise-			= m1 :&: updateAtT pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2-		where	s1 = sizeT pf s m1-			lastIx m = case extractMaxT pf s (\ _ v -> (v, Just v)) m of-				Last (Just (v, _)) -> sizeT pf s m - s v-				_			-> sizeT pf s m-}-	alterT pf s f k (m1 :&: m2)-		| L k <- k	= alterT pf s f k m1 :&: m2-		| R k <- k	= m1 :&: alterT pf s f k m2-	traverseWithKeyT pf s f (m1 :&: m2)-		= (:&:) <$> traverseWithKeyT pf s (f . L) m1 <*> traverseWithKeyT pf s (f . R) m2-	foldWithKeyT pf f (m1 :&: m2) -		= foldWithKeyT pf (f . L) m1 . foldWithKeyT pf (f . R) m2-	foldlWithKeyT pf f (m1 :&: m2)-		= foldlWithKeyT pf (f . R) m2 . foldlWithKeyT pf (f . L) m1-	mapEitherT pf s1 s2 f (m1 :&: m2) = case (mapEitherT pf s1 s2 (f . L) m1, mapEitherT pf s1 s2 (f . R) m2) of+			= m1 :&: updateAtH pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2+		where	s1 = sizeH pf s m1+			lastIx m = case extractMaxH pf s (\ _ v -> (v, Just v)) m of+				Last (Just (v, _)) -> sizeH pf s m - s v+				_			-> sizeH pf s m-}+	alterH pf s f k (m1 :&: m2)+		| L k <- k	= alterH pf s f k m1 :&: m2+		| R k <- k	= m1 :&: alterH pf s f k m2+	alterLookupH pf s f k (m1 :&: m2)+		| L k <- k	= fmap (:&: m2) (alterLookupH pf s f k m1)+		| R k <- k	= fmap (m1 :&:) (alterLookupH pf s f k m2)+	traverseWithKeyH pf s f (m1 :&: m2)+		= (:&:) <$> traverseWithKeyH pf s (f . L) m1 <*> traverseWithKeyH pf s (f . R) m2+	foldWithKeyH pf f (m1 :&: m2) +		= foldWithKeyH pf (f . L) m1 . foldWithKeyH pf (f . R) m2+	foldlWithKeyH pf f (m1 :&: m2)+		= foldlWithKeyH pf (f . R) m2 . foldlWithKeyH pf (f . L) m1+	mapEitherH pf s1 s2 f (m1 :&: m2) = case (mapEitherH pf s1 s2 (f . L) m1, mapEitherH pf s1 s2 (f . R) m2) of 		((m1L, m1R), (m2L, m2R)) -> (m1L :&: m2L, m1R :&: m2R)-	splitLookupT pf s f k0 (m1 :&: m2)-		| L k <- k0, (m1L, x, m1R) <- splitLookupT pf s f k m1-			= (m1L :&: emptyT pf, x, m1R :&: m2)-		| R k <- k0, (m2L, x, m2R) <- splitLookupT pf s f k m2-			= (m1 :&: m2L, x, emptyT pf :&: m2R)-	unionT pf s f (m11 :&: m12) (m21 :&: m22)-		= unionT pf s (f . L) m11 m21 :&: unionT pf s (f . R) m12 m22-	isectT pf s f (m11 :&: m12) (m21 :&: m22)-		= isectT pf s (f . L) m11 m21 :&: isectT pf s (f . R) m12 m22-	diffT pf s f (m11 :&: m12) (m21 :&: m22)-		= diffT pf s (f . L) m11 m21 :&: diffT pf s (f . R) m12 m22-	extractT pf s f (m1 :&: m2) = second (:&: m2) <$> extractT pf s (f . L) m1 <|>-		second (m1 :&:) <$> extractT pf s (f . R) m2--- 	extractMinT pf s f (m1 :&: m2) = second (:&: m2) <$> extractMinT pf s (f . L) m1 <|>--- 		second (m1 :&:) <$> extractMinT pf s (f . R) m2--- 	extractMaxT pf s f (m1 :&: m2) = second (:&: m2) <$> extractMaxT pf s (f . L) m1 <|>--- 		second (m1 :&:) <$> extractMaxT pf s (f . R) m2--- 	alterMinT pf s f (m1 :&: m2)--- 		| nullT pf m1	= m1 :&: alterMinT pf s (f . R) m2--- 		| otherwise	= alterMinT pf s (f . L) m1 :&: m2--- 	alterMaxT pf s f (m1 :&: m2)--- 		| nullT pf m2	= alterMaxT pf s (f . L) m1 :&: m2--- 		| otherwise	= m1 :&: alterMaxT pf s (f . R) m2-	isSubmapT pf (<=) (m11 :&: m12) (m21 :&: m22)-		= isSubmapT pf (<=) m11 m21 && isSubmapT pf (<=) m12 m22-	fromListT pf s f xs = case breakEither xs of-		(ys, zs) -> fromListT pf s (f . L) ys :&: fromListT pf s (f . R) zs-	fromAscListT pf s f xs = case breakEither xs of-		(ys, zs) -> fromAscListT pf s (f . L) ys :&: fromAscListT pf s (f . R) zs-	fromDistAscListT pf s xs = case breakEither xs of-		(ys, zs) -> fromDistAscListT pf s ys :&: fromDistAscListT pf s zs |])+	splitLookupH pf s f k0 (m1 :&: m2)+		| L k <- k0, (m1L, x, m1R) <- splitLookupH pf s f k m1+			= (m1L :&: emptyH pf, x, m1R :&: m2)+		| R k <- k0, (m2L, x, m2R) <- splitLookupH pf s f k m2+			= (m1 :&: m2L, x, emptyH pf :&: m2R)+	unionH pf s f (m11 :&: m12) (m21 :&: m22)+		= unionH pf s (f . L) m11 m21 :&: unionH pf s (f . R) m12 m22+	isectH pf s f (m11 :&: m12) (m21 :&: m22)+		= isectH pf s (f . L) m11 m21 :&: isectH pf s (f . R) m12 m22+	diffH pf s f (m11 :&: m12) (m21 :&: m22)+		= diffH pf s (f . L) m11 m21 :&: diffH pf s (f . R) m12 m22+	extractH pf s f (m1 :&: m2) = fmap (:&: m2) <$> extractH pf s (f . L) m1 <|>+		fmap (m1 :&:) <$> extractH pf s (f . R) m2+-- 	extractMinH pf s f (m1 :&: m2) = second (:&: m2) <$> extractMinH pf s (f . L) m1 <|>+-- 		second (m1 :&:) <$> extractMinH pf s (f . R) m2+-- 	extractMaxH pf s f (m1 :&: m2) = second (:&: m2) <$> extractMaxH pf s (f . L) m1 <|>+-- 		second (m1 :&:) <$> extractMaxH pf s (f . R) m2+-- 	alterMinH pf s f (m1 :&: m2)+-- 		| nullH pf m1	= m1 :&: alterMinH pf s (f . R) m2+-- 		| otherwise	= alterMinH pf s (f . L) m1 :&: m2+-- 	alterMaxH pf s f (m1 :&: m2)+-- 		| nullH pf m2	= alterMaxH pf s (f . L) m1 :&: m2+-- 		| otherwise	= m1 :&: alterMaxH pf s (f . R) m2+	isSubmapH pf (<=) (m11 :&: m12) (m21 :&: m22)+		= isSubmapH pf (<=) m11 m21 && isSubmapH pf (<=) m12 m22+	fromListH pf s f xs = case breakEither xs of+		(ys, zs) -> fromListH pf s (f . L) ys :&: fromListH pf s (f . R) zs+	fromAscListH pf s f xs = case breakEither xs of+		(ys, zs) -> fromAscListH pf s (f . L) ys :&: fromAscListH pf s (f . R) zs+	fromDistAscListH pf s xs = case breakEither xs of+		(ys, zs) -> fromDistAscListH pf s ys :&: fromDistAscListH pf s zs
Data/TrieMap/MultiRec/UnitMap.hs view
@@ -12,7 +12,7 @@  import Control.Applicative import Control.Arrow-import Control.Monad+-- import Control.Monad  import Data.Maybe import Data.Monoid@@ -24,7 +24,7 @@  newtype UMap (phi :: * -> *) (r :: * -> *) ix a = UMap (Maybe a) type instance HTrieMapT phi U = UMap phi-type instance HTrieMap phi (U r) = UMap phi r+-- type instance HTrieMap phi (U r) = UMap phi r  -- type instance RepT (UMap phi r ix) = RepT Maybe -- type instance Rep (UMap phi r ix a) = RepT Maybe (Rep a)@@ -35,33 +35,6 @@ -- 	fromRepT = UMap . fromRepT |])  instance HTrieKeyT phi U (UMap phi) where-	emptyT = emptyH-	nullT = nullH-	sizeT = sizeH-	lookupT = lookupH-	lookupIxT = lookupIxH-	assocAtT = assocAtH--- 	updateAtT = updateAtH-	alterT = alterH-	traverseWithKeyT = traverseWithKeyH-	foldWithKeyT = foldWithKeyH-	foldlWithKeyT = foldlWithKeyH-	mapEitherT = mapEitherH-	splitLookupT = splitLookupH-	unionT = unionH-	isectT = isectH-	diffT = diffH-	extractT = extractH--- 	extractMinT = extractMinH--- 	extractMaxT = extractMaxH--- 	alterMinT = alterMinH--- 	alterMaxT = alterMaxH-	isSubmapT = isSubmapH-	fromListT = fromListH-	fromAscListT = fromAscListH-	fromDistAscListT = fromDistAscListH--instance HTrieKey phi (U r) (UMap phi r) where 	emptyH _ = UMap Nothing 	nullH _ (UMap m) = isNothing m 	sizeH _ s (UMap m) = maybe 0 s m@@ -74,6 +47,7 @@ -- 		| otherwise -- 			= UMap m 	alterH _ _ f _ (UMap m) = UMap (f m)+	alterLookupH _ _ f _ (UMap m) = UMap <$> f m 	traverseWithKeyH _ _ f (UMap m) = UMap <$> traverse (f U) m 	foldWithKeyH _ f (UMap m) z = foldr (f U) z m 	foldlWithKeyH _ f (UMap m) z = foldl (f U) z m@@ -82,7 +56,7 @@ 	unionH _ _ f (UMap m1) (UMap m2) = UMap (unionMaybe (f U) m1 m2) 	isectH _ _ f (UMap m1) (UMap m2) = UMap (isectMaybe (f U) m1 m2) 	diffH _ _ f (UMap m1) (UMap m2) = UMap (diffMaybe (f U) m1 m2)-	extractH _ _ f (UMap m) = maybe empty (second UMap <.> f U) m+	extractH _ _ f (UMap m) = maybe empty (fmap UMap <.> f U) m -- 	extractMinH _ _ f (UMap m) = fmap (second UMap . f U) (First m) -- 	extractMaxH _ _ f (UMap m) = fmap (second UMap . f U) (Last m) -- 	alterMinH _ _ f (UMap m) = (UMap . f U) <$> (First m)
Data/TrieMap/OrdMap.hs view
@@ -4,21 +4,22 @@  import Data.TrieMap.TrieKey import Data.TrieMap.Sized-import Data.TrieMap.Applicative+-- import Data.TrieMap.Applicative import Data.TrieMap.Modifiers-import Data.TrieMap.MultiRec.Base+import Data.TrieMap.CPair+-- import Data.TrieMap.MultiRec.Base -- import Data.TrieMap.Rep -- import Data.TrieMap.Rep.TH  import Control.Applicative (Applicative(..), Alternative(..), (<$>))-import Control.Arrow+-- import Control.Arrow import Control.Monad hiding (join) -import Data.Monoid-import Data.Maybe+-- import Data.Monoid+-- import Data.Maybe -- import Data.Map -- import qualified Data.Map as Map-import Data.Traversable+-- import Data.Traversable  import Prelude hiding (lookup) @@ -50,6 +51,7 @@ 	assocAtM s i = onKey Ord . assocAt s 0 i -- 	updateAtM s r f = updateAt s 0 r (\ i -> f i . Ord) 	alterM s f (Ord k) = alter s f k+	alterLookupM s f (Ord k) = alterLookup s f k 	traverseWithKeyM s f = traverseWithKey s (f . Ord) 	foldWithKeyM f = foldrWithKey (f . Ord) 	foldlWithKeyM f = foldlWithKey (f . Ord)@@ -149,6 +151,13 @@ 		Just x'	-> balance s k x' l r 	GT	-> balance s kx x l (alter s f k r) +alterLookup :: Ord k => Sized a -> (Maybe a -> CPair z (Maybe a)) -> k -> OrdMap k a -> CPair z (OrdMap k a)+alterLookup s f k Tip = maybe Tip (singleton s k) <$> f Nothing+alterLookup s f k (Bin _ kx x l r) = case compare k kx of+	LT -> fmap (\ l' -> balance s kx x l' r) (alterLookup s f k l)+	EQ -> maybe (glue s l r) (\ x' -> balance s k x' l r) <$> f (Just x)+	GT -> fmap (\ r' -> balance s kx x l r') (alterLookup s f k r)+ singleton :: Sized a -> k -> a -> OrdMap k a singleton s k a = Bin (s a) k a Tip Tip @@ -371,12 +380,12 @@   | size l > size r = let (f,l') = deleteFindMax s (\ k a -> (balance s k a, Nothing)) l in f l' r   | otherwise       = let (f,r') = deleteFindMin s (\ k a -> (balance s k a, Nothing)) r in f l r' -extract :: Alternative t => Sized a -> (k -> a -> t (z, Maybe a)) -> OrdMap k a -> t (z, OrdMap k a)+extract :: Alternative t => Sized a -> (k -> a -> t (CPair z (Maybe a))) -> OrdMap k a -> t (CPair z (OrdMap k a)) extract s f t = case t of 	Bin _ k x l r -> -		second (\ l' -> balance s k x l' r) <$> extract s f l <|>-		second (maybe (glue s l r) (\ x' -> balance s k x' l r))  <$> f k x <|>-		second (balance s k x l) <$> extract s f r+		fmap (\ l' -> balance s k x l' r) <$> extract s f l <|>+		fmap (maybe (glue s l r) (\ x' -> balance s k x' l r))  <$> f k x <|>+		fmap (balance s k x l) <$> extract s f r  deleteFindMin :: Sized a -> (k -> a -> (x, Maybe a)) -> OrdMap k a -> (x, OrdMap k a) deleteFindMin s f t
+ Data/TrieMap/ProdMap.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, TypeFamilies #-}++module Data.TrieMap.ProdMap () where++import Data.TrieMap.TrieKey+-- import Data.TrieMap.Sized+import Data.TrieMap.Applicative+import Data.TrieMap.Regular.Class+-- import Data.TrieMap.Regular.TH++import Control.Applicative+import Control.Arrow++import Data.Maybe+import Data.Monoid+import Data.Foldable++import Data.Sequence (Seq, (|>))+import qualified Data.Sequence as Seq++newtype PMap m1 k2 a = PMap (m1 (TrieMap k2 a))+type instance TrieMapT ((,) a) = PMap (TrieMap a)+type instance TrieMap (a, b) = PMap (TrieMap a) b+-- type instance TrieMap (a, b) = PMap (TrieMap a) (TrieMap b)++instance (TrieKey a m, TrieKey b (TrieMap b)) => TrieKey (a, b) (PMap m b) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT++instance TrieKey k1 m1 => TrieKeyT ((,) k1) (PMap m1) where+	emptyT = PMap emptyM+	nullT (PMap m) = nullM m+	sizeT s (PMap m) = sizeM (sizeM s) m+	lookupT (k1, k2) (PMap m) = lookupM k1 m >>= lookupM k2+	lookupIxT s (a, b) (PMap m) = case lookupIxM (sizeM s) a m of+		(lb, x, ub) -> let lookupX = do	Asc i1 a' m' <- x+						return (onIndex (i1 +) (onKey ((,) a') (lookupIxM s b m')))+			in ((do	Asc iL aL mL <- lb+				aboutM (\ bL v -> return (Asc (iL + sizeM s mL - s v) (aL, bL) v)) mL) <|>+			    (do	(lb', _, _) <- Last lookupX+			    	lb'),+			    (do	(_, x', _) <- lookupX+			    	x'),+			    (do	(_, _, ub') <- First lookupX+			    	ub') <|>+			    (do	Asc iU aU mU <- ub+			    	aboutM (\ bU -> return . Asc iU (aU, bU)) mU))+	assocAtT s i (PMap m) = case assocAtM (sizeM s) i m of+		(lb, x, ub) -> let lookupX = do	Asc i1 a' m' <- x+						return (onIndex (i1 +) (onKey ((,) a') (assocAtM s (i - i1) m')))+			in ((do	Asc iL aL mL <- lb+				aboutM (\ bL v -> return (Asc (iL + sizeM s mL - s v) (aL, bL) v)) mL) <|>+			    (do	(lb', _, _) <- Last lookupX+			    	lb'),+			    (do	(_, x', _) <- lookupX+			    	x'),+			    (do	(_, _, ub') <- First lookupX+			    	ub') <|>+			    (do	Asc iU aU mU <- ub+			    	aboutM (\ bU -> return . Asc iU (aU, bU)) mU))+-- 	updateAtM+	alterT s f (a, b) (PMap m) = PMap (alterM (sizeM s) g a m) where+		g = guardNullM . alterM s f b . fromMaybe emptyM+	alterLookupT s f (a, b) (PMap m) = PMap <$> alterLookupM (sizeM s) g a m where+		g = fmap guardNullM . alterLookupM s f b . fromMaybe emptyM+	traverseWithKeyT s f (PMap m) = PMap <$> traverseWithKeyM (sizeM s) (\ a -> traverseWithKeyM s (\ b -> f (a, b))) m+	foldWithKeyT f (PMap m) = foldWithKeyM (\ a -> foldWithKeyM (\ b -> f (a, b))) m+	foldlWithKeyT f (PMap m) = foldlWithKeyM (\ a -> flip (foldlWithKeyM (\ b -> f (a, b)))) m+	mapEitherT s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherM (sizeM s1) (sizeM s2) g m) where+		g a = (guardNullM *** guardNullM) . mapEitherM s1 s2 (\ b -> f (a, b))+	splitLookupT s f (a, b) (PMap m) = PMap `sides` splitLookupM (sizeM s) g a m where+		g = sides guardNullM . splitLookupM s f b+	isSubmapT (<=) (PMap m1) (PMap m2) = isSubmapM (isSubmapM (<=)) m1 m2+	unionT s f (PMap m1) (PMap m2) = PMap (unionM (sizeM s) (\ a -> guardNullM .: unionM s (\ b -> f (a, b))) m1 m2)+	isectT s f (PMap m1) (PMap m2) = PMap (isectM (sizeM s) (\ a -> guardNullM .: isectM s (\ b -> f (a, b))) m1 m2)+	diffT s f (PMap m1) (PMap m2) = PMap (diffM (sizeM s) (\ a -> guardNullM .: diffM s (\ b -> f (a, b))) m1 m2)+	extractT s f (PMap m) = fmap PMap <$> extractM (sizeM s) g m where+		g a = fmap guardNullM <.> extractM s (\ b -> f (a, b))+-- 	extractMinT s f (PMap m) = second PMap <$> extractMinM (sizeM s) g m where+-- 		g a = second guardNullM . fromJust . getFirst . extractMinM s (\ b -> f (a, b))+-- 	extractMaxT s f (PMap m) = second PMap <$> extractMaxM (sizeM s) g m where+-- 		g a = second guardNullM . fromJust . getLast . extractMaxM s (\ b -> f (a, b))+	fromListT s f xs = PMap (mapWithKeyM (sizeM s) (\ a -> fromListM s (\ b -> f (a, b)))+		(fromListM (const 1) (const (++)) (breakFst xs)))+	fromAscListT s f xs = PMap (fromDistAscListM (sizeM s)+		[(a, fromAscListM s (\ b -> f (a, b)) ys) | (a, ys) <- breakFst xs])++--    aboutMin :: TrieKey k (TrieMap k) => Sized a -> (k -> a -> x) -> TrieMap k a -> First x+--    aboutMin s f m = fst <$> extractMinM s (\ k a -> (f k a, Nothing)) m+-- +--    aboutMax :: TrieKey k (TrieMap k) => Sized a -> (k -> a -> x) -> TrieMap k a -> Last x+--    aboutMax s f m = fst <$> extractMaxM s (\ k a -> (f k a, Nothing)) m++breakFst :: Eq k1 => [((k1, k2), a)] -> [(k1, [(k2, a)])]+breakFst [] = []+breakFst (((a, b),v):xs) = breakFst' a (Seq.singleton (b, v)) xs where+	breakFst' a vs (((a', b'), v'):xs)+		| a == a'	= breakFst' a' (vs |> (b', v')) xs+		| otherwise	= (a, toList vs):breakFst' a' (Seq.singleton (b', v')) xs+	breakFst' a vs [] = [(a, toList vs)]+	{-+guardNullM :: TrieKey k (TrieMap k) => TrieMap k a -> Maybe (TrieMap k a)+guardNullM m +	| nullM m	= Nothing+	| otherwise	= Just m-}
+ Data/TrieMap/RadixTrie.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE TemplateHaskell, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, PatternGuards #-}++module Data.TrieMap.RadixTrie () where++import Data.TrieMap.TrieKey+import Data.TrieMap.Sized+import Data.TrieMap.Applicative+import Data.TrieMap.CPair+import Data.TrieMap.Regular.Class+-- import Data.TrieMap.Regular.TH++import Control.Applicative+import Control.Arrow+import Control.Monad++import Data.Maybe+import Data.Monoid+import Data.Foldable+import Data.Traversable++import Prelude hiding (lookup, foldr, foldl)++data Edge k m a = Edge {-# UNPACK #-} !Int [k] (Maybe a) (m (Edge k m a))+type Edge' k a = Edge k (TrieMap k) a+type MEdge k m a = Maybe (Edge k m a)+type MEdge' k a = Maybe (Edge' k a)++newtype RadixTrie k a = Radix (MEdge' k a)++type instance TrieMapT [] = RadixTrie+type instance TrieMap [k] = RadixTrie k++edgeSize :: Edge k m a -> Int+edgeSize (Edge sz _ _ _) = sz++instance TrieKey k (TrieMap k) => TrieKey [k] (RadixTrie k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT++instance TrieKeyT [] RadixTrie where+	emptyT = Radix Nothing+	nullT (Radix m) = isNothing m+	sizeT _ (Radix m) = maybe 0 edgeSize m+	lookupT ks (Radix m) = m >>= lookup ks+	alterT s f ks (Radix m) = Radix (alter s f ks m)+	alterLookupT s f ks (Radix m) = Radix <$> alterLookupE s f ks m+	traverseWithKeyT s f (Radix m) = Radix <$> traverse (traverseE s f) m+	extractT s f (Radix m) = maybe empty (fmap Radix <.> extractE s f) m+	foldWithKeyT f (Radix m) z = foldr (foldE f) z m+	foldlWithKeyT f (Radix m) z = foldl (foldlE f) z m+	mapEitherT s1 s2 f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE s1 s2 f) m)+	unionT s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s f) m1 m2)+	isectT s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s f) m1 m2)+	diffT s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s f) m1 m2)+	lookupIxT s ks (Radix m) = maybe (empty, empty, empty) (lookupIxE s 0 ks) m+	isSubmapT (<=) (Radix m1) (Radix m2) = subMaybe (isSubmapE (<=)) m1 m2+	splitLookupT s f ks (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE s f ks) m+	assocAtT s i (Radix m) = maybe (empty, empty, empty) (assocAtE s 0 i) m+  +cat :: [k] -> Edge' k a -> Edge' k a+ks `cat` Edge sz ls v ts = Edge sz (ks ++ ls) v ts++cons :: k -> Edge' k a -> Edge' k a+k `cons` Edge sz ks v ts = Edge sz (k:ks) v ts++edge :: TrieKey k (TrieMap k) => Sized a -> [k] -> Maybe a -> TrieMap k (Edge' k a) -> Edge' k a+edge s ks v ts = Edge (maybe 0 s v + sizeM edgeSize ts) ks v ts++singleMaybe :: TrieKey k (TrieMap k) => Sized a -> [k] -> Maybe a -> MEdge' k a+singleMaybe s ks v = do	v <- v+			return (edge s ks (Just v) emptyM)++compact :: TrieKey k (TrieMap k) => Edge' k a -> MEdge' k a+compact e@(Edge sz ks Nothing ts) = case assocsM ts of+	[]	-> Nothing+	[(l, e')] -> compact (ks `cat` (l `cons` e'))+	_	-> Just e+compact e = Just e++lookup :: (Eq k, TrieKey k (TrieMap k)) => [k] -> Edge' k a -> Maybe a+lookup ks (Edge _ ls v ts) = match ks ls where+	match (k:ks) (l:ls)+		| k == l = match ks ls+	match (k:ks) [] = lookupM k ts >>= lookup ks+	match [] [] = v+	match _ _ = Nothing++alter :: (TrieKey k (TrieMap k)) => Sized a -> (Maybe a -> Maybe a) -> [k] -> MEdge' k a -> MEdge' k a+alter s f ks0 Nothing = singleMaybe s ks0 (f Nothing)+alter s f ks0 (Just e@(Edge sz ls0 v ts)) = match 0 ks0 ls0 where+	match i _ _ | i `seq` False = undefined+	match i (k:ks) (l:ls) = case compare k l of+	      LT | Just v' <- f Nothing	+		      -> Just $ let sv = s v' in Edge (sv + sz) (take i ls0) Nothing (fromDistAscListM edgeSize+					[(k, Edge sv ks (Just v') emptyM), (l, Edge sz ls v ts)])+	      EQ	-> match (i+1) ks ls+	      GT | Just v' <- f Nothing+		      -> Just $ let sv = s v' in Edge (sv + sz) (take i ls0) Nothing (fromDistAscListM edgeSize+					[(l, Edge sz ls v ts), (k, Edge sv ks (Just v') emptyM)])+	      _	-> Just e+	match _ (k:ks) [] = compact $ edge s ls0 v (alterM edgeSize g k ts) where+		g = alter s f ks+	match _ [] (l:ls)+		| Just v' <- f Nothing+			= Just (Edge (s v' + sz) ks0 (Just v') (singletonM edgeSize l (Edge sz ls v ts)))+	match _ [] []+		= compact (edge s ls0 (f v) ts)+	match _ _ _ = Just e++alterLookupE :: TrieKey k (TrieMap k) => Sized a -> (Maybe a -> CPair z (Maybe a)) -> [k] -> MEdge' k a -> CPair z (MEdge' k a)+alterLookupE s f ks Nothing = singleMaybe s ks <$> f Nothing+alterLookupE s f ks0 (Just e@(Edge sz ls0 v0 ts0)) = match 0 ks0 ls0 where+      match i _ _ | i `seq` False = undefined+      match i (k:ks) (l:ls) = case compare k l of+	      LT	-> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $+				      fromDistAscListM edgeSize [(k, Edge sv ks (Just v') emptyM), (l, Edge sz ls v0 ts0)]))+			      (f Nothing)+	      GT	-> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $+				      fromDistAscListM edgeSize [(l, Edge sz ls v0 ts0), (k, Edge sv ks (Just v') emptyM)]))+			      (f Nothing)+	      EQ	-> match (i+1) ks ls+      match _ (k:ks) [] = fmap (compact . edge s ls0 v0) (alterLookupM edgeSize g k ts0) where+	      g = alterLookupE s f ks+      match _ [] (l:ls) = fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sv + sz) ks0 (Just v') (singletonM edgeSize l (Edge sz ls v0 ts0))))+			      (f Nothing)+      match _ [] [] = fmap (\ v' -> compact $ edge s ls0 v' ts0) (f v0)++traverseE :: (Applicative f, TrieKey k (TrieMap k)) => Sized b -> ([k] -> a -> f b) -> Edge' k a -> f (Edge' k b)+traverseE s f (Edge _ ks v ts)+	= edge s ks <$> traverse (f ks) v <*> traverseWithKeyM edgeSize g ts +	where	g l = traverseE s (\ ls -> f (ks ++ l:ls))++extractE :: (Alternative f, TrieKey k (TrieMap k)) => Sized a -> ([k] -> a -> f (CPair x (Maybe a))) -> Edge' k a -> f (CPair x (MEdge' k a))+extractE s f (Edge _ ks v ts) = case v of+	Nothing	-> rest+	Just v	-> fmap (\ v' -> compact (edge s ks v' ts)) <$> f ks v <|> rest+	where	rest = fmap (compact . edge s ks v) <$> extractM edgeSize g ts+	     	g l = extractE s (\ ls -> f (ks ++ l:ls))++aboutE :: (Alternative f, TrieKey k (TrieMap k)) => ([k] -> a -> f x) -> Edge' k a -> f x+aboutE f = cpFst <.> extractE (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))++foldE :: TrieKey k (TrieMap k) => ([k] -> a -> b -> b) -> Edge' k a -> b -> b+foldE f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyM g ts z) v where+	g l = foldE (\ ls -> f (ks ++ l:ls))++foldlE :: TrieKey k (TrieMap k) => ([k] -> b -> a -> b) -> b -> Edge' k a -> b +foldlE f z (Edge _ ks v ts) = foldlWithKeyM g ts (foldl (f ks) z v) where+	g l = foldlE (\ ls -> f (ks ++ l:ls))++mapEitherE :: TrieKey k (TrieMap k) => Sized b -> Sized c -> ([k] -> a -> (Maybe b, Maybe c)) -> Edge' k a ->+	(MEdge' k b, MEdge' k c)+mapEitherE s1 s2 f (Edge _ ks v ts) = (compact *** compact) (edge s1 ks vL tsL, edge s2 ks vR tsR)+	where	(vL, vR) = maybe (Nothing, Nothing) (f ks) v+	     	(tsL, tsR) = mapEitherM edgeSize edgeSize (\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts++unionE :: TrieKey k (TrieMap k) => Sized a -> ([k] -> a -> a -> Maybe a) -> Edge' k a -> Edge' k a -> MEdge' k a+unionE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match 0 ks0 ls0 where+	match i _ _ | i `seq` False = undefined+	match i (k:ks) (l:ls) = case compare k l of+	      EQ -> match (i+1) ks ls+	      LT -> Just $ Edge (szK + szL) (take i ks0) Nothing (fromDistAscListM edgeSize +		      [(k, Edge szK ks vK tsK), (l, Edge szL ls vL tsL)])+	      GT -> Just $ Edge (szK + szL) (take i ks0) Nothing (fromDistAscListM edgeSize +		      [(l, Edge szL ls vL tsL), (k, Edge szK ks vK tsK)])+	match _ [] (l:ls) = compact (edge s ks0 vK (alterM edgeSize g l tsK)) where+		g (Just eK') = unionE s (\ ls' -> f (ks0 ++ l:ls')) eK' (Edge szL ls vL tsL)+		g Nothing = Just (Edge szL ls vL tsL)+	match _ (k:ks) [] = compact (edge s ls0 vL (alterM edgeSize g k tsL)) where+		g Nothing = Just (Edge szK ks vK tsK)+		g (Just eL') = unionE s (\ ks' -> f (ls0 ++ k:ks')) (Edge szK ks vK tsK) eL'+	match _ [] [] = compact (edge s ls0 (unionMaybe (f ls0) vK vL) (unionM edgeSize g tsK tsL)) where+		g x = unionE s (\ xs -> f (ls0 ++ x:xs))++isectE :: TrieKey k (TrieMap k) => Sized c -> ([k] -> a -> b -> Maybe c) -> Edge' k a -> Edge' k b -> MEdge' k c+isectE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match ks0 ls0 where+	match (k:ks) (l:ls)+		| k == l	= match ks ls+	match (k:ks) [] = do	eL' <- lookupM k tsL+			   	cat ls0 <$> cons k <$> isectE s (\ ks' -> f (ls0 ++ k:ks')) (Edge szK ks vK tsK) eL'+	match [] (l:ls) = do	eK' <- lookupM l tsK+				cat ks0 <$> cons l <$> isectE s (\ ls' -> f (ks0 ++ l:ls')) eK' (Edge szL ls vL tsL)+	match [] [] = compact (edge s ks0 (isectMaybe (f ks0) vK vL) (isectM edgeSize g tsK tsL)) where+		g x = isectE s (\ xs -> f (ks0 ++ x:xs))+	match _ _ = Nothing++diffE :: TrieKey k (TrieMap k) => Sized a -> ([k] -> a -> b -> Maybe a) -> Edge' k a -> Edge' k b -> MEdge' k a+diffE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match ks0 ls0 where+	match (k:ks) (l:ls)+		| k == l	= match ks ls+	match (k:ks) []+		| Just eL' <- lookupM k tsL+			= cat ls0 . cons k <$> diffE s (\ ks' -> f (ls0 ++ k:ks')) (Edge szK ks vK tsK) eL'+	match [] (l:ls)+		= compact (edge s ks0 vK (alterM edgeSize (>>= g) l tsK))+		where	g eK' = diffE s (\ ls' -> f (ks0 ++ l:ls')) eK' (Edge szL ls vL tsL)+	match [] [] = compact (edge s ks0 (diffMaybe (f ks0) vK vL) (diffM edgeSize g tsK tsL)) where+		g x = diffE s (\ xs -> f (ks0 ++ x:xs))+	match _ _ = Just eK++lookupIxE :: TrieKey k (TrieMap k) => Sized a -> Int -> [k] -> Edge' k a -> IndexPos [k] a+lookupIxE s i ks e@(Edge sz ls v ts) = match ks ls where+	match (k:ks) (l:ls) = case compare k l of+		LT	-> (empty, empty, aboutE (return .: Asc i) e)+		EQ	-> match ks ls+		GT	-> (aboutE (\ k a -> return (Asc (i + sz - s a) k a)) e, empty, empty)+	match (k:ks) [] = let sv = maybe 0 s v in case onIndex (i + sv +) (lookupIxM edgeSize k ts) of+		(lb, x, ub) -> let lookupX = do	Asc i' k' e' <- x+						return $ onKey (\ ks' -> ls ++ k':ks') $+							lookupIxE s i' ks e'+			in ((do v <- Last v+				return (Asc i ls v)) <|>+			    (do Asc iL kL eL <- lb+				aboutE (\ ksL vL -> return $ Asc (iL + edgeSize eL - s vL) (ls ++ kL:ksL) vL) eL) <|>+			    (do (lb', _, _) <- Last lookupX+				lb'),+			    (do (_, x', _) <- lookupX+				x'),+			    (do (_, _, ub') <- First lookupX+				ub') <|>+			    (do Asc iU kU eU <- ub+				aboutE (\ ksU -> return . Asc iU (ls ++ kU:ksU)) eU))+	match [] (l:ls) = (empty, empty, aboutE (return .: Asc i) e)+	match [] [] = (empty, Asc i ls <$> v, aboutM (\ x -> aboutE (\ xs -> return . Asc (i + maybe 0 s v) (ls ++ x:xs))) ts)++isSubmapE :: TrieKey k (TrieMap k) => LEq a b -> LEq (Edge' k a) (Edge' k b)+isSubmapE (<=) (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where+	match (k:ks) (l:ls)+		| k == l	= match ks ls+	match (k:ks) []+		| Just eL' <- lookupM k tsL+			= isSubmapE (<=) (Edge szK ks vK tsK) eL'+	match [] [] = subMaybe (<=) vK vL && isSubmapM (isSubmapE (<=)) tsK tsL+	match _ _ = False++splitLookupE :: TrieKey k (TrieMap k) => Sized a -> (a -> (Maybe a, Maybe x, Maybe a)) -> [k] -> Edge' k a ->+	(MEdge' k a, Maybe x, MEdge' k a)+splitLookupE s f ks e@(Edge _ ls v ts) = match ks ls where+	match (k:ks) (l:ls) = case compare k l of+		LT	-> (Nothing, Nothing, Just e)+		GT	-> (Just e, Nothing, Nothing)+		EQ	-> match ks ls+	match (k:ks) [] = case splitLookupM edgeSize g k ts of+		(tsL, x, tsR) -> (compact (edge s ls v tsL), x, compact (edge s ls Nothing tsR))+		where	g = splitLookupE s f ks+	match [] (l:ls) = (Nothing, Nothing, Just e)+	match [] [] = (singleMaybe s ls vL, x, compact (edge s ls vR ts))+		where	(vL, x, vR) = maybe (Nothing, Nothing, Nothing) f v++assocAtE :: TrieKey k (TrieMap k) => Sized a -> Int -> Int -> Edge' k a -> IndexPos [k] a+assocAtE _ i0 i _ | i0 `seq` i `seq` False = undefined+assocAtE s i0 i (Edge sz ks v ts) = let sv = maybe 0 s v in case assocAtM edgeSize (i - sv) ts of+	(lb, x, ub) -> let lookupX = do Asc i' l e' <- x+					return (onKey (\ ls -> ks ++ l:ls) (assocAtE s (i0 + sv + i') (i - i') e'))+		in ((do	v <- Last v+			guard (i >= sv)+			return (Asc i0 ks v)) <|>+		      (do	Asc iL lL eL <- lb+				aboutE (\ ls vL -> return (Asc (i0 + iL + sv + edgeSize eL - s vL) (ks ++ lL:ls) vL)) eL) <|>+		      (do	(lb', _, _) <- Last lookupX+				lb'),+		      (do	v <- v+				guard (i >= 0 && i < sv)+				return (Asc i0 ks v)) <|> +		      (do	(_, x', _) <- lookupX+				x'),+		      (do	(_, _, ub') <- First lookupX+				ub') <|>+		      (do	v <- First v+				guard (i < 0)+				return (Asc i0 ks v)))
Data/TrieMap/Regular/Base.hs view
@@ -2,7 +2,7 @@  module Data.TrieMap.Regular.Base where -import Data.TrieMap.TrieKey+-- import Data.TrieMap.TrieKey  newtype K0 a r = K0 {unK0 :: a} deriving (Show) newtype I0 r = I0 {unI0 :: r} deriving (Show)
Data/TrieMap/Regular/Class.hs view
@@ -5,10 +5,11 @@ import Data.TrieMap.Sized import Data.TrieMap.Applicative import Data.TrieMap.TrieKey-import Data.TrieMap.Regular.Eq+-- import Data.TrieMap.Regular.Eq import Data.TrieMap.Regular.Ord+import Data.TrieMap.CPair -import Data.Monoid+-- import Data.Monoid  import Control.Applicative @@ -23,6 +24,7 @@ 	assocAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Int -> m k a -> IndexPos (f k) a -- 	updateAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Round -> (Int -> f k -> a -> Maybe (a)) -> Int -> m k a -> m k a 	alterT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe (a) -> Maybe (a)) -> f k -> m k a -> m k a+	alterLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe a -> CPair x (Maybe a)) -> f k -> m k a -> CPair x (m k a) 	traverseWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Applicative t) =>  		Sized b -> (f k -> a -> t (b)) -> m k a -> t (m k b) 	foldWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => @@ -52,6 +54,8 @@ 	fromListT s f = foldr (\ (k, a) -> alterT s (Just . maybe a (f k a)) k) emptyT 	fromAscListT = fromListT 	fromDistAscListT s = fromAscListT s (const const)+-- 	alterLookupT s f k m = fmap (\ v' -> alterT s (const v') k m) (f (lookupT k m))+	alterT s f k m = cpSnd (alterLookupT s (cP () . f) k m) -- 	updateAtT s f i m = case assocAtT s i m of -- 		(i, k, a) -> alterT s (const (f i k a)) k m @@ -76,7 +80,7 @@  aboutT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => 	(f k -> a -> t z) -> TrieMapT f k a -> t z-aboutT f m = fst <$> extractT (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a)) m+aboutT f m = cpFst <$> extractT (const 0) (\ k a -> fmap (flip cP Nothing) (f k a)) m  {-alterMinT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a
Data/TrieMap/Regular/CompMap.hs view
@@ -6,10 +6,10 @@ import Data.TrieMap.Regular.Class import Data.TrieMap.Regular.Ord import Data.TrieMap.Regular.Eq-import Data.TrieMap.Regular.TH+-- import Data.TrieMap.Regular.TH import Data.TrieMap.TrieKey-import Data.TrieMap.Rep-import Data.TrieMap.Rep.TH+-- import Data.TrieMap.Rep+-- import Data.TrieMap.Rep.TH  import Control.Applicative import Control.Arrow@@ -37,34 +37,79 @@ instance (OrdT f, Ord g) => Ord (App f g) where 	compare = compareT -$(deriveM [d|-   instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g)) => TrieKeyT (f `O` g) (CompMap m g) where+instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g), TrieKey k (TrieMap k)) => +		TrieKey ((f `O` g) k) (CompMap m g k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT+++instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g)) => TrieKeyT (f `O` g) (CompMap m g) where 	emptyT = CMap emptyT 	nullT (CMap m) = nullT m 	sizeT s (CMap m) = sizeT s m-	lookupT (O x) (CMap m) = lookupT (fmap A x) m-	lookupIxT s (O x) (CMap m) = onKey (O . fmap unA) (lookupIxT s (fmap A x) m)+	lookupT (O x) (CMap m) = lookupT (A <$> x) m+	lookupIxT s (O x) (CMap m) = onKey (O . fmap unA) (lookupIxT s (A <$> x) m) 	assocAtT s i (CMap m) = onKey (O . fmap unA) (assocAtT s i m) -- 	updateAtT s r f i (CMap m) -- 		= CMap (updateAtT s r (\ i' -> f i' . O . fmap unA) i m)-	alterT s f (O x) (CMap m) = CMap (alterT s f (fmap A x) m)+	alterT s f (O x) (CMap m) = CMap (alterT s f (A <$> x) m)+	alterLookupT s f (O x) (CMap m) = CMap <$> alterLookupT s f (A <$> x) m 	traverseWithKeyT s f (CMap m) = CMap <$> traverseWithKeyT s (f . O . fmap unA) m 	foldWithKeyT f (CMap m) = foldWithKeyT (f . O . fmap unA) m 	foldlWithKeyT f (CMap m) = foldlWithKeyT (f . O . fmap unA) m 	mapEitherT s1 s2 f (CMap m) = (CMap *** CMap) (mapEitherT s1 s2 (f . O . fmap unA) m)-	splitLookupT s f (O k) (CMap m) = CMap `sides` splitLookupT s f (fmap A k) m+	splitLookupT s f (O k) (CMap m) = CMap `sides` splitLookupT s f (A <$> k) m 	isSubmapT (<=) (CMap m1) (CMap m2) = isSubmapT (<=) m1 m2-	extractT s f (CMap m) = second CMap <$> extractT s (f . O . fmap unA) m+	extractT s f (CMap m) = fmap CMap <$> extractT s (f . O . fmap unA) m -- 	extractMinT s f (CMap m) = second CMap <$> extractMinT s (f . O . fmap unA) m -- 	extractMaxT s f (CMap m) = second CMap <$> extractMaxT s (f . O . fmap unA) m -- 	alterMinT s f (CMap m) = CMap (alterMinT s (f . O . fmap unA) m) -- 	alterMaxT s f (CMap m) = CMap (alterMaxT s (f . O . fmap unA) m) 	unionT s f (CMap m1) (CMap m2) = CMap (unionT s (f . O . fmap unA) m1 m2) 	isectT s f (CMap m1) (CMap m2) = CMap (isectT s (f . O . fmap unA) m1 m2)-	diffT s f (CMap m1) (CMap m2) = CMap (diffT s (f . O . fmap unA) m1 m2) |])+	diffT s f (CMap m1) (CMap m2) = CMap (diffT s (f . O . fmap unA) m1 m2) -$(deriveM [d| -   instance TrieKeyT f m => TrieKeyT (App f) (AppMap m) where+instance (TrieKeyT f m, TrieKey k (TrieMap k)) => TrieKey (App f k) (AppMap m k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT++instance TrieKeyT f m => TrieKeyT (App f) (AppMap m) where 	emptyT = AMap emptyT 	nullT (AMap m) = nullT m 	sizeT s (AMap m) = sizeT s m@@ -73,12 +118,13 @@ 	assocAtT s i (AMap m) = onKey A (assocAtT s i m) -- 	updateAtT s r f i (AMap m) = AMap (updateAtT s r (\ i' -> f i' . A) i m) 	alterT s f (A k) (AMap m) = AMap (alterT s f k m)+	alterLookupT s f (A k) (AMap m) = AMap <$> alterLookupT s f k m 	traverseWithKeyT s f (AMap m) = AMap <$> traverseWithKeyT s (f . A) m 	foldWithKeyT f (AMap m) = foldWithKeyT (f . A) m 	foldlWithKeyT f (AMap m) = foldlWithKeyT (f . A) m 	mapEitherT s1 s2 f (AMap m) = (AMap *** AMap) (mapEitherT s1 s2 (f . A) m) 	splitLookupT s f (A k) (AMap m) = AMap `sides` splitLookupT s f k m-	extractT s f (AMap m) = second AMap <$> extractT s (f . A) m+	extractT s f (AMap m) = fmap AMap <$> extractT s (f . A) m -- 	extractMinT s f (AMap m) = second AMap <$> extractMinT s (f . A) m -- 	extractMaxT s f (AMap m) = second AMap <$> extractMaxT s (f . A) m -- 	alterMinT s f (AMap m) = AMap (alterMinT s (f . A) m)@@ -86,4 +132,4 @@ 	unionT s f (AMap m1) (AMap m2) = AMap (unionT s (f . A) m1 m2) 	isectT s f (AMap m1) (AMap m2) = AMap (isectT s (f . A) m1 m2) 	diffT s f (AMap m1) (AMap m2) = AMap (diffT s (f . A) m1 m2)-	isSubmapT (<=) (AMap m1) (AMap m2) = isSubmapT (<=) m1 m2 |])+	isSubmapT (<=) (AMap m1) (AMap m2) = isSubmapT (<=) m1 m2
Data/TrieMap/Regular/ConstMap.hs view
@@ -25,6 +25,7 @@ 	assocAtM s i (KMap m) = onKey K0 (assocAtM s i m) -- 	updateAtM s r f i (KMap m) = KMap (updateAtM s r (\ i -> f i . K0) i m) 	alterM s f (K0 k) (KMap m) = KMap (alterM s f k m)+	alterLookupM s f (K0 k) (KMap m) = KMap <$> alterLookupM s f k m 	traverseWithKeyM s f (KMap m) = KMap <$> traverseWithKeyM s (f . K0) m 	foldWithKeyM f (KMap m) = foldWithKeyM (f . K0) m 	foldlWithKeyM f (KMap m) = foldlWithKeyM (f . K0) m@@ -33,7 +34,7 @@ 	unionM s f (KMap m1) (KMap m2) = KMap (unionM s (f . K0) m1 m2) 	isectM s f (KMap m1) (KMap m2) = KMap (isectM s (f . K0) m1 m2) 	diffM s f (KMap m1) (KMap m2) = KMap (diffM s (f . K0) m1 m2)-	extractM s f (KMap m) = second KMap <$> extractM s (f . K0) m+	extractM s f (KMap m) = fmap KMap <$> extractM s (f . K0) m -- 	extractMinM s f (KMap m) = second KMap <$> extractMinM s (f . K0) m -- 	extractMaxM s f (KMap m) = second KMap <$> extractMaxM s (f . K0) m -- 	alterMinM s f (KMap m) = KMap (alterMinM s (f . K0) m) @@ -52,6 +53,7 @@ 	assocAtT = assocAtM -- 	updateAtT = updateAtM 	alterT = alterM+	alterLookupT = alterLookupM 	traverseWithKeyT = traverseWithKeyM 	foldWithKeyT = foldWithKeyM 	foldlWithKeyT = foldlWithKeyM
Data/TrieMap/Regular/Eq.hs view
@@ -3,8 +3,8 @@ module Data.TrieMap.Regular.Eq where  import Data.TrieMap.Regular.Base-import Data.TrieMap.MultiRec.Base(FamT(..), KeyFam(..))-import Data.TrieMap.MultiRec.Eq(HEq0(..))+-- import Data.TrieMap.MultiRec.Base(Family(..))+-- import Data.TrieMap.MultiRec.Eq(HEq0(..)) import Data.TrieMap.Modifiers  class EqT f where@@ -12,6 +12,9 @@  eqT :: (EqT f, Eq a) => f a -> f a -> Bool eqT = eqT0 (==)++-- instance EqT (Family phi) where+-- 	eqT0 (==) (F a) (F b) = a == b  instance Eq a => EqT (K0 a) where 	eqT0 _ (K0 a) (K0 b) = a == b
Data/TrieMap/Regular/IdMap.hs view
@@ -23,6 +23,7 @@ 	assocAtT s i (IMap m) = onKey I0 (assocAtM s i m) -- 	updateAtT s r f i (IMap m) = IMap (updateAtM s r (\ i -> f i . I0) i m) 	alterT s f (I0 k) (IMap m) = IMap (alterM s f k m)+	alterLookupT s f (I0 k) (IMap m) = IMap <$> alterLookupM s f k m 	traverseWithKeyT s f (IMap m) = IMap <$> traverseWithKeyM s (f . I0) m 	foldWithKeyT f (IMap m) = foldWithKeyM (f . I0) m 	foldlWithKeyT f (IMap m) = foldlWithKeyM (f . I0) m@@ -31,7 +32,7 @@ 	unionT s f (IMap m1) (IMap m2) = IMap (unionM s (f . I0) m1 m2) 	isectT s f (IMap m1) (IMap m2) = IMap (isectM s (f . I0) m1 m2) 	diffT s f (IMap m1) (IMap m2) = IMap (diffM s (f . I0) m1 m2)-	extractT s f (IMap m) = second IMap <$> extractM s (f . I0) m+	extractT s f (IMap m) = fmap IMap <$> extractM s (f . I0) m -- 	extractMinT s f (IMap m) = second IMap <$> extractMinM s (f . I0) m -- 	extractMaxT s f (IMap m) = second IMap <$> extractMaxM s (f . I0) m -- 	alterMinT s f (IMap m) = IMap (alterMinM s (f . I0) m)@@ -50,6 +51,7 @@ 	assocAtM = assocAtT -- 	updateAtM = updateAtT 	alterM = alterT+	alterLookupM = alterLookupT 	traverseWithKeyM = traverseWithKeyT 	foldWithKeyM = foldWithKeyT 	foldlWithKeyM = foldlWithKeyT
Data/TrieMap/Regular/Ord.hs view
@@ -4,9 +4,9 @@  import Data.TrieMap.Regular.Base import Data.TrieMap.Regular.Eq-import Data.TrieMap.MultiRec.Base(FamT(..), KeyFam(..))-import Data.TrieMap.MultiRec.Ord(HOrd0(..))-import Data.TrieMap.TrieKey+-- import Data.TrieMap.MultiRec.Base(Family(..))+-- import Data.TrieMap.MultiRec.Ord(HOrd0(..))+-- import Data.TrieMap.TrieKey import Data.TrieMap.Modifiers import Data.Monoid @@ -19,7 +19,9 @@ compareT = compareT0 compare  -- instance HOrd0 KeyFam r => OrdT (FamT KeyFam r) where-	++-- instance OrdT (Family phi) where+-- 	compareT0 cmp (F a) (F b) = cmp a b  instance Ord a => OrdT (K0 a) where 	compareT0 _ (K0 a) (K0 b) = compare a b
Data/TrieMap/Regular/ProdMap.hs view
@@ -8,7 +8,7 @@ import Data.TrieMap.TrieKey import Data.TrieMap.Applicative import Data.TrieMap.Sized-import Data.TrieMap.Regular.TH+-- import Data.TrieMap.Regular.TH  import Control.Applicative import Control.Arrow@@ -28,8 +28,30 @@  --maybe (sizeT s m) fst (getLast (extractMaxT s (\ _ a -> (sizeT s m - s a, Just a)) m)) -$(deriveM [d|-   instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :*: g) (PMap m1 m2) where+instance (TrieKeyT f m1, TrieKeyT g m2, TrieKey k (TrieMap k)) =>+	TrieKey ((f :*: g) k) (PMap m1 m2 k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT++instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :*: g) (PMap m1 m2) where 	emptyT = PMap emptyT 	nullT (PMap m) = nullT m 	sizeT s (PMap m) = sizeT (sizeT s) m@@ -78,6 +100,8 @@ -- 				= guardNullT (updateAtT s r (\ i' -> f (iA + i') . (a :*:)) (i - iA) m') 	alterT s f (a :*: b) (PMap m) = PMap (alterT (sizeT s) g a m) where 		g = guardNullT . alterT s f b . fromMaybe emptyT+	alterLookupT s f (a :*: b) (PMap m) = PMap <$> alterLookupT (sizeT s) g a m where+		g = fmap guardNullT . alterLookupT s f b . fromMaybe emptyT 	traverseWithKeyT s f (PMap m) = PMap <$> traverseWithKeyT (sizeT s) g m where 		g a = traverseWithKeyT s (\ b -> f (a :*: b)) 	foldWithKeyT f (PMap m) = foldWithKeyT g m where@@ -91,8 +115,8 @@ 	unionT s f (PMap m1) (PMap m2) = PMap (unionT (sizeT s) (\ a -> guardNullT .: unionT s (\ b -> f (a :*: b))) m1 m2) 	isectT s f (PMap m1) (PMap m2) = PMap (isectT (sizeT s) (\ a -> guardNullT .: isectT s (\ b -> f (a :*: b))) m1 m2) 	diffT s f (PMap m1) (PMap m2) = PMap (diffT (sizeT s) (\ a -> guardNullT .: diffT s (\ b -> f (a :*: b))) m1 m2)-	extractT s f (PMap m) = second PMap <$> extractT (sizeT s) g m where-		g a = second guardNullT <.> extractT s (\ b -> f (a :*: b))+	extractT s f (PMap m) = fmap PMap <$> extractT (sizeT s) g m where+		g a = fmap guardNullT <.> extractT s (\ b -> f (a :*: b)) -- 	extractMinT s f (PMap m) = second PMap <$> extractMinT (sizeT s) g m where -- 		g a = second guardNullT . fromJust . getFirst . extractMinT s (f . (a :*:)) -- 	extractMaxT s f (PMap m) = second PMap <$> extractMaxT (sizeT s) g m where@@ -105,11 +129,10 @@ 	fromAscListT s f xs = PMap (fromDistAscListT (sizeT s) 		[(a, fromAscListT s (\ b -> f (a :*: b)) ys) | (a, ys) <- breakFst xs]) 	-   breakFst :: (EqT f, Eq k) => [((f :*: g) k, a)] -> [(f k, [(g k, a)])]-   breakFst [] = []-   breakFst ((a :*: b, v):xs) = breakFst' a (Seq.singleton (b, v)) xs where+breakFst :: (EqT f, Eq k) => [((f :*: g) k, a)] -> [(f k, [(g k, a)])]+breakFst [] = []+breakFst ((a :*: b, v):xs) = breakFst' a (Seq.singleton (b, v)) xs where    	breakFst' a vs ((a' :*: b', v):xs) 		| a `eqT` a'	= breakFst' a (vs |> (b', v)) xs 		| otherwise	= (a, toList vs):breakFst' a' (Seq.singleton (b', v)) xs 	breakFst' a vs [] = [(a, toList vs)]-	|])
Data/TrieMap/Regular/RadixTrie.hs view
@@ -6,13 +6,14 @@ import Data.TrieMap.Regular.Base import Data.TrieMap.Regular.Ord import Data.TrieMap.Regular.Eq-import Data.TrieMap.Regular.TH+-- import Data.TrieMap.Regular.TH import Data.TrieMap.Sized import Data.TrieMap.TrieKey import Data.TrieMap.Applicative-import Data.TrieMap.Rep-import Data.TrieMap.Rep.TH-import qualified Data.TrieMap.MultiRec.Base as MR+import Data.TrieMap.CPair+-- import Data.TrieMap.Rep+-- import Data.TrieMap.Rep.TH+-- import qualified Data.TrieMap.MultiRec.Base as MR  import Control.Arrow import Control.Applicative@@ -57,6 +58,7 @@ 	assocAtT s i (Radix m) = maybe (mzero, mzero, mzero) (onKey List . assocAtE s 0 i) m -- 	updateAtT s r f i (Radix m) = Radix (m >>= updateAtE s r (\ i' -> f i' . List) i) 	alterT s f (List ks) (Radix m) = Radix (maybe (singletonME s ks (f Nothing)) (alterE s f ks) m)+	alterLookupT s f (List ks) (Radix m) = Radix <$> maybe (singletonME s ks <$> f Nothing) (alterLookupE s f ks) m 	traverseWithKeyT s f (Radix m) = Radix <$> traverse (traverseE s (f . List)) m 	foldWithKeyT f (Radix m) z = foldr (foldE (f . List)) z m 	foldlWithKeyT f (Radix m) z = foldr (foldlE (f . List)) z m@@ -65,7 +67,7 @@ 	unionT s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s (f . List)) m1 m2) 	isectT s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s (f . List)) m1 m2) 	diffT s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s (f . List)) m1 m2)-	extractT s f (Radix m) = maybe empty (second Radix <.> extractE s (f . List)) m+	extractT s f (Radix m) = maybe empty (fmap Radix <.> extractE s (f . List)) m -- -- 	extractMinT s f (Radix m) = First m >>= fmap (second Radix) . extractMinE s (f . List) -- 	extractMaxT s f (Radix m) = Last m >>= fmap (second Radix) . extractMaxE s (f . List) -- 	alterMinT s f (Radix m) = Radix (m >>= alterMinE s (f . List))@@ -83,6 +85,7 @@ 	assocAtM = assocAtT -- 	updateAtM = updateAtT 	alterM = alterT+	alterLookupM = alterLookupT 	traverseWithKeyM = traverseWithKeyT 	foldWithKeyM = foldWithKeyT 	foldlWithKeyM = foldlWithKeyT@@ -165,6 +168,24 @@ 	match _ [] [] = compact (edge s ls0 (f v0) ts0) 	match _ _ _ = Just e +alterLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>+	Sized a -> (Maybe a -> CPair x (Maybe a)) -> [f k] -> Edge' f k a -> CPair x (MEdge' f k a)+alterLookupE s f ks0 e@(Edge sz ls0 v0 ts0) = match 0 ks0 ls0 where+	match i _ _ | i `seq` False = undefined+	match i (k:ks) (l:ls) = case compareT k l of+		LT -> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $ +				fromDistAscListT edgeSize [(k, Edge sv ks (Just v') emptyT), (l, Edge sz ls v0 ts0)]))+			(f Nothing)+		GT -> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $ +				fromDistAscListT edgeSize [(l, Edge sz ls v0 ts0), (k, Edge sv ks (Just v') emptyT)]))+			(f Nothing)+		EQ	-> match (i+1) ks ls+	match _ (k:ks) [] = fmap (compact . edge s ls0 v0) (alterLookupT edgeSize g k ts0) where+		g = maybe (singletonME s ks <$> f Nothing) (alterLookupE s f ks)+	match _ [] (l:ls) = fmap (Just . maybe e (\ v' -> Edge (sz + s v') ks0 (Just v') (singletonT edgeSize l (Edge sz ls v0 ts0))))+				(f Nothing)+	match _ [] [] = fmap (\ v' -> compact (edge s ls0 v' ts0)) (f v0)+ traverseE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Applicative t) =>  	Sized b -> ([f k] -> a -> t (b)) -> Edge' f k a -> t (Edge' f k b) traverseE s f (Edge _ ks v ts) =@@ -213,15 +234,15 @@ 	match _ [] [] = compact (edge s ks0 (unionMaybe (f ks0) vK vL) (unionT edgeSize g tsK tsL)) where 		g x = unionE s (\ xs -> f (ks0 ++ x:xs)) -extractE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => Sized a -> ([f k] -> a -> t (x, Maybe a)) -> -	Edge' f k a -> t (x, MEdge' f k a)-extractE s f (Edge _ ks v ts) = (maybe empty (second (\ v' -> compact (edge s ks v' ts)) <.> f ks) v) <|>-  		(second (compact . edge s ks Nothing) <$> extractT edgeSize g ts)+extractE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => Sized a -> ([f k] -> a -> t (CPair x (Maybe a))) -> +	Edge' f k a -> t (CPair x (MEdge' f k a))+extractE s f (Edge _ ks v ts) = (maybe empty (fmap (\ v' -> compact (edge s ks v' ts)) <.> f ks) v) <|>+  		(fmap (compact . edge s ks Nothing) <$> extractT edgeSize g ts) 	where	g l = extractE s (\ ls -> f (ks ++ l:ls))  aboutE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => ([f k] -> a -> t x) -> 	Edge' f k a -> t x-aboutE f = fst <.> extractE (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a))+aboutE f = cpFst <.> extractE (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))  -- extractMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> (x, Maybe a)) ->  -- 	Edge' f k a -> Last (x, MEdge' f k a)
Data/TrieMap/Regular/RegMap.hs view
@@ -21,6 +21,7 @@ 	assocAtM s i (RegMap m) = onKey to' (assocAtT s i m) -- 	updateAtM s r f i (RegMap m) = RegMap (updateAtT s r (\ i' -> f i' . to') i m) 	alterM s f k (RegMap m) = RegMap (alterT s f (from' k) m)+	alterLookupM s f k (RegMap m) = RegMap <$> alterLookupT s f (from' k) m 	traverseWithKeyM s f (RegMap m) = RegMap <$> traverseWithKeyT s (f . to') m 	foldWithKeyM f (RegMap m) = foldWithKeyT (f . to') m 	foldlWithKeyM f (RegMap m) = foldlWithKeyT (f . to') m@@ -29,7 +30,7 @@ 	unionM s f (RegMap m1) (RegMap m2) = RegMap (unionT s (f . to') m1 m2) 	isectM s f (RegMap m1) (RegMap m2) = RegMap (isectT s (f . to') m1 m2) 	diffM s f (RegMap m1) (RegMap m2) = RegMap (diffT s (f . to') m1 m2)-	extractM s f (RegMap m) = second RegMap <$> extractT s (f . to') m+	extractM s f (RegMap m) = fmap RegMap <$> extractT s (f . to') m -- 	extractMinM s f (RegMap m) = second RegMap <$> extractMinT s (f . to') m -- 	extractMaxM s f (RegMap m) = second RegMap <$> extractMaxT s (f . to') m -- 	alterMinM s f (RegMap m) = RegMap (alterMinT s (f . to') m)
Data/TrieMap/Regular/TH.hs view
@@ -8,7 +8,7 @@  deriveM :: Q [Dec] -> Q [Dec] deriveM decs = do-	iT@(InstanceD cxt (triekeyt `AppT` f `AppT` m) _:_) <- decs+	iT@(InstanceD cxt inst _:_) <- decs 	(InstanceD _ _ myDecs:_) <- [d| 	  instance (TrieKeyT f m, Ord (f k), TrieKey k mm) => TrieKey (f k) (m k) where 		emptyM = emptyT@@ -17,7 +17,9 @@ 		lookupIxM = lookupIxT 		assocAtM = assocAtT -- 		updateAtM = updateAtT+ 		alterM = alterT+		alterLookupM = alterLookupT 		traverseWithKeyM = traverseWithKeyT 		foldWithKeyM = foldWithKeyT 		foldlWithKeyM = foldlWithKeyT@@ -39,8 +41,7 @@ 	let triekey = ConT ''TrieKey 	let triemap = ConT ''TrieMap 	let ordT = ConT ''Ord-	return (InstanceD (triekey `AppT` k `AppT` (triemap `AppT` k):ordT `AppT` (f `AppT` k):cxt)-			(triekey `AppT` (f `AppT` k) `AppT` (m `AppT` k)) myDecs:iT)+	return [InstanceD cxt inst myDecs]  mkVar :: String -> TypeQ mkVar x = varT =<< newName x
Data/TrieMap/Regular/UnionMap.hs view
@@ -4,18 +4,18 @@  import Data.TrieMap.Regular.Class import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.TH+-- import Data.TrieMap.Regular.TH import Data.TrieMap.TrieKey import Data.TrieMap.Applicative -- import Data.TrieMap.Rep -- import Data.TrieMap.Rep.TH  import Control.Applicative-import Control.Arrow+-- import Control.Arrow import Control.Monad -import Data.Either-import Data.Monoid+-- import Data.Either+-- import Data.Monoid  -- import Generics.MultiRec.Base data UnionMap m1 m2 k a = m1 k a :&: m2 k a@@ -31,8 +31,30 @@ -- 	toRepT (m1 :&: m2) = toRepT m1 :*: toRepT m2 -- 	fromRepT (m1 :*: m2) = fromRepT m1 :&: fromRepT m2 |]) -$(deriveM [d| -   instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :+: g) (UnionMap m1 m2) where+instance (TrieKeyT f m1, TrieKeyT g m2, TrieKey k (TrieMap k)) => TrieKey ((f :+: g) k) (UnionMap m1 m2 k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT+++instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :+: g) (UnionMap m1 m2) where 	emptyT = emptyT :&: emptyT 	nullT (m1 :&: m2) = nullT m1 && nullT m2 	sizeT s (m1 :&: m2) = sizeT s m1 + sizeT s m2@@ -60,6 +82,9 @@ 	alterT s f k (m1 :&: m2) = case k of 		L k -> alterT s f k m1 :&: m2 		R k -> m1 :&: alterT s f k m2+	alterLookupT s f k (m1 :&: m2) = case k of+		L k -> fmap (:&: m2) (alterLookupT s f k m1)+		R k -> fmap (m1 :&:) (alterLookupT s f k m2) 	traverseWithKeyT s f (m1 :&: m2) = (:&:) <$> traverseWithKeyT s (f . L) m1 <*> traverseWithKeyT s (f . R) m2 	foldWithKeyT f (m1 :&: m2) = foldWithKeyT (f . L) m1 . foldWithKeyT (f . R) m2 	foldlWithKeyT f (m1 :&: m2) = foldlWithKeyT (f . R) m2 . foldlWithKeyT (f . L) m1@@ -73,8 +98,8 @@ 	unionT s f (m11 :&: m12) (m21 :&: m22) = unionT s (f . L) m11 m21 :&: unionT s (f . R) m12 m22 	isectT s f (m11 :&: m12) (m21 :&: m22) = isectT s (f . L) m11 m21 :&: isectT s (f . R) m12 m22 	diffT s f (m11 :&: m12) (m21 :&: m22) = diffT s (f . L) m11 m21 :&: diffT s (f . R) m12 m22-	extractT s f (m1 :&: m2) = second (:&: m2) <$> extractT s (f . L) m1 <|>-		second (m1 :&:) <$> extractT s (f . R) m2+	extractT s f (m1 :&: m2) = fmap (:&: m2) <$> extractT s (f . L) m1 <|>+		fmap (m1 :&:) <$> extractT s (f . R) m2 -- 	extractMinT s f (m1 :&: m2) = second (:&: m2) <$> extractMinT s (f . L) m1 <|> -- 		second (m1 :&:) <$> extractMinT s (f . R) m2 -- 	extractMaxT s f (m1 :&: m2) = second (:&: m2) <$> extractMaxT s (f . L) m1 <|>@@ -91,4 +116,4 @@ 	fromAscListT s f xs = case partEithers xs of 		(ys, zs) -> fromAscListT s (f . L) ys :&: fromAscListT s (f . R) zs 	fromDistAscListT s xs = case partEithers xs of-		(ys, zs) -> fromDistAscListT s ys :&: fromDistAscListT s zs |])+		(ys, zs) -> fromDistAscListT s ys :&: fromDistAscListT s zs
Data/TrieMap/Regular/UnitMap.hs view
@@ -5,9 +5,9 @@ import Data.TrieMap.Regular.Class import Data.TrieMap.Regular.Base import Data.TrieMap.TrieKey-import Data.TrieMap.Rep-import Data.TrieMap.Rep.Instances-import Data.TrieMap.Rep.TH+-- import Data.TrieMap.Rep+-- import Data.TrieMap.Rep.Instances+-- import Data.TrieMap.Rep.TH import Data.TrieMap.Applicative  import Control.Applicative@@ -25,14 +25,6 @@ type instance TrieMapT U0 = M type instance TrieMap (U0 r) = M r -type instance RepT (M k) = RepT Maybe-type instance Rep (M k a) = RepT Maybe (Rep a)--$(genRepT [d|-   instance ReprT (M k) where-	toRepT (M a) = toRepT a-	fromRepT = M . fromRepT |])- instance TrieKey (U0 r) (M r) where 	emptyM = M Nothing 	nullM (M a) = isNothing a@@ -50,6 +42,7 @@ -- 			| r && i >= 0		-> M (v >>= f 0 U0) -- 		_ -> M v 	alterM _ f _ (M a) = M (f a)+	alterLookupM _ f _ (M a) = M <$> f a 	traverseWithKeyM _ f (M a) = M <$> traverse (f U0) a 	foldWithKeyM f (M a) z = foldr (f U0) z a 	foldlWithKeyM f (M a) z = foldl (f U0) z a@@ -59,7 +52,7 @@ 	unionM _ f (M a) (M b) = M (unionMaybe (f U0) a b) 	isectM _ f (M a) (M b) = M (isectMaybe (f U0) a b) 	diffM _ f (M a) (M b) = M (diffMaybe (f U0) a b)-	extractM _ f (M a) = maybe empty (second M <.> f U0) a+	extractM _ f (M a) = maybe empty (fmap M <.> f U0) a -- 	extractMinM _ f (M a) = fmap (second M . f U0) (First a) -- 	extractMaxM _ f (M a) = fmap (second M . f U0) (Last a) -- 	alterMinM _ f (M a) = M (a >>= f U0)@@ -77,6 +70,7 @@ 	assocAtT = assocAtM -- 	updateAtT = updateAtM 	alterT = alterM+	alterLookupT = alterLookupM 	traverseWithKeyT = traverseWithKeyM 	foldWithKeyT = foldWithKeyM 	foldlWithKeyT = foldlWithKeyM
Data/TrieMap/Rep/Instances.hs view
@@ -5,7 +5,7 @@ import Data.TrieMap.Rep import Data.TrieMap.Rep.TH import Data.TrieMap.Regular.Base-import Data.TrieMap.OrdMap+-- import Data.TrieMap.OrdMap import Data.TrieMap.Modifiers -- import Language.Haskell.TH @@ -17,6 +17,8 @@ import Data.Foldable (toList) import Data.Bits import Data.Array.IArray+import qualified Data.IntSet as ISet+import qualified Data.IntMap as IMap import Data.ByteString hiding (map) import qualified Data.ByteString as BS @@ -32,22 +34,29 @@ type Pair a = (,) a type Sum a = Either a -type instance RepT Maybe = U0 :+: I0+type instance RepT Rev = Rev+type instance Rep (Rev a) = Rev (Rep a)++$(genRepT [d|+   instance ReprT Rev where+	toRepTMap f (Rev a) = Rev (f a)+	fromRepTMap f (Rev a) = Rev (f a) |])++type instance RepT Maybe = Sum () type instance Rep (Maybe a) = RepT Maybe (Rep a)  $(genRepT [d|    instance ReprT Maybe where-	toRepTMap f = maybe (L U0) (R . I0 . f)-	fromRepTMap _ L{} = Nothing-	fromRepTMap f (R (I0 a)) = Just (f a) |])+	toRepTMap f = maybe (Left ()) (Right . f)+	fromRepTMap f = either (const Nothing) (Just . f) |]) -type instance RepT [] = L I0-type instance Rep [a] = L I0 (Rep a)+type instance RepT [] = []+type instance Rep [a] = [Rep a]  $(genRepT [d|     instance ReprT [] where-	toRepTMap f = List . map (I0 . f)-	fromRepTMap f (List xs) = map (f . unI0) xs |])+	toRepTMap = map+	fromRepTMap = map |])  type instance RepT ((,) a) = Pair (Rep a) type instance Rep (a, b) = RepT ((,) a) (Rep b)@@ -87,21 +96,20 @@ 	toRepTMap f = either (Left . toRep) (Right . f) 	fromRepTMap f = either (Left . fromRep) (Right . f) |]) -type instance Rep Bool = (U0 :+: U0) (U0 ())+type instance Rep Bool = Sum () () instance Repr Bool where-	toRep False = L U0-	toRep True = R U0-	fromRep L{} = False-	fromRep R{} = True+	toRep False = Left ()+	toRep True = Right ()+	fromRep = either (const False) (const True)  type instance Rep Char = Word32 instance Repr Char where 	toRep = fromIntegral . ord 	fromRep = chr . fromIntegral -type instance Rep () = U0 ()+type instance Rep () = () instance Repr () where-	toRep _ = U0+	toRep _ = () 	fromRep _ = ()  type instance Rep Double = Ordered Double@@ -173,23 +181,23 @@ 	toRep = id 	fromRep = id -type instance Rep ByteString = (L I0 :*: I0) Word32+type instance Rep ByteString = ([] :*: I0) Word32 instance Repr ByteString where-	toRep xs = List (toList64 xs) :*: I0 (fromIntegral (length xs))-	fromRep (List xs :*: I0 n) = case xs of+	toRep xs = toList64 xs :*: I0 (fromIntegral (length xs))+	fromRep (xs :*: I0 n) = case xs of 		[]	-> BS.empty-		(I0 x:xs) -> fst (unfoldrN (fromIntegral n) toBlock (W (Words 3 x) xs))+		(x:xs) -> fst (unfoldrN (fromIntegral n) toBlock (W (Words 3 x) xs))  data Words = Words {ix :: {-# UNPACK #-} !Int, word32 :: {-# UNPACK #-} !Word32}-data Words' = W {-# UNPACK #-} !Words [I0 Word32]+data Words' = W {-# UNPACK #-} !Words [Word32] -toList64 :: ByteString -> [I0 Word32]+toList64 :: ByteString -> [Word32] toList64 xs = case BS.foldl c (Words 4 0, Seq.empty) xs of-	(Words i w32, ys) -> toList ys ++ [I0 w32]+	(Words i w32, ys) -> toList ys ++ [w32] 	where	fS :: Word8 -> Int -> Word32 		fS w x = fromIntegral w `shiftL` x 		(Words 0 w, xs) `c` w8-			= (Words 3 (w .|. sL w8 24), xs |> I0 w)+			= (Words 3 (w .|. sL w8 24), xs |> w) 		(Words (i+1) w, xs) `c` w8 			= (Words i (w .|. sL w8 (8 * i)), xs) 		sL :: Word8 -> Int -> Word32@@ -199,7 +207,7 @@ toBlock (W (Words i0@(i+1) w) xs) = Just (extract w (8 * i0), (W (Words i w) xs)) 	where	extract :: Word32 -> Int -> Word8 		extract w x = fromIntegral (w `shiftR` x)-toBlock (W (Words 0 w) (I0 x:xs)) = Just (fromIntegral w, (W (Words 3 x) xs))+toBlock (W (Words 0 w) (x:xs)) = Just (fromIntegral w, (W (Words 3 x) xs)) toBlock _ = Nothing  type instance RepT (Array i) = L (Pair (Rep i)) :*: K0 (Pair (Rep i) (Rep i))@@ -212,15 +220,15 @@ 	fromRepTMap f (List xs :*: K0 (l, r)) 		= array (fromRep l, fromRep r) [(fromRep k, f a) | (k, a) <- xs] |]) -type instance RepT Set.Set = L I0+type instance RepT Set.Set = [] type instance RepT (Map.Map k) = L (Pair (Rep k))-type instance Rep (Set.Set a) = L I0 (Rep a)+type instance Rep (Set.Set a) = [Rep a] type instance Rep (Map.Map k a) = RepT (Map.Map k) (Rep a)  $(genRepT [d|    instance ReprT Set.Set where-	toRepTMap f s = List (Fold.foldr (\ a xs -> I0 (f a):xs) [] s)-	fromRepTMap f (List xs) = Set.fromDistinctAscList [f x | I0 x <- xs] |])+	toRepTMap f s = Fold.foldr ((:) . f) [] s+	fromRepTMap f xs = Set.fromDistinctAscList [f x | x <- xs] |])  $(genRepT [d|    instance Repr k => ReprT (Map.Map k) where@@ -230,7 +238,34 @@ type instance RepT Rev = Rev type instance Rep (Rev a) = Rev (Rep a) +-- -- $(genRepT [d|+--    instance ReprT Rev where+--    	toRepTMap f (Rev m) = Rev (f m)+-- 	fromRepTMap f (Rev m) = Rev (f m) |])++type instance Rep ISet.IntSet = Rep [Int]+type instance RepT IMap.IntMap = L (Pair (Rep Int))+type instance Rep (IMap.IntMap a) = RepT IMap.IntMap (Rep a)++instance Repr ISet.IntSet where+	toRep = toRep . ISet.toList+	fromRep = ISet.fromDistinctAscList . fromRep+ $(genRepT [d|-   instance ReprT Rev where-   	toRepTMap f (Rev m) = Rev (f m)-	fromRepTMap f (Rev m) = Rev (f m) |])+   instance ReprT IMap.IntMap where+   	toRepTMap f m = List [(toRep k, f a) | (k, a) <- IMap.assocs m]+	fromRepTMap f (List xs) = IMap.fromDistinctAscList [(fromRep k, f a) | (k, a) <- xs] |])++type instance RepT Seq.Seq = []+type instance Rep (Seq.Seq a) = [Rep a]++-- type instance Rep (Rev a) = Rev (Rep a)++$(genRepT [d|+   instance ReprT Seq.Seq where+	toRepTMap f = Fold.foldr (\ a xs -> f a:xs) []+	fromRepTMap f = Fold.foldl (\ xs a -> xs |> f a) Seq.empty |])+++-- instance Functor Rev where+-- 	fmap f (Rev a) = Rev (f a)
Data/TrieMap/Rep/TH.hs view
@@ -4,8 +4,8 @@  import Language.Haskell.TH import Data.TrieMap.Rep-import Language.Haskell.TH.Ppr-import Debug.Trace+-- import Language.Haskell.TH.Ppr+-- import Debug.Trace {- genRepT ::  TypeQ -> Q [Dec] genRepT ff = do
Data/TrieMap/Representation/TH.hs view
@@ -1,3 +1,63 @@-module Data.TrieMap.Representation.TH (module Data.TrieMap.Rep.TH) where+{-# LANGUAGE TemplateHaskell #-} +module Data.TrieMap.Representation.TH  where+ import Data.TrieMap.Rep.TH+import Data.TrieMap.Rep+import Data.TrieMap.Regular.Base+import Language.Haskell.TH+import Control.Arrow+import Control.Monad++type RepInfo = (Q Type, Q Exp, Q Exp)+	-- RepInfo t = (t', t -> t', t' -> t)+-- inferRepresentation :: Name -> String -> Q [Dec]+-- inferRepresentation k kRepName = do++-- conToMatch :: Name -> Int -> Q Match+-- conToMatch con [] = return (Match (ConP con []) (NormalB (ConE ''U0)) [])+-- conToMatch con ts = +-- 	do	varTs <- replicateM ts (newName "a")+-- 		let pat = ConP con (map (VarP . fst) varTs)+-- 		+-- 		let bod = NormalB (prod [ConE 'toRep `AppE` (VarE x) | (x, _) <- varTs])+-- 		return (Match pat bod [])+-- 	where	prod [x] = x+-- 		prod (x:xs) = ConE (mkName ":*:") `AppE` x `AppE` prod xs+-- +-- infixConToMatch :: Name -> Q Match+-- infixConToMatch con = do+-- 	a <- newName "a"+-- 	b <- newName "b"+-- 	let ae = varE a+-- 	let be = varE b+-- 	b <- [| toRep $ae :*: toRep $be |]+-- 	return (Match (InfixP (VarP a) con (VarP b)) (NormalB b) [])++-- conToRep :: Type -> [Type] -> RepInfo+-- conToRep _ [] = (conT ''U0, [| const U0 |], [| const U0 |])+-- conToRep t [x]+-- 	| x == t	= (conT ''I0, [| I0 |], [| unI0 |])+-- 	| otherwise	= (conT ''K0 `appT` x, [| K0 |], [| unK0 |])+-- conToRep t (arg0:args) = case conToRep t args of+-- 	(tArgs, toArgs, fromArgs)+-- 		| arg0 == t	-> (conT '':*: `appT` conT ''I0 `appT` tArgs, [| \ (a, b) -> (I0 a, $toArgs b) |],+-- 		 			[| \ (I0 a, b) -> (a, $fromArgs b) |])+-- 		| otherwise	-> (conT '':*: `appT` (conT ''K0 `appT` +-- 	where	toTuple [(_, x), (_, y)] = TupleT 2 `AppT` x `AppT` y+-- 		+-- +-- product :: Q Exp -> Q Exp -> RepInfo -> RepInfo -> RepInfo+-- product inj outj (t1, to1, from1) (t2, to2, from2) = +-- 	(tupleT 2 `appT` t1 `appT` t2,+-- 		[| ($to1 *** $to2) . $outj |],+-- 		[| $inj . ($from1 *** $from2) |])+-- +-- sum :: Q Exp -> Q Exp -> RepInfo -> RepInfo -> RepInfo+-- sum inj outj (t1, to1, from1) (t2, to2, from2) = +-- 	(conT ''Either `appT` t1 `appT` t2,+-- 		[| ($to1 +++ $to2) . $outj |],+-- 		[| $inj ($from1 +++ $from2) |])+-- repInstances :: Set Name+-- repInstances = fromList [''Int, ''Bool, ''Char, ''Double, ''Int, ''Int8, ''Int16, ''Int32, ''Int64, ''Word, ''Word8,+-- 	''Word16, ''Word32, ''Word64, ''(), ''ByteString, ''IntSet,
Data/TrieMap/ReverseMap.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell, UndecidableInstances, TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-} -module Data.TrieMap.ReverseMap() where+module Data.TrieMap.ReverseMap (reverse, unreverse) where  import Data.TrieMap.TrieKey import Data.TrieMap.Modifiers@@ -13,13 +13,38 @@  import Data.Monoid hiding (Dual) +import Prelude hiding (reverse)+import qualified Data.List as L+ newtype ReverseMap k a = RMap (TrieMap k a)  type instance TrieMapT Rev = ReverseMap type instance TrieMap (Rev k) = ReverseMap k -$(deriveM [d|-   instance TrieKeyT Rev ReverseMap where+instance TrieKey k (TrieMap k) => TrieKey (Rev k) (ReverseMap k) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT+++instance TrieKeyT Rev ReverseMap where 	emptyT = RMap emptyM 	nullT (RMap m) = nullM m 	sizeT s (RMap m) = sizeM s m@@ -35,6 +60,7 @@ -- 		sz = sizeM s m 	traverseWithKeyT s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m) 	alterT s f (Rev k) (RMap m) = RMap (alterM s f k m)+	alterLookupT s f (Rev k) (RMap m) = RMap <$> alterLookupM s f k m 	splitLookupT s f (Rev k) (RMap m) = case splitLookupM s f' k m of 		(mL, x, mR) -> (RMap mR, x, RMap mL) 		where f' x = case f x of@@ -45,15 +71,18 @@ 	unionT s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2) 	isectT s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2) 	diffT s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2)-	extractT s f (RMap m) = second RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m)+	extractT s f (RMap m) = fmap RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m) -- 	extractMinM s f (RMap m) = second RMap <$> First (getLast (extractMaxM s (f . Rev) m)) -- 	extractMaxM s f (RMap m) = second RMap <$> Last (getFirst (extractMinM s (f . Rev) m)) -- 	alterMinM s f (RMap m) = RMap (alterMaxM s (f . Rev) m) -- 	alterMaxM s f (RMap m) = RMap (alterMinM s (f . Rev) m) 	isSubmapT (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2+	fromListT s f xs = RMap (fromListM s (f . Rev) [(k, a) | (Rev k, a) <- xs])+	fromAscListT s f xs = RMap (fromAscListM s (\ k -> flip (f (Rev k))) [(k, a) | (Rev k, a) <- L.reverse xs])+	fromDistAscListT s xs = RMap (fromDistAscListM s [(k, a) | (Rev k, a) <- L.reverse xs]) -   reverse :: TrieMap k a -> TrieMap (Rev k) a-   reverse = RMap |])+reverse :: TrieMap k a -> TrieMap (Rev k) a+reverse = RMap  unreverse :: TrieMap (Rev k) a -> TrieMap k a unreverse (RMap m) = m
Data/TrieMap/TrieKey.hs view
@@ -4,6 +4,7 @@  import Data.TrieMap.Applicative import Data.TrieMap.Sized+import Data.TrieMap.CPair  import Control.Applicative import Control.Arrow@@ -21,7 +22,7 @@ type UnionFunc k a = k -> a -> a -> Maybe a type IsectFunc k a b c = k -> a -> b -> Maybe c type DiffFunc k a b = k -> a -> b -> Maybe a-type ExtractFunc f m k a x = (k -> a -> f (x, Maybe a)) -> m -> f (x, m)+type ExtractFunc f m k a x = (k -> a -> f (CPair x (Maybe a))) -> m -> f (CPair x m) type LEq a b = a -> b -> Bool  data Assoc k a = Asc {-# UNPACK #-} !Int k a@@ -71,6 +72,7 @@ 	assocAtM :: TrieMap k ~ m => Sized a -> Int -> m a -> IndexPos k a -- 	updateAtM :: TrieMap k ~ m => Sized a -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> m a -> m a 	alterM :: (TrieMap k ~ m) => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> m a -> m a+	alterLookupM :: TrieMap k ~ m => Sized a -> (Maybe a -> CPair x (Maybe a)) -> k -> m a -> CPair x (m a) 	{-# SPECIALIZE traverseWithKeyM :: (k -> a -> Id (b)) -> m a -> Id (m b) #-} 	traverseWithKeyM :: (TrieMap k ~ m, Applicative f) => Sized b -> 		(k -> a -> f (b)) -> m a -> f (m b)@@ -90,6 +92,8 @@ 	fromListM, fromAscListM :: (TrieMap k ~ m) => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> m a 	fromDistAscListM :: (TrieMap k ~ m) => Sized a -> [(k, a)] -> m a 	+-- 	alterLookupM s f k m = fmap (\ v' -> alterM s (const v') k m) (f (lookupM k m))+	alterM s f k m = cpSnd (alterLookupM s (cP () . f) k m) 	sizeM s m = foldWithKeyM (\ _ a n -> s a + n) m 0 	fromListM s f = foldl' (flip (uncurry (insertWithKeyM s f))) emptyM 	fromAscListM = fromListM@@ -106,6 +110,7 @@ mapMaybeM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> Maybe (b)) -> m a -> m b mapMaybeM s f = snd . mapEitherM elemSize s (((,) (Nothing :: Maybe (Elem ix))) .: f) +{-# INLINE [1] mapWithKeyM #-} mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> b) -> m a -> m b mapWithKeyM s f  = unId . traverseWithKeyM s (Id .: f) @@ -147,4 +152,15 @@ subMaybe _ _ _ = False  aboutM :: (TrieKey k (TrieMap k), Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z-aboutM f = fst <.> extractM (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a))+aboutM f = cpFst <.> extractM (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))++{-# RULES+-- 	"lookupM/emptyM" forall k . lookupM k emptyM = Nothing;+-- 	"sizeM/emptyM" forall s . sizeM s emptyM = 0;+-- 	"traverseWithKeyM/emptyM" forall s f . traverseWithKeyM s f emptyM = pure emptyM;+-- 	"extractM/emptyM" forall s f . extractM s f emptyM = empty;+-- 	"foldWithKeyM/emptyM" forall f . foldWithKeyM f emptyM z = z;+-- 	"foldlWithKeyM/emptyM" forall f . foldlWithKeyM f emptyM z = z;+-- 	"lookupIxM/emptyM" forall s k . lookupIxM s k emptyM = (empty, empty, empty);+-- 	"mapEitherM/emptyM" forall s1 s2 f . mapEitherM s1 s2 f emptyM = (emptyM, emptyM);+	#-}
+ Data/TrieMap/UnionMap.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE FlexibleContexts, PatternGuards, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}++module Data.TrieMap.UnionMap () where++import Data.TrieMap.TrieKey+import Data.TrieMap.Regular.Class+-- import Data.TrieMap.Regular.TH+import Data.TrieMap.Applicative++import Control.Applicative+-- import Control.Arrow++-- import Data.Monoid++data UMap m1 k2 a = m1 a :&: TrieMap k2 a++type instance TrieMapT (Either a) = UMap (TrieMap a)+type instance TrieMap (Either a b) = UMap (TrieMap a) b++instance (TrieKey a m, TrieKey b (TrieMap b)) => TrieKey (Either a b) (UMap m b) where+	emptyM = emptyT+	nullM = nullT+	lookupM = lookupT+	lookupIxM = lookupIxT+	assocAtM = assocAtT+	alterM = alterT+	alterLookupM = alterLookupT+	traverseWithKeyM = traverseWithKeyT+	foldWithKeyM = foldWithKeyT+	foldlWithKeyM = foldlWithKeyT+	mapEitherM = mapEitherT+	splitLookupM = splitLookupT+	unionM = unionT+	isectM = isectT+	diffM = diffT+	extractM = extractT+	isSubmapM = isSubmapT+	fromListM = fromListT+	fromAscListM = fromAscListT+	fromDistAscListM = fromDistAscListT++instance TrieKey k1 m1 => TrieKeyT (Either k1) (UMap m1) where+	emptyT = emptyM :&: emptyM+	nullT (m1 :&: m2) = nullM m1 && nullM m2+	sizeT s (m1 :&: m2) = sizeM s m1 + sizeM s m2+	lookupT k (m1 :&: m2) = either (`lookupM` m1) (`lookupM` m2) k+	lookupIxT s k (m1 :&: m2) = case k of+		Left k	| (lb, x, ub) <- onKey Left $ lookupIxM s k m1+				-> (lb, x, ub <|> aboutM (\ k -> return . Asc (sizeM s m1) (Right k)) m2)+		Right k | (lb, x, ub) <- onKey Right $ lookupIxM s k m2+				-> (aboutM (\ k a -> return (Asc (sizeM s m1 - s a) (Left k) a)) m1 <|> lb, x, ub)+	assocAtT s i (m1 :&: m2)+		| i < s1, (lb, x, ub) <- onKey Left (assocAtM s i m1)+			= (lb, x, ub <|> aboutM (\ k -> return . Asc s1 (Right k)) m2)+		| (lb, x, ub) <- onKey Right (onIndex (s1 +) (assocAtM s (i - s1) m2))+			= (aboutM (\ k a -> return (Asc (s1 - s a) (Left k) a)) m1 <|> lb, x, ub)+		where s1 = sizeM s m1+-- 	updateAtM s r i (m1 :&: m2)+	alterT s f k (m1 :&: m2) = case k of+		Left k	-> alterM s f k m1 :&: m2+		Right k	-> m1 :&: alterM s f k m2+	alterLookupT s f k (m1 :&: m2) = case k of+		Left k	-> fmap (:&: m2) (alterLookupM s f k m1)+		Right k	-> fmap (m1 :&:) (alterLookupM s f k m2)+	traverseWithKeyT s f (m1 :&: m2) = (:&:) <$> traverseWithKeyM s (f . Left) m1 <*> traverseWithKeyM s (f . Right) m2+	foldWithKeyT f (m1 :&: m2) = foldWithKeyM (f . Left) m1 . foldWithKeyM (f . Right) m2+	foldlWithKeyT f (m1 :&: m2) = foldlWithKeyM (f . Right) m2 . foldlWithKeyM (f . Left) m1+	mapEitherT s1 s2 f (m1 :&: m2) = (m1L :&: m2L, m1R :&: m2R)+		where	(m1L, m1R) = mapEitherM s1 s2 (f . Left) m1+			(m2L, m2R) = mapEitherM s1 s2 (f . Right) m2+-- 	extractMinT s f (m1 :&: m2) = second (:&: m2) <$> extractMinM s (f . Left) m1 <|>+-- 		second (m1 :&:) <$> extractMinM s (f . Right) m2+-- 	extractMaxT s f (m1 :&: m2) = second (:&: m2) <$> extractMaxM s (f . Left) m1 <|>+-- 		second (m1 :&:) <$> extractMaxM s (f . Right) m2+	extractT s f (m1 :&: m2) = fmap (:&: m2) <$> extractM s (f . Left) m1 <|>+		fmap (m1 :&:) <$> extractM s (f . Right) m2+	splitLookupT s f k (m1 :&: m2) = case k of+		Left k | (m1L, x, m1R) <- splitLookupM s f k m1+			-> (m1L :&: emptyM, x, m1R :&: m2)+		Right k | (m2L, x, m2R) <- splitLookupM s f k m2+			-> (m1 :&: m2L, x, emptyM :&: m2R)+	unionT s f (m11 :&: m12) (m21 :&: m22)+		= unionM s (f . Left) m11 m21 :&: unionM s (f . Right) m12 m22+	isectT s f (m11 :&: m12) (m21 :&: m22)+		= isectM s (f . Left) m11 m21 :&: isectM s (f . Right) m12 m22+	diffT s f (m11 :&: m12) (m21 :&: m22)+		= diffM s (f . Left) m11 m21 :&: diffM s (f . Right) m12 m22+	isSubmapT (<=) (m11 :&: m12) (m21 :&: m22) = isSubmapM (<=) m11 m21 && isSubmapM (<=) m12 m22+	fromListT s f xs = case partEithers xs of+		(ys, zs) -> fromListM s (f . Left) ys :&: fromListM s (f . Right) zs+	fromAscListT s f xs = case partEithers xs of+		(ys, zs) -> fromAscListM s (f . Left) ys :&: fromAscListM s (f . Right) zs+	fromDistAscListT s xs = case partEithers xs of+		(ys, zs) -> fromDistAscListM s ys :&: fromDistAscListM s zs+	+partEithers :: [(Either a b, x)] -> ([(a, x)], [(b, x)])+partEithers = foldr part ([], []) where+	  part (Left x, z) (xs, ys) = ((x,z):xs, ys)+	  part (Right y, z) (xs, ys) = (xs, (y, z):ys)++--   aboutMinM :: TrieKey k (TrieMap k) => (k -> a -> x) -> TrieMap k a -> First x+--   aboutMinM f m = fst <$> extractMinM (const 0) (\ k a -> (f k a, Nothing)) m+-- +--   aboutMaxM :: TrieKey k (TrieMap k) => (k -> a -> x) -> TrieMap k a -> Last x+--   aboutMaxM f m = fst <$> extractMaxM (const 0) (\ k a -> (f k a, Nothing)) m +
+ Data/TrieMap/UnitMap.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}++module Data.TrieMap.UnitMap where++import Data.TrieMap.TrieKey++import Control.Applicative++import Data.Foldable+import Data.Traversable+import Data.Maybe++import Prelude hiding (foldr, foldl)++type instance TrieMap () = Maybe++instance TrieKey () Maybe where+	emptyM = Nothing+	nullM = isNothing+	sizeM = maybe 0+	lookupM = flip const+	lookupIxM _ _ m = (empty, Asc 0 () <$> m, empty)+	assocAtM s i m = case m of+		Nothing	-> (empty, empty, empty)+		Just m+			| i < 0		-> (empty, empty, return (Asc 0 () m))+			| i < s m	-> (empty, return (Asc 0 () m), empty)+			| otherwise	-> (return (Asc 0 () m), empty, empty)+	traverseWithKeyM _ f = traverse (f ())+	foldWithKeyM f m z = foldr (f ()) z m+	foldlWithKeyM f m z = foldl (f ()) z m+	mapEitherM _ _ f = maybe (Nothing, Nothing) (f ())+	splitLookupM _ f _ = maybe (Nothing, Nothing, Nothing) f+	alterM _ f _ = f+	alterLookupM _ f _ = f+	unionM _ f = unionMaybe (f ())+	isectM _ f = isectMaybe (f ())+	diffM _ f = diffMaybe (f ())+	extractM _ f = maybe empty (f ())+	isSubmapM (<=) = subMaybe (<=)+	fromListM _ f [] = Nothing+	fromListM _ f ((_, v):xs) = Just (foldl (\ v' -> f () v' . snd) v xs)+	fromAscListM = fromListM
TrieMap.cabal view
@@ -1,5 +1,5 @@ name:		     TrieMap-version:             0.5.2+version:             0.5.3 tested-with:	     GHC category:            Algorithms synopsis:	     Automatic type inference of generalized tries.@@ -24,10 +24,15 @@ 	Data.TrieMap.Class.Instances, 	Data.TrieMap.TrieKey, 	Data.TrieMap.Applicative,+	Data.TrieMap.CPair,+	Data.TrieMap.ProdMap,+	Data.TrieMap.RadixTrie,+	Data.TrieMap.UnionMap,+	Data.TrieMap.UnitMap, 	Data.TrieMap.Rep, 	Data.TrieMap.Rep.Instances, 	Data.TrieMap.Rep.TH,-	Data.TrieMap.MultiRec.TH,+	-- Data.TrieMap.MultiRec.TH, 	Data.TrieMap.MultiRec.FamMap, 	Data.TrieMap.MultiRec.Eq, 	Data.TrieMap.MultiRec.Ord,@@ -36,7 +41,7 @@ 	Data.TrieMap.MultiRec.IMap, 	Data.TrieMap.MultiRec.Base, 	-- Data.TrieMap.MultiRec.XMap,-	Data.TrieMap.MultiRec.FixMap,+	-- Data.TrieMap.MultiRec.FixMap, 	-- Data.TrieMap.MultiRec.AppMap, 	Data.TrieMap.MultiRec.Instances, 	Data.TrieMap.MultiRec.ProdMap,