TrieMap 0.7.2 → 1.0.0

raw patch · 53 files changed

+861/−4246 lines, 53 filesdep +ghc-primdep −multirecdep ~template-haskelldep ~th-expand-synsPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependencies removed: multirec

Dependency ranges changed: template-haskell, th-expand-syns

API changes (from Hackage documentation)

Files

• Data/TrieMap.hs +34/−93
• Data/TrieMap/Applicative.hs +1/−27
• Data/TrieMap/CPair.hs +0/−35
• Data/TrieMap/Class.hs +5/−21
• Data/TrieMap/Class/Instances.hs +13/−112
• Data/TrieMap/IntMap.hs +113/−262
• Data/TrieMap/Key.hs +9/−19
• Data/TrieMap/Modifiers.hs +20/−0
• Data/TrieMap/MultiRec.hs +0/−7
• Data/TrieMap/MultiRec/Base.hs +0/−106
• Data/TrieMap/MultiRec/Class.hs +0/−179
• Data/TrieMap/MultiRec/ConstMap.hs +0/−51
• Data/TrieMap/MultiRec/Eq.hs +0/−54
• Data/TrieMap/MultiRec/FamMap.hs +0/−101
• Data/TrieMap/MultiRec/IMap.hs +0/−56
• Data/TrieMap/MultiRec/Instances.hs +0/−12
• Data/TrieMap/MultiRec/Ord.hs +0/−101
• Data/TrieMap/MultiRec/ProdMap.hs +0/−141
• Data/TrieMap/MultiRec/Sized.hs +0/−20
• Data/TrieMap/MultiRec/TagMap.hs +0/−137
• Data/TrieMap/MultiRec/UnionMap.hs +0/−116
• Data/TrieMap/MultiRec/UnitMap.hs +0/−68
• Data/TrieMap/OrdMap.hs +62/−165
• Data/TrieMap/ProdMap.hs +31/−100
• Data/TrieMap/RadixTrie.hs +79/−151
• Data/TrieMap/Regular.hs +0/−6
• Data/TrieMap/Regular/Base.hs +0/−71
• Data/TrieMap/Regular/Class.hs +0/−91
• Data/TrieMap/Regular/CompMap.hs +0/−135
• Data/TrieMap/Regular/ConstMap.hs +0/−73
• Data/TrieMap/Regular/Eq.hs +0/−90
• Data/TrieMap/Regular/IdMap.hs +0/−71
• Data/TrieMap/Regular/Instances.hs +0/−11
• Data/TrieMap/Regular/Ord.hs +0/−101
• Data/TrieMap/Regular/ProdMap.hs +0/−138
• Data/TrieMap/Regular/RadixTrie.hs +0/−417
• Data/TrieMap/Regular/RegMap.hs +0/−41
• Data/TrieMap/Regular/Rep.hs +0/−71
• Data/TrieMap/Regular/Sized.hs +0/−9
• Data/TrieMap/Regular/TH.hs +0/−26
• Data/TrieMap/Regular/UnionMap.hs +0/−119
• Data/TrieMap/Regular/UnitMap.hs +0/−90
• Data/TrieMap/Rep.hs +2/−3
• Data/TrieMap/Rep/Instances.hs +66/−145
• Data/TrieMap/Rep/TH.hs +32/−44
• Data/TrieMap/Representation.hs +39/−11
• Data/TrieMap/Representation/TH.hs +48/−36
• Data/TrieMap/ReverseMap.hs +25/−69
• Data/TrieMap/TrieKey.hs +50/−81
• Data/TrieMap/UnionMap.hs +93/−91
• Data/TrieMap/UnitMap.hs +25/−30
• Tests.hs +108/−0
• TrieMap.cabal +6/−42

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, UnboxedTuples #-}  module Data.TrieMap ( 	-- * Map type@@ -36,6 +36,7 @@ 	unionWithKey, 	unionMaybeWith, 	unionMaybeWithKey,+	symmetricDifference, 	-- ** Difference 	difference, 	differenceWith,@@ -88,16 +89,6 @@ 	-- * Submap 	isSubmapOf, 	isSubmapOfBy,-	-- * Indexed-	predecessor,-	lookupWithIndex,-	successor,-	neighborhood,-	lookupIndex,-	predecessorAt,-	lookupAt,-	successorAt,-	neighborhoodAt,	 	-- * Min/Max 	findMin, 	findMax,@@ -120,23 +111,15 @@ 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.Rep.Instances () 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(Monoid(..), First(..), Last(..))--- import Data.Foldable--- import Data.Traversable --- import Generics.MultiRec.Base--- import Data.TrieMap.Regular.Base--- import Data.TrieMap.Regular.Sized import GHC.Exts (build)  import Prelude hiding (lookup, foldr, null, map, filter, reverse)@@ -154,31 +137,52 @@ 	mempty = empty 	mappend = union --- newtype Elem a k = Elem {getElem :: a}+-- | The empty map. empty :: TKey k => TMap k a empty = TMap emptyM +-- | A map with a single element. singleton :: TKey k => k -> a -> TMap k a singleton k a = insert k a empty +-- | Is the map empty? null :: TKey k => TMap k a -> Bool null (TMap m) = nullM m +-- | Lookup the value at a key in the map.+-- +-- The function will return the corresponding value as @('Just' value)@, or 'Nothing' if the key isn't in the map. lookup :: TKey k => k -> TMap k a -> Maybe a lookup k (TMap m) = getElem <$> lookupM (toRep k) m +-- | The expression @('findWithDefault' def k map)@ returns the value at key @k@ or returns default value @def@+-- when the key is not in the map. findWithDefault :: TKey k => a -> k -> TMap k a -> a findWithDefault a = fromMaybe a .: lookup +-- | Find the value at a key. Calls 'error' when the element can not be found. (!) :: TKey k => TMap k a -> k -> a m ! k = fromMaybe (error "Element not found") (lookup k m) +-- | The expression @('alter' f k map)@ alters the value @x@ at @k@, or absence thereof. +-- 'alter' can be used to insert, delete, or update a value in a 'TMap'. In short:+-- @'lookup' k ('alter' f k m) = f ('lookup' k m)@. 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) +extract :: (TKey k, MonadPlus m) => (k -> a -> m (x, Maybe a)) -> TMap k a -> m (x, TMap k a)+extract f m = unwrapMonad (extractA (WrapMonad .: f) m)+ -- | Projects information out of, and modifies or deletes, an individual association pair,  -- alternating over all associations in the map. -- +-- If @assocs m == [(k1, a1), ..., (kn, an)]@, then+-- +-- > extract f m = let upd k (x, maybeA) = (x, alter (const maybeA) k m) in+-- >   (upd k1 <$> f kn an) <|> ... <|> (upd kn <$> f kn an)+-- +-- This generalizes a large number of operations, including+--  -- > minViewWithKey == getFirst (extract (\ k a -> return ((k, a), Nothing))) -- > updateMaxWithKey f m == maybe m snd (getLast (extract (\ k a -> return ((), f k a)) m)) -- @@ -187,21 +191,8 @@ -- > getFirst (extract (\ k a -> if p k a then return ((k, a), Nothing) else mzero) m) --  -- finds and removes the first association pair satisfying the predicate |p|.--extract :: (TKey k, MonadPlus m) => (k -> a -> m (x, Maybe a)) -> TMap k a -> m (x, TMap k a)-extract f m = unwrapMonad (extractA (WrapMonad .: f) m)---- | 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) = 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-about f = unwrapMonad . aboutA (WrapMonad .: f)---- | Generalization of 'about' for 'Alternative' functors.-aboutA :: (TKey k, Alternative f) => (k -> a -> f x) -> TMap k a -> f x-aboutA f = fst <.> extractA (\ k a -> flip (,) Nothing <$> f k a)+extractA f (TMap m) = fmap TMap <$> extractM elemSize (\ k (Elem a) -> fmap (fmap (fmap Elem)) (f (fromRep k) a)) m  insert :: TKey k => k -> a -> TMap k a -> TMap k a insert = insertWith const@@ -292,7 +283,7 @@ 	f' k (Elem a) (Elem b) = Elem <$> f (fromRep k) a b  difference, (\\) :: TKey k => TMap k a -> TMap k b -> TMap k a-difference = differenceWith (\ x _ -> Nothing)+difference = differenceWith (\ _ _ -> Nothing)  (\\) = difference @@ -345,17 +336,16 @@  mapEitherWithKey :: TKey k => (k -> a -> Either b c) -> TMap k a -> (TMap k b, TMap k c) mapEitherWithKey f (TMap m) = case mapEitherM elemSize elemSize f' m of-	(mL, mR) -> (TMap mL, TMap mR) +	(# mL, mR #) -> (TMap mL, TMap mR)  	where	f' k (Elem a) = case f (fromRep k) a of-			Left b	-> (Just (Elem b), Nothing)-			Right c	-> (Nothing, Just (Elem c))+			Left b	-> (# Just (Elem b), Nothing #)+			Right c	-> (# Nothing, Just (Elem c) #)  mapMaybe :: TKey k => (a -> Maybe b) -> TMap k a -> TMap k b mapMaybe = mapMaybeWithKey . const  mapMaybeWithKey :: TKey k => (k -> a -> Maybe b) -> TMap k a -> TMap k b-mapMaybeWithKey f (TMap m) = TMap (snd (mapEitherM elemSize elemSize f' m)) where-	f' k (Elem a) = (Nothing, Elem <$> f (fromRep k) a)+mapMaybeWithKey f (TMap m) = TMap (mapMaybeM elemSize (\ k (Elem a) -> Elem <$> f (fromRep k) a) m)  partition :: TKey k => (a -> Bool) -> TMap k a -> (TMap k a, TMap k a) partition = partitionWithKey . const@@ -375,8 +365,8 @@  splitLookup :: TKey k => k -> TMap k a -> (TMap k a, Maybe a, TMap k a) splitLookup k (TMap m) = case splitLookupM elemSize f (toRep k) m of-	(mL, x, mR) -> (TMap mL, x, TMap mR) -	where	f (Elem x) = (Nothing, Just x, Nothing)+	(# mL, x, mR #) -> (TMap mL, x, TMap mR) +	where	f (Elem x) = (# Nothing, Just x, Nothing #)  isSubmapOf :: (TKey k, Eq a) => TMap k a -> TMap k a -> Bool isSubmapOf = isSubmapOfBy (==)@@ -409,54 +399,5 @@ notMember :: TKey k => k -> TMap k a -> Bool notMember = not .: member --- showMap :: (TKey k, Show (TrieMap (Rep k) (Elem a) (Rep k))) => TMap k a -> String--- showMap (TMap m) = show m---- | @'predecessor' k a@ returns the index, key, and value of the immediate predecessor of @k@ in the map.  --- The predecessor is the element with the largest key @< k@.-predecessor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)-predecessor k m = fst3 (neighborhood k m)--lookupIndex :: TKey k => k -> TMap k a -> Maybe Int-lookupIndex k m = fst3 <$> lookupWithIndex k m --fst3 (a, b, c) = a-snd3 (a, b, c) = b-thd3 (a, b, c) = c--findIndex :: TKey k => k -> TMap k a -> Int-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)--successor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)-successor k m = thd3 (neighborhood k m)--neighborhood :: TKey k => k -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))-neighborhood k (TMap m) = case lookupIxM elemSize (toRep k) m of-		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)-	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)--predecessorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)-predecessorAt k m = fst3 (neighborhoodAt k m)--lookupAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)-lookupAt k m = snd3 (neighborhoodAt k m)--successorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)-successorAt k m = thd3 (neighborhoodAt k m)--neighborhoodAt :: TKey k => Int -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))-neighborhoodAt i (TMap m) = case assocAtM elemSize i m of-		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)-	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)- 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)+keysSet m = TSet (() <$ m)

@@ -3,13 +3,11 @@ module Data.TrieMap.Applicative where  import Control.Applicative-import Control.Arrow import Control.Monad  import Data.Monoid hiding (Dual)  newtype Id a = Id {unId :: a}-newtype WM w m a = WM {runWM :: m (w, a)}  instance Functor First where 	fmap f (First m) = First (fmap f m)@@ -25,20 +23,6 @@ 	return = Last . return 	Last m >>= k = Last (m >>= getLast . k) -instance Functor m => Functor (WM w m) where-	fmap f (WM x) = WM (fmap (second f) x)--instance (Applicative m, Monoid w) => Applicative (WM w m) where-	pure x = WM (pure (mempty, x))-	WM f <*> WM x = WM (fmap (\ (fW, ff) (xW, xx) -> (fW `mappend` xW, ff xx)) f <*> x)--instance (Alternative m, Monoid w) => Alternative (WM w m) where-	empty = WM empty-	WM a <|> WM b = WM (a <|> b)--write :: (Functor m, Monoid w) => w -> WM w m a -> WM w m a-write w (WM m) = WM (fmap (\ (v, xx) -> (v `mappend` w, xx)) m)- instance Applicative Id where 	pure = Id 	Id f <*> Id x = Id (f x)@@ -54,13 +38,6 @@ 	mzero = mempty 	mplus = mappend --- instance Monad First where--- 	return x = First (Just x)--- 	First Nothing >>= _ = First Nothing--- 	First (Just x) >>= k = k x--- --- instance Monad Last- (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (f .: g) x y = f (g x y) @@ -69,9 +46,6 @@  (<.:>) :: Functor f => (c -> d) -> (a -> b -> f c) -> a -> b -> f d (f <.:> g) x y = f <$> g x y-{--(<|>) :: MonadPlus m => m a -> m a -> m a-(<|>) = mplus-}  instance Applicative First where 	pure = return@@ -96,7 +70,7 @@  instance Applicative f => Applicative (Dual f) where 	pure = Dual . pure-	Dual f <*> Dual x = Dual (flip ($) <$> x <*> f)+	Dual f <*> Dual x = Dual (f <*> x)  instance Alternative f => Alternative (Dual f) where 	empty = Dual empty

@@ -1,35 +0,0 @@-{-# 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)

@@ -1,9 +1,8 @@-{-# LANGUAGE FlexibleInstances, TypeFamilies, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} -module Data.TrieMap.Class (TMap(..), TSet (..), TKey, TKeyT, Rep, TrieMap, TrieKey) where+module Data.TrieMap.Class (TMap(..), TSet (..), TKey, Rep, TrieMap, TrieKey) where  import Data.TrieMap.TrieKey-import Data.TrieMap.OrdMap import Data.TrieMap.Rep import Data.TrieMap.Sized @@ -11,25 +10,14 @@ import Data.Foldable import Data.Traversable --- import Generics.MultiRec.Base-import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Sized- import Prelude hiding (foldr)  newtype TMap k a = TMap {getTMap :: TrieMap (Rep k) (Elem a)} newtype TSet a = TSet (TMap a ()) -class (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k--- 	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+class (Repr k, TrieKey (Rep k)) => TKey k -instance (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f+instance (Repr k, TrieKey (Rep k)) => TKey k  instance TKey k => Functor (TMap k) where 	fmap = fmapDefault@@ -38,8 +26,4 @@ 	foldr f z (TMap m) = foldWithKeyM (\ _ (Elem a) -> f a) m z  instance TKey k => Traversable (TMap k) where-	traverse = trv---- 	traverse f (TMap m) = TMap <$> traverseWithKeyM (\ _ (K0 a) -> K0 <$> f a) m-trv :: (Applicative f, TKey k) => (a -> f b) -> TMap k a -> f (TMap k b)-trv f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ _ (Elem a) -> Elem <$> f a) m+	traverse f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ _ (Elem a) -> Elem <$> f a) m

@@ -1,115 +1,16 @@-{-# LANGUAGE FlexibleInstances, TemplateHaskell, CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}- module Data.TrieMap.Class.Instances where -import Data.TrieMap.Class-import Data.TrieMap.TrieKey-import Data.TrieMap.Rep-import Data.TrieMap.Rep.TH-import Data.TrieMap.Rep.Instances-import Data.TrieMap.Sized-import Data.TrieMap.RadixTrie()-import Data.TrieMap.MultiRec.Instances-import Data.TrieMap.IntMap-import Data.TrieMap.OrdMap-import Data.TrieMap.ReverseMap-import Data.TrieMap.ProdMap-import Data.TrieMap.UnionMap-import Data.TrieMap.Class-import Data.TrieMap.Modifiers-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Instances--- import Data.TrieMap.UnionMap()+import Data.TrieMap.Class ()+import Data.TrieMap.TrieKey ()+import Data.TrieMap.Rep ()+import Data.TrieMap.Rep.Instances ()+import Data.TrieMap.Representation ()+import Data.TrieMap.Sized ()+import Data.TrieMap.RadixTrie ()+import Data.TrieMap.IntMap ()+import Data.TrieMap.OrdMap ()+import Data.TrieMap.ReverseMap ()+import Data.TrieMap.ProdMap ()+import Data.TrieMap.UnionMap () import Data.TrieMap.UnitMap()-import Data.TrieMap.Key--import Data.Bits-import Data.Char-import Data.Complex-import Data.Either-import Data.Foldable-import Data.Int -import Data.List hiding (foldr)-import Data.Word-import Data.Array.IArray-import Data.Map(Map)-import Data.Set(Set)--import Prelude hiding (foldr)--#if __GLASGOW_HASKELL__-import GHC.Exts (build)-#else--build :: (forall b . (a -> b -> b) -> b -> b) -> [a]-build f = f (:) []-#endif-{--instance TKey k => TKey [k] where-	type Rep [k] = L I0 (Rep k)-	toRep = map toRep-	fromRep = map fromRep-}---- 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-}+import Data.TrieMap.Key ()

@@ -1,135 +1,67 @@-{-# LANGUAGE TemplateHaskell, TypeOperators, UndecidableInstances, BangPatterns, Rank2Types, CPP, MagicHash, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE UnboxedTuples, BangPatterns, TypeFamilies, PatternGuards, MagicHash, CPP #-}  module Data.TrieMap.IntMap () where  import Data.TrieMap.TrieKey--- import Data.TrieMap.MultiRec.Base--- import Data.TrieMap.Applicative import Data.TrieMap.Sized-import Data.TrieMap.CPair--- import Data.TrieMap.ReverseMap--- import Data.TrieMap.Rep--- import Data.TrieMap.Rep.TH  import Control.Applicative (Applicative(..), Alternative(..), (<$>))-import Control.Arrow-import Control.Monad (MonadPlus(..))  import Data.Bits-import Data.Maybe-import Data.Monoid+import Data.Maybe hiding (mapMaybe) import Data.Word--- 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- import Prelude hiding (lookup, null, foldl, foldr) -type Nat = Word32+#include "MachDeps.h"+#if WORD_SIZE_IN_BITS == 32+import GHC.Prim+import GHC.Word -data WordMap a = Nil-              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key (a)-              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(WordMap a) !(WordMap a) -		deriving (Show)--- data IntMap a = IMap (WordMap a) (WordMap a)-type instance TrieMap Word32 = WordMap--- type instance TrieMap Int32 = IntMap+complement32 (W32# w#) = W32# (not# w#)+#elif WORD_SIZE_IN_BITS > 32+complement32 = xor (bit 32 - 1)+#else+import GHC.Prim+import GHC.IntWord32+complement32 (W32# w#) = W32# (not32# w#)+#endif+complement32 :: Word32 -> Word32 +{-# RULES+	"complement/Word32" complement = complement32+	#-}++type Nat = Word32+ type Prefix = Word32 type Mask   = Word32 type Key    = Word32 type Size   = Int --- type instance RepT WordMap = FamT KeyFam (HFix (U :+: (K Size :*: K Key :*: X) :+:--- 				(K Size :*: K Prefix :*: K Mask :*: A0 :*: A0)))--- type instance Rep (WordMap a) = RepT WordMap (Rep a)--- --- -- $(genRepT [d|---    instance ReprT WordMap where--- 	toRepT = FamT . toFix where--- 		toFix = HIn . toFix'--- 		toFix' Nil = L U--- 		toFix' (Tip s kx x) = R (L (K s :*: K kx :*: X x))--- 		toFix' (Bin s p m l r) = R (R (K s :*: K p :*: K m :*: A0 (toFix l) :*: A0 (toFix r)))--- 	fromRepT (FamT m) = fromFix m where--- 		fromFix (HIn x) = fromFix' x--- 		fromFix' L{} = Nil--- 		fromFix' (R (L (K s :*: K kx :*: X x))) = Tip s kx x--- 		fromFix' (R (R (K s :*: K p :*: K m :*: A0 l :*: A0 r))) = Bin s p m (fromFix l) (fromFix r) |])--instance TrieKey Word32 WordMap where+instance TrieKey Word32 where+	data TrieMap Word32 a = Nil+              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key a+              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(TrieMap Word32 a) !(TrieMap Word32 a)  	emptyM = Nil+	singletonM = singleton 	nullM = null 	sizeM _ = size 	lookupM = lookup-	lookupIxM s = lookupIx s 0-	assocAtM s = assocAt s 0--- 	updateAtM s r = updateAt s r 0 	alterM = alter 	alterLookupM = alterLookup 	traverseWithKeyM = traverseWithKey 	foldWithKeyM = foldr 	foldlWithKeyM = foldl+	mapMaybeM = mapMaybe 	mapEitherM = mapEither 	splitLookupM = splitLookup 	unionM = unionWithKey 	isectM = intersectionWithKey 	diffM = differenceWithKey 	extractM s f = extract s f--- 	extractMinM s f = First . minViewWithKey s f--- 	extractMaxM s f = Last . maxViewWithKey s f--- 	alterMinM = updateMinWithKey--- 	alterMaxM = updateMaxWithKey 	isSubmapM = isSubmapOfBy -{-instance TrieKey Int32 IntMap where-	emptyM = IMap Nil Nil-	nullM (IMap mN mP) = nullM mN && nullM mP-	sizeM s (IMap mN mP) = sizeM s mN + sizeM s mP-	lookupM k (IMap mN mP)-		| k < 0		= lookupM (fromIntegral (-k)) mN-		| otherwise	= lookupM (fromIntegral k) mP-	lookupIxM s k (IMap mN mP)-		| k < 0		= do	(i, v) <- lookupIx' 0 s (fromIntegral (-k)) mN-					return (sizeM s mN - 1 - i, v)-		| otherwise	= do	(i, v) <- lookupIxM s (fromIntegral k) mP-					return (i + sizeM s mN, v)-	assocAtM s i (IMap mN mP)-		| i < sN, (i', k, a) <- assocAt' s i mN-			= (i', - fromIntegral k, a)-		| (i', k, a) <-assocAtM s (i - sN) mP-			= (i' + sN, fromIntegral k, a)-		where	sN = sizeM s mN-	updateAtM s f i (IMap mN mP)-		| i < sN	= updateAtM s (\ i' k -> f i' (- fromIntegral k)) (sN - 1 - i) mN `IMap` mP-		| otherwise	= mN `IMap` updateAtM s (\ i' k -> f (i' + sN) (fromIntegral k)) (i - sN) mP-		where	sN = sizeM s mN-	alterM s f k (IMap mN mP)-		| k < 0		= alterM s f (fromIntegral (- k)) mN `IMap` mP-		| otherwise	= mN `IMap` alterM s f (fromIntegral k) mP-	traverseWithKeyM s f (IMap mN mP) =-		IMap <$> traverseWithKeyM s (\ k -> f (- fromIntegral k)) mN <*>-			traverseWithKeyM s (f . fromIntegral) mP-	foldWithKeyM f (IMap mN mP) =-		foldlWithKeyM (\ k -> flip (f (- fromIntegral k))) mN . foldWithKeyM (f . fromIntegral) mP-	foldlWithKeyM f (IMap mN mP) =-		foldlWithKeyM (f . fromIntegral) mP . foldWithKeyM (\ k -> flip (f (- fromIntegral k))) mN-	mapEitherM s1 s2 f (IMap mN mP) = (IMap mNL mPL, IMap mNR mPR)-		where	(mNL, mNR) = mapEitherM s1 s2 (\ k -> f (- fromIntegral k)) mN-			(mPL, mPR) = mapEitherM s1 s2 (f . fromIntegral) mP-	splitLookupM s f k (IMap mN mP)-		| k < 0, (mNL, ans, mNR) <- splitLookupM s ((\ (l, x, r) -> (r, x, l)) . f) (fromIntegral (-k)) mN-			= (IMap mNR emptyM, ans, IMap mNL mP)-		| (mPL, ans, mPR) <- splitLookupM s f (fromIntegral k) mP-			= (IMap mN mPL, ans, IMap emptyM mPR)-}- natFromInt :: Word32 -> Nat natFromInt = id @@ -148,132 +80,105 @@ -- #endif  -size :: WordMap a -> Int+size :: TrieMap Word32 a -> Int size Nil = 0 size (Tip s _ _) = s size (Bin s _ _ _ _) = s -null :: WordMap a -> Bool+null :: TrieMap Word32 a -> Bool null Nil = True null _ = False -lookup :: Nat -> WordMap a -> Maybe (a)+lookup :: Nat -> TrieMap Word32 a -> Maybe a lookup k (Bin _ _ m l r) = lookup k (if zeroN k m then l else r) lookup k (Tip _ kx x) 	| k == kx	= Just x lookup _ _ = 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-		= (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i0 + size l) k a, Just a)) r))-	| (lb, x, ub) <- assocAt s (i0 + sl) (i - sl) r-		= (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i0 + size l - s a) k a, Just a)) l) <|> lb, x, ub)-	where	sl = size l-assocAt _ i0 _ (Tip _ k x) = (mzero, return (Asc i0 k x), mzero)-assocAt _ _ _ _ = (mzero, mzero, mzero)--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-		if i < sl then bin p m (updateAt s True i0 f i l) r -			else bin p m l (updateAt s True (i0 + sl) f (i - sl) r)-	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)-	_	-> t-updateAt s False !i0 f !i t = case t of-	Bin sz p m l r -> let {sl = size l; mI = maxIx l} in-		if i < mI then bin p m (updateAt s False i0 f i l) r-			else bin p m l (updateAt s False (i0 + sl) f (i - sl) r)-	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)-	_	-> t-	where	maxIx m = maybe (size m) fst (maxViewWithKey s (\ _ a -> (size m - s a, Just a)) m)--lookupIx :: Sized a -> Int -> Nat -> WordMap a -> IndexPos Nat a-lookupIx s !i k t = case t of-	Bin _ _ m l r-		| zeroN k m, (lb, x, ub) <- lookupIx s i k l-			-> (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i + size l) k a, Just a)) r))-		| (lb, x, ub) <- lookupIx s (i + size l) k r-			-> (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i + size l - s a) k a, Just a)) l) <|> lb, x, ub)-	Tip _ kx x-		| k == kx	-> (mzero, return (Asc i kx x), mzero)-	_ -> (mzero, mzero, mzero)--singleton :: Sized a -> Key -> a -> WordMap a+singleton :: Sized a -> Key -> a -> TrieMap Word32 a singleton s k a = Tip (s a) k a -singletonMaybe :: Sized a -> Key -> Maybe (a) -> WordMap a+singletonMaybe :: Sized a -> Key -> Maybe a -> TrieMap Word32 a singletonMaybe s k = maybe Nil (singleton s k) -alter :: Sized a -> (Maybe (a) -> Maybe (a)) -> Key -> WordMap a -> WordMap a+alter :: Sized a -> (Maybe a -> Maybe a) -> Key -> TrieMap Word32 a -> TrieMap Word32 a alter s f k t = case t of-	Bin sz p m l r+	Bin _ p m l r 		| nomatch k p m	-> join k (singletonMaybe s k (f Nothing)) p t 		| zero k m	-> bin p m (alter s f k l) r 		| otherwise	-> bin p m l (alter s f k r)-	Tip sz ky y+	Tip _ ky y 		| k == ky	-> singletonMaybe s k (f (Just y)) 		| Just x <- f Nothing 				-> join k (Tip (s x) k x) ky t-		| otherwise	-> Tip sz ky y+		| otherwise	-> t 	Nil	-> singletonMaybe s k (f Nothing) -alterLookup :: Sized a -> (Maybe a -> CPair x (Maybe a)) -> Key -> WordMap a -> CPair x (WordMap a)+alterLookup :: Sized a -> (Maybe a -> (# x, Maybe a #)) -> Key -> TrieMap Word32 a -> (# x, TrieMap Word32 a #) alterLookup s f k t = case t of-	Bin sz p m l r+	Bin _ p m l r 		| nomatch k p m-			-> fmap (\ v -> join k (singletonMaybe s k v) p t) (f Nothing)+			-> onUnboxed (\ 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)+			-> onUnboxed (\ 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+			-> onUnboxed (\ r' -> bin p m l r') (alterLookup s f k) r+	Tip _ ky y+		| k == ky	-> onUnboxed (singletonMaybe s k) f (Just y)+		| otherwise	-> onUnboxed (\ v -> join k (singletonMaybe s k v) ky t) f Nothing+	Nil	-> onUnboxed (singletonMaybe s k) f Nothing -traverseWithKey :: Applicative f => Sized b -> (Key -> a -> f (b)) -> WordMap a -> f (WordMap b)+traverseWithKey :: Applicative f => Sized b -> (Key -> a -> f b) -> TrieMap Word32 a -> f (TrieMap Word32 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 :: (Key -> a -> b -> b) -> TrieMap Word32 a -> b -> b foldr f t   = case t of       Bin _ _ _ l r -> foldr f l . foldr f r       Tip _ k x     -> f k x       Nil         -> id -foldl :: (Key -> b -> a -> b) -> WordMap a -> b -> b+foldl :: (Key -> b -> a -> b) -> TrieMap Word32 a -> b -> b foldl f t   = case t of       Bin _ _ _ l r -> foldl f r . foldl f l       Tip _ k x     -> flip (f k) x       Nil         -> id -mapEither :: Sized b -> Sized c -> EitherMap Key (a) (b) (c) ->-	WordMap a -> (WordMap b, WordMap c)-mapEither _ _ _ Nil = (Nil, Nil)-mapEither s1 s2 f (Bin _ p m l r) = case (mapEither s1 s2 f l, mapEither s1 s2 f r) of-	((lL, lR), (rL, rR)) -> (bin p m lL rL, bin p m lR rR)-mapEither s1 s2 f (Tip _ kx x) = (singletonMaybe s1 kx *** singletonMaybe s2 kx) (f kx x)+mapMaybe :: Sized b -> (Key -> a -> Maybe b) -> TrieMap Word32 a -> TrieMap Word32 b+mapMaybe s f (Bin _ p m l r)	= bin p m (mapMaybe s f l) (mapMaybe s f r)+mapMaybe s f (Tip _ kx x)	= singletonMaybe s kx (f kx x)+mapMaybe _ _ _			= 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-        | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)-        | zero k m  -> let (lt,found,gt) = splitLookup s f k l in (lt,found,union s gt r)-        | otherwise -> let (lt,found,gt) = splitLookup s f k r in (union s l lt,found,gt)-      Tip _ ky y -        | k>ky      -> (t,Nothing,Nil)-        | k<ky      -> (Nil,Nothing,t)-        | otherwise -> singletonMaybe s k `sides` f y-      Nil -> (Nil,Nothing,Nil)+mapEither :: Sized b -> Sized c -> EitherMap Key a b c ->+	TrieMap Word32 a -> (# TrieMap Word32 b, TrieMap Word32 c #)+mapEither s1 s2 f (Bin _ p m l r) +	| (# lL, lR #) <- mapEither s1 s2 f l, (# rL, rR #) <- mapEither s1 s2 f r+				= (# bin p m lL rL, bin p m lR rR #)+mapEither s1 s2 f (Tip _ kx x)	= both (singletonMaybe s1 kx) (singletonMaybe s2 kx) (f kx) x+mapEither _ _ _ _		= (# Nil, Nil #) -union :: Sized a -> WordMap a -> WordMap a -> WordMap a+splitLookup :: Sized a -> SplitMap a x -> Key -> TrieMap Word32 a -> (# TrieMap Word32 a ,Maybe x,TrieMap Word32 a #)+splitLookup s f k t@(Bin _ p m l r)+        | nomatch k p m = if k>p then (# t,Nothing,Nil #) else (# Nil,Nothing,t #)+        | zero k m, (# lt, found, gt #) <- splitLookup s f k l+        		= (# lt,found,union s gt r #)+        | (# lt, found, gt #) <- splitLookup s f k r +        		= (# union s l lt,found,gt #)+splitLookup s f k t@(Tip _ ky y)+        | k>ky		= (# t,Nothing,Nil #)+        | k<ky		= (# Nil,Nothing,t #)+        | otherwise	= sides (singletonMaybe s k) f y+splitLookup _ _ _ _	= (# Nil,Nothing,Nil #)++union :: Sized a -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a+union _ Nil t       = t+union _ t Nil       = t+union s (Tip _ k x) t = alter s (const (Just x)) k t+union s t (Tip _ k x) = alter s (Just . fromMaybe x) k t  -- right bias union s t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)   | shorter m1 m2  = union1   | shorter m2 m1  = union2@@ -287,12 +192,12 @@     union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2             | zero p1 m2        = bin p2 m2 (union s t1 l2) r2             | otherwise         = bin p2 m2 l2 (union s t1 r2)-union s (Tip _ k x) t = alter s (const (Just x)) k t-union s t (Tip _ k x) = alter s (Just . fromMaybe x) k t  -- right bias-union _ Nil t       = t-union _ t Nil       = t -unionWithKey :: Sized a -> UnionFunc Key (a) -> WordMap a -> WordMap a -> WordMap a+unionWithKey :: Sized a -> UnionFunc Key a -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a+unionWithKey _ _ Nil t  = t+unionWithKey _ _ t Nil  = t+unionWithKey s f (Tip _ k x) t = alter s (maybe (Just x) (f k x)) k t+unionWithKey s f t (Tip _ k x) = alter s (maybe (Just x) (flip (f k) x)) k t unionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)   | shorter m1 m2  = union1   | shorter m2 m1  = union2@@ -306,12 +211,14 @@     union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2             | zero p1 m2        = bin p2 m2 (unionWithKey s f t1 l2) r2             | otherwise         = bin p2 m2 l2 (unionWithKey s f t1 r2)-unionWithKey s f (Tip _ k x) t = alter s (maybe (Just x) (f k x)) k t-unionWithKey s f t (Tip _ k x) = alter s (maybe (Just x) (flip (f k) x)) k t-unionWithKey _ _ Nil t  = t-unionWithKey _ _ t Nil  = t -intersectionWithKey :: Sized c -> IsectFunc Key (a) (b) (c) -> WordMap a -> WordMap b -> WordMap c+intersectionWithKey :: Sized c -> IsectFunc Key a b c -> TrieMap Word32 a -> TrieMap Word32 b -> TrieMap Word32 c+intersectionWithKey _ _ Nil _ = Nil+intersectionWithKey _ _ _ Nil = Nil+intersectionWithKey s f (Tip _ k x) t2+  = singletonMaybe s k (lookup (natFromInt k) t2 >>= f k x)+intersectionWithKey s f t1 (Tip _ k y) +  = singletonMaybe s k (lookup (natFromInt k) t1 >>= flip (f k) y) intersectionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)   | shorter m1 m2  = intersection1   | shorter m2 m1  = intersection2@@ -326,14 +233,12 @@                   | zero p1 m2        = intersectionWithKey s f t1 l2                   | otherwise         = intersectionWithKey s f t1 r2 -intersectionWithKey s f (Tip _ k x) t2-  = singletonMaybe s k (lookup (natFromInt k) t2 >>= f k x)-intersectionWithKey s f t1 (Tip _ k y) -  = singletonMaybe s k (lookup (natFromInt k) t1 >>= flip (f k) y)-intersectionWithKey _ _ Nil _ = Nil-intersectionWithKey _ _ _ Nil = Nil--differenceWithKey :: Sized a -> (Key -> a -> b -> Maybe (a)) -> WordMap a -> WordMap b -> WordMap a+differenceWithKey :: Sized a -> (Key -> a -> b -> Maybe a) -> TrieMap Word32 a -> TrieMap Word32 b -> TrieMap Word32 a+differenceWithKey _ _ Nil _       = Nil+differenceWithKey _ _ t Nil       = t+differenceWithKey s f t1@(Tip _ k x) t2 +  = maybe t1 (singletonMaybe s k . f k x) (lookup (natFromInt k) t2)+differenceWithKey s f t (Tip _ k y) = alter s (>>= flip (f k) y) k t differenceWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)   | shorter m1 m2  = difference1   | shorter m2 m1  = difference2@@ -348,82 +253,24 @@                 | zero p1 m2        = differenceWithKey s f t1 l2                 | otherwise         = differenceWithKey s f t1 r2 -differenceWithKey s f t1@(Tip _ k x) t2 -  = maybe t1 (singletonMaybe s k . f k x) (lookup (natFromInt k) t2)-differenceWithKey _ _ Nil _       = Nil-differenceWithKey s f t (Tip _ k y) = alter s (>>= flip (f k) y) k t-differenceWithKey _ _ t Nil       = t--isSubmapOfBy :: LEq (a) (b) -> LEq (WordMap a) (WordMap b)+isSubmapOfBy :: LEq a b -> LEq (TrieMap Word32 a) (TrieMap Word32 b) isSubmapOfBy (<=) t1@(Bin _ p1 m1 l1 r1) (Bin _ p2 m2 l2 r2)   | shorter m1 m2  = False   | shorter m2 m1  = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy (<=) t1 l2                                                       else isSubmapOfBy (<=) t1 r2)                        | otherwise      = (p1==p2) && isSubmapOfBy (<=) l1 l2 && isSubmapOfBy (<=) r1 r2-isSubmapOfBy _         (Bin _ _ _ _ _) _ = False-isSubmapOfBy (<=) (Tip _ k x) t     = maybe False (x <=) (lookup (natFromInt k) t)-isSubmapOfBy _         Nil _           = True--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 -> 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         -> 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--maxViewUnsigned, minViewUnsigned :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> (x, WordMap a)-maxViewUnsigned s f t -    = case t of-        Bin _ p m l r -> let (result,t') = maxViewUnsigned s f r in (result,bin p m l t')-        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)-        Nil -> error "maxViewUnsigned Nil"--minViewWithKey s f t-    = case t of-        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 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)-        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)-        Nil -> error "minViewUnsigned Nil"--updateMinWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a-updateMinWithKey s f t-    = case t of-        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--updateMinWithKeyUnsigned :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a-updateMinWithKeyUnsigned s f t-    = case t of-        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--updateMaxWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a-updateMaxWithKey s f t-    = case t of-        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+isSubmapOfBy _		(Bin _ _ _ _ _) _+	= False+isSubmapOfBy (<=)	(Tip _ k x) t+	= maybe False (x <=) (lookup (natFromInt k) t)+isSubmapOfBy _		Nil _+	= True -updateMaxWithKeyUnsigned :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a-updateMaxWithKeyUnsigned s f t-    = case t of-        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+extract :: Alternative f => Sized a -> (Key -> a -> f (x, Maybe a)) -> TrieMap Word32 a -> f (x, TrieMap Word32 a)+extract s f (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+extract s f (Tip _ k x)		= fmap (singletonMaybe s k) <$> f k x+extract _ _ _			= empty  mask :: Key -> Mask -> Prefix mask i m@@ -462,10 +309,14 @@       x2 -> case (x2 .|. shiftRL x2 4) of        x3 -> case (x3 .|. shiftRL x3 8) of         x4 -> case (x4 .|. shiftRL x4 16) of+#if WORD_SIZE_IN_BITS > 32          x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms           x6 -> (x6 `xor` (shiftRL x6 1))+#else+	 x5 -> x5 `xor` shiftRL x5 1+#endif -join :: Prefix -> WordMap a -> Prefix -> WordMap a -> WordMap a+join :: Prefix -> TrieMap Word32 a -> Prefix -> TrieMap Word32 a -> TrieMap Word32 a join p1 t1 p2 t2   | zero p1 m = bin p m t1 t2   | otherwise = bin p m t2 t1@@ -473,7 +324,7 @@     m = branchMask p1 p2     p = mask p1 m -bin :: Prefix -> Mask -> WordMap a -> WordMap a -> WordMap a+bin :: Prefix -> Mask -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a bin _ _ l Nil = l bin _ _ Nil r = r bin p m l r   = Bin (size l + size r) p m l r

@@ -1,37 +1,27 @@ {-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} -module Data.TrieMap.Key where+module Data.TrieMap.Key (Key(..)) where  import Control.Applicative-import Control.Arrow ((***)) import Data.TrieMap.Class import Data.TrieMap.TrieKey import Data.TrieMap.Rep--newtype Key k = Key {getKey :: k}-newtype KeyMap k a = KeyMap {getKeyMap :: TrieMap (Rep k) a}--instance (TKey k) => Eq (Key k) where-	Key k1 == Key k2 = toRep k1 == toRep k2--instance (TKey k) => Ord (Key k) where-	Key k1 `compare` Key k2 = compare (toRep k1) (toRep k2)--type instance TrieMap (Key k) = KeyMap k+import Data.TrieMap.Modifiers -instance TKey k => TrieKey (Key k) (KeyMap k) where+instance TKey k => TrieKey (Key k) where+	newtype TrieMap (Key k) a = KeyMap (TrieMap (Rep k) a) 	emptyM = KeyMap emptyM+	singletonM s (Key k) a = KeyMap (singletonM s (toRep k) a) 	nullM (KeyMap m) = nullM m 	lookupM (Key k) (KeyMap m) = lookupM (toRep k) m-	lookupIxM s (Key k) (KeyMap m) = onKey (Key . fromRep) (lookupIxM s (toRep k) m)-	assocAtM s i (KeyMap m) = onKey (Key . fromRep) (assocAtM s i m) 	alterM s f (Key k) (KeyMap m) = KeyMap (alterM s f (toRep k) m)-	alterLookupM s f (Key k) (KeyMap m) = KeyMap <$> alterLookupM s f (toRep k) m+	alterLookupM s f (Key k) (KeyMap m) = onUnboxed KeyMap (alterLookupM s f (toRep k)) m 	traverseWithKeyM s f (KeyMap m) = KeyMap <$> traverseWithKeyM s (f . Key . fromRep) m 	foldWithKeyM f (KeyMap m) = foldWithKeyM (f . Key . fromRep) m 	foldlWithKeyM f (KeyMap m) = foldlWithKeyM (f . Key . fromRep) m-	mapEitherM s1 s2 f (KeyMap m) = (KeyMap *** KeyMap) (mapEitherM s1 s2 (f . Key . fromRep) m)-	splitLookupM s f (Key k) (KeyMap m) = KeyMap `sides` splitLookupM s f (toRep k) m+	mapMaybeM s f (KeyMap m) = KeyMap (mapMaybeM s (f . Key . fromRep) m)+	mapEitherM s1 s2 f (KeyMap m) = both KeyMap KeyMap (mapEitherM s1 s2 (f . Key . fromRep)) m+	splitLookupM s f (Key k) (KeyMap m) = sides KeyMap (splitLookupM s f (toRep k)) m 	unionM s f (KeyMap m1) (KeyMap m2) = KeyMap (unionM s (f . Key . fromRep) m1 m2) 	isectM s f (KeyMap m1) (KeyMap m2) = KeyMap (isectM s (f . Key . fromRep) m1 m2) 	diffM s f (KeyMap m1) (KeyMap m2) = KeyMap (diffM s (f . Key . fromRep) m1 m2)

@@ -1,5 +1,8 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies #-} module Data.TrieMap.Modifiers where +import Data.TrieMap.Rep+ newtype Ordered a = Ord {unOrd :: a} deriving (Eq, Ord) newtype Rev k = Rev {getRev :: k} deriving (Eq) instance Ord k => Ord (Rev k) where@@ -10,3 +13,20 @@  instance Functor Rev where 	fmap f (Rev a) = Rev (f a)++newtype Key k = Key {getKey :: k}++instance (Repr k, Eq (Rep k)) => Eq (Key k) where+	Key k1 == Key k2 = toRep k1 == toRep k2++instance (Repr k, Ord (Rep k)) => Ord (Key k) where+	Key k1 `compare` Key k2 = toRep k1 `compare` toRep k2+	Key k1 <= Key k2 = toRep k1 <= toRep k2+	Key k1 < Key k2 = toRep k1 < toRep k2+	Key k1 >= Key k2 = toRep k1 >= toRep k2+	Key k1 > Key k2 = toRep k1 > toRep k2++instance Repr k => Repr (Key k) where+	type Rep (Key k) = Rep k+	toRep (Key k) = toRep k+	fromRep = Key . fromRep

@@ -1,7 +0,0 @@-module Data.TrieMap.MultiRec (HTrieKeyT, HTrieKey, HTrieMapT, HTrieMap, Family(..), HOrd(..)) where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.FamMap-import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.MultiRec.Base-import Data.TrieMap.MultiRec.Ord

@@ -1,106 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, ExistentialQuantification, KindSignatures, FlexibleInstances, MultiParamTypeClasses #-}--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.TriseKey---- import Generics.MultiRec-import Generics.MultiRec.Base-import Generics.MultiRec.HFix---- 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 {unF :: 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 HFunctor phi f => HFunctor phi (A f) where--- 	hmapA f pf (A x) = A <$> hmapA f pf x---- instance HFunctor phi A0 where--- 	hmapA f pf (A0 x) = A0 <$> f pf x---- instance HEq phi f => HEq phi (A f) where--- 	heq f pf (A x) (A y) = heq f pf x y---- 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 Functor (Family phi) where-	fmap f (F x) = F (f x)---- instance Functor f => Functor (FamT phi f) where--- 	fmap = fmapp---- instance FunctorT (K k) where--- 	fmapp = fmap--instance Functor (K k r) where-	fmap f (K a) = K a--instance FunctorT (I ix) where-	fmapp = fmap--instance Functor (I ix r) where-	fmap f (I a) = I a--instance FunctorT U where-	fmapp f U = U --instance Functor (U r) where-	fmap f U = U--instance (FunctorT f, FunctorT g) => FunctorT (f :*: g) where	-	fmapp f (x :*: y) = fmapp f x :*: fmapp f y--instance (Functor (f r), Functor (g r)) => Functor ((f :*: g) r) where-	fmap f (x :*: y) = fmap f x :*: fmap f y--instance (FunctorT f, FunctorT g) => FunctorT (f :+: g) where-	fmapp f (L l) = L (fmapp f l)-	fmapp f (R r) = R (fmapp f r)--instance (Functor (f r), Functor (g r)) => Functor ((f :+: g) r) where-	fmap f (L l) = L (fmap f l)-	fmap f (R r) = R (fmap f r)---- instance FunctorT f => FunctorT (A f) where--- 	fmapp f (A x) = A (fmapp f x)---- instance FunctorT A0 where--- 	fmapp f (A0 x) = A0 (fmap f x)---- instance (FunctorT f, Functor r) => Functor (A f r) where--- 	fmap = fmapp---- instance Functor r => Functor (A0 r) where--- 	fmap = fmapp---- instance FunctorT X where--- 	fmapp = fmap---- instance Functor (X r) where--- 	fmap f (X x) = X (f x)--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-	breakEither' (L k, a) (xs, ys) = ((k, a):xs, ys)-	breakEither' (R k, a) (xs, ys) = (xs, (k, a):ys)

@@ -1,179 +0,0 @@-{-# 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.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--type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> * -> * -> *-type family HTrieMap (phi :: * -> *) (r :: * -> *) :: * -> * -> *--class HOrd phi f => HTrieKeyT (phi :: * -> *) (f :: (* -> *) -> * -> *) m | m -> phi f where-	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-	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)-	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-	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-	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)-	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)-	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-	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-	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-	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--- 	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--- 	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)--- 	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)-	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)-	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-	fromDistAscListH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => -		phi ix -> HSized phi a -> [(f r ix, a )] -> m r 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)--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-	---- 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)--- -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)-guardNullH pf m-	| nullH pf m	= Nothing-	| otherwise	= Just m--- --- -- 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-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)

@@ -1,51 +0,0 @@-{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}--module Data.TrieMap.MultiRec.ConstMap () where--import Data.TrieMap.MultiRec.Class--- 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--import Control.Applicative-import Control.Arrow-import Control.Monad---- 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 RepT (KMap phi m r ix) = RepT m--- type instance Rep (KMap phi m r ix a) = RepT m (Rep a)--- --- -- $(genRepT [d|---    instance ReprT m => ReprT (KMap phi m r ix) where--- 	toRepT (KMap m) = toRepT m--- 	fromRepT = KMap . fromRepT |])--instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where-	emptyH _ = KMap emptyM-	nullH _ (KMap m) = nullM 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)-	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 _ 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

@@ -1,54 +0,0 @@-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances #-}--module Data.TrieMap.MultiRec.Eq where---- 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-	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-}-{--instance HEq0 phi r => HEq0 phi (A0 r) where-	heqH pf (A0 x) (A0 y) = heqH pf x y-}---- 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

@@ -1,101 +0,0 @@-{-# LANGUAGE PatternGuards, TypeFamilies, MultiParamTypeClasses, Rank2Types, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}--module Data.TrieMap.MultiRec.FamMap () where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq-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.TrieKey--- 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 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))-type instance TrieMap (Family phi ix) = FamMap phi (HTrieMapT phi (PF phi)) ix--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--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--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)--from'' :: (Fam phi, HFunctor phi (PF phi), El phi ix) => Family phi ix -> PF phi (Family phi) ix-from'' = from' 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)--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)--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--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-	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 (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

@@ -1,56 +0,0 @@-{-# LANGUAGE QuasiQuotes, TemplateHaskell, Rank2Types, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}--module Data.TrieMap.MultiRec.IMap () where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Sized--- import Data.TrieMap.MultiRec.KeyFam--- import Data.TrieMap.MultiRec.TT--- import Data.TrieMap.Rep.TT--- import Data.TrieMap.Rep-import Data.TrieMap.TrieKey--import Control.Applicative-import Control.Arrow--import Generics.MultiRec--newtype IMap phi xi r ix a = IMap (HTrieMap phi r xi a)-type instance HTrieMapT phi (I xi) = IMap phi xi--- type instance TTrieMap phi (I xi r) = TTrieMapH phi (I xi) r---- 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)--- --- -- $(genRepH [d|---   instance ReprH (TTrieMap phi r xi) => ReprH (IMap phi xi r ix) where--- 	toRepH (IMap m) = toRepH m--- 	fromRepH = IMap . fromRepH |] )--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]) 

@@ -1,12 +0,0 @@-module Data.TrieMap.MultiRec.Instances where--import Data.TrieMap.MultiRec.ProdMap-import Data.TrieMap.MultiRec.IMap-import Data.TrieMap.MultiRec.UnionMap-import Data.TrieMap.MultiRec.TagMap-import Data.TrieMap.MultiRec.ConstMap-import Data.TrieMap.MultiRec.UnitMap-import Data.TrieMap.MultiRec.FamMap--- import Data.TrieMap.MultiRec.AppMap--- import Data.TrieMap.MultiRec.XMap--- import Data.TrieMap.MultiRec.FixMap

@@ -1,101 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeOperators, MultiParamTypeClasses, Rank2Types, GADTs #-}--module Data.TrieMap.MultiRec.Ord where--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--class HEq phi f => HOrd phi f where-	compareH :: (forall ix . phi ix -> Comparator (r ix)) -> phi ix -> Comparator (f r ix)--class HEq0 phi r => HOrd0 phi r where-	compare0 :: phi ix -> Comparator (r ix)--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 _ _ (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 (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) => HOrd phi (f :+: g) where-	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-		_	   -> 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 U where-	compareH _ _ _ _ = EQ---- 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

@@ -1,141 +0,0 @@-{-# LANGUAGE PatternGuards, TemplateHaskell, TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}--module Data.TrieMap.MultiRec.ProdMap () where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq--- import Data.TrieMap.MultiRec.Ord-import Data.TrieMap.MultiRec.Sized--- 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--- import Data.TrieMap.Rep.TH--import Control.Applicative-import Control.Arrow--import Data.Maybe-import Data.Monoid-import Data.Foldable-import Data.Sequence ((|>))-import qualified Data.Sequence as Seq--import Generics.MultiRec--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 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)---- -- $(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 (sizeH pf s m) (getFirst (aboutH pf (\ _ a -> return (sizeH pf s m - s a)) 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--- 					= guardNullH pf $--- 						alterMaxH pf s (\ b v -> f (iA + sizeH pf s m - s v) (a :*: b) v) m--- 				| otherwise--- 					= 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)]

@@ -1,20 +0,0 @@-{-# LANGUAGE Rank2Types, KindSignatures #-}--module Data.TrieMap.MultiRec.Sized where---- import Data.TrieMap.Sized--- --- class HSized phi r where--- 	hGetSize :: phi ix -> r ix -> Int--- --- newtype ElF phi r ix = ElF (r ix)--- --- instance (HSized phi r, El phi ix) => Sized (ElF phi r) where--- 	getSize (ElF x) = hGetSize proof x--type HSized (phi :: * -> *) a = a -> Int--newtype Elem a = Elem {getElem :: a}--sizeElem :: HSized phi (Elem a)-sizeElem _ = 1

@@ -1,137 +0,0 @@-{-# LANGUAGE TemplateHaskell, Rank2Types, TypeOperators, KindSignatures, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, GADTs, MultiParamTypeClasses #-}--module Data.TrieMap.MultiRec.TagMap () where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.MultiRec.Sized-import Data.TrieMap.CPair--- import Data.TrieMap.MultiRec.TH--- import Data.TrieMap.Applicative-import Data.TrieMap.TrieKey--- import Data.TrieMap.Rep--import Control.Applicative-import Control.Arrow-import Control.Monad--import Data.Maybe--- import Data.Monoid--- import Data.Foldable-import Generics.MultiRec--data TagF a ix xi where-	TagF :: a -> TagF a ix ix--unTagF :: TagF a ix xi -> a-unTagF (TagF x) = x--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 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)---- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi) => ReprT (TagMap phi f ix r xi) where--- 	toRepT (TagMap m) = fmap unTagF (toRepT m)--- 	fromRepT = TagMap . fromRepT . fmap TagF--- --- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi, Repr a) => Repr (TagMap phi f ix r xi a) where--- 	toRep (TagMap m) = fmap (toRep . unTagF) (toRepT m)--- 	fromRep = TagMap . fromRepT . fmap (TagF . fromRep)--combineTag :: IsectFunc ((f :>: ix) r xi) (a) (b) (c) ->-	IsectFunc (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi)-combineTag f k (TagF a) (TagF b) = TagF <$> f (Tag k) a b--mapTag :: Functor t => ((f :>: ix) r xi -> a -> t (b)) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)-mapTag f k (TagF a) = TagF <$> f (Tag k) a--sizeTag :: HSized phi a -> HSized phi (TagF a ix xi)-sizeTag s (TagF x) = s x--restructure :: HTrieKeyT phi f (HTrieMapT phi f) =>-	((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 (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)--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-	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-	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-	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-	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)-	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-	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-	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-	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-	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)-	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)-	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-	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-	alterMinH = alterMinT-	alterMaxH = alterMaxT-	extractMinH = extractMinT-	extractMaxH = extractMaxT-	isSubmapH = isSubmapT-	fromListH = fromListT-	fromAscListH = fromAscListT-	fromDistAscListH = fromDistAscListT-}

@@ -1,116 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, UndecidableInstances, PatternGuards, MultiParamTypeClasses, TypeOperators #-}--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.TrieKey--- import Data.TrieMap.Rep--- import Data.TrieMap.Rep.TH--- import Data.TrieMap.MultiRec.TH--- import qualified Data.TrieMap.Regular.Base as Reg--import Control.Applicative--- import Control.Arrow-import Control.Monad---- 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) = HTrieMapH phi (f :+: g) r---- 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)---- -- $(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--- 	|])--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 = 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 +) (assocAtH pf s (i - s1) m2)) of-			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)-		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 :&: updateAtH pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2-		| i < s1-			= updateAtH pf s r (\ i' -> f i' . L) i m1 :&: m2-		| otherwise-			= 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)-	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

@@ -1,68 +0,0 @@-{-# LANGUAGE UndecidableInstances, TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}--module Data.TrieMap.MultiRec.UnitMap () where--import Data.TrieMap.MultiRec.Class-import Data.TrieMap.MultiRec.Eq-import Data.TrieMap.Applicative-import Data.TrieMap.TrieKey--- import Data.TrieMap.Rep--- import Data.TrieMap.Rep.Instances--- import Data.TrieMap.Rep.TH--import Control.Applicative-import Control.Arrow--- import Control.Monad--import Data.Maybe-import Data.Monoid-import Data.Foldable-import Data.Traversable-import Generics.MultiRec--import Prelude hiding (foldr, foldl)--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 RepT (UMap phi r ix) = RepT Maybe--- type instance Rep (UMap phi r ix a) = RepT Maybe (Rep a)--- --- -- $(genRepT [d|---   instance ReprT (UMap phi r ix) where--- 	toRepT (UMap m) = toRepT m--- 	fromRepT = UMap . fromRepT |])--instance HTrieKeyT phi U (UMap phi) where-	emptyH _ = UMap Nothing-	nullH _ (UMap m) = isNothing m-	sizeH _ s (UMap m) = maybe 0 s m-	lookupH _ _ (UMap m) = m-	lookupIxH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)-	assocAtH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)--- 	updateAtH _ s r f i (UMap m)--- 		| r == (i >= 0)--- 			= UMap (m >>= f 0 U)--- 		| 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-	mapEitherH _ _ _ f (UMap m) = (UMap *** UMap) (maybe (Nothing, Nothing) (f U) m)-	splitLookupH _ _ f _ (UMap m) = UMap `sides` maybe (Nothing, Nothing, Nothing) f m-	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 (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)--- 	alterMaxH _ _ f (UMap m) = (UMap . f U) <$> (Last m)-	isSubmapH _ _ (UMap Nothing) _ = True-	isSubmapH _ (<=) (UMap m1) (UMap m2) = subMaybe (<=) m1 m2-	fromListH _ _ f xs = UMap (foldr (\ (_, a) -> Just . maybe a (f U a)) Nothing xs)-	fromAscListH = fromListH-	fromDistAscListH _ _ xs = UMap (fmap snd (listToMaybe xs))

@@ -1,146 +1,55 @@-{-# LANGUAGE UndecidableInstances, TemplateHaskell, FlexibleContexts, TypeOperators, Rank2Types, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE UnboxedTuples, TypeFamilies, PatternGuards #-}  module Data.TrieMap.OrdMap () where  import Data.TrieMap.TrieKey import Data.TrieMap.Sized--- import Data.TrieMap.Applicative import Data.TrieMap.Modifiers-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.Monad hiding (join) --- import Data.Monoid--- import Data.Maybe--- import Data.Map--- import qualified Data.Map as Map--- import Data.Traversable- import Prelude hiding (lookup) -data OrdMap k a = Tip -              | Bin {-# UNPACK #-} !Int k (a) !(OrdMap k a) !(OrdMap k a) --type instance TrieMap (Ordered k) = OrdMap k---- type instance RepT (OrdMap k) = FamT KeyFam (HFix (U :+: (K Int :*: K k :*: X :*: A0 :*: A0)))--- type instance Rep (OrdMap k a) = RepT (OrdMap k) (Rep a)---- -- $(genRepT [d|---    instance ReprT (OrdMap k) where--- 	toRepT = FamT . toFix where--- 		toFix Tip = HIn (L U)--- 		toFix (Bin s kx x l r) = HIn (R (K s :*: K kx :*: X x :*: A0 (toFix l) :*: A0 (toFix r)))--- 	fromRepT (FamT x) = fromFix x where--- 		fromFix (HIn L{}) = Tip--- 		fromFix (HIn (R (K s :*: K kx :*: X x :*: A0 l :*: A0 r)))--- 			= Bin s kx x (fromFix l) (fromFix r) |])+type OrdMap k = TrieMap (Ordered k) -instance Ord k => TrieKey (Ordered k) (OrdMap k) where+instance Ord k => TrieKey (Ordered k) where+	data TrieMap (Ordered k) a = Tip +              | Bin {-# UNPACK #-} !Int k a !(OrdMap k a) !(OrdMap k a)  	emptyM = Tip+	singletonM s (Ord k) = singleton s k 	nullM Tip = True 	nullM _ = False 	sizeM _ = size 	lookupM (Ord k) = lookup k-	lookupIxM s (Ord k) = onKey Ord . lookupIx s 0 k-	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)+	mapMaybeM s f = mapMaybe s (f . Ord) 	mapEitherM s1 s2 f = mapEither s1 s2 (f . Ord)-	extractM s f m = extract s (f . Ord) m--- 	extractMinM _ _ Tip = mzero--- 	extractMinM s f m = return (deleteFindMin s (f . Ord) m)--- 	extractMaxM _ _ Tip = mzero--- 	extractMaxM s f m = return (deleteFindMax s (f . Ord) m)--- 	alterMinM s f = updateMin s (f . Ord)--- 	alterMaxM s f = updateMax s (f . Ord)+	extractM s f = extract s (f . Ord) 	splitLookupM s f (Ord k) = splitLookup s f k 	isSubmapM = isSubmap 	fromAscListM s f xs = fromAscList s (f . Ord) [(k, a) | (Ord k, a) <- xs] 	fromDistAscListM s xs = fromDistinctAscList s [(k, a) | (Ord k, a) <- xs]-	unionM s f m1 m2 = case (m1, m2) of-		(Tip, _) -> m2-		(_, Tip) -> m1-		_	 -> hedgeUnionWithKey s (f . Ord) (const LT) (const GT) m1 m2+	unionM _ _ Tip m2 = m2+	unionM _ _ m1 Tip = m1+	unionM s f m1 m2 = hedgeUnionWithKey s (f . Ord) (const LT) (const GT) m1 m2 	isectM s f = isect s (f . Ord)-	diffM s f m1 m2 = case (m1, m2) of-		(Tip, _) -> Tip-		(_, Tip) -> m1-		_	 -> hedgeDiffWithKey s (f . Ord) (const LT) (const GT) m1 m2+	diffM _ _ Tip _ = Tip+	diffM _ _ m1 Tip = m1+	diffM s f m1 m2 = hedgeDiffWithKey s (f . Ord) (const LT) (const GT) m1 m2 -lookup :: Ord k => k -> OrdMap k a -> Maybe (a)-lookup k Tip = Nothing+lookup :: Ord k => k -> OrdMap k a -> Maybe a lookup k (Bin _ k' v l r) = case compare k k' of 	LT	-> lookup k l 	EQ	-> Just v 	GT	-> lookup k r--lookupIx :: Ord k => Sized a -> Int -> k -> OrdMap k a -> IndexPos k a-lookupIx _ i _ _ | i `seq` False = undefined-lookupIx _ _ _ Tip = (mzero, mzero, mzero)-lookupIx s i k (Bin sz kx x l r) = case compare k kx of-	LT	-> case lookupIx s i k l of-		(lb, ans, ub) -> (lb, ans, ub <|> return (Asc (i + size l) kx x))-	EQ	-> (extractMax (\ k v -> Asc (i + size l - s v) k v) l,-			return (Asc (i + size l) kx x),-		    extractMin (Asc (i + sz - size r)) r)-	GT	-> case lookupIx s (i + sz - size r) k r of-		(lb, ans, ub) -> (return (Asc (i + size l) kx x) <|> lb, ans, ub)-	where	extractMin f Tip = mzero-		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)-		extractMax f Tip = mzero-		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)--assocAt :: Sized a -> Int -> Int -> OrdMap k a -> IndexPos k a-assocAt _ i0 i _ | i0 `seq` i `seq` False = undefined-assocAt _ _ _ Tip = (mzero, mzero, mzero)-assocAt s i0 i (Bin sz k a l r)-	| i < sL, (lb, ans, ub) <- assocAt s i0 i l-			= (lb, ans, ub <|> return (Asc (i0 + size l) k a))-	| i < sK	= (extractMax (\ k v -> Asc (i0 + sL - s v) k v) l,-				return (Asc (i0 + sL) k a),-			   extractMin (Asc sK) r)-	| (lb, ans, ub) <- assocAt s (i0 + sK) (i - sK) r-			= (return (Asc (i0 + sL) k a) <|> lb, ans, ub)-	where	sL = size l-		sK = sz - size r-		extractMin f Tip = mzero-		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)-		extractMax f Tip = mzero-		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)--updateAt :: Sized a -> Int -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> OrdMap k a -> OrdMap k a-updateAt _ i0 _ _ i _ | i0 `seq` i `seq` False = undefined-updateAt _ _ _ _ _ Tip = Tip-updateAt s i0 True f i (Bin sz k a l r)-	| i < sL	= balance s k a (updateAt s i0 True f i l) r-	| i < sK	= case f (i0 + sL) k a of-		Nothing	-> glue s l r-		Just a'	-> bin s k a' l r-	| otherwise	= balance s k a l (updateAt s (i0 + sK) True f (i - sK) r)-	where	sL = size l-		sK = sz - size r -updateAt s i0 False f i (Bin sz k a l r)-	| i < maxIxL	= balance s k a (updateAt s i0 False f i l) r-	| i <= sL	= case f (i0 + sL) k a of-		Nothing	-> glue s l r-		Just a' -> bin s k a' l r-	| otherwise	= balance s k a l (updateAt s (i0 + sK) False f (i - sK) r)-	where	sL = size l-		maxIxL = case l of	Tip	-> 0-					_ 	-> fst (deleteFindMax s (\ _ a -> (size l - s a, Just a)) l)-		sK = sz - size r+lookup _ _ = Nothing -alter :: Ord k => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> OrdMap k a -> OrdMap k a+alter :: Ord k => Sized a -> (Maybe a -> Maybe a) -> k -> OrdMap k a -> OrdMap k a alter s f k Tip = case f Nothing of 	Nothing	-> Tip 	Just x	-> singleton s k x@@ -151,71 +60,60 @@ 		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 :: Ord k => Sized a -> (Maybe a -> (# z, Maybe a #)) -> k -> OrdMap k a -> (# z, OrdMap k a #)+alterLookup s f k Tip = onUnboxed (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)+	LT -> onUnboxed (\ l' -> balance s kx x l' r) (alterLookup s f k) l+	EQ -> onUnboxed (maybe (glue s l r) (\ x' -> balance s k x' l r)) f (Just x)+	GT -> onUnboxed (balance s kx x l) (alterLookup s f k) r  singleton :: Sized a -> k -> a -> OrdMap k a singleton s k a = Bin (s a) k a Tip Tip -traverseWithKey :: Applicative f => Sized b -> (k -> a -> f (b)) -> OrdMap k a -> f (OrdMap k b)-traverseWithKey s f Tip = pure Tip+traverseWithKey :: Applicative f => Sized b -> (k -> a -> f b) -> OrdMap k a -> f (OrdMap k b)+traverseWithKey _ _ Tip = pure Tip traverseWithKey s f (Bin _ k a l r) = balance s k <$> f k a <*> traverseWithKey s f l <*> traverseWithKey s f r  foldrWithKey :: (k -> a -> b -> b) -> OrdMap k a -> b -> b-foldrWithKey f Tip = id+foldrWithKey _ Tip = id foldrWithKey f (Bin _ k a l r) = foldrWithKey f l . f k a . foldrWithKey f r  foldlWithKey :: (k -> b -> a -> b) -> OrdMap k a -> b -> b-foldlWithKey f Tip = id+foldlWithKey _ Tip = id foldlWithKey f (Bin _ k a l r) = foldlWithKey f r . flip (f k) a . foldlWithKey f l -mapEither :: Ord k => Sized b -> Sized c -> EitherMap k (a) (b) (c) ->-	OrdMap k a -> (OrdMap k b, OrdMap k c)-mapEither s1 s2 f m = case m of-	Tip	-> (Tip, Tip)-	Bin _ k a l r -> case (f k a, mapEither s1 s2 f l, mapEither s1 s2 f r) of-		((aL, aR), (lL, lR), (rL, rR)) ->-			(joinMaybe s1 k aL lL rL, joinMaybe s2 k aR lR rR)--updateMin :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a-updateMin s f m = case m of-	Tip	-> Tip-	Bin _ k a Tip r -> case f k a of-		Nothing -> r-		Just a'	-> insertMin s k a' r-	Bin _ k a l r	-> balance s k a (updateMin s f l) r+mapMaybe :: Ord k => Sized b -> (k -> a -> Maybe b) -> OrdMap k a -> OrdMap k b+mapMaybe _ _ Tip = Tip+mapMaybe s f (Bin _ k a l r) = joinMaybe s k (f k a) (mapMaybe s f l) (mapMaybe s f r) -updateMax :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a-updateMax s f m = case m of-	Tip	-> Tip-	Bin _ k a l Tip	-> case f k a of-		Nothing	-> l-		Just a'	-> insertMax s k a' l-	Bin _ k a l r	-> balance s k a l (updateMax s f r)+mapEither :: Ord k => Sized b -> Sized c -> EitherMap k a b c ->+	OrdMap k a -> (# OrdMap k b, OrdMap k c #)+mapEither _ _ _ Tip = (# Tip, Tip #)+mapEither s1 s2 f (Bin _ k a l r) +  | (# aL, aR #) <- f k a,+    (# lL, lR #) <- mapEither s1 s2 f l,+    (# rL, rR #) <- mapEither s1 s2 f r+	    = (# joinMaybe s1 k aL lL rL, joinMaybe s2 k aR lR rR #) -splitLookup :: Ord k => Sized a -> SplitMap (a) x -> k -> OrdMap k a -> (OrdMap k a, Maybe x, OrdMap k a)+splitLookup :: Ord k => Sized a -> SplitMap a x -> k -> OrdMap k a -> (# OrdMap k a, Maybe x, OrdMap k a #) splitLookup s f k m = case m of-	Tip	-> (Tip, Nothing, Tip)+	Tip	-> (# Tip, Nothing, Tip #) 	Bin _ kx x l r -> case compare k kx of 		LT	-> case splitLookup s f k l of-			(lL, ans, lR) -> (lL, ans, join s kx x lR r)+			(# lL, ans, lR #) -> (# lL, ans, join s kx x lR r #) 		EQ	-> case f x of-			(xL, ans, xR) -> (maybe l (\ xL -> insertMax s kx xL l) xL, ans,-						maybe r (\ xR -> insertMin s kx xR r) xR)+			(# xL, ans, xR #) -> (# maybe l (\ xL -> insertMax s kx xL l) xL, ans,+						maybe r (\ xR -> insertMin s kx xR r) xR #) 		GT	-> case splitLookup s f k r of-			(rL, ans, rR) -> (join s kx x l rL, ans, rR)+			(# rL, ans, rR #) -> (# join s kx x l rL, ans, rR #) -isSubmap :: Ord k => LEq (a) (b) -> LEq (OrdMap k a) (OrdMap k b)-isSubmap (<=) Tip _ = True-isSubmap (<=) _ Tip = False-isSubmap (<=) (Bin _ kx x l r) t = case found of-	Nothing	-> False-	Just y	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt-	where	(lt, found, gt) = splitLookup (const 1) (\ x -> (Nothing, Just x, Nothing)) kx t+isSubmap :: Ord k => LEq a b -> LEq (OrdMap k a) (OrdMap k b)+isSubmap _ Tip _ = True+isSubmap _ _ Tip = False+isSubmap (<=) (Bin _ kx x l r) t = case splitLookup (const 1) (\ x -> (# Nothing, Just x, Nothing #)) kx t of+	(# lt, found, gt #)	-> case found of+	  Nothing	-> False+	  Just y	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt  fromAscList :: Eq k => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> OrdMap k a fromAscList s f xs = fromDistinctAscList s (combineEq xs) where@@ -223,7 +121,7 @@ 	combineEq [] = [] 	 	combineEq' z [] = [z]-	combineEq' z@(kz, zz) (x@(kx, xx):xs)+	combineEq' (kz, zz) (x@(kx, xx):xs) 		| kz == kx	= combineEq' (kx, f kx xx zz) xs 		| otherwise	= (kz,zz):combineEq' x xs @@ -247,7 +145,7 @@     buildB l k x c r zs     = c (bin s k x l r) zs  hedgeUnionWithKey :: Ord k-                  => Sized a -> (k -> a -> a -> Maybe (a))+                  => Sized a -> (k -> a -> a -> Maybe a)                   -> (k -> Ordering) -> (k -> Ordering)                   -> OrdMap k a -> OrdMap k a -> OrdMap k a hedgeUnionWithKey _ _ _     _     t1 Tip@@ -300,18 +198,16 @@       GT -> trimLookupLo lo cmphi r       EQ -> (Just (kx,x),trim (compare lo) cmphi r) -isect :: Ord k => Sized c -> IsectFunc k (a) (b) (c) -> OrdMap k a -> OrdMap k b -> OrdMap k c-isect s f Tip _ = Tip-isect s f _ Tip = Tip-isect s f t1@(Bin _ k1 x1 l1 r1) t2@(Bin _ k2 x2 l2 r2) =-	let	(lt, found, gt) = splitLookup (const 1) (\ x -> (Nothing, Just x, Nothing)) k2 t1-		tl		= isect s f lt l2-		tr		= isect s f gt r2+isect :: Ord k => Sized c -> IsectFunc k a b c -> OrdMap k a -> OrdMap k b -> OrdMap k c+isect s f t1@Bin{} (Bin _ k2 x2 l2 r2)+  | (# lt, found, gt #) <- splitLookup (const 1) (\ x -> (# Nothing, Just x, Nothing #)) k2 t1+  	= let	tl	= isect s f lt l2+		tr	= isect s f gt r2 	 in joinMaybe s k2 (found >>= \ x1' -> f k2 x1' x2) tl tr-+isect _ _ _ _ = Tip  hedgeDiffWithKey :: Ord k-                 => Sized a -> (k -> a -> b -> Maybe (a))+                 => Sized a -> (k -> a -> b -> Maybe a)                  -> (k -> Ordering) -> (k -> Ordering)                  -> OrdMap k a -> OrdMap k b -> OrdMap k a hedgeDiffWithKey _ _ _     _     Tip _@@ -332,7 +228,7 @@     tl          = hedgeDiffWithKey s f cmplo cmpkx lt l     tr          = hedgeDiffWithKey s f cmpkx cmphi gt r -joinMaybe :: Ord k => Sized a -> k -> Maybe (a) -> OrdMap k a -> OrdMap k a -> OrdMap k a+joinMaybe :: Ord k => Sized a -> k -> Maybe a -> OrdMap k a -> OrdMap k a -> OrdMap k a joinMaybe s kx = maybe (merge s) (join s kx)  join :: Ord k => Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a@@ -380,12 +276,13 @@   | 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 (CPair z (Maybe a))) -> OrdMap k a -> t (CPair z (OrdMap k a))+extract :: Alternative t => Sized a -> (k -> a -> t (z, Maybe a)) -> OrdMap k a -> t (z, OrdMap k a) extract s f t = case t of 	Bin _ k x l 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+	Tip	-> empty  deleteFindMin :: Sized a -> (k -> a -> (x, Maybe a)) -> OrdMap k a -> (x, OrdMap k a) deleteFindMin s f t 

@@ -1,113 +1,49 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE UnboxedTuples, TupleSections, PatternGuards, 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 Data.Sequence ((|>)) 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+instance (TrieKey k1, TrieKey k2) => TrieKey (k1, k2) where+	newtype TrieMap (k1, k2) a = PMap (TrieMap k1 (TrieMap k2 a))+	emptyM = PMap emptyM+	singletonM s (k1, k2) a = PMap (singletonM (sizeM s) k1 (singletonM s k2 a))+	nullM (PMap m) = nullM m+	sizeM s (PMap m) = sizeM (sizeM s) m+	lookupM (k1, k2) (PMap m) = lookupM k1 m >>= lookupM k2+	alterM 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)))+	alterLookupM s f (a, b) (PMap m) = onUnboxed PMap (alterLookupM (sizeM s) g a) m where+		g (Just m) = onUnboxed guardNullM (alterLookupM s f b) m+		g _ = onUnboxed guardNullM (alterLookupM s f b) emptyM+	traverseWithKeyM s f (PMap m) = PMap <$> traverseWithKeyM (sizeM s) (\ a -> traverseWithKeyM s (f . (a,))) m+	foldWithKeyM f (PMap m) = foldWithKeyM (\ a -> foldWithKeyM (f . (a,))) m+	foldlWithKeyM f (PMap m) = foldlWithKeyM (\ a -> flip (foldlWithKeyM (f . (a,)))) m+	mapMaybeM s f (PMap m) = PMap (mapMaybeM (sizeM s) g m) where+		g a = guardNullM . mapMaybeM s (f . (a,))+	mapEitherM s1 s2 f (PMap m) = both PMap PMap (mapEitherM (sizeM s1) (sizeM s2) g) m where+		g a m = both guardNullM guardNullM (mapEitherM s1 s2 (f . (a,))) m+	splitLookupM s f (a, b) (PMap m) = sides PMap (splitLookupM (sizeM s) g a) m where+		g = sides guardNullM (splitLookupM s f b)+	isSubmapM (<=) (PMap m1) (PMap m2) = isSubmapM (isSubmapM (<=)) m1 m2+	unionM s f (PMap m1) (PMap m2) = PMap (unionM (sizeM s) (\ a -> guardNullM .: unionM s (f . (a,))) m1 m2)+	isectM s f (PMap m1) (PMap m2) = PMap (isectM (sizeM s) (\ a -> guardNullM .: isectM s (f . (a,))) m1 m2)+	diffM s f (PMap m1) (PMap m2) = PMap (diffM (sizeM s) (\ a -> guardNullM .: diffM s (f . (a,))) m1 m2)+	extractM s f (PMap m) = fmap PMap <$> extractM (sizeM s) g m where+		g a = fmap guardNullM <.> extractM s (f . (a,))+	fromListM s f xs = PMap (mapWithKeyM (sizeM s) (\ a -> fromListM s (f . (a,))) 		(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+	fromAscListM s f xs = PMap (fromDistAscListM (sizeM s)+		[(a, fromAscListM s (f . (a,)) ys) | (a, ys) <- breakFst xs])  breakFst :: Eq k1 => [((k1, k2), a)] -> [(k1, [(k2, a)])] breakFst [] = []@@ -116,8 +52,3 @@ 		| 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-}

@@ -1,20 +1,15 @@-{-# LANGUAGE TemplateHaskell, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, PatternGuards #-}+{-# LANGUAGE BangPatterns, UnboxedTuples, TupleSections, TypeFamilies, PatternGuards, UnboxedTuples #-}  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 @@ -22,58 +17,35 @@  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+instance TrieKey k =>  TrieKey [k] where+	newtype TrieMap [k] a = Radix (MEdge' k a)+	emptyM = Radix Nothing+	singletonM s ks a = Radix (Just (Edge (s a) ks (Just a) emptyM))+	nullM (Radix m) = isNothing m+	sizeM _ (Radix m) = maybe 0 edgeSize m+	lookupM ks (Radix m) = m >>= lookup ks+	alterM s f ks (Radix m) = Radix (alter s f ks m)+	alterLookupM s f ks (Radix m) = onUnboxed Radix (alterLookupE s f ks) m+	traverseWithKeyM s f (Radix m) = Radix <$> traverse (traverseE s f) m+	extractM s f (Radix m) = maybe empty (fmap Radix <.> extractE s f) m+	foldWithKeyM f (Radix m) z = foldr (foldE f) z m+	foldlWithKeyM f (Radix m) z = foldl (foldlE f) z m+	mapMaybeM s f (Radix m) = Radix (m >>= mapMaybeE s f)+	mapEitherM _ _ _ (Radix Nothing) = (# emptyM, emptyM #)+	mapEitherM s1 s2 f (Radix (Just m)) = both Radix Radix (mapEitherE s1 s2 f) m+	unionM s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s f) m1 m2)+	isectM s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s f) m1 m2)+	diffM s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s f) m1 m2)+-- 	lookupIxM s ks (Radix m) = maybe (empty, empty, empty) (lookupIxE s 0 ks) m+	isSubmapM (<=) (Radix m1) (Radix m2) = subMaybe (isSubmapE (<=)) m1 m2+	splitLookupM _ _ _ (Radix Nothing) = (# emptyM, Nothing, emptyM #)+	splitLookupM s f ks (Radix (Just e)) = sides Radix (splitLookupE s f ks) e+-- 	assocAtM 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@@ -81,21 +53,21 @@ 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 :: TrieKey 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 :: TrieKey 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+compact :: TrieKey k => Edge' k a -> MEdge' k a+compact e@(Edge _ 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 :: (Eq k, TrieKey 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@@ -103,11 +75,10 @@ 	match [] [] = v 	match _ _ = Nothing -alter :: (TrieKey k (TrieMap k)) => Sized a -> (Maybe a -> Maybe a) -> [k] -> MEdge' k a -> MEdge' k a+alter :: TrieKey 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+	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)])@@ -125,57 +96,59 @@ 		= 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 :: TrieKey k => Sized a -> (Maybe a -> (# z, Maybe a #)) -> [k] -> MEdge' k a -> (# z, MEdge' k a #)+alterLookupE s f ks Nothing = onUnboxed (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 $+      match !i (k:ks) (l:ls) = case compare k l of+	      LT	-> onUnboxed (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 $+			      f Nothing+	      GT	-> onUnboxed (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)+			      f Nothing 	      EQ	-> match (i+1) ks ls-      match _ (k:ks) [] = fmap (compact . edge s ls0 v0) (alterLookupM edgeSize g k ts0) where+      match _ (k:ks) [] = onUnboxed (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)+      match _ [] (l:ls) = onUnboxed (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 _ [] [] = onUnboxed (\ 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 :: (Applicative f, TrieKey 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 :: (Alternative f, TrieKey k) => Sized a -> ([k] -> a -> f (x, Maybe a)) -> Edge' k a -> f (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 :: TrieKey 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 :: TrieKey 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+mapMaybeE :: TrieKey k => Sized b -> ([k] -> a -> Maybe b) -> Edge' k a -> MEdge' k b+mapMaybeE s f (Edge _ ks v ts) = compact (edge s ks (v >>= f ks)+	(mapMaybeM edgeSize (\ l -> mapMaybeE s (\ 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+mapEitherE :: TrieKey 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) = case mapEitherM edgeSize edgeSize (\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts of+  (# tsL, tsR #) -> case v of+       Nothing	-> (# compact (edge s1 ks Nothing tsL), compact (edge s2 ks Nothing tsR) #)+       Just v	-> case f ks v of+		      (# vL, vR #) -> (# compact (edge s1 ks vL tsL), compact (edge s2 ks vR tsR) #)++unionE :: TrieKey k => Sized a -> ([k] -> a -> a -> Maybe a) -> Edge' k a -> Edge' k a -> MEdge' k a+unionE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match 0 ks0 ls0 where+	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)])@@ -190,8 +163,8 @@ 	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+isectE :: TrieKey k => Sized c -> ([k] -> a -> b -> Maybe c) -> Edge' k a -> Edge' k b -> MEdge' k c+isectE s f (Edge szK ks0 vK tsK) (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@@ -202,8 +175,8 @@ 		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+diffE :: TrieKey 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) (Edge szL ls0 vL tsL) = match ks0 ls0 where 	match (k:ks) (l:ls) 		| k == l	= match ks ls 	match (k:ks) []@@ -216,33 +189,9 @@ 		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+isSubmapE :: TrieKey k => LEq a b -> LEq (Edge' k a) (Edge' k b)+isSubmapE (<=) (Edge szK ks vK tsK) (Edge _ ls vL tsL) = match ks ls where 	match (k:ks) (l:ls) 		| k == l	= match ks ls 	match (k:ks) []@@ -251,39 +200,18 @@ 	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 :: TrieKey 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)+		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)))+	    (# tsL, x, tsR #) -> (# compact (edge s ls v tsL), x, compact (edge s ls Nothing tsR) #)+	  where	g = splitLookupE s f ks+	match [] (_:_) = (# Nothing, Nothing, Just e #)+	match [] [] = case v of+	    Nothing	-> (# Nothing, Nothing, compact (edge s ls Nothing ts) #)+	    Just v	-> case f v of+		(# vL, x, vR #)	-> (# singleMaybe s ls vL, x, compact (edge s ls vR ts) #)

@@ -1,6 +0,0 @@-module Data.TrieMap.Regular (TrieMapT, TrieKeyT, module Data.TrieMap.Regular.Base, EqT(..), Comparator, OrdT (..){-, K0 (..), I0 (..), U(..), (:*:)(..), (:+:)(..), L(..), Fix(..)-}) where--import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Ord-import Data.TrieMap.Regular.Eq

@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeOperators #-}--module Data.TrieMap.Regular.Base where---- import Data.TrieMap.TrieKey--newtype K0 a r = K0 {unK0 :: a} deriving (Show)-newtype I0 r = I0 {unI0 :: r} deriving (Show)-data U0 r = U0 deriving (Show)-data (f :*: g) r = f r :*: g r deriving (Show)-data (f :+: g) r = L (f r) | R (g r) deriving (Show)-newtype L f r = List [f r] deriving (Show)-newtype (f `O` g) r = O (f (g r))-newtype Reg r = Reg {unReg :: r} deriving (Show)--newtype Fix f = In {out :: f (Fix f)}--type family PF a :: * -> *--instance (Functor f, Functor g) => Functor (f `O` g) where-	fmap f (O x) = O (fmap (fmap f) x)--class Regular a where-	from :: a -> PF a a-	to :: PF a a -> a--type instance PF (K0 a r) = K0 a-type instance PF (I0 r) = I0-type instance PF (U0 r) = U0-type instance PF ((f :*: g) r) = PF (f r) :*: PF (g r)-type instance PF ((f :+: g) r) = PF (f r) :+: PF (g r)-type instance PF (Fix f) = f-type instance PF [a] = L (PF a)-type instance PF (L f a) = L (PF (f a))--- type instance PF Bool = K Bool--- type instance PF Int = K Int--- type instance PF Char = K Char--- type instance PF --instance Functor (K0 a) where-	fmap _ (K0 a) = K0 a--instance Functor I0 where-	fmap f (I0 a) = I0 (f a)--instance Functor U0 where-	fmap _ U0 = U0--instance Functor f => Functor (L f) where-	fmap f (List xs) = List (map (fmap f) xs)--instance (Functor f, Functor g) => Functor (f :*: g) where-	fmap f (x :*: y) = fmap f x :*: fmap f y--instance (Functor f, Functor g) => Functor (f :+: g) where-	fmap f (L x) = L (fmap f x)-	fmap f (R x) = R (fmap f x)--from' :: (Functor (PF a), Regular a) => Reg a -> PF a (Reg a)-from' (Reg a) = fmap Reg (from a)--to' :: (Functor (PF a), Regular a) => PF a (Reg a) -> Reg a-to' = Reg . to . fmap unReg--infixr 7 :*:-infixr 6 :+:--partEithers :: [((f :+: g) r, a)] -> ([(f r, a)], [(g r, a)])-partEithers = foldr part ([], []) where-	part (L k, a) (xs, ys) = ((k, a):xs, ys)-	part (R k, a) (xs, ys) = (xs, (k, a):ys)

@@ -1,91 +0,0 @@-{-# LANGUAGE Rank2Types, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}--module Data.TrieMap.Regular.Class where--import Data.TrieMap.Sized-import Data.TrieMap.Applicative-import Data.TrieMap.TrieKey--- import Data.TrieMap.Regular.Eq-import Data.TrieMap.Regular.Ord-import Data.TrieMap.CPair---- import Data.Monoid--import Control.Applicative--type family TrieMapT (f :: * -> *) :: * -> * -> *--class OrdT f => TrieKeyT (f :: * -> *) (m :: * -> * -> *) | m -> f, f -> m where-	emptyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a-	nullT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a -> Bool-	sizeT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a -> Int-	lookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => f k -> m k a -> Maybe (a)-	lookupIxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> f k -> m k a -> IndexPos (f k) a-	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)) => -		(f k -> a -> b -> b) -> m k a -> b -> b-	foldlWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) =>-		(f k -> b -> a -> b) -> m k a -> b -> b-	mapEitherT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => -		Sized b -> Sized c -> EitherMap (f k) (a) (b) (c) -> m k a -> (m k b, m k c)-	splitLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> f k ->-		m k a -> (m k a, Maybe x, m k a)-	unionT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> UnionFunc (f k) (a) ->-		m k a -> m k a -> m k a-	isectT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized c -> IsectFunc (f k) (a) (b) (c) ->-		m k a -> m k b -> m k c-	diffT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> DiffFunc (f k) (a) (b) ->-		m k a -> m k b -> m k a-	extractT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Alternative t) => -		Sized a -> ExtractFunc t (m k a) (f k) a x--- 	extractMinT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) First a (m k a) x--- 	extractMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) Last a (m k a) x--- 	alterMinT, alterMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> Maybe (a)) ->--- 		m k a -> m k a-	isSubmapT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (m k a) (m k b)-	fromListT, fromAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> a -> a) ->-		[(f k, a)] -> m k a-	fromDistAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> [(f k, a)] -> m k a-	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---- mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>--- 	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b--- mapWithKeyT s f m = unId (traverseWithKeyT s (\ k a -> Id (f k a)) m)--guardNullT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> Maybe (TrieMapT f k a)-guardNullT m-	| nullT m	= Nothing-	| otherwise	= Just m--assocsT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> [(f k, a)]-assocsT m = foldWithKeyT (\ k a -> ((k, a):)) m []--singletonT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> f k -> a -> TrieMapT f k a-singletonT s k a = alterT s (const (Just a)) k emptyT--mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => -	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b-mapWithKeyT s f m = unId (traverseWithKeyT s (Id .: f) m)--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 = 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-alterMinT s f m = maybe m snd (getFirst (extractMinT s (\ k a -> ((), f k a)) m))--alterMaxT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>-	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a-}--- alterMaxT s f m = maybe m snd (getLast (extractMaxT s (\ k a -> ((), f k a)) m))

@@ -1,135 +0,0 @@-{-# LANGUAGE TemplateHaskell, PatternGuards, UndecidableInstances, FlexibleContexts, TypeOperators, TypeFamilies, MultiParamTypeClasses #-}--module Data.TrieMap.Regular.CompMap () where--import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Ord-import Data.TrieMap.Regular.Eq--- import Data.TrieMap.Regular.TH-import Data.TrieMap.TrieKey--- import Data.TrieMap.Rep--- import Data.TrieMap.Rep.TH--import Control.Applicative-import Control.Arrow--import Prelude hiding (lookup)--newtype CompMap m g k a = CMap (m (App g k) a)-newtype App f a = A {unA :: f a}-newtype AppMap m k a = AMap (m k a)--type instance TrieMapT (App f) = AppMap (TrieMapT f)-type instance TrieMap (App f r) = AppMap (TrieMapT f) r-type instance TrieMapT (f `O` g) = CompMap (TrieMapT f) g-type instance TrieMap ((f `O` g) r) = CompMap (TrieMapT f) g r--instance EqT f => EqT (App f) where-	eqT0 (==) (A a) (A b) = eqT0 (==) a b--instance OrdT f => OrdT (App f) where-	compareT0 cmp (A a) (A b) = compareT0 cmp a b--instance (EqT f, Eq r) => Eq (App f r) where-	(==) = eqT--instance (OrdT f, Ord g) => Ord (App f g) where-	compare = compareT--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 (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 (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 (A <$> k) m-	isSubmapT (<=) (CMap m1) (CMap m2) = isSubmapT (<=) m1 m2-	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)--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-	lookupT (A k) (AMap m) = lookupT k m-	lookupIxT s (A k) (AMap m) = onKey A (lookupIxT s k m)-	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) = 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)--- 	alterMaxT s f (AMap m) = AMap (alterMaxT s (f . A) m)-	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

@@ -1,73 +0,0 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, UndecidableInstances #-}--module Data.TrieMap.Regular.ConstMap() where--import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base-import Data.TrieMap.TrieKey--import Control.Applicative-import Control.Arrow-import Control.Monad---- import Data.Monoid--newtype KMap m k a = KMap (m a)-type instance TrieMapT (K0 a) = KMap (TrieMap a)-type instance TrieMap (K0 a r) = TrieMapT (K0 a) r--instance (TrieKey k m, m ~ TrieMap k) => TrieKey (K0 k r) (KMap m r) where-	emptyM = KMap emptyM-	nullM (KMap m) = nullM m-	sizeM s (KMap m) = sizeM s m-	lookupM (K0 k) (KMap m) = lookupM k m-	lookupIxM s (K0 k) (KMap m) = onKey K0 (lookupIxM s k m)-	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-	mapEitherM s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM s1 s2 (f . K0) m)-	splitLookupM s f (K0 k) (KMap m) = KMap `sides` splitLookupM s f k m-	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) = 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) --- 	alterMaxM s f (KMap m) = KMap (alterMaxM s (f . K0) m)-	isSubmapM (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2-	fromListM s f xs = KMap (fromListM s (f . K0) [(k, a) | (K0 k, a) <- xs])-	fromAscListM s f xs = KMap (fromAscListM s (f . K0) [(k, a) | (K0 k, a) <- xs])-	fromDistAscListM s xs = KMap (fromDistAscListM s [(k, a) | (K0 k, a) <- xs])--instance (TrieKey k m, m ~ TrieMap k) => TrieKeyT (K0 k) (KMap m) where-	emptyT = emptyM-	nullT = nullM-	sizeT = sizeM-	lookupT = lookupM-	lookupIxT = lookupIxM-	assocAtT = assocAtM--- 	updateAtT = updateAtM-	alterT = alterM-	alterLookupT = alterLookupM-	traverseWithKeyT = traverseWithKeyM-	foldWithKeyT = foldWithKeyM-	foldlWithKeyT = foldlWithKeyM-	mapEitherT = mapEitherM-	splitLookupT = splitLookupM-	unionT = unionM-	isectT = isectM-	diffT = diffM-	extractT = extractM--- 	extractMinT = extractMinM--- 	extractMaxT = extractMaxM--- 	alterMinT = alterMinM--- 	alterMaxT = alterMaxM-	isSubmapT = isSubmapM-	fromListT = fromListM-	fromAscListT = fromAscListM-	fromDistAscListT = fromDistAscListM

@@ -1,90 +0,0 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}--module Data.TrieMap.Regular.Eq where--import Data.TrieMap.Regular.Base--- import Data.TrieMap.MultiRec.Base(Family(..))--- import Data.TrieMap.MultiRec.Eq(HEq0(..))-import Data.TrieMap.Modifiers--class EqT f where-	eqT0 :: (a -> a -> Bool) -> f a -> f a -> Bool--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--instance EqT I0 where-	eqT0 (==) (I0 a) (I0 b) = a == b--instance EqT [] where-	eqT0 (==) = eqT' where-		eqT' (a:as) (b:bs) = a == b && eqT' as bs-		eqT' [] [] = True--eqT' _ _ = False--instance (EqT f, EqT g) => EqT (f :*: g) where-	eqT0 (==) (x1 :*: y1) (x2 :*: y2) = eqT0 (==) x1 x2 && eqT0 (==) y1 y2--instance (EqT f, EqT g) => EqT (f :+: g) where-	eqT0 (==) a b = case (a, b) of-		(L a, L b) -> eqT0 (==) a b-		(R a, R b) -> eqT0 (==) a b-		_	   -> False--instance EqT U0 where-	eqT0 _ _ _ = True--instance EqT f => EqT (L f) where-	eqT0 (==) (List xs) (List ys) = eqT' xs ys where-		eqT0' = eqT0 (==)-		eqT' (a:as) (b:bs) = eqT0' a b && eqT' as bs-		eqT' [] [] = True-		eqT' _ _ = False--instance (Regular a, Functor (PF a), EqT (PF a)) => Eq (Reg a) where-	a == b = eqT (from' a) (from' b)--instance (EqT f, Eq r) => Eq (L f r) where-	(==) = eqT--instance (EqT f, EqT g, Eq r) => Eq ((f :*: g) r) where-	(==) = eqT--instance (EqT f, EqT g, Eq r) => Eq ((f :+: g) r) where-	(==) = eqT--instance (EqT f, EqT g) => EqT (f `O` g) where-	eqT0 (==) (O x) (O y) = eqT0 (eqT0 (==)) x y--instance (EqT f, EqT g, Eq r) => Eq ((f `O` g) r) where-	(==) = eqT--instance Eq a => Eq (K0 a r) where-	K0 a == K0 b = a == b--instance Eq r => Eq (I0 r) where-	I0 a == I0 b = a == b--instance Eq (U0 r) where-	_ == _ = True--instance Eq a => EqT ((,) a) where-	eqT0 (=#=) (a, b) (c, d) = a == c && b =#= d--instance Eq a => EqT (Either a) where-	eqT0 _ (Left a) (Left b) = a == b-	eqT0 (==) (Right a) (Right b) = a == b-	eqT0 _ _ _ = False--instance EqT Ordered where-	eqT0 (==) (Ord x) (Ord y) = x == y--instance EqT Rev where-	eqT0 (==) (Rev x) (Rev y) = y == x

@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies, MultiParamTypeClasses #-}--module Data.TrieMap.Regular.IdMap where--import Data.TrieMap.TrieKey-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Class--import Control.Applicative-import Control.Arrow-import Control.Monad--newtype IMap k a = IMap (TrieMap k a)-type instance TrieMapT I0 = IMap-type instance TrieMap (I0 k) = IMap k--instance TrieKeyT I0 IMap where-	emptyT = IMap emptyM-	nullT (IMap m) = nullM m-	sizeT s (IMap m) = sizeM s m-	lookupT (I0 k) (IMap m) = lookupM k m-	lookupIxT s (I0 k) (IMap m) = onKey I0 (lookupIxM s k m)-	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-	mapEitherT s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherM s1 s2 (f . I0) m)-	splitLookupT s f (I0 k) (IMap m) = IMap `sides` splitLookupM s f k m-	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) = 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)--- 	alterMaxT s f (IMap m) = IMap (alterMaxM s (f . I0) m)-	isSubmapT (<=) (IMap m1) (IMap m2) = isSubmapM (<=) m1 m2-	fromListT s f xs = IMap (fromListM s (f . I0) [(k, a) | (I0 k, a) <- xs])-	fromAscListT s f xs = IMap (fromAscListM s (f . I0) [(k, a) | (I0 k, a) <- xs])-	fromDistAscListT s xs = IMap (fromDistAscListM s [(k, a) | (I0 k, a) <- xs])--instance TrieKey k (TrieMap k) => TrieKey (I0 k) (IMap k) where-	emptyM = emptyT-	nullM = nullT-	sizeM = sizeT-	lookupM = lookupT-	lookupIxM = lookupIxT-	assocAtM = assocAtT--- 	updateAtM = updateAtT-	alterM = alterT-	alterLookupM = alterLookupT-	traverseWithKeyM = traverseWithKeyT-	foldWithKeyM = foldWithKeyT-	foldlWithKeyM = foldlWithKeyT-	mapEitherM = mapEitherT-	splitLookupM = splitLookupT-	unionM = unionT-	isectM = isectT-	diffM = diffT-	extractM = extractT--- 	extractMinM = extractMinT--- 	extractMaxM = extractMaxT--- 	alterMinM = alterMinT --- 	alterMaxM = alterMaxT-	isSubmapM = isSubmapT-	fromListM = fromListT-	fromAscListM = fromAscListT-	fromDistAscListM = fromDistAscListT

@@ -1,11 +0,0 @@-module Data.TrieMap.Regular.Instances where--import Data.TrieMap.Regular.UnitMap-import Data.TrieMap.Regular.ConstMap-import Data.TrieMap.Regular.ProdMap-import Data.TrieMap.Regular.UnionMap-import Data.TrieMap.Regular.RadixTrie-import Data.TrieMap.Regular.IdMap-import Data.TrieMap.Regular.RegMap-import Data.TrieMap.Regular.CompMap-import Data.TrieMap.Regular.Rep

@@ -1,101 +0,0 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts, TypeOperators #-}--module Data.TrieMap.Regular.Ord where--import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Eq--- import Data.TrieMap.MultiRec.Base(Family(..))--- import Data.TrieMap.MultiRec.Ord(HOrd0(..))--- import Data.TrieMap.TrieKey-import Data.TrieMap.Modifiers-import Data.Monoid--type Comparator a = a -> a -> Ordering--class EqT f => OrdT f where-	compareT0 :: Comparator a -> Comparator (f a)--compareT :: (OrdT f, Ord a) => Comparator (f a)-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--instance Ord a => Ord (K0 a r) where-	compare (K0 a) (K0 b) = compare a b--instance OrdT I0 where-	compareT0 cmp (I0 a) (I0 b) = cmp a b--instance Ord r => Ord (I0 r) where-	compare = compareT--instance (OrdT f, OrdT g) => OrdT (f :*: g) where-	compareT0 cmp (x1 :*: y1) (x2 :*: y2) = compareT0 cmp x1 x2 `mappend` compareT0 cmp y1 y2--instance (OrdT f, OrdT g, Ord r) => Ord ((f :*: g) r) where-	compare = compareT--instance (OrdT f, OrdT g) => OrdT (f `O` g) where-	compareT0 cmp (O x) (O y) = compareT0 (compareT0 cmp) x y--instance (OrdT f, OrdT g, Ord r) => Ord ((f `O` g) r) where-	compare = compareT--instance (OrdT f, OrdT g) => OrdT (f :+: g) where-	compareT0 cmp x y = case (x, y) of-		(L x, L y)	-> compareT0 cmp x y-		(R x, R y)	-> compareT0 cmp x y-		(L _, R _)	-> LT-		(R _, L _)	-> GT--instance (OrdT f, OrdT g, Ord r) => Ord ((f :+: g) r) where-	compare = compareT--instance OrdT U0 where-	compareT0 _ = compare--instance Ord (U0 r) where-	compare _ _ = EQ--instance OrdT f => OrdT (L f) where-	compareT0 cmp (List xs) (List ys) = compareT0' xs ys where-		cmpT' = compareT0 cmp-		compareT0' (x:xs) (y:ys) = cmpT' x y `mappend` compareT0' xs ys-		compareT0' [] [] = EQ-		compareT0' [] _ = LT-		compareT0' _ [] = GT--instance (OrdT f, Ord r) => Ord (L f r) where-	compare = compareT--instance OrdT [] where-	compareT0 cmp = cmpT' where-		cmpT' (x:xs) (y:ys) = cmp x y `mappend` cmpT' xs ys-		cmpT' [] [] = EQ-		cmpT' [] _ = LT-		cmpT' _ [] = GT--instance (Regular a, Functor (PF a), OrdT (PF a)) => Ord (Reg a) where-	compare a b = compareT (from' a) (from' b)--instance Ord a => OrdT ((,) a) where-	compareT0 cmp (a, b) (c, d) = compare a c `mappend` cmp b d-	-instance Ord a => OrdT (Either a) where-	compareT0 cmp x y = case (x, y) of-		(Left a, Left b) -> compare a b-		(Right a, Right b) -> cmp a b-		(Left{}, Right{}) -> LT-		(Right{}, Left{}) -> GT--instance OrdT Rev where-	compareT0 cmp (Rev x) (Rev y) = cmp y x--instance OrdT Ordered where-	compareT0 cmp (Ord x) (Ord y) = cmp x y

@@ -1,138 +0,0 @@-{-# LANGUAGE TemplateHaskell, PatternGuards, TypeFamilies, MultiParamTypeClasses, FlexibleContexts,  TypeOperators, UndecidableInstances #-}--module Data.TrieMap.Regular.ProdMap() where--import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Eq-import Data.TrieMap.TrieKey-import Data.TrieMap.Applicative-import Data.TrieMap.Sized--- import Data.TrieMap.Regular.TH--import Control.Applicative-import Control.Arrow--import Data.Maybe-import Data.Monoid-import Data.Sequence (Seq, (|>))-import qualified Data.Sequence as Seq-import Data.Foldable--newtype PMap m1 (m2 :: * -> * -> *) k a = PMap (m1 k (m2 k a))-type instance TrieMapT (f :*: g) = PMap (TrieMapT f) (TrieMapT g)-type instance TrieMap ((f :*: g) r) = TrieMapT (f :*: g) r--lastIx :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> TrieMapT f k a -> Int-lastIx s m = fromMaybe (sizeT s m) (getLast (aboutT (\ _ a -> return $ sizeT s m - s a) m))----maybe (sizeT s m) fst (getLast (extractMaxT s (\ _ a -> (sizeT s m - s a, Just a)) m))--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-	lookupT (a :*: b) (PMap m) = lookupT a m >>= lookupT b-	lookupIxT s (a :*: b) (PMap m) = case lookupIxT (sizeT s) a m of-		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x-						let (lb', x', ub') = lookupIxT s b m'-						let f = onKeyA (a' :*:) . onIndexA (i' +)-						return (f <$> lb', f <$> x', f <$> ub')-			in ((do	Asc iL aL mL <- lb-				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax s mL)) <|>-			    (do	(lb', _, _) <- Last lookupX-			    	lb'),-			    (do	(_, x', _) <- lookupX-			    	x'),-			    (do	(_, _, ub') <- First lookupX-			    	ub') <|>-			    (do Asc iR aR mR <- ub-			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin s mR))) -		where	getMin s m = aboutT (\ k a -> return (Asc 0 k a)) m-			getMax s m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m-	assocAtT s i (PMap m) = case assocAtT (sizeT s) i m of-		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x-						let (lb', x', ub') = assocAtT s (i - i') m'-						let f = onKeyA (a' :*:) . onIndexA (i' +)-						return (f <$> lb', f <$> x', f <$> ub')-			in ((do	Asc iL aL mL <- lb-				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax mL)) <|>-			    (do	(lb', _, _) <- Last lookupX-			    	lb'),-			    (do	(_, x', _) <- lookupX-			    	x'),-			    (do	(_, _, ub') <- First lookupX-			    	ub') <|>-			    (do	Asc iR aR mR <- ub-			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin mR)))-		where	getMin m = aboutT (\ k a -> return (Asc 0 k a)) m-			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m--- 	updateAtT s r f i (PMap m) = PMap (updateAtT (sizeT s) r g i m) where--- 		g iA a m'--- 			| not r && i < iA--- 				= guardNullT (alterMinT s (f iA . (a :*:)) m')--- 			| r && i >= iA + lastIx s m'--- 				= guardNullT (alterMaxT s (f (lastIx s m') . (a :*:)) m')--- 			| otherwise--- 				= 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-		g a = foldWithKeyT (\ b -> f (a :*: b))-	foldlWithKeyT f (PMap m) = foldlWithKeyT g m where-		g a z m = foldlWithKeyT (\ b -> f (a :*: b)) m z-	mapEitherT s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherT (sizeT s1) (sizeT s2) g m) where-		g a = (guardNullT *** guardNullT) . mapEitherT s1 s2 (\ b -> f (a :*: b))-	splitLookupT s f (a :*: b) (PMap m) = PMap `sides` splitLookupT (sizeT s) g a m where-		g = sides guardNullT . splitLookupT s f b-	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) = 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--- 		g a = second guardNullT . fromJust . getLast . extractMaxT s (f . (a :*:))--- 	alterMinT s f (PMap m) = PMap (alterMinT (sizeT s) (\ a -> guardNullT . alterMinT s (\ b -> f (a :*: b))) m)--- 	alterMaxT s f (PMap m) = PMap (alterMaxT (sizeT s) (\ a -> guardNullT . alterMaxT s (\ b -> f (a :*: b))) m)-	isSubmapT (<=) (PMap m1) (PMap m2) = isSubmapT (isSubmapT (<=)) m1 m2 -	fromListT s f xs = PMap (mapWithKeyT (sizeT s) (\ a -> fromListT s (\ b -> f (a :*: b))) -		(fromListT (const 1) (const (++)) (breakFst xs)))-	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' 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)]

@@ -1,417 +0,0 @@-{-# LANGUAGE TemplateHaskell, Rank2Types, PatternGuards, FlexibleContexts, TypeFamilies, UndecidableInstances, MultiParamTypeClasses #-}--module Data.TrieMap.Regular.RadixTrie () where--import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base-import Data.TrieMap.Regular.Ord-import Data.TrieMap.Regular.Eq--- import Data.TrieMap.Regular.TH-import Data.TrieMap.Sized-import Data.TrieMap.TrieKey-import Data.TrieMap.Applicative-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-import Control.Monad--import Data.Maybe-import Data.Monoid-import Data.Foldable-import Data.Traversable--import Prelude hiding (foldr, foldl)--data Edge f (m :: * -> * -> *) k a = Edge {-# UNPACK #-} !Int [f k] (Maybe (a)) (m k (Edge f m k a))-type Edge' f k a = Edge f (TrieMapT f) k a-type MEdge f k m a = Maybe (Edge f m k a)-type MEdge' f k a = Maybe (Edge' f k a)---- type instance PF (Edge f m k a) = (K0 (L f k) :*: K0 (Maybe (a)) :*: L (K0 k :*: I0) :*: K0 Int)--- type instance (RadixTrie f k a) = U0 :+: PF (Edge f m k a)---- instance (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Regular (Edge f m k a) where--- 	from (Edge n ks v ts) = K0 (List ks) :*: K0 v :*: --newtype RadixTrie f k a = Radix (MEdge' f k a)--- newtype K0 a b = K0 a--type instance TrieMapT (L f) = RadixTrie f-type instance TrieMap (L f r) = RadixTrie f r--edgeSize :: Sized (Edge f m k a)-edgeSize (Edge s _ _ _) = s--edge :: (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> m k (Edge f m k a) -> Edge f m k a-edge s ks v ts = Edge (maybe 0 s v + sizeT edgeSize ts) ks v ts--instance (OrdT f, TrieKeyT f m, m ~ TrieMapT f) => TrieKeyT (L f) (RadixTrie f) where-	emptyT = Radix Nothing-	nullT (Radix m) = isNothing m-	sizeT _ (Radix m) = maybe 0 edgeSize m-	lookupT (List ks) (Radix m) = m >>= lookupE ks-	lookupIxT s (List ks) (Radix m) = maybe (mzero, mzero, mzero) (onKey List . lookupIxE s 0 ks) m-	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-	mapEitherT s1 s2 f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE s1 s2 (f . List)) m)-	splitLookupT s f (List ks) (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE s f ks) m-	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 (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))--- 	alterMaxT s f (Radix m) = Radix (m >>= alterMaxE s (f . List))-	isSubmapT (<=) (Radix m1) (Radix m2) = subMaybe (isSubEdge (<=)) m1 m2-	fromListT s f xs = Radix (fromListE s (f . List) [(ks, a) | (List ks, a) <- xs])-	fromAscListT s f xs = Radix (fromAscListE s (f . List) [(ks, a) | (List ks, a) <- xs])--instance (OrdT f, TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieKey (L f k) (RadixTrie f k) where-	emptyM = emptyT-	nullM = nullT-	sizeM = sizeT-	lookupM = lookupT-	lookupIxM = lookupIxT-	assocAtM = assocAtT--- 	updateAtM = updateAtT-	alterM = alterT-	alterLookupM = alterLookupT-	traverseWithKeyM = traverseWithKeyT-	foldWithKeyM = foldWithKeyT-	foldlWithKeyM = foldlWithKeyT-	mapEitherM = mapEitherT-	splitLookupM = splitLookupT-	unionM = unionT-	isectM = isectT-	diffM = diffT-	extractM = extractT--- 	extractMinM = extractMinT--- 	extractMaxM = extractMaxT--- 	alterMinM = alterMinT--- 	alterMaxM = alterMaxT-	isSubmapM = isSubmapT-	fromListM = fromListT-	fromAscListM = fromAscListT-	fromDistAscListM = fromDistAscListT---- instance (Ord k, TrieKey k m) => TrieKey [k] (RadixTrie k m) where--- 	emptyM = Radix Nothing--- 	nullM (Radix m) = isNothing m--- 	lookupM ks (Radix m) = m >>= lookupE ks--- 	alterM f ks (Radix m) = Radix (maybe (singletonME ks (f Nothing)) (alterE f ks) m)--- 	traverseWithKeyM f (Radix m) = Radix <$> traverse (traverseE f) m--- 	foldWithKeyM f (Radix m) z = foldr (foldE f) z m--- 	mapEitherM f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE f) m)--- 	splitLookupM f ks (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE f ks) m--- 	unionM f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE f) m1 m2)--- 	isectM f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE f) m1 m2)--- 	diffM f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE f) m1 m2)--- 	extractMinM (Radix m) = First m >>= fmap (fmap Radix) . extractMinE--- 	extractMaxM (Radix m) = Last m >>= fmap (fmap Radix) . extractMaxE--- 	alterMinM f (Radix m) = Radix (m >>= alterMinE f)--- 	alterMaxM f (Radix m) = Radix (m >>= alterMaxE f)--- 	isSubmapM (<=) (Radix m1) (Radix m2) = subMaybe (isSubEdge (<=)) m1 m2--- 	fromListM = Radix .: fromListE--- 	fromAscListM = Radix .: fromAscListE--compact :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Edge' f k a -> MEdge' f k a-compact e@(Edge s ks Nothing ts) = case assocsT ts of-	[]	-> Nothing-	[~(k, e'@(Edge s' ls v ts'))]-		-> e' `seq` compact (Edge s' (ks ++ k:ls) v ts')-	_	-> Just e-compact e = Just e--cons :: f k -> Edge' f k a -> Edge' f k a-l `cons` Edge s ls v ts = Edge s (l:ls) v ts--cat :: [f k] -> Edge' f k a -> Edge' f k a-ks `cat` Edge s ls v ts = Edge s (ks ++ ls) v ts--singletonME :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> MEdge' f k a-singletonME s ks = fmap (\ v -> Edge (s v) ks (Just v) emptyT)--lookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => [f k] -> Edge' f k a -> Maybe (a)-lookupE ks (Edge _ ls v ts) = match ks ls where-	match (k:ks) (l:ls)-		| k `eqT` l	= match ks ls-	match (k:ks) [] = do	e' <- lookupT k ts-				lookupE ks e'-	match [] [] = v-	match _ _ = Nothing--alterE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => -	Sized a -> (Maybe (a) -> Maybe (a)) -> [f k] -> Edge' f k a -> MEdge' f k a-alterE 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)-		| k `eqT` l	= match (i+1) ks ls-		| Just v <- f Nothing-				= Just (Edge (sz + s v) (take i ls0) Nothing -					(fromListT edgeSize (const const) [(k, Edge (s v) ks (Just v) emptyT), -						(l, Edge sz ls v0 ts0)]))-	match _ (k:ks) [] = compact $ edge s ls0 v0 $ alterT edgeSize g k ts0 where-		g = maybe (singletonME s ks (f Nothing)) (alterE s f ks)-	match _ [] (l:ls)-		| Just v <- f Nothing-			= Just (Edge (sz + s v) ks0 (Just v) (singletonT edgeSize l (Edge sz ls v0 ts0)))-	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) =-	edge s ks <$> traverse (f ks) v <*> traverseWithKeyT edgeSize (\ l -> traverseE s (\ ls -> f (ks ++ l:ls))) ts--foldE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> a -> b -> b) -> Edge' f k a -> b -> b-foldE f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyT (\ l -> foldE (\ ls -> f (ks ++ l:ls))) ts z) v--foldlE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> b -> a -> b) -> Edge' f k a -> b -> b-foldlE f (Edge _ ks v ts) z = foldlWithKeyT (\ l z m -> foldlE (\ ls -> f (ks ++ l:ls)) m z) ts (foldl (f ks) z v)--mapEitherE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized b -> Sized c -> -	EitherMap (EitherMap [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)-mapEitherE s1 s2 f (Edge _ ks v ts) = case (maybe (Nothing, Nothing) (f ks) v, mapEitherT edgeSize edgeSize -					(\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts) of -	((vL, vR), (tsL, tsR)) -> (compact (edge s1 ks vL tsL), compact (edge s2 ks vR tsR))--splitLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> [f k] -> SplitMap (Edge' f k a) x-splitLookupE s f ks e@(Edge _ ls v ts) = match ks ls where-	match (k:ks) (l:ls) = case compareT k l of-		LT	-> (Nothing, Nothing, Just e)-		EQ	-> match ks ls-		GT	-> (Just e, Nothing, Nothing)-	match [] [] = case v of-		Nothing	-> (Nothing, Nothing, Just e)-		Just v	-> compact `sides` case f v of-			(vL, x, vR) -> (edge s ls vL emptyT, x, edge s ls vR ts)-	match [] (l:ls) = (Just e, Nothing, Nothing)-	match (k:ks) [] = compact `sides` case splitLookupT edgeSize g k ts of-		(tsL, x, tsR)	-> (edge s ls v tsL, x, edge s ls Nothing tsR)-		where	g = splitLookupE s f ks--unionE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> UnionFunc (UnionFunc [f k] (a)) (Edge' f k a)-unionE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match 0 ks0 ls0 where-	match i _ _ | i `seq` False = undefined-	match i (k:ks) (l:ls)-		| k `eqT` l	= match (i+1) ks ls-		| otherwise	= Just (Edge (szK + szL) (take i ks0) Nothing -					(fromListT edgeSize (const const) [(k, Edge szK ks vK tsK), (l, Edge szL ls vL tsL)]))-	match _ (k:ks) [] = compact (edge s ls0 vL $ alterT edgeSize g k tsL) where-		g Nothing = Just (Edge szK ks vK tsK)-		g (Just e) = unionE s (\ ks' -> f (ls0 ++ k:ks')) (Edge szK ks vK tsK) e-	match _ [] (l:ls) = compact (edge s ks0 vK $ alterT edgeSize g l tsK) where-		g Nothing = Just (Edge szL ls vL tsL)-		g (Just e) = unionE s (\ ls' -> f (ks0 ++ l:ls')) e (Edge szL ls vL tsL)-	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 (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 = 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)--- extractMaxE s f (Edge _ ks v ts) = (do--- 		v <- Last v--- 		let (x, v') = f ks v--- 		return (x, compact (edge s ks v' ts))) <|> ---  			(second (compact . edge s ks v) <.> extractMaxT edgeSize g ts)--- 	where	g x = fromJust . getLast . extractMaxE s (\ xs -> f (ks ++ x:xs))---- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->--- 	([f k] -> a -> Maybe (a)) -> Edge' f k a -> MEdge' f k a--- alterMinE s f (Edge _ ks (Just v) ts) = compact (edge s ks (f ks v) ts)--- alterMinE s f (Edge _ ks Nothing ts) = compact (edge s ks Nothing (alterMinT edgeSize (\ x -> alterMinE s (\ xs -> f (ks ++ x:xs))) ts))--- --- alterMaxE s f (Edge _ ks v ts)--- 	| nullT ts	= do	v' <- v >>= f ks--- 				return (Edge (s v') ks (Just v') ts)--- 	| otherwise	= compact (edge s ks v (alterMaxT edgeSize (\ x -> alterMaxE s (\ xs -> f (ks ++ x:xs))) ts))--isectE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized c ->-	IsectFunc (IsectFunc [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)-isectE s f (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where-	match (k:ks) (l:ls)-		| k `eqT` l	= match ks ls-	match (k:ks) [] = do	e' <- lookupT k tsL-				liftM (cat ls . cons k) (isectE s (\ ks' -> f (ls ++ k:ks')) (Edge szK ks vK tsK) e')-	match [] (l:ls) = do	e' <- lookupT l tsK-				liftM (cat ks . cons l) (isectE s (\ ls' -> f (ks ++ l:ls')) e' (Edge szL ls vL tsL))-	match [] [] = compact (edge s ks (isectMaybe (f ks) vK vL) (isectT edgeSize g tsK tsL)) where-		g x = isectE s (\ xs -> f (ks ++ x:xs))--diffE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->-	DiffFunc (DiffFunc [f k] (a) (b)) (Edge' f k a) (Edge' f k b)-diffE s f e@(Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where-	match (k:ks) (l:ls)-		| k `eqT` l	= match ks ls-	match (k:ks) []-		| Just e' <- lookupT k tsL-			= fmap (cat ls . cons k) (diffE s (\ ks' -> f (ls ++ k:ks')) (Edge szK ks vK tsK) e')-	match [] (l:ls) = compact (edge s ks vK (alterT edgeSize (>>= g) l tsK)) where-		g e' = diffE s (\ ls' -> f (ks ++ l:ls')) e' (Edge szL ls vL tsL)-	match [] [] = compact (edge s ks (diffMaybe (f ks) vK vL) (diffT edgeSize g tsK tsL)) where-		g x = diffE s (\ xs -> f (ks ++ x:xs))--isSubEdge :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (Edge' f k a) (Edge' f k b)-isSubEdge (<=) (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where-	match (k:ks) (l:ls)-		| k `eqT` l	= match ks ls-	match (k:ks) []-		| Just e' <- lookupT k tsL-			= isSubEdge (<=) (Edge szK ks vK tsK) e'-	match [] []-		= subMaybe (<=) vK vL && isSubmapT (isSubEdge (<=)) tsK tsL-	match _ _ = False--filterer :: (k -> k -> Bool) -> (a -> a -> a) -> [([k], a)] -> (Maybe a, [(k, [([k], a)])])-filterer (==) f = filterer' where-	filterer' (([], a):xs) = first (Just . maybe a (flip f a)) (filterer' xs)-	filterer' ((k:ks, a):xs) = second (cons k ks a) (filterer' xs)-	filterer' [] = (Nothing, [])-	cons k ks a [] = [(k, [(ks, a)])]-	cons k ks a ys0@((k', xs):ys)-		| k == k'	= (k', (ks,a):xs):ys-		| otherwise	= (k, [(ks, a)]):ys0--fromListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a-fromListE _ _ [] = Nothing-fromListE s f xs = case filterer eqT (f []) xs of-	(Nothing, [(k, xs)]) -> cons k <$> fromListE s (f . (k:)) xs-	(v, xss) -> Just (edge s [] v (mapWithKeyT edgeSize (\ k (K0 xs) -> fromJust (fromListE s (f . (k:)) xs))-				(fromListT (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (ys ++ xs)) [(k, K0 xs) | (k, xs) <- xss])))--fromAscListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => -	Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a-fromAscListE _ _ [] = Nothing-fromAscListE s f xs = case filterer eqT (f []) xs of-	(Nothing, [(k, xs)]) -> cons k <$> fromAscListE s (f . (k:)) xs-	(v, xss) -> Just (edge s [] v (fromDistAscListT edgeSize [(k, fromJust (fromAscListE s (f . (k:)) xs)) | (k, xs) <- xss]))--lookupIxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>-	Sized a -> Int -> [f k] -> Edge' f k a -> IndexPos [f k] a-lookupIxE _ i _ _ | i `seq` False = undefined-lookupIxE s i ks e@(Edge _ ls v ts) = match ks ls where-	match (k:ks) (l:ls) = case compareT k l of-		LT	-> (mzero, mzero, getMin (Asc i) e)-		EQ	-> match ks ls-		GT	-> (getMax (Asc i) e, mzero, mzero)-	match (k:ks) [] = case lookupIxT edgeSize k ts of-		(lb, x, ub) -> let lookupX = do	Asc iK k' e' <- x-						let (lb', x', ub') = lookupIxE s (i + iK) ks e'-						let f = onKeyA ((ls ++) . (k' :))-						return (f <$> lb', f <$> x', f <$> ub')-			in ((do	Asc iL kL eL <- lb-				getMax (\ ksL -> Asc (i + iL) (ls ++ kL:ksL)) eL) <|>-			    (do	(lb', _, _) <- Last lookupX-			    	lb'),-			    (do	(_, x', _) <- lookupX-			    	x'),-			    (do (_, _, ub') <- First lookupX-			    	ub') <|>-			    (do	Asc iR kR eR <- ub-			    	getMin (\ ksR -> Asc (i + iR) (ls ++ kR:ksR)) eR))-	match [] [] = (mzero, Asc i ls <$> v, aboutT-				(\ x -> aboutE (\ xs v' -> return (Asc (i + maybe 0 s v) (ls ++ x:xs) v'))) ts)-	match [] _ = (mzero, mzero, getMin (Asc i) e)-	getMin f = aboutE (return .: f)-	getMax f = aboutE (return .: f)--assocAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>-	Sized a -> Int -> Int -> Edge' f k a -> IndexPos [f k] a-assocAtE s i0 i (Edge _ ks Nothing ts) = case assocAtT edgeSize i ts of-	(lb, x, ub) -> let lookupX = do	Asc i' l e' <- x-					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i') (i - i') e'))-		in ((do	Asc iL lL eL <- lb-			getMax (\ ls -> Asc (i0 + iL) (ks ++ lL:ls)) eL) <|>-		    (do	(lb', _, _) <- Last lookupX-		    	lb'),-		    (do	(_, x', _) <- lookupX-		    	x'),-		    (do	(_, _, ub') <- First lookupX-		    	ub') <|>-		    (do	Asc iR lR eR <- ub-		    	getMin (\ ls -> Asc (i0 + iR) (ks ++ lR:ls)) eR))-	where 	getMin f e = aboutE (return .: f) e-		getMax f e = aboutE (return .: f) e-assocAtE s i0 i (Edge _ ks (Just v) ts)-	| i < sv	= (mzero, return (Asc i ks v), aboutT (\ l -> aboutE (\ ls v' -> return (Asc (i0 + sv) (ks ++ l:ls) v'))) ts)-	| (lb, x, ub) <- assocAtT edgeSize (i - sv) ts-		= let lookupX = do	Asc i' l e' <- x-					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i' + sv) (i - sv - i') e'))-		in ((do	Asc iL lL eL <- lb-			getMax (\ ls -> Asc (i0 + iL + sv) (ks ++ lL:ls)) eL) <|>-		    (do	(lb', _, _) <- Last lookupX-		    	lb'),-		    (do	(_, x', _) <- lookupX-		    	x'),-		    (do	(_, _, ub') <- First lookupX-		    	ub') <|>-		    (do	Asc iR lR eR <- ub-		    	getMin (\ ls -> Asc (i0 + iR + sv) (ks ++ lR:ls)) eR))-	where 	getMin f = aboutE (return .: f)-		getMax f = aboutE (return .: f)-		sv = s v---- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => --- 	Sized a -> ([f k] -> a -> Maybe a) -> Edge' f k a -> MEdge' f k a--- alterMinE s f e = maybe (Just e) snd $ getFirst (extractMinE s (\ k a -> ((), f k a)) e)--- alterMaxE s f e = maybe (Just e) snd $ getLast (extractMaxE s (\ k a -> ((), f k a)) e)---- updateAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>--- 	Sized a -> Round -> (Int -> [f k] -> a -> Maybe (a)) -> Int -> Edge' f k a -> MEdge' f k a--- updateAtE s r f i (Edge sz ks Nothing ts) = compact (edge s ks Nothing (updateAtT edgeSize r g i ts)) where--- 	g iT l e--- 		| not r, i < iT--- 			= alterMinE s (f iT . (ks++) . (l:)) e--- 		| r, i >= iT + edgeSize e--- 			= alterMaxE s (\ ls a -> f (edgeSize e + iT - s a) (ks ++ l:ls) a) e--- 		| otherwise--- 			= updateAtE s r (\ i' ls -> f (i' + iT) (ks ++ l:ls)) (i - iT) e--- updateAtE s r f i (Edge sz ks (Just v) ts)--- 	| i < sv	= compact (edge s ks (f 0 ks v) ts)--- 	| otherwise	= compact (edge s ks (Just v) (updateAtT edgeSize r g i1 ts))--- 	where	sv = s v--- 		i1 = i - sv--- 		g iT l e --- 			| not r, i1 < iT --- 				= alterMinE s (f (iT + sv) . (ks ++) . (l:)) e--- 			| r, i1 >= iT + edgeSize e--- 				= alterMaxE s (\ ls a -> f (iT + sv + edgeSize e + iT - s a) (ks ++ l:ls) a) e--- 			| otherwise--- 				= updateAtE s r (\ i' ls -> f (sv + iT + i') (ks ++ l:ls)) (i - sv - iT) e

@@ -1,41 +0,0 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}--module Data.TrieMap.Regular.RegMap() where--import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base-import Data.TrieMap.TrieKey--import Control.Applicative-import Control.Arrow-import Control.Monad--newtype RegMap k m a = RegMap (m (Reg k) a)--instance (Regular k, Functor (PF k), TrieKeyT (PF k) m, m ~ TrieMapT (PF k)) => TrieKey (Reg k) (RegMap k m) where-	emptyM = RegMap emptyT	-	nullM (RegMap m) = nullT m-	sizeM s (RegMap m) = sizeT s m-	lookupM k (RegMap m) = lookupT (from' k) m-	lookupIxM s k (RegMap m) = onKey to' (lookupIxT s (from' k) m)-	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-	mapEitherM s1 s2 f (RegMap m) = (RegMap *** RegMap) (mapEitherT s1 s2 (f . to') m)-	splitLookupM s f k (RegMap m) = RegMap `sides` splitLookupT s f (from' k) m-	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) = 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)--- 	alterMaxM s f (RegMap m) = RegMap (alterMaxT s (f . to') m)-	isSubmapM (<=) (RegMap m1) (RegMap m2) = isSubmapT (<=) m1 m2-	fromListM s f xs = RegMap (fromListT s (f . to') [(from' k, a) | (k, a) <- xs])-	fromAscListM s f xs = RegMap (fromAscListT s (f . to') [(from' k, a) | (k, a) <- xs])-	fromDistAscListM s xs = RegMap (fromDistAscListT s [(from' k, a) | (k, a) <- xs])

@@ -1,71 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, TypeFamilies, TemplateHaskell #-}--module Data.TrieMap.Regular.Rep where--import Data.TrieMap.Rep-import Data.TrieMap.Rep.TH-import Data.TrieMap.Regular.Base--type instance RepT (K0 a) = K0 (Rep a)-type instance RepT I0 = I0-type instance RepT U0 = U0-type instance RepT (L f) = L (RepT f)-type instance RepT (f :*: g) = RepT f :*: RepT g-type instance RepT (f :+: g) = RepT f :+: RepT g-type instance RepT (f `O` g) = RepT f `O` RepT g--type instance Rep (K0 a b) = RepT (K0 a) b-type instance Rep (I0 a) = I0 (Rep a)-type instance Rep (U0 a) = U0 a-type instance Rep (L f a) = L (RepT f) (Rep a)-type instance Rep ((f :*: g) a) = RepT (f :*: g) (Rep a)-type instance Rep ((f :+: g) a) = RepT (f :+: g) (Rep a)-type instance Rep ((f `O` g) a) = RepT (f `O` g) (Rep a)-type instance Rep (Fix f) = Fix (RepT f)--instance Repr a => ReprT (K0 a) where-	toRepTMap _ (K0 a) = K0 (toRep a)-	fromRepTMap _ (K0 a) = K0 (fromRep a)--instance Repr a => Repr (K0 a b) where-	toRep = toRepT-	fromRep = fromRepT--$(genRepT [d|-   instance ReprT I0 where-	toRepTMap = fmap-	fromRepTMap = fmap |])--instance ReprT U0 where-	toRepTMap _ _ = U0-	fromRepTMap _ _ = U0--instance Repr (U0 a) where-	toRep _ = U0-	fromRep _ = U0--$(genRepT [d|-   instance ReprT f => ReprT (L f) where-	toRepTMap f (List xs) = List (map (toRepTMap f) xs)-	fromRepTMap f (List xs) = List (map (fromRepTMap f) xs) |])--$(genRepT [d|-   instance (ReprT f, ReprT g) => ReprT (f :*: g) where-	toRepTMap f (x :*: y) = toRepTMap f x :*: toRepTMap f y-	fromRepTMap f (x :*: y) = fromRepTMap f x :*: fromRepTMap f y |])--$(genRepT [d|-   instance (ReprT f, ReprT g) => ReprT (f :+: g) where-	toRepTMap f (L a) = L (toRepTMap f a)-	toRepTMap f (R b) = R (toRepTMap f b)-	fromRepTMap f (L a) = L (fromRepTMap f a)-	fromRepTMap f (R b) = R (fromRepTMap f b) |])--$(genRepT [d|-   instance (ReprT f, ReprT g) => ReprT (f `O` g) where-	toRepTMap f (O x) = O (toRepTMap (toRepTMap f) x)-	fromRepTMap f (O x) = O (fromRepTMap (fromRepTMap f) x) |])--instance ReprT f => Repr (Fix f) where-	toRep (In x) = In (toRepTMap toRep x)-	fromRep (In x) = In (fromRepTMap fromRep x)

@@ -1,9 +0,0 @@-{-# LANGUAGE Rank2Types #-}--module Data.TrieMap.Regular.Sized where--import Data.TrieMap.Regular.Base-import Data.TrieMap.Sized--sizeK0 :: Sized (K0 a b)-sizeK0 _ = 1

@@ -1,26 +0,0 @@-{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, QuasiQuotes #-}--module Data.TrieMap.Regular.TH where--import Data.TrieMap.Regular.Class-import Data.TrieMap.TrieKey-import Language.Haskell.TH--deriveM :: Q [Dec] -> Q [Dec]-deriveM decs = do-	iT@(InstanceD cxt inst _:_) <- decs-	let myDecs = zipWith (\ m t -> ValD (VarP m) (NormalB (VarE t)) [])-		['emptyM, 'nullM, 'lookupM, 'lookupIxM, 'assocAtM, 'alterM, 'alterLookupM, 'traverseWithKeyM,-			'foldWithKeyM, 'foldlWithKeyM, 'mapEitherM, 'splitLookupM, 'unionM, 'isectM, 'diffM, 'extractM,-			'isSubmapM, 'fromListM, 'fromAscListM, 'fromDistAscListM]-		['emptyT, 'nullT, 'lookupT, 'lookupIxT, 'assocAtT, 'alterT, 'alterLookupT, 'traverseWithKeyT,-			'foldWithKeyT, 'foldlWithKeyT, 'mapEitherT, 'splitLookupT, 'unionT, 'isectT, 'diffT, 'extractT,-			'isSubmapT, 'fromListT, 'fromAscListT, 'fromDistAscListT]-	k <- mkVar "k"-	let triekey = ConT ''TrieKey-	let triemap = ConT ''TrieMap-	let ordT = ConT ''Ord-	return [InstanceD cxt inst myDecs]--mkVar :: String -> TypeQ-mkVar x = varT =<< newName x

@@ -1,119 +0,0 @@-{-# LANGUAGE PatternGuards, FlexibleInstances, TemplateHaskell, TypeOperators, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}--module Data.TrieMap.Regular.UnionMap() where--import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.Base--- 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.Monad---- import Data.Either--- import Data.Monoid---- import Generics.MultiRec.Base-data UnionMap m1 m2 k a = m1 k a :&: m2 k a--type instance TrieMapT (f :+: g) = UnionMap (TrieMapT f) (TrieMapT g)-type instance TrieMap ((f :+: g) r) = TrieMapT (f :+: g) r---- type instance RepT (UnionMap m1 m2 k) = RepT (m1 k) :*: RepT (m2 k)--- type instance Rep (UnionMap f g k a) = RepT (UnionMap f g k) (Rep a)--- --- -- $(genRepT [d|---    instance (ReprT (m1 k), ReprT (m2 k)) => ReprT (UnionMap m1 m2 k) where--- 	toRepT (m1 :&: m2) = toRepT m1 :*: toRepT m2--- 	fromRepT (m1 :*: m2) = fromRepT m1 :&: fromRepT m2 |])--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-	lookupT k (m1 :&: m2) = case k of-		L k -> lookupT k m1-		R k -> lookupT k m2-	lookupIxT s k (m1 :&: m2) = case k of-		L k | (lb, x, ub) <- onKey L (lookupIxT s k m1)-			-> (lb, x, ub <|> fmap (onKeyA R . onIndexA (sizeT s m1 +)) (getMin m2))-		R k | (lb, x, ub) <- onIndex (sizeT s m1 +) (onKey R (lookupIxT s k m2))-			-> (fmap (onKeyA L) (getMax m1) <|> lb, x, ub)-		where	getMin = aboutT (return .: Asc 0)-			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m-	assocAtT s i (m1 :&: m2)-		| i < s1	= onKey L (assocAtT s i m1)-		| otherwise	= onKey R (onIndex (s1 +) (assocAtT s (i - s1) m2))-		where s1 = sizeT s m1-{-	updateAtT s r f i (m1 :&: m2)-		| not r, i >= maxIx m1-				= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2-		| i < s1	= updateAtT s r (\ i' -> f i' . L) i m1 :&: m2-		| otherwise	= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2-		where 	s1 = sizeT s m1-			maxIx m = maybe (sizeT s m) fst $ getLast (extractMaxT s (\ _ v -> (sizeT s m - s v, Just v)) m)-}-	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-	mapEitherT s1 s2 f (m1 :&: m2) = case (mapEitherT s1 s2 (f . L) m1, mapEitherT s1 s2 (f . R) m2) of-		((m1L, m1R), (m2L, m2R)) -> (m1L :&: m2L, m1R :&: m2R)-	splitLookupT s f k (m1 :&: m2) = case k of-		L k -> case splitLookupT s f k m1 of-			(m1L, ans, m1R) -> (m1L :&: emptyT, ans, m1R :&: m2)-		R k -> case splitLookupT s f k m2 of-			(m2L, ans, m2R) -> (m1 :&: m2L, ans, emptyT :&: m2R)-	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) = 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 <|>--- 		second (m1 :&:) <$> extractMaxT s (f . R) m2--- 	alterMinT s f (m1 :&: m2)--- 		| nullT m1	= m1 :&: alterMinT s (f . R) m2--- 		| otherwise	= alterMinT s (f . L) m1 :&: m2--- 	alterMaxT s f (m1 :&: m2)--- 		| nullT m2	= alterMaxT s (f . L) m1 :&: m2--- 		| otherwise	= m1 :&: alterMaxT s (f . R) m2-	isSubmapT (<=) (m11 :&: m12) (m21 :&: m22) = isSubmapT (<=) m11 m21 && isSubmapT (<=) m12 m22-	fromListT s f xs = case partEithers xs of-		(ys, zs) -> fromListT s (f . L) ys :&: fromListT s (f . R) zs-	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

@@ -1,90 +0,0 @@-{-# LANGUAGE UndecidableInstances, TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-}--module Data.TrieMap.Regular.UnitMap() where--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.Applicative--import Control.Applicative-import Control.Arrow-import Control.Monad--import Data.Foldable-import Data.Maybe-import Data.Monoid-import Data.Traversable--import Prelude hiding (foldr, foldl)--newtype M k a = M (Maybe a)-type instance TrieMapT U0 = M-type instance TrieMap (U0 r) = M r--instance TrieKey (U0 r) (M r) where-	emptyM = M Nothing-	nullM (M a) = isNothing a-	sizeM s (M a) = maybe 0 s a-	lookupM _ (M a) = a-	lookupIxM s _ (M a) = (mzero, Asc 0 U0 <$> a, mzero)-	assocAtM s i (M a)-		| i < 0	= (mzero, mzero, Asc 0 U0 <$> First a)-		| i > maybe 0 s a-			= (Asc 0 U0 <$> Last a, mzero, mzero)-		| otherwise-			= (mzero, Asc 0 U0 <$> a, mzero)--- 	updateAtM s r f i (M v) = case v of--- 		Just a	| not r && i <= 0	-> M (v >>= f 0 U0)--- 			| 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-	mapEitherM _ _ f (M Nothing) = (M Nothing, M Nothing)-	mapEitherM _ _ f (M (Just a)) = (M *** M) (f U0 a)-	splitLookupM _ f _ (M a) = M `sides` maybe (Nothing, Nothing, Nothing) f a-	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 (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)--- 	alterMaxM = alterMinM-	isSubmapM (<=) (M a) (M b) = subMaybe (<=) a b-	fromListM _ f = M . foldr (\ (_, a) -> Just . maybe a (f U0 a)) Nothing-	fromDistAscListM _ = M . fmap snd . listToMaybe--instance TrieKeyT U0 M where-	emptyT = emptyM-	nullT = nullM-	sizeT = sizeM-	lookupT = lookupM-	lookupIxT = lookupIxM-	assocAtT = assocAtM--- 	updateAtT = updateAtM-	alterT = alterM-	alterLookupT = alterLookupM-	traverseWithKeyT = traverseWithKeyM-	foldWithKeyT = foldWithKeyM-	foldlWithKeyT = foldlWithKeyM-	mapEitherT = mapEitherM-	splitLookupT = splitLookupM-	unionT = unionM-	isectT = isectM-	diffT = diffM-	extractT = extractM--- 	extractMinT = extractMinM--- 	extractMaxT = extractMaxM--- 	alterMinT = alterMinM--- 	alterMaxT = alterMaxM-	isSubmapT = isSubmapM-	fromListT = fromListM-	fromAscListT = fromAscListM-	fromDistAscListT = fromDistAscListM

@@ -2,14 +2,13 @@  module Data.TrieMap.Rep where -type family Rep a-type family RepT (f :: * -> *) :: * -> *- class Repr a where+	type Rep a 	toRep :: a -> Rep a 	fromRep :: Rep a -> a  class Functor (RepT f) => ReprT f where+	type RepT f :: * -> * 	toRepT :: f a -> RepT f a 	fromRepT :: RepT f a -> f a 	toRepTMap :: (a -> b) -> f a -> RepT f b

@@ -1,28 +1,23 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, TypeOperators, TemplateHaskell, NPlusKPatterns #-}+{-# LANGUAGE RankNTypes, FlexibleContexts, UndecidableInstances, TypeFamilies, TypeOperators, TemplateHaskell, NPlusKPatterns #-}+{-# OPTIONS -funbox-strict-fields #-}  module Data.TrieMap.Rep.Instances()  where  import Data.TrieMap.Rep import Data.TrieMap.Rep.TH-import Data.TrieMap.Regular.Base--- import Data.TrieMap.OrdMap import Data.TrieMap.Modifiers--- import Language.Haskell.TH -import Control.Arrow- import Data.Char import Data.Int import Data.Word 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 -import Data.Sequence (Seq, (|>))+import Data.Sequence ((|>)) import qualified Data.Sequence as Seq import qualified Data.Foldable as Fold @@ -34,132 +29,87 @@ type Pair a = (,) a type Sum a = Either a -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 (Left ()) (Right . f)-	fromRepTMap f = either (const Nothing) (Just . f) |])+instance ReprT Rev where+  type RepT Rev = Rev+  toRepTMap = fmap+  fromRepTMap = fmap -type instance RepT [] = []-type instance Rep [a] = [Rep a]+genRepr [t| Rev |] -$(genRepT [d| -   instance ReprT [] where+instance ReprT [] where+	type RepT [] = [] 	toRepTMap = map-	fromRepTMap = map |])--type instance RepT ((,) a) = Pair (Rep a)-type instance Rep (a, b) = RepT ((,) a) (Rep b)--$(genRepT [d|-    instance Repr a => ReprT ((,) a) where-	toRepTMap f = toRep *** f-	fromRepTMap f = fromRep *** f |])---- instance (ReprT ((,) a), Repr b) => Repr ((,) a b) where---- instance (Repr a, Repr b) => Repr (a, b) where--- 	toRep = fmap toRep . toRepT--- 	fromRep = fromRepT . fmap fromRep--type instance RepT ((,,) a b) = K0 (Rep a) :*: K0 (Rep b) :*: I0-type instance Rep (a, b, c) = RepT ((,,) a b) (Rep c)--$(genRepT [d|-   instance (Repr a, Repr b) => ReprT ((,,) a b) where-	toRepTMap f (a, b, c) = K0 (toRep a) :*: K0 (toRep b) :*: I0 (f c)-	fromRepTMap f (K0 a :*: K0 b :*: I0 c) = (fromRep a, fromRep b, f c) |])--type instance RepT ((,,,) a b c) = K0 (Rep a) :*: K0 (Rep b) :*: K0 (Rep c) :*: I0-type instance Rep (a, b, c, d) = RepT ((,,,) a b c) (Rep d)--$(genRepT [d|-   instance (Repr a, Repr b, Repr c) => ReprT ((,,,) a b c) where-	toRepTMap f (a, b, c, d) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: I0 (f d)-	fromRepTMap f (K0 a :*: K0 b :*: K0 c :*: I0 d) = (fromRep a, fromRep b, fromRep c, f d) |])+	fromRepTMap = map -type instance RepT (Either a) = Sum (Rep a)-type instance Rep (Either a b) = RepT (Either a) (Rep b)+genRepr [t| [] |] -$(genRepT [d|-  instance Repr a => ReprT (Either a) where-	toRepTMap f = either (Left . toRep) (Right . f)-	fromRepTMap f = either (Left . fromRep) (Right . f) |])+genTupleRepr 2+genTupleRepr 3+genTupleRepr 4+genTupleRepr 5+genTupleRepr 6+genTupleRepr 7+genTupleRepr 8 -type instance Rep Bool = Sum () ()-instance Repr Bool where-	toRep False = Left ()-	toRep True = Right ()-	fromRep = either (const False) (const True)+instance (Repr a, Repr b) => Repr (Either a b) where+  type Rep (Either a b) = Either (Rep a) (Rep b)+  toRep (Left a) = Left (toRep a)+  toRep (Right b) = Right (toRep b)+  fromRep (Left a) = Left (fromRep a)+  fromRep (Right b) = Right (fromRep b) -type instance Rep Char = Word32 instance Repr Char where+	type Rep Char = Word32 	toRep = fromIntegral . ord 	fromRep = chr . fromIntegral -type instance Rep () = () instance Repr () where+	type Rep () = () 	toRep _ = () 	fromRep _ = () -type instance Rep Double = Ordered Double-instance Repr Double where-	toRep = Ord-	fromRep = unOrd--type instance Rep Int = Rep Int32 instance Repr Int where+	type Rep Int = Rep Int32 	toRep = toSigned 	fromRep = fromSigned -type instance Rep Word8 = Word32 instance Repr Word8 where+	type Rep Word8 = Word32 	toRep = fromIntegral 	fromRep = fromIntegral -type instance Rep Word16 = Word32 instance Repr Word16 where+	type Rep Word16 = Word32 	toRep = fromIntegral 	fromRep = fromIntegral -type instance Rep Word = Word32 instance Repr Word where+	type Rep Word = Word32 	toRep = fromIntegral 	fromRep = fromIntegral -type instance Rep Int8 = Rep Int32- instance Repr Int8 where+	type Rep Int8 = Rep Int32 	toRep = toSigned 	fromRep = fromSigned -type instance Rep Int16 = Rep Int32 instance Repr Int16 where+	type Rep Int16 = Rep Int32 	toRep = toSigned 	fromRep = fromSigned -type instance Rep Int32 = Sum (Rev Word32) Word32 instance Repr Int32 where+	type Rep Int32 = Sum (Rev Word32) Word32 	toRep = toSigned 	fromRep = fromSigned -type instance Rep Word64 = Pair Word32 Word32 instance Repr Word64 where+	type Rep Word64 = Pair Word32 Word32 	toRep x = (fromIntegral (x `shiftR` 32), fromIntegral x) 	fromRep (x, y) = fromIntegral x `shiftL` 32 .|. fromIntegral y -type instance Rep Int64 = Sum (Rev (Rep Word64)) (Rep Word64) instance Repr Int64 where+	type Rep Int64 = Sum (Rev (Rep Word64)) (Rep Word64) 	toRep x | x < 0	= Left (Rev (toRep' (fromIntegral (-x)))) 		| otherwise = Right (toRep' (fromIntegral x)) 		where toRep' = toRep :: Word64 -> Rep Word64@@ -176,27 +126,25 @@ fromSigned :: Integral a => Sum (Rev Word32) Word32 -> a fromSigned = either (\ (Rev x) -> - fromIntegral x) fromIntegral -type instance Rep Word32 = Word32 instance Repr Word32 where+	type Rep Word32 = Word32 	toRep = id 	fromRep = id -type instance Rep ByteString = ([] :*: I0) Word32 instance Repr ByteString where-	toRep xs = toList64 xs :*: I0 (fromIntegral (length xs))-	fromRep (xs :*: I0 n) = case xs of+	type Rep ByteString = ([Word32], Word32)+	toRep xs = (toList64 xs, fromIntegral (length xs))+	fromRep (xs, n) = case xs of 		[]	-> BS.empty 		(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 [Word32]+data Words = Words !Int !Word32+data Words' = W !Words [Word32]  toList64 :: ByteString -> [Word32]-toList64 xs = case BS.foldl c (Words 4 0, Seq.empty) xs of-	(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+toList64 xs = case BS.foldl' c (Words 4 0, Seq.empty) xs of+	(Words _ w32, ys) -> toList ys ++ [w32]+	where	(Words 0 w, xs) `c` w8 			= (Words 3 (w .|. sL w8 24), xs |> w) 		(Words i' w, xs) `c` w8 			= let !i = i' - 1 in (Words i (w .|. sL w8 (8 * i)), xs)@@ -210,58 +158,31 @@ 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))-type instance Rep (Array i e) = RepT (Array i) (Rep e)--$(genRepT [d| -   instance (Repr i, Ix i) => ReprT (Array i) where-	toRepTMap f arr = List [(toRep i, f a) | (i, a) <- assocs arr] :*: K0 (toRep l, toRep u)-		where (l, u) = bounds arr-	fromRepTMap f (List xs :*: K0 (l, r))-		= array (fromRep l, fromRep r) [(fromRep k, f a) | (k, a) <- xs] |])--type instance RepT Set.Set = []-type instance RepT (Map.Map k) = L (Pair (Rep k))-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 = Fold.foldr ((:) . f) [] s-	fromRepTMap f xs = Set.fromDistinctAscList [f x | x <- xs] |])--$(genRepT [d|-   instance Repr k => ReprT (Map.Map k) where-	toRepTMap f m = List (Map.foldWithKey (\ k a xs -> (toRep k, f a):xs) [] m)-	fromRepTMap f (List xs) = Map.fromDistinctAscList [(fromRep k, f x) | (k, x) <- xs] |])--type instance RepT Rev = Rev-type instance Rep (Rev a) = Rev (Rep a)+instance ReprT Set.Set where+  type RepT Set.Set = []+  toRepTMap f s = Fold.foldr ((:) . f) [] s+  fromRepTMap f xs = Set.fromDistinctAscList [f x | x <- xs]  --- -- $(genRepT [d|---    instance ReprT Rev where---    	toRepTMap f (Rev m) = Rev (f m)--- 	fromRepTMap f (Rev m) = Rev (f m) |])+genRepr [t| Set.Set |] -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 k, Repr a) => Repr (Map.Map k a) where+  type Rep (Map.Map k a) = [(Rep k, Rep a)]+  toRep m = [(toRep k, toRep a) | (k, a) <- Map.assocs m]+  fromRep xs = Map.fromDistinctAscList [(fromRep k, fromRep a) | (k, a) <- xs]  instance Repr ISet.IntSet where-	toRep = toRep . ISet.toList-	fromRep = ISet.fromDistinctAscList . fromRep---type instance RepT Seq.Seq = []-type instance Rep (Seq.Seq a) = [Rep a]---- type instance Rep (Rev a) = Rev (Rep a)+  type Rep ISet.IntSet = Rep [Int]+  toRep = toRep . ISet.toList+  fromRep = ISet.fromDistinctAscList . fromRep -$(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 Repr a => Repr (IMap.IntMap a) where+  type Rep (IMap.IntMap a) = [(Rep Int, Rep a)]+  toRep m = [(toRep i, toRep a) | (i, a) <- IMap.assocs m]+  fromRep xs = IMap.fromDistinctAscList [(fromRep i, fromRep a) | (i, a) <- xs] +instance ReprT Seq.Seq where+  type RepT Seq.Seq = []+  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)+genRepr [t| Seq.Seq |]

@@ -1,50 +1,38 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes, UndecidableInstances #-} -module Data.TrieMap.Rep.TH (genRepT, mkCon, conT, mkVar, appT, Type(..)) where+module Data.TrieMap.Rep.TH where  import Language.Haskell.TH import Data.TrieMap.Rep--- import Language.Haskell.TH.Ppr--- import Debug.Trace-{--genRepT ::  TypeQ -> Q [Dec]-genRepT ff = do-	f <- ff-	a <- newName "a"-	b <- newName "b"-	g <- newName "g"-	let reprt = ConT (mkName "ReprT")-	let repr = ConT (mkName "Repr")-	let rept = ConT (mkName "RepT")-	let rep = ConT (mkName "Rep")-	torep <- [| fmap toRep . toRepT |]-	fromrep <- [| fromRepT . fmap fromRep |]-	let toRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)]-		(AppT (VarT g) (VarT b) ~> AppT (AppT rept (VarT g)) (AppT rep (VarT b)))-	let fromRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)] -		(AppT (AppT rept (VarT g)) (AppT rep (VarT b)) ~> AppT (VarT g) (VarT b))-	let ans = [InstanceD [AppT reprt f, AppT repr (VarT a)] (AppT repr (AppT f (VarT a)))-		[FunD (mkName "toRep") [Clause [] (NormalB ( torep )) []],-			FunD (mkName "fromRep") [Clause [] (NormalB ( fromrep )) []]]]-	return ans-} -genRepT :: Q [Dec] -> Q [Dec]-genRepT decs = do-	iT@(InstanceD cxt (reprt `AppT` f) _:_) <- decs-	let myDecs = [ValD (VarP 'toRep) (NormalB (AppE (VarE 'toRepTMap) (VarE 'toRep))) [],-		ValD (VarP 'fromRep) (NormalB (AppE (VarE 'fromRepTMap) (VarE 'fromRep))) []]-	a <- mkVar "a"-	return (InstanceD (ClassP ''Repr [a]:cxt) (ConT ''Repr `AppT` (f `AppT` a)) myDecs :iT)--(~>) :: Type -> Type -> Type-a ~> b = AppT (AppT ArrowT a) b--mkCon :: String -> TypeQ-mkCon = conT . mkName--mkVar :: String -> TypeQ-mkVar x = varT =<< newName x+genRepr :: Q Type -> Q [Dec]+genRepr typ = do+  t <- typ+  let a = VarT (mkName "a")+  toRepImpl <- [| toRepTMap toRep |]+  fromRepImpl <- [| fromRepTMap fromRep |]+  return [InstanceD [ClassP ''Repr [a]]+		(ConT ''Repr `AppT` (t `AppT` a))+		[TySynInstD ''Rep [t `AppT` a] ((ConT ''RepT `AppT` t) `AppT` (ConT ''Rep `AppT` a)),+			ValD (VarP 'toRep)+				(NormalB toRepImpl) [],+			ValD (VarP 'fromRep)+				(NormalB fromRepImpl) []]] --- f :: Q [Dec]--- f = do	ans <- [d| instance (ReprT ((,) a), Repr b) => Repr (a, b) where |]--- 	traceShow ans $ return ans+genTupleRepr :: Int -> Q [Dec]+genTupleRepr n = do+  let ts = [mkName [a] | a <- take n ['a'..]]+  xs <- sequence [newName [a] | a <- take n ['a'..]]+  xReps <- sequence [newName (a:"Rep") | a <- take n ['a'..]]+  let toR = 'toRep+  let fromR = 'fromRep+  let tupleT = foldl AppT (TupleT n) [VarT t | t <- ts]+  return [InstanceD [ClassP ''Repr [VarT t] | t <- ts]+    (ConT ''Repr `AppT` tupleT)+    [TySynInstD ''Rep [tupleT] (foldl AppT (TupleT n) [ConT ''Rep `AppT` VarT t | t <- ts]),+	FunD toR+	  [Clause [TupP [VarP x | x <- xs]]+	    (NormalB (TupE [VarE toR `AppE` VarE x |  x <- xs])) []],+	FunD fromR+	  [Clause [TupP [VarP xRep | xRep <- xReps]]+	    (NormalB (TupE [VarE fromR `AppE` VarE xRep | xRep <- xReps])) []]]]

@@ -1,14 +1,42 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}-module Data.TrieMap.Representation (Repr(..), ReprT(..), Rep, RepT) where+{-# LANGUAGE TypeFamilies, TemplateHaskell, UndecidableInstances #-}+module Data.TrieMap.Representation (Repr(..)) where +import Data.TrieMap.Sized+import Data.TrieMap.TrieKey+import Data.TrieMap.Class import Data.TrieMap.Rep-import Data.TrieMap.Rep.Instances-import Data.TrieMap.Rep.TH-import Data.TrieMap.Regular.Rep-import Data.TrieMap.Regular.Base-import qualified Data.IntMap as IMap+import Data.TrieMap.Rep.Instances ()+import Data.TrieMap.Representation.TH -$(genRepT [d|-   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] |])+import Data.Complex+import Data.Tree+import Data.Ratio+import Foreign.C.Types++instance (TKey k, Repr a) => Repr (TMap k a) where+	type Rep (TMap k a) = [(Rep k, Rep a)]+	toRep (TMap m) = foldWithKeyM (\ k (Elem a) xs -> (k, toRep a):xs) m []+	fromRep xs = TMap (fromDistAscListM (const 1) [(k, Elem (fromRep a)) | (k, a) <- xs])++genOrdRepr ''Float+genOrdRepr ''Double+genRepr ''Bool+genRepr ''Tree+genRepr ''Ratio+genRepr ''Maybe+genRepr ''Complex+genRepr ''CInt+genRepr ''CChar+genRepr ''CSChar+genRepr ''CUChar+genRepr ''CShort+genRepr ''CUShort+genRepr ''CUInt+genRepr ''CLong+genRepr ''CULong+genRepr ''CLLong+genRepr ''CULLong+genRepr ''CClock+genRepr ''CTime+genRepr ''CFloat+genRepr ''CDouble

@@ -1,16 +1,12 @@ {-# LANGUAGE TemplateHaskell, QuasiQuotes, PatternGuards, DoAndIfThenElse #-} -module Data.TrieMap.Representation.TH (genRepr) where+module Data.TrieMap.Representation.TH (genRepr, genOrdRepr) where -import Data.TrieMap.Rep.TH+import Data.TrieMap.Modifiers import Data.TrieMap.Rep-import Data.TrieMap.Regular.Base-import Data.TrieMap.Key-import Data.TrieMap.Rep.Instances+import Data.TrieMap.Rep.Instances () import Language.Haskell.TH import Language.Haskell.TH.ExpandSyns-import Control.Arrow-import Control.Monad  data ToRepCase = ToRepCase [Pat] Exp data FromRepCase = FromRepCase Pat [Exp]@@ -19,28 +15,56 @@  type Representation = (Type, ToRep, FromRep) --- | Given the name of a type constructor, automatically generates an efficient 'Repr' instance.  /Warning/: Generalized tries do not work for "infinitely complicated types," for example, a type-system construction of the natural numbers.--- In these cases, a context reduction stack overflow will occur at compile time when you use the 'TKey' instance for that type.+-- | Given a type with an associated 'Ord' instance, generates a representation that will cause its 'TMap'+-- implementation to be essentially equivalent to "Data.Map".+genOrdRepr :: Name -> Q [Dec]+genOrdRepr tycon = do+	TyConI dec <- reify tycon+	let theTyp = foldl AppT (ConT tycon) . map tyVarBndrType+	case dec of+		DataD cxt _ tyvars _ _ -> do+			repr <- ordRepr (theTyp tyvars)+			return (decsForRepr cxt (theTyp tyvars) repr)+		NewtypeD cxt _ tyvars _ _ -> do+			repr <- ordRepr (theTyp tyvars)+			return (decsForRepr cxt (theTyp tyvars) repr)+		_	-> fail ("Cannot generate Repr instance for " ++ pprint dec)++ordRepr :: Type -> Q Representation+ordRepr t0 = do+	x <- newName "x"+	return (ConT ''Ordered `AppT` t0, +			[ToRepCase [VarP x] (ConE 'Ord `AppE` VarE x)],+			[FromRepCase (ConP 'Ord [VarP x])+				[VarE x]])+	++-- | Given the name of a type constructor, automatically generates an efficient 'Repr' instance.  +-- /Warning/: Generalized tries do not work for "infinitely complicated types," for example, a+-- type-system construction of the natural numbers.  In these cases, a context reduction stack+-- overflow will occur at compile time when you use the 'TKey' instance for that type. genRepr :: Name -> Q [Dec] genRepr tycon = do 	TyConI dec <- reify tycon+	let theTyp = foldl AppT (ConT tycon) . map tyVarBndrType 	case dec of-		DataD _ _ tyvars cons _ -> do+		DataD cxt _ tyvars cons _ -> do 			conReprs <- mapM conRepr cons-			return (decsForRepr (foldl AppT (ConT tycon) (map tyVarBndrType tyvars)) (foldr1 union conReprs))-		NewtypeD _ _ tyvars con _ -> do+			return (decsForRepr cxt (theTyp tyvars) (foldr1 union conReprs))+		NewtypeD cxt _ tyvars con _ -> do 			theConRepr <- conRepr con-			return (decsForRepr (foldl AppT (ConT tycon) (map tyVarBndrType tyvars)) theConRepr)+			return (decsForRepr cxt (theTyp tyvars) theConRepr)+		_	-> fail ("Cannot generate Repr instance for " ++ pprint dec)  tyVarBndrType :: TyVarBndr -> Type tyVarBndrType (PlainTV tyvar) = VarT tyvar tyVarBndrType (KindedTV tyvar _) = VarT tyvar -decsForRepr :: Type -> Representation -> [Dec]-decsForRepr t (tRep, toR, fromR) = [-		TySynInstD ''Rep [t] tRep,-		InstanceD [] (ConT ''Repr `AppT` t)-			[FunD 'toRep+decsForRepr :: Cxt -> Type -> Representation -> [Dec]+decsForRepr cxt t (tRep, toR, fromR) = [+		InstanceD cxt (ConT ''Repr `AppT` t)+			[TySynInstD ''Rep [t] tRep,+			 FunD 'toRep 				[Clause pats (NormalB e) [] | ToRepCase pats e <- toR], 			 FunD 'fromRep 				[Clause [pat] (NormalB e) [] | FromRepCase pat [e] <- fromR]]]@@ -59,6 +83,7 @@ conRepr (NormalC con args) = do 	argCons <- mapM (typeRepr . snd) args 	return (conify con (foldr1 prod argCons))+conRepr con = fail ("Cannot generate representation for existential constructor " ++ pprint con)  typeRepr :: Type -> ReprM Representation typeRepr t00 = expandSyns t00 >>= \ t0 -> case decompose t0 of@@ -76,7 +101,7 @@ 				[CompE [BindS (VarP xRep) (VarE xsRep), 					NoBindS (CaseE (VarE xRep) [Match pat (NormalB e) [] | FromRepCase pat [e] <- fromR])]]]) 	(TupleT 0, _)	-> return unit-	(TupleT n, ts)	-> do+	(TupleT _, ts)	-> do 		reps <- mapM typeRepr ts 		let (tRep, toR, fromR) = foldr1 prod reps 		return (tRep, [ToRepCase [TupP pats] e | ToRepCase pats e <- toR], [FromRepCase pat [TupE es] | FromRepCase pat es <- fromR])@@ -90,16 +115,9 @@ 						[ToRepCase [ConP 'Right pats] (ConE 'Right `AppE` e) | ToRepCase pats e <- rToR], 					[FromRepCase (ConP 'Left [pat]) [ConE 'Left `AppE` e] | FromRepCase pat [e] <- lFromR] ++ 						[FromRepCase (ConP 'Right [pat]) [ConE 'Right `AppE` e] | FromRepCase pat [e] <- rFromR])-		| con == ''Maybe, [t] <- ts-			-> do	(tRep, toR, fromR) <- typeRepr t-				return (ConT ''Either `AppT` TupleT 0 `AppT` tRep,-					[ToRepCase [ConP 'Nothing []] (ConE 'Left `AppE` TupE [])] ++-						[ToRepCase [ConP 'Just pats] (ConE 'Right `AppE` e) | ToRepCase pats e <- toR],-					[FromRepCase (RecP 'Left []) [ConE 'Nothing]] ++-						[FromRepCase (ConP 'Right [pat]) [ConE 'Just `AppE` e] | FromRepCase pat [e] <- fromR])-		| otherwise -> do-					ClassI _ instances <- reify ''Repr+		| otherwise -> do	ClassI _ instances <- reify ''Repr 					let knowns = [tycon | ClassInstance{ci_tys = [ConT tycon]} <- instances]+					-- TODO: recognize preexisting higher-arity instances 					if con `elem` knowns && null ts then do 						arg <- newName "arg" 						argRep <- newName "argRep"@@ -109,10 +127,6 @@ 					else recursiveRepr t0 	_	-> recursiveRepr t0 -tyVarBndrName :: TyVarBndr -> Name-tyVarBndrName (PlainTV n) = n-tyVarBndrName (KindedTV n _) = n- recursiveRepr :: Type -> ReprM Representation recursiveRepr t0 = do	-- TODO: handle type synonyms here 		x <- newName "arg"@@ -136,7 +150,8 @@  conify :: Name -> Representation -> Representation conify conName (t, toR, fromR) =-	(t, [ToRepCase [ConP conName args] e | ToRepCase args e <- toR], [FromRepCase p [foldl AppE (ConE conName) outs] | FromRepCase p outs <- fromR])+	(t, [ToRepCase [ConP conName args] e | ToRepCase args e <- toR], +		[FromRepCase p [foldl AppE (ConE conName) outs] | FromRepCase p outs <- fromR])  union :: Representation -> Representation -> Representation union (t1, toRep1, fromRep1)@@ -146,6 +161,3 @@ 		[ToRepCase pats (ConE 'Right `AppE` e) | ToRepCase pats e <- toRep2], 		[FromRepCase (ConP 'Left [pat]) es | FromRepCase pat es <- fromRep1] ++ 		[FromRepCase (ConP 'Right [pat]) es | FromRepCase pat es <- fromRep2])---- genRepInstance :: Type -> Representationesentation -> Q Dec--- genInstance

@@ -1,85 +1,41 @@-{-# LANGUAGE TemplateHaskell, UndecidableInstances, TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE UnboxedTuples, TypeFamilies #-}  module Data.TrieMap.ReverseMap (reverse, unreverse) where  import Data.TrieMap.TrieKey import Data.TrieMap.Modifiers import Data.TrieMap.Applicative-import Data.TrieMap.Regular.Class-import Data.TrieMap.Regular.TH  import Control.Applicative-import Control.Arrow -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--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-	lookupT (Rev k) (RMap m) = lookupM k m-	lookupIxT s (Rev k) (RMap m) = case lookupIxM s k m of-		(Last lb, x, First ub) -> onKey Rev (onIndex (sizeM s m - 1 -) (Last ub, x, First lb))-	assocAtT s i (RMap m) = case assocAtM s (sz - 1 - i) m of-		(Last lb, x, First ub) -> onKey Rev (onIndex (sz -) (Last ub, x, First lb))-		where 	sz = sizeM s m--- 	updateAtM s r f i (RMap m) = RMap (updateAtM s r' f' (sz - i) m) where--- 		r' = not r--- 		f' i = f (sz - 1 - i) . Rev--- 		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)+instance TrieKey k => TrieKey (Rev k) where+	newtype TrieMap (Rev k) a = RMap (TrieMap k a)+	emptyM = RMap emptyM+	singletonM s (Rev k) a = RMap (singletonM s k a)+	nullM (RMap m) = nullM m+	sizeM s (RMap m) = sizeM s m+	lookupM (Rev k) (RMap m) = lookupM k m+	traverseWithKeyM s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m)+	alterM s f (Rev k) (RMap m) = RMap (alterM s f k m)+	alterLookupM s f (Rev k) (RMap m) = onUnboxed RMap (alterLookupM s f k) m+	splitLookupM s f (Rev k) (RMap m) = sides RMap (splitLookupM s f' k) m 		where f' x = case f x of-			(xL, ans, xR) -> (xR, ans, xL)-	mapEitherT s1 s2 f (RMap m) = (RMap *** RMap) (mapEitherM s1 s2 (f . Rev) m)-	foldWithKeyT f (RMap m) = foldlWithKeyM (flip . f . Rev) m-	foldlWithKeyT f (RMap m) = foldWithKeyM (flip . f . Rev) m-	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) = 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])+			(# xL, ans, xR #) -> (# xR, ans, xL #)+	mapMaybeM s f (RMap m) = RMap (mapMaybeM s (f . Rev) m)+	mapEitherM s1 s2 f (RMap m) = both RMap RMap (mapEitherM s1 s2 (f . Rev)) m+	foldWithKeyM f (RMap m) = foldlWithKeyM (flip . f . Rev) m+	foldlWithKeyM f (RMap m) = foldWithKeyM (flip . f . Rev) m+	unionM s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2)+	isectM s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2)+	diffM s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2)+	extractM s f (RMap m) = fmap RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m)+	isSubmapM (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2+	fromListM s f xs = RMap (fromListM s (f . Rev) [(k, a) | (Rev k, a) <- xs])+	fromAscListM s f xs = RMap (fromAscListM s (\ k -> flip (f (Rev k))) [(k, a) | (Rev k, a) <- L.reverse xs])+	fromDistAscListM s xs = RMap (fromDistAscListM s [(k, a) | (Rev k, a) <- L.reverse xs])  reverse :: TrieMap k a -> TrieMap (Rev k) a reverse = RMap

@@ -1,48 +1,29 @@-{-# LANGUAGE PatternGuards, Rank2Types, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, KindSignatures #-}+{-# LANGUAGE TupleSections, TypeFamilies, UnboxedTuples #-}  module Data.TrieMap.TrieKey where  import Data.TrieMap.Applicative import Data.TrieMap.Sized-import Data.TrieMap.CPair  import Control.Applicative import Control.Arrow  import Data.Monoid-import Data.List -type family TrieMap k :: * -> *---- type family MapPF (m :: (* -> *) -> * -> *) ix :: (* -> *) -> *--- data Fixer f--type EitherMap k a b c = k -> a -> (Maybe b, Maybe c)-type SplitMap a x = a -> (Maybe a, Maybe x, Maybe a)+type EitherMap k a b c = k -> a -> (# Maybe b, Maybe c #)+type SplitMap a x = a -> (# Maybe a, Maybe x, Maybe a #) 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 (CPair x (Maybe a))) -> m -> f (CPair x m)+type ExtractFunc f m k a x = (k -> a -> f (x, Maybe a)) -> m -> f (x, m) type LEq a b = a -> b -> Bool  data Assoc k a = Asc {-# UNPACK #-} !Int k a--- data IndexPos k a = Between {-# UNPACK #-} !(Assoc k a) {-# UNPACK #-} !(Assoc k a)--- 			| Exact {-# UNPACK #-} !(Assoc k a) (Last (Assoc k a)) (First (Assoc k a))--- 			| Above {-# UNPACK #-} !(Assoc k a) | Below {-# UNPACK #-} !(Assoc k a) | Nada-type IndexPos k a = (Last (Assoc k a), Maybe (Assoc k a), First (Assoc k a))+type IndexPos k a = (# Last (Assoc k a), Maybe (Assoc k a), First (Assoc k a) #)  onIndexA :: (Int -> Int) -> Assoc k a -> Assoc k a onIndexA f (Asc i k a) = Asc (f i) k a -onIndex :: (Int -> Int) -> IndexPos k a -> IndexPos k a-onIndex f (l, x, r) = (onIndexA f <$> l, onIndexA f <$> x, onIndexA f <$> r)--onKey :: (k -> k') -> IndexPos k a -> IndexPos k' a-onKey = onValue . first--onVal :: (a -> a') -> IndexPos k a -> IndexPos k a'-onVal = onValue . second- onKeyA :: (k -> k') -> Assoc k a -> Assoc k' a onKeyA = onValueA . first @@ -53,84 +34,71 @@ onValueA :: ((k, a) -> (k', a')) -> Assoc k a -> Assoc k' a' onValueA f (Asc i k a) = uncurry (Asc i) (f (k, a)) -{-# INLINE onValue #-}-onValue :: ((k, a) -> (k', a')) -> IndexPos k a -> IndexPos k' a'-onValue f (l, x, r) = (onValueA f <$> l, onValueA f <$> x, onValueA f <$> r)--type Round = Bool--- type Sized f = forall ix . f ix -> Int---- toFixer :: a -> Fixer a--- toFixer _ = undefined+onUnboxed :: (c -> d) -> (a -> (# b, c #)) -> a -> (# b, d #)+onUnboxed g f a = case f a of+		       (# b, c #) -> (# b, g c #) -class Ord k => TrieKey k m | m -> k where-	emptyM :: TrieMap k ~ m => m a-	nullM :: TrieMap k ~ m => m a -> Bool-	sizeM :: (TrieMap k ~ m) => Sized a -> m a -> Int-	lookupM :: TrieMap k ~ m => k -> m a -> Maybe (a)-	lookupIxM :: TrieMap k ~ m => Sized a -> k -> m a -> IndexPos k a-	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) #-}+class Ord k => TrieKey k where+	data TrieMap k :: * -> *+	emptyM :: TrieMap k a+	singletonM :: Sized a -> k -> a -> TrieMap k a+	nullM :: TrieMap k a -> Bool+	sizeM :: Sized a -> TrieMap k a -> Int+	lookupM :: k -> TrieMap k a -> Maybe a+	alterM :: Sized a -> (Maybe (a) -> Maybe (a)) -> k -> TrieMap k a -> TrieMap k a+	alterLookupM :: Sized a -> (Maybe a -> (# x, Maybe a #)) -> k -> TrieMap k a -> (# x, TrieMap k a #)+	{-# SPECIALIZE traverseWithKeyM :: (k -> a -> Id (b)) -> TrieMap k a -> Id (TrieMap k b) #-} 	traverseWithKeyM :: (TrieMap k ~ m, Applicative f) => Sized b ->-		(k -> a -> f (b)) -> m a -> f (m b)-	foldWithKeyM :: TrieMap k ~ m => (k -> a -> b -> b) -> m a -> b -> b-	foldlWithKeyM :: TrieMap k ~ m => (k -> b -> a -> b) -> m a -> b -> b-	mapEitherM :: (TrieMap k ~ m) => Sized b -> Sized c -> EitherMap k (a) (b) (c) -> m a -> (m b, m c)-	splitLookupM :: (TrieMap k ~ m) => Sized a -> SplitMap (a) x -> k -> m a -> (m a, Maybe x, m a)-	unionM :: (TrieMap k ~ m) => Sized a -> UnionFunc k (a) -> m a -> m a -> m a-	isectM :: (TrieMap k ~ m) => Sized c -> IsectFunc k (a) (b) (c) -> m a -> m b -> m c-	diffM :: (TrieMap k ~ m) => Sized a -> DiffFunc k (a) (b) -> m a -> m b -> m a-	extractM :: (TrieMap k ~ m, Alternative f) => Sized a -> ExtractFunc f (m a) k a x--- 	extractMinM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k First (a) (m a) x--- 	extractMaxM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k Last (a) (m a) x--- 	alterMinM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> First (m a)--- 	alterMaxM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> Last (m a)-	isSubmapM :: TrieMap k ~ m => LEq (a) (b) -> LEq (m a) (m b)-	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+		(k -> a -> f (b)) -> TrieMap k a -> f (TrieMap k b)+	foldWithKeyM :: (k -> a -> b -> b) -> TrieMap k a -> b -> b+	foldlWithKeyM :: (k -> b -> a -> b) -> TrieMap k a -> b -> b+	mapMaybeM :: Sized b -> (k -> a -> Maybe b) -> TrieMap k a -> TrieMap k b+	mapEitherM :: Sized b -> Sized c -> EitherMap k (a) (b) (c) -> TrieMap k a -> (# TrieMap k b, TrieMap k c #)+	splitLookupM :: Sized a -> SplitMap a x -> k -> TrieMap k a -> (# TrieMap k a, Maybe x, TrieMap k a #)+	unionM :: Sized a -> UnionFunc k (a) -> TrieMap k a -> TrieMap k a -> TrieMap k a+	isectM :: Sized c -> IsectFunc k (a) (b) (c) -> TrieMap k a -> TrieMap k b -> TrieMap k c+	diffM :: Sized a -> DiffFunc k (a) (b) -> TrieMap k a -> TrieMap k b -> TrieMap k a+	extractM :: (Alternative f) => Sized a -> ExtractFunc f (TrieMap k a) k a x+	isSubmapM :: LEq (a) (b) -> LEq (TrieMap k a) (TrieMap k b)+	fromListM, fromAscListM :: Sized a -> (k -> a -> a -> a) -> [(k, a)] -> TrieMap k a+	fromDistAscListM :: Sized a -> [(k, a)] -> TrieMap k 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+	fromListM s f = foldr (uncurry (insertWithKeyM s f)) emptyM 	fromAscListM = fromListM 	fromDistAscListM s = fromAscListM s (const const) -guardNullM :: (TrieKey k m, m ~ TrieMap k) => m a -> Maybe (m a)+guardNullM :: TrieKey k => TrieMap k a -> Maybe (TrieMap k a) guardNullM m 	| nullM m	= Nothing 	| otherwise	= Just m -sides :: (a -> c) -> (a, b, a) -> (c, b, c)-sides f (l, x, r) = (f l, x, f r)+sides :: (b -> d) -> (a -> (# b, c, b #)) -> a -> (# d, c, d #)+sides g f a = case f a of+		   (# x, y, z #) -> (# g x, y, g z #) -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)+both :: (b -> b') -> (c -> c') -> (a -> (# b, c #)) -> a -> (# b', c' #)+both g1 g2 f a = case f a of+		  (# x, y #) -> (# g1 x, g2 y #)  {-# INLINE [1] mapWithKeyM #-}-mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> b) -> m a -> m b+mapWithKeyM :: TrieKey k => Sized b -> (k -> a -> b) -> TrieMap k a -> TrieMap k b mapWithKeyM s f  = unId . traverseWithKeyM s (Id .: f) -mapM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (a -> b) -> m a -> m b+mapM :: TrieKey k => Sized b -> (a -> b) -> TrieMap k a -> TrieMap k b mapM s = mapWithKeyM s . const -assocsM :: (TrieKey k m, m ~ TrieMap k) => m a -> [(k, a)]+assocsM :: TrieKey k => TrieMap k a -> [(k, a)] assocsM m = foldWithKeyM (\ k a xs -> (k, a):xs) m [] -insertM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a -> m a+insertM :: TrieKey k => Sized a -> k -> a -> TrieMap k a -> TrieMap k a insertM s = insertWithKeyM s (const const) -insertWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> (k -> a -> a -> a) -> k -> a -> m a -> m a+insertWithKeyM :: TrieKey k => Sized a -> (k -> a -> a -> a) -> k -> a -> TrieMap k a -> TrieMap k a insertWithKeyM s f k a = alterM s f' k where 	f' = Just . maybe a (f k a) -singletonM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a-singletonM s k a = insertM s k a emptyM--fromListM' :: (TrieKey k m, m ~ TrieMap k) => Sized a -> [(k, a)] -> m a+fromListM' :: TrieKey k => Sized a -> [(k, a)] -> TrieMap k a fromListM' s = fromListM s (const const) --xs = foldr (uncurry insertM) emptyM xs  unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a@@ -143,16 +111,17 @@ isectMaybe _ _ _ = Nothing  diffMaybe :: (a -> b -> Maybe a) -> Maybe a -> Maybe b -> Maybe a-diffMaybe f Nothing = const Nothing-diffMaybe f (Just x) = maybe (Just x) (f x)+diffMaybe _ Nothing _ = Nothing+diffMaybe _ (Just x) Nothing = Just x+diffMaybe f (Just x) (Just y) = f x y  subMaybe :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool subMaybe _ Nothing _ = True subMaybe (<=) (Just a) (Just b) = a <= b subMaybe _ _ _ = False -aboutM :: (TrieKey k (TrieMap k), Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z-aboutM f = cpFst <.> extractM (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))+aboutM :: (TrieKey k, Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z+aboutM f = fst <.> extractM (const 0) (\ k a -> fmap (, Nothing) (f k a))  {-# RULES -- 	"lookupM/emptyM" forall k . lookupM k emptyM = Nothing;

@@ -1,106 +1,108 @@-{-# LANGUAGE FlexibleContexts, PatternGuards, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}-+{-# LANGUAGE PatternGuards, UnboxedTuples, TypeFamilies, PatternGuards, ViewPatterns #-}+{-# OPTIONS -funbox-strict-fields #-} module Data.TrieMap.UnionMap () where  import Data.TrieMap.TrieKey-import Data.TrieMap.Regular.Class--- import Data.TrieMap.Regular.TH-import Data.TrieMap.Applicative+import Data.TrieMap.Sized  import Control.Applicative--- import Control.Arrow --- import Data.Monoid+union :: (TrieKey k1, TrieKey k2) => Sized a -> TrieMap k1 a -> TrieMap k2 a -> TrieMap (Either k1 k2) a+union _ (nullM -> True) (nullM -> True)	= Empty+union s m1@(sizeM s -> s1) m2@(sizeM s -> s2) = Union (s1 + s2) m1 m2 -data UMap m1 k2 a = m1 a :&: TrieMap k2 a+singletonMaybe :: (TrieKey k1, TrieKey k2) => Sized a -> Either k1 k2 -> Maybe a -> TrieMap (Either k1 k2) a+singletonMaybe s k a = maybe Empty (singletonM s k) a -type instance TrieMapT (Either a) = UMap (TrieMap a)-type instance TrieMap (Either a b) = UMap (TrieMap a) b+singletonL :: (TrieKey k1, TrieKey k2) => Sized a -> k1 -> a -> TrieMap (Either k1 k2) a+singletonL s k a = Union (s a) (singletonM s k a) emptyM -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+singletonR :: (TrieKey k1, TrieKey k2) => Sized a -> k2 -> a -> TrieMap (Either k1 k2) a+singletonR s k a = Union (s a) emptyM (singletonM s k a) -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+instance (TrieKey k1, TrieKey k2) => TrieKey (Either k1 k2) where+	data TrieMap (Either k1 k2) a = Empty | Union !Int (TrieMap k1 a) (TrieMap k2 a)++	emptyM = Empty 	+	singletonM s = either (singletonL s) (singletonR s)+	+	nullM Empty = True+	nullM _ = False+	+	sizeM _ Empty = 0+	sizeM _ (Union s _ _) = s+	+	lookupM k (Union _ m1 m2) = either (`lookupM` m1) (`lookupM` m2) k+	lookupM _ _ = Nothing+	+	alterM s f k (Union _ m1 m2) = case k of+		Left k	-> union s (alterM s f k m1) m2+		Right k	-> union s m1 (alterM s f k m2)+	alterM s f k _ = singletonMaybe s k (f Nothing)++	alterLookupM s f k Empty = onUnboxed (singletonMaybe s k) f Nothing+	alterLookupM s f (Left k) (Union _ m1 m2) = onUnboxed (flip (union s) m2) (alterLookupM s f k) m1+	alterLookupM s f (Right k) (Union _ m1 m2) = onUnboxed (union s m1) (alterLookupM s f k) m2++	traverseWithKeyM s f (Union _ m1 m2) = union s <$> traverseWithKeyM s (f . Left) m1 <*> traverseWithKeyM s (f . Right) m2+	traverseWithKeyM _ _ _ = pure Empty++	foldWithKeyM f (Union _ m1 m2) = foldWithKeyM (f . Left) m1 . foldWithKeyM (f . Right) m2+	foldWithKeyM _ _ = id++	foldlWithKeyM f (Union _ m1 m2) = foldlWithKeyM (f . Right) m2 . foldlWithKeyM (f . Left) m1+	foldlWithKeyM _ _ = id++	mapMaybeM s f (Union _ m1 m2) = union s (mapMaybeM s (f . Left) m1) (mapMaybeM s (f . Right) m2)+	mapMaybeM _ _ _ = Empty++	mapEitherM s1 s2 f (Union _ m1 m2)+	  | (# m1L, m1R #) <- mapEitherM s1 s2 (f . Left) m1,+	    (# m2L, m2R #) <- mapEitherM s1 s2 (f . Right) m2+	    	= (# union s1 m1L m2L, union s2 m1R m2R #)+	mapEitherM _ _ _ _ = (# Empty, Empty #)++	extractM s f (Union _ m1 m2) = let (&) = union s in fmap (& m2) <$> extractM s (f . Left) m1 <|>+		fmap (m1 &) <$> extractM s (f . Right) m2+	extractM _ _ _ = empty++	splitLookupM s f k (Union _ m1 m2) = let (&) = union s in 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 #)+	splitLookupM _ _ _ _ = (# emptyM, Nothing, emptyM #)++	unionM s f (Union _ m11 m12) (Union _ m21 m22)+		= union s (unionM s (f . Left) m11 m21) (unionM s (f . Right) m12 m22)+	unionM _ _ Empty m2 = m2+	unionM _ _ m1 Empty = m1++	isectM _ _ Empty _ = Empty+	isectM _ _ _ Empty = Empty+	isectM s f (Union _ m11 m12) (Union _ m21 m22)+		= union s (isectM s (f . Left) m11 m21) (isectM s (f . Right) m12 m22)++	diffM _ _ Empty _ = Empty+	diffM _ _ m1 Empty = m1+	diffM s f (Union _ m11 m12) (Union _ m21 m22)+		= union s (diffM s (f . Left) m11 m21) (diffM s (f . Right) m12 m22)++	isSubmapM _ Empty _ = True+	isSubmapM (<=) (Union _ m11 m12) (Union _ m21 m22) = isSubmapM (<=) m11 m21 && isSubmapM (<=) m12 m22+	isSubmapM _ Union{} Empty = False++	fromListM s f = onPair (union s) (fromListM s (f . Left)) (fromListM s (f . Right)) . partEithers++	fromAscListM s f = onPair (union s) (fromAscListM s (f . Left)) (fromAscListM s (f . Right)) . partEithers++	fromDistAscListM s = onPair (union s) (fromDistAscListM s) (fromDistAscListM s) . partEithers++onPair :: (c -> d -> e) -> (a -> c) -> (b -> d) -> (a, b) -> e+onPair f g h (a, b) = f (g a) (h b)+ 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 -	

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, UnboxedTuples #-}  module Data.TrieMap.UnitMap where @@ -12,32 +12,27 @@  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+instance TrieKey () where+	newtype TrieMap () a = Unit {getUnit :: Maybe a}+	emptyM = Unit Nothing+	singletonM _ _ = Unit . Just+	nullM = isNothing . getUnit+	sizeM s = maybe 0 s . getUnit+	lookupM _ (Unit m) = m+	traverseWithKeyM _ f (Unit m) = Unit <$> traverse (f ()) m+	foldWithKeyM f (Unit m) z = foldr (f ()) z m+	foldlWithKeyM f (Unit m) z = foldl (f ()) z m+	mapMaybeM _ f (Unit m) = Unit (m >>= f ())+	mapEitherM _ _ f (Unit (Just a)) = both Unit Unit (f ()) a+	mapEitherM _ _ _ _ = (# emptyM, emptyM #)+	splitLookupM _ f _ (Unit (Just a)) = sides Unit f a+	splitLookupM _ _ _ _ = (# emptyM, Nothing, emptyM #)+	alterM _ f _ (Unit m) = Unit (f m)+	alterLookupM _ f _ (Unit m) = onUnboxed Unit f m+	unionM _ f (Unit m1) (Unit m2) = Unit (unionMaybe (f ()) m1 m2)+	isectM _ f (Unit m1) (Unit m2) = Unit (isectMaybe (f ()) m1 m2)+	diffM _ f (Unit m1) (Unit m2) = Unit (diffMaybe (f ()) m1 m2)+	extractM _ f (Unit m) = maybe empty (fmap (fmap Unit) . f ()) m+	isSubmapM (<=) (Unit m1) (Unit m2) = subMaybe (<=) m1 m2+	fromListM _ _ [] = Unit Nothing+	fromListM _ f ((_, v):xs) = Unit $ Just (foldl (\ v' -> f () v' . snd) v xs)

@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, ExistentialQuantification, CPP #-}+-- module Tests where++import Control.Monad+import qualified Data.TrieMap as T+import qualified Data.Map as M+import Test.QuickCheck+import Prelude hiding (null, lookup)++type Key = [String]+type Val = [String]++main = quickCheck (verify M.empty T.empty)++instance Arbitrary Op where+	arbitrary = oneof [+		liftM Op (liftM2 Insert arbitrary arbitrary),+		return (Op Map),+		return (Op ToList),+		return (Op Size),+		liftM (Op . Lookup) arbitrary,+		liftM (Op . Delete) arbitrary,+		return (Op MinView),+		return (Op MaxView),+		return (Op MapMaybe)]+	shrink (Op (Insert k v)) = [Op (Insert k' v') | k' <- shrink k, v' <- shrink v]+	shrink (Op (Lookup k)) = map (Op . Lookup) (shrink k)+	shrink (Op (Delete k)) = map (Op . Delete) (shrink k)+	shrink _ = []++data Op = forall r . Op (Operation r)++instance Show Op where+	show (Op (Insert k v)) = "Insert " ++ show k ++ " " ++ show v+	show (Op (Lookup k)) = "Lookup " ++ show k+	show (Op (Delete k)) = "Delete " ++ show k+	show (Op Map) = "Map"+	show (Op Size) = "Size"+	show (Op ToList) = "ToList"+	show (Op MinView) = "MinView"+	show (Op MaxView) = "MaxView"+	show (Op MapMaybe) = "MapMaybe"++data Operation r where+	Insert :: Key -> Val -> Operation ()+	Map :: Operation ()+	ToList :: Operation [(Key, Val)]+	Size :: Operation Int+	Lookup :: Key -> Operation (Maybe Val)+	Delete :: Key -> Operation ()+	MinView :: Operation (Maybe (Key, Val))+	MaxView :: Operation (Maybe (Key, Val))+	MapMaybe :: Operation ()++operateMap :: M.Map Key Val -> Operation r -> (r, M.Map Key Val)+operateMap m (Insert k v) = ((), M.insert k v m)+operateMap m (Lookup k) = (M.lookup k m, m)+operateMap m Map = ((), M.mapWithKey (\ k a -> k ++ a) m)+operateMap m ToList = (M.assocs m, m)+operateMap m Size = (M.size m, m)+operateMap m (Delete k) = ((), M.delete k m)+operateMap m MinView = case M.minViewWithKey m of+	Nothing	 -> (Nothing, m)+	Just ((k, v), m')	-> (Just (k, v), m')+operateMap m MaxView = case M.maxViewWithKey m of+	Nothing	-> (Nothing, m)+	Just (kv, m')	-> (Just kv, m')+operateMap m MapMaybe = ((), M.mapMaybeWithKey f m)+	where	f ("":xs) ("":ys) = Just (xs ++ ys)+		f _ _ = Nothing++operateTMap :: T.TMap Key Val -> Operation r -> (r, T.TMap Key Val)+operateTMap m (Insert k v) = ((), T.insert k v m)+operateTMap m (Lookup k) = (T.lookup k m, m)+operateTMap m Map = ((), T.mapWithKey (\ k a -> k ++ a) m)+operateTMap m ToList = (T.assocs m, m)+operateTMap m Size = (T.size m, m)+operateTMap m (Delete k) = ((), T.delete k m)+operateTMap m MinView = case T.minViewWithKey m of+	Nothing	 -> (Nothing, m)+	Just ((k, v), m')	-> (Just (k, v), m')+operateTMap m MaxView = case T.maxViewWithKey m of+	Nothing	-> (Nothing, m)+	Just (kv, m')	-> (Just kv, m')+operateTMap m MapMaybe = ((), T.mapMaybeWithKey f m)+	where	f ("":xs) ("":ys) = Just (xs ++ ys)+		f _ _ = Nothing++#define VERIFYOP(operation) verifyOp op@operation{} m tm = \+	case (operateMap m op, operateTMap tm op) of \+		{((r1, m'), (r2, tm'))	-> guard (r1 == r2 && M.assocs m' == T.assocs tm') >> return (m', tm');}++verifyOp :: Operation r -> M.Map Key Val -> T.TMap Key Val -> Maybe (M.Map Key Val, T.TMap Key Val)+VERIFYOP(Insert)+VERIFYOP(Lookup)+VERIFYOP(Map)+VERIFYOP(Size)+VERIFYOP(ToList)+VERIFYOP(Delete)+VERIFYOP(MinView)+VERIFYOP(MaxView)+VERIFYOP(MapMaybe)++verify :: M.Map Key Val -> T.TMap Key Val -> [Op] -> Bool+verify m tm (Op op:ops) = case verifyOp op m tm of+	Nothing	-> False+	Just (m', tm') -> verify m' tm' ops+verify _ _ [] = True

@@ -1,32 +1,29 @@ name:		     TrieMap-version:             0.7.2+version:             1.0.0 tested-with:	     GHC category:            Algorithms synopsis:	     Automatic type inference of generalized tries.-description:	     Builds on the multirec library to create a system capable of automatic or simple generalized trie type inference.  Uses Template Haskell to automatically derive a TKey instance for almost any datatype.  Just splice @'Data.TrieMap.Representation.TH.genRepr' \'\'Foo@-			to derive a 'Data.TrieMap.Class.TKey' instance for @Foo@.  (It works if @Foo@ has type arguments, too!)+description:	     Builds on the multirec library to create a system capable of automatic or simple generalized trie type inference. license:             BSD3 license-file:	     LICENSE author:              Louis Wasserman maintainer:          wasserman.louis@gmail.com-build-Depends:       base < 5.0.0.0, containers, multirec, template-haskell >= 2.5.0.0, bytestring, array, th-expand-syns >= 0.1.1.0+build-Depends:       base < 5.0.0.0, containers, template-haskell, bytestring, array, th-expand-syns, ghc-prim build-type:	     Simple+ghc-options:         -Wall -fno-warn-name-shadowing -fno-warn-orphans+extra-source-files:  Tests.hs exposed-modules:   	Data.TrieMap, 	Data.TrieSet, 	Data.TrieMap.Class,-	Data.TrieMap.Regular,-	Data.TrieMap.MultiRec, 	Data.TrieMap.Representation, 	Data.TrieMap.Representation.TH, 	Data.TrieMap.Modifiers-	-- Data.TrieMap.TrieKey other-modules:-	Data.TrieMap.Key, 	Data.TrieMap.Class.Instances,+	Data.TrieMap.Key, 	Data.TrieMap.TrieKey, 	Data.TrieMap.Applicative,-	Data.TrieMap.CPair, 	Data.TrieMap.ProdMap, 	Data.TrieMap.RadixTrie, 	Data.TrieMap.UnionMap,@@ -34,39 +31,6 @@ 	Data.TrieMap.Rep, 	Data.TrieMap.Rep.Instances, 	Data.TrieMap.Rep.TH,-	-- Data.TrieMap.MultiRec.TH,-	Data.TrieMap.MultiRec.FamMap,-	Data.TrieMap.MultiRec.Eq,-	Data.TrieMap.MultiRec.Ord,-	Data.TrieMap.MultiRec.Class,-	Data.TrieMap.MultiRec.ConstMap,-	Data.TrieMap.MultiRec.IMap,-	Data.TrieMap.MultiRec.Base,-	-- Data.TrieMap.MultiRec.XMap,-	-- Data.TrieMap.MultiRec.FixMap,-	-- Data.TrieMap.MultiRec.AppMap,-	Data.TrieMap.MultiRec.Instances,-	Data.TrieMap.MultiRec.ProdMap,-	Data.TrieMap.MultiRec.TagMap,-	Data.TrieMap.MultiRec.UnionMap,-	Data.TrieMap.MultiRec.UnitMap,-	Data.TrieMap.MultiRec.Sized,-	Data.TrieMap.Regular.Base,-	Data.TrieMap.Regular.Class,-	Data.TrieMap.Regular.ConstMap,-	Data.TrieMap.Regular.Eq,-	Data.TrieMap.Regular.IdMap,-	Data.TrieMap.Regular.Instances,-	Data.TrieMap.Regular.Ord,-	Data.TrieMap.Regular.ProdMap,-	Data.TrieMap.Regular.RadixTrie,-	Data.TrieMap.Regular.UnitMap,-	Data.TrieMap.Regular.RegMap,-	Data.TrieMap.Regular.CompMap,-	Data.TrieMap.Regular.UnionMap,-	Data.TrieMap.Regular.TH,-	Data.TrieMap.Regular.Sized,-	Data.TrieMap.Regular.Rep, 	Data.TrieMap.IntMap, 	Data.TrieMap.OrdMap, 	Data.TrieMap.ReverseMap,