[Delphi] カスタム管理レコードを使ったスマートポインタ

カスタム管理レコード

Delphi 10.4 で待望の(？) Custom Managed Record（カスタム管理レコード）が追加されました。

大雑把に言うといくつかの演算子が追加され、その呼び出しが自動化されたもの、です。
具体的には

• class operator Initialize (out Dest: TMyRecord);
• class operator Finalize (var Dest: TMyRecord);
• class operator Assign (var Dest: TMyRecord; const [ref] Src: TMyRecord);

の３つの演算子が追加されました。
それぞれを見ていきます。

Intialize & Finalize

Initialize は初期化演算子で、レコードが定義されたときに呼び出されます。
Finalize は終了処理演算子で、レコードが廃棄されるときに呼び出されます。

ということで、Initialize, Finalize を組み込んだ TFooRec というレコードを定義してみました。

type
  TFooRec = record
  private var
    FBar: Integer;
  public
    class operator Initialize(out ADest: TFooRec);
    class operator Finalize(var ADest: TFooRec);
  end;

class operator TFooRec.Initialize(out ADest: TFooRec);
begin
  ADest.FBar := 10; // 初期化
end;

class operator TFooRec.Finalize(var ADest: TFooRec);
begin
  ADest.FBar := 0; // 終了時呼び出されるが、ここで値を設定する意味は特に無い
end;

それぞれ、引数で対象のインスタンスが渡されるので、そのインスタンスに対して操作します。
Initialize, Finalize 片方だけの宣言でも大丈夫です。

では、実際に TFooRec を使うコードを書いてみます。

procedure Baz;
var
  Rec: TFooRec; 
begin
  // begin の直後に Rec.Initialize の呼び出しが走る
  Writeln(Rec.FBar); // Initialize で 10 に初期化されているため、10 が出力される
end; // この end のタイミングで Rec.Finalize の呼び出しが走る

上記のコードは record の定義と Writeln だけですが、このコードから生成されたマシンコード(Windows x86)を見てみると…

CMRSample.dpr.57: begin
004F12E0 55               push ebp
004F12E1 8BEC             mov ebp,esp
004F12E3 51               push ecx
004F12E4 8D45FC           lea eax,[ebp-$04]
004F12E7 E8CCFFFFFF       call TFooRec.&op_Initialize // ここ
～中略～
CMRSample.dpr.58: Writeln(Rec.FBar);
～中略～
CMRSample.dpr.59: end;
004F131E 8D45FC           lea eax,[ebp-$04]
004F1321 E8A6FFFFFF       call TFooRec.&op_Finalize // ここ
004F1326 C3               ret 

こんな風になっています。
最初に述べた通り、定義のタイミングと廃棄のタイミングで自動的に呼び出されているのが判りますね。

今までの record でも constructor は定義できました。しかし、destructor は定義できませんでした。
カスタム管理レコードでは Finalize を destructor として使用できます。

そして従来の record と決定的に違うのは、自動的に呼び出されるということです。
これが非常に重要です。

例えば…

procedure Baz;
var
  Rec: TFooRec;
begin
  // 何か処理
  raise Exception.Create('何かエラー');
end;

という具合に例外が発生するとそのままコードを抜けてしまうため、今までの record では何もされませんが、カスタム管理レコードならこのような場合でも Finalize が呼び出されるため、かならず終了処理を実行できるのです！

では、もう少しバリエーションを見てみます。

インライン定義

procedure InilineSample;
begin
  var Rec: TRec; // ここで Initialize が呼ばれ、スコープを抜けるときに Finalize が呼ばれる
end;

静的配列

procedure ArraySample;
var
  Rec: array [0.. 9] of TRec;
begin
  // ここで各要素の Initialize が呼ばれ、スコープを抜けるときに各要素の Finalize が呼ばれる
end;

動的配列

procedure DynArraySample;
begin
  var Rec: TArray<TRec>;
  SetLengh(Rec); // メモリを確保するときに各要素の Initialize が呼ばれ、スコープを抜けるときに 各要素の Finalize が呼ばれる
end;

Assign

Assign は代入演算子です。
通常の record の代入は各フィールドの値がコピーされますが、カスタム管理レコードでは、その処理を自由に変更できます。
先ほどの TFooRec に Assign を追加してみると…

class operator TFooRec.Assign(var ADest: TFooRec; const [ref] ASrc: TFooRec);
begin
  ADest.FBar := ASrc.FBar + 10; // 自身の値 + 10 を代入する
end;

procedure Baz;
var
  Rec: TFooRec;
begin
  Writeln(Rec.FBar);
  var Rec2 := Rec; // ここで Assign が呼ばれる
  Writeln(Rec2.FBar);
end;

実行結果

10
20

こんな風に代入時に Assign が自動的に呼び出され、処理内容を変更できます。
そして、この仕組みは関数の引数にレコードを値渡したときも実行されます。

procedure Qux(ARec: TFooRec);
begin
  Writeln(ARec.FBar);
  var Rec2 := ARec;
  Writeln(Rec2.FBar);
end;

実行結果

20
30

引数に値渡しされるときも Assign のコードが実行されるため ARec は既に値が 20 になっています。
値渡し以外はどうなるかというと、DocWiki に詳しく書いてあるとおりで

// Assign が呼ばれる
procedure Proc(ARec: TFooRec); 

// Assign が呼ばれない
procedure Proc(const ARec: TFooRec);
procedure Proc(var ARec: TFooRec);
procedure Proc(out ARec: TFooRec);

となります。
つまり参照渡しの場合は何もしないということです。

これに関連して record を返す関数の場合は

function Func: TFooRec;

最初に Initialize が呼ばれ、次に代入先があった場合は Assign と Finalize が呼ばれます。

// Initialize が呼ばれたあと Assign が呼ばれ、Func の戻値の Finalize が呼ばれる
var Rec := Func; 

と、これを踏まえてのスマートポインタです。

スマートポインタ

Initialize / Finalize の機能を使ってスマートポインタを簡単に実装できます。
例えば

type
  TSmartPointer<T: TPersistent, constructor> = record
  strict private var
    FValue: T;
  public
    class operator Initialize(out ADest: TSmartPointer<T>);
    class operator Finalize(var ADest: TSmartPointer<T>);
    class operator Assign(
      var ADest: TSmartPointer<T>;
      const [ref] ASrc: TSmartPointer<T>);
    class operator Implicit(const AValue: T): TSmartPointer<T>;
    class operator Implicit(const ASmartPtr: TSmartPointer<T>): T;
  public
    property Value: T read FValue;
  end;

class operator TSmartPointer<T>.Initialize(out ADest: TSmartPointer<T>);
begin
  ADest.FValue := T.Create;
end;

class operator TSmartPointer<T>.Finalize(var ADest: TSmartPointer<T>);
begin
  ADest.FValue.Free;
end;

class operator TSmartPointer<T>.Assign(
  var ADest: TSmartPointer<T>;
  const [ref] ASrc: TSmartPointer<T>);
begin
  ADest.FValue.Assign(ASrc.FValue);
end;

class operator TSmartPointer<T>.Implicit(const AValue: T): TSmartPointer<T>;
begin
  Result.FValue.Assign(AValue);
end;

class operator TSmartPointer<T>.Implicit(const ASmartPtr: TSmartPointer<T>): T;
begin
  Result := ASmartPtr.FValue;
end;

こんな感じです。
今回は Assign / Implicit 演算子内で TPersistent.Assign を使うために TPersistent から派生しているクラスに限定しました。
また、Implicit は以前からある暗黙の型変換の演算子で、代入時の自動型変換を担います。

この TSmartPointer を使った実際のコードが↓です。

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Add('Hello, ');

  var SL: TSmartPointer<TStringList>; // Initialize で TStringList のインスタンスが生成される
  SL := TStringList(Memo1.Lines); // Implicit で代入 (Memo1.Lines は TStrings なので型変換している)
  SL.Value.Add('Custom Managed Record!');
  Memo1.Lines := SL; // Implicit で代入
  // Finalize で TStringList のインスタンスが廃棄される
end;

実行結果

こんなに簡単にスマートポインタが実装できました！

※ちなみに、この Style は DelphiStyles の ClearCerulean というものです。
気に入ったらみんな買ってあげてね！

まとめ

今回紹介した SmartPointer は、そのままでは 10.4 Sydney から廃止された ARC の代替とまではいきませんが、カスタム管理レコードはアイデア次第で色々なことができそうです。