このアーティクルは
Delphi Advent Calendar 2015の14日目の記事です(3年ぶり3回目)。
Delphiの特徴的な型として
集合型というものがあります。これは基底型となる
列挙型、
部分範囲型の組み合わせを保持できるというもので、C言語の
ビットフィールドに相当するものですが、各種演算子などが用意されており、非常に便利な言語機能です。しかし集合型にはその基底型の要素数が256以下、正確には順序値として0から255まで、という制約があります。しかし状況によっては256要素を超えるような、あるいは基底型で負値となるものを含むような集合型が欲しいということがあります。そこで既存の集合型になるべく近い形で実装してみることにします。ただしDelphiの
ジェネリックスはC++のテンプレートとは実装が異なり文法的制約が厳しい(というか値型にはほぼ使えない)ため、ジェネリックスによる汎用の実装ではなく個別の実装になってしまいます。また本来の集合型と同様に使えるよう、参照型(クラスによる実装)ではなく値型である
高度なレコード型による実装とします。
まず基底型となる列挙型を定義します。
type
TFoo = (Foo0 = -1,
Foo1,
Foo2,
Foo3,
Foo4,
Foo5,
FooMax = 256);
順序値が-1から256なのでこれを基底型とする集合型を定義すると
type
TFooSet = set of TFoo; // Error: E2028 Sets may have at most 256 elements
(当然ですが)エラーになります。では代替となる高度なレコード型を定義していきます。
const
BYTE_BIT = 8; // Number of bits in byte
type
TFooSet = record
private
FData: array [0..((Ord(High(TFoo)) - Ord(Low(TFoo)) + 1 + (BYTE_BIT - 1)) div BYTE_BIT) - 1] of Byte;
public
procedure Empty;
function IsEmpty: Boolean;
end;
procedure TFooSet.Empty;
begin
FillChar(FData[0],SizeOf(FData),0);
end;
function TFooSet.IsEmpty: Boolean;
var
Offset: Integer;
begin
Result := False;
for Offset := Low(FData) to High(FData) do
begin
if FData[Offset] <> 0 then
begin
Result := True;
Exit;
end;
end;
end;
FDataは基底型に対応したビット列を実際に格納する領域で、Emptyはその領域を0クリアするメソッド、IsEmptyはビット列が全て0となっているかどうかをチェックするメソッドです。
次に基底型に対応する要素を追加、削除するメソッド(Include、Exclude)です。単独の要素、複数の要素(array of)のどちらにも対応します。
type
TFooSet = record
private
...
class procedure CalcOffsets(Value: TFoo; var AOffset: Integer; var ABit: Byte); static;
public
...
procedure Include(Value: TFoo); overload;
procedure Include(const Values: array of TFoo); overload;
procedure Exclude(Value: TFoo); overload;
procedure Exclude(const Values: array of TFoo); overload;
end;
procedure TFooSet.Include(Value: TFoo);
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
FData[Offset] := FData[Offset] or Bit;
end;
procedure TFooSet.Include(const Values: array of TFoo);
var
Value: TFoo;
begin
if Length(Values) > 0 then
begin
for Value in Values do
begin
Include(Value);
end;
end;
end;
procedure TFooSet.Exclude(Value: TFoo);
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
FData[Offset] := FData[Offset] and (not Bit);
end;
procedure TFooSet.Exclude(const Values: array of TFoo);
var
Value: TFoo;
begin
for Value in Values do
begin
Exclude(Value);
end;
end;
class procedure TFooSet.CalcOffsets(Value: TFoo; var AOffset: Integer; var ABit: Byte);
var
RelPos: Integer;
begin
RelPos := Ord(Value) - Ord(Low(TFoo));
AOffset := RelPos div BYTE_BIT;
ABit := 1 shl (RelPos mod BYTE_BIT);
end;
CalcOffsetsは基底型の要素がどのビット位置に割り当てられているのかを計算します。
次は基底型の要素が含まれているかどうかを調べるInメソッドです。Inは
予約語のため
"&"で修飾します。
type
TFooSet = record
...
public
...
function &In(Value: TFoo): Boolean;
end;
function TFooSet.&In(Value: TFoo): Boolean;
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
Result := (FData[Offset] and Bit) <> 0;
end;
あとは何らかの形で文字列化できないと不便なので、16進文字列化するToStringと16進文字列からレコード型に値を入れるParseを用意します。
type
TFooSet = record
...
public
...
function ToString(ZeroSuppression: Boolean = True): String;
class function Parse(const Value: String): TFooSet; static;
end;
function TFooSet.ToString(ZeroSuppression: Boolean): String;
var
Index: Integer;
Len: Integer;
Offset: Integer;
begin
Result := '';
for Offset := Low(FData) to High(FData) do
begin
Result := IntToHex(FData[Offset],2) + Result;
end;
if ZeroSuppression = True then
begin
Index := 1;
Len := Length(Result);
while (Index < Len) and (Result[Index] = '0') do
begin
Index := Index + 1;
end;
if Index > 1 then
begin
Delete(Result,1,Index - 1);
end;
end;
end;
class function TFooSet.Parse(const Value: String): TFooSet;
var
Offset: Integer;
S: String;
begin
Result.Clear;
S := StringOfChar('0',(SizeOf(Result.FData) * 2) - Length(Value)) + Value;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := StrToInt('$' + Copy(S,(SizeOf(Result.FData) * 2) - (Offset * 2) - 1,2));
end;
end;
必要な処理はこれで概ね揃いましたが、まだ既存の集合型と同じように使う、というわけにはいきません。そこで
演算子オーバロードを用意します。
集合型に対応する演算子には"+"(和集合)、"-"(差集合)、"*"(積集合)、"<="(サブセット)。">="(スーパーセット)、"="(等しい)、"<>"(等しくない)、"in"(メンバかどうか)の8つがあります。まず基底型の配列からの暗黙的な型キャストを行うImplicitと、"+"(class operator Add)、"-"(class operator Subtract)、"*"(class operator Multiply)の3つの演算子オーバロードです。
type
TFooSet = record
...
public
...
{$IF CompilerVersion>=24.00}
class operator Implicit(const Values: array of TFoo): TFooSet;
{$IFEND}
class operator Add(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Add(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
class operator Subtract(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Subtract(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
class operator Multiply(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Multiply(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
end;
{$IF CompilerVersion>=24.00}
class operator TFooSet.Implicit(const Values: array of TFoo): TFooSet;
begin
Result.Clear;
Result.Include(Values);
end;
{$IFEND}
class operator TFooSet.Add(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] or rvalue.FData[Offset];
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Add(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
var
Value: TFoo;
begin
Result := lvalue;
for Value in rvalue do
begin
Result.Include(Value);
end;
end;
{$IFEND}
class operator TFooSet.Subtract(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] and (not rvalue.FData[Offset]);
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Subtract(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
var
Value: TFoo;
begin
Result := lvalue;
for Value in rvalue do
begin
Result.Exclude(Value);
end;
end;
{$IFEND}
class operator TFooSet.Multiply(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] and rvalue.FData[Offset];
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Multiply(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
begin
Result := lvalue * TFooSet(rvalue);
end;
{$IFEND}
ここで明示的な型キャストを行うExplicitを用意しなかったのは、"TFooSet([Foo0,Foo2])"の"[Foo0,Foo2]"の部分がarray of TFooではなくset of TFooと解釈されてしまいコンパイルエラー(
E1012)となる問題を解決できなかったためです。また同様の理由からImplicitはXE3以降、Add/Subtract/Multiplyの2番目のoverload(右項がarray of TFoo)はXE7以降のみ有効です。
次に"<="(class operator LessThanOrEqual)。">="(class operator GreaterThanOrEqual)、"="(class operator Equal)、"<>"(class operator NotEqual)、"in"(class operator In)です。
type
TFooSet = record
...
public
...
class operator LessThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator GreaterThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator Equal(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator NotEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator In(lvalue: TFoo; const rvalue: TFooSet): Boolean;
end;
class operator TFooSet.LessThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] and rvalue.FData[Offset]) <> lvalue.FData[Offset] then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.GreaterThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] and rvalue.FData[Offset]) <> rvalue.FData[Offset] then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.Equal(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] xor rvalue.FData[Offset]) <> 0 then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.NotEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
begin
Result := not (lvalue = rvalue);
end;
class operator TFooSet.In(lvalue: TFoo; const rvalue: TFooSet): Boolean;
begin
Result := rvalue.&In(lvalue);
end;
ここでclass operator LessThanOrEqual/GreaterThanOrEqual/Equal/NotEqualにAdd/Subtract/Multiplyのようにarray of TFooを第2パラメータ(右項)とするものを用意しなかったのもExplicitと同様の理由です。
これでTFooSetに対する演算子も一通り揃いました。残るはfor-inループ構造への対応です。必要なものは
for 文を使用するコンテナの繰り返しにあるように、Booleanを返し次の値を指し示すMoveNextメソッドとコレクションに含まれる値を返すCurrentプロパティとを持つようなクラス、インタフェース、レコードのいずれかを返すGetEnumeratorメソッド、ということになります。ここではネストした形でクラスを定義します。
type
PFooSet = ^TFooSet;
TFooSet = record
private
type
TEnumerator = class(TObject)
private
FContainer: PFooSet;
FIndex: Integer;
function GetCurrent: TFoo;
public
constructor Create(Container: PFooSet);
function MoveNext: Boolean;
property Current: TFoo
read GetCurrent;
end;
public
...
function GetEnumerator: TEnumerator;
end;
function TFooSet.GetEnumerator: TEnumerator;
begin
Result := TEnumerator.Create(@Self);
end;
constructor TFooSet.TEnumerator.Create(Container: PFooSet);
begin
inherited Create;
FIndex := Ord(Low(TFoo)) - 1;
FContainer := Container;
end;
function TFooSet.TEnumerator.MoveNext: Boolean;
begin
while (FIndex < Ord(High(TFoo))) do
begin
FIndex := FIndex + 1;
if TFoo(FIndex) in FContainer^ then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
function TFooSet.TEnumerator.GetCurrent: TFoo;
begin
Result := TFoo(FIndex);
end;
これでTFooSetに対して通常の集合型のように"+"、"-"、"*"のような演算や"="、"<>"のような比較、for..inによる要素の取り出しを行うことができるようになりました。
同様にすることで部分範囲型で値が0..255に収まらないようなものを基底型とするような集合型も実装することができます。
→
要素数が256を超える列挙型の集合型(Gist)
→
値範囲が0..255に収まらない部分範囲型の集合型(Gist)
