{$MODE FPC}
{$MODESWITCH RESULT}
{$MODESWITCH OUT}
{$MODESWITCH DEFAULTPARAMETERS}
unit dya_hashmap_objects;

interface

uses
  dya_hashmap_impl;

type
generic THashMapOfObject<T> = object
public type
  TPtr = ^THashMapOfObject;
  TValue = T;
  PValue = ^TValue;
  TStats = THashMapStats;
  TIterator = object
  private
    FImpl: dya_hashmap_impl.THashMapIterator;
  public
    procedure Init(HashMap: TPtr);
    procedure Done; inline;
    function Next: Boolean; inline;
    function Key: AnsiString; inline;
  end;
private
  FImpl: dya_hashmap_impl.THashMap;
  procedure DestructValue(Value: Pointer; Len: SizeUInt); static;
public
  procedure Init;
  procedure Done; inline;
  procedure Add(const Key: array of AnsiChar; constref Obj: T); inline;
  procedure Add(const Key: AnsiString; constref Obj: T); inline;
  function Emplace(const Key: array of AnsiChar): PValue; inline;
  procedure Delete(const Key: array of AnsiChar); inline;
  function Find(const Key: array of AnsiChar; out Value: PValue): Boolean; inline; overload;
  function Find(const Key: AnsiString; out Value: PValue): Boolean; inline; overload;
  function Has(const Key: array of AnsiChar): Boolean; inline;
  function Has(const Key: AnsiString): Boolean; inline;
  procedure GetStats(out Stats: TStats); inline;
end;

// _SetKey should not be public, but when delete it from here,
// I get "Error: Global Generic template references static symtable"
function GetHash(S: PAnsiChar; Len: SizeUInt): THashMapHash;
procedure _SetKey(S: PAnsiChar; L: SizeUInt; out K: THashMapKey);

implementation

function GetHash(S: PAnsiChar; Len: SizeUInt): THashMapHash;
var
  Test, I: Integer;
begin
  Result := 0;
  for I := 0 to Len - 1 do begin
    Result := (Result shl 4) or Byte(S[I]);
    Test := Result and $F0000000;
    if Test <> 0 then
      Result := (Result xor (Result shr 24)) and $FFFFFFF;
  end;
end;

{function GetHash(S: PAnsiChar; Len: SizeUInt): THashMapHash;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Len - 1 do begin
      Result := Result +   Byte(S[I]);
      Result := Result +   (Result shl 10);
      Result := Result xor (Result shr 6);
  end;
  Result := Result +  (Result shl 3);
  Result := Result or (Result shr 11);
  Result := Result +  (Result shl 15);
end;}

procedure _SetKey(S: PAnsiChar; L: SizeUInt; out K: THashMapKey);
begin
  K.Data := S;
  K.Len := L;
  K.Hash := GetHash(S, L);
end;

procedure THashMapOfObject.TIterator.Init(HashMap: TPtr);
begin
  HashMapIteratorInit(HashMap^.FImpl, FImpl);
end;

procedure THashMapOfObject.TIterator.Done;
begin
  HashMapIteratorDone(FImpl);
end;

function THashMapOfObject.TIterator.Next: Boolean;
begin
  Result := HashMapIteratorNext(FImpl);
end;

function THashMapOfObject.TIterator.Key: AnsiString;
begin
  SetLength(Result, FImpl.Key.Len);
  Move(FImpl.Key.Data^, Result[1], FImpl.Key.Len);
end;

procedure THashMapOfObject.DestructValue(Value: Pointer; Len: SizeUInt);
begin
  PValue(Value)^.Done;
  Finalize(PValue(Value)^);
end;

procedure THashMapOfObject.Init;
begin
  HashMapInit(FImpl,
              nil, //@DestructValue,
              nil,  // Allocator
              nil,  // GetMem
              nil,  // FreeMem
              nil); // ReAllocMem
end;

procedure THashMapOfObject.Done;
begin
  HashMapDone(FImpl);
end;

procedure THashMapOfObject.Add(const Key: array of AnsiChar; constref Obj: T);
var
  K: THashMapKey;
begin
  K.Data := @Key[0];
  K.Len := Length(Key);
  K.Hash := GetHash(@Key[0], Length(Key));
  HashMapAdd(FImpl, K, @Obj, SizeOf(T));
end;

procedure THashMapOfObject.Add(const Key: AnsiString; constref Obj: T);
var
  K: THashMapKey;
begin
  _SetKey(@Key[1], Length(Key), K);
  HashMapAdd(FImpl, K, @Obj, SizeOf(T));
end;

function THashMapOfObject.Emplace(const Key: array of AnsiChar): PValue;
var
  K: THashMapKey;
begin
  K.Data := @Key[0];
  K.Len := Length(Key);
  K.Hash := GetHash(@Key[0], Length(Key));
  Result := HashMapEmplace(FImpl, K, SizeOf(T));
  Initialize(Result^);
end;

procedure THashMapOfObject.Delete(const Key: array of AnsiChar);
var
  K: THashMapKey;
begin
  K.Data := @Key[0];
  K.Len := Length(Key);
  K.Hash := GetHash(@Key[0], Length(Key));
  HashMapDelete(FImpl, K);
end;

function THashMapOfObject.Find(const Key: array of AnsiChar; out Value: PValue): Boolean;
var
  K: THashMapKey;
  V: THashMapValue;
begin
  K.Data := @Key[0];
  K.Len := Length(Key);
  K.Hash := GetHash(@Key[0], Length(Key));
  Result := HashMapFind(FImpl, K, V);
  if Result then
    Value := V.Data;
end;

function THashMapOfObject.Find(const Key: AnsiString; out Value: PValue): Boolean;
var
  K: THashMapKey;
  V: THashMapValue;
begin
  _SetKey(@Key[1], Length(Key), K);
  Result := HashMapFind(FImpl, K, V);
  if Result then
    Value := V.Data;
end;

function THashMapOfObject.Has(const Key: array of AnsiChar): Boolean;
var
  Temp: PValue;
begin
  Result := Find(Key, Temp);
end;

function THashMapOfObject.Has(const Key: AnsiString): Boolean;
var
  Temp: PValue;
begin
  Result := Find(Key, Temp);
end;

procedure THashMapOfObject.GetStats(out Stats: TStats);
begin
  HashMapGetStats(FImpl, Stats);
end;

end.
