Модератор: Модераторы
runewalsh писал(а):И в простом выражении типа A := A + 1 это будет значить создание (1) временного объекта для суммы и (2) создание нового A из временного. Мой вариант лучше =). Для полного счастья ещё можно интерфейсную ссылку на временный объект хранить как сырой pointer, чтобы не дёргалась почём зря в длинных выражениях, но это уже такое.
sts писал(а):создается объект
zub писал(а):Зачем из паскаля cpp делать? cpp уже есть
runewalsh писал(а):Ну, идеологически — да, в терминологии обжектпаскаля — нет.
A := 1;
B := 4;
C := (A + B) + (A + B) + (A + B);
D := C + C;
E := C - (B - A);
sts писал(а):память выделяется?
{$mode objfpc} {$h+} {$apptype console} {$modeswitch duplicatelocals} {$typedaddress on}
{-$define UseHeaptrc}
{$define StoreInterfaceAsPointer}
uses
{$ifdef UseHeaptrc} heaptrc, {$endif} Windows;
function QPC: double;
var
c, f: int64;
begin
QueryPerformanceCounter((@c)^);
QueryPerformanceFrequency((@f)^);
result := c/f;
end;
function IntToStr(x: integer): string;
begin
str(x, result);
end;
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;
begin
R:=TMyClassTmp.Create;
R.Value:= A.Value + B;
end;
operator +(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
begin
R:=A;
R.Value:= A.Value + B;
end;
operator +(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
begin
R:=A;
R.Value:= A.Value + B.Value;
B.Free;
end;
operator -(A:IMyClass;B:Integer)R:TMyClassTmp;
begin
R:=TMyClassTmp.Create;
R.Value:= A.Value - B;
end;
operator -(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
begin
R:=A;
R.Value:= A.Value - B;
end;
operator -(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
begin
R:=A;
R.Value:= A.Value - B.Value;
B.Free;
end;
operator :=(A:IMyClass)R:Integer;
begin
R:= A.Value;
end;
operator :=(A:Integer)R:IMyClass;
begin
R:= TMyClass.Create;
R.Value:= A;
end;
operator :=(A:TMyClassTmp)R:IMyClass;
begin
R:= TMyClass.Create;
R.Value:= A.Value;
A.Free;
end;
operator :=(A:TMyClassTmp)R:Integer;
begin
R:= A.Value;
A.Free;
end;
operator :=(A:IMyClass)R:String;
begin
R:= IntToStr(A.Value);
end;
constructor TMyClass.Create;
begin
inherited Create;
FValue:= 0;
end;
destructor TMyClass.Destroy;
begin
inherited Destroy;
end;
function TMyClass.GetValue: Integer;
begin
result:= FValue;
end;
procedure TMyClass.SetValue(Value: Integer);
begin
FValue:= Value;
end;
constructor TMyClassTmp.Create;
begin
inherited Create;
Value:= 0;
end;
destructor TMyClassTmp.Destroy;
begin
inherited Destroy;
end;
type
IXYPair = interface
function GetX: integer; procedure SetX(x: integer);
function GetY: integer; procedure SetY(y: integer);
property X: integer read GetX write SetX;
property Y: integer read GetY write SetY;
function ToString: string;
end;
XYPair = class(TInterfacedObject, IXYPair)
x, y: integer;
constructor Create(x, y: integer);
destructor Destroy; override;
function GetX: integer; procedure SetX(x: integer);
function GetY: integer; procedure SetY(y: integer);
function ToString: string; override;
end;
constructor XYPair.Create(x, y: integer);
begin
inherited Create;
self.x := x;
self.y := y;
end;
destructor XYPair.Destroy;
begin
inherited Destroy;
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;
function XYPair.ToString: string;
begin
result := '(' + IntToStr(x) + ', ' + IntToStr(y) + ')';
end;
type
PassedXYPair = object
ref: {$ifdef StoreInterfaceAsPointer} pointer {$else} IXYPair {$endif};
temp: boolean;
function Make(const ref: IXYPair; temp: boolean): PassedXYPair; static;
function ForceTemp: PassedXYPair;
{$ifdef StoreInterfaceAsPointer} procedure ReleaseOperands(var a, b: PassedXYPair); static; {$endif}
end;
function PassedXYPair.Make(const ref: IXYPair; temp: boolean): PassedXYPair;
begin
{$ifdef StoreInterfaceAsPointer} result.ref := nil; {$endif}
IXYPair(result.ref) := ref;
result.temp := temp;
end;
function PassedXYPair.ForceTemp: PassedXYPair;
var
r: IXYPair absolute ref;
begin
if temp then result := self else result := Make(XYPair.Create(r.X, r.Y), true);
end;
{$ifdef StoreInterfaceAsPointer}
procedure PassedXYPair.ReleaseOperands(var a, b: PassedXYPair);
begin
if not a.temp then IXYPair(a.ref) := nil;
IXYPair(b.ref) := nil;
end;
{$endif}
operator :=(const ref: IXYPair): PassedXYPair;
begin
result := PassedXYPair.Make(ref, {temp =} false);
end;
operator :=(const pair: PassedXYPair): IXYPair;
begin
{$ifdef StoreInterfaceAsPointer}
result := nil; // если результатом является автотип, в FPC он может быть не занулён, а содержать некое валидное старое значение.
pointer(result) := pair.ref; // ссылка уже держалась
{$else}
result := pair.ref;
{$endif}
end;
operator +(a, b: PassedXYPair): PassedXYPair;
var
br: IXYPair absolute b.ref;
rr: IXYPair absolute result.ref;
begin
if b.temp and not a.temp then
result := b + a
else
begin
result := a.ForceTemp;
rr.x := rr.x + br.x;
rr.y := rr.y + br.y;
{$ifdef StoreInterfaceAsPointer} PassedXYPair.ReleaseOperands(a, b); {$endif}
end;
end;
operator -(a, b: PassedXYPair): PassedXYPair;
var
br: IXYPair absolute b.ref;
rr: IXYPair absolute result.ref;
begin
if b.temp and not a.temp then
begin
result := b - a;
rr.x := -rr.x;
rr.y := -rr.y;
end else
begin
result := a.ForceTemp;
rr.x := rr.x - br.x;
rr.y := rr.y - br.y;
{$ifdef StoreInterfaceAsPointer} PassedXYPair.ReleaseOperands(a, b); {$endif}
end;
end;
const
FailCorrect: array[boolean] of string = (' (FAIL)', ' (correct)');
procedure Check1;
var
A, B, C, D, E: IMyClass;
begin
A := 1;
B := 4;
C := (A + B) + (A + B) + (A + B);
D := C + C;
E := C - (B - A);
writeln('A = ', A.Value, ' - expected 1', FailCorrect[A.Value = 1]);
writeln('B = ', B.Value, ' - expected 4', FailCorrect[B.Value = 4]);
writeln('C = ', C.Value, ' - expected 3 x (A+B) = 3 x 5 = 15', FailCorrect[C.Value = 15]);
writeln('D = ', D.Value, ' - expected 30', FailCorrect[D.Value = 30]);
writeln('E = ', E.Value, ' - expected 15 - (4 - 1) = 12', FailCorrect[E.Value = 12]);
writeln('---');
end;
procedure Check2;
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('A = ', A.ToString, ' - expected (1, 2)', FailCorrect[(A.X = 1) and (A.Y = 2)]);
writeln('B = ', B.ToString, ' - expected (3, 4)', FailCorrect[(B.X = 3) and (B.Y = 4)]);
writeln('C = ', C.ToString, ' - expected 3 x (A+B) = 3 x (4, 6) = (12, 18)', FailCorrect[(C.X = 12) and (C.Y = 18)]);
writeln('D = ', D.ToString, ' - expected (24, 36)', FailCorrect[(D.X = 24) and (D.Y = 36)]);
writeln('E = ', E.ToString, ' - expected (12, 18) - ((3, 4) - (1, 2)) = (10, 16)', FailCorrect[(E.X = 10) and (E.Y = 16)]);
writeln('---');
end;
const
Iterations = 1000000;
procedure Bench1;
var
A, B, C, D, E, R: IMyClass;
i: integer;
ok: boolean;
t: double;
begin
write('Bench 1... ');
R := 0;
t := QPC;
for i := 0 to Iterations - 1 do
begin
A := 1;
B := 4;
C := (A + B) + (A + B) + (A + B);
D := C + C;
E := C - (B - A);
R := R + D + E;
end;
t := (QPC - t) / Iterations;
ok := R.Value = (30 + 12) * Iterations;
write('R = ', R.Value, FailCorrect[ok]);
if ok then write(', iteration time: ', 1e6*t:0:2, ' mcs');
writeln;
end;
procedure Bench2;
var
A, B, C, D, E, R, expected: IXYPair;
i: integer;
ok: boolean;
t: double;
begin
write('Bench 2... ');
R := XYPair.Create(0, 0);
t := QPC;
for i := 0 to Iterations - 1 do
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);
R := R + D + E;
end;
t := (QPC - t) / Iterations;
expected := XYPair.Create((24 + 10) * Iterations, (36 + 16) * Iterations);
ok := (R.X = expected.X) and (R.Y = expected.Y);
write('R = ', R.ToString, ' - expected ', expected.ToString, FailCorrect[ok]);
if ok then write(', iteration time: ', 1e6*t:0:2, ' mcs');
writeln;
end;
procedure Run;
begin
Check1;
Check2;
Bench1;
Bench2;
end;
begin
Run;
{$ifdef UseHeaptrc} DumpHeap; {$endif}
readln;
end.
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 GetRefCount : longint;
function ToString : string;
property Value: Integer read GetValue write SetValue;
end;
{ TMyClass }
TMyClass = class(TInterfacedObject, IMyClass)
protected
FValue: Integer;
FText: String;
function GetValue: Integer;
procedure SetValue(Value: Integer);
function GetRefCount : longint;
public
constructor Create;
destructor Destroy; override;
function ToString : string; override;
property Value: integer read FValue write FValue;
property Text: String read FText write FText;
end;
operator +(A:IMyClass;B:Integer)R:TMyClass;
operator +(A:TMyClass;B:Integer)R:TMyClass;
operator +(A:TMyClass;B:TMyClass)R:TMyClass;
operator +(A:IMyClass;B:IMyClass)R:TMyClass;
operator -(A:IMyClass;B:Integer)R:TMyClass;
operator -(A:TMyClass;B:Integer)R:TMyClass;
operator -(A:TMyClass;B:TMyClass)R:TMyClass;
operator :=(A:IMyClass)R:Integer;
operator :=(A:Integer)R:IMyClass;
operator :=(A:TMyClass)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;
FullMyClassCount: integer = 0;
MaxMyClassCount: 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:TMyClass;
begin
AddLog('operator1 +(A:IMyClass;B:Integer)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + IntToStr(B));
R:=TMyClass.Create;
R.Text:='(' + A.ToString + '+' + IntToStr(B) +')';
R.Value:= A.Value + B;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator +(A:TMyClass;B:Integer)R:TMyClass;
begin
AddLog('operator2 +(A:TMyClass;B:Integer)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog('B = ' + IntToStr(B));
R:=A;
R.Text:='(' + A.ToString + '+' + IntToStr(B) +')';
R.Value:= A.Value + B;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator +(A:TMyClass;B:TMyClass)R:TMyClass;
begin
AddLog('operator3 +(A:TMyClass;B:TMyClass)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
R:=A;
R.Text:='(' + A.ToString + '+' + B.ToString +')';
R.Value:= A.Value + B.Value;
B.Free;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator +(A:IMyClass;B:IMyClass)R:TMyClass;
begin
AddLog('operator4 +(A:IMyClass;B:IMyClass)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
R:=TMyClass.Create;
R.Text:='(' + A.ToString + '+' + B.ToString +')';
R.Value:= A.Value + B.Value;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator -(A:IMyClass;B:Integer)R:TMyClass;
begin
AddLog('operator5 -(A:IMyClass;B:Integer)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + IntToStr(B));
R:=TMyClass.Create;
R.Text:='(' + A.ToString + '-' + IntToStr(B) +')';
R.Value:= A.Value - B;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator -(A:TMyClass;B:Integer)R:TMyClass;
begin
AddLog('operator6 -(A:TMyClass;B:Integer)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + IntToStr(B));
R:=A;
R.Text:='(' + A.ToString + '-' + IntToStr(B) +')';
R.Value:= A.Value - B;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator -(A:TMyClass;B:TMyClass)R:TMyClass;
begin
AddLog('operator7 -(A:TMyClass;B:TMyClass)R:TMyClass');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
AddLog(' B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
R:=A;
R.Text:='(' + A.ToString + '-' + B.ToString +')';
R.Value:= A.Value - B.Value;
B.Free;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator :=(A:IMyClass)R:Integer;
begin
AddLog('operator8 :=(A:IMyClass)R:Integer');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
R:= A.Value;
AddLog(' R:' + IntToStr(R));
end;
operator :=(A:Integer)R:IMyClass;
begin
AddLog('operator9 :=(A:Integer)R:IMyClass');
AddLog(' A:' + IntToStr(A));
R:= TMyClass.Create;
R.Value:= A;
AddLog(' R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;
operator :=(A:TMyClass)R:Integer;
begin
AddLog('operator10 :=(A:TMyClass)R:Integer');
AddLog(' A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
R:= A.Value;
A.Free;
AddLog(' R:' + IntToStr(R));
end;
operator +(A:String; B:IMyClass)R:String;
begin
R:= A + IntToStr(B.Value);
end;
operator :=(A:IMyClass)R:String;
begin
R:= IntToStr(A.Value);
end;
{ TMyClass }
constructor TMyClass.Create;
begin
Inc(MyClassCount);
Inc(FullMyClassCount);
if MaxMyClassCount < MyClassCount then MaxMyClassCount:= MyClassCount;
inherited Create;
AddLog('TMyClass.Create, MyClassCount = ' + IntToStr(MyClassCount));
FValue:= 0;
end;
destructor TMyClass.Destroy;
begin
AddLog('TMyClass.Destroy, ' + ToString + ', Value = ' + IntToStr(FValue) + ', MyClassCount = ' + IntToStr(MyClassCount));
inherited Destroy;
Dec(MyClassCount);
if MyClassCount = 0 then AddLog('MyClassCount = ' + IntToStr(MyClassCount) + ', MaxMyClassCount = ' + IntToStr(MaxMyClassCount));
end;
function TMyClass.ToString: string;
begin
if FText = '' then
result:= IntToStr(FValue)
else
result:= FText;
end;
function TMyClass.GetValue: Integer;
begin
result:= FValue;
end;
procedure TMyClass.SetValue(Value: Integer);
begin
FValue:= Value;
end;
function TMyClass.GetRefCount : longint;
begin
result:= RefCount;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
A,B,C,D,E: IMyClass;
begin
try
//A:= 10;
//C:= ((A+2)+3)+4;
//Memo1.Lines.Add('C = ' + IntToStr(C));
//A := 10;
//A := A + (A + 1) + (A + 1);
//C := A + 1 + A;
//Memo1.Lines.Add('C = ' + C);
//Memo1.Lines.Add('(C + 10) = ' + (C + 10));
// A := 10;
// A := A + (A + 1);
// A := (A + 1) + (A + 1);
// A := A + (A + 1) + (A + 1);
// Memo1.Lines.Add('A = ' + A);
//A := 1;
//A := A + 1;
//Memo1.Lines.Add('A = ' + A);
A := 1;
B := 4;
C := (A + B) + (A + B) + (A + B);
D := C + C;
E := C - (B - A);
Memo1.Lines.Add('A = ' + A);
Memo1.Lines.Add('B = ' + B);
Memo1.Lines.Add('C = ' + C);
Memo1.Lines.Add('D = ' + D);
Memo1.Lines.Add('E = ' + E);
finally
Memo1.Lines.Add('FullMyClassCount = ' + IntToStr(FullMyClassCount));
end;
end;
end.
popoveo писал(а):Программист в данной ситуации не может контролировать работу с памятью, в то время как синтаксис и семантика языка позволяют написать некорректные выражения. В своем коде, конечно, знаешь ограничения и ошибок не сделаешь. А если пишешь код для сторонних лиц?
popoveo писал(а):Так почему этого нет при использовании перегрузки операторов для классов? Опять логическая нестыковка...
popoveo писал(а):Почему в таком же временном выражении при создании перечислителя у последнего вызывается деструктор после отработки цикла, а при использовании операторов - нет? Где здесь логика? Подобные вещи должны обрабатываться однотипно.
popoveo писал(а):По поводу алгоритмов, когда мы считаем переданный аргумент созданным и уменьшаем количество ссылок: это не пройдет, если в середину выражения передается экземпляр класса, который уже есть в группе (группах) и на него уже созданы ссылки.
popoveo писал(а):Почему в таком же временном выражении при создании перечислителя у последнего вызывается деструктор после отработки цикла, а при использовании операторов - нет? Где здесь логика? Подобные вещи должны обрабатываться однотипно.
runewalsh писал(а):Операторы могут быть не только для классов, поэтому как раз правило «если операнд — экземпляр класса, он автоматически уничтожается» было бы странным. Тогда как энумераторы (или, скажем, исключения, тоже управляемые автоматически) — всегда экземпляры классов.
runewalsh писал(а):Хотя я бы сам не отказался от такого правила, наряду с чем-нибудь типа «в отсутствие модификатора структурам и автотипам в списке параметров автоматически приписывается const» — тоже на первый взгляд НЕПОСЛЕДОВАТЕЛЬНО, но если подумать...
popoveo писал(а):По поводу алгоритмов, когда мы считаем переданный аргумент созданным и уменьшаем количество ссылок: это не пройдет, если в середину выражения передается экземпляр класса, который уже есть в группе (группах) и на него уже созданы ссылки.
runewalsh писал(а):Ты не понял. Не созданным, а «захваченным» (инкрементнутым). При передачё счётчик увеличивается , внутри оператора — уменьшается. Раз ссылки держались где-то ещё, счётчик останется >0 и объект не уничтожится. И наоборот, если объект создан на месте, у него будет счётчик = 1, внутри оператора он декрементируется до 0 и уничтожится. С интерфейсными ссылками всё это происходит автоматически.
popoveo писал(а):как не пытайся, но не сможешь отследить временное это выражение или нет. Тоже об этом писал, нет способов решения на текущий момент, можно обработать только частные случаи.
popoveo писал(а):"A" входит в пару групп, количество ссылок, например, 2. Просто вот так: B:=(A+A)+(A+A); Здесь логическая нестыковка - как не пытайся, но не сможешь отследить временное это выражение или нет.
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 49