Вопрос про освобождение памяти при перегрузке операторов

[popoveo]

Здравствуйте. Есть класс TMyClass. Для него перегружен оператор +:
operator +(A:TMyClass;B:Byte)R:TMyClass;
begin
R:=TMyClass.Create;
//что-то делаем...
end
Как освобождать память в выражениях вида C:=((A+2)+3)+4, где A+2 создаст TMyClass, (A+2)+3 создаст еще один класс... Ведь деструкторы автоматически не запустятся...
Есть ли вообще какая-либо методика высвобождения памяти в данном случае или возможно только ограничиться одним действием в выражении и прибивать полученные классы руками?

[runewalsh]

А хрен его знает. Используй record/object, интерфейсы или свой подсчёт ссылок.

Код: Выделить всё

{$mode objfpc} {$h+} {$modeswitch duplicatelocals+}
{$apptype console}
uses
   heaptrc;

type
   Summable = class
      value: string;
      constructor Create(const value: string);
      function Acquire: Summable;
      procedure Release;
   private
      refcount: cardinal;
   const
      ImpossibleRefcount = High(cardinal);
   end;

   constructor Summable.Create(const value: string);
   begin
      self.value := value;
      refcount := 1;
   end;

   function Summable.Acquire: Summable;
   begin
      Assert(refcount <> ImpossibleRefcount, 'Попытка увеличить счётчик ссылок уничтожаемого объекта!');
      inc(refcount);
      result := self;
   end;

   procedure Summable.Release;
   begin
      Assert(refcount <> ImpossibleRefcount, 'Попытка освободить уничтожаемый объект!');
      dec(refcount);
      if refcount = 0 then
      begin
         refcount := ImpossibleRefcount;
         Destroy;
      end;
   end;

   operator +(const a, b: Summable): Summable;
   begin
      try
         result := Summable.Create(a.value + b.value);
      finally
         a.Release;
         b.Release;
      end;
   end;

var
   r, t: Summable;

begin
   t := Summable.Create('T');
   r := Summable.Create('1') + t.Acquire + Summable.Create('2') + t.Acquire + Summable.Create('3');
   writeln(r.value);
   readln;
   r.Release;
   t.Release;
end.

[beria]

Ведь деструкторы автоматически не запустятся...

А собственно почему? Динамические строки внутри класса автоматически освобождают память при убиении оного класса, хотя и с задержкой, о чем сам убедился загоняя в них монструозных размеров HTML страницы.

[Дож]

свой подсчёт ссылок

И что произойдёт в выражении A := B + C в предложенном коде? B и C будут не только сложены, но и освобождены?

[runewalsh]

Поэтому там и Acquire. Руками красиво не сделаешь. Ну, хотя бы семантику можно более-менее согласованно выстроить: ссылку аквайрит передающий (в т. ч. возвращающий, как частный случай — после конструктора объект автоматически аквайрнут), освобождает тот, кому передали.

[скалогрыз]

а не проще отказаться от перегрузки операторов?

методы или простые процедуры и функции... помощники классов... всё это предсказуемее работает.

[popoveo]

Объекты вместо классов и подсчет ссылок рассматривал. К сожалению, не подходит ни то, ни другое. Первое - потому что внутри классов, над которыми перегружаем операторы, есть динамически выделяемая память (все равно нужно отловить момент уничтожения объекта). Второй вариант также не подходит, т.к. опять не понятно, где увеличивать и уменьшать количество ссылок. Все же реализовал второй вариант с костылями: во всех операторах запихиваю созданный класс в группу - статический член этого класса, увеличиваю количество ссылок в экземпляре. После вычисления выражения добавляю еще ссылку, если результат нужен. Потом очищаю группу: уменьшаю у всех элементов количество ссылок. Ненужные (где была одна ссылка) погибают. Но это синтаксически тоже некрасиво и также может привести к ошибкам. Получается что-то типа: var A:TMyClass; begin A:=0; A:=(A+2)+3; if Need(A) then A.CreateLink; TMyClass.TemporaryGroup.Clear; end; Отказ от операторов тоже рассматривал, но как это решает проблему промежуточных результатов? A:=Add(Add(A,2),3). Тоже самое.

[runewalsh]

опять не понятно, где увеличивать и уменьшать количество ссылок

При любой передаче объекта «по значению», а тот, кому передали, уменьшает, когда закончит работать. В частности: функция ожидает аргументы инкрементнутыми и освобождает их; если функция возвращает объект, она инкрементирует его счётчик, а когда вызвавший закончит с ним работать — декрементирует; конструкторы всегда возвращают объект со счётчиком = 1. Ну, так в моём варианте (и так компилятор работает со всеми автотипами, кроме интерфейсов).

Интерфейсы чуть по-другому сделаны (предполагается, что конструктор возвращает объект с нулём ссылок), поэтому у них есть неприятная багофича:

Код: Выделить всё

{$mode objfpc} {$h+} {$apptype console} {$modeswitch duplicatelocals}
uses
   heaptrc;

type
   IString = interface
      function GetValue: string;
      property Value: string read GetValue;
   end;

   StringWrapper = class(TInterfacedObject, IString)
      value: string;
      constructor Create(const value: string);
      function GetValue: string;
   end;

   constructor StringWrapper.Create(const value: string);
   begin
      inherited Create;
      self.value := value;
   end;

   function StringWrapper.GetValue: string;
   begin
      result := value;
   end;

   operator +(a, b: IString): IString;
   begin
      result := StringWrapper.Create(a.Value + b.Value);
   end;

   procedure Test;
   begin
      writeln((StringWrapper.Create('1') + StringWrapper.Create('2') + StringWrapper.Create('3')).Value);
   end;

begin
   Test;
   DumpHeap;
   readln;
end.

Если в operator+ передать const-ссылку на объект, созданный на месте (здесь операнды такими и являются), его счётчик никогда не увеличится с нуля, соответственно, не уменьшится и объект утечёт. Это не считая того, что подсчёт ссылок работает только для переменных интерфейсного типа, а не классового, поэтому, единожды отдав класс в интерфейсную переменную, в дальнейшем с ним можно работать только через интерфейсы.

[скалогрыз]

Отказ от операторов тоже рассматривал, но как это решает проблему промежуточных результатов? A:=Add(Add(A,2),3). Тоже самое.

очевидно же - плохой и неэффективный API!

как бы сделал я:

Код: Выделить всё

function Copy(a: TMyClass): TMyClass;

procedure Add(a: TMyClass; vl: byte);
begin
  a.val:=a.val+vl;
end;


1. сложение в другой объект C:=((A+2)+3)+4

Код: Выделить всё

var
  c,a: TMyClass
...
  C:=Copy(A);
  Add(C,2);
  Add(C,3);
  Add(C,4);


2. сложение в свой же объект:

Код: Выделить всё

var
  c,a: TMyClass
...
  Add(A,2)
  Add(A,3)


(ни одного лишнего обращения к куче!)

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

Код: Выделить всё

function Add_(a: TMyClass; vl: byte): TMyClass;
begin
  Add(a, vl);
  Result:=a;
end;


1. сложение в другой объект C:=((A+2)+3)+4

Код: Выделить всё

var
  c,a: TMyClass
...
  C:=Add_(Add_(Add_(Copy(A),2),3),4);


2. сложение в себя

Код: Выделить всё

var
  a: TMyClass
...
  a:=Add_(Add_(A,2),3);


на самом деле держать с стеке (а тут компилятор будет держать), ничё хорошего нет... хотя там где-то был ключ компиляции на развёртку рекурсий.

Но опять же - никаких и лишних(!)(!!)(!!!) обращений к динамической памяти нет.

К сожалению, война между: "писать гламурно" и "писать эффективно" проигрываеся в сторону гламурно. Особенно в тех языках (паскаль), где требуется писать эффективно.

[Дож]

А все проблемы от того, что Management Operators всё ещё не поддерживаются :)

[sts]

а зачем вы создаете новый экземпляр объекта? (а ну да уже написали об этом)

Добавлено спустя 20 минут 12 секунд:
в общем решение есть надо проверять, в общих чертах, надо сохранять ссылки на созданные в операторах промежуточные объекты и зачищать их в операторе :=

Код: Выделить всё

operator +(A:TMyClass;B:Byte)R:TMyClass;
begin
  if A.FIsTempObj then
     R:= A //чтоб лишних промежуточных экземпляров не плодить
  else begin
     R:=TMyClass.Create;
     A.FOperRef:= R;
     R.FIsTempObj:= true;
  end;
//что-то делаем...
end

Код: Выделить всё

operator :=(A:TMyClass)R:TMyClass;
begin
if A.FIsTempObj then begin
R:= A
R.FIsTempObj:= false;
end else begin
R:=TMyClass.Create;
//копируем A в R
end;
//зачищаем промежуточные объекты...
end

думаю идея понятна...

Добавлено спустя 13 минут 11 секунд:
ща расчехлю фрипаскаль- проверю

Добавлено спустя 24 минуты 17 секунд:
мда неожиданно

Добавлено спустя 29 минут 54 секунды:

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  TMyClass = class
  protected
    FIsTempObj: boolean;
  public
    Value: Integer;
    constructor Create;
    destructor Destroy; override;
  end;

  operator +(A:TMyClass;B:Integer)R:TMyClass;
  operator +(A:TMyClass;B:TMyClass)R:TMyClass;
  operator -(A:TMyClass;B:Integer)R:TMyClass;
  operator -(A:TMyClass;B:TMyClass)R:TMyClass;
  operator :=(A:TMyClass)R:Integer;
  operator :=(A:Integer)R:TMyClass;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  MyClassCount: integer;

implementation

{$R *.lfm}

procedure AddLog(Text: string);
begin
  if Assigned(Form1) then Form1.Memo1.Lines.Add(Text);
end;

{ TMyClass }

operator +(A:TMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator +, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  if A.FIsTempObj then begin
     R:= A;
  end else begin
     R:=TMyClass.Create;
     R.FIsTempObj:= true;
  end;
  R.Value:= A.Value + B;
end;

operator +(A:TMyClass;B:TMyClass)R:TMyClass;
begin
  AddLog('operator +, 2');
  if A.FIsTempObj then begin
    R:= A;
    R.Value:= A.Value + B.Value;
    if B.FIsTempObj then B.Free;
  end else if B.FIsTempObj then begin
    R:= B;
  end else begin
    R:=TMyClass.Create;
    R.FIsTempObj:= true;
  end;
  R.Value:= A.Value + B.Value;
end;

operator -(A:TMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator -, 3');
  if A.FIsTempObj then begin
     R:= A;
  end else begin
     R:=TMyClass.Create;
     R.FIsTempObj:= true;
  end;
  R.Value:= A.Value - B;
end;

operator -(A:TMyClass;B:TMyClass)R:TMyClass;
begin
  AddLog('operator -, 4');
  if A.FIsTempObj then begin
    R:= A;
    R.Value:= A.Value - B.Value;
    if B.FIsTempObj then B.Free;
  end else if B.FIsTempObj then begin
    R:= B;
  end else begin
    R:=TMyClass.Create;
    R.FIsTempObj:= true;
  end;
  R.Value:= A.Value - B.Value;
end;

operator :=(A:TMyClass)R:Integer;
begin
  AddLog('operator :=, A.Value = ' + IntToStr(A.Value));
  R:= A.Value;
  if A.FIsTempObj then A.Free;
end;

operator :=(A:Integer)R:TMyClass;
begin
  AddLog('operator :=, A = ' + IntToStr(A));
  R:=TMyClass.Create;
  R.Value:= A;
end;

constructor TMyClass.Create;
begin
  Inc(MyClassCount);
  inherited Create;
  AddLog('TMyClass.Create, MyClassCount = ' + IntToStr(MyClassCount));
  FIsTempObj:= false;
  Value:= 0;
end;

destructor TMyClass.Destroy;
begin
  AddLog('TMyClass.Destroy, MyClassCount = ' + IntToStr(MyClassCount));
  inherited Destroy;
  Dec(MyClassCount);
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  A,C: TMyClass;
begin
  try
    A:= 10;
    C:= ((A+2)+3)+4;
    Memo1.Lines.Add('C = ' + IntToStr(C));
    a.Free;
  finally
    Memo1.Lines.Add('MyClassCount = ' + IntToStr(MyClassCount));
  end;
end;

end.


Добавлено спустя 57 секунд:

Код: Выделить всё

Memo1
operator :=, A = 10
TMyClass.Create, MyClassCount = 1
operator +, A.Value = 10, B = 2
TMyClass.Create, MyClassCount = 2
operator +, A.Value = 12, B = 3
operator +, A.Value = 15, B = 4
operator :=, A.Value = 19
TMyClass.Destroy, MyClassCount = 2
C = 19
TMyClass.Destroy, MyClassCount = 1
MyClassCount = 0


Добавлено спустя 5 минут 3 секунды:
в общем перегрузка хороша тем что ненужно .Create делать в A:= 10; осталось еще от A.Free; избавиться.

Добавлено спустя 26 минут 3 секунды:
во, самый безглючный вариант

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  IMyClass = interface
    function GetValue: Integer;
    procedure SetValue(Value: Integer);
    function GetIsTempObj: boolean;
    procedure SetIsTempObj(Value: boolean);

    property Value: Integer read GetValue write SetValue;
    property IsTempObj: boolean read GetIsTempObj write SetIsTempObj;
  end;

  TMyClass = class(TInterfacedObject, IMyClass)
  protected
    FValue: Integer;
    FIsTempObj: boolean;

    function GetValue: Integer;
    procedure SetValue(Value: Integer);
    function GetIsTempObj: boolean;
    procedure SetIsTempObj(Value: boolean);
  public

    constructor Create(IsTempObj: boolean = false);

    destructor Destroy; override;
  end;

  operator +(A:IMyClass;B:Integer)R:IMyClass;
  operator +(A:IMyClass;B:IMyClass)R:IMyClass;
  operator -(A:IMyClass;B:Integer)R:IMyClass;
  operator -(A:IMyClass;B:IMyClass)R:IMyClass;
  operator :=(A:IMyClass)R:Integer;
  operator :=(A:Integer)R:IMyClass;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  MyClassCount: integer;

implementation

{$R *.lfm}

procedure AddLog(Text: string);
begin
  if Assigned(Form1) then Form1.Memo1.Lines.Add(Text);
end;

{ TMyClass }

operator +(A:IMyClass;B:Integer)R:IMyClass;
begin
  AddLog('operator +, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  if A.IsTempObj then begin
     R:= A;
  end else begin
     R:=TMyClass.Create(true);
  end;
  R.Value:= A.Value + B;
end;

operator +(A:IMyClass;B:IMyClass)R:IMyClass;
begin
  AddLog('operator +, 2');
  if A.IsTempObj then begin
    R:= A;
  end else if B.IsTempObj then begin
    R:= B;
  end else begin
    R:= TMyClass.Create(true);
  end;
  R.Value:= A.Value + B.Value;
end;

operator -(A:IMyClass;B:Integer)R:IMyClass;
begin
  AddLog('operator -, 3');
  if A.IsTempObj then begin
     R:= A;
  end else begin
     R:= TMyClass.Create(true);
  end;
  R.Value:= A.Value - B;
end;

operator -(A:IMyClass;B:IMyClass)R:IMyClass;
begin
  AddLog('operator -, 4');
  if A.IsTempObj then begin
    R:= A;
  end else if B.IsTempObj then begin
    R:= B;
  end else begin
    R:= TMyClass.Create(true);
  end;
  R.Value:= A.Value - B.Value;
end;

operator :=(A:IMyClass)R:Integer;
begin
  AddLog('operator :=, A.Value = ' + IntToStr(A.Value));
  R:= A.Value;
end;

operator :=(A:Integer)R:IMyClass;
begin
  AddLog('operator :=, A = ' + IntToStr(A));
  R:= TMyClass.Create;
  R.Value:= A;
end;

constructor TMyClass.Create(IsTempObj: boolean);
begin
  Inc(MyClassCount);
  inherited Create;
  AddLog('TMyClass.Create, MyClassCount = ' + IntToStr(MyClassCount));
  FIsTempObj:= IsTempObj;
  FValue:= 0;
end;

destructor TMyClass.Destroy;
begin
  AddLog('TMyClass.Destroy, MyClassCount = ' + IntToStr(MyClassCount));
  inherited Destroy;
  Dec(MyClassCount);
end;

function TMyClass.GetValue: Integer;
begin
  result:= FValue;
end;

procedure TMyClass.SetValue(Value: Integer);
begin
  FValue:= Value;
end;

function TMyClass.GetIsTempObj: boolean;
begin
  result:= FIsTempObj;
end;

procedure TMyClass.SetIsTempObj(Value: boolean);
begin
  FIsTempObj:= Value;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  A,C: IMyClass;
begin
  try
    A:= 10;
    C:= ((A+2)+3)+4;
    Memo1.Lines.Add('C = ' + IntToStr(C));
  finally
    Memo1.Lines.Add('MyClassCount = ' + IntToStr(MyClassCount));
  end;
end;

end.


[runewalsh]

Идея с временными объектами хорошая, но в таком виде очень рискованная.
Твой код легко ломается, например:

Код: Выделить всё

A := 10;
A := A + 0; // теперь A считается временным
C := A + 1 + A; // первый плюс изменит A на месте, поэтому второй получит неожиданное значение правого операнда

Ящитаю, лучше всего разрулить отдельным типом для временных объектов.

Код: Выделить всё

{$mode objfpc} {$h+} {$apptype console} {$modeswitch duplicatelocals}
uses
   heaptrc;

   function IntToStr(x: integer): string;
   begin
      str(x, result);
   end;

type
   IXYPair = interface
      function GetX: integer; procedure SetX(x: integer);
      function GetY: integer; procedure SetY(y: integer);
      function ToString: string;
      property X: integer read GetX write SetX;
      property Y: integer read GetY write SetY;
   end;

   XYPair = class(TInterfacedObject, IXYPair)
      x, y: integer;
      constructor Create(x, y: integer);
      function ToString: string; override;
      function GetX: integer; procedure SetX(x: integer);
      function GetY: integer; procedure SetY(y: integer);
   end;

   constructor XYPair.Create(x, y: integer);
   begin
      inherited Create;
      self.x := x;
      self.y := y;
      writeln('created ' + ToString);
   end;

   function XYPair.ToString: string;
   begin
      result := '(' + IntToStr(x) + ', ' + IntToStr(y) + ')';
   end;

   function XYPair.GetX: integer; begin result := x; end;
   procedure XYPair.SetX(x: integer); begin self.x := x; end;
   function XYPair.GetY: integer; begin result := y; end;
   procedure XYPair.SetY(y: integer); begin self.y := y; end;

type
   PassedXYPair = object
      ref: IXYPair;
      temp: boolean;
      function Make(const ref: IXYPair; temp: boolean): PassedXYPair; static;
      function ToMutable: IXYPair;
   end;

   function PassedXYPair.Make(const ref: IXYPair; temp: boolean): PassedXYPair;
   begin
      result.ref := ref;
      result.temp := temp;
   end;

   function PassedXYPair.ToMutable: IXYPair;
   begin
      if temp then result := ref else result := XYPair.Create(ref.X, ref.Y);
   end;

   operator :=(const ref: IXYPair): PassedXYPair;
   begin
      result := PassedXYPair.Make(ref, {temp =} false);
   end;

   operator :=(const pair: PassedXYPair): IXYPair;
   begin
      result := pair.ref;
   end;

   operator +(a, b: PassedXYPair): PassedXYPair;
   var
      src: string;
   begin
      src := a.ref.ToString + ' + ' + b.ref.ToString;
      if b.temp and not a.temp then
         result := b + a
      else
      begin
         result := PassedXYPair.Make(a.ToMutable, {temp = } true);
         result.ref.x := result.ref.x + b.ref.x;
         result.ref.y := result.ref.y + b.ref.y;
      end;
      writeln('operator +: ', src, ' = ', result.ref.ToString);
   end;

   operator -(a, b: PassedXYPair): PassedXYPair;
   var
      src: string;
   begin
      src := a.ref.ToString + ' - ' + b.ref.ToString;
      if b.temp and not a.temp then
      begin
         result := b - a;
         result.ref.x := -result.ref.x;
         result.ref.y := -result.ref.y;
      end else
      begin
         result := PassedXYPair.Make(a.ToMutable, {temp = } true);
         result.ref.x := result.ref.x - b.ref.x;
         result.ref.y := result.ref.y - b.ref.y;
      end;
      writeln('operator -: ', src, ' = ', result.ref.ToString);
   end;

   procedure Test;
   var
      A, B, C, D, E: IXYPair;
   begin
      A := XYPair.Create(1, 2);
      B := XYPair.Create(3, 4);
      C := (A + B) + (A + B) + (A + B);
      D := C + C;
      E := C - (B - A);
      writeln('---');
      writeln('A = ', A.ToString, ' - expected (1, 2)');
      writeln('B = ', B.ToString, ' - expected (3, 4)');
      writeln('C = ', C.ToString, ' - expected 3*(A+B) = 3*(4, 6) = (12, 18)');
      writeln('D = ', D.ToString, ' - expected (24, 36)');
      writeln('E = ', E.ToString, ' - expected (12, 18) - ((3, 4) - (1, 2)) = (10, 16)');
      writeln('---');
   end;

begin
   Test;
   DumpHeap;
   readln;
end.

[Лекс Айрин]

A := A + 0; // теперь A считается временным

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

[sts]

Идея с временными объектами хорошая, но в таком виде очень рискованная.

да, просмотрел.

удивление вызвало то что нельзя перекрыть

Код: Выделить всё

operator :=(A:IMyClass)R:IMyClass;

ну почему такая зашоренность у авторов!

Добавлено спустя 3 минуты 27 секунд:
тобишь, изначально я планировал в случае:

Код: Выделить всё

A := A + 0;

снимать признак временности.

Добавлено спустя 7 минут 47 секунд:
в общем у меня от freepascal сплошное расстройство, вроде бы куча возможностей но всякие недочеты все портят, ничего на нем не делаю.

Добавлено спустя 55 минут 13 секунд:

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  IMyClass = interface
    function GetValue: Integer;
    procedure SetValue(Value: Integer);
    property Value: Integer read GetValue write SetValue;
  end;

  TMyClass = class(TInterfacedObject, IMyClass)
  protected
    FValue: Integer;
    function GetValue: Integer;
    procedure SetValue(Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TMyClassTmp = class(TObject)
  protected
    Value: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  operator +(A:IMyClass;B:Integer)R:TMyClassTmp;
  operator +(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
  operator +(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;

  operator -(A:IMyClass;B:Integer)R:TMyClassTmp;
  operator -(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
  operator -(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;

  operator :=(A:IMyClass)R:Integer;
  operator :=(A:Integer)R:IMyClass;
  operator :=(A:TMyClassTmp)R:IMyClass;
  operator :=(A:TMyClassTmp)R:Integer;

  operator +(A:String; B:IMyClass)R:String;

  operator :=(A:IMyClass)R:String;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  MyClassCount: integer = 0;
  MaxMyClassCount: integer = 0;
  MyClassTmpCount: integer = 0;
  MaxMyClassTmpCount: integer = 0;

implementation

{$R *.lfm}

procedure AddLog(Text: string);
begin
  if Assigned(Form1) then Form1.Memo1.Lines.Add(Text);
end;

operator +(A:IMyClass;B:Integer)R:TMyClassTmp;
begin
  AddLog('operator1 +, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  R:=TMyClassTmp.Create;
  R.Value:= A.Value + B;
end;

operator +(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
begin
  AddLog('operator2 +, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  R:=A;
  R.Value:= A.Value + B;
end;

operator +(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
begin
  AddLog('operator3 +, A.Value = ' + IntToStr(A.Value) + ', B.Value = ' + IntToStr(B.Value));
  R:=A;
  R.Value:= A.Value + B.Value;
  B.Free;
end;

operator -(A:IMyClass;B:Integer)R:TMyClassTmp;
begin
  AddLog('operator4 -, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  R:=TMyClassTmp.Create;
  R.Value:= A.Value - B;
end;

operator -(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
begin
  AddLog('operator5 -, A.Value = ' + IntToStr(A.Value) + ', B = ' + IntToStr(B));
  R:=A;
  R.Value:= A.Value - B;
end;

operator -(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
begin
  AddLog('operator6 -, A.Value = ' + IntToStr(A.Value) + ', B.Value = ' + IntToStr(B.Value));
  R:=A;
  R.Value:= A.Value - B.Value;
  B.Free;
end;

operator :=(A:IMyClass)R:Integer;
begin
  AddLog('operator7 :=, A.Value = ' + IntToStr(A.Value));
  R:= A.Value;
end;

operator :=(A:Integer)R:IMyClass;
begin
  AddLog('operator8 :=, A = ' + IntToStr(A));
  R:= TMyClass.Create;
  R.Value:= A;
end;

operator :=(A:TMyClassTmp)R:IMyClass;
begin
  AddLog('operator9 :=, A.Value = ' + IntToStr(A.Value));
  R:= TMyClass.Create;
  R.Value:= A.Value;
  A.Free;
end;

operator :=(A:TMyClassTmp)R:Integer;
begin
  AddLog('operator10 :=, A.Value = ' + IntToStr(A.Value));
  R:= A.Value;
  A.Free;
end;

operator +(A:String; B:IMyClass)R:String;
begin
  AddLog('operator11 :=, A = "' + A+ '", B.Value = ' + IntToStr(B.Value));
  R:= A + IntToStr(B.Value);
end;

operator :=(A:IMyClass)R:String;
begin
  AddLog('operator12 :=, A.Value = ' + IntToStr(A.Value));
  R:= IntToStr(A.Value);
end;

{ TMyClass }

constructor TMyClass.Create;
begin
  Inc(MyClassCount);
  if MaxMyClassCount < MyClassCount then MaxMyClassCount:= MyClassCount;
  inherited Create;
  AddLog('TMyClass.Create, MyClassCount = ' + IntToStr(MyClassCount));
  FValue:= 0;
end;

destructor TMyClass.Destroy;
begin
  AddLog('TMyClass.Destroy, MyClassCount = ' + IntToStr(MyClassCount));
  inherited Destroy;
  Dec(MyClassCount);
  if MyClassCount = 0 then AddLog('MyClassCount = ' + IntToStr(MyClassCount) + ', MaxMyClassCount = ' + IntToStr(MaxMyClassCount));
end;

function TMyClass.GetValue: Integer;
begin
  result:= FValue;
end;

procedure TMyClass.SetValue(Value: Integer);
begin
  FValue:= Value;
end;

{ TMyClassTmp }

constructor TMyClassTmp.Create;
begin
  Inc(MyClassTmpCount);
  if MaxMyClassTmpCount < MyClassTmpCount then MaxMyClassTmpCount:= MyClassTmpCount;
  inherited Create;
  AddLog('TMyClassTmp.Create, MyClassTmpCount = ' + IntToStr(MyClassTmpCount));
  Value:= 0;
end;

destructor TMyClassTmp.Destroy;
begin
  AddLog('TMyClassTmp.Destroy, MyClassTmpCount = ' + IntToStr(MyClassTmpCount));
  inherited Destroy;
  Dec(MyClassTmpCount);
  if MyClassTmpCount = 0 then AddLog('MyClassTmpCount = ' + IntToStr(MyClassTmpCount) + ', MaxMyClassTmpCount = ' + IntToStr(MaxMyClassTmpCount));
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  A,C: IMyClass;
begin
  try
    A:= 10;
//    C:= ((A+2)+3)+4;
//    Memo1.Lines.Add('C = ' + IntToStr(C));
    A := A + (A + 1) + (A + 1);
    C := A + 1 + A;
    Memo1.Lines.Add('C = ' + C);
    Memo1.Lines.Add('(C + 10) = ' + (C + 10));
  finally
    Memo1.Lines.Add('MyClassCount = ' + IntToStr(MyClassCount));
  end;
end;

end.


переделал на спец временный класс, вроде работает.

[runewalsh]

operator +(A:IMyClass;B:Integer)R:TMyClassTmp;

И в простом выражении типа A := A + 1 это будет значить создание (1) временного объекта для суммы и (2) создание нового A из временного. Мой вариант лучше =). Для полного счастья ещё можно интерфейсную ссылку на временный объект хранить как сырой pointer, чтобы не дёргалась почём зря в длинных выражениях, но это уже такое.

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

Для операторов как сахара над функциями нет специальных правил вроде «+0 не имеет эффекта», поэтому, если заинлайнить, integer+0 действительно вырежется, но не остальное тело.