index f3331d816e68d994a3bd234972172c3733184554..85133c3efbc10d47581f03f132ed6bda137d36b7 100644 (file)
--- a/src/shared/hashtable.pas
+++ b/src/shared/hashtable.pas
{.$DEFINE RBHASH_DEBUG_DELETE}
{.$DEFINE RBHASH_DEBUG_COMPACT}
{$IF DEFINED(D2F_DEBUG)}
- {$DEFINE RBHASH_SANITY_CHECKS}
+ {.$DEFINE RBHASH_SANITY_CHECKS}
{$ENDIF}
// hash table (robin hood)
unit hashtable;
// WARNING! don't put structures into hash, use ponters or ids!
generic THashBase<KeyT, ValueT> = class(TObject)
private
- const InitSize = {$IF DEFINED(D2F_DEBUG)}16{$ELSE}512{$ENDIF}; // *MUST* be power of two
+ const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
const LoadFactorPrc = 90; // it is ok for robin hood hashes
public
- type THashFn = function (constref o: KeyT): LongWord;
- type TEquFn = function (constref a, b: KeyT): Boolean;
- type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
-
type
PEntry = ^TEntry;
TEntry = record
private
hash: LongWord; // key hash or 0
nextFree: PEntry; // next free entry
+ private
+ function getEmpty (): Boolean; inline;
+ public
+ property empty: Boolean read getEmpty;
+ property keyhash: LongWord read hash; // cannot be 0
end;
+ type THashFn = function (constref o: KeyT): LongWord;
+ type TEquFn = function (constref a, b: KeyT): Boolean;
+ type TFreeKeyFn = procedure (var k: KeyT); // this may free key
+ type TFreeValueFn = procedure (var v: ValueT); // this may free value
+ type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
+ type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
+
private
+ type
+ TEntryArray = array of TEntry;
+
+ public
type
TValEnumerator = record
private
- mEntries: PEntry;
+ mEntries: TEntryArray;
mFirstEntry, mLastEntry, cur: Integer;
public
- constructor Create (aents: PEntry; afirst, alast: Integer);
- function MoveNext: Boolean;
- function getCurrent (): ValueT;
+ constructor Create (const aents: TEntryArray; afirst, alast: Integer);
+ function MoveNext (): Boolean; inline;
+ function getCurrent (): ValueT; inline;
+ function GetEnumerator (): TValEnumerator; inline;
property Current: ValueT read getCurrent;
end;
TKeyEnumerator = record
private
- mEntries: PEntry;
+ mEntries: TEntryArray;
mFirstEntry, mLastEntry, cur: Integer;
public
- constructor Create (aents: PEntry; afirst, alast: Integer);
- function MoveNext: Boolean;
- function getCurrent (): KeyT;
+ constructor Create (const aents: TEntryArray; afirst, alast: Integer);
+ function MoveNext (): Boolean; inline;
+ function getCurrent (): KeyT; inline;
+ function GetEnumerator (): TKeyEnumerator; inline;
property Current: KeyT read getCurrent;
end;
TKeyValEnumerator = record
private
- mEntries: PEntry;
+ mEntries: TEntryArray;
mFirstEntry, mLastEntry, cur: Integer;
public
- constructor Create (aents: PEntry; afirst, alast: Integer);
- function MoveNext: Boolean;
- function getCurrent (): PEntry;
+ constructor Create (const aents: TEntryArray; afirst, alast: Integer);
+ function MoveNext (): Boolean; inline;
+ function getCurrent (): PEntry; inline;
+ function GetEnumerator (): TKeyValEnumerator; inline;
property Current: PEntry read getCurrent;
end;
private
hashfn: THashFn;
equfn: TEquFn;
+ freekeyfn: TFreeKeyFn;
+ freevalfn: TFreeValueFn;
mBuckets: array of PEntry; // entries, points to mEntries elements
mBucketsUsed: Integer;
- mEntries: array of TEntry;
+ mEntries: TEntryArray;
{$IFDEF RBHASH_SANITY_CHECKS}
mEntriesUsed: Integer;
{$ENDIF}
function allocEntry (): PEntry;
procedure releaseEntry (e: PEntry);
- //function distToStIdx (idx: LongWord): LongWord; inline;
+ function distToStIdx (idx: LongWord): LongWord; inline;
procedure putEntryInternal (swpe: PEntry);
function getCapacity (): Integer; inline;
+ procedure freeEntries ();
+
public
- constructor Create (ahashfn: THashFn; aequfn: TEquFn);
+ constructor Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
destructor Destroy (); override;
procedure clear ();
procedure rehash ();
procedure compact (); // call this instead of `rehash()` after alot of deletions
- function get (constref akey: KeyT; out rval: ValueT): Boolean; // `true`: found
- function put (constref akey: KeyT; constref aval: ValueT): Boolean; // `true`: replaced
- function has (constref akey: KeyT): Boolean; // `true`: found
- function del (constref akey: KeyT): Boolean; // `true`: deleted
+ // you may pass `keyhash` to bypass hash calculation
+ function get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean; // `true`: found
+ // the function may return calculated value hash in `keyhash`
+ function put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean; // `true`: replaced
+ // you may pass `keyhash` to bypass hash calculation
+ function has (constref akey: KeyT; keyhashin: PLongWord=nil): Boolean; // `true`: found
+ // you may pass `keyhash` to bypass hash calculation
+ function del (constref akey: KeyT; keyhashin: PLongWord=nil): Boolean; // `true`: deleted
//WARNING! don't modify table in iterator (queries are ok, though)
- function forEach (it: TIteratorFn): Boolean;
+ function forEach (it: TIteratorFn): Boolean; overload;
+ function forEach (it: TIteratorExFn): Boolean; overload;
// default `for ... in` enums values
function GetEnumerator (): TValEnumerator;
type
THashIntInt = specialize THashBase<Integer, Integer>;
+ THashStrInt = specialize THashBase<AnsiString, Integer>;
+ THashIntStr = specialize THashBase<Integer, AnsiString>;
+ THashStrStr = specialize THashBase<AnsiString, AnsiString>;
+
function hashNewIntInt (): THashIntInt;
+function hashNewStrInt (): THashStrInt;
+function hashNewIntStr (): THashIntStr;
+function hashNewStrStr (): THashStrStr;
function u32Hash (a: LongWord): LongWord; inline;
function nextPOT (x: LongWord): LongWord; inline;
+// for integer keys
+function hashIntEqu (constref a, b: Integer): Boolean;
+function hashIntHash (constref k: Integer): LongWord;
+function hashStrEqu (constref a, b: AnsiString): Boolean;
+function hashStrHash (constref k: AnsiString): LongWord;
+procedure hashStrFree (var s: AnsiString);
+
+
implementation
uses
// ////////////////////////////////////////////////////////////////////////// //
-function hiiequ (constref a, b: Integer): Boolean; begin result := (a = b); end;
+function hashIntEqu (constref a, b: Integer): Boolean; begin result := (a = b); end;
+function hashStrEqu (constref a, b: AnsiString): Boolean; begin result := (a = b); end;
+procedure hashStrFree (var s: AnsiString); begin s := ''; end;
{$PUSH}
{$RANGECHECKS OFF}
-function hiihash (constref k: Integer): LongWord;
+function hashIntHash (constref k: Integer): LongWord;
begin
- result := k;
+ result := LongWord(k);
result -= (result shl 6);
result := result xor (result shr 17);
result -= (result shl 9);
result := result xor (result shl 10);
result := result xor (result shr 15);
end;
+
+function hashStrHash (constref k: AnsiString): LongWord;
+begin
+ if (Length(k) > 0) then result := fnvHash(PAnsiChar(k)^, Length(k)) else result := 0;
+end;
{$POP}
function hashNewIntInt (): THashIntInt;
begin
- result := THashIntInt.Create(hiihash, hiiequ);
+ result := THashIntInt.Create(hashIntHash, hashIntEqu);
+end;
+
+
+function hashNewStrInt (): THashStrInt;
+begin
+ result := THashStrInt.Create(hashStrHash, hashStrEqu, hashStrFree);
+end;
+
+
+function hashNewIntStr (): THashIntStr;
+begin
+ result := THashIntStr.Create(hashIntHash, hashIntEqu, nil, hashStrFree);
+end;
+
+
+function hashNewStrStr (): THashStrStr;
+begin
+ result := THashStrStr.Create(hashStrHash, hashStrEqu, hashStrFree, hashStrFree);
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THashBase.Create (ahashfn: THashFn; aequfn: TEquFn);
+function THashBase.TEntry.getEmpty (): Boolean; inline; begin result := (hash = 0); end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function THashBase.getCapacity (): Integer; inline; begin result := Length(mBuckets); end;
+
+
+constructor THashBase.Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
begin
if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
hashfn := ahashfn;
equfn := aequfn;
+ freekeyfn := afreekeyfn;
+ freevalfn := afreevalfn;
mSeed := u32Hash($29a);
+ mFirstEntry := -1;
+ mLastEntry := -1;
clear();
end;
end;
-procedure THashBase.clear ();
+procedure THashBase.freeEntries ();
var
- idx: Integer;
+ f: Integer;
+ e: PEntry;
begin
- SetLength(mBuckets, InitSize);
- for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
-
- SetLength(mEntries, Length(mBuckets));
- {
- for idx := 0 to High(mEntries)-1 do
+ if (mFirstEntry >= 0) then
begin
- mEntries[idx].hash := 0;
- mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
- end;
- mEntries[High(mEntries)].hash := 0;
- mEntries[High(mEntries)].nextFree := nil;
- }
- {
- for idx := 0 to High(mEntries) do
+ for f := mFirstEntry to mLastEntry do
+ begin
+ e := @mEntries[f];
+ if not e.empty then
+ begin
+ if assigned(freekeyfn) then freekeyfn(e.key);
+ if assigned(freevalfn) then freevalfn(e.value);
+ e.key := Default(KeyT);
+ e.value := Default(ValueT);
+ e.hash := 0;
+ end;
+ end;
+ end
+ else if (Length(mEntries) > 0) then
begin
- mEntries[idx].hash := 0;
- mEntries[idx].nextFree := nil;
+ FillChar(mEntries[0], Length(mEntries)*sizeof(mEntries[0]), 0);
end;
- }
-
- mBucketsUsed := 0;
+ mFreeEntryHead := nil;
+ mFirstEntry := -1;
+ mLastEntry := -1;
{$IFDEF RBHASH_SANITY_CHECKS}
mEntriesUsed := 0;
{$ENDIF}
- mFreeEntryHead := nil; //@mEntries[0];
- mFirstEntry := -1;
- mLastEntry := -1;
+end;
+
+
+procedure THashBase.clear ();
+//var idx: Integer;
+begin
+ freeEntries();
+ SetLength(mBuckets, InitSize);
+ FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
+ //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
+ SetLength(mEntries, InitSize);
+ FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
+ mBucketsUsed := 0;
end;
procedure THashBase.reset ();
-var
- idx: Integer;
+//var idx: Integer;
begin
+ freeEntries();
if (mBucketsUsed > 0) then
begin
- for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
- {
- for idx := 0 to High(mEntries)-1 do
- begin
- mEntries[idx].hash := 0;
- mEntries[idx].nextFree := @mEntries[idx+1]; //idx+1;
- end;
- mEntries[High(mEntries)].hash := 0;
- mEntries[High(mEntries)].nextFree := nil;
- }
- {
- if (mFirstEntry >= 0) then
- begin
- for idx := mFirstEntry to mLastEntry do
- begin
- mEntries[idx].hash := 0;
- mEntries[idx].nextFree := nil;
- end;
- end;
- }
-
+ //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
+ FillChar(mBuckets[0], Length(mBuckets)*sizeof(mBuckets[0]), 0);
mBucketsUsed := 0;
- {$IFDEF RBHASH_SANITY_CHECKS}
- mEntriesUsed := 0;
- {$ENDIF}
- mFreeEntryHead := nil; //@mEntries[0];
- mFirstEntry := -1;
- mLastEntry := -1;
end;
end;
-function THashBase.getCapacity (): Integer; inline; begin result := Length(mBuckets); end;
-
-
function THashBase.allocEntry (): PEntry;
var
idx: Integer;
end;
{$IFDEF RBHASH_SANITY_CHECKS}
if (mFreeEntryHead = nil) then raise Exception.Create('internal error in hash entry allocator (0)');
- if (mFreeEntryHead.hash <> 0) then raise Exception.Create('internal error in hash entry allocator (1)');
+ if (not mFreeEntryHead.empty) then raise Exception.Create('internal error in hash entry allocator (1)');
{$ENDIF}
result := mFreeEntryHead;
mFreeEntryHead := result.nextFree;
if (mEntriesUsed = 0) then raise Exception.Create('internal error in hash entry allocator');
if (mEntriesUsed <> mBucketsUsed) then raise Exception.Create('internal error in hash entry allocator (entry/bucket count mismatch)');
if (e = nil) then raise Exception.Create('internal error in hash entry allocator (trying to release nil entry)');
- if (e.hash = 0) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
+ if (e.empty) then raise Exception.Create('internal error in hash entry allocator (trying to release unallocated entry)');
{$ENDIF}
idx := Integer((PtrUInt(e)-PtrUInt(@mEntries[0])) div sizeof(mEntries[0]));
{$IFDEF RBHASH_SANITY_CHECKS}
if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
{$ENDIF}
+ if assigned(freekeyfn) then freekeyfn(e.key);
+ if assigned(freevalfn) then freevalfn(e.value);
{$IFDEF RBHASH_SANITY_CHECKS}
Dec(mEntriesUsed);
{$ENDIF}
+ e.key := Default(KeyT);
+ e.value := Default(ValueT);
e.hash := 0;
e.nextFree := mFreeEntryHead;
- mFreeEntryHead := e; //idx;
+ mFreeEntryHead := e;
// fix mFirstEntry and mLastEntry
{$IFDEF RBHASH_SANITY_CHECKS}
if (mFirstEntry < 0) or (mLastEntry < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 0)');
{$IFDEF RBHASH_SANITY_CHECKS}
if (mEntriesUsed <> 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 1)');
{$ENDIF}
+ mFreeEntryHead := nil;
mFirstEntry := -1;
mLastEntry := -1;
end
if (idx = mFirstEntry) then
begin
cidx := idx+1;
- while (mEntries[cidx].hash = 0) do Inc(cidx);
+ while (mEntries[cidx].empty) do Inc(cidx);
{$IFDEF RBHASH_SANITY_CHECKS}
if (cidx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
{$ENDIF}
if (idx = mLastEntry) then
begin
cidx := idx-1;
- while (mEntries[cidx].hash = 0) do Dec(cidx);
+ while (mEntries[cidx].empty) do Dec(cidx);
{$IFDEF RBHASH_SANITY_CHECKS}
if (cidx < 0) then raise Exception.Create('internal error in hash entry allocator (invalid first/last range; 3)');
{$ENDIF}
end;
-(*
function THashBase.distToStIdx (idx: LongWord): LongWord; inline;
begin
{$IFDEF RBHASH_SANITY_CHECKS}
assert(idx < Length(mBuckets));
assert(mBuckets[idx] <> nil);
{$ENDIF}
- result := mBuckets[idx].hash and High(mBuckets);
+ result := (mBuckets[idx].hash xor mSeed) and High(mBuckets);
if (result <= idx) then result := idx-result else result := idx+(Length(mBuckets)-result);
end;
-*)
-function THashBase.has (constref akey: KeyT): Boolean;
+function THashBase.has (constref akey: KeyT; keyhashin: PLongWord=nil): Boolean;
var
khash, idx: LongWord;
dist, pdist: LongWord;
- bhigh: LongWord;
+ bhigh, xseed: LongWord;
begin
result := false;
if (mBucketsUsed = 0) then exit;
bhigh := High(mBuckets);
- khash := hashfn(akey) xor mSeed; if (khash = 0) then khash := $29a;
- idx := khash and bhigh;
+ xseed := mSeed;
+
+ if (keyhashin <> nil) then
+ begin
+ khash := keyhashin^;
+ if (khash = 0) then khash := hashfn(akey);
+ end
+ else
+ begin
+ khash := hashfn(akey);
+ end;
+ if (khash = 0) then khash := $29a;
+
+ idx := (khash xor xseed) and bhigh;
if (mBuckets[idx] = nil) then exit;
for dist := 0 to bhigh do
begin
if (mBuckets[idx] = nil) then break;
- //pdist := distToStIdx(idx);
- pdist := mBuckets[idx].hash and bhigh;
- if (pdist <= idx) then pdist := idx-pdist else pdist := idx+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idx);
if (dist > pdist) then break;
result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
if result then break;
end;
-function THashBase.get (constref akey: KeyT; out rval: ValueT): Boolean;
+function THashBase.get (constref akey: KeyT; out rval: ValueT; keyhashin: PLongWord=nil): Boolean;
var
khash, idx: LongWord;
dist, pdist: LongWord;
- bhigh: LongWord;
+ bhigh, xseed: LongWord;
begin
result := false;
if (mBucketsUsed = 0) then begin rval := Default(ValueT); exit; end;
bhigh := High(mBuckets);
- khash := hashfn(akey) xor mSeed; if (khash = 0) then khash := $29a;
- idx := khash and bhigh;
- if (mBuckets[idx] = nil) then begin rval := Default(ValueT); exit; end;
+ xseed := mSeed;
+
+ if (keyhashin <> nil) then
+ begin
+ khash := keyhashin^;
+ if (khash = 0) then khash := hashfn(akey);
+ end
+ else
+ begin
+ khash := hashfn(akey);
+ end;
+ if (khash = 0) then khash := $29a;
+
+ idx := (khash xor xseed) and bhigh;
for dist := 0 to bhigh do
begin
if (mBuckets[idx] = nil) then break;
- //pdist := distToStIdx(idx);
- pdist := mBuckets[idx].hash and bhigh;
- if (pdist <= idx) then pdist := idx-pdist else pdist := idx+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idx);
if (dist > pdist) then break;
result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
- if result then
- begin
- rval := mBuckets[idx].value;
- break;
- end;
+ if result then begin rval := mBuckets[idx].value; break; end;
idx := (idx+1) and bhigh;
end;
procedure THashBase.putEntryInternal (swpe: PEntry);
var
idx, dist, pcur, pdist: LongWord;
- tmpe: PEntry; // current entry to swap (or nothing)
- bhigh: LongWord;
+ tmpe: PEntry;
+ bhigh, xseed: LongWord;
begin
bhigh := High(mBuckets);
- idx := swpe.hash and bhigh;
+ xseed := mSeed;
+ idx := (swpe.hash xor xseed) and bhigh;
{$IFDEF RBHASH_DEBUG_INSERT}writeln('inserting key ', swpe.key, '; value=', swpe.value, '; wantidx=', idx, '; bhigh=', bhigh);{$ENDIF}
pcur := 0;
for dist := 0 to bhigh do
Inc(mBucketsUsed);
break;
end;
- //pdist := distToStIdx(idx);
- pdist := mBuckets[idx].hash and bhigh;
- if (pdist <= idx) then pdist := idx-pdist else pdist := idx+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idx);
if (pcur > pdist) then
begin
// swapping the current bucket with the one to insert
end;
-function THashBase.put (constref akey: KeyT; constref aval: ValueT): Boolean;
+function THashBase.put (constref akey: KeyT; constref aval: ValueT; keyhashout: PLongWord=nil): Boolean;
var
khash, idx, dist, pdist: LongWord;
swpe: PEntry = nil; // current entry to swap (or nothing)
- bhigh: LongWord;
+ bhigh, xseed: LongWord;
newsz, eidx: Integer;
begin
result := false;
bhigh := High(mBuckets);
- khash := hashfn(akey) xor mSeed; if (khash = 0) then khash := $29a;
- idx := khash and bhigh;
+ xseed := mSeed;
+ khash := hashfn(akey);
+ if (khash = 0) then khash := $29a;
+ if (keyhashout <> nil) then keyhashout^ := khash;
+ idx := (khash xor xseed) and bhigh;
// check if we already have this key
if (mBucketsUsed <> 0) and (mBuckets[idx] <> nil) then
for dist := 0 to bhigh do
begin
if (mBuckets[idx] = nil) then break;
- //pdist := distToStIdx(idx);
- pdist := mBuckets[idx].hash and bhigh;
- if (pdist <= idx) then pdist := idx-pdist else pdist := idx+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idx);
if (dist > pdist) then break;
result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
if result then
begin
// replace element
- //mBuckets[idx].key := akey;
+ if assigned(freekeyfn) then freekeyfn(mBuckets[idx].key);
+ if assigned(freevalfn) then freevalfn(mBuckets[idx].value);
+ mBuckets[idx].key := akey;
mBuckets[idx].value := aval;
exit;
end;
// mFreeEntryHead will be fixed in `rehash()`
// reinsert entries
rehash();
- // as seed was changed, recalc hash
- khash := hashfn(akey) xor mSeed; if (khash = 0) then khash := $29a;
end;
// create new entry
// see http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
-function THashBase.del (constref akey: KeyT): Boolean;
+function THashBase.del (constref akey: KeyT; keyhashin: PLongWord=nil): Boolean;
var
khash, idx, idxnext, pdist, dist: LongWord;
- bhigh: LongWord;
+ bhigh, xseed: LongWord;
begin
result := false;
if (mBucketsUsed = 0) then exit;
bhigh := High(mBuckets);
- khash := hashfn(akey) xor mSeed; if (khash = 0) then khash := $29a;
- idx := khash and bhigh;
+ xseed := mSeed;
+
+ if (keyhashin <> nil) then
+ begin
+ khash := keyhashin^;
+ if (khash = 0) then khash := hashfn(akey);
+ end
+ else
+ begin
+ khash := hashfn(akey);
+ end;
+ if (khash = 0) then khash := $29a;
+
+ idx := (khash xor xseed) and bhigh;
// find key
if (mBuckets[idx] = nil) then exit; // no key
for dist := 0 to bhigh do
begin
if (mBuckets[idx] = nil) then break;
- //pdist := distToStIdx(idxcur);
- pdist := mBuckets[idx].hash and bhigh;
- if (pdist <= idx) then pdist := idx-pdist else pdist := idx+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idx);
if (dist > pdist) then break;
result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
if result then break;
writeln(' dist=', dist, '; idx=', idx, '; idxnext=', idxnext, '; ce=', (mBuckets[idx] <> nil), '; ne=', (mBuckets[idxnext] <> nil));
{$ENDIF}
if (mBuckets[idxnext] = nil) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' idxnext nil');{$ENDIF} mBuckets[idx] := nil; break; end;
- //pdist := distToStIdx(idxnext);
- pdist := mBuckets[idxnext].hash and bhigh;
- if (pdist <= idxnext) then pdist := idxnext-pdist else pdist := idxnext+((bhigh+1)-pdist);
- //
+ pdist := distToStIdx(idxnext);
if (pdist = 0) then begin {$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist is zero');{$ENDIF} mBuckets[idx] := nil; break; end;
{$IFDEF RBHASH_DEBUG_DELETE}writeln(' pdist=', pdist);{$ENDIF}
mBuckets[idx] := mBuckets[idxnext];
{$ENDIF}
begin
// change seed, to minimize pathological cases
+ //TODO: use prng to generate new hash
if (mSeed = 0) then mSeed := $29a;
mSeed := u32Hash(mSeed);
// clear buckets
- for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
+ //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
+ FillChar(mBuckets[0], Length(mBuckets)*sizeof(mBuckets[0]), 0);
mBucketsUsed := 0;
// reinsert entries
mFreeEntryHead := nil;
for idx := 0 to High(mEntries) do
begin
e := @mEntries[idx];
- if (e.hash <> 0) then
+ if (not e.empty) then
begin
{$IFDEF RBHASH_SANITY_CHECKS}
if (e.nextFree <> nil) then raise Exception.Create('internal error in rehash: inconsistent');
Inc(cnt);
if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
{$ENDIF}
- e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
+ // no need to recalculate hash
+ //e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
putEntryInternal(e);
end
else
if (mBucketsUsed < 1) then raise Exception.Create('internal error in hash table (invalid bucket count; 0)');
{$ENDIF}
didx := 0;
- while (didx < Length(mEntries)) do if (mEntries[didx].hash <> 0) then Inc(didx) else break;
+ while (didx < Length(mEntries)) do if (not mEntries[didx].empty) then Inc(didx) else break;
f := didx+1;
// copy entries
while true do
begin
- if (mEntries[f].hash <> 0) then
+ if (not mEntries[f].empty) then
begin
{$IFDEF RBHASH_SANITY_CHECKS}
if (didx >= f) then raise Exception.Create('internal error in hash: inconsistent');
mEntries[f].hash := 0;
Inc(didx);
if (f = mLastEntry) then break;
- while (didx < Length(mEntries)) do if (mEntries[didx].hash <> 0) then Inc(didx) else break;
+ while (didx < Length(mEntries)) do if (not mEntries[didx].empty) then Inc(didx) else break;
end;
Inc(f);
end;
cnt := 0;
for f := mFirstEntry to mLastEntry do
begin
- if (mEntries[f].hash = 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
+ if (mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 2)');
Inc(cnt);
end;
if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 3)');
if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table (invalid first/last range; 4)');
for f := mLastEntry+1 to High(mEntries) do
begin
- if (mEntries[f].hash <> 0) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
+ if (not mEntries[f].empty) then raise Exception.Create('internal error in hash table (invalid first/last range; 5)');
end;
{$ENDIF}
end
end;
-function THashBase.forEach (it: TIteratorFn): Boolean;
+function THashBase.forEach (it: TIteratorFn): Boolean; overload;
+var
+ f: Integer;
+begin
+ result := false;
+ if not assigned(it) or (mFirstEntry < 0) then exit;
+ for f := mFirstEntry to mLastEntry do
+ begin
+ if (not mEntries[f].empty) then
+ begin
+ result := it(mEntries[f].key, mEntries[f].value);
+ if result then exit;
+ end;
+ end;
+end;
+
+function THashBase.forEach (it: TIteratorExFn): Boolean; overload;
var
- i: Integer;
+ f: Integer;
begin
result := false;
- if not assigned(it) then exit;
- i := mFirstEntry;
- if (i < 0) then exit;
- while (i <= mLastEntry) do
+ if not assigned(it) or (mFirstEntry < 0) then exit;
+ for f := mFirstEntry to mLastEntry do
begin
- if (mEntries[i].hash <> 0) then
+ if (not mEntries[f].empty) then
begin
- result := it(mEntries[i].key, mEntries[i].value);
+ result := it(mEntries[f].key, mEntries[f].value, mEntries[f].hash);
if result then exit;
end;
- Inc(i);
end;
end;
// enumerators
function THashBase.GetEnumerator (): TValEnumerator;
begin
- if (Length(mEntries) > 0) then result := TValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
+ if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
else result := TValEnumerator.Create(nil, -1, -1);
end;
function THashBase.byKey (): TKeyEnumerator;
begin
- if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
+ if (Length(mEntries) > 0) then result := TKeyEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
else result := TKeyEnumerator.Create(nil, -1, -1);
end;
function THashBase.byValue (): TValEnumerator;
begin
- if (Length(mEntries) > 0) then result := TValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
+ if (Length(mEntries) > 0) then result := TValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
else result := TValEnumerator.Create(nil, -1, -1);
end;
function THashBase.byKeyValue (): TKeyValEnumerator; // PEntry
begin
- if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry)
+ if (Length(mEntries) > 0) then result := TKeyValEnumerator.Create(mEntries, mFirstEntry, mLastEntry)
else result := TKeyValEnumerator.Create(nil, -1, -1);
end;
+function THashBase.TValEnumerator.GetEnumerator (): TValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
+function THashBase.TKeyEnumerator.GetEnumerator (): TKeyEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
+function THashBase.TKeyValEnumerator.GetEnumerator (): TKeyValEnumerator; inline; begin result.mEntries := self.mEntries; result.mFirstEntry := self.mFirstEntry; result.mLastEntry := self.mLastEntry; result.cur := self.cur; end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
-constructor THashBase.TValEnumerator.Create (aents: PEntry; afirst, alast: Integer);
+constructor THashBase.TValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
begin
mEntries := aents;
mFirstEntry := afirst;
cur := mFirstEntry-1;
end;
-function THashBase.TValEnumerator.MoveNext: Boolean;
+function THashBase.TValEnumerator.MoveNext (): Boolean; inline;
begin
Inc(cur);
while (cur <= mLastEntry) do
begin
- if (mEntries[cur].hash <> 0) then begin result := true; exit; end;
+ if (not mEntries[cur].empty) then begin result := true; exit; end;
end;
result := false;
end;
-function THashBase.TValEnumerator.getCurrent (): ValueT;
+function THashBase.TValEnumerator.getCurrent (): ValueT; inline;
begin
result := mEntries[cur].value;
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THashBase.TKeyEnumerator.Create (aents: PEntry; afirst, alast: Integer);
+constructor THashBase.TKeyEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
begin
mEntries := aents;
mFirstEntry := afirst;
cur := mFirstEntry-1;
end;
-function THashBase.TKeyEnumerator.MoveNext: Boolean;
+function THashBase.TKeyEnumerator.MoveNext (): Boolean; inline;
begin
Inc(cur);
while (cur <= mLastEntry) do
begin
- if (mEntries[cur].hash <> 0) then begin result := true; exit; end;
+ if (not mEntries[cur].empty) then begin result := true; exit; end;
end;
result := false;
end;
-function THashBase.TKeyEnumerator.getCurrent (): KeyT;
+function THashBase.TKeyEnumerator.getCurrent (): KeyT; inline;
begin
result := mEntries[cur].key;
end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THashBase.TKeyValEnumerator.Create (aents: PEntry; afirst, alast: Integer);
+constructor THashBase.TKeyValEnumerator.Create (const aents: TEntryArray; afirst, alast: Integer);
begin
mEntries := aents;
mFirstEntry := afirst;
cur := mFirstEntry-1;
end;
-function THashBase.TKeyValEnumerator.MoveNext: Boolean;
+function THashBase.TKeyValEnumerator.MoveNext (): Boolean; inline;
begin
Inc(cur);
while (cur <= mLastEntry) do
begin
- if (mEntries[cur].hash <> 0) then begin result := true; exit; end;
+ if (not mEntries[cur].empty) then begin result := true; exit; end;
end;
result := false;
end;
-function THashBase.TKeyValEnumerator.getCurrent (): PEntry;
+function THashBase.TKeyValEnumerator.getCurrent (): PEntry; inline;
begin
- result := mEntries+cur;
+ result := @mEntries[cur];
end;