module Data.HashMap.Common
(
HashMap(..)
, Prefix
, Mask
, Hash
, join
, bin
, zero
, nomatch
, mask
, maskW
, branchMask
, highBit
) where
#include "MachDeps.h"
import Control.DeepSeq (NFData(rnf))
import Data.Bits ((.&.), (.|.), complement, shiftR, xor)
import qualified Data.Foldable as Foldable
import Data.Word (Word)
import Prelude hiding (foldr, map)
import qualified Data.FullList.Lazy as FL
data HashMap k v
= Nil
| Tip !Hash
!(FL.FullList k v)
| Bin !Prefix
!Mask
!(HashMap k v)
!(HashMap k v)
deriving Show
type Prefix = Int
type Mask = Int
type Hash = Int
instance (Eq k, Eq v) => Eq (HashMap k v) where
t1 == t2 = equal t1 t2
t1 /= t2 = nequal t1 t2
equal :: (Eq k, Eq v) => HashMap k v -> HashMap k v -> Bool
equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) =
(m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
equal (Tip h1 l1) (Tip h2 l2) = (h1 == h2) && (l1 == l2)
equal Nil Nil = True
equal _ _ = False
nequal :: (Eq k, Eq v) => HashMap k v -> HashMap k v -> Bool
nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) =
(m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
nequal (Tip h1 l1) (Tip h2 l2) = (h1 /= h2) || (l1 /= l2)
nequal Nil Nil = False
nequal _ _ = True
instance (NFData k, NFData v) => NFData (HashMap k v) where
rnf Nil = ()
rnf (Tip _ xs) = rnf xs
rnf (Bin _ _ l r) = rnf l `seq` rnf r `seq` ()
instance Functor (HashMap k) where
fmap = map
map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2
map f = go
where
go (Bin p m l r) = Bin p m (go l) (go r)
go (Tip h l) = Tip h (FL.map f' l)
go Nil = Nil
f' k v = (k, f v)
instance Foldable.Foldable (HashMap k) where
foldr f = foldrWithKey (const f)
foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey f = go
where
go z (Bin _ _ l r) = go (go z r) l
go z (Tip _ l) = FL.foldrWithKey f z l
go z Nil = z
join :: Prefix -> HashMap k v -> Prefix -> HashMap k v -> HashMap k v
join p1 t1 p2 t2
| zero p1 m = Bin p m t1 t2
| otherwise = Bin p m t2 t1
where
m = branchMask p1 p2
p = mask p1 m
bin :: Prefix -> Mask -> HashMap k v -> HashMap k v -> HashMap k v
bin _ _ l Nil = l
bin _ _ Nil r = r
bin p m l r = Bin p m l r
zero :: Hash -> Mask -> Bool
zero i m = (fromIntegral i :: Word) .&. (fromIntegral m :: Word) == 0
nomatch :: Hash -> Prefix -> Mask -> Bool
nomatch i p m = (mask i m) /= p
mask :: Hash -> Mask -> Prefix
mask i m = maskW (fromIntegral i :: Word) (fromIntegral m :: Word)
maskW :: Word -> Word -> Prefix
maskW i m = fromIntegral (i .&. (complement (m1) `xor` m))
branchMask :: Prefix -> Prefix -> Mask
branchMask p1 p2 =
fromIntegral (highBit (fromIntegral p1 `xor` fromIntegral p2 :: Word))
highBit :: Word -> Word
highBit x0 =
let !x1 = x0 .|. shiftR x0 1
!x2 = x1 .|. shiftR x1 2
!x3 = x2 .|. shiftR x2 4
!x4 = x3 .|. shiftR x3 8
!x5 = x4 .|. shiftR x4 16
#if WORD_SIZE_IN_BITS == 32
in x5 `xor` (shiftR x5 1)
#elif WORD_SIZE_IN_BITS == 64
!x6 = x5 .|. shiftR x5 32
in x6 `xor` (shiftR x6 1)
#else
# error WORD_SIZE_IN_BITS not supported
#endif