X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FHashTable.hs;h=0f31af52509bde78501971800c3e8b0561d0bc9c;hb=b875ec7b3b799bf19841ca1adf23f6d3e8b3a8f6;hp=cc4c32b16796bced392fcbed5c9f78f6727f0fb3;hpb=253bd8d0ee679e72731308456cea91eb9600ff70;p=haskell-directory.git

diff --git a/Data/HashTable.hs b/Data/HashTable.hs
index cc4c32b..0f31af5 100644
--- a/Data/HashTable.hs
+++ b/Data/HashTable.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -187,7 +187,7 @@ new
 
 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
 
@@ -271,11 +271,17 @@ expandHashTable
       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 }
@@ -286,7 +292,7 @@ expandHashTable
 			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
@@ -298,10 +304,10 @@ expandHashTable
 		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
@@ -343,7 +349,7 @@ update (HashTable ref) key val = do
   segment <- myReadArray dir segment_index
   bucket <- myReadArray segment segment_offset
   let 
-    (deleted,bucket') = foldr filt (0,[]) bucket
+    (deleted,bucket') = foldr filt (0::Int32,[]) bucket
     filt pair@(k,v) (deleted,bucket)
 	| key `cmp` k = (deleted+1, bucket)
 	| otherwise   = (deleted,   pair:bucket)