[project @ 2003-11-26 09:55:22 by simonmar]

[ghc-base.git] / Data / HashTable.hs

diff --git a/Data/HashTable.hs b/Data/HashTable.hs
index 5211f90..9fbe735 100644 (file)
--- a/Data/HashTable.hs
+++ b/Data/HashTable.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.HashTable
@@ -23,29 +25,55 @@ module Data.HashTable (
        -- * Hash functions
        -- $hash_functions
        hashInt, hashString,
+       prime,
        -- * Diagnostics
        longestChain
  ) where
 
-import Data.Char       ( ord )
-import Data.Int        ( Int32 )
-import Data.Array.IO
-import Data.Array.Base
-import Data.List       ( maximumBy )
-import Data.IORef
+-- This module is imported by Data.Dynamic, which is pretty low down in the
+-- module hierarchy, so don't import "high-level" modules
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Base
+#else
+import Prelude hiding  ( lookup )
+#endif
+import Data.Tuple      ( fst )
 import Data.Bits
-import Control.Monad   ( when )
-import Prelude                 hiding (lookup)
---import Debug.Trace
+import Data.Maybe
+import Data.List       ( maximumBy, filter, length, concat )
+import Data.Int                ( Int32 )
+
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Num
+import GHC.Real                ( Integral(..), fromIntegral )
+
+import GHC.IOBase      ( IO, IOArray, newIOArray, readIOArray, writeIOArray,
+                         unsafeReadIOArray, unsafeWriteIOArray,
+                         IORef, newIORef, readIORef, writeIORef )
+import GHC.Err         ( undefined )
+#else
+import Data.Char       ( ord )
+import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
+#  if defined(__HUGS__)
+import Hugs.IOArray    ( IOArray, newIOArray, readIOArray, writeIOArray,
+                         unsafeReadIOArray, unsafeWriteIOArray )
+#  elif defined(__NHC__)
+import NHC.IOExtras    ( IOArray, newIOArray, readIOArray, writeIOArray)
+#  endif
+#endif
+import Control.Monad   ( when, mapM, sequence_ )
+
 
+-----------------------------------------------------------------------
 myReadArray  :: IOArray Int32 a -> Int32 -> IO a
 myWriteArray :: IOArray Int32 a -> Int32 -> a -> IO ()
-#ifdef DEBUG
-myReadArray  = readArray
-myWriteArray = writeArray
+#if defined(DEBUG) || defined(__NHC__)
+myReadArray  = readIOArray
+myWriteArray = writeIOArray
 #else
-myReadArray arr i = unsafeRead arr (fromIntegral i)
-myWriteArray arr i x = unsafeWrite arr (fromIntegral i) x
+myReadArray arr i = unsafeReadIOArray arr (fromIntegral i)
+myWriteArray arr i x = unsafeWriteIOArray arr (fromIntegral i) x
 #endif
 
 -- | A hash table mapping keys of type @key@ to values of type @val@.
@@ -101,7 +129,7 @@ data HashTable key val
 --
 -- This implementation of hash tables uses the low-order /n/ bits of the hash
 -- value for a key, where /n/ varies as the hash table grows.  A good hash
--- function therefore will give a good distribution regardless of /n/.
+-- function therefore will give an even distribution regardless of /n/.
 --
 -- If your keyspace is integrals such that the low-order bits between
 -- keys are highly variable, then you could get away with using 'id'
@@ -117,7 +145,7 @@ data HashTable key val
 hashInt :: Int -> Int32
 hashInt = (`rem` prime) . fromIntegral
 
--- | A sample hash fucntion for 'String's.  The implementation is:
+-- | A sample hash function for 'String's.  The implementation is:
 --
 -- >    hashString = fromIntegral . foldr f 0
 -- >      where f c m = ord c + (m * 128) `rem` 1500007
@@ -128,8 +156,9 @@ hashString :: String -> Int32
 hashString = fromIntegral . foldr f 0
   where f c m = ord c + (m * 128) `rem` fromIntegral prime
 
--- a prime larger than the maximum hash table size
-prime = 1500007 :: Int32
+-- | A prime larger than the maximum hash table size
+prime :: Int32
+prime = 1500007
 
 -- -----------------------------------------------------------------------------
 -- Parameters
@@ -146,16 +175,20 @@ hLOAD = 4 :: Int32 -- Maximum average load of a single hash bucket
 -- -----------------------------------------------------------------------------
 -- Creating a new hash table
 
--- | Creates a new hash table
+-- | Creates a new hash table.  The following property should hold for the @eq@
+-- and @hash@ functions passed to 'new':
+--
+-- >   eq A B  =>  hash A == hash B
+--
 new
-  :: (key -> key -> Bool)    -- ^ An equality comparison on keys
-  -> (key -> Int32)         -- ^ A hash function on keys
+  :: (key -> key -> Bool)    -- ^ @eq@: An equality comparison on keys
+  -> (key -> Int32)         -- ^ @hash@: A hash function on keys
   -> IO (HashTable key val)  -- ^ Returns: an empty hash table
 
 new cmp hash_fn = do
   -- make a new hash table with a single, empty, segment
-  dir     <- newArray (0,dIR_SIZE) undefined
-  segment <- newArray (0,sEGMENT_SIZE-1) []
+  dir     <- newIOArray (0,dIR_SIZE) undefined
+  segment <- newIOArray (0,sEGMENT_SIZE-1) []
   myWriteArray dir 0 segment
 
   let
@@ -231,7 +264,7 @@ expandHashTable
       newindex   = newbucket .&. sEGMENT_MASK
   --
   when (newindex == 0) $
-       do segment <- newArray (0,sEGMENT_SIZE-1) []
+       do segment <- newIOArray (0,sEGMENT_SIZE-1) []
           myWriteArray dir newsegment segment
   --
   let table' =