Оптимизация может быть злом

Давно не обновлял свой блог, пора бы это сделать. В этом сообщении хотел бы поделиться своими взглядами на оптимизацию программ. Скажу сразу, для опытного программиста тут едва ли будет что-либо новое.

Мне порой кажется, что существует определенная категория программистов, которые считают что самое главное в программе - это максимальная степень оптимизации. Склонен с этим мнением не согласится. Отвечая на вопрос, что самое главное, нужно смотреть с двух разных точек зрения и искать компромисс между ними. И во многих случаях получится так, что оптимизации места здесь не найдется. Две точки зрения - это прикладная программа с точки зрения конечного пользователя, и программный код с точки зрения разработчика(-ов).

Конечного пользователя интересует программный продукт, набор его функций и возможностей, ему все равно выполняется ли определенный участок кода за 1 мс или за 10 мс, если он все равно не заметит разницы. Но погоня за выйгрышем этих 9 мс может обойтись разработчику достаточно дорого. Вопрос - в чем смысл? Единственный возможный - это в целях самообразования, но не более. Поймите, что качество программы от этого не вырастет ни на йоту, а может даже и упадет.

Программный код же далеко не в последнюю очередь пишется для людей. И требования к нему - соответствующие. Он должен быть понятен, читаем, гибок и расширяем. Разработка почти никогда не заканчивается в момент выпуска первой версии программы, и очень важно чтобы усовершенствование программного продукта обходилась как можно дешевле. Оптимизация же может принести вред качеству кода с этой точки зрения (особенно низкоуровневая оптимизация) - мы пытаемся сделать код более оптимальным для машины, за счет уменьшения его оптимальности для человека. Выигрыш от ненужной оптимизации сомнителен, в то время как проигрыш - ощутим. ПРЕЖДЕВРЕМЕННАЯ ОПТИМИЗАЦИЯ - ЗЛО! Не чешите, пока не чешется. Но с другой стороны, обратное - преждевременная пессимизация - тоже зло. Ищите серединку опираясь на обозначенные приоритеты.

Поэтому очень важно думая об оптимизации правильно расставлять приоритеты. А приоритеты эти - это юзабилити -  для пользователя, и читаемость, гибкость, расширяемость кода - для разработчика. Оптимизировать нужно тогда и только тогда, когда итоговые показатели не устраивают пользователей. И то, делать это нужно - тоже правильно. Не стоит сразу же бросаться переписывать участки кода на ассемблере - это глупо. В первую очередь нужно выявить узкое место путем тестирования и замеров. Делать это нужно обязательно, даже если вам кажется что вы знаете почему ваша программа тормозит. Поверьте опыту, достаточно часто ваши догадки не оправдываются и причина кроется где-то еще. И только выявив это узкое место, найдя причину, нужно пытаться найти более оптимальный вариант, решающий ту же задачу. В большинстве случаев этот оптимальный вариант заключается в высокоуровневой оптимизации - нужно изменить сам подход к решению задачи. Я не являюсь заядлым любителем алгоритмов и при оптимизации использую скорее не математический, а инженерный подход, о котором расскажу в следующий раз.

Реализация паттерна "Singleton" в Delphi

Давно интересовала тема реализации шаблона дизайна "Singleton" в Delphi, которая бы мне просто позволила бы мне получить соответствующее поведение путем простого наследования от некоторого базового класса. В результате нескольких различных вариантов реализаций остановился на таком:

type
  // Базовый класс для объектов, реализующих паттерн 
  // "Singleton". Для получения доступа к экземпляру
  // необходимо вызвать GetInstance. Если экземпляр 
  // еще не существует, то он будет создан. Иначе -  
  // возвращена ссылка на ранее созданный экземпляр.
  // Уничтожить экземпляр можно вручную, вызвав Free, 
  // иначе он будет уничтожен автоматически перед 
  // завершением приложения
  TSingleton = class(TObject)
  private
    class procedure RegisterInstance(Instance: 
      TSingletone);
    procedure UnRegisterInstance;
    class function FindInstance: TSingletone;
  protected
    // Инициализацию производить только в этом 
    // конструкторе, а не в GetInstance.
    // Не рекомендуется выносить этот конструктор 
    // из секции protected
    constructor Create; virtual;
  public
    class function NewInstance: TObject; override;
    procedure BeforeDestruction; override;
    // Точка доступа к экземпляру
    constructor GetInstance;
  end;
...

implementation

uses Contnrs;

var
  SingletonList: TObjectList;

{ TSingleton }

procedure TSingleton.BeforeDestruction;
begin
  UnregisterInstance;
  inherited BeforeDestruction;
end;

constructor TSingleton.Create;
begin
  inherited Create;
end;

class function TSingleton.FindInstance: 
  TSingletone;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to SingletonList.Count - 1 do
    if SingletonList[i].ClassType = Self 
    then begin
      Result := TSingleton(SingletonList[i]);
      Break;
    end;
end;

constructor TSingleton.GetInstance;
begin
  inherited Create;
end;

class function TSingleton.NewInstance: TObject;
begin
  Result := FindInstance;
  if Result = nil then begin
    Result := inherited NewInstance;
    TSingleton(Result).Create;
    RegisterInstance(TSingleton(Result));
  end;
end;

class procedure TSingleton.RegisterInstance(Instance: 
  TSingleton);
begin
  SingletonList.Add(Instance);
end;

procedure TSingletone.UnRegisterInstance;
begin
  SingletonList.Extract(Self);
end;

initialization
  SingletonList := TObjectList.Create(True);

finalization
  SingletonList.Free;

Ошибка в Delphi RTL - функция GetPropValue неверно работает с со свойствами типа Cardinal

Обнаружил неприятную ошибку в Delphi RTL. Казалось бы, такой совсем безобидный код вызывает Range check error:

type
  TFoo = class(TPersistent)
  private
    FBar: Cardinal;
  published
    property Bar: Cardinal read FBar write FBar;
  end;
...
var
  Obj: TFoo;
  Value: Variant;
begin
  Obj := TFoo.Create;
  try
    // Устанавливаем любое значение, выходящее за рамки 
    // типа Integer
    Obj.Bar := 4294967295; {$FFFFFFFF}
    Value := GetPropValue(Obj, 'Bar');
    SetPropValue(Obj, 'Bar', Value);  // Error
  finally
    Obj.Free;
  end;
end;

Почему так происходит? Заглянув в исходный код модуля TypInfo.pas, обнаружим такие строки:

  case PropInfo^.PropType^^.Kind of
    tkInteger, tkChar, tkWChar, tkClass:
      Result := GetOrdProp(Instance, PropInfo);

Очевидно, наше свойство имеет Kind = tkInteger, следовательно, Result будет присвоен результат вызова функции GetOrdProp. Казалось бы, все логично, но посмотрев на прототип функции GetOrdProp обнаружим, что возвращаемое значение имеет тип Longint - т.е. 4 байтное целое со знаком. Следовательно, вариантной переменной Result изначально установится неверное значение поля VType. Оно станет равным varInteger ($0003), вместо varLongWord ($0013). Ошибка имеет место быть именно здесь. Значение Value будет интерпретироваться как -1, а не как 4294967295.
Следующая строка в нашем примере вызовет проявление этой ошибки. Заглянув в реализацию функции SetPropValue увидим, что перед установкой свойству значения, происходит проверка, не выходит ли оно за диапазон возможных для данного типа:

function RangedValue(const AMin, AMax: Int64): Int64;
begin
  Result := Trunc(Value);
  if (Result < AMin) or (Result > AMax) then
    RangeError;
end;

Функция вызывается с верными параметрами - AMin = 0; AMax = 4294967295. Но Result в первой строке будет присвоено значение -1, т.е. наше $FFFFFFFF, которое мы установили свойству, но интерпретируемое как Integer, а не как Cardinal. И, разумеется, это значение не пройдет проверку на вхождение в диапазон.
Обходной путь для решения данной проблемы - не использовать Get(Set)PropValue для свойств, которые имеют или могут иметь тип 4-байтного целого без знака. Предусмотрите этот случай, и используйте вместо этого функции Get(Set)OrdProp.

Ручное управление временем жизни для объектов, реализующих интерфейсы

У Алексея Михайличенко, есть статья, в которой показано, что при работе с интерфейсами, которые реализуют объекты не ведущие учет ссылок, может возникнуть AV на казалось бы пустом месте. Исключение возникает в функции _IntfClear, которая вызывается автоматически для интерфейсных ссылок при выходе их за область видимости. Однако если объект до этого был уничтожен, интерфейсная ссылка перестает быть валидной и попытка вызова метода этого интерфейса собственно и приводит к AV. Вот эта статья:
http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1312

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

TMyInterfacedObject = class(TObject, IInterface)
protected
  FRefCount: Integer;
  FDestroyed: Boolean;
  function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; stdcall;
public
  procedure FreeInstance; override;
end;

procedure TMyInterfacedObject.FreeInstance;
begin
  FDestroyed := True;
  if RefCount = 0 then
    inherited FreeInstance;
end; 

function TMyInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TMyInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TMyInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and FDestroyed then
    FreeInstance;
end;

При вызове Free для таких объектов освобождение памяти под экземпляр произойдет только в том случае, если равен нулю счетчик ссылок. Иначе - просто будет выполнен код деструктора, а освобождение памяти произойдет только после обнуления счетчика. С другой стороны, обнуление счетчика не приведет к уничтожению экземпляра до тех пор, пока явно не вызвать для данного объекта Free.

class constructors

Хотелось бы иметь в Delphi for Win32 методы, объявляемые как class constructor, т.е. выполняющую некоторую инициализацию для класса в целом, а не для его экземпляров. И чтобы их код гарантировано выполнялся при старте приложения (подобно секции initialization юнита). И чтобы потомки класса наследовали конструкторы класса предка, а при желании - могли переопределить его поведение. Зачем это нужно? Скажем, у меня есть классы с общим предком, которые я должен регистрировать с помощью RegisterClass. Мне приходится помнить об этом и прописывать код регистрации руками для каждого класса в секции инициализации юнита. А если бы была описанная выше возможность, я мог бы в коде классового конструктора базового класса написать
RegisterClass(Self);
и просто объявлять от класса потомков - они бы регистрировались автоматически. Можно было бы регистрировать даже более сложным образом:
RegisterClassAlias(Self, GetClassAlias);
где GetClassAlias - виртуальный классовый метод. Эх, мечты-мечты...

Порождение разнотипных объектов

Очень часто встречаю в различных проектах код, подобный представленному ниже:

сase SomeValue of
  1: Obj := TFirstClass.Create;
  2: Obj := TSecondClass.Create;
...
end;

И это еще при том, что классы родственны между собой и их конструкторы имеют одинаковый прототип. Не нужно заниматься подобной ерундой, язык поддерживает виртуальные конструкторы! Все, что нужно, это объявить тип "классовая ссылка" (он же метакласс) таким образом:
TMyClass = class of TMyObject;
где TMyObject - общий предок для всех классов, экземпляры которых необходимо создавать, а также у класса TMyObject объявить виртуальный конструктор, который в потомках следует перекрывать. Например:

TMyObject = class(...)
public
  constructor Create(SomeParam: SomeType); virtual;
...
end;
TFirstClass = class(TMyObject)
public
  constructor Create(SomeParam: SomeType); override;
...
end;

Теперь создать экземпляр неизвестного на этапе компиляции класса можно например так:

function Factory(ClassType: TMyClass; Param: SomeType): TMyObject;
begin
  Result := ClassType.Create(Param);
end;

Вызывать можно так:
Obj := Factory(TFirstClass, 10);
или
Obj := Factory(TSecondClass, 20);

Можно пойти дальше и реализовать фабрику, которая принимает на входе некое значение типа String, Integer или другого типа, находит в неком реестре сопоставленный этому значению класс и создает его экземпляр:

RegisterClassAlias(TFirstClass, '1');
RegisterClassAlias(TSecondClass, '2');

function Factory(ClassId: Integer; Param: SomeType): TMyObject;
var
  ClassType: TMyClass;
begin
  ClassType := TMyClass(FindClass(IntToStr(ClassId)));
  Result := ClassType.Create(Param);
end;

Тут мы воспользовались стандартным реестром классов, занеся в него элементы с помощью вызовов RegisterClassAlias. Ограничение этого реестра в том, что регистрировать в нем можно только потомки TPersistent. Если ваши классы не являются его потомками, то можно реализовать свой простенький реестр, на основе, скажем, TStringList

Delphi - виды контрактов у классов

Грубо говоря, видов контрактов у классов в Delphi столько, сколько и директив области видимости - private, protected, public определяют контракты класса с самим собой, с потомками и с клиентским кодом. А как быть, если нам нужна более гибкая политика разграничения доступа к членам класса? Скажем, доступ к определенным членам класса при обычных условиях клиентскому коду должен быть запрещен, однако по специальной просьбе клиента, этот доступ необходимо предоставить. Такое поведение можно реализовать с помощью интерфейсов: класс определяет нужные приватные методы как реализацию некого интерфейса. Таким образом, получить доступ к этим методам клиент сможет только явно запросив интерфейс. Этим действием клиент берет на себя ответственность, как бы подтверждая "мне это действительно нужно и я знаю, что делаю". А можно пойти еще дальше - давать доступ к интерфейсу не всем кто попросит, а делать определенную проверку и только в случае успеха возвращать интерфейс. Таким образом можно, например, сэмитировать "дружественные классы" C++. В общем, простор для творчества большой, только нужно учесть, что подобное поведение не допускается в рамках технологии COM.