Вопрос про освобождение памяти при перегрузке операторов
Модератор: Модераторы
Вопрос про освобождение памяти при перегрузке операторов
Здравствуйте. Есть класс TMyClass. Для него перегружен оператор +:
operator +(A:TMyClass;B:Byte)R:TMyClass;
begin
R:=TMyClass.Create;
//что-то делаем...
end
Как освобождать память в выражениях вида C:=((A+2)+3)+4, где A+2 создаст TMyClass, (A+2)+3 создаст еще один класс... Ведь деструкторы автоматически не запустятся...
Есть ли вообще какая-либо методика высвобождения памяти в данном случае или возможно только ограничиться одним действием в выражении и прибивать полученные классы руками?
operator +(A:TMyClass;B:Byte)R:TMyClass;
begin
R:=TMyClass.Create;
//что-то делаем...
end
Как освобождать память в выражениях вида C:=((A+2)+3)+4, где A+2 создаст TMyClass, (A+2)+3 создаст еще один класс... Ведь деструкторы автоматически не запустятся...
Есть ли вообще какая-либо методика высвобождения памяти в данном случае или возможно только ограничиться одним действием в выражении и прибивать полученные классы руками?
А хрен его знает. Используй 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.
Последний раз редактировалось runewalsh 25.12.2016 04:55:47, всего редактировалось 1 раз.
popoveo писал(а):Ведь деструкторы автоматически не запустятся...
А собственно почему? Динамические строки внутри класса автоматически освобождают память при убиении оного класса, хотя и с задержкой, о чем сам убедился загоняя в них монструозных размеров HTML страницы.
runewalsh писал(а):свой подсчёт ссылок
И что произойдёт в выражении A := B + C в предложенном коде? B и C будут не только сложены, но и освобождены?
Поэтому там и Acquire. Руками красиво не сделаешь. Ну, хотя бы семантику можно более-менее согласованно выстроить: ссылку аквайрит передающий (в т. ч. возвращающий, как частный случай — после конструктора объект автоматически аквайрнут), освобождает тот, кому передали.
а не проще отказаться от перегрузки операторов? 
методы или простые процедуры и функции... помощники классов... всё это предсказуемее работает.
методы или простые процедуры и функции... помощники классов... всё это предсказуемее работает.
Объекты вместо классов и подсчет ссылок рассматривал. К сожалению, не подходит ни то, ни другое. Первое - потому что внутри классов, над которыми перегружаем операторы, есть динамически выделяемая память (все равно нужно отловить момент уничтожения объекта). Второй вариант также не подходит, т.к. опять не понятно, где увеличивать и уменьшать количество ссылок. Все же реализовал второй вариант с костылями: во всех операторах запихиваю созданный класс в группу - статический член этого класса, увеличиваю количество ссылок в экземпляре. После вычисления выражения добавляю еще ссылку, если результат нужен. Потом очищаю группу: уменьшаю у всех элементов количество ссылок. Ненужные (где была одна ссылка) погибают. Но это синтаксически тоже некрасиво и также может привести к ошибкам. Получается что-то типа: 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). Тоже самое.
popoveo писал(а): опять не понятно, где увеличивать и уменьшать количество ссылок
При любой передаче объекта «по значению», а тот, кому передали, уменьшает, когда закончит работать. В частности: функция ожидает аргументы инкрементнутыми и освобождает их; если функция возвращает объект, она инкрементирует его счётчик, а когда вызвавший закончит с ним работать — декрементирует; конструкторы всегда возвращают объект со счётчиком = 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-ссылку на объект, созданный на месте (здесь операнды такими и являются), его счётчик никогда не увеличится с нуля, соответственно, не уменьшится и объект утечёт. Это не считая того, что подсчёт ссылок работает только для переменных интерфейсного типа, а не классового, поэтому, единожды отдав класс в интерфейсную переменную, в дальнейшем с ним можно работать только через интерфейсы.
popoveo писал(а):Отказ от операторов тоже рассматривал, но как это решает проблему промежуточных результатов? 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 всё ещё не поддерживаются :)
а зачем вы создаете новый экземпляр объекта? (а ну да уже написали об этом)
Добавлено спустя 20 минут 12 секунд:
в общем решение есть надо проверять, в общих чертах, надо сохранять ссылки на созданные в операторах промежуточные объекты и зачищать их в операторе :=
думаю идея понятна...
Добавлено спустя 13 минут 11 секунд:
ща расчехлю фрипаскаль- проверю
Добавлено спустя 24 минуты 17 секунд:
мда неожиданно
Добавлено спустя 29 минут 54 секунды:
Добавлено спустя 57 секунд:
Добавлено спустя 5 минут 3 секунды:
в общем перегрузка хороша тем что ненужно .Create делать в A:= 10; осталось еще от A.Free; избавиться.
Добавлено спустя 26 минут 3 секунды:
во, самый безглючный вариант
Добавлено спустя 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.
Идея с временными объектами хорошая, но в таком виде очень рискованная.
Твой код легко ломается, например:
Ящитаю, лучше всего разрулить отдельным типом для временных объектов.
Твой код легко ломается, например:
Код: Выделить всё
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.- Лекс Айрин
- долгожитель
- Сообщения: 5723
- Зарегистрирован: 19.02.2013 16:54:51
- Откуда: Волгоград
- Контактная информация:
runewalsh писал(а):A := A + 0; // теперь A считается временным
этот код, кстати, должен резаться оптимизатором еще на этапе первичного анализа.
runewalsh писал(а):Идея с временными объектами хорошая, но в таком виде очень рискованная.
да, просмотрел.
удивление вызвало то что нельзя перекрыть
Код: Выделить всё
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.
переделал на спец временный класс, вроде работает.
sts писал(а):operator +(A:IMyClass;B:Integer)R:TMyClassTmp;
И в простом выражении типа A := A + 1 это будет значить создание (1) временного объекта для суммы и (2) создание нового A из временного. Мой вариант лучше =). Для полного счастья ещё можно интерфейсную ссылку на временный объект хранить как сырой pointer, чтобы не дёргалась почём зря в длинных выражениях, но это уже такое.
Лекс Айрин писал(а):этот код, кстати, должен резаться оптимизатором еще на этапе первичного анализа.
Для операторов как сахара над функциями нет специальных правил вроде «+0 не имеет эффекта», поэтому, если заинлайнить, integer+0 действительно вырежется, но не остальное тело.
Последний раз редактировалось runewalsh 29.12.2016 18:10:38, всего редактировалось 2 раза.
