{$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.