Индексация глобальная и не очень

Сразу оговорюсь, статья не имеет ничего общего с индексацией сайтов и т.п. Речь пойдет о вещах куда более простых, но, тем не менее, нужных. Иногда надо проиндексировать сущности, так чтобы индексы были уникальны в рамках программы и компактно упакованы в промежуток [0..N]. Причем заводить для этого отдельные механизмы совершенно не хочется.

Примером может послужить такая задача:

Всем, думаю, известно, что class var в Delphi есть не что иное, как обычная глобальная переменная, единая для класса и всех его потомков. А иногда нужно, чтобы потомки использовали свои собственные, например, для подсчета экземпляров класса. Я знаю как минимум одно решение этой проблемы, но это хак. Кроме того он требует от пользователя дополнительных действий — выделения памяти в блоке initialization и, по-хорошему, освобождения ее в finalization.

Но можно сделать и проще — завести глобальный (class var) массив, и сделать так, чтобы каждый потомок ссылался на свою ячейку. Единственная проблема в том, что для этого требуется проиндексировать потомков, причем сделать это автоматически.

В моем случае задача была несколько другой. Хотелось добавить классам универсальную возможность включать/исключать себя в множества и проверять себя на принадлежность за O(1). То есть добавить поле «сигнатуры», дающее такую возможность в независимости от количества предполагаемых множеств и не связывать классы каким-нибудь общим предком. В любом случае на определенном этапе я пришел к проблеме индексации этих самых множеств.

Немного побродив по просторам интернета, я не нашел готового решения. Собственно я не видел, чтобы такая задача вообще ставилась. А между тем, думаю, этому нашлось бы немало применений.

Вообще задача несложная. Возможно, это и послужило причиной отсутствия разговоров на эту тему. В самом примитивном виде код занимает всего несколько строк:

type
  TIndexator<TIdent> = class
  private
    var FIndexTable: TDictionary<TIdent, Integer>;
  public
    constructor Create;
    destructor Destroy; override;
    function GetIndex(Ident: TIdent): Integer;
  end;

function TIndexator<TIdent>.GetIndex(Ident: TIdent): Integer;
begin
  if not FIndexTable.TryGetValue(Ident, Result) then begin
    Result := FIndexTable.Count;
    FIndexTable.Add(Ident, Result);
  end;
end;

Но мне этого показалось недостаточно. В такой реализации надо создавать дополнительные переменные, как правило, глобальные и следить за их инициализацией. Кроме того не хватает некоторой гибкости. В общем, я решил немного усовершенствовать подход, и в результате получилось вот что:

type
  TGlobalIndexator<TIdent> = class
  private type
    TIdentTable = TList<TIdent>;
    TIndexTable = TDictionary<TIdent, Integer>;
    PClientField = ^TClientField;
    TClientField = record
      IndexNames: TIdentTable;
      IndexTable: TIndexTable;
    end;
    TClientTable = TDictionary<Pointer, PClientField>;
  strict private
    class var FClientTable: TClientTable;
    class constructor InitClass;
    class function GetField(Client: Pointer): PClientField;
  public
    class function GetIndex(Ident: TIdent): Integer; overload;
    class function GetIndex(Client: Pointer; Ident: TIdent): Integer; overload;
    class function GetIdent(Index: Integer): TIdent; overload;
    class function GetIdent(Client: Pointer; Index: Integer): TIdent; overload;
  end;

class constructor TGlobalIndexator<TIdent>.InitClass;
begin
  FClientTable := TClientTable.Create;
end;

class function TGlobalIndexator<TIdent>.GetField(
  Client: Pointer): PClientField;
begin
  if not FClientTable.TryGetValue(Client, Result) then begin
    New(Result);
    Result.IndexNames := TIdentTable.Create;
    Result.IndexTable := TIndexTable.Create;
    FClientTable.Add(Client, Result);
  end;
end;

class function TGlobalIndexator<TIdent>.GetIndex(Client: Pointer;
  Ident: TIdent): Integer;
var Field: PClientField;
begin
  //Writeln('GetIndex(', Client.ClassName, ', , Ident, );');
  Field := GetField(Client);
  if not Field.IndexTable.TryGetValue(Ident, Result) then begin
    Result := Field.IndexNames.Count;
    Field.IndexNames.Add(Ident);
    Field.IndexTable.Add(Ident, Result);
  end;
end;

class function TGlobalIndexator<TIdent>.GetIndex(Ident: TIdent): Integer;
begin
  Result := GetIndex(Pointer(Self), Ident);
end;

class function TGlobalIndexator<TIdent>.GetIdent(Client: Pointer;
  Index: Integer): TIdent;
var Field: PClientField;
begin
  Field := GetField(Client);
  if Index < Field.IndexNames.Count then
    Result := Field.IndexNames[Index]
  else
    raise Exception.CreateFmt('Index %d is not registered', [Index]);
end;

class function TGlobalIndexator<TIdent>.GetIdent(Index: Integer): TIdent;
begin
  Result := GetIdent(Pointer(Self), Index);
end;

Код все равно не сложен. Как можно заметить, в нем нет процедур удаления индекса. Это сделано специально, чтобы избежать множества проблем, связанных с использованием «старого» индекса.

Применять этот класс можно двумя способами: В простых случаях можно просто задать новый потомок класса. Ничего переопределять при этом не нужно, важен лишь факт создания нового класса.

type
  TMyStringIndexator = class(TGlobalIndexator<String>) end;

begin
  Index1 := TMyStringIndexator('Key0');
  Index2 := TMyStringIndexator('Key1');
end;

Там где требуется бо&#x301льшая гибкость можно помимо индексируемого значения указать «клиента». Индексация различных клиентов будет проводиться независимо. Если клиент — статический класс, то указывается TSomeClass.ClassInfo, если текущий потомок — Self.ClassInfo, если объект, то просто Self.

Вот, например, реализация выше упомянутого счетчика экземпляров:

type
  TCountable = class
  private
    FIndex: Integer;
    class var FCounts: array of Integer;
    function GetCount: Integer; inline;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
  end;

constructor TCountable.Create;
begin
  FIndex := TGlobalIndexator<Pointer>.GetIndex(TCountable.ClassInfo, ClassInfo);
  if Length(FCounts) <= FIndex then
    SetLength(FCounts, FIndex + 1);
  Inc(FCounts[FIndex]);
end;

destructor TCountable.Destroy;
begin
  Dec(FCounts[FIndex]);
end;

function TCountable.GetCount: Integer;
begin
  Result := FCounts[FIndex];
end;

Так у каждого потомка будет свой счетчик экземпляров, и нет необходимости в каких либо дополнительных действиях.

В общем, надеюсь, кому-то эта идея пойдет на пользу.