packages feed

hashtables 1.0.0.0 → 1.0.1.0

raw patch · 7 files changed

+420/−114 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.HashTable.ST.Basic: instance Monoid Slot
+ Data.HashTable.ST.Basic: instance Show Slot

Files

cbits/cfuncs.c view
@@ -1,5 +1,7 @@+#include <signal.h> #include <stdint.h>-+#include <stdio.h>+#include <unistd.h>  #if defined(USE_SSE_4_1) #include <smmintrin.h>@@ -42,8 +44,14 @@                       uint32_t x1, uint32_t x2) {     uint32_t* ep = array + end;     uint32_t* p = array + start;+    int wrapped = 0;     while (1) {-        if (p == ep) p = array;+        if (p == ep) {+            if (wrapped) return -1;+            ep = array + start;+            p = array;+            wrapped = 1;+        }         if (*p == x1 || *p == x2) return p - array;         ++p;     }@@ -54,8 +62,14 @@                       uint32_t x1, uint32_t x2, uint32_t x3) {     uint32_t* ep = array + end;     uint32_t* p = array + start;+    int wrapped = 0;     while (1) {-        if (p == ep) p = array;+        if (p == ep) {+            if (wrapped) return -1;+            ep = array + start;+            p = array;+            wrapped = 1;+        }         if (*p == x1 || *p == x2 || *p == x3) return p - array;         ++p;     }@@ -66,8 +80,14 @@                       uint64_t x1, uint64_t x2) {     uint64_t* ep = array + end;     uint64_t* p = array + start;+    int wrapped = 0;     while (1) {-        if (p == ep) p = array;+        if (p == ep) {+            if (wrapped) return -1;+            ep = array + start;+            p = array;+            wrapped = 1;+        }         if (*p == x1 || *p == x2) return p - array;         ++p;     }@@ -78,8 +98,14 @@                       uint64_t x1, uint64_t x2, uint64_t x3) {     uint64_t* ep = array + end;     uint64_t* p = array + start;+    int wrapped = 0;     while (1) {-        if (p == ep) p = array;+        if (p == ep) {+            if (wrapped) return -1;+            ep = array + start;+            p = array;+            wrapped = 1;+        }         if (*p == x1 || *p == x2 || *p == x3) return p - array;         ++p;     }@@ -469,3 +495,13 @@     return lineResult64((int)m, start); } +void suicide(volatile int* check, int t) {+    int secs = (3*t + 999999) / 1000000;+    if (secs < 1) secs = 1;++    sleep(secs);+    if (*check) {+        printf("timeout expired, dying!!\n");+        raise(SIGKILL);+    }+}
hashtables.cabal view
@@ -1,5 +1,5 @@ Name:                hashtables-Version:             1.0.0.0+Version:             1.0.1.0 Synopsis:            Mutable hash tables in the ST monad Homepage:            http://github.com/gregorycollins/hashtables License:             BSD3@@ -165,7 +165,7 @@     if flag(portable)-    cpp-options: -DNO_C_SEARCH+    cpp-options: -DNO_C_SEARCH -DPORTABLE    if !flag(portable) && flag(unsafe-tricks) && impl(ghc)     build-depends: ghc-prim
src/Data/HashTable/Internal/CacheLine.hs view
@@ -234,30 +234,38 @@  {-# INLINE forwardSearch2 #-} forwardSearch2 :: IntArray s -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch2 !vec !start !end !x1 !x2 = go start+forwardSearch2 !vec !start !end !x1 !x2 = go start end False   where-    next !i = let !j = i+1-              in if j == end then 0 else j+    next !i !e !b = let !j = i+1+                    in if j == e+                         then (if b then (-1,e,True) else (0,start,True))+                         else (j,e,b) -    go !i = do+    go !i !e !b = do         h <- M.readArray vec i         if h == x1 || h == x2           then return i-          else go $ next i+          else do+              let (!i',!e',!b') = next i e b+              if (i' < 0) then return (-1) else go i' e' b'   {-# INLINE forwardSearch3 #-} forwardSearch3 :: IntArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int-forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start+forwardSearch3 !vec !start !end !x1 !x2 !x3 = go start end False   where-    next !i = let !j = i+1-              in if j == end then 0 else j+    next !i !e !b = let !j = i+1+                    in if j == e+                         then (if b then (-1,e,True) else (0,start,True))+                         else (j,e,b) -    go !i = do+    go !i !e !b = do         h <- M.readArray vec i         if h == x1 || h == x2 || h == x3           then return i-          else go $ next i+          else do+              let (!i',!e',!b') = next i e b+              if (i' < 0) then return (-1) else go i' e' b'   deBruijnBitPositions :: U.Vector Int8
src/Data/HashTable/ST/Basic.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE BangPatterns    #-}-{-# LANGUAGE MagicHash       #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP          #-}+{-# LANGUAGE MagicHash    #-}  {-| @@ -13,6 +14,10 @@   * don't care that a table resize might pause for a long time to rehash all     of the key-value mappings. +  * have a workload which is not heavy with deletes; deletes clutter the table+    with deleted markers and force the table to be completely rehashed fairly+    often.+ /Details:/  Of the hash tables in this collection, this hash table has the best insert and@@ -88,11 +93,13 @@   ------------------------------------------------------------------------------+import           Control.Exception (assert) import           Control.Monad hiding (mapM_, foldM) import           Control.Monad.ST import           Data.Hashable (Hashable) import qualified Data.Hashable as H import           Data.Maybe+import           Data.Monoid import           Data.STRef import           GHC.Exts import           Prelude hiding (lookup, read, mapM_)@@ -109,13 +116,14 @@ newtype HashTable s k v = HT (STRef s (HashTable_ s k v))  data HashTable_ s k v = HashTable-    { _size   :: {-# UNPACK #-} !Int-    , _load   :: !(U.IntArray s)  -- ^ prefer unboxed vector here to STRef-                                  -- because I know it will be appropriately-                                  -- strict-    , _hashes :: !(U.IntArray s)-    , _keys   :: {-# UNPACK #-} !(MutableArray s k)-    , _values :: {-# UNPACK #-} !(MutableArray s v)+    { _size    :: {-# UNPACK #-} !Int+    , _load    :: !(U.IntArray s)  -- ^ How many entries in the table? Prefer+                                   -- unboxed vector here to STRef because I+                                   -- know it will be appropriately strict+    , _delLoad :: !(U.IntArray s)  -- ^ How many deleted entries in the table?+    , _hashes  :: !(U.IntArray s)+    , _keys    :: {-# UNPACK #-} !(MutableArray s k)+    , _values  :: {-# UNPACK #-} !(MutableArray s v)     }  @@ -166,8 +174,8 @@     k  <- newArray m undefined     v  <- newArray m undefined     ld <- U.newArray 1-    return $! HashTable m ld h k v-+    dl <- U.newArray 1+    return $! HashTable m ld dl h k v   ------------------------------------------------------------------------------@@ -186,8 +194,6 @@ {-# INLINE delete #-}  -- ------------------------------------------------------------------------------ -- | See the documentation for this function in -- "Data.HashTable.Class#v:lookup".@@ -196,30 +202,35 @@     ht <- readRef htRef     lookup' ht   where-    lookup' (HashTable sz _ hashes keys values) = do+    lookup' (HashTable sz _ _ hashes keys values) = do         let !b = whichBucket h sz         debug $ "lookup sz=" ++ show sz ++ " h=" ++ show h ++ " b=" ++ show b-        go b+        go b 0 sz        where         !h = hash k -        go !b = {-# SCC "lookup/go" #-} do-            idx <- forwardSearch2 hashes b sz h emptyMarker+        go !b !start !end = {-# SCC "lookup/go" #-} do+            idx <- forwardSearch2 hashes b end h emptyMarker             debug $ "forwardSearch2 returned " ++ show idx-            h0  <- U.readArray hashes idx-            debug $ "h0 was " ++ show h0+            if (idx < 0 || idx < start || idx >= end)+               then return Nothing+               else do+                 h0  <- U.readArray hashes idx+                 debug $ "h0 was " ++ show h0 -            if recordIsEmpty h0-              then return Nothing-              else do-                k' <- readArray keys idx-                if k == k'-                  then do-                    debug $ "value found at " ++ show idx-                    v <- readArray values idx-                    return $! Just v-                  else go $! idx + 1+                 if recordIsEmpty h0+                   then return Nothing+                   else do+                     k' <- readArray keys idx+                     if k == k'+                       then do+                         debug $ "value found at " ++ show idx+                         v <- readArray values idx+                         return $! Just v+                       else if idx < b+                              then go (idx + 1) (idx + 1) b+                              else go (idx + 1) start end {-# INLINE lookup #-}  @@ -262,7 +273,7 @@ foldM :: (a -> (k,v) -> ST s a) -> a -> HashTable s k v -> ST s a foldM f seed0 htRef = readRef htRef >>= work   where-    work (HashTable sz _ hashes keys values) = go 0 seed0+    work (HashTable sz _ _ hashes keys values) = go 0 seed0       where         go !i !seed | i >= sz = return seed                     | otherwise = do@@ -282,7 +293,7 @@ mapM_ :: ((k,v) -> ST s b) -> HashTable s k v -> ST s () mapM_ f htRef = readRef htRef >>= work   where-    work (HashTable sz _ hashes keys values) = go 0+    work (HashTable sz _ _ hashes keys values) = go 0       where         go !i | i >= sz = return ()               | otherwise = do@@ -302,14 +313,14 @@ computeOverhead :: HashTable s k v -> ST s Double computeOverhead htRef = readRef htRef >>= work   where-    work (HashTable sz' loadRef _ _ _) = do+    work (HashTable sz' loadRef _ _ _ _) = do         !ld <- U.readArray loadRef 0         let k = fromIntegral ld / sz         return $ constOverhead / sz + overhead k       where         sz = fromIntegral sz'         -- Change these if you change the representation-        constOverhead = 10+        constOverhead = 14         overhead k = 3 / k - 2  @@ -330,44 +341,55 @@              -> ST s () insertRecord !sz !hashes !keys !values !h !key !value = do     let !b = whichBucket h sz-    debug $ "insertRecord sz=" ++ show sz ++ "h=" ++ show h ++ " b=" ++ show b+    debug $ "insertRecord sz=" ++ show sz ++ " h=" ++ show h ++ " b=" ++ show b     probe b    where     probe !i = {-# SCC "insertRecord/probe" #-} do         !idx <- forwardSearch2 hashes i sz emptyMarker deletedMarker         debug $ "forwardSearch2 returned " ++ show idx-        U.writeArray hashes idx h-        writeArray keys idx key-        writeArray values idx value+        assert (idx >= 0) $ do+            U.writeArray hashes idx h+            writeArray keys idx key+            writeArray values idx value   ------------------------------------------------------------------------------ checkOverflow :: (Eq k, Hashable k) =>                  (HashTable_ s k v)               -> ST s (HashTable_ s k v)-checkOverflow ht@(HashTable sz ldRef _ _ _) = do+checkOverflow ht@(HashTable sz ldRef delRef _ _ _) = do     !ld <- U.readArray ldRef 0     let !ld' = ld + 1     U.writeArray ldRef 0 ld'+    !dl <- U.readArray delRef 0 -    if fromIntegral ld / fromIntegral sz > maxLoad-      then growTable ht+    debug $ concat [ "checkOverflow: sz="+                   , show sz+                   , " entries="+                   , show ld+                   , " deleted="+                   , show dl ]++    if fromIntegral (ld + dl) / fromIntegral sz > maxLoad+      then if dl > ld `div` 2+             then rehashAll ht sz+             else growTable ht       else return ht   -------------------------------------------------------------------------------growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v)-growTable (HashTable sz loadRef hashes keys values) = do-    let !sz' = bumpSize sz+rehashAll :: Hashable k => HashTable_ s k v -> Int -> ST s (HashTable_ s k v)+rehashAll (HashTable sz loadRef _ hashes keys values) sz' = do+    debug $ "rehashing: old size " ++ show sz ++ ", new size " ++ show sz'     ht' <- newSizedReal sz'-    let (HashTable _ loadRef' newHashes newKeys newValues) = ht'+    let (HashTable _ loadRef' _ newHashes newKeys newValues) = ht'     U.readArray loadRef 0 >>= U.writeArray loadRef' 0-    rehash sz' newHashes newKeys newValues+    rehash newHashes newKeys newValues     return ht'    where-    rehash sz' newHashes newKeys newValues = go 0+    rehash newHashes newKeys newValues = go 0       where         go !i | i >= sz   = return ()               | otherwise = {-# SCC "growTable/rehash" #-} do@@ -381,6 +403,30 @@   ------------------------------------------------------------------------------+growTable :: Hashable k => HashTable_ s k v -> ST s (HashTable_ s k v)+growTable ht@(HashTable sz _ _ _ _ _) = do+    let !sz' = bumpSize sz+    rehashAll ht sz'+++------------------------------------------------------------------------------+-- Helper data structure for delete'+data Slot = Slot {+      _slot       :: {-# UNPACK #-} !Int+    , _wasDeleted :: {-# UNPACK #-} !Int  -- we use Int because Bool won't+                                          -- unpack+    }+  deriving (Show)+++------------------------------------------------------------------------------+instance Monoid Slot where+    mempty = Slot maxBound 0+    (Slot x1 b1) `mappend` (Slot x2 b2) =+        if x1 == maxBound then Slot x2 b2 else Slot x1 b1+++------------------------------------------------------------------------------ -- Returns the slot in the array where it would be safe to write the given key. delete' :: (Hashable k, Eq k) =>            (HashTable_ s k v)@@ -388,62 +434,97 @@         -> k         -> Int         -> ST s Int-delete' (HashTable sz loadRef hashes keys values) clearOut k h = do-    let !b = whichBucket h sz+delete' (HashTable sz loadRef delRef hashes keys values) clearOut k h = do     debug $ "delete': sz=" ++ show sz ++ " h=" ++ show h-            ++ " b=" ++ show b-    (found,b') <- go Nothing b-    when found $ do-        !ld <- U.readArray loadRef 0-        let !ld' = ld - 1-        U.writeArray loadRef 0 ld'+            ++ " b0=" ++ show b0+    (found, slot) <- go mempty b0 False++    let !b' = _slot slot++    when found $ bump loadRef (-1)++    -- bump the delRef lower if we're writing over a deleted marker+    when (not clearOut && _wasDeleted slot == 1) $ bump delRef (-1)     return b'    where-    delPlace !fp !b    = maybe (Just b) (const fp) fp-    choosePlace !fp !b = fromMaybe b fp-    samePlace !fp !b   = maybe (True) (== b) fp+    bump ref i = do+        !ld <- U.readArray ref 0+        U.writeArray ref 0 $! ld + i -    go !fp !b = do+    !b0 = whichBucket h sz++    haveWrapped !(Slot fp _) !b = if fp == maxBound+                                    then False+                                    else b <= fp++    -- arguments:++    --   * fp    maintains the slot in the array where it would be safe to+    --           write the given key+    --   * b     search the buckets array starting at this index.+    --   * wrap  True if we've wrapped around, False otherwise++    go !fp !b !wrap = do         debug $ "go: fp=" ++ show fp ++ " b=" ++ show b+                  ++ ", wrap=" ++ show wrap         !idx <- forwardSearch3 hashes b sz h emptyMarker deletedMarker         debug $ "forwardSearch3 returned " ++ show idx-        h0 <- U.readArray hashes idx-        debug $ "h0 was " ++ show h0 -        if recordIsEmpty h0-          then do-              let pl = choosePlace fp idx-              debug $ "empty, returning " ++ show pl-              return (False, pl)-          else-            if recordIsDeleted h0+        if wrap && idx >= b0+          -- we wrapped around in the search and didn't find our hash code;+          -- this means that the table is full of deleted elements. Just return+          -- the first place we'd be allowed to insert.+          --+          -- TODO: if we get in this situation we should probably just rehash+          -- the table, because every insert is going to be O(n).+          then return $!+                   (False, fp `mappend` (Slot (error "impossible") 0))+          else do+            -- because the table isn't full, we know that there must be either+            -- an empty or a deleted marker somewhere in the table. Assert this+            -- here.+            assert (idx > 0) $ return ()+            h0 <- U.readArray hashes idx+            debug $ "h0 was " ++ show h0++            if recordIsEmpty h0               then do-                  let pl = delPlace fp idx-                  debug $ "deleted, cont with pl=" ++ show pl-                  go pl $ idx + 1-              else-                if h == h0+                  let pl = fp `mappend` (Slot idx 0)+                  debug $ "empty, returning " ++ show pl+                  return (False, pl)+              else do+                let !wrap' = haveWrapped fp idx+                if recordIsDeleted h0                   then do-                    k' <- readArray keys idx-                    if k == k'+                      let pl = fp `mappend` (Slot idx 1)+                      debug $ "deleted, cont with pl=" ++ show pl+                      go pl (idx + 1) wrap'+                  else+                    if h == h0                       then do-                        debug $ "found at " ++ show idx-                        debug $ "clearout=" ++ show clearOut-                        debug $ "sp? " ++ show (samePlace fp idx)-                        -- "clearOut" is set if we intend to write a new-                        -- element into the slot. If we're doing an update and-                        -- we found the old key, instead of writing "deleted"-                        -- and then re-writing the new element there, we can-                        -- just write the new element. This only works if we-                        -- were planning on writing the new element here.-                        when (clearOut || not (samePlace fp idx)) $ do-                            U.writeArray hashes idx 1-                            writeArray keys idx undefined-                            writeArray values idx undefined-                        return (True, choosePlace fp idx)-                      else go fp $ idx + 1-                  else go fp $ idx + 1+                        k' <- readArray keys idx+                        if k == k'+                          then do+                            let samePlace = _slot fp == idx+                            debug $ "found at " ++ show idx+                            debug $ "clearout=" ++ show clearOut+                            debug $ "sp? " ++ show samePlace+                            -- "clearOut" is set if we intend to write a new+                            -- element into the slot. If we're doing an update+                            -- and we found the old key, instead of writing+                            -- "deleted" and then re-writing the new element+                            -- there, we can just write the new element. This+                            -- only works if we were planning on writing the+                            -- new element here.+                            when (clearOut || not samePlace) $ do+                                bump delRef 1+                                U.writeArray hashes idx 1+                                writeArray keys idx undefined+                                writeArray values idx undefined+                            return (True, fp `mappend` (Slot idx 0))+                          else go fp (idx + 1) wrap'+                      else go fp (idx + 1) wrap'  ------------------------------------------------------------------------------ maxLoad :: Double@@ -502,5 +583,8 @@ ------------------------------------------------------------------------------ {-# INLINE debug #-} debug :: String -> ST s ()---debug s = unsafeIOToST (putStrLn s)+#ifdef DEBUG+debug s = unsafeIOToST (putStrLn s)+#else debug _ = return ()+#endif
src/Data/HashTable/ST/Cuckoo.hs view
@@ -253,7 +253,9 @@ searchOne !keys !hashes !k = go   where     go !b !h = do+        debug $ "searchOne: go " ++ show b ++ " " ++ show h         idx <- cacheLineSearch hashes b h+        debug $ "searchOne: cacheLineSearch returned " ++ show idx          case idx of           -1 -> return (-1)
test/hashtables-test.cabal view
@@ -47,8 +47,10 @@     ghc-options: -fhpc    if flag(portable)-    cpp-options: -DNO_C_SEARCH-+    cpp-options: -DNO_C_SEARCH -DPORTABLE+  else+    build-depends: unix >= 2.3 && <3+       if !flag(portable) && flag(unsafe-tricks) && impl(ghc)     cpp-options: -DUNSAFETRICKS     build-depends: ghc-prim@@ -68,8 +70,10 @@                      mwc-random == 0.8.*,                      primitive,                      QuickCheck >= 2.3.0.2,+                     HUnit >= 1.2 && <2,                      test-framework >= 0.3.1 && <0.4,                      test-framework-quickcheck2 >= 0.2.6 && < 0.3,+                     test-framework-hunit >= 0.2.6 && <3,                      vector >= 0.7    cpp-options: -DTESTSUITE@@ -92,7 +96,9 @@   ghc-prof-options:  -prof -auto-all    if flag(portable)-    cpp-options: -DNO_C_SEARCH+    cpp-options: -DNO_C_SEARCH -DPORTABLE+  else+    build-depends: unix >= 2.3 && <3    if !flag(portable) && flag(unsafe-tricks) && impl(ghc)     cpp-options: -DUNSAFETRICKS@@ -112,8 +118,10 @@                      hashable >= 1.1 && <2,                      mwc-random == 0.8.*,                      QuickCheck >= 2.3.0.2,+                     HUnit >= 1.2 && <2,                      test-framework >= 0.3.1 && <0.4,                      test-framework-quickcheck2 >= 0.2.6 && < 0.3,+                     test-framework-hunit >= 0.2.6 && <3,                      statistics == 0.8.*,                      primitive,                      vector >= 0.7
test/suite/Data/HashTable/Test/Common.hs view
@@ -1,5 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes   #-}+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RankNTypes               #-}  module Data.HashTable.Test.Common   ( FixedTableType@@ -9,7 +11,7 @@   ) where  -------------------------------------------------------------------------------import           Control.Monad                        (liftM, when)+import           Control.Monad                        (foldM_, liftM, when) import           Control.Monad.ST                     (unsafeIOToST) import           Data.IORef import           Data.List                            hiding ( insert@@ -20,14 +22,22 @@ import qualified Data.Vector.Mutable                  as MV import           Prelude                              hiding (lookup, mapM_) import           System.Random.MWC+import           System.Timeout import           Test.Framework+import           Test.Framework.Providers.HUnit import           Test.Framework.Providers.QuickCheck2+import           Test.HUnit (assertFailure) import           Test.QuickCheck import           Test.QuickCheck.Monadic ------------------------------------------------------------------------------ import qualified Data.HashTable.Class                 as C import           Data.HashTable.IO +#ifndef PORTABLE+import           Control.Concurrent+import           Foreign (malloc, free, poke, Ptr)+import           Foreign.C.Types (CInt)+#endif  ------------------------------------------------------------------------------ type FixedTableType h = forall k v . IOHashTable h k v@@ -67,6 +77,8 @@          , SomeTest testNewAndInsert          , SomeTest testGrowTable          , SomeTest testDelete+         , SomeTest testNastyFullLookup+         , SomeTest testForwardSearch3          ]  @@ -250,6 +262,162 @@         ct <- run $ foldM f (0::Int, 0::Int) ht         assertEq "max + count" (n-1,n-1) ct         forceType dummyArg ht+++------------------------------------------------------------------------------+data Action = Lookup Int+            | Insert Int+            | Delete Int+            deriving Show+++timeout_ :: Int -> IO a -> IO ()+#ifdef PORTABLE+timeout_ t m = timeout t m >>= maybe (assertFailure "timeout")+                                     (const $ return ())+#else++foreign import ccall safe "suicide"+  c_suicide :: Ptr CInt -> CInt -> IO ()+++-- Foreign thread can get blocked here, stalling progress. We'll make damned+-- sure we bomb out.+timeout_ t m = do+    ptr <- malloc+    poke ptr 1+    forkOS $ suicide ptr+    threadDelay 1000+    r <- timeout t m+    poke ptr 0+    maybe (assertFailure "timeout")+          (const $ return ())+          r+  where+    suicide ptr = do+        c_suicide ptr $ toEnum t+        free ptr+#endif++applyAction :: forall h . C.HashTable h =>+               IOHashTable h Int () -> Action -> IO ()+applyAction tbl (Lookup key) = lookup tbl key >> return ()+applyAction tbl (Insert key) = insert tbl key ()+applyAction tbl (Delete key) = delete tbl key+++testForwardSearch3 :: HashTest+testForwardSearch3 prefix dummyArg = testCase (prefix ++ "/forwardSearch3") go+  where+    go = do+        tbl <- new+        forceType tbl dummyArg+        timeout_ 3000000 $+            foldM_ (\t k -> applyAction t k >> return t) tbl testData++    testData =+      [ Insert 65+      , Insert 66+      , Insert 67+      , Insert 74+      , Insert 75+      , Insert 76+      , Insert 77+      , Insert 79+      , Insert 80+      , Insert 81+      , Insert 82+      , Insert 83+      , Insert 84+      , Delete 81+      , Delete 82+      , Insert 85+      , Insert 86+      , Insert 87+      , Insert 88+      , Insert 89+      , Insert 90+      , Insert 78+      , Insert 93+      , Insert 94+      , Insert 95+      , Insert 96+      , Insert 97+      , Insert 92+      , Delete 93+      , Delete 94+      , Delete 95+      , Delete 96+      , Insert 99+      , Insert 100+      , Insert 101+      , Insert 102+      , Insert 103+      , Insert 104+      , Insert 98+      , Insert 91+      , Insert 108+      , Insert 109+      , Insert 110+      , Insert 111+      ]+++testNastyFullLookup :: HashTest+testNastyFullLookup prefix dummyArg = testCase (prefix ++ "/nastyFullLookup") go+  where+    go = do+        tbl <- new+        forceType tbl dummyArg+        timeout_ 3000000 $+            foldM_ (\t k -> applyAction t k >> return t) tbl testData++    testData =+      [ Insert 28+      , Insert 27+      , Insert 30+      , Insert 31+      , Insert 32+      , Insert 33+      , Insert 34+      , Insert 29+      , Insert 36+      , Insert 37+      , Delete 34+      , Delete 29+      , Insert 38+      , Insert 39+      , Insert 40+      , Insert 35+      , Delete 39+      , Insert 42+      , Insert 43+      , Delete 40+      , Delete 35+      , Insert 44+      , Insert 45+      , Insert 41+      , Insert 48+      , Insert 47+      , Insert 50+      , Insert 51+      , Insert 52+      , Insert 49+      , Insert 54+      , Insert 53+      , Insert 56+      , Insert 55+      , Insert 58+      , Insert 57+      , Insert 60+      , Insert 59+      , Delete 60+      , Insert 62+      , Insert 61+      , Insert 63+      , Insert 46+      , Lookup 66+      ]   ------------------------------------------------------------------------------