hashmap-1.3.1.1/0000755000000000000000000000000012726362514011472 5ustar0000000000000000hashmap-1.3.1.1/hashmap.cabal0000644000000000000000000000466412726362514014111 0ustar0000000000000000Name: hashmap Version: 1.3.1.1 Synopsis: Persistent containers Map and Set based on hashing. Description: An implementation of persistent 'Map' and 'Set' containers based on hashing. The implementation is build on top of 'Data.IntMap.IntMap' and 'Data.IntSet.IntSet', with very similar API. It uses 'Hashable' class from the @hashable@ package for hashing. . This package can be used as a drop-in replacement for 'Data.Map' and 'Data.Set' modules. . The @'Map' key value@ is an 'Data.IntMap.IntMap' indexed by the hash value, containing either one ('key', 'value') or a @'Data.Map.Map' key value@ for all keys with the same hash value. . The @'Set' elem@ is an 'Data.IntMap.IntMap' indexed by the hash value, containing either one 'elem' or @'Data.Set.Set' elem@ for all elements with the same hash value. Homepage: https://github.com/foxik/hashmap bug-reports: https://github.com/foxik/hashmap/issues License: BSD3 License-file: LICENSE Author: Milan Straka Maintainer: Ryan Scott Stability: Provisional copyright: (C) 2011-2012 Milan Straka, 2016 Ryan Scott Category: Data Build-type: Simple Cabal-version: >= 1.6 Extra-source-files: CHANGES, README.md, include/*.h tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.1 source-repository head type: git location: https://github.com/foxik/hashmap Flag OldContainers Description: Use old version of containers where NFData instances are provided by deepseq. Default: False Library Exposed-modules: Data.HashMap, Data.HashSet include-dirs: include Build-depends: base >= 4.0 && < 5, hashable >= 1.0 if !flag(OldContainers) Build-depends: containers >= 0.4.2, deepseq >= 1.2 else Build-depends: containers >= 0.3, deepseq >= 1.0 && < 1.2 Extensions: CPP if impl(ghc) Extensions: StandaloneDeriving, DeriveDataTypeable hashmap-1.3.1.1/LICENSE0000644000000000000000000000300312726362514012473 0ustar0000000000000000Copyright Milan Straka 2011-2012, Ryan Scott 2016 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Milan Straka nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hashmap-1.3.1.1/CHANGES0000644000000000000000000000373012726362514012470 0ustar0000000000000000= Version 1.3.1.1, 2016-06-09 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Ensure hashmap.h is distributed with the tarball = Version 1.3.1, 2016-06-09 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * GHC 8 compatibility = Version 1.3.0.1, 2012-12-14 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Relax dependencies -- allow older versions of containers. A new flag is introduced, because there are dependencies between containers and deepseq versions: it is not possible to compile with deepseq >= 1.2 and containers < 0.4.2. = Version 1.3.0.0, 2012-12-11 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Add NFData instances. = Version 1.2.0.1, 2011-09-21 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Add missing StandaloneDeriving and DeriveDataTypeable GHC extensions to enable Typeable deriving. Also remove PatternGuards extension, which was needed only once. = Version 1.2.0.0, 2011-05-08 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Rename HashMap and HashSet to Map and Set. That allows to use this package as a drop-in replacement for Data.Map and Data.Set packages. HashMap and HashSet types are kept as deprecated type synonyms. = Version 1.1.0.1, 2011-04-19 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Convert the repository to Git. = Version 1.1.0, 2010-08-15 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Separating Hashable class to its own package and depending on it. = Version 1.0.0.3, 2010-08-07 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Improving the performance of HashSet and HashMap by using (Some a) datatype. This speeds up the case where only one value is stored for a given hash. The performance gain is ~10% for delete, ~15% for insert, 20-50% for union. = Version 1.0.0.2, 2010-06-01 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Improving performance of ByteString hash by using inlinePerformIO. = Version 1.0.0.1, 2010-05-30 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Doc fixes = Version 1.0.0, 2010-05-30 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Adding module HashSet = Version 0.9.0, 2010-05-29 = ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ * Initial versions of HashMap, Hashable hashmap-1.3.1.1/README.md0000644000000000000000000000310212726362514012745 0ustar0000000000000000# `hashmap` [![Hackage](https://img.shields.io/hackage/v/hashmap.svg)][Hackage: hashmap] [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/hashmap.svg)](http://packdeps.haskellers.com/reverse/hashmap) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] [![Build](https://img.shields.io/travis/foxik/hashmap.svg)](https://travis-ci.org/foxik/hashmap) [Hackage: hashmap]: http://hackage.haskell.org/package/hashmap "hashmap package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" [tl;dr Legal: BSD3]: https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" :warning: Deprecated in favor of [`unordered-containers`](https://github.com/tibbe/unordered-containers) An implementation of persistent `Map` and `Set` containers based on hashing. The implementation is build on top of `Data.IntMap.IntMap` and `Data.IntSet.IntSet`, with very similar API. It uses `Hashable` class from the `hashable` package for hashing. This package can be used as a drop-in replacement for `Data.Map` and `Data.Set` modules. The `Map key value` is an `Data.IntMap.IntMap` indexed by the hash value, containing either one (`key`, `value`) or a `Data.Map.Map key value` for all keys with the same hash value. The `Set elem` is an `Data.IntMap.IntMap` indexed by the hash value, containing either one `elem` or `Data.Set.Set elem` for all elements with the same hash value. hashmap-1.3.1.1/Setup.hs0000644000000000000000000000011012726362514013116 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hashmap-1.3.1.1/include/0000755000000000000000000000000012726362514013115 5ustar0000000000000000hashmap-1.3.1.1/include/hashmap.h0000644000000000000000000000253712726362514014716 0ustar0000000000000000#ifndef HASKELL_HASHMAP_H #define HASKELL_HASHMAP_H /* * Define INSTANCE_TYPEABLE[0-2] */ #if __GLASGOW_HASKELL__ >= 707 #define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon #define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon #define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon #elif defined(__GLASGOW_HASKELL__) #define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon #define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon #define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon #else #define INSTANCE_TYPEABLE0(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \ instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] } #define INSTANCE_TYPEABLE1(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \ instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault } #define INSTANCE_TYPEABLE2(tycon,tcname,str) tcname :: TyCon; tcname = mkTyCon str; \ instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \ instance Typeable a => Typeable1 (tycon a) where { typeOf1 = typeOf1Default }; \ instance (Typeable a, Typeable b) => Typeable (tycon a b) where { typeOf = typeOfDefault } #endif #endif hashmap-1.3.1.1/Data/0000755000000000000000000000000012726362514012343 5ustar0000000000000000hashmap-1.3.1.1/Data/HashMap.hs0000644000000000000000000007522612726362514014234 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.HashMap -- Copyright : (c) Milan Straka 2011 -- License : BSD-style -- Maintainer : fox@ucw.cz -- Stability : provisional -- Portability : portable -- -- Persistent 'Map' based on hashing, which is defined as -- -- @ -- data 'Map' k v = 'Data.IntMap.IntMap' (Some k v) -- @ -- -- is an 'Data.IntMap.IntMap' indexed by hash values of keys, -- containing a value of @Some e@. That contains either one -- @('k', 'v')@ pair or a @'Data.Map.Map' k v@ with keys of the same hash values. -- -- The interface of a 'Map' is a suitable subset of 'Data.IntMap.IntMap' -- and can be used as a drop-in replacement of 'Data.Map.Map'. -- -- The complexity of operations is determined by the complexities of -- 'Data.IntMap.IntMap' and 'Data.Map.Map' operations. See the sources of -- 'Map' to see which operations from @containers@ package are used. ----------------------------------------------------------------------------- module Data.HashMap ( Map , HashMap -- * Operators , (!), (\\) -- * Query , null , size , member , notMember , lookup , findWithDefault -- * Construction , empty , singleton -- ** Insertion , insert , insertWith, insertWithKey, insertLookupWithKey -- ** Delete\/Update , delete , adjust , adjustWithKey , update , updateWithKey , updateLookupWithKey , alter -- * Combine -- ** Union , union , unionWith , unionWithKey , unions , unionsWith -- ** Difference , difference , differenceWith , differenceWithKey -- ** Intersection , intersection , intersectionWith , intersectionWithKey -- * Traversal -- ** Map , map , mapWithKey , mapAccum , mapAccumWithKey -- ** Fold , fold , foldWithKey -- * Conversion , elems , keys , keysSet , assocs -- ** Lists , toList , fromList , fromListWith , fromListWithKey -- * Filter , filter , filterWithKey , partition , partitionWithKey , mapMaybe , mapMaybeWithKey , mapEither , mapEitherWithKey -- * Submap , isSubmapOf, isSubmapOfBy , isProperSubmapOf, isProperSubmapOfBy ) where import Prelude hiding (lookup,map,filter,null) import Control.Applicative (Applicative(pure,(<*>))) import Control.DeepSeq import Data.Hashable import Data.Foldable (Foldable(foldMap)) import Data.List (foldl') import Data.Monoid (Monoid(..)) import Data.Traversable (Traversable(traverse)) import Data.Typeable #if __GLASGOW_HASKELL__ import Text.Read import Data.Data (Data(..), mkNoRepType) #endif import qualified Data.IntMap as I import qualified Data.Map as M import qualified Data.Set as S {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} -- | Find the value at a key. -- Calls 'error' when the element can not be found. (!) :: (Hashable k, Ord k) => Map k a -> k -> a m ! k = case lookup k m of Nothing -> error "HashMap.(!): key not an element of the map" Just v -> v -- | Same as 'difference'. (\\) :: Ord k => Map k a -> Map k b -> Map k a m1 \\ m2 = difference m1 m2 {-------------------------------------------------------------------- Types --------------------------------------------------------------------} data Some k v = Only !k v | More !(M.Map k v) deriving (Eq, Ord) instance (NFData k, NFData v) => NFData (Some k v) where rnf (Only k v) = rnf k `seq` rnf v rnf (More m) = rnf m -- | The abstract type of a @Map@. Its interface is a suitable -- subset of 'Data.IntMap.IntMap'. newtype Map k v = Map (I.IntMap (Some k v)) deriving (Eq, Ord) -- | The @HashMap@ is a type synonym for @Map@ for backward compatibility. -- It is deprecated and will be removed in furture releases. {-# DEPRECATED HashMap "HashMap is deprecated. Please use Map instead." #-} type HashMap k v = Map k v instance (NFData k, NFData v) => NFData (Map k v) where rnf (Map m) = rnf m instance Functor (Map k) where fmap = map instance Ord k => Monoid (Map k a) where mempty = empty mappend = union mconcat = unions instance Foldable (Map k) where foldMap f (Map m) = foldMap some_fold m where some_fold (Only _ x) = f x some_fold (More s) = foldMap f s instance Traversable (Map k) where traverse f (Map m) = pure Map <*> traverse some_traverse m where some_traverse (Only k x) = pure (Only k) <*> f x some_traverse (More s) = pure More <*> traverse f s instance (Show k, Show a) => Show (Map k a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) instance (Read k, Hashable k, Ord k, Read a) => Read (Map k a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif #include "hashmap.h" INSTANCE_TYPEABLE2(Map,mapTc,"Map") #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Data k, Hashable k, Ord k, Data a) => Data (Map k a) where gfoldl f z m = z fromList `f` (toList m) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.HashMap.Map" dataCast1 f = gcast1 f #endif {-------------------------------------------------------------------- Comparing elements --------------------------------------------------------------------} -- For ByteStrings, doing compare is usually faster than doing (==), -- according to benchmarks. A Set is using compare naturally. We therefore -- define eq :: Ord a => a -> a -> Bool, which serves as (==). {-# INLINE eq #-} eq :: Ord a => a -> a -> Bool eq x y = x `compare` y == EQ {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | Is the map empty? null :: Map k a -> Bool null (Map m) = I.null m -- | Number of elements in the map. size :: Map k a -> Int size (Map m) = I.fold ((+) . some_size) 0 m where some_size (Only _ _) = 1 some_size (More s) = M.size s -- | Is the key a member of the map? member :: (Hashable k, Ord k) => k -> Map k a -> Bool member k m = case lookup k m of Nothing -> False Just _ -> True -- | Is the key not a member of the map? notMember :: (Hashable k, Ord k) => k -> Map k a -> Bool notMember k m = not $ member k m some_lookup :: Ord k => k -> Some k a -> Maybe a some_lookup k (Only k' x) | k `eq` k' = Just x | otherwise = Nothing some_lookup k (More s) = M.lookup k s -- | Lookup the value at a key in the map. lookup :: (Hashable k, Ord k) => k -> Map k a -> Maybe a lookup k (Map m) = I.lookup (hash k) m >>= some_lookup k -- | The expression @('findWithDefault' def k map)@ returns the value at key -- @k@ or returns @def@ when the key is not an element of the map. findWithDefault :: (Hashable k, Ord k) => a -> k -> Map k a -> a findWithDefault def k m = case lookup k m of Nothing -> def Just x -> x {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | The empty map. empty :: Map k a empty = Map I.empty -- | A map of one element. singleton :: Hashable k => k -> a -> Map k a singleton k x = Map $ I.singleton (hash k) $ (Only k x) {-------------------------------------------------------------------- Insert --------------------------------------------------------------------} -- | Insert a new key\/value pair in the map. If the key is already present in -- the map, the associated value is replaced with the supplied value, i.e. -- 'insert' is equivalent to @'insertWith' 'const'@. insert :: (Hashable k, Ord k) => k -> a -> Map k a -> Map k a insert k x (Map m) = Map $ I.insertWith some_insert (hash k) (Only k x) m where some_insert _ (Only k' x') | k `eq` k' = Only k x | otherwise = More $ M.insert k x (M.singleton k' x') some_insert _ (More s) = More $ M.insert k x s -- | Insert with a combining function. @'insertWith' f key value mp@ will -- insert the pair (key, value) into @mp@ if key does not exist in the map. If -- the key does exist, the function will insert @f new_value old_value@. insertWith :: (Hashable k, Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith f k x (Map m) = Map $ I.insertWith some_insert_with (hash k) (Only k x) m where some_insert_with _ (Only k' x') | k `eq` k' = Only k (f x x') | otherwise = More $ M.insert k x (M.singleton k' x') some_insert_with _ (More s) = More $ M.insertWith f k x s -- | Insert with a combining function. @'insertWithKey' f key value mp@ will -- insert the pair (key, value) into @mp@ if key does not exist in the map. If -- the key does exist, the function will insert @f key new_value old_value@. insertWithKey :: (Hashable k, Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKey f k x (Map m) = Map $ I.insertWith some_insert_with_key (hash k) (Only k x) m where some_insert_with_key _ (Only k' x') | k `eq` k' = Only k (f k x x') | otherwise = More $ M.insert k x (M.singleton k' x') some_insert_with_key _ (More s) = More $ M.insertWithKey f k x s -- | The expression (@'insertLookupWithKey' f k x map@) is a pair where the -- first element is equal to (@'lookup' k map@) and the second element equal to -- (@'insertWithKey' f k x map@). insertLookupWithKey :: (Hashable k, Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a) insertLookupWithKey f k x (Map m) = case I.insertLookupWithKey some_insert_with_key (hash k) (Only k x) m of (found, m') -> (found >>= some_lookup k, Map m') where some_insert_with_key _ _ (Only k' x') | k `eq` k' = Only k (f k x x') | otherwise = More $ M.insert k x (M.singleton k' x') some_insert_with_key _ _ (More s) = More $ M.insertWithKey f k x s {-------------------------------------------------------------------- Deletion --------------------------------------------------------------------} some_norm :: M.Map k v -> Maybe (Some k v) some_norm s = case M.size s of 0 -> Nothing 1 -> case M.findMin s of (k, x) -> Just $ Only k x _ -> Just $ More $ s some_norm' :: M.Map k v -> Some k v some_norm' s = case M.size s of 1 -> case M.findMin s of (k, x) -> Only k x _ -> More $ s -- | Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. delete :: (Hashable k, Ord k) => k -> Map k a -> Map k a delete k (Map m) = Map $ I.update some_delete (hash k) m where some_delete v@(Only k' _) | k `eq` k' = Nothing | otherwise = Just v some_delete (More t) = some_norm $ M.delete k t -- | Adjust a value at a specific key. When the key is not a member of the map, -- the original map is returned. adjust :: (Hashable k, Ord k) => (a -> a) -> k -> Map k a -> Map k a adjust f k (Map m) = Map $ I.adjust some_adjust (hash k) m where some_adjust v@(Only k' x) | k `eq` k' = Only k (f x) | otherwise = v some_adjust (More t) = More $ M.adjust f k t -- | Adjust a value at a specific key. When the key is not a member of the map, -- the original map is returned. adjustWithKey :: (Hashable k, Ord k) => (k -> a -> a) -> k -> Map k a -> Map k a adjustWithKey f k (Map m) = Map $ I.adjust some_adjust_with_key (hash k) m where some_adjust_with_key v@(Only k' x) | k `eq` k' = Only k (f k x) | otherwise = v some_adjust_with_key (More t) = More $ M.adjustWithKey f k t -- | The expression (@'update' f k map@) updates the value @x@ at @k@ (if it is -- in the map). If (@f x@) is 'Nothing', the element is deleted. If it is -- (@'Just' y@), the key @k@ is bound to the new value @y@. update :: (Hashable k, Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a update f k (Map m) = Map $ I.update some_update (hash k) m where some_update v@(Only k' x) | k `eq` k' = f x >>= return . Only k' | otherwise = Just v some_update (More t) = some_norm $ M.update f k t -- | The expression (@'update' f k map@) updates the value @x@ at @k@ (if it is -- in the map). If (@f k x@) is 'Nothing', the element is deleted. If it is -- (@'Just' y@), the key @k@ is bound to the new value @y@. updateWithKey :: (Hashable k, Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a updateWithKey f k (Map m) = Map $ I.update some_update_with_key (hash k) m where some_update_with_key v@(Only k' x) | k `eq` k' = f k x >>= return . Only k' | otherwise = Just v some_update_with_key (More t) = some_norm $ M.updateWithKey f k t -- | Lookup and update. The function returns original value, if it is updated. -- This is different behavior than 'Data.Map.updateLookupWithKey'. Returns the -- original key value if the map entry is deleted. updateLookupWithKey :: (Hashable k, Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a) updateLookupWithKey f k (Map m) = case I.updateLookupWithKey some_update_with_key (hash k) m of (found, m') -> (found >>= some_lookup k, Map m') where some_update_with_key _ v@(Only k' x) | k `eq` k' = f k x >>= return . Only k' | otherwise = Just v some_update_with_key _ (More t) = some_norm $ M.updateWithKey f k t -- | 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 an -- 'Map'. alter :: (Hashable k, Ord k) => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a alter f k (Map m) = Map $ I.alter some_alter (hash k) m where some_alter Nothing = f Nothing >>= return . Only k some_alter (Just v@(Only k' x)) | k `eq` k' = f (Just x) >>= return . Only k' | otherwise = Just v some_alter (Just (More t)) = some_norm $ M.alter f k t {-------------------------------------------------------------------- Union --------------------------------------------------------------------} -- | The union of a list of maps. unions :: Ord k => [Map k a] -> Map k a unions xs = foldl' union empty xs -- | The union of a list of maps, with a combining operation. unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a unionsWith f xs = foldl' (unionWith f) empty xs -- | The (left-biased) union of two maps. -- It prefers the first map when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). union :: Ord k => Map k a -> Map k a -> Map k a union (Map m1) (Map m2) = Map $ I.unionWith some_union m1 m2 where some_union v@(Only k x) (Only l y) | k `eq` l = v | otherwise = More (M.singleton k x `M.union` M.singleton l y) some_union (Only k x) (More t) = More $ M.singleton k x `M.union` t some_union (More t) (Only k x) = More $ t `M.union` M.singleton k x some_union (More t) (More u) = More $ t `M.union` u some_union_with_key :: Ord k => (k -> a -> a -> a) -> Some k a -> Some k a -> Some k a some_union_with_key f (Only k x) (Only l y) | k `eq` l = Only k (f k x y) | otherwise = More (M.unionWithKey f (M.singleton k x) (M.singleton l y)) some_union_with_key f (Only k x) (More t) = More $ M.unionWithKey f (M.singleton k x) t some_union_with_key f (More t) (Only k x) = More $ M.unionWithKey f t (M.singleton k x) some_union_with_key f (More t) (More u) = More $ M.unionWithKey f t u -- | The union with a combining function. unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith f (Map m1) (Map m2) = Map $ I.unionWith (some_union_with_key $ const f) m1 m2 -- | The union with a combining function. unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey f (Map m1) (Map m2) = Map $ I.unionWith (some_union_with_key f) m1 m2 {-------------------------------------------------------------------- Difference --------------------------------------------------------------------} -- | Difference between two maps (based on keys). difference :: Ord k => Map k a -> Map k b -> Map k a difference (Map m1) (Map m2) = Map $ I.differenceWith some_diff m1 m2 where some_diff v@(Only k _) (Only l _) | k `eq` l = Nothing | otherwise = Just v some_diff v@(Only k _) (More t) | k `M.member` t = Nothing | otherwise = Just v some_diff (More t) (Only k _) = some_norm $ M.delete k t some_diff (More t) (More u) = some_norm $ t `M.difference` u some_diff_with_key :: Ord k => (k -> a -> b -> Maybe a) -> Some k a -> Some k b -> Maybe (Some k a) some_diff_with_key f v@(Only k x) (Only l y) | k `eq` l = f k x y >>= return . Only k | otherwise = Just v some_diff_with_key f (Only k x) (More t) = some_norm $ M.differenceWithKey f (M.singleton k x) t some_diff_with_key f (More t) (Only k x) = some_norm $ M.differenceWithKey f t (M.singleton k x) some_diff_with_key f (More t) (More u) = some_norm $ M.differenceWithKey f t u -- | Difference with a combining function. differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWith f (Map m1) (Map m2) = Map $ I.differenceWith (some_diff_with_key $ const f) m1 m2 -- | Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). -- If it returns (@'Just' y@), the element is updated with a new value @y@. differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWithKey f (Map m1) (Map m2) = Map $ I.differenceWith (some_diff_with_key f) m1 m2 {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------} delete_empty :: I.IntMap (Some k a) -> I.IntMap (Some k a) delete_empty = I.filter some_empty where some_empty (Only _ _) = True some_empty (More t) = not $ M.null t -- | The (left-biased) intersection of two maps (based on keys). intersection :: Ord k => Map k a -> Map k b -> Map k a intersection (Map m1) (Map m2) = Map $ delete_empty $ I.intersectionWith some_intersection m1 m2 where some_intersection v@(Only k _) (Only l _) | k `eq` l = v | otherwise = More (M.empty) some_intersection v@(Only k _) (More t) | k `M.member` t = v | otherwise = More (M.empty) some_intersection (More t) (Only k x) = some_norm' $ M.intersection t (M.singleton k x) some_intersection (More t) (More u) = some_norm' $ M.intersection t u some_intersection_with_key :: Ord k => (k -> a -> b -> c) -> Some k a -> Some k b -> Some k c some_intersection_with_key f (Only k x) (Only l y) | k `eq` l = Only k (f k x y) | otherwise = More (M.empty) some_intersection_with_key f (Only k x) (More t) = some_norm' $ M.intersectionWithKey f (M.singleton k x) t some_intersection_with_key f (More t) (Only k x) = some_norm' $ M.intersectionWithKey f t (M.singleton k x) some_intersection_with_key f (More t) (More u) = some_norm' $ M.intersectionWithKey f t u -- | The intersection with a combining function. intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWith f (Map m1) (Map m2) = Map $ delete_empty $ I.intersectionWith (some_intersection_with_key $ const f) m1 m2 -- | The intersection with a combining function. intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWithKey f (Map m1) (Map m2) = Map $ delete_empty $ I.intersectionWith (some_intersection_with_key f) m1 m2 {-------------------------------------------------------------------- Submap --------------------------------------------------------------------} -- | Is this a proper submap? (ie. a submap but not equal). isProperSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2 = isSubmapOf m1 m2 && size m1 < size m2 -- | Is this a proper submap? (ie. a submap but not equal). The expression -- (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @m1@ and @m2@ are not -- equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when -- applied to their respective values. isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool isProperSubmapOfBy f m1 m2 = isSubmapOfBy f m1 m2 && size m1 < size m2 -- | Is this a submap? isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool isSubmapOf (Map m1) (Map m2) = I.isSubmapOfBy some_isSubmapOf m1 m2 where some_isSubmapOf (Only k _) (Only l _) = k `eq` l some_isSubmapOf (Only k _) (More t) = k `M.member` t some_isSubmapOf (More _) (Only _ _) = False some_isSubmapOf (More t) (More u) = t `M.isSubmapOf` u -- | The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if all keys in -- @m1@ are in @m2@, and when @f@ returns 'True' when applied to their -- respective values. isSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool isSubmapOfBy f (Map m1) (Map m2) = I.isSubmapOfBy some_isSubmapOfBy m1 m2 where some_isSubmapOfBy (Only k x) (Only l y) = k `eq` l && x `f` y some_isSubmapOfBy (Only k x) (More t) = case M.lookup k t of Just y -> f x y _ -> False some_isSubmapOfBy (More _) (Only _ _) = False some_isSubmapOfBy (More t) (More u) = M.isSubmapOfBy f t u {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------} -- | Map a function over all values in the map. map :: (a -> b) -> Map k a -> Map k b map f (Map m) = Map $ I.map some_map m where some_map (Only k x) = Only k $ f x some_map (More t) = More $ M.map f t -- | Map a function over all values in the map. mapWithKey :: (k -> a -> b) -> Map k a -> Map k b mapWithKey f (Map m) = Map $ I.map some_map_with_key m where some_map_with_key (Only k x) = Only k $ f k x some_map_with_key (More t) = More $ M.mapWithKey f t -- | The function @'mapAccum'@ threads an accumulating argument through the map -- in unspecified order of keys. mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccum f a (Map m) = case I.mapAccum some_map_accum a m of (acc, m') -> (acc, Map m') where some_map_accum acc (Only k x) = case f acc x of (acc', x') -> (acc', Only k x') some_map_accum acc (More t) = case M.mapAccum f acc t of (acc', t') -> (acc', More t') -- | The function @'mapAccumWithKey'@ threads an accumulating argument through -- the map in unspecified order of keys. mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumWithKey f a (Map m) = case I.mapAccum some_map_accum_with_key a m of (acc, m') -> (acc, Map m') where some_map_accum_with_key acc (Only k x) = case f acc k x of (acc', x') -> (acc', Only k x') some_map_accum_with_key acc (More t) = case M.mapAccumWithKey f acc t of (acc', t') -> (acc', More t') {-------------------------------------------------------------------- Filter --------------------------------------------------------------------} -- | Filter all values that satisfy some predicate. filter :: Ord k => (a -> Bool) -> Map k a -> Map k a filter p (Map m) = Map $ I.mapMaybe some_filter m where some_filter v@(Only _ x) | p x = Just v | otherwise = Nothing some_filter (More t) = some_norm $ M.filter p t -- | Filter all keys\/values that satisfy some predicate. filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a filterWithKey p (Map m) = Map $ I.mapMaybe some_filter_with_key m where some_filter_with_key v@(Only k x) | p k x = Just v | otherwise = Nothing some_filter_with_key (More t) = some_norm $ M.filterWithKey p t -- | Partition the map according to some predicate. The first map contains all -- elements that satisfy the predicate, the second all elements that fail the -- predicate. partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a) partition p m = (filter p m, filter (not . p) m) -- | Partition the map according to some predicate. The first map contains all -- elements that satisfy the predicate, the second all elements that fail the -- predicate. partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a) partitionWithKey p m = (filterWithKey p m, filterWithKey (\k -> not . p k) m) -- | Map values and collect the 'Just' results. mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b mapMaybe f (Map m) = Map $ I.mapMaybe some_map_maybe m where some_map_maybe (Only k x) = f x >>= return . Only k some_map_maybe (More t) = some_norm $ M.mapMaybe f t -- | Map keys\/values and collect the 'Just' results. mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b mapMaybeWithKey f (Map m) = Map $ I.mapMaybe some_map_maybe_with_key m where some_map_maybe_with_key (Only k x) = f k x >>= return . Only k some_map_maybe_with_key (More t) = some_norm $ M.mapMaybeWithKey f t -- | Map values and separate the 'Left' and 'Right' results. mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEither f m = (mapMaybe (maybe_left . f) m, mapMaybe (maybe_right . f) m) -- | Map keys\/values and separate the 'Left' and 'Right' results. mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEitherWithKey f m = (mapMaybeWithKey (\k a -> maybe_left (f k a)) m ,mapMaybeWithKey (\k a -> maybe_right (f k a)) m) -- Helper functions for this section maybe_left :: Either a b -> Maybe a maybe_left (Left a) = Just a maybe_left (Right _) = Nothing maybe_right :: Either a b -> Maybe b maybe_right (Right b) = Just b maybe_right (Left _) = Nothing {-------------------------------------------------------------------- Fold --------------------------------------------------------------------} -- | Fold the values in the map, such that @'fold' f z == 'Prelude.foldr' -- f z . 'elems'@. fold :: (a -> b -> b) -> b -> Map k a -> b fold f z (Map m) = I.fold some_fold z m where some_fold (Only _ x) y = f x y some_fold (More t) y = M.fold f y t -- | Fold the keys and values in the map, such that @'foldWithKey' f z == -- 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b foldWithKey f z (Map m) = I.fold some_fold_with_key z m where some_fold_with_key (Only k x) y = f k x y some_fold_with_key (More t) y = M.foldWithKey f y t {-------------------------------------------------------------------- List variations --------------------------------------------------------------------} -- | Return all elements of the map in arbitrary order of their keys. elems :: Map k a -> [a] elems (Map m) = I.fold some_append_elems [] m where some_append_elems (Only _ x) acc = x : acc some_append_elems (More t) acc = M.elems t ++ acc -- | Return all keys of the map in arbitrary order. keys :: Map k a -> [k] keys (Map m) = I.fold some_append_keys [] m where some_append_keys (Only k _) acc = k : acc some_append_keys (More t) acc = M.keys t ++ acc -- | The set of all keys of the map. keysSet :: Ord k => Map k a -> S.Set k keysSet (Map m) = I.fold (S.union . some_keys_set) S.empty m where some_keys_set (Only k _) = S.singleton k some_keys_set (More t) = M.keysSet t -- | Return all key\/value pairs in the map in arbitrary key order. assocs :: Map k a -> [(k,a)] assocs = toList {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -- | Convert the map to a list of key\/value pairs. toList :: Map k a -> [(k,a)] toList (Map m) = I.fold some_append [] m where some_append (Only k x) acc = (k, x) : acc some_append (More t) acc = M.toList t ++ acc -- | Create a map from a list of key\/value pairs. fromList :: (Hashable k, Ord k) => [(k,a)] -> Map k a fromList xs = foldl' (\m (k, x) -> insert k x m) empty xs -- | Create a map from a list of key\/value pairs with a combining function. fromListWith :: (Hashable k, Ord k) => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs = foldl' (\m (k, x) -> insertWith f k x m) empty xs -- | Build a map from a list of key\/value pairs with a combining function. fromListWithKey :: (Hashable k, Ord k) => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs = foldl' (\m (k, x) -> insertWithKey f k x m) empty xs hashmap-1.3.1.1/Data/HashSet.hs0000644000000000000000000003041612726362514014242 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.HashSet -- Copyright : (c) Milan Straka 2011 -- License : BSD-style -- Maintainer : fox@ucw.cz -- Stability : provisional -- Portability : portable -- -- Persistent 'Set' based on hashing, which is defined as -- -- @ -- data 'Set' e = 'Data.IntMap.IntMap' (Some e) -- @ -- -- is an 'Data.IntMap.IntMap' indexed by hash values of elements, -- containing a value of @Some e@. That contains either one 'e' -- or a @'Data.Set.Set' e@ with elements of the same hash values. -- -- The interface of a 'Set' is a suitable subset of 'Data.IntSet.IntSet' -- and can be used as a drop-in replacement of 'Data.Set.Set'. -- -- The complexity of operations is determined by the complexities of -- 'Data.IntMap.IntMap' and 'Data.Set.Set' operations. See the sources of -- 'Set' to see which operations from @containers@ package are used. ----------------------------------------------------------------------------- module Data.HashSet ( Set , HashSet -- * Operators , (\\) -- * Query , null , size , member , notMember , isSubsetOf , isProperSubsetOf -- * Construction , empty , singleton , insert , delete -- * Combine , union , unions , difference , intersection -- * Filter , filter , partition -- * Map , map -- * Fold , fold -- * Conversion , elems , toList , fromList ) where import Prelude hiding (lookup,map,filter,null) import Control.DeepSeq import Data.Hashable import Data.List (foldl') import Data.Monoid (Monoid(..)) import Data.Typeable #if __GLASGOW_HASKELL__ import Text.Read import Data.Data (Data(..), mkNoRepType) #endif import qualified Data.IntMap as I import qualified Data.Set as S {-------------------------------------------------------------------- Operators --------------------------------------------------------------------} -- | Same as 'difference'. (\\) :: Ord a => Set a -> Set a -> Set a s1 \\ s2 = difference s1 s2 {-------------------------------------------------------------------- Types --------------------------------------------------------------------} data Some a = Only !a | More !(S.Set a) deriving (Eq, Ord) instance NFData a => NFData (Some a) where rnf (Only a) = rnf a rnf (More s) = rnf s -- | The abstract type of a @Set@. Its interface is a suitable -- subset of 'Data.IntSet.IntSet'. newtype Set a = Set (I.IntMap (Some a)) deriving (Eq, Ord) -- | The @HashSet@ is a type synonym for @Set@ for backward compatibility. -- It is deprecated and will be removed in furture releases. {-# DEPRECATED HashSet "HashSet is deprecated. Please use Set instead." #-} type HashSet a = Set a instance NFData a => NFData (Set a) where rnf (Set s) = rnf s instance Ord a => Monoid (Set a) where mempty = empty mappend = union mconcat = unions instance Show a => Show (Set a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) instance (Hashable a, Ord a, Read a) => Read (Set a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \ r -> do ("fromList",s) <- lex r (xs,t) <- reads s return (fromList xs,t) #endif #include "hashmap.h" INSTANCE_TYPEABLE1(Set,setTc,"Set") #if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} -- This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Hashable a, Ord a, Data a) => Data (Set a) where gfoldl f z m = z fromList `f` (toList m) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.HashSet.Set" dataCast1 f = gcast1 f #endif {-------------------------------------------------------------------- Comparing elements --------------------------------------------------------------------} -- For ByteStrings, doing compare is usually faster than doing (==), -- according to benchmarks. A Set is using compare naturally. We therefore -- define eq :: Ord a => a -> a -> Bool, which serves as (==). {-# INLINE eq #-} eq :: Ord a => a -> a -> Bool eq x y = x `compare` y == EQ {-------------------------------------------------------------------- Query --------------------------------------------------------------------} -- | Is the set empty? null :: Set a -> Bool null (Set s) = I.null s -- | Number of elements in the set. size :: Set a -> Int size (Set s) = I.fold ((+) . some_size) 0 s where some_size (Only _) = 1 some_size (More t) = S.size t -- | Is the element a member of the set? member :: (Hashable a, Ord a) => a -> Set a -> Bool member a (Set s) = case I.lookup (hash a) s of Nothing -> False Just (Only a') -> a `eq` a' Just (More s') -> S.member a s' -- | Is the element not a member of the set? notMember :: (Hashable a, Ord a) => a -> Set a -> Bool notMember k s = not $ member k s -- | Is this a subset? isSubsetOf :: Ord a => Set a -> Set a -> Bool isSubsetOf (Set s1) (Set s2) = I.isSubmapOfBy (some_isSubsetOf) s1 s2 where some_isSubsetOf (Only a) (Only b) = a `eq` b some_isSubsetOf (Only a) (More s) = a `S.member` s some_isSubsetOf (More _) (Only _) = False some_isSubsetOf (More s) (More t) = s `S.isSubsetOf` t -- | Is this a proper subset? (ie. a subset but not equal). isProperSubsetOf :: Ord a => Set a -> Set a -> Bool isProperSubsetOf s1 s2 = isSubsetOf s1 s2 && size s1 < size s2 {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} -- | The empty set. empty :: Set a empty = Set I.empty -- | A set of one element. singleton :: Hashable a => a -> Set a singleton a = Set $ I.singleton (hash a) $ Only a -- | Add a value to the set. When the value is already an element of the set, -- it is replaced by the new one, ie. 'insert' is left-biased. insert :: (Hashable a, Ord a) => a -> Set a -> Set a insert a (Set s) = Set $ I.insertWith some_insert (hash a) (Only a) s where some_insert _ v@(Only b) | a `eq` b = v | otherwise = More $ S.insert a (S.singleton b) some_insert _ (More t) = More $ S.insert a t some_norm :: S.Set a -> Maybe (Some a) some_norm s = case S.size s of 0 -> Nothing 1 -> Just $ Only $ S.findMin s _ -> Just $ More $ s some_norm' :: S.Set a -> Some a some_norm' s = case S.size s of 1 -> Only $ S.findMin s _ -> More $ s -- | Delete a value in the set. Returns the original set when the value was not -- present. delete :: (Hashable a, Ord a) => a -> Set a -> Set a delete a (Set s) = Set $ I.update some_delete (hash a) s where some_delete v@(Only b) | a `eq` b = Nothing | otherwise = Just v some_delete (More t) = some_norm $ S.delete a t {-------------------------------------------------------------------- Combine --------------------------------------------------------------------} -- | The union of two sets. union :: Ord a => Set a -> Set a -> Set a union (Set s1) (Set s2) = Set $ I.unionWith some_union s1 s2 where some_union v@(Only a) (Only b) | a `eq` b = v | otherwise = More (S.singleton a `S.union` S.singleton b) some_union (Only a) (More s) = More $ S.singleton a `S.union` s some_union (More s) (Only a) = More $ s `S.union` S.singleton a some_union (More s) (More t) = More $ s `S.union` t -- | The union of a list of sets. unions :: Ord a => [Set a] -> Set a unions xs = foldl' union empty xs -- | Difference between two sets. difference :: Ord a => Set a -> Set a -> Set a difference (Set s1) (Set s2) = Set $ I.differenceWith some_diff s1 s2 where some_diff v@(Only a) (Only b) | a `eq` b = Nothing | otherwise = Just v some_diff v@(Only a) (More s) | a `S.member` s = Nothing | otherwise = Just v some_diff (More s) (Only a) = some_norm $ S.delete a s some_diff (More s) (More t) = some_norm $ s `S.difference` t -- The I.intersectionWith does not have type general enough. We need the function -- given to I.intersectionWith to have type a -> b -> Maybe c, so the elements could -- be deleted from the IntMap. As it is only a -> b -> c, we allow empty sets to be -- in the resulting intersection and delete them with a filter afterwards. This is -- the function performing the deletions. delete_empty :: I.IntMap (Some a) -> I.IntMap (Some a) delete_empty = I.filter some_empty where some_empty (Only _) = True some_empty (More s) = not $ S.null s -- | The intersection of two sets. intersection :: Ord a => Set a -> Set a -> Set a intersection (Set s1) (Set s2) = Set $ delete_empty $ I.intersectionWith some_intersection s1 s2 where some_intersection v@(Only a) (Only b) | a `eq` b = v | otherwise = More (S.empty) some_intersection v@(Only a) (More s) | a `S.member` s = v | otherwise = More (S.empty) some_intersection (More s) (Only a) | a `S.member` s = Only (S.findMin $ s `S.intersection` (S.singleton a)) | otherwise = More (S.empty) some_intersection (More s) (More t) = some_norm' $ s `S.intersection` t {-------------------------------------------------------------------- Filter --------------------------------------------------------------------} -- | Filter all elements that satisfy some predicate. filter :: Ord a => (a -> Bool) -> Set a -> Set a filter p (Set s) = Set $ I.mapMaybe some_filter s where some_filter v@(Only a) | p a = Just v | otherwise = Nothing some_filter (More t) = some_norm (S.filter p t) -- | Partition the set according to some predicate. The first set contains all -- elements that satisfy the predicate, the second all elements that fail the -- predicate. partition :: Ord a => (a -> Bool) -> Set a -> (Set a, Set a) partition p s = (filter p s, filter (not . p) s) {-------------------------------------------------------------------- Map --------------------------------------------------------------------} -- | @'map' f s@ is the set obtained by applying @f@ to each element of @s@. -- -- It's worth noting that the size of the result may be smaller if, for some -- @(x,y)@, @x /= y && f x == f y@ map :: (Hashable b, Ord b) => (a -> b) -> Set a -> Set b map f = fromList . fold ((:) . f) [] {-------------------------------------------------------------------- Fold --------------------------------------------------------------------} -- | Fold over the elements of a set in an unspecified order. fold :: (a -> b -> b) -> b -> Set a -> b fold f z (Set s) = I.fold some_fold z s where some_fold (Only a) x = f a x some_fold (More t) x = S.fold f x t {-------------------------------------------------------------------- Conversions --------------------------------------------------------------------} -- | The elements of a set. (For sets, this is equivalent to toList). elems :: Set a -> [a] elems = toList -- | Convert the set to a list of elements. toList :: Set a -> [a] toList (Set s) = I.fold some_append [] s where some_append (Only a) acc = a : acc some_append (More t) acc = S.toList t ++ acc -- | Create a set from a list of elements. fromList :: (Hashable a, Ord a) => [a] -> Set a fromList xs = foldl' (flip insert) empty xs