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)
0 件のコメント:
コメントを投稿