critbit (empty) → 0.0.0.0
raw patch · 11 files changed
+1390/−0 lines, 11 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, bytestring-trie, containers, critbit, criterion, deepseq, hashable, mtl, mwc-random, test-framework, test-framework-quickcheck2, text, unordered-containers, vector
Files
- Data/CritBit/Core.hs +152/−0
- Data/CritBit/Map/Lazy.hs +22/−0
- Data/CritBit/Tree.hs +421/−0
- Data/CritBit/Types/Internal.hs +119/−0
- LICENSE +26/−0
- README.markdown +208/−0
- Setup.lhs +3/−0
- benchmarks/Benchmarks.hs +189/−0
- critbit.cabal +91/−0
- tests/Main.hs +22/−0
- tests/Properties.hs +137/−0
+ Data/CritBit/Core.hs view
@@ -0,0 +1,152 @@+-- |+-- Module : Data.CritBit.Tree+-- Copyright : (c) Bryan O'Sullivan 2013+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- "Core" functions that implement the crit-bit tree algorithms.+--+-- I plopped these functions into their own source file to demonstrate+-- just how small the core of the crit-bit tree concept is.+--+-- I have also commented this module a bit more heavily than I usually+-- do, in the hope that the comments will make the code more+-- approachable to less experienced Haskellers.+module Data.CritBit.Core+ (+ -- * Public functions+ insert+ , lookupWith+ , delete+ -- * Internal functions+ , calcDirection+ , direction+ , followPrefixes+ ) where++import Data.Bits ((.|.), (.&.), complement, shiftR, xor)+import Data.CritBit.Types.Internal+import Data.Word (Word16)++-- | /O(log n)/. Insert a new key and value in the map. If the key is+-- already present in the map, the associated value is replaced with+-- the supplied value. 'insert' is equivalent to @'insertWith'+-- 'const'@.+--+-- > insert "b" 7 (fromList [("a",5), ("b",3)]) == fromList [("a",5), ("b",7)]+-- > insert "x" 7 (fromList [("a",5), ("b",3)]) == fromList [("a",5), ("b",3), ("x",7)]+-- > insert "x" 5 empty == singleton "x" 5+insert :: (CritBitKey k) => k -> v -> CritBit k v -> CritBit k v+insert k v (CritBit root) = CritBit . go $ root+ where+ go i@(Internal left right _ _)+ | direction k i == 0 = go left+ | otherwise = go right+ go (Leaf lk _) = rewalk root+ where+ rewalk i@(Internal left right byte otherBits)+ | byte > n = finish i+ | byte == n && otherBits > nob = finish i+ | direction k i == 0 = i { ileft = rewalk left }+ | otherwise = i { iright = rewalk right }+ rewalk i = finish i++ finish (Leaf _ _) | k == lk = Leaf lk v+ finish node+ | nd == 0 = Internal { ileft = node, iright = Leaf k v,+ ibyte = n, iotherBits = nob }+ | otherwise = Internal { ileft = Leaf k v, iright = node,+ ibyte = n, iotherBits = nob }++ (n, nob, c) = followPrefixes k lk+ nd = calcDirection nob c+ go Empty = Leaf k v+{-# INLINABLE insert #-}++lookupWith :: (CritBitKey k) =>+ a -- ^ Failure continuation+ -> (v -> a) -- ^ Success continuation+ -> k+ -> CritBit k v -> a+-- We use continuations here to avoid reimplementing the lookup+-- algorithm with trivial variations.+lookupWith notFound found k (CritBit root) = go root+ where+ go i@(Internal left right _ _)+ | direction k i == 0 = go left+ | otherwise = go right+ go (Leaf lk v) | k == lk = found v+ go _ = notFound+{-# INLINE lookupWith #-}++-- | /O(log n)/. 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 "a" (fromList [("a",5), ("b",3)]) == singleton "b" 3+-- > delete "c" (fromList [("a",5), ("b",3)]) == fromList [("a",5), ("b",3)]+-- > delete "a" empty == empty+delete :: (CritBitKey k) => k -> CritBit k v -> CritBit k v+-- Once again with the continuations! It's somewhat faster to do+-- things this way than to expicitly unwind our recursion once we've+-- found the leaf to delete. It's also a ton less code.+--+-- (If you want a good little exercise, rewrite this function without+-- using continuations, and benchmark the two versions.)+delete k t@(CritBit root) = go root CritBit+ where+ go i@(Internal left right _ _) cont+ | direction k i == 0 = go left $ \new ->+ case new of+ Empty -> cont right+ l -> cont $! i { ileft = l }+ | otherwise = go right $ \new ->+ case new of+ Empty -> cont left+ r -> cont $! i { iright = r }+ go (Leaf lk _) cont+ | k == lk = cont Empty+ go _ _ = t+{-# INLINABLE delete #-}++-- | Determine which direction we should move down the tree based on+-- the critical bitmask at the current node and the corresponding byte+-- in the key. Left is 0, right is 1.+direction :: (CritBitKey k) => k -> Node k v -> Int+direction k (Internal _ _ byte otherBits) =+ calcDirection otherBits (getByte k byte)+direction _ _ = error "Data.CritBit.Core.direction: unpossible!"+{-# INLINE direction #-}++-- Given a critical bitmask and a byte, return 0 to move left, 1 to+-- move right.+calcDirection :: BitMask -> Word16 -> Int+calcDirection otherBits c = (1 + fromIntegral (otherBits .|. c)) `shiftR` 9+{-# INLINE calcDirection #-}++-- | Figure out the byte offset at which the key we are interested in+-- differs from the leaf we reached when we initially walked the tree.+--+-- We return some auxiliary stuff that we'll bang on to help us figure+-- out which direction to go in to insert a new node.+followPrefixes :: (CritBitKey k) =>+ k -- ^ The key from "outside" the tree.+ -> k -- ^ Key from the leaf we reached.+ -> (Int, BitMask, Word16)+{-# INLINE followPrefixes #-}+followPrefixes k l = go 0+ where+ go n | n == byteCount k = (n, maskLowerBits c, c)+ | n == byteCount l = (n, maskLowerBits b, 0)+ | b /= c = (n, maskLowerBits (b `xor` c), c)+ | otherwise = go (n+1)+ where b = getByte k n+ c = getByte l n++ maskLowerBits v = (n3 .&. (complement (n3 `shiftR` 1))) `xor` 511+ where+ n3 = n2 .|. (n2 `shiftR` 8)+ n2 = n1 .|. (n1 `shiftR` 4)+ n1 = n0 .|. (n0 `shiftR` 2)+ n0 = v .|. (v `shiftR` 1)
+ Data/CritBit/Map/Lazy.hs view
@@ -0,0 +1,22 @@+-- |+-- Module : Data.CritBit.Map.Lazy+-- Copyright : (c) Bryan O'Sullivan 2013+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- A crit-bit tree that does not evaluate its values by default.+--+-- For every /n/ key-value pairs stored, a crit-bit tree uses /n/-1+-- internal nodes, for a total of 2/n/-1 internal nodes and leaves.+module Data.CritBit.Map.Lazy+ (+ -- * Types+ CritBitKey(..)+ , CritBit+ , module Data.CritBit.Tree+ ) where++import Data.CritBit.Tree+import Data.CritBit.Types.Internal
+ Data/CritBit/Tree.hs view
@@ -0,0 +1,421 @@+{-# LANGUAGE BangPatterns, RecordWildCards, ScopedTypeVariables #-}++-- |+-- Module : Data.CritBit.Tree+-- Copyright : (c) Bryan O'Sullivan 2013+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+module Data.CritBit.Tree+ (+ -- * Operators+ -- , (!)+ -- , (\\)++ -- * Query+ null+ , size+ , member+ , notMember+ , lookup+ , findWithDefault+ , lookupGT+ -- , lookupGE++ -- * Construction+ , empty+ , singleton++ -- * Insertion+ , insert+ -- , insertWith+ -- , insertWithKey+ -- , insertLookupWithKey++ -- * Deletion+ , delete+ -- , adjust+ -- , adjustWithKey+ -- , update+ -- , updateWithKey+ -- , updateLookupWithKey+ -- , alter++ -- * Combination+ -- ** Union+ , union+ -- , unionWith+ -- , unionWithKey+ -- , unions+ -- , unionsWith+ , unionL+ , unionR++ -- ** Difference+ -- , difference+ -- , differenceWith+ -- , differenceWithKey++ -- ** Intersection+ -- , intersection+ -- , intersectionWith+ -- , intersectionWithKey++ -- * Traversal+ -- ** Map+ -- , map+ -- , mapWithKey+ -- , traverseWithKey+ -- , mapAccum+ -- , mapAccumWithKey+ -- , mapAccumRWithKey+ -- , mapKeys+ -- , mapKeysWith+ -- , mapKeysMonotonic++ -- * Folds+ , foldl+ , foldr+ , foldlWithKey+ , foldrWithKey++ -- ** Strict folds+ , foldl'+ , foldr'+ , foldlWithKey'+ , foldrWithKey'++ -- * Conversion+ -- , elems+ , keys+ -- , assocs+ -- , keysSet+ -- , fromSet++ -- ** Lists+ , toList+ , fromList+ -- , fromListWith+ -- , fromListWithKey++ -- ** Ordered lists+ -- , toAscList+ -- , toDescList+ -- , fromAscList+ -- , fromAscListWith+ -- , fromAscListWithKey+ -- , fromDistinctAscList++ -- * Filter+ -- , filter+ -- , filterWithKey+ -- , partition+ -- , partitionWithKey++ -- , mapMaybe+ -- , mapMaybeWithKey+ -- , mapEither+ -- , mapEitherWithKey++ -- , split+ -- , splitLookup++ -- * Submap+ -- , isSubmapOf+ -- , isSubmapOfBy+ -- , isProperSubmapOf+ -- , isProperSubmapOfBy++ -- -- * Min\/Max+ -- , findMin+ -- , findMax+ -- , deleteMin+ -- , deleteMax+ -- , deleteFindMin+ -- , deleteFindMax+ -- , updateMin+ -- , updateMax+ -- , updateMinWithKey+ -- , updateMaxWithKey+ -- , minView+ -- , maxView+ -- , minViewWithKey+ -- , maxViewWithKey+ ) where++import Data.CritBit.Core+import Data.CritBit.Types.Internal+import Prelude hiding (foldl, foldr, lookup, null)+import qualified Data.List as List++-- | /O(1)/. Is the map empty?+--+-- > null (empty) == True+-- > null (singleton 1 'a') == False+null :: CritBit k v -> Bool+null (CritBit Empty) = True+null _ = False++-- | /O(1)/. The empty map.+--+-- > empty == fromList []+-- > size empty == 0+empty :: CritBit k v+empty = CritBit { cbRoot = Empty }++-- | /O(log n)/. Is the key a member of the map?+--+-- > member "a" (fromList [("a",5), ("b",3)]) == True+-- > member "c" (fromList [("a",5), ("b",3)]) == False+--+-- See also 'notMember'.+member :: (CritBitKey k) => k -> CritBit k v -> Bool+member k m = lookupWith False (const True) k m+{-# INLINABLE member #-}++-- | /O(log n)/. Is the key not a member of the map?+--+-- > notMember "a" (fromList [("a",5), ("b",3)]) == False+-- > notMember "c" (fromList [("a",5), ("b",3)]) == True+--+-- See also 'member'.+notMember :: (CritBitKey k) => k -> CritBit k v -> Bool+notMember k m = lookupWith True (const False) k m+{-# INLINE notMember #-}++-- | /O(log n)/. 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.+--+-- An example of using @lookup@:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > import Data.Text+-- > import Prelude hiding (lookup)+-- > import Data.CritBit.Map.Lazy+-- >+-- > employeeDept, deptCountry, countryCurrency :: CritBit Text Text+-- > employeeDept = fromList [("John","Sales"), ("Bob","IT")]+-- > deptCountry = fromList [("IT","USA"), ("Sales","France")]+-- > countryCurrency = fromList [("USA", "Dollar"), ("France", "Euro")]+-- >+-- > employeeCurrency :: Text -> Maybe Text+-- > employeeCurrency name = do+-- > dept <- lookup name employeeDept+-- > country <- lookup dept deptCountry+-- > lookup country countryCurrency+-- >+-- > main = do+-- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John"))+-- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete"))+--+-- The output of this program:+--+-- > John's currency: Just "Euro"+-- > Pete's currency: Nothing+lookup :: (CritBitKey k) => k -> CritBit k v -> Maybe v+lookup k m = lookupWith Nothing Just k m+{-# INLINABLE lookup #-}++-- | /O(log n)/. Returns the value associated with the given key, or+-- the given default value if the key is not in the map.+--+-- > findWithDefault 1 "x" (fromList [("a",5), ("b",3)]) == 1+-- > findWithDefault 1 "a" (fromList [("a",5), ("b",3)]) == 5+findWithDefault :: (CritBitKey k) =>+ v -- ^ Default value to return if lookup fails.+ -> k -> CritBit k v -> v+findWithDefault d k m = lookupWith d id k m+{-# INLINABLE findWithDefault #-}++-- | /O(log n)/. Find smallest key greater than the given one and+-- return the corresponding (key, value) pair.+--+-- > lookupGT "aa" (fromList [("a",3), ("b",5)]) == Just ("b",5)+-- > lookupGT "b" (fromList [("a",3), ("b",5)]) == Nothing+lookupGT :: (CritBitKey k) => k -> CritBit k v -> Maybe (k, v)+lookupGT k (CritBit root) = go root+ where+ go i@(Internal left right _ _)+ | direction k i == 0 = go left+ | otherwise = go right+ go (Leaf lk lv) = rewalk root+ where+ finish (Leaf _ _) = case byteCompare k lk of+ LT -> Just (lk, lv)+ _ -> Nothing+ finish node+ | calcDirection nob c == 0 = Nothing+ | otherwise = leftmost node+ rewalk i@(Internal left right byte otherBits)+ | byte > n = finish i+ | byte == n && otherBits > nob = finish i+ | direction k i == 0 = case rewalk left of+ Nothing -> leftmost right+ wat -> wat+ | otherwise = rewalk right+ rewalk i = finish i+ (n, nob, c) = followPrefixes k lk+ go Empty = Nothing+ leftmost (Internal left _ _ _) = leftmost left+ leftmost (Leaf lmk lmv) = Just (lmk, lmv)+ leftmost _ = Nothing+{-# INLINABLE lookupGT #-}++byteCompare :: (CritBitKey k) => k -> k -> Ordering+byteCompare a b = go 0+ where+ go i = case ba `compare` getByte b i of+ EQ | ba /= 0 -> go (i + 1)+ wat -> wat+ where ba = getByte a i+{-# INLINABLE byteCompare #-}++-- | /O(n*log n)/. Build a map from a list of key\/value pairs. If+-- the list contains more than one value for the same key, the last+-- value for the key is retained.+--+-- > fromList [] == empty+-- > fromList [("a",5), ("b",3), ("a",2)] == fromList [("a",2), ("b",3)]+fromList :: (CritBitKey k) => [(k, v)] -> CritBit k v+fromList = List.foldl' (flip (uncurry insert)) empty+{-# INLINABLE fromList #-}++-- | /O(1)/. A map with a single element.+--+-- > singleton "a" 1 == fromList [("a", 1)]+singleton :: k -> v -> CritBit k v+singleton k v = CritBit (Leaf k v)+{-# INLINE singleton #-}++-- | /O(n)/. The number of elements in the map.+--+-- > size empty == 0+-- > size (singleton "a" 1) == 1+-- > size (fromList [("a",1), ("c",2), ("b",3)]) == 3+size :: CritBit k v -> Int+size (CritBit root) = go root+ where+ go (Internal l r _ _) = go l + go r+ go (Leaf _ _) = 1+ go Empty = 0++-- | /O(n)/. Fold the values in the map using the given+-- left-associative function, such that+-- @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+--+-- Examples:+--+-- > elems = reverse . foldl (flip (:)) []+--+-- > foldl (+) 0 (fromList [("a",5), ("bbb",3)]) == 8+foldl :: (a -> v -> a) -> a -> CritBit k v -> a+foldl f z m = foldlWithKeyWith (\_ b -> b) (\a _ v -> f a v) z m+{-# INLINABLE foldl #-}++-- | /O(n)/. A strict version of 'foldl'. Each application of the+-- function is evaluated before using the result in the next+-- application. This function is strict in the starting value.+foldl' :: (a -> v -> a) -> a -> CritBit k v -> a+foldl' f z m = foldlWithKeyWith seq (\a _ v -> f a v) z m+{-# INLINABLE foldl' #-}++-- | /O(n)/. Fold the keys and values in the map using the given+-- left-associative function, such that+-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.+--+-- Examples:+--+-- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []+--+-- > let f result k a = result ++ "(" ++ show k ++ ":" ++ a ++ ")"+-- > foldlWithKey f "Map: " (fromList [("a",5), ("b",3)]) == "Map: (b:3)(a:5)"+foldlWithKey :: (a -> k -> v -> a) -> a -> CritBit k v -> a+foldlWithKey f z m = foldlWithKeyWith (\_ b -> b) f z m+{-# INLINABLE foldlWithKey #-}++-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of+-- the function is evaluated before using the result in the next+-- application. This function is strict in the starting value.+foldlWithKey' :: (a -> k -> v -> a) -> a -> CritBit k v -> a+foldlWithKey' f z m = foldlWithKeyWith seq f z m+{-# INLINABLE foldlWithKey' #-}++foldlWithKeyWith :: (a -> a -> a) -> (a -> k -> v -> a) -> a -> CritBit k v -> a+foldlWithKeyWith maybeSeq f z0 (CritBit root) = go z0 root+ where+ go z (Internal left right _ _) = let z' = go z left+ in z' `maybeSeq` go z' right+ go z (Leaf k v) = f z k v+ go z Empty = z+{-# INLINE foldlWithKeyWith #-}++-- | /O(n)/. Fold the values in the map using the given+-- right-associative function, such that+-- @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+--+-- Example:+--+-- > elems map = foldr (:) [] map+foldr :: (v -> a -> a) -> a -> CritBit k v -> a+foldr f z m = foldrWithKeyWith (\_ b -> b) (\_ v a -> f v a) z m+{-# INLINABLE foldr #-}++-- | /O(n)/. A strict version of 'foldr'. Each application of the+-- function is evaluated before using the result in the next+-- application. This function is strict in the starting value.+foldr' :: (v -> a -> a) -> a -> CritBit k v -> a+foldr' f z m = foldrWithKeyWith seq (\_ v a -> f v a) z m+{-# INLINABLE foldr' #-}++-- | /O(n)/. Fold the keys and values in the map using the given+-- right-associative function, such that+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+--+-- Examples:+--+-- > keys map = foldrWithKey (\k x ks -> k:ks) [] map+--+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldrWithKey f "Map: " (fromList [("a",5), ("b",3)]) == "Map: (a:5)(b:3)"+foldrWithKey :: (k -> v -> a -> a) -> a -> CritBit k v -> a+foldrWithKey f z m = foldrWithKeyWith (\_ b -> b) f z m+{-# INLINABLE foldrWithKey #-}++-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of+-- the function is evaluated before using the result in the next+-- application. This function is strict in the starting value.+foldrWithKey' :: (k -> v -> a -> a) -> a -> CritBit k v -> a+foldrWithKey' f z m = foldrWithKeyWith seq f z m+{-# INLINABLE foldrWithKey' #-}++foldrWithKeyWith :: (a -> a -> a) -> (k -> v -> a -> a) -> a -> CritBit k v -> a+foldrWithKeyWith maybeSeq f z0 (CritBit root) = go root z0+ where+ go (Internal left right _ _) z = let z' = go right z+ in z' `maybeSeq` go left z'+ go (Leaf k v) z = f k v z+ go Empty z = z+{-# INLINE foldrWithKeyWith #-}++-- | /O(n)/. Return all keys of the map in ascending order.+--+-- > keys (fromList [("b",5), ("a",3)]) == ["a","b"]+-- > keys empty == []+keys :: CritBit k v -> [k]+keys m = foldrWithKey f [] m+ where f k _ ks = k : ks++unionL :: (CritBitKey k) => CritBit k v -> CritBit k v -> CritBit k v+unionL a b = foldlWithKey' (\m k v -> insert k v m) b a+{-# INLINABLE unionL #-}++unionR :: (CritBitKey k) => CritBit k v -> CritBit k v -> CritBit k v+unionR a b = foldlWithKey' (\m k v -> insert k v m) a b+{-# INLINABLE unionR #-}++union :: (CritBitKey k) => CritBit k v -> CritBit k v -> CritBit k v+union a b = unionL a b+{-# INLINE union #-}
+ Data/CritBit/Types/Internal.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- |+-- Module : Data.CritBit.Types.Internal+-- Copyright : (c) Bryan O'Sullivan 2013+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+module Data.CritBit.Types.Internal+ (+ CritBitKey(..)+ , CritBit(..)+ , BitMask+ , Node(..)+ , toList+ ) where++import Control.DeepSeq (NFData(..))+import Data.Bits ((.|.), (.&.), shiftL, shiftR)+import Data.ByteString (ByteString)+import Data.Text ()+import Data.Text.Internal (Text(..))+import Data.Word (Word16)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.Text.Array as T++type BitMask = Word16++data Node k v =+ Internal {+ ileft, iright :: !(Node k v)+ , ibyte :: !Int+ -- ^ The byte at which the left and right subtrees differ.+ , iotherBits :: !BitMask+ -- ^ The bitmask representing the critical bit within the+ -- differing byte. If the critical bit is e.g. 0x8, the bitmask+ -- will have every bit below 0x8 set, hence 0x7.+ }+ | Leaf k v+ | Empty+ -- ^ Logically, the 'Empty' constructor is a property of the tree,+ -- rather than a node (a non-empty tree will never contain any+ -- 'Empty' constructors). In practice, turning 'CritBit' from a+ -- newtype into an ADT with an 'Empty' constructor adds a+ -- pattern-match and a memory indirection to every function, which+ -- slows them all down.+ deriving (Eq, Show)++instance (NFData k, NFData v) => NFData (Node k v) where+ rnf (Internal l r _ _) = rnf l `seq` rnf r+ rnf (Leaf k v) = rnf k `seq` rnf v+ rnf Empty = ()++-- | A crit-bit tree.+newtype CritBit k v = CritBit {+ cbRoot :: Node k v+ } deriving (Eq, NFData)++instance (Show k, Show v) => Show (CritBit k v) where+ show t = "fromList " ++ show (toList t)++-- | A type that can be used as a key in a crit-bit tree.+--+-- We use 9 bits to represent 8-bit bytes so that we can distinguish+-- between an interior byte that is zero (which must have the 9th bit+-- set) and a byte past the end of the input (which must /not/ have+-- the 9th bit set).+--+-- Without this trick, the critical bit calculations would fail on+-- zero bytes /within/ a string, and our tree would be unable to+-- handle arbitrary binary data.+class (Eq k) => CritBitKey k where+ -- | Return the number of bytes used by this key.+ --+ -- For reasonable performance, implementations must be inlined and+ -- /O(1)/.+ byteCount :: k -> Int++ -- | Return the byte at the given offset (counted in bytes) of+ -- this key, bitwise-ORed with 256. If the offset is past the end+ -- of the key, return zero.+ --+ -- For reasonable performance, implementations must be inlined and+ -- /O(1)/.+ getByte :: k -> Int -> Word16++instance CritBitKey ByteString where+ byteCount = B.length+ {-# INLINE byteCount #-}++ getByte bs n+ | n < B.length bs = fromIntegral (B.unsafeIndex bs n) .|. 256+ | otherwise = 0+ {-# INLINE getByte #-}++instance CritBitKey Text where+ byteCount (Text _ _ len) = len `shiftL` 1+ {-# INLINE byteCount #-}++ getByte (Text arr off len) n+ | n < len `shiftL` 1 =+ let word = T.unsafeIndex arr (off + (n `shiftR` 1))+ byteInWord = (word `shiftR` ((n .&. 1) `shiftL` 3)) .&. 0xff+ in byteInWord .|. 256+ | otherwise = 0+ {-# INLINE getByte #-}++-- | /O(n)/. Convert the map to a list of key\/value pairs. The list+-- returned will be sorted in lexicographically ascending order.+--+-- > toList (fromList [("b",3), ("a",5)]) == [("a",5),("b",3)]+-- > toList empty == []+toList :: CritBit k v -> [(k, v)]+toList (CritBit root) = go root []+ where+ go (Internal l r _ _) next = go l (go r next)+ go (Leaf k v) next = (k,v) : next+ go Empty next = next
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2013 Bryan O'Sullivan+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.++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.
+ README.markdown view
@@ -0,0 +1,208 @@+Crit-bit trees for Haskell+====++This is the first purely functional implementation of crit-bit trees+that I'm aware of.++This package exists in part with education in mind:++* The core data structures are simple.++* The core algorithms are easy to grasp.++* I have intentionally structured the source to be easy to follow and+ extend.++* I've *deliberately* left the package incomplete. Ever thought to+ yourself, "I'd write a bit of Haskell if only I had a project to+ work on"? Well, here's your chance! I will set aside time to+ review your code and answer what questions I can.++Education aside, crit-bit trees offer some interesting features+compared to other key/value container types in Haskell.++* For many operations, they are much faster than `Data.Map` from the+ `containers` package. For instance, [`lookup` is about 3x+ faster](http://htmlpreview.github.io/?https://github.com/bos/critbit/blob/master/doc/criterion-sample-lookup.html).++* Compared to `Data.HashMap`, you get about the same lookup+ performance, but also some features that a hash-based structure+ can't provide: prefix-based search, efficient neighbour lookup,+ ordered storage.++Of course crit-bit trees have some downsides, too. For example,+building a tree from randomly ordered inputs is somewhat slow, and of+course the set of usable key types is small (only types that can be+interpreted as bitstrings "for free").++Compared to the most easily findable crit-bit tree code you'll come+across that's [written in C](https://github.com/glk/critbit), the core+of this library has a lot less accidental complexity, and so may be+easier to understand. It also handles arbitrary binary data that will+cause the C library to go wrong.++++How to contribute+====++I've purposely published this package in an incomplete state, and I'd+like your help to round it out. In return, you get to learn a little+Haskell, have your code reviewed by someone who wants to see you+succeed, and contribute to a rather nifty library.++Do you need any prior experience with Haskell to get started? No! All+you need is curiosity and the ability to learn from context. Oh, and a+github account.++My aim with this library is drop-in API compatibility with the widely+used Haskell [`containers`](https://github.com/haskell/containers)+library, which has two happy consequences:++* There are lots of functions to write!++* In almost every case, you'll find a pre-existing function in+ `containers` that (from a user's perspective) does exactly what its+ counterparts in *this* library ought to do.+++Getting started+----++If you want to contribute or play around, please use the most modern+version of the [Haskell Platform](http://www.haskell.org/platform/).++Once you have the Platform installed, there are just a few more steps.++Set up your local database of known open source Haskell packages.++ cabal update++Install the latest version of the `cabal` command, without which you+won't be able to build or run benchmarks. You'll also want a sandbox+environment. I like `cabal-dev`, and there are plenty of others.++ cabal install cabal-install+ cabal install cabal-dev++Both the new `cabal` command and `cabal-dev` will install to+`$HOME/.cabal/bin`, so put that directory at the front of your shell's+search path before you continue.++Get the `critbit` source.++ git clone git://github.com/bos/critbit++Set up a sandbox.++The first time through, you need to download and install a ton of+dependencies, so hang in there.++ cd critbit+ cabal-dev install \+ --enable-tests \+ --enable-benchmarks \+ --only-dependencies \+ -j++The `cabal-dev` command is just a sandboxing wrapper around the+`cabal` command. The `-j` flag above tells `cabal` to use all of your+CPUs, so even the initial build shouldn't take more than a few+minutes.++ cabal-dev configure \+ --enable-tests \+ --enable-benchmarks+ cabal-dev build+++Running the test suite+----++Once you've built the code, you can run the entire test suite in a few+seconds.++ dist/build/tests/tests +RTS -N++(The `+RTS -N` above tells GHC's runtime system to use all available+cores.)++If you want to explore, the `tests` program accepts a `--help`+option. Try it out.+++Running benchmarks+----++It is just as easy to benchmark stuff as to test it.++First, you need a dictionary. If your system doesn't have a file named+`/usr/share/dict/words`, you can [download a dictionary+here](http://www.cs.duke.edu/~ola/ap/linuxwords).++If you've downloaded a dictionary, tell the benchmark+suite where to find it by setting the `WORDS` environment variable.++ export WORDS=/my/path/to/linuxwords++You can then run benchmarks and generate a report. For instance, this+runs every benchmark that begins with `bytestring/lookup`.++ dist/build/benchmarks/benchmarks -o lookup.html \+ bytestring/lookup++Open the `lookup.html` file in your browser. [Here's an+example](http://htmlpreview.github.io/?https://github.com/bos/critbit/blob/master/doc/criterion-sample-lookup.html)+of what to expect.++As with `tests`, run the `benchmarks` program with `--help` if you+want to do some exploring.++++What your code should look like+----++Okay, so you've bought into this idea, and would like to try writing a+patch. How to begin?++I've generally tried to write commits with a view to being readable,+so there are examples you can follow.++For instance, [here's the commit where I added the `keys`+function](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3). This+commit follows a simple pattern:++* [Uncomment the export](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3#L0L91) of the function.++* [Write the function+ definition](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3#L0R503).+ In this case, the documentation is taken almost verbatim from the+ corresponding function in [the `Data.Map`+ module](https://github.com/haskell/containers/blob/342a95002822cca56f2d5b086cdd5a98592d5c10/Data/Map/Base.hs#L1889).++* [Write a+ test](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3#L2R108)+ and [make sure it gets+ run](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3#L2R124).++* [Add an entry to the benchmark+ suite](https://github.com/bos/critbit/commit/48438b48ca9bc5d96c1987afe7acdf4dada823f3#L1R179)+ so it's easy to see how this compares to other key/value map types.++Naturally, you'll follow the prevailing coding and formatting style.+If you forget, I'll be sad and offer you only a terse "fix your+formatting" review, and then you'll be sad too.+++Setting expectations+====++I have no idea whether this experiment will attract zero contributors+or a hundred. If the former, that's too bad, and I'll flesh the+library out at my own pace. If the latter, I'll do my best to keep up,+and we'll be more systematic if necessary (it would be a shame to see+several redundant pull requests implementing the same functions, is+what I'm thinking).++But the main point of this is: have fun!
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE CPP, Rank2Types, ScopedTypeVariables #-}+module Main (main) where++import Control.Applicative ((<$>))+import Control.Arrow (first)+import Control.DeepSeq (NFData(..))+import Control.Exception (catch, evaluate)+import Control.Monad (when)+import Control.Monad.Trans (liftIO)+import Criterion.Main (bench, bgroup, defaultMain, nf, whnf)+import Criterion.Types (Pure)+import Data.Hashable (Hashable(..), hashByteArray)+import Data.Maybe (fromMaybe)+import Data.Text.Array (aBA)+import Data.Text.Encoding (decodeUtf8)+import Data.Text.Internal (Text(..))+import System.Environment (lookupEnv)+import System.IO (hPutStrLn, stderr)+import System.IO.Error (ioError, isDoesNotExistError)+import System.Random.MWC (GenIO, GenST, asGenST, create, uniform, uniformR)+import qualified Data.ByteString.Char8 as B+import qualified Data.CritBit.Map.Lazy as C+import qualified Data.HashMap.Lazy as H+import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Trie as Trie+import qualified Data.Vector.Generic.Mutable as M++#if 0+instance Hashable Text where+ hash (Text arr off len) = hashByteArray (aBA arr) (off * 2) (len * 2)+ {-# INLINE hash #-}+#endif++instance (NFData a) => NFData (Trie.Trie a) where+ rnf = rnf . Trie.toList++every k = go 0+ where+ go i (x:xs)+ | i == k-1 = x : go 0 xs+ | otherwise = go (i+1) xs+ go _ _ = []++shuffle :: GenIO -> Double -> [Int] -> IO [Int]+shuffle gen prob xs = do+ let vec = V.fromList xs+ len = G.length vec+ v <- G.unsafeThaw vec+ let go i | i == 1 = return ()+ | otherwise = do+ p <- uniform gen+ when (p <= prob) $+ M.unsafeSwap v i =<< uniformR (0, i) gen+ go (i-1)+ go (len - 1)+ V.toList <$> G.unsafeFreeze v++chartres = do+ let xs = [0..2999]+ nxs = fromIntegral (length xs) :: Double+ go pct = do+ gen <- create+ let prob = fromIntegral pct / 100+ ys <- shuffle gen prob xs+ let mismatches = length . filter id . zipWith (/=) xs $ ys+ putStrLn $ show prob ++ " " ++ show (fromIntegral mismatches / nxs)+ mapM_ go [0..100]+++main = do+ fileName <- fromMaybe "/usr/share/dict/words" <$> lookupEnv "WORDS"+ ordKeys <- (every 5 . B.words) <$> B.readFile fileName+ `catch` \(err::IOError) -> do+ when (isDoesNotExistError err) $ do+ hPutStrLn stderr+ ("(point the 'WORDS' environment variable at a file " +++ "to use it for benchmark data)")+ ioError err+ let b_ordKVs = zip ordKeys [(0::Int)..]+ b_revKVs = reverse b_ordKVs+ b_randKVs <- do+ gen <- create+ let kvVec = V.fromList b_ordKVs+ (G.toList . G.backpermute kvVec) <$>+ G.replicateM (G.length kvVec) (uniformR (0, G.length kvVec - 1) gen)+ let t_ordKVs = map (first decodeUtf8) b_ordKVs+ t_randKVs = map (first decodeUtf8) b_randKVs+ t_revKVs = map (first decodeUtf8) b_revKVs+ b_critbit = C.fromList b_ordKVs+ b_map = Map.fromList b_ordKVs+ b_hashmap = H.fromList b_ordKVs+ b_trie = Trie.fromList b_ordKVs+ key = fst . head $ b_randKVs+ b_critbit_1 = C.delete key b_critbit+ b_map_1 = Map.delete key b_map+ b_hashmap_1 = H.delete key b_hashmap+ b_trie_1 = Trie.delete key b_trie+ (b_randKVs_13, b_randKVs_23) = (take (l - n) b_randKVs, drop n b_randKVs)+ where+ l = length b_randKVs+ n = l `div` 3+ b_critbit_13 = C.fromList b_randKVs_13+ b_critbit_23 = C.fromList b_randKVs_23+ b_map_13 = Map.fromList b_randKVs_13+ b_map_23 = Map.fromList b_randKVs_23+ b_hashmap_13 = H.fromList b_randKVs_13+ b_hashmap_23 = H.fromList b_randKVs_23+ b_trie_13 = Trie.fromList b_randKVs_13+ b_trie_23 = Trie.fromList b_randKVs_23+ fromList kvs = [+ bench "critbit" $ whnf C.fromList kvs+ , bench "map" $ whnf Map.fromList kvs+ , bench "hashmap" $ whnf H.fromList kvs+ ]+ keyed critbit map hashmap trie =+ [+ bgroup "present" [+ bench "critbit" $ whnf (critbit key) b_critbit+ , bench "map" $ whnf (map key) b_map+ , bench "hashmap" $ whnf (hashmap key) b_hashmap+ , bench "trie" $ whnf (trie key) b_trie+ ]+ , bgroup "missing" [+ bench "critbit" $ whnf (critbit key) b_critbit_1+ , bench "map" $ whnf (map key) b_map_1+ , bench "hashmap" $ whnf (hashmap key) b_hashmap_1+ , bench "trie" $ whnf (trie key) b_trie_1+ ]+ ]+ twoMaps critbit map hashmap trie = [+ bench "critbit" $ whnf (critbit b_critbit_13) b_critbit_23+ , bench "map" $ whnf (map b_map_13) b_map_23+ , bench "hashmap" $ whnf (hashmap b_hashmap_13) b_hashmap_23+ , bench "trie" $ whnf (trie b_trie_13) b_trie_23+ ]+ function (eval :: forall a b. NFData b => (a -> b) -> a -> Pure)+ critbit map hashmap trie = [+ bench "critbit" $ eval critbit b_critbit+ , bench "map" $ eval map b_map+ , bench "hashmap" $ eval hashmap b_hashmap+ , bench "trie" $ eval trie b_trie+ ]+ evaluate $ rnf [rnf b_critbit, rnf b_critbit_1, rnf b_map, rnf b_map_1,+ rnf b_hashmap, rnf b_hashmap_1, rnf b_trie, rnf b_trie_1,+ rnf b_randKVs, rnf b_revKVs, rnf key,+ rnf b_critbit_13, rnf b_critbit_23,+ rnf b_map_13, rnf b_map_23,+ rnf b_hashmap_13, rnf b_hashmap_23,+ rnf b_trie_13, rnf b_trie_23]+ defaultMain+ [ bgroup "bytestring" [+ bgroup "fromList" [+ bgroup "ordered" $ fromList b_ordKVs +++ [ bench "trie" $ whnf Trie.fromList b_ordKVs ]+ , bgroup "random" $ fromList b_randKVs +++ [ bench "trie" $ whnf Trie.fromList b_randKVs ]+ , bgroup "reversed" $ fromList b_revKVs +++ [ bench "trie" $ whnf Trie.fromList b_revKVs ]+ ]+ , bgroup "delete" $ keyed C.delete Map.delete H.delete Trie.delete+ , bgroup "insert" $ keyed (flip C.insert 1) (flip Map.insert 1)+ (flip H.insert 1) (flip Trie.insert 1)+ , bgroup "lookup" $ keyed C.lookup Map.lookup H.lookup Trie.lookup+ , bgroup "lookupGT" $ [+ bench "critbit" $ whnf (C.lookupGT key) b_critbit+ , bench "map" $ whnf (Map.lookupGT key) b_map+ ]+ , bgroup "member" $ keyed C.member Map.member H.member Trie.member+ , bgroup "foldlWithKey'" $ let f a _ b = a + b+ in function whnf (C.foldlWithKey' f 0)+ (Map.foldlWithKey' f 0)+ (H.foldlWithKey' f 0) id+ , bgroup "foldl'" $ function whnf (C.foldl' (+) 0) (Map.foldl' (+) 0)+ (H.foldl' (+) 0) id+ , bgroup "keys" $ function nf C.keys Map.keys H.keys Trie.keys+ , bgroup "union" $ twoMaps C.unionR Map.union H.union Trie.unionR+ ]+ , bgroup "text" [+ bgroup "fromList" [+ bgroup "ordered" $ fromList t_ordKVs+ , bgroup "random" $ fromList t_randKVs+ , bgroup "reversed" $ fromList t_revKVs+ ]+ ]+ ]
+ critbit.cabal view
@@ -0,0 +1,91 @@+name: critbit+version: 0.0.0.0+homepage: https://github.com/bos/critbit+bug-reports: https://github.com/bos/critbit/issues+synopsis: Crit-bit maps and sets+description:+ Whee.+license: BSD3+license-file: LICENSE+author: Bryan O'Sullivan <bos@serpentine.com>+maintainer: Bryan O'Sullivan <bos@serpentine.com>+copyright: 2013 Bryan O'Sullivan+category: Data+build-type: Simple+cabal-version: >= 1.8+extra-source-files:+ README.markdown++flag developer+ description: operate in developer mode+ default: False++library+ exposed-modules:+ Data.CritBit.Map.Lazy+ other-modules:+ Data.CritBit.Core+ Data.CritBit.Types.Internal+ Data.CritBit.Tree++ build-depends:+ base >= 4 && < 5,+ bytestring >= 0.9,+ deepseq,+ text >= 0.11.3.1,+ vector++ ghc-options: -Wall -funbox-strict-fields -O2 -fwarn-tabs+ if flag(developer)+ ghc-prof-options: -auto-all+ ghc-options: -Werror+ cpp-options: -DASSERTS++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ if impl(ghc >= 7.4)+ other-modules: Properties++ ghc-options:+ -Wall -threaded -rtsopts++ build-depends:+ base >= 4 && < 5,+ bytestring,+ containers,+ critbit,+ QuickCheck >= 2.4,+ test-framework >= 0.4,+ test-framework-quickcheck2 >= 0.2,+ text++benchmark benchmarks+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: Benchmarks.hs+ ghc-options: -O2 -rtsopts++ build-depends:+ base >= 4 && < 5,+ bytestring,+ bytestring-trie,+ containers,+ critbit,+ criterion >= 0.8,+ deepseq,+ hashable < 1.2,+ mtl,+ mwc-random,+ text,+ unordered-containers,+ vector++source-repository head+ type: git+ location: https://github.com/bos/critbit++source-repository head+ type: mercurial+ location: https://bitbucket.org/bos/critbit
+ tests/Main.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}+module Main (main) where++import Test.Framework++#if MIN_VERSION_base(4,5,0)+import Properties (properties)+#else+import Test.Framework.Providers.QuickCheck2 (testProperty)++-- Don't run any tests on GHC < 7.4, but *do* generate a test output+-- file that a continuous build system can consume so that it won't+-- crash. The output file can't be devoid of tests, because then+-- instead of crashing Jenkins will fail because no tests were run.+-- Thanks for being so inflexible, Jenkins!+properties = [ testProperty "fuck you, jenkins" True ]+#endif++main :: IO ()+main = defaultMain [+ testGroup "properties" properties+ ]
+ tests/Properties.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Properties+ where++import Control.Applicative ((<$>))+import Data.ByteString (ByteString)+import Data.CritBit.Map.Lazy (CritBitKey, CritBit)+import Data.Text (Text)+import Data.Word (Word8)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary(..), Args(..), quickCheckWith, stdArgs)+import Test.QuickCheck.Property (Testable)+import qualified Data.ByteString as BB+import qualified Data.ByteString.Char8 as B+import qualified Data.CritBit.Map.Lazy as C+import qualified Data.Map as Map+import qualified Data.Text as T++instance Arbitrary ByteString where+ arbitrary = BB.pack <$> arbitrary+ shrink = map B.pack . shrink . B.unpack++instance Arbitrary Text where+ arbitrary = T.pack <$> arbitrary+ shrink = map T.pack . shrink . T.unpack++type V = Word8++newtype KV a = KV { fromKV :: [(a, V)] }+ deriving (Show, Eq, Ord)++instance Arbitrary a => Arbitrary (KV a) where+ arbitrary = (KV . flip zip [0..]) <$> arbitrary+ shrink = map (KV . flip zip [0..]) . shrink . map fst . fromKV++instance (CritBitKey k, Arbitrary k, Arbitrary v) =>+ Arbitrary (CritBit k v) where+ arbitrary = C.fromList <$> arbitrary+ shrink = map C.fromList . shrink . C.toList++newtype CB k = CB (CritBit k V)+ deriving (Show, Eq, Arbitrary)++t_lookup_present :: (CritBitKey k) => k -> k -> V -> CB k -> Bool+t_lookup_present _ k v (CB m) = C.lookup k (C.insert k v m) == Just v++t_lookup_missing :: (CritBitKey k) => k -> k -> CB k -> Bool+t_lookup_missing _ k (CB m) = C.lookup k (C.delete k m) == Nothing++#if MIN_VERSION_containers(0,5,0)+t_lookupGT :: (Ord k, CritBitKey k) => k -> k -> KV k -> Bool+t_lookupGT _ k (KV kvs) =+ C.lookupGT k (C.fromList kvs) == Map.lookupGT k (Map.fromList kvs)+#endif++t_fromList_toList :: (CritBitKey k, Ord k) => k -> KV k -> Bool+t_fromList_toList _ (KV kvs) =+ Map.toList (Map.fromList kvs) == C.toList (C.fromList kvs)++t_fromList_size :: (CritBitKey k, Ord k) => k -> KV k -> Bool+t_fromList_size _ (KV kvs) =+ Map.size (Map.fromList kvs) == C.size (C.fromList kvs)++t_delete_present :: (CritBitKey k, Ord k) => k -> KV k -> k -> V -> Bool+t_delete_present _ (KV kvs) k v =+ C.toList (C.delete k c) == Map.toList (Map.delete k m)+ where+ c = C.insert k v $ C.fromList kvs+ m = Map.insert k v $ Map.fromList kvs++t_unionL :: (CritBitKey k, Ord k) => k -> KV k -> KV k -> Bool+t_unionL _ (KV kv0) (KV kv1) =+ Map.toList (Map.fromList kv0 `Map.union` Map.fromList kv1) ==+ C.toList (C.fromList kv0 `C.unionL` C.fromList kv1)++t_foldl :: (CritBitKey k) => k -> CritBit k V -> Bool+t_foldl _ m = C.foldl (+) 0 m == C.foldr (+) 0 m++t_foldlWithKey :: (CritBitKey k, Ord k) => k -> KV k -> Bool+t_foldlWithKey _ (KV kvs) =+ C.foldlWithKey f ([], 0) (C.fromList kvs) ==+ Map.foldlWithKey f ([], 0) (Map.fromList kvs)+ where+ f (l,s) k v = (k:l,s+v)++t_foldl' :: (CritBitKey k) => k -> CritBit k V -> Bool+t_foldl' _ m = C.foldl' (+) 0 m == C.foldl (+) 0 m++t_foldlWithKey' :: (CritBitKey k, Ord k) => k -> KV k -> Bool+t_foldlWithKey' _ (KV kvs) =+ C.foldlWithKey' f ([], 0) (C.fromList kvs) ==+ Map.foldlWithKey' f ([], 0) (Map.fromList kvs)+ where+ f (l,s) k v = (k:l,s+v)++t_keys :: (CritBitKey k, Ord k) => k -> KV k -> Bool+t_keys _ (KV kvs) = C.keys (C.fromList kvs) == Map.keys (Map.fromList kvs)++propertiesFor :: (Arbitrary k, CritBitKey k, Ord k, Show k) => k -> [Test]+propertiesFor t = [+ testProperty "t_fromList_toList" $ t_fromList_toList t+ , testProperty "t_fromList_size" $ t_fromList_size t+ , testProperty "t_lookup_present" $ t_lookup_present t+ , testProperty "t_lookup_missing" $ t_lookup_missing t+#if MIN_VERSION_containers(0,5,0)+ , testProperty "t_lookupGT" $ t_lookupGT t+#endif+ , testProperty "t_delete_present" $ t_delete_present t+ , testProperty "t_unionL" $ t_unionL t+ , testProperty "t_foldl" $ t_foldl t+ , testProperty "t_foldlWithKey" $ t_foldlWithKey t+ , testProperty "t_foldl'" $ t_foldl' t+ , testProperty "t_foldlWithKey'" $ t_foldlWithKey' t+ , testProperty "t_keys" $ t_keys t+ ]++properties :: [Test]+properties = [+ testGroup "text" $ propertiesFor T.empty+ , testGroup "bytestring" $ propertiesFor B.empty+ ]++-- Handy functions for fiddling with from ghci.++blist :: [ByteString] -> CritBit ByteString Word8+blist = C.fromList . flip zip [0..]++tlist :: [Text] -> CritBit Text Word8+tlist = C.fromList . flip zip [0..]++mlist :: [ByteString] -> Map.Map ByteString Word8+mlist = Map.fromList . flip zip [0..]++qc :: Testable prop => Int -> prop -> IO ()+qc n = quickCheckWith stdArgs { maxSuccess = n }