> module OrdAssList ( FM(..), OrdAssList(..), > -- construction > empty, singleton, union, unionMany, > add, (///), > -- construction with combining function > union_C, unionMany_C, add_C, addMany_C, > -- modification > intersect, delete, deleteMany, minus, > amapFM, > -- conversion > toList, fromList, > -- size > -- length, genericLength > -- testing > --null > isSingleton, > -- extraction > elemsFM, indicesFM, > -- lookup > lookup, lookupWithDefault, > lookupWithContinuation, > -- *additional functions* > toSortedList, fromSortedList, > prefixLookup > ) > where
> import Sort ( mergeSortBy, uniqueBy ) > import Subsequences ( isPrefixOf ) > import Support ( applyWithDefault, applyWithContinuation )Note: many functions are identical to those of
OrdList except for
the compare function.
> type FM a b = OrdAssList a bLists ordered by the first component containing no duplicates.
> type OrdAssList a b = [(a, b)]Lists are already instances of
Eq and Ord.
> --instance Eq a => Eq (FM a b) > --instance Ord a => Ord (FM a b)
> empty :: FM a b > empty = []
> singleton :: (a,b) -> FM a b > singleton b = [b]
union corresponds to merge.
> union :: Ord a => FM a b -> FM a b -> FM a b > union [] y = y > union x@(_:_) [] = x > union x@(a:x') y@(b:y') = case compare a b of > _LT -> a : union x' y > _EQ -> a : union x' y' > _GT -> b : union x y'
> unionMany :: Ord a => [FM a b] -> FM a b > unionMany = foldl union empty
> add :: Ord a => (a,b) -> FM a b -> FM a b > add a [] = [a] > add a x@(b:x') = case compare a b of > _LT -> a : x > _EQ -> a : x' > _GT -> b : add a x'Note:
/// instead of //.
> (///) :: Ord a => FM a b -> [(a,b)] -> FM a b > --x /// bs = foldr add x bs -- insertion sort > x /// bs = x `union` fromList bs -- merge sort
combine old new and
combine left right, respectively.
> union_C :: Ord a => (b -> b -> b) > -> FM a b -> FM a b -> FM a b > union_C combine [] y = y > union_C combine x@(_:_) [] = x > union_C combine x@(b1@(a1,v1):x') y@(b2@(a2,v2):y') > = case _tagCmp a1 a2 of > _LT -> b1 : union_C combine x' y > _EQ -> (a1,combine v1 v2) : union_C combine x' y' > _GT -> b2 : union_C combine x y'
> unionMany_C :: Ord a => (b -> b -> b) -> [FM a b] -> FM a b > unionMany_C combine = foldl (union_C combine) empty
> add_C :: Ord a => (b -> b -> b) > -> (a,b) -> FM a b -> FM a b > add_C combine b [] = [b] > add_C combine b1@(a1,v1) x@(b2@(a2,v2):x') > = case _tagCmp a1 a2 of > _LT -> b1 : x > _EQ -> (a1,combine v1 v2) : x' > _GT -> b2 : add_C combine b1 x'
> addMany_C :: Ord a => (b -> b -> b) > -> FM a b -> [(a,b)] -> FM a b > addMany_C combine x bs = union_C combine x (fromList bs)
> intersect :: Ord a => FM a b -> FM a b -> FM a b > intersect [] y = [] > intersect x@(_:_) [] = [] > intersect x@(a:x') y@(b:y') = case compare a b of > _LT -> intersect x' y > _EQ -> a : intersect x' y' > _GT -> intersect x y'
> delete :: Ord a => a -> FM a b -> FM a b > delete a [] = [] > delete a x@(b:x') = case _tagCmp a (fst b) of > _LT -> x > _EQ -> x' > _GT -> b : delete a x'
> deleteMany :: Ord a => FM a b -> [a] -> FM a b > deleteMany = foldr delete
> minus :: Ord a => FM a b -> FM a b -> FM a b > minus [] y = [] > minus x@(_:_) [] = x > minus x@(a:x') y@(b:y') = case compare a b of > _LT -> a : minus x' y > _EQ -> minus x' y' > _GT -> minus x y'
> amapFM :: ((a,b) -> c) -> (FM a b -> FM a c) > amapFM f bs = [ (a,f b) | b@(a,v)<-bs ]Note:
partition, filter, foldl, foldr need no
redefinition.
> toList :: FM a b -> [(a,b)] > toList = id
> fromList :: Ord a => [(a,b)] -> FM a b > fromList = fromSortedList > . mergeSortBy (\p q -> fst p <= fst q)
length and genericLength need no redefinition.
> --length :: FM a b -> Int > --genericLength :: Integral i => FM a b -> i
null needs no redefinition.
> --null :: FM a b -> Bool
> isSingleton :: FM a b -> Bool > isSingleton [a] = True > isSingleton _ = False
> intersecting :: Ord a => FM a b -> FM a b -> Bool > intersecting [] y = False > intersecting x@(_:_) [] = False > intersecting x@(a:x') y@(b:y')= case compare a b of > _LT -> intersecting x' y > _EQ -> True > _GT -> intersecting x y'
> isSubsetOf :: Ord a => FM a b -> FM a b -> Bool > isSubsetOf [] y = True > isSubsetOf x@(_:_) [] = False > isSubsetOf x@(a:x') y@(b:y') = case compare a b of > _LT -> False > _EQ -> isSubsetOf x' y' > _GT -> isSubsetOf x y'
elemsFM instead of elems. Dito: indicesFM.
> elemsFM :: FM a b -> [b] > elemsFM = map snd
> indicesFM :: FM a b -> [a] > indicesFM = map fst
! is predefined.
> --(!) :: Ord a => FM a b -> a -> b > --x ! a = lookupWithDefault x > -- (error "OrdAssList.!: elem not found") a
> lookup :: Ord a => FM a b -> a -> Maybe b > lookup [] a = Nothing > lookup x@(b:x') a = case _tagCmp a (fst b) of > _LT -> Nothing > _EQ -> Just (snd b) > _GT -> lookup x' a
> lookupWithDefault :: Ord a => FM a b -> b -> a -> b > lookupWithDefault = applyWithDefault . lookup
> lookupWithContinuation :: Ord a => FM a b -> (b -> c) -> c -> a ->c > lookupWithContinuation = applyWithContinuation . lookup
> toSortedList :: FM a b -> [(a,b)] > toSortedList = id
> fromSortedList :: Eq a => [(a,b)] -> FM a b > fromSortedList = uniqueBy (\p q -> fst p == fst q)
prefixLookup returns the list of all completions of the given list.
> prefixLookup :: Ord a => FM [a] b -> [a] -> [([a],b)] > prefixLookup x s = [ b | b@(a, _)<-x, s `isPrefixOf` a ]
> compare :: Ord a => (a,b) -> (a,b) -> _CMP_TAG
> compare p q = _tagCmp (fst p) (fst q)
> {-# INLINE compare #-}