+insert ht key val =
+ updatingBucket CanInsert (\bucket -> ((key,val):bucket, 1, ())) ht key
+
+
+-- ------------------------------------------------------------
+-- The core of the implementation is lurking down here, in findBucket,
+-- updatingBucket, and expandHashTable.
+
+tooBig :: Int32 -> Int32 -> Bool
+tooBig k b = k-hYSTERESIS > hLOAD * b
+
+-- index of bucket within table.
+bucketIndex :: Int32 -> Int32 -> Int32
+bucketIndex mask h = h .&. mask
+
+-- find the bucket in which the key belongs.
+-- returns (key equality, bucket index, bucket)
+--
+-- This rather grab-bag approach gives enough power to do pretty much
+-- any bucket-finding thing you might want to do. We rely on inlining
+-- to throw away the stuff we don't want. I'm proud to say that this
+-- plus updatingBucket below reduce most of the other definitions to a
+-- few lines of code, while actually speeding up the hashtable
+-- implementation when compared with a version which does everything
+-- from scratch.
+{-# INLINE findBucket #-}
+findBucket :: HashTable key val -> key -> IO (HT key val, Int32, [(key,val)])
+findBucket HashTable{ tab=ref, hash_fn=hash} key = do
+ table@HT{ buckets=bkts, bmask=b } <- readIORef ref
+ let indx = bucketIndex b (hash key)
+ bucket <- readHTArray bkts indx
+ return (table, indx, bucket)
+
+data Inserts = CanInsert
+ | Can'tInsert
+ deriving (Eq)
+
+-- updatingBucket is the real workhorse of all single-element table
+-- updates. It takes a hashtable and a key, along with a function
+-- describing what to do with the bucket in which that key belongs. A
+-- flag indicates whether this function may perform table insertions.
+-- The function returns the new contents of the bucket, the number of
+-- bucket entries inserted (negative if entries were deleted), and a
+-- value which becomes the return value for the function as a whole.
+-- The table sizing is enforced here, calling out to expandSubTable as
+-- necessary.
+
+-- This function is intended to be inlined and specialized for every
+-- calling context (eg every provided bucketFn).
+{-# INLINE updatingBucket #-}
+
+updatingBucket :: Inserts -> ([(key,val)] -> ([(key,val)], Int32, a)) ->
+ HashTable key val -> key ->
+ IO a
+updatingBucket canEnlarge bucketFn
+ ht@HashTable{ tab=ref, hash_fn=hash } key = do
+ (table@HT{ kcount=k, buckets=bkts, bmask=b },
+ indx, bckt) <- findBucket ht key
+ (bckt', inserts, result) <- return $ bucketFn bckt
+ let k' = k + inserts
+ table1 = table { kcount=k' }
+ writeMutArray bkts indx bckt'
+ table2 <- if canEnlarge == CanInsert && inserts > 0 then do
+ recordIns inserts k' bckt'
+ if tooBig k' b
+ then expandHashTable hash table1
+ else return table1
+ else return table1