{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}{-# LANGUAGE MagicHash #-}{-|
A hash table using the cuckoo strategy. (See
<http://en.wikipedia.org/wiki/Cuckoo_hashing>). Use this hash table if you...
* want the fastest possible inserts, and very fast lookups.
* are conscious of memory usage; this table has less space overhead than
"Data.HashTable.ST.Basic", but more than "Data.HashTable.ST.Linear".
* don't care that a table resize might pause for a long time to rehash all
of the key-value mappings.
/Details:/
The basic idea of cuckoo hashing, first introduced by Pagh and Rodler in 2001,
is to use /d/ hash functions instead of only one; in this implementation d=2
and the strategy we use is to split up a flat array of slots into @k@ buckets,
each cache-line-sized:
@
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+----------+
|x0|x1|x2|x3|x4|x5|x6|x7|y0|y1|y2|y3|y4|y5|y6|y7|z0|z1|z2........|
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+----------+
[ ^^^ bucket 0 ^^^ ][ ^^^ bucket 1 ^^^ ]...
@
There are actually three parallel arrays: one unboxed array of 'Int's for hash
codes, one boxed array for keys, and one boxed array for values. When looking
up a key-value mapping, we hash the key using two hash functions and look in
both buckets in the hash code array for the key. Each bucket is cache-line
sized, with its keys in no particular order. Because the hash code array is
unboxed, we can search it for the key using a highly-efficient branchless
strategy in C code, using SSE instructions if available.
On insert, if both buckets are full, we knock out a randomly-selected entry
from one of the buckets (using a random walk ensures that \"key cycles\" are
broken with maximum probability) and try to repeat the insert procedure. This
process may not succeed; if all items have not successfully found a home after
some number of tries, we give up and rehash all of the elements into a larger
table.
/Space overhead: experimental results/
The implementation of cuckoo hash given here is almost as fast for lookups as
the basic open-addressing hash table using linear probing, and on average is
more space-efficient: in randomized testing on my 64-bit machine (see
@test\/compute-overhead\/ComputeOverhead.hs@ in the source distribution), mean
overhead is 1.71 machine words per key-value mapping, with a standard deviation
of 0.30 words, and 2.46 words per mapping at the 95th percentile.
/References:/
* A. Pagh and F. Rodler. Cuckoo hashing. In /Proceedings of the 9th
Annual European Symposium on Algorithms/, pp. 121-133, 2001.
-}moduleData.HashTable.ST.Cuckoo(HashTable,new,newSized,delete,lookup,insert,mapM_,foldM)where------------------------------------------------------------------------------importControl.Monadhiding(foldM,mapM_)importControl.Monad.STimportData.Hashablehiding(hash)importqualifiedData.HashableasHimportData.IntimportData.MaybeimportData.Primitive.ArrayimportData.STRefimportGHC.ExtsimportPreludehiding(lookup,read,mapM_)------------------------------------------------------------------------------importqualifiedData.HashTable.ClassasCimportData.HashTable.Internal.CheapPseudoRandomBitStreamimportData.HashTable.Internal.CacheLineimportqualifiedData.HashTable.Internal.IntArrayasUimportData.HashTable.Internal.Utils#ifdef DEBUGimportSystem.IO#endif-------------------------------------------------------------------------------- | A cuckoo hash table.newtypeHashTableskv=HT(STRefs(HashTable_skv))dataHashTable_skv=HashTable{_size::{-# UNPACK #-}!Int-- ^ in buckets, total size is-- numWordsInCacheLine * _size,_rng::{-# UNPACK #-}!(BitStreams),_hashes::{-# UNPACK #-}!(U.IntArrays),_keys::{-# UNPACK #-}!(MutableArraysk),_values::{-# UNPACK #-}!(MutableArraysv),_maxAttempts::{-# UNPACK #-}!Int}------------------------------------------------------------------------------instanceC.HashTableHashTablewherenew=newnewSized=newSizedinsert=insertdelete=deletelookup=lookupfoldM=foldMmapM_=mapM_computeOverhead=computeOverhead------------------------------------------------------------------------------instanceShow(HashTableskv)whereshow_="<HashTable>"-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:new".new::STs(HashTableskv)new=newSizedReal2>>=newRef{-# INLINE new #-}-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:newSized".newSized::Int->STs(HashTableskv)newSizedn=doletn'=(n+numWordsInCacheLine-1)`div`numWordsInCacheLineletk=nextBestPrime$ceiling$fromIntegraln'/maxLoadnewSizedRealk>>=newRef{-# INLINE newSized #-}-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:insert".insert::(Eqk,Hashablek)=>HashTableskv->k->v->STs()insertht!k!v=readRefht>>=\h->insert'hkv>>=writeRefht-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:computeOverhead".computeOverhead::HashTableskv->STsDoublecomputeOverheadhtRef=readRefhtRef>>=workwherework(HashTablesz_____)=donFilled<-foldMf0htRefletoh=totSz-- one word per element in hashes+2*(totSz-nFilled)-- two words per non-filled entry+12-- fixed overheadreturn$!fromIntegral(oh::Int)/fromIntegralnFilledwheretotSz=numWordsInCacheLine*szf!a_=return$!a+1-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:delete".delete::(Hashablek,Eqk)=>HashTableskv->k->STs()deletehtRefk=readRefhtRef>>=gowheregoht@(HashTablesz_____)=do_<-delete'htFalsekb1b2h1h2return()whereh1=hash1kh2=hash2kb1=whichLineh1szb2=whichLineh2sz-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:lookup".lookup::(Eqk,Hashablek)=>HashTableskv->k->STs(Maybev)lookuphtRefk=doht<-readRefhtReflookup'htk{-# INLINE lookup #-}------------------------------------------------------------------------------lookup'::(Eqk,Hashablek)=>HashTable_skv->k->STs(Maybev)lookup'(HashTablesz_hasheskeysvalues_)!k=do-- Unlike the write case, prefetch doesn't seem to help here for lookup.-- prefetchRead hashes b2idx1<-searchOnekeyshasheskb1h1ifidx1>=0thendov<-readArrayvaluesidx1return$!Justvelsedoidx2<-searchOnekeyshasheskb2h2ifidx2>=0thendov<-readArrayvaluesidx2return$!JustvelsereturnNothingwhereh1=hash1kh2=hash2kb1=whichLineh1szb2=whichLineh2sz{-# INLINE lookup' #-}------------------------------------------------------------------------------searchOne::(Eqk)=>MutableArraysk->U.IntArrays->k->Int->Int->STsIntsearchOne!keys!hashes!k=gowherego!b!h=dodebug$"searchOne: go "++showb++" "++showhidx<-cacheLineSearchhashesbhdebug$"searchOne: cacheLineSearch returned "++showidxcaseidxof-1->return(-1)_->dok'<-readArraykeysidxifk==k'thenreturnidxelsedolet!idx'=idx+1ifisCacheLineAlignedidx'thenreturn(-1)elsegoidx'h{-# INLINE searchOne #-}-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:foldM".foldM::(a->(k,v)->STsa)->a->HashTableskv->STsafoldMfseed0htRef=readRefhtRef>>=foldMWorkfseed0{-# INLINE foldM #-}------------------------------------------------------------------------------foldMWork::(a->(k,v)->STsa)->a->HashTable_skv->STsafoldMWorkfseed0(HashTablesz_hasheskeysvalues_)=go0seed0wheretotSz=numWordsInCacheLine*szgo!i!seed|i>=totSz=returnseed|otherwise=doh<-U.readArrayhashesiifh/=emptyMarkerthendok<-readArraykeysiv<-readArrayvaluesi!seed'<-fseed(k,v)go(i+1)seed'elsego(i+1)seed{-# INLINE foldMWork #-}-------------------------------------------------------------------------------- | See the documentation for this function in-- "Data.HashTable.Class#v:mapM_".mapM_::((k,v)->STsa)->HashTableskv->STs()mapM_fhtRef=readRefhtRef>>=mapMWorkf{-# INLINE mapM_ #-}------------------------------------------------------------------------------mapMWork::((k,v)->STsa)->HashTable_skv->STs()mapMWorkf(HashTablesz_hasheskeysvalues_)=go0wheretotSz=numWordsInCacheLine*szgo!i|i>=totSz=return()|otherwise=doh<-U.readArrayhashesiifh/=emptyMarkerthendok<-readArraykeysiv<-readArrayvaluesi_<-f(k,v)go(i+1)elsego(i+1){-# INLINE mapMWork #-}----------------------------------- Private declarations follow -----------------------------------------------------------------------------------------------------------------newSizedReal::Int->STs(HashTable_skv)newSizedRealnbuckets=dolet!ntotal=nbuckets*numWordsInCacheLinelet!maxAttempts=12+(log2$toEnumnbuckets)debug$"creating cuckoo hash table with "++shownbuckets++" buckets having "++showntotal++" total slots"rng<-newBitStreamhashes<-U.newArrayntotalkeys<-newArrayntotalundefinedvalues<-newArrayntotalundefinedreturn$!HashTablenbucketsrnghasheskeysvaluesmaxAttemptsinsert'::(Eqk,Hashablek)=>HashTable_skv->k->v->STs(HashTable_skv)insert'htkv=dodebug"insert': begin"mbX<-updateOrFailhtkvz<-maybe(returnht)(\(k',v')->growhtk'v')mbXdebug"insert': end"returnz{-# INLINE insert #-}------------------------------------------------------------------------------updateOrFail::(Eqk,Hashablek)=>HashTable_skv->k->v->STs(Maybe(k,v))updateOrFailht@(HashTablesz_hasheskeysvalues_)kv=dodebug$"updateOrFail: begin: sz = "++showszdebug$" h1="++showh1++", h2="++showh2++", b1="++showb1++", b2="++showb2(didx,hashCode)<-delete'htTruekb1b2h1h2debug$"delete' returned ("++showdidx++","++showhashCode++")"ifdidx>=0thendoU.writeArrayhashesdidxhashCodewriteArraykeysdidxkwriteArrayvaluesdidxvreturnNothingelsecuckoowhereh1=hash1kh2=hash2kb1=whichLineh1szb2=whichLineh2szcuckoo=dodebug"cuckoo: calling cuckooOrFail"result<-cuckooOrFailhth1h2b1b2kvdebug$"cuckoo: cuckooOrFail returned "++(ifisJustresultthen"Just _"else"Nothing")-- if cuckoo failed we need to grow the table.maybe(returnNothing)(return.Just)result{-# INLINE updateOrFail #-}-------------------------------------------------------------------------------- Returns either (-1,-1) (not found, and both buckets full ==> trigger-- cuckoo), or the slot in the array where it would be safe to write the given-- key, and the hashcode to use theredelete'::(Hashablek,Eqk)=>HashTable_skv-- ^ hash table->Bool-- ^ are we updating?->k-- ^ key->Int-- ^ cache line start address 1->Int-- ^ cache line start address 2->Int-- ^ hash1->Int-- ^ hash2->STs(Int,Int)delete'(HashTable__hasheskeysvalues_)!updating!kb1b2h1h2=dodebug$"delete' b1="++showb1++" b2="++showb2++" h1="++showh1++" h2="++showh2prefetchWritehashesb2idx1<-searchOnekeyshasheskb1h1ifidx1<0thendoidx2<-searchOnekeyshasheskb2h2ifidx2<0thenifupdatingthendodebug$"delete': looking for empty element"-- if we're updating, we look for an empty elementidxE1<-cacheLineSearchhashesb1emptyMarkerdebug$"delete': idxE1 was "++showidxE1ifidxE1>=0thenreturn(idxE1,h1)elsedoidxE2<-cacheLineSearchhashesb2emptyMarkerdebug$"delete': idxE2 was "++showidxE1ifidxE2>=0thenreturn(idxE2,h2)elsereturn(-1,-1)elsereturn(-1,-1)elsedeleteItidx2h2elsedeleteItidx1h1wheredeleteIt!idx!h=doifnotupdatingthendoU.writeArrayhashesidxemptyMarkerwriteArraykeysidxundefinedwriteArrayvaluesidxundefinedelsereturn()return$!(idx,h){-# INLINE delete' #-}------------------------------------------------------------------------------cuckooOrFail::(Hashablek,Eqk)=>HashTable_skv-- ^ hash table->Int-- ^ hash code 1->Int-- ^ hash code 2->Int-- ^ cache line 1->Int-- ^ cache line 2->k-- ^ key->v-- ^ value->STs(Maybe(k,v))cuckooOrFail(HashTableszrnghasheskeysvaluesmaxAttempts0)!h1_0!h2_0!b1_0!b2_0!k0!v0=do-- at this point we know:---- * there is no empty slot in either cache line---- * the key doesn't already exist in the table---- next things to do:---- * decide which element to bump---- * read that element, and write (k,v) in there---- * attempt to write the bumped element into its other cache slot---- * if it fails, recurse.debug$"cuckooOrFail h1_0="++showh1_0++" h2_0="++showh2_0++" b1_0="++showb1_0++" b2_0="++showb2_0!lineChoice<-getNextBitrngdebug$"chose line "++showlineChoicelet(!b,!h)=iflineChoice==0then(b1_0,h1_0)else(b2_0,h2_0)gobhk0v0maxAttempts0whererandomIdx!b=do!z<-getNBitscacheLineIntBitsrngreturn$!b+zbumpIdx!idx!h!k!v=dodebug$"bumpIdx idx="++showidx++" h="++showh!h'<-U.readArrayhashesidxdebug$"bumpIdx: h' was "++showh'!k'<-readArraykeysidxv'<-readArrayvaluesidxU.writeArrayhashesidxhwriteArraykeysidxkwriteArrayvaluesidxvdebug$"bumped key with h'="++showh'return$!(h',k',v')otherHashhk=ifh2==hthenh1elseh2whereh1=hash1kh2=hash2ktryWrite!b!hkvmaxAttempts=dodebug$"tryWrite b="++showb++" h="++showhidx<-cacheLineSearchhashesbemptyMarkerdebug$"cacheLineSearch returned "++showidxifidx>=0thendoU.writeArrayhashesidxhwriteArraykeysidxkwriteArrayvaluesidxvreturnNothingelsegobhkv$!maxAttempts-1go!b!h!kv!maxAttempts|maxAttempts==0=return$!Just(k,v)|otherwise=doidx<-randomIdxb(!h0',!k',v')<-bumpIdxidxhkvlet!h'=otherHashh0'k'let!b'=whichLineh'sztryWriteb'h'k'v'maxAttempts------------------------------------------------------------------------------grow::(Eqk,Hashablek)=>HashTable_skv->k->v->STs(HashTable_skv)grow(HashTablesz_hasheskeysvalues_)k0v0=donewHt<-grow'$!bumpSizeszmbR<-updateOrFailnewHtk0v0maybe(returnnewHt)(\_->grow'$bumpSize$_sizenewHt)mbRwheregrow'newSz=dodebug$"growing table, oldsz = "++showsz++", newsz="++shownewSznewHt<-newSizedRealnewSzrehashnewSznewHtrehash!newSz!newHt=go0wheretotSz=numWordsInCacheLine*szgo!i|i>=totSz=returnnewHt|otherwise=doh<-U.readArrayhashesiif(h/=emptyMarker)thendok<-readArraykeysiv<-readArrayvaluesimbR<-updateOrFailnewHtkvmaybe(go$i+1)(\_->grow'$bumpSizenewSz)mbRelsego$i+1------------------------------------------------------------------------------hashPrime::InthashPrime=ifwordSize==32thenhashPrime32elsehashPrime64wherehashPrime32=0xedf2a025hashPrime64=0x3971ca9c8b3722e9------------------------------------------------------------------------------hash1::Hashablek=>k->Inthash1=hashFH.hash{-# INLINE hash1 #-}hash2::Hashablek=>k->Inthash2=hashF(H.hashWithSalthashPrime){-# INLINE hash2 #-}hashF::(k->Int)->k->InthashFfk=outwhere!(I#h#)=fk!m#=maskw#h#0#!nm#=not#m#!r#=((int2Word#1#)`and#`m#)`or#`(int2Word#h#`and#`nm#)!out=I#(word2Int#r#){-# INLINE hashF #-}------------------------------------------------------------------------------emptyMarker::IntemptyMarker=0------------------------------------------------------------------------------maxLoad::DoublemaxLoad=0.88------------------------------------------------------------------------------debug::String->STs()#ifdef DEBUGdebugs=unsafeIOToST(putStrLns>>hFlushstdout)#elsedebug_=return()#endif{-# INLINE debug #-}------------------------------------------------------------------------------whichLine::Int->Int->IntwhichLine!h!sz=whichBuckethsz`iShiftL`cacheLineIntBits{-# INLINE whichLine #-}------------------------------------------------------------------------------newRef::HashTable_skv->STs(HashTableskv)newRef=liftMHT.newSTRef{-# INLINE newRef #-}writeRef::HashTableskv->HashTable_skv->STs()writeRef(HTref)ht=writeSTRefrefht{-# INLINE writeRef #-}readRef::HashTableskv->STs(HashTable_skv)readRef(HTref)=readSTRefref{-# INLINE readRef #-}