{
    Я пытался реализовать коллекции на дженириках, но в старых версиях fpc
    есть куча Internal Error'ов и глюков, а на RPi2 я не могу собрать новый
    компилятор.
    Поэтому принял решение временно реализовать самые нужные коллекции без
    дженериков.
}
{$MODE OBJFPC}
{$MODESWITCH AUTODEREF}
unit dhashmap_oldstyle;

interface

uses
  dstrnum,
  dstrings;

type
THashFunc = function (P: PAnsiChar; Len: LongInt): Cardinal;

PHashMap = ^THashMap;
THashMap = object
private type
  TPair = record
    Key: AnsiString;
    Value: AnsiString;
  end;
private
  FElementSize: LongInt;
  FFunc: THashFunc;
  FPages: LongInt;
  FTable: array of array of TPair;
public
  constructor Init(ElementSize: LongInt; Func: THashFunc; Pages: LongInt = 128);
  destructor Done; virtual;
  procedure Add(Key: TAnsiBuf; P: Pointer);
  function Get(Key: TAnsiBuf): Pointer;
  function Find(Key: TAnsiBuf; var P: Pointer): Boolean;
  procedure Del(Key: TAnsiBuf);
  // Utils
  function GetCount: LongInt;
  function GetAllCollisions: LongInt;
  function GetMaxCollisions: LongInt;
public type
  // leads to Internal error in fpc3.0.0rc1
  TIterator = object
  private
    FHashMap: PHashMap;
    FPage: LongInt;
    FIndex: LongInt;
  public
    procedure Init(HashMap: PHashMap);
    procedure Done;
    function Next: Boolean;
    function Key: TAnsiBuf;
    function Value: Pointer;
  end;
protected
  procedure DeleteElement(P: Pointer); virtual;
  procedure MoveElement(Src, Dst: Pointer); virtual;
  procedure CopyElement(Src, Dst: Pointer); virtual;
  function GetPage(Key: TAnsiBuf): Cardinal;
  function GetIndex(Key: TAnsiBuf; Page: LongInt): LongInt;
end;

//THashMapIterator = object
//private
//  FHashMap: PHashMap;
//  FPage: LongInt;
//  FIndex: LongInt;
//public
//  procedure Init{(HashMap: PHashMap)};
//  procedure Done;
//  //function Next: Boolean;
//  //function Key: TAnsiBuf;
//  //function Value: Pointer;
//end;

implementation

constructor THashMap.Init(ElementSize: LongInt; Func: THashFunc; Pages: LongInt = 128);
begin
  FElementSize := ElementSize;
  FFunc := Func;
  FPages := Pages;
  SetLength(FTable, FPages);
end;

destructor THashMap.Done;
var
  Page, Index: LongInt;
begin
  for Page := 0 to High(FTable) do begin
    for Index := 0 to High(FTable[Page]) do begin
      DeleteElement(@FTable[Page][Index].Value[1]);
      FTable[Page][Index].Key := '';
      FTable[Page][Index].Value := '';
    end;
    SetLength(FTable[Page], 0);
  end;
  SetLength(FTable, 0);
end;

procedure THashMap.Add(Key: TAnsiBuf; P: Pointer);
var
  Page, I: LongInt;
begin
  Page := GetPage(Key);
  for I := 0 to High(FTable[Page]) do
    if Key = AnsiBuf(FTable[Page][I].Key) then begin
      DeleteElement(@FTable[Page][I].Value[1]);
      CopyElement(P, @FTable[Page][I].Value[1]);
      Exit;
    end;
  SetLength(FTable[Page], Length(FTable[Page]) + 1);
  FTable[Page][High(FTable[Page])].Key := Key.ToString;
  SetLength(FTable[Page][High(FTable[Page])].Value, FElementSize);
  CopyElement(P, @FTable[Page][High(FTable[Page])].Value[1]);
end;

function THashMap.Get(Key: TAnsiBuf): Pointer;
var
  Page, I: LongInt;
begin
  Page := GetPage(Key);
  for I := 0 to High(FTable[Page]) do
    if Key = FTable[Page][I].Key then
      Exit(@FTable[Page][I].Value[1]);
  Exit(nil);
end;

function THashMap.Find(Key: TAnsiBuf; var P: Pointer): Boolean;
var
  Page, I: LongInt;
begin
  Page := GetPage(Key);
  for I := 0 to High(FTable[Page]) do begin
    if Key = FTable[Page][I].Key then begin
      P := @FTable[Page][I].Value[1];
      Exit(True);
    end;
  end;
  Exit(False);
end;

procedure THashMap.Del(Key: TAnsiBuf);
var
  Page, Index: LongInt;
begin
  Page := GetPage(Key);
  Index := GetIndex(Key, Page);
  if Index <> -1 then begin
    DeleteElement(@FTable[Page][Index].Value[1]);
    FTable[Page][Index].Key := FTable[Page][High(FTable[Page])].Key;
    MoveElement(@FTable[Page][High(FTable[Page])].Value[1], @FTable[Page][Index].Value[1]);
    SetLength(FTable[Page], Length(FTable[Page]) - 1);
  end;
end;

procedure THashMap.TIterator.Init(HashMap: PHashMap);
begin
  FHashMap := HashMap;
  FPage := 0;
  FIndex := -1;
end;

procedure THashMap.TIterator.Done;
begin
end;

function THashMap.TIterator.Next: Boolean;
begin
  if FPage >= FHashMap.FPages then
    Exit(False);
  Inc(FIndex);
  while FIndex >= Length(FHashMap.FTable[FPage]) do begin
    FIndex := 0;
    Inc(FPage);
    if FPage >= FHashMap.FPages then
      Exit(False);
  end;
  Exit(True);
end;

function THashMap.TIterator.Key: TAnsiBuf;
begin
  Result := FHashMap.FTable[FPage][FIndex].Key;
end;

function THashMap.TIterator.Value: Pointer;
begin
  Result := @FHashMap.FTable[FPage][FIndex].Value[1];
end;

procedure THashMap.DeleteElement(P: Pointer);
begin
end;

procedure THashMap.MoveElement(Src, Dst: Pointer);
begin
  CopyElement(Src, Dst);
  DeleteElement(Src);
end;

procedure THashMap.CopyElement(Src, Dst: Pointer);
begin
  Move(Src^, Dst^, FElementSize);
end;

function THashMap.GetCount: LongInt;
var
  Page: LongInt;
begin
  Result := 0;
  for Page := 0 to High(FTable) do
    Result := Result + Length(FTable[Page]);
end;

function THashMap.GetAllCollisions: LongInt;
var
  Page: LongInt;
begin
  Result := 0;
  for Page := 0 to High(FTable) do
    if Length(FTable[Page]) <> 0 then
      Result := Result + Length(FTable[Page]) - 1;
end;

function THashMap.GetMaxCollisions: LongInt;
var
  Page: LongInt;
begin
  Result := 0;
  for Page := 0 to High(FTable) do
    if Result < High(FTable[Page]) then
      Result := High(FTable[Page]);
end;

function THashMap.GetPage(Key: TAnsiBuf): Cardinal;
begin
  Result := FFunc(Key.Data, Key.Length) mod FPages;
end;

function THashMap.GetIndex(Key: TAnsiBuf; Page: LongInt): LongInt;
begin
  Result := 0;
  while Result < Length(FTable[Page]) do begin
    if Key = FTable[Page][Result].Key then
      Exit;
    Inc(Result);
  end;
  Exit(-1);
end;

end.
