-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
new cmp hash_fn = do
-- make a new hash table with a single, empty, segment
- dir <- newIOArray (0,dIR_SIZE) undefined
+ dir <- newIOArray (0,dIR_SIZE-1) undefined
segment <- newIOArray (0,sEGMENT_SIZE-1) []
myWriteArray dir 0 segment
newsegment = newbucket `shiftR` sEGMENT_SHIFT
newindex = newbucket .&. sEGMENT_MASK
--
- when (newindex == 0) $
+ if newsegment >= dIR_SIZE -- make sure we don't overflow the table.
+ then return table
+ else do
+ --
+ when (newindex == 0) $
do segment <- newIOArray (0,sEGMENT_SIZE-1) []
- myWriteArray dir newsegment segment
+ writeIOArray dir newsegment segment
+ -- doesn't happen very often, so we might as well use a safe
+ -- array index here.
--
- let table' =
+ let table' =
if (split+1) < max
then table{ split = split+1,
bcount = bcount+1 }
max_bucket = max * 2,
mask1 = mask2,
mask2 = mask2 `shiftL` 1 .|. 1 }
- let
+ let
split_bucket old new [] = do
segment <- myReadArray dir oldsegment
myWriteArray segment oldindex old
then split_bucket old ((k,v):new) xs
else split_bucket ((k,v):old) new xs
--
- segment <- myReadArray dir oldsegment
- bucket <- myReadArray segment oldindex
- split_bucket [] [] bucket
- return table'
+ segment <- myReadArray dir oldsegment
+ bucket <- myReadArray segment oldindex
+ split_bucket [] [] bucket
+ return table'
-- -----------------------------------------------------------------------------
-- Deleting a mapping from the hash table