There was some discussion about user-defined class operators in the Delphi non-technical forum. Some folks seem to be asking for operators for heap-allocated classes, but in the absence of either GC or reference counting, these are problematic.
I suggested that records combined with interfaces can get much of the benefit of both worlds: user-defined operators on the record, life-time management via interface reference counting, and arbitrary data sizing through the interface being a heap reference.
To demonstrate the idea through example, I have written up a quick copy-on-write array type that has a user-defined '+' operator that concatenates two lists. Let me build it up from the bottom. First, I've defined a generic dynamic array type to avoid the pitfalls of nominal typing that Delphi has inherited from Pascal (a common newbie mistake, particularly with the syntactic ambiguity with open arrays in parameter lists):
type TArray<T> = array of T;
Next up is the interface. Using an interface for communicating between the record and the heap value means that I get reference counting, and thus lifetime management, for free.
ICowArrayData<T> = interface
function GetLength: Integer;
function MutableClone: ICowArrayData<T>;
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function ToArray: TArray<T>;
end;
TCowArrayData<T> = class(TInterfacedObject, ICowArrayData<T>)
private
FData: TArray<T>;
public
constructor Create(const Data: TArray<T>);
function GetLength: Integer;
function MutableClone: ICowArrayData<T>;
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function ToArray: TArray<T>;
end;
The only "interesting" method really is MutableClone, which I'll be calling to verify that I have a unique instance before I perform any mutating operations. This is necessary to get copy-on-write behaviour. The implementation class doesn't add anything beyond a constructor, as all communication will be through the interface.
Here's the actual record, and the only type that the user of this bundle should concern themselves with:
TCowArray<T> = record
private
FData: ICowArrayData<T>;
function GetItems(Index: Integer): T;
procedure SetItems(Index: Integer; const Value: T);
function GetLength: Integer;
public
constructor Create(const Data: TArray<T>); overload;
constructor Create(const Data: array of T); overload;
property Items[Index: Integer]: T read GetItems write SetItems; default;
property Length: Integer read GetLength;
function ToArray: TArray<T>;
class operator Add(const Left, Right: TCowArray<T>): TCowArray<T>;
end;
It adds a nice default Items property so that values can be indexed like arrays, exposes a Length property much like .NET, and adds in the Add operator to prove the point.
The implementation of most the methods are pretty routine, but a few are important. First up, because interfaces are managed types, they get zero-initialized by default. Thus, we can't expect the record's FData field to be initialized. We can take a leaf out of Delphi's built-in array (and string) types, and let zero-length arrays be represented by a nil FData. That affects the implementation of the record methods, e.g.:
function TCowArray<T>.GetLength: Integer;
begin
if FData = nil then
Exit(0); // nil => zero-length
Result := FData.GetLength;
end;
Another important method is the implementation of the copy-on-write itself. The only mutating method on this type is SetItems, and here it is:
procedure TCowArray<T>.SetItems(Index: Integer; const Value: T); begin FData := FData.MutableClone; FData.SetItem(Index, Value); end;
This isn't particularly efficient, but it does make sure that we have a unique reference when required. The implementation of MutableClone is simple enough too:
function TCowArrayData<T>.MutableClone: ICowArrayData<T>;
begin
if RefCount = 1 then
Exit(Self);
Result := TCowArrayData<T>.Create(ToArray);
end;
Using the inherited RefCount from TInterfacedObject, we can determine safely if we are only referred to by our caller. In a race scenario, where RefCount might e.g. spuriously be 2, there won't be any correctness problem if we duplicate the array anyway.
The implementation of the '+' operator is pretty trivial too:
class operator TCowArray<T>.Add(const Left, Right: TCowArray<T>): TCowArray<T>;
var
resultArr: TArray<T>;
i: Integer;
begin
SetLength(resultArr, Left.Length + Right.Length);
for i := 0 to Left.Length - 1 do
resultArr[i] := Left[i];
for i := 0 to Right.Length - 1 do
resultArr[Left.Length + i] := Right[i];
Result := TCowArray<T>.Create(resultArr);
end;
Finally, let's look at the program body itself, testing these types:
procedure WriteArray(const Msg: string; Arr: TCowArray<Integer>);
var
i: Integer;
begin
Write(Msg, ':');
for i := 0 to Arr.Length - 1 do
Write(' ', Arr[i]);
Writeln;
end;
var
x, y: TCowArray<Integer>;
begin
try
x := TCowArray<Integer>.Create([1, 2, 3]);
y := x;
Writeln('Starting out, both x and y refer to same instance data');
WriteArray('x', x);
WriteArray('y', y);
Writeln('Modifying x; note that y doesn''t change:');
x[1] := 42;
WriteArray('x', x);
WriteArray('y', y);
// Add operator as concatenation
Writeln('Concatenation:');
y := x + y;
WriteArray('x', x);
WriteArray('y', y);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
The output does indeed show that the array is copied on writes, and that concatenation works as expected:
Starting out, both x and y refer to same instance data x: 1 2 3 y: 1 2 3 Modifying x; note that y doesn't change: x: 1 42 3 y: 1 2 3 Concatenation: x: 1 42 3 y: 1 42 3 1 2 3
As an addendum, let me add the full source for reference. Note that due to some bugs in the current compiler's generics implementation for dynamic arrays, the code won't work if it's part of a unit - it needs to be in a single whole for now, unfortunately.
{$apptype console}
uses SysUtils;
type
TArray<T> = array of T;
ICowArrayData<T> = interface
function GetLength: Integer;
function MutableClone: ICowArrayData<T>;
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function ToArray: TArray<T>;
end;
TCowArrayData<T> = class(TInterfacedObject, ICowArrayData<T>)
private
FData: TArray<T>;
public
constructor Create(const Data: TArray<T>);
function GetLength: Integer;
function MutableClone: ICowArrayData<T>;
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function ToArray: TArray<T>;
end;
TCowArray<T> = record
private
FData: ICowArrayData<T>;
function GetItems(Index: Integer): T;
procedure SetItems(Index: Integer; const Value: T);
function GetLength: Integer;
public
constructor Create(const Data: TArray<T>); overload;
constructor Create(const Data: array of T); overload;
property Items[Index: Integer]: T read GetItems write SetItems; default;
property Length: Integer read GetLength;
function ToArray: TArray<T>;
class operator Add(const Left, Right: TCowArray<T>): TCowArray<T>;
end;
{ TCowArray<T> }
class operator TCowArray<T>.Add(const Left, Right: TCowArray<T>): TCowArray<T>;
var
resultArr: TArray<T>;
i: Integer;
begin
SetLength(resultArr, Left.Length + Right.Length);
for i := 0 to Left.Length - 1 do
resultArr[i] := Left[i];
for i := 0 to Right.Length - 1 do
resultArr[Left.Length + i] := Right[i];
Result := TCowArray<T>.Create(resultArr);
end;
constructor TCowArray<T>.Create(const Data: TArray<T>);
begin
if Data = nil then
FData := nil
else
FData := TCowArrayData<T>.Create(Data);
end;
constructor TCowArray<T>.Create(const Data: array of T);
var
arr: TArray<T>;
i: Integer;
begin
if System.Length(Data) = 0 then
FData := nil
else
begin
SetLength(arr, System.Length(Data));
for i := 0 to System.Length(Data) - 1 do
arr[i] := Data[i];
FData := TCowArrayData<T>.Create(arr);
end;
end;
function TCowArray<T>.GetItems(Index: Integer): T;
begin
Result := FData.GetItem(Index);
end;
function TCowArray<T>.GetLength: Integer;
begin
if FData = nil then
Exit(0);
Result := FData.GetLength;
end;
procedure TCowArray<T>.SetItems(Index: Integer; const Value: T);
begin
FData := FData.MutableClone;
FData.SetItem(Index, Value);
end;
function TCowArray<T>.ToArray: TArray<T>;
begin
if FData = nil then
Exit(nil);
Result := FData.ToArray;
end;
{ TCowArrayData<T> }
constructor TCowArrayData<T>.Create(const Data: TArray<T>);
begin
FData := Data;
end;
function TCowArrayData<T>.GetItem(Index: Integer): T;
begin
Result := FData[Index];
end;
function TCowArrayData<T>.GetLength: Integer;
begin
Result := Length(FData);
end;
function TCowArrayData<T>.MutableClone: ICowArrayData<T>;
begin
if RefCount = 1 then
Exit(Self);
Result := TCowArrayData<T>.Create(ToArray);
end;
procedure TCowArrayData<T>.SetItem(Index: Integer; const Value: T);
begin
FData[Index] := Value;
end;
function TCowArrayData<T>.ToArray: TArray<T>;
var
i: Integer;
begin
SetLength(Result, Length(FData));
for i := 0 to Length(FData) - 1 do
Result[i] := FData[i];
end;
procedure WriteArray(const Msg: string; Arr: TCowArray<Integer>);
var
i: Integer;
begin
Write(Msg, ':');
for i := 0 to Arr.Length - 1 do
Write(' ', Arr[i]);
Writeln;
end;
var
x, y: TCowArray<Integer>;
begin
try
x := TCowArray<Integer>.Create([1, 2, 3]);
y := x;
Writeln('Starting out, both x and y refer to same instance data');
WriteArray('x', x);
WriteArray('y', y);
Writeln('Modifying x; note that y doesn''t change:');
x[1] := 42;
WriteArray('x', x);
WriteArray('y', y);
// Add operator as concatenation
Writeln('Concatenation:');
y := x + y;
WriteArray('x', x);
WriteArray('y', y);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
