X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FHashTable.hs;h=37ddb5e05199973400f79937f925e4a6d1ae9195;hb=ea98be462413c2785386967865a511b3405bb031;hp=8c88f15b9a033e61374859845f7a59029bad7f32;hpb=e1399bdcde01f55824973b556f60eecbe4dc2250;p=ghc-base.git

diff --git a/Data/HashTable.hs b/Data/HashTable.hs
index 8c88f15..37ddb5e 100644
--- a/Data/HashTable.hs
+++ b/Data/HashTable.hs
@@ -33,25 +33,42 @@ module Data.HashTable (
 -- 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 Data.Maybe
-import Data.List	( maximumBy, filter, length, concat )
+import Data.List	( maximumBy, filter, length, concat, foldl )
+import Data.Int		( Int32 )
 
+#if defined(__GLASGOW_HASKELL__)
 import GHC.Num
-import GHC.Int  	( Int32 )
 import GHC.Real		( Integral(..), fromIntegral )
 
-import GHC.IOBase	( IO, IOArray, newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
+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
+#if defined(DEBUG) || defined(__NHC__)
 myReadArray  = readIOArray
 myWriteArray = writeIOArray
 #else
@@ -136,11 +153,12 @@ hashInt = (`rem` prime) . fromIntegral
 -- which seems to give reasonable results.
 --
 hashString :: String -> Int32
-hashString = fromIntegral . foldr f 0
-  where f c m = ord c + (m * 128) `rem` fromIntegral prime
+hashString = fromIntegral . foldl f 0
+  where f m c = ord c + (m * 128) `rem` fromIntegral prime
 
 -- | A prime larger than the maximum hash table size
-prime = 1500007 :: Int32
+prime :: Int32
+prime = 1500007
 
 -- -----------------------------------------------------------------------------
 -- Parameters
@@ -157,10 +175,14 @@ 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
@@ -198,7 +220,7 @@ insert (HashTable ref) key val = do
 	   then expandHashTable table1
 	   else return table1
   writeIORef ref table2
-  (segment_index,segment_offset) <- tableLocation table key
+  (segment_index,segment_offset) <- tableLocation table2 key
   segment <- myReadArray dir segment_index
   bucket <- myReadArray segment segment_offset
   myWriteArray segment segment_offset ((key,val):bucket)
@@ -232,6 +254,7 @@ expandHashTable
       table@HT{ dir=dir,
 		split=split,
 		max_bucket=max,
+		bcount=bcount,
 		mask2=mask2 } = do
   let
       oldsegment = split `shiftR` sEGMENT_SHIFT
@@ -247,10 +270,12 @@ expandHashTable
   --
   let table' =
   	if (split+1) < max
-     	    then table{ split = split+1 }
+     	    then table{ split = split+1,
+			bcount = bcount+1 }
      		-- we've expanded all the buckets in this table, so start from
 		-- the beginning again.
      	    else table{ split = 0,
+			bcount = bcount+1,
 			max_bucket = max * 2,
 			mask1 = mask2,
 			mask2 = mask2 `shiftL` 1 .|. 1 }