{$mode delphi}
{ Copy on write example based on code by Barry Kelly }
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
Result:=[];
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.