clone ⇒ swap ⇒ edit ⇒ swap

VBAHaskellのC++側APIにふたつの関数を追加した。VBAのクラスインスタンスを操作する時のイディオムである swap と clone を実装するのに使う。
（今回もHaskell的な要素はまったくありません。）

以下ではswap は自身の属性と他のオブジェクトの属性をまるごと入れ替える操作、clone は自身と同じ属性を持つコピーオブジェクトを生成する操作のことを意味する。

自身を元にして新しいオブジェクトを返す関数 new_obj を作る
・クラス名は myClass
・属性を変更するためのPrivateなeditメソッドがある
・ edit は失敗する可能性もあり、その場合は Nothing を返すことにする
・関数呼び出し後、Me には副作用がないようにしたい

これをclone ⇒ swap ⇒ edit ⇒ swapのパターンを用いて実装した例がこちら。swapとcloneは上記APIを使って実装したものと想定している。（冗長にMe.をつけている）

Public Function new_obj() As myClass
    Set new_obj = Me.clone    ' クローンオブジェクトの生成
    Call Me.swap(new_obj)     ' swapでクローンと自分自身を入れ替える
    Dim result As Boolean
    result = Me.edit          ' 自分自身を edit する
    Call Me.swap(new_obj)     ' 2度目のswap。Meは元に戻る
    If result = False Then Set new_obj = Nothing
End Function

この関数から返るのは clone.edit 相当のオブジェクトだが、ここでの edit は Me に対する操作なので Private宣言されていても問題なく呼び出すことができる。途中でオブジェクトの内部状態が壊れてしまった時も2度目のswapによってMeは問題なく現状復帰できる。こういう使い方をするという前提があれば editメソッドは正常系のロジックに専念し、失敗した場合は単にFalseを返せばよくなるので記述がシンプルになる。

他のオブジェクトを受け取ってMeと相互作用する関数を作る
これも同じことで、対象のオブジェクトとMeをswapをすることによってMeに対する操作に置き換えることができる。

Public Function compare(ByVal other As myClass) As ***
    Call Me.swap(other)       ' swapで対象オブジェクトと自分自身を入れ替える
    （ここでotherの属性をMeの属性として取得して何か計算する）
    Call Me.swap(other)       ' 
    Meの属性とotherの属性とを比較した結果を返す
End Function

受け取った他のオブジェクトに副作用を及ぼすことをしないのであればcloneを作る必要はないが、副作用があるならcloneを作っておきcloneとswapすることによって元に戻すことができる。swapとcloneのイディオムによって、クラス内でしか使用しないPrivateメソッドをあえてPublic化する必要は減ると思う。

APIとして追加したcopy_valueMemberとcopy_objectMemberのシグネチャは以下の通り。

// VBAのクラスオブジェクトの特定のメンバ（オブジェクト型以外）を同一クラスの他のオブジェクトにコピーする
VARIANT_BOOL __stdcall copy_valueMember(IDispatch* me, VARIANT* mbr, IDispatch* target, __int32 dir);

// VBAのクラスオブジェクトのオブジェクト型のメンバを同一クラスの他のオブジェクトにコピーする
VARIANT_BOOL __stdcall copy_objectMember(IDispatch* me, IDispatch** pmbr, IDispatch* target, __int32 dir, VARIANT* method);

この関数は新しいファイル classMemberCopy.cpp を追加して入れた。

VBA側でswapとcloneを実装する例がこちら。Declare文は個別の.clsモジュールに宣言し、IDispatch の部分を個別に対象のクラス型に変える必要がある。

' 自分のクラスが "myClass"
' メンバとして "memberClass" のインスタンスを持つ

Private Declare PtrSafe Function copy_valueMember Lib "mapM.dll" _
                                        (ByVal source As myClass, _
                                    ByRef mem As Variant, _
                                ByVal target As myClass, _
                            ByVal direc As Long) As Boolean

Private Declare PtrSafe Function copy_objectMember Lib "mapM.dll" _
                                        (ByVal source As myClass, _
                                    ByRef pmem As memberClass, _
                                ByVal target As myClass, _
                            ByVal direc As Long, _
                        Optional ByRef nm As Variant) As Boolean

Private myValue  As Long
Private myObject As memberClass

' 他のオブジェクトと属性の交換
Private Sub swap(ByVal other As myClass)
    Call copy_valueMember(Me, myValue, other, 0)
    Call copy_objectMember(Me, myObject, other, 0)
End Sub

' 自身のcloneを生成
Private Function clone() As myClass
    Set clone = New myClass
    Call copy_valueMember(Me, myValue, clone, 1)
    Call copy_objectMember(Me, myObject, clone, 1, "clone")
End Function

メンバとして複数のクラスを持つ場合は、copy_objectMember のシノニムを宣言すればいい。