import Hugs.IOArray ( IOArray, newIOArray,
unsafeReadIOArray, unsafeWriteIOArray )
# elif defined(__NHC__)
-import NHC.IOExtras ( IOArray, newIOArray )
+import NHC.IOExtras ( IOArray, newIOArray, readIOArray, writeIOArray )
# endif
#endif
import Control.Monad ( mapM, mapM_, sequence_ )
#if defined(DEBUG) || defined(__NHC__)
type MutArray a = IOArray Int32 a
type HTArray a = MutArray a
-newMutArray = newArray
-readHTArray = readArray
-writeMutArray = writeArray
+newMutArray = newIOArray
+readHTArray = readIOArray
+writeMutArray = writeIOArray
freezeArray = return
thawArray = return
#else
-- implemented by extracting the uppermost 32 bits of the 64-bit
-- result of multiplying by a 32-bit constant. The constant is from
-- Knuth, derived from the golden ratio:
+--
-- > golden = round ((sqrt 5 - 1) * 2^31) :: Int
hashInt :: Int -> Int32
hashInt x = mulHi (fromIntegral x) golden
then return table
else do
--
- newbkts' <- newMutArray (0,newmask) []
+ newbkts' <- newMutArray (0,newmask) []
- let
- splitBucket oldindex = do
- bucket <- readHTArray bkts oldindex
- let (oldb,newb) =
+ let
+ splitBucket oldindex = do
+ bucket <- readHTArray bkts oldindex
+ let (oldb,newb) =
partition ((oldindex==). bucketIndex newmask . hash . fst) bucket
- writeMutArray newbkts' oldindex oldb
- writeMutArray newbkts' (oldindex + oldsize) newb
- mapM_ splitBucket [0..mask]
+ writeMutArray newbkts' oldindex oldb
+ writeMutArray newbkts' (oldindex + oldsize) newb
+ mapM_ splitBucket [0..mask]
- newbkts <- freezeArray newbkts'
+ newbkts <- freezeArray newbkts'
- return ( table{ buckets=newbkts, bmask=newmask } )
+ return ( table{ buckets=newbkts, bmask=newmask } )
-- -----------------------------------------------------------------------------
-- Deleting a mapping from the hash table