hamtmap 0.2 → 0.3

raw patch · 5 files changed

+234/−169 lines, 5 filesdep +hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

API changes (from Hackage documentation)

Files

• Data/BitUtil.hs +4/−0
• Data/HamtMap.hs +175/−137
• benchmarks/benchmark.hs +6/−9
• hamtmap.cabal +2/−2
• tests/tests.hs +47/−21

@@ -3,6 +3,7 @@ import Data.Bits import Data.Word import Data.Int+import Data.List (foldl')  -- Bit operations @@ -21,6 +22,9 @@           loop 32 _ = []           loop ix bitmap | bitmap .&. 1 == 0 = loop (ix+1) (bitmap `shiftR` 1)                          | otherwise         = ix:(loop (ix+1) (bitmap `shiftR` 1))++indicesToBitmap :: (Bits a) => [Int] -> a+indicesToBitmap = foldl' (\bm ix -> bm .|. (1 `shiftL` ix)) 0  bitCount32 :: (Integral a) => Int32 -> a bitCount32 x = bitCount8 ((x `shiftR` 24) .&. 0xff) +

@@ -44,6 +44,9 @@     -- * Traversal     , Data.HamtMap.map     , mapWithKey+    -- * Filter+    , Data.HamtMap.filter+    , filterWithKey     -- * Conversion     , Data.HamtMap.elems     , keys@@ -56,54 +59,45 @@ import Control.Monad import Control.DeepSeq import Data.Bits+import Data.Hashable (Hashable)+import qualified Data.Hashable as H import Data.Int import Data.List hiding (insert, lookup) import Data.Array as A import Prelude as P  -- | A HamtMap from keys @k@ to values @v@-data (Eq k) => HamtMap k v = HM {-                                    hashFn :: k -> Int32-                                  , root :: Node k v-                              }--instance (Eq k, Show k, Show v) => Show (HamtMap k v) where-    show (HM h r) = show r-    -- show = ("fromList hashFn "++).show.(Data.HamtMap.toList)--instance (Eq k, NFData k, NFData v) => NFData (HamtMap k v) where-    rnf (HM f r) = f `seq` rnf r+data (Eq k, Hashable k) => HamtMap k v = EmptyNode |+                                         LeafNode {+                                               h :: Int32+                                             , key :: k+                                             , value :: v+                                         } |+                                         HashCollisionNode {+                                               h :: Int32+                                             , pairs :: [(k, v)]+                                         } |+                                         BitmapIndexedNode {+                                               bitmap :: Int32+                                             , subNodes :: Array Int32 (HamtMap k v)+                                         } |+                                         ArrayNode {+                                               numChildren :: Int32+                                             , subNodes :: Array Int32 (HamtMap k v)+                                         } -instance (Eq k, NFData k, NFData v) => NFData (Node k v) where+instance (Eq k, Hashable k, NFData k, NFData v) => NFData (HamtMap k v) where     rnf EmptyNode = ()     rnf (LeafNode h k v) = rnf h `seq` rnf k `seq` rnf v     rnf (HashCollisionNode h xs) = rnf h `seq` rnf xs     rnf (BitmapIndexedNode bm arr) = rnf bm `seq` rnf arr     rnf (ArrayNode n arr) = rnf n `seq` rnf arr -data (Eq k) => Node k v = EmptyNode |-                          LeafNode {-                                hash :: Int32-                              , key :: k-                              , value :: v-                          } |-                          HashCollisionNode {-                                hash :: Int32-                              , pairs :: [(k, v)]-                          } |-                          BitmapIndexedNode {-                                bitmap :: Int32-                              , subNodes :: Array Int32 (Node k v)-                          } |-                          ArrayNode {-                                numChildren :: Int32-                              , subNodes :: Array Int32 (Node k v)-                          } -instance (Eq k, Show k, Show v) => Show (Node k v) where+instance (Eq k, Hashable k, Show k, Show v) => Show (HamtMap k v) where     show EmptyNode = ""-    show (LeafNode _hash key value) = show (key, value)-    show (HashCollisionNode _hash pairs) = "h" ++ show pairs+    show (LeafNode _h key value) = show (key, value)+    show (HashCollisionNode _h pairs) = "h" ++ show pairs     show (BitmapIndexedNode bitmap subNodes) = "b" ++ show bitmap ++ (show $ A.elems subNodes)     show (ArrayNode numChildren subNodes) = "a" ++ show numChildren ++ (show $ A.elems subNodes) @@ -117,25 +111,37 @@  -- Some miscellaneous helper functions -isEmptyNode :: Node k v -> Bool+isEmptyNode :: HamtMap k v -> Bool isEmptyNode EmptyNode = True isEmptyNode _ = False -hashFragment shift hash = (hash `shiftR` shift) .&. fromIntegral mask +isTipNode :: (Eq k, Hashable k) => HamtMap k v -> Bool+isTipNode EmptyNode               = True+isTipNode (LeafNode _ _ _)        = True+isTipNode (HashCollisionNode _ _) = True+isTipNode _                       = False --- | @('empty' hashFn)@ is the empty HamtMap, with hashFn being the key hash function.-empty :: (Eq k) => (k -> Int32) -> HamtMap k v -empty hashFn = HM hashFn EmptyNode+hash :: (Eq k, Hashable k) => k -> Int32+hash = fromIntegral.(H.hash)  --- | @('singleton' hashFn key value)@ is a single-element HamtMap holding @(key, value)@-singleton :: (Eq k) => (k -> Int32) -> k -> v -> HamtMap k v+hashFragment shift h = (h `shiftR` shift) .&. fromIntegral mask -singleton hashFn key value = HM hashFn $ LeafNode (hashFn key) key value +-- | The empty HamtMap.+empty :: (Eq k, Hashable k) => HamtMap k v +empty = EmptyNode+++-- | @('singleton' key value)@ is a single-element HamtMap holding @(key, value)@+singleton :: (Eq k, Hashable k) => k -> v -> HamtMap k v++singleton key value = LeafNode (hash key) key value++ -- Helper data type for alterNode data Change = Removed | Modified | Nil | Added deriving Eq @@ -143,54 +149,54 @@ -- | The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.-alter :: (Eq k) => (Maybe v -> Maybe v) -> k -> HamtMap k v -> HamtMap k v+alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HamtMap k v -> HamtMap k v -alter updateFn key (HM hashFn root) =-    HM hashFn $ alterNode 0 updateFn (hashFn key) key root+alter updateFn key root =+    alterNode 0 updateFn (hash key) key root  -alterNode :: (Eq k) => Int -> (Maybe v -> Maybe v) -> Int32 -> k -> Node k v -> Node k v+alterNode :: (Eq k, Hashable k) => Int -> (Maybe v -> Maybe v) -> Int32 -> k -> HamtMap k v -> HamtMap k v -alterNode _shift updateFn hash key EmptyNode =+alterNode _shift updateFn h key EmptyNode =     maybe EmptyNode-          (LeafNode hash key)+          (LeafNode h key)           (updateFn Nothing) -alterNode shift updateFn hash' key' node@(LeafNode hash key value) =+alterNode shift updateFn h' key' node@(LeafNode h key value) =     if key' == key        then maybe EmptyNode-                  (LeafNode hash key)+                  (LeafNode h key)                   (updateFn (Just value))-       else let node' = alterNode shift updateFn hash' key' EmptyNode+       else let node' = alterNode shift updateFn h' key' EmptyNode                 in if isEmptyNode node'                       then node                       else combineNodes shift node node'     where-    combineNodes :: (Eq k) => Int -> Node k v -> Node k v -> Node k v+    combineNodes :: (Eq k, Hashable k) => Int -> HamtMap k v -> HamtMap k v -> HamtMap k v     combineNodes shift node1@(LeafNode h1 k1 v1) node2@(LeafNode h2 k2 v2) =-        let hash1 = nodeHash node1-            hash2 = nodeHash node2-            subHash1 = hashFragment shift hash1-            subHash2 = hashFragment shift hash2-            (nodeA, nodeB) = if (subHash1 < subHash2)+        let h1 = nodeHash node1+            h2 = nodeHash node2+            subH1 = hashFragment shift h1+            subH2 = hashFragment shift h2+            (nodeA, nodeB) = if (subH1 < subH2)                                 then (node1, node2)                                 else (node2, node1)-            bitmap' = ((toBitmap subHash1) .|. (toBitmap subHash2))-            subNodes' = if subHash1 == subHash2+            bitmap' = ((toBitmap subH1) .|. (toBitmap subH2))+            subNodes' = if subH1 == subH2                            then listArray (0, 0) [combineNodes (shift+shiftStep) node1 node2]                            else listArray (0, 1) [nodeA, nodeB]-            in if hash1 == hash2-                  then HashCollisionNode hash1 [(k2, v2), (k1, v1)]+            in if h1 == h2+                  then HashCollisionNode h1 [(k2, v2), (k1, v1)]                   else BitmapIndexedNode bitmap' subNodes'-    nodeHash (LeafNode hash key value) = hash-    nodeHash (HashCollisionNode hash pairs) = hash+    nodeHash (LeafNode h key value) = h+    nodeHash (HashCollisionNode h pairs) = h -alterNode _shift updateFn _hash' key (HashCollisionNode hash pairs) =+alterNode _shift updateFn _hash' key (HashCollisionNode h pairs) =     let pairs' = updateList updateFn key pairs         in case pairs' of                 []             -> undefined -- should never happen-                [(key, value)] -> LeafNode hash key value-                otherwise      -> HashCollisionNode hash pairs'+                [(key, value)] -> LeafNode h key value+                otherwise      -> HashCollisionNode h pairs'     where updateList updateFn key [] =               maybe []                     (\value' -> [(key, value')])@@ -202,13 +208,13 @@           updateList updateFn key (p:pairs) =               p : updateList updateFn key pairs -alterNode shift updateFn hash key bmnode@(BitmapIndexedNode bitmap subNodes) =-    let subHash = hashFragment shift hash+alterNode shift updateFn h key bmnode@(BitmapIndexedNode bitmap subNodes) =+    let subHash = hashFragment shift h         ix = fromBitmap bitmap subHash         bit = toBitmap subHash         exists = (bitmap .&. bit) /= 0         child = if exists then subNodes A.! fromIntegral ix else EmptyNode-        child' = alterNode (shift+shiftStep) updateFn hash key child+        child' = alterNode (shift+shiftStep) updateFn h key child         removed = exists && isEmptyNode child'         added = not exists && not (isEmptyNode child')         change = if exists@@ -240,7 +246,7 @@                    -- Note: it's possible to have a single-element BitmapIndexedNode                    -- if there are two keys with the same subHash in the trie.                    EmptyNode-           else if bound' == 0 && isLeafNode (subNodes' A.! 0)+           else if bound' == 0 && isTipNode (subNodes' A.! 0)               then -- Pack a BitmapIndexedNode into a LeafNode                    subNodes' A.! 0            else if change == Added && bound' > bmnodeMax - 1@@ -248,11 +254,8 @@                    expandBitmapNode shift subHash child' bitmap subNodes               else BitmapIndexedNode bitmap' subNodes'     where-    isLeafNode (LeafNode _ _ _) = True-    isLeafNode _ = False--    expandBitmapNode :: (Eq k) =>-        Int -> Int32 -> Node k v -> Int32 -> Array Int32 (Node k v) -> Node k v+    expandBitmapNode :: (Eq k, Hashable k) =>+        Int -> Int32 -> HamtMap k v -> Int32 -> Array Int32 (HamtMap k v) -> HamtMap k v     expandBitmapNode shift subHash node' bitmap subNodes =         let assocs = zip (bitmapToIndices bitmap) (A.elems subNodes)             assocs' = (subHash, node'):assocs@@ -261,10 +264,10 @@             in ArrayNode numChildren $ blank // assocs'             -- TODO: an array copy could be avoided here -alterNode shift updateFn hash key node@(ArrayNode numChildren subNodes) =-    let subHash = hashFragment shift hash+alterNode shift updateFn h key node@(ArrayNode numChildren subNodes) =+    let subHash = hashFragment shift h         child = subNodes A.! subHash-        child' = alterNode (shift+shiftStep) updateFn hash key child+        child' = alterNode (shift+shiftStep) updateFn h key child         change = if isEmptyNode child                     then if isEmptyNode child'                             then Nil@@ -282,13 +285,13 @@               then packArrayNode subHash numChildren subNodes               else ArrayNode numChildren' $ subNodes // [(subHash, child')]     where-    packArrayNode :: (Eq k) => Int32 -> Int32 -> Array Int32 (Node k v) -> Node k v+    packArrayNode :: (Eq k, Hashable k) => Int32 -> Int32 -> Array Int32 (HamtMap k v) -> HamtMap k v     packArrayNode subHashToRemove numChildren subNodes =         let elems' = P.map (\i -> if i == subHashToRemove                                    then EmptyNode                                    else subNodes A.! i)                          [0..pred chunk]-            subNodes' = listArray (0, (numChildren-2)) $ filter (not.isEmptyNode) elems'+            subNodes' = listArray (0, (numChildren-2)) $ P.filter (not.isEmptyNode) elems'             listToBitmap = foldr (\on bm -> (bm `shiftL` 1) .|. (if on then 1 else 0)) 0             bitmap = listToBitmap $ P.map (not.isEmptyNode) elems'             in BitmapIndexedNode bitmap subNodes'@@ -299,7 +302,7 @@ -- 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 the pair @(key, f new_value old_value)@.-insertWith :: (Eq k) => (v -> v -> v) -> k -> v -> HamtMap k v -> HamtMap k v+insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HamtMap k v -> HamtMap k v  insertWith accumFn key value hm =     let fn :: (v -> v -> v) -> v -> Maybe v -> Maybe v@@ -312,7 +315,7 @@ -- 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 :: (Eq k) => k -> v -> HamtMap k v -> HamtMap k v+insert :: (Eq k, Hashable k) => k -> v -> HamtMap k v -> HamtMap k v  insert = insertWith const @@ -320,46 +323,40 @@ -- | 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 :: (Eq k) => (v -> Maybe v) -> k -> HamtMap k v -> HamtMap k v+update :: (Eq k, Hashable k) => (v -> Maybe v) -> k -> HamtMap k v -> HamtMap k v  update updateFn = alter ((=<<) updateFn)   -- | 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 :: (Eq k) => k -> HamtMap k v -> HamtMap k v+delete :: (Eq k, Hashable k) => k -> HamtMap k v -> HamtMap k v  delete = alter (const Nothing)   -- | Update a value at a specific key with the result of the provided function. -- When the key is not a member of the map, the original map is returned.-adjust :: (Eq k) => (v -> v) -> k -> HamtMap k v -> HamtMap k v+adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HamtMap k v -> HamtMap k v  adjust updateFn = alter ((=<<) ((Just).updateFn))   -- | Map a function over all values in the map.-mapWithKey :: (Eq k) => (k -> v -> v) -> HamtMap k v -> HamtMap k v--mapWithKey mapFn (HM hashFn root) =-    HM hashFn $ mapWithKeyNode mapFn root---mapWithKeyNode :: (Eq k) => (k -> v -> v) -> Node k v -> Node k v+mapWithKey :: (Eq k, Hashable k) => (k -> v -> v) -> HamtMap k v -> HamtMap k v -mapWithKeyNode _mapFn EmptyNode = EmptyNode+mapWithKey _mapFn EmptyNode = EmptyNode -mapWithKeyNode mapFn (LeafNode hash key value) = LeafNode hash key $ mapFn key value+mapWithKey mapFn (LeafNode h key value) = LeafNode h key $ mapFn key value -mapWithKeyNode mapFn (HashCollisionNode hash pairs) =-    HashCollisionNode hash (P.map (\(key, value) -> (key, mapFn key value)) pairs)+mapWithKey mapFn (HashCollisionNode h pairs) =+    HashCollisionNode h (P.map (\(key, value) -> (key, mapFn key value)) pairs) -mapWithKeyNode mapFn (BitmapIndexedNode bitmap subNodes) =-    BitmapIndexedNode bitmap $ arrayMap (mapWithKeyNode mapFn) subNodes+mapWithKey mapFn (BitmapIndexedNode bitmap subNodes) =+    BitmapIndexedNode bitmap $ arrayMap (mapWithKey mapFn) subNodes -mapWithKeyNode mapFn (ArrayNode numChildren subNodes) =-    ArrayNode numChildren $ arrayMap (mapWithKeyNode mapFn) subNodes+mapWithKey mapFn (ArrayNode numChildren subNodes) =+    ArrayNode numChildren $ arrayMap (mapWithKey mapFn) subNodes   arrayMap :: (Ix i) => (a -> a) -> Array i a -> Array i a@@ -368,21 +365,67 @@   -- | Map a function over all values in the map.-map :: (Eq k) => (v -> v) -> HamtMap k v -> HamtMap k v+map :: (Eq k, Hashable k) => (v -> v) -> HamtMap k v -> HamtMap k v  map fn = mapWithKey (const fn)  +-- | Filter for all values that satisify a predicate.+filterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> HamtMap k v -> HamtMap k v++filterWithKey _fn EmptyNode = EmptyNode++filterWithKey fn node@(LeafNode h key value) | fn key value = node+                                                 | otherwise    = EmptyNode++filterWithKey fn (HashCollisionNode h pairs) =+    let pairs' = P.filter (uncurry fn) pairs+        in case pairs' of+                []             -> EmptyNode+                [(key, value)] -> LeafNode h key value+                otherwise      -> HashCollisionNode h pairs'++filterWithKey fn (BitmapIndexedNode bitmap subNodes) =+    let mapped = P.map (filterWithKey fn) (A.elems subNodes)+        zipped = zip (bitmapToIndices bitmap) mapped+        filtered = P.filter (\(ix, subNode) -> not (isEmptyNode subNode)) zipped+        (indices', subNodes') = unzip filtered+        n = fromIntegral $ length filtered+        in case subNodes' of+                []                      -> EmptyNode+                [node] | isTipNode node -> node+                otherwise               -> BitmapIndexedNode (indicesToBitmap indices')+                                                             (listArray (0, n-1) subNodes')++filterWithKey fn (ArrayNode numChildren subNodes) =+    let mapped = P.map (filterWithKey fn) (A.elems subNodes)+        zipped = zip [0..31] mapped+        filtered = P.filter (\(ix, subNode) -> not (isEmptyNode subNode)) zipped+        (indices', subNodes') = unzip filtered+        n = fromIntegral $ length filtered+        in case filtered of+                [] -> EmptyNode+                [(ix, node)] | isTipNode node -> node+                els | n <= bmnodeMax -> BitmapIndexedNode (indicesToBitmap indices')+                                                          (listArray (0, n-1) subNodes')+                    | otherwise      -> ArrayNode n (listArray (0, 31) mapped)+++-- | Filter for all values that satisify a predicate.+filter :: (Eq k, Hashable k) => (v -> Bool) -> HamtMap k v -> HamtMap k v++filter fn = filterWithKey (const fn)+ -- | Lookup the value at a key in the map. -- -- The function will return the corresponding value as @('Just' value)@, -- or 'Nothing' if the key isn't in the map.-lookup :: (Eq k) => k -> HamtMap k v -> Maybe v+lookup :: (Eq k, Hashable k) => k -> HamtMap k v -> Maybe v -lookup key (HM hashFn root) = lookupNode 0 (hashFn key) key root+lookup key root = lookupNode 0 (hash key) key root  -lookupNode :: (Eq k) => Int -> Int32 -> k -> Node k v -> Maybe v+lookupNode :: (Eq k, Hashable k) => Int -> Int32 -> k -> HamtMap k v -> Maybe v  lookupNode _ _ _ EmptyNode = Nothing @@ -393,22 +436,22 @@ lookupNode _ _ key (HashCollisionNode _ pairs) =     P.lookup key pairs -lookupNode shift hash key (BitmapIndexedNode bitmap subNodes) =-    let subHash = hashFragment shift hash+lookupNode shift h key (BitmapIndexedNode bitmap subNodes) =+    let subHash = hashFragment shift h         ix = fromBitmap bitmap subHash         exists = (bitmap .&. (toBitmap subHash)) /= 0         in if exists-              then lookupNode (shift+shiftStep) hash key (subNodes A.! ix)+              then lookupNode (shift+shiftStep) h key (subNodes A.! ix)               else Nothing -lookupNode shift hash key (ArrayNode _numChildren subNodes) =-    let subHash = hashFragment shift hash-        in lookupNode (shift+shiftStep) hash key (subNodes A.! subHash)+lookupNode shift h key (ArrayNode _numChildren subNodes) =+    let subHash = hashFragment shift h+        in lookupNode (shift+shiftStep) h key (subNodes A.! subHash)   -- | Find the value at a key. -- Calls 'error' when the element can not be found.-(!) :: (Eq k) => HamtMap k v -> k -> v+(!) :: (Eq k, Hashable k) => HamtMap k v -> k -> v  hm ! key = maybe (error "element not in the map")                  id@@ -416,45 +459,40 @@   -- | Is the key a member of the map? See also 'notMember'.-member :: (Eq k) => k -> HamtMap k v -> Bool+member :: (Eq k, Hashable k) => k -> HamtMap k v -> Bool  member key hm = maybe False (const True) (Data.HamtMap.lookup key hm)  -- | Is the key a member of the map? See also 'member'.-notMember :: (Eq k) => k -> HamtMap k v -> Bool+notMember :: (Eq k, Hashable k) => k -> HamtMap k v -> Bool  notMember key = not.(member key)   -- | Convert to a list of key\/value pairs.-toList :: (Eq k) => HamtMap k v -> [(k, v)]--toList (HM _hashFn root) = toListNode root---toListNode :: (Eq k) => Node k v -> [(k, v)]+toList :: (Eq k, Hashable k) => HamtMap k v -> [(k, v)] -toListNode EmptyNode = []+toList EmptyNode = [] -toListNode (LeafNode _hash key value) = [(key, value)]+toList (LeafNode _hash key value) = [(key, value)] -toListNode (HashCollisionNode _hash pairs) = pairs+toList (HashCollisionNode _hash pairs) = pairs -toListNode (BitmapIndexedNode _bitmap subNodes) =-    concat $ P.map toListNode $ A.elems subNodes+toList (BitmapIndexedNode _bitmap subNodes) =+    concat $ P.map toList $ A.elems subNodes -toListNode (ArrayNode _numChildren subNodes) =-    concat $ P.map toListNode $ A.elems subNodes+toList (ArrayNode _numChildren subNodes) =+    concat $ P.map toList $ A.elems subNodes   -- | Build a map from a list of key\/value pairs with a combining function.-fromListWith :: (Eq k) => (k -> Int32) -> (v -> v -> v) -> [(k, v)] -> HamtMap k v+fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HamtMap k v -fromListWith hashFn combineFn assocs =-    HM hashFn $ fromListNode 0 combineFn $ P.map (\(k, v) -> ((hashFn k), k, v)) assocs+fromListWith combineFn assocs =+    fromListNode 0 combineFn $ P.map (\(k, v) -> ((hash k), k, v)) assocs  -fromListNode :: (Eq k) => Int -> (v -> v -> v) -> [(Int32, k, v)] -> Node k v+fromListNode :: (Eq k, Hashable k) => Int -> (v -> v -> v) -> [(Int32, k, v)] -> HamtMap k v  fromListNode shift combineFn hkvs =     let subHashed = P.map (\triple@(h, k, v) -> (hashFragment shift h, triple)) hkvs@@ -462,7 +500,7 @@                   -- this will alternately reverse and unreverse the list on each level down         dividedList = A.elems divided         subNodes = listArray (0, mask) $ P.map (fromListNode (shift+shiftStep) combineFn) $ dividedList-        numChildren = length $ filter (not.null) dividedList+        numChildren = length $ P.filter (not.null) dividedList         in case hkvs of                 []          -> EmptyNode                 [(h, k, v)] -> LeafNode h k v@@ -485,10 +523,10 @@                 _ | otherwise ->                     makeBMNode numChildren subNodes     where-    makeBMNode :: (Eq k) => Int -> Array Int32 (Node k v) -> Node k v+    makeBMNode :: (Eq k, Hashable k) => Int -> Array Int32 (HamtMap k v) -> HamtMap k v     makeBMNode numChildren subNodes =         let subNodeList = A.elems subNodes-            subNodes' = listArray (0, (fromIntegral numChildren-1)) $ filter (not.isEmptyNode) subNodeList+            subNodes' = listArray (0, (fromIntegral numChildren-1)) $ P.filter (not.isEmptyNode) subNodeList             listToBitmap = foldr (\on bm -> (bm `shiftL` 1) .|. (if on then 1 else 0)) 0             bitmap = listToBitmap $ P.map (not.isEmptyNode) subNodeList             in BitmapIndexedNode bitmap subNodes'@@ -506,20 +544,20 @@ -- | 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 :: (Eq k) => (k -> Int32) -> [(k, v)] -> HamtMap k v+fromList :: (Eq k, Hashable k) => [(k, v)] -> HamtMap k v -fromList hashFn assocs =-    fromListWith hashFn const assocs+fromList assocs =+    fromListWith const assocs    -- | Return all keys of the map.-keys :: (Eq k) => HamtMap k v -> [k]+keys :: (Eq k, Hashable k) => HamtMap k v -> [k]  keys = (P.map fst).toList   -- | Return all elements of the map.-elems :: (Eq k) => HamtMap k v -> [v]+elems :: (Eq k, Hashable k) => HamtMap k v -> [v]  elems = (P.map snd).toList

@@ -19,17 +19,14 @@  instance NFData BS.ByteString -hashBS :: BS.ByteString -> Int32-hashBS = fromIntegral . hash- main :: IO () main = do-    let hmbs = HM.fromList hashBS elemsBS :: HM.HamtMap BS.ByteString Int+    let hmbs = HM.fromList elemsBS :: HM.HamtMap BS.ByteString Int     defaultMainWith defaultConfig         (liftIO . evaluate $ rnf [hmbs])-        [ bench "fromList" $ nf (HM.fromList hashBS) elemsBS+        [ bench "fromList" $ nf HM.fromList elemsBS         , bench "lookup" $ nf (lookup keysBS) hmbs-        , bench "insert" $ nf (insert elemsBS) (HM.empty hashBS)+        , bench "insert" $ nf (insert elemsBS) HM.empty         , bench "delete" $ nf (delete keysBS) hmbs         ]   where@@ -39,13 +36,13 @@     elemsBS = zip keysBS [1..n]     keysBS  = rnd 8 n -lookup :: Eq k => [k] -> HM.HamtMap k Int -> Int+lookup :: (Eq k, Hashable k) => [k] -> HM.HamtMap k Int -> Int lookup xs m = foldl' (\z k -> fromMaybe z (HM.lookup k m)) 0 xs -insert :: Eq k => [(k, Int)] -> HM.HamtMap k Int -> HM.HamtMap k Int+insert :: (Eq k, Hashable k) => [(k, Int)] -> HM.HamtMap k Int -> HM.HamtMap k Int insert xs m0 = foldl' (\m (k, v) -> HM.insert k v m) m0 xs -delete :: Eq k => [k] -> HM.HamtMap k Int -> HM.HamtMap k Int+delete :: (Eq k, Hashable k) => [k] -> HM.HamtMap k Int -> HM.HamtMap k Int delete xs m0 = foldl' (\m k -> HM.delete k m) m0 xs  -- | Generate a number of fixed length strings where the content of

@@ -1,5 +1,5 @@ name:               hamtmap-version:            0.2+version:            0.3 cabal-version:      >= 1.2 synopsis:           A purely functional and persistent hash map description:        A port of Clojure's efficient persistent and hash@@ -20,7 +20,7 @@ stability:          experimental  library-  build-depends:    base >= 4 && < 5, array, deepseq+  build-depends:    base >= 4 && < 5, array, deepseq, hashable   exposed-modules:  Data.HamtMap   other-modules:    Data.BitUtil   ghc-options:      -O2

@@ -7,6 +7,16 @@ import Data.Maybe (isNothing) import Prelude as P +newtype Inty = Inty Int deriving (Eq, Show, Ord)++instance Hashable Inty where+    hash (Inty i) = fromIntegral (hash i `mod` 2)++instance Arbitrary Inty where+    arbitrary = do+        x <- arbitrary+        return $ Inty x+ ldelete :: (Eq k) => k -> [(k, v)] -> [(k, v)] ldelete _ [] = [] ldelete k ((k', v'):xs) | k' == k   = ldelete k xs@@ -17,9 +27,9 @@ lset k v ((k', v'):xs) | k' == k   = (k, v) : lset k v xs                        | otherwise = (k', v') : lset k v xs -prop_insert :: (Eq k, Hashable k, Eq v) => (k -> Int32) -> k -> v -> [(k, v)] -> Bool-prop_insert hashFn k v lm =-    let hm  = fromList hashFn lm+prop_insert :: (Eq k, Hashable k, Eq v) => k -> v -> [(k, v)] -> Bool+prop_insert k v lm =+    let hm  = fromList lm         hm' = insert k v hm         in    member k hm'            && not (notMember k hm')@@ -30,9 +40,9 @@                   else toList hm == ldelete k (toList hm')                   ) -prop_delete :: (Eq k, Hashable k, Eq v) => (k -> Int32) -> k -> [(k, v)] -> Bool-prop_delete hashFn k lm =-    let hm  = fromList hashFn lm+prop_delete :: (Eq k, Hashable k, Eq v) => k -> [(k, v)] -> Bool+prop_delete k lm =+    let hm  = fromList lm         hm' = delete k hm         in    not (member k hm')            && notMember k hm'@@ -42,15 +52,15 @@                   else toList hm' == toList hm                   ) -prop_fromList :: (Eq k, Hashable k, Ord k, Eq v, Ord v) => (k -> Int32) -> [(k, v)] -> Bool-prop_fromList hashFn lm =-    let hm = fromList hashFn lm-        hm' = foldl' (\hm (k,v) -> insert k v hm) (empty hashFn) lm+prop_fromList :: (Eq k, Hashable k, Ord k, Eq v, Ord v) => [(k, v)] -> Bool+prop_fromList lm =+    let hm = fromList lm+        hm' = foldl' (\hm (k,v) -> insert k v hm) empty lm         in sort (toList hm) == sort (toList hm') -prop_toList :: (Eq k, Hashable k, Ord k, Eq v, Ord v) => (k -> Int32) -> [(k, v)] -> Bool-prop_toList hashFn lm =-    let hm = fromList hashFn lm+prop_toList :: (Eq k, Hashable k, Eq v) => [(k, v)] -> Bool+prop_toList lm =+    let hm = fromList lm         lm' = toList hm         ks = keys hm         ks' = P.map fst lm'@@ -61,19 +71,35 @@            && els == els'            && els == els'' +prop_map :: (Eq k, Hashable k, Integral v) => [(k, v)] -> Bool+prop_map lm =+    let hm = fromList lm+        lm' = toList hm+        in toList (HM.map (*2) hm) == P.map (\(x,y) -> (x, y*2)) lm' +prop_filter :: (Eq k, Hashable k, Integral v) => [(k, v)] -> Bool+prop_filter lm =+    let hm = fromList lm+        lm' = toList hm+        in toList (HM.filter even hm) == P.filter (\(x,y) -> even y) lm'++ options = TestOptions       { no_of_tests         = 200       , length_of_tests     = 2 -- seconds       , debug_tests         = False }  main = runTests "tests" options-    [ run (prop_insert fromIntegral :: Int -> Int -> [(Int,Int)] -> Bool)-    , run (prop_insert (fromIntegral.(`mod` 2)) :: Int -> Int -> [(Int,Int)] -> Bool)-    , run (prop_delete fromIntegral :: Int -> [(Int, Int)] -> Bool)-    , run (prop_delete (fromIntegral.(`mod` 2)) :: Int -> [(Int,Int)] -> Bool)-    , run (prop_fromList fromIntegral :: [(Int, Int)] -> Bool)-    , run (prop_fromList (fromIntegral.(`mod` 2)) :: [(Int, Int)] -> Bool)-    , run (prop_toList fromIntegral :: [(Int, Int)] -> Bool)-    , run (prop_toList (fromIntegral.(`mod` 2)) :: [(Int, Int)] -> Bool)+    [ run (prop_insert :: Int -> Int -> [(Int,Int)] -> Bool)+    , run (prop_insert :: Inty -> Int -> [(Inty,Int)] -> Bool)+    , run (prop_delete :: Int -> [(Int, Int)] -> Bool)+    , run (prop_delete :: Inty -> [(Inty, Int)] -> Bool)+    , run (prop_fromList :: [(Int, Int)] -> Bool)+    , run (prop_fromList :: [(Inty, Int)] -> Bool)+    , run (prop_toList :: [(Int, Int)] -> Bool)+    , run (prop_toList :: [(Inty, Int)] -> Bool)+    , run (prop_map :: [(Int, Int)] -> Bool)+    , run (prop_map :: [(Inty, Int)] -> Bool)+    , run (prop_filter :: [(Int, Int)] -> Bool)+    , run (prop_filter :: [(Inty, Int)] -> Bool)     ]