7

のDelphi XE2のヘルプではSystem.Generics.Collections.TArray.Sort、それは言う

Note: If the Comparer parameter is provided, it is used to compare elements; otherwise the default comparator for the array elements is used. 

少し掘り下げたところ、 のデフォルトのコンパレータTArray.Sort_LookupVtableInfofromであることがわかりましたSystem.Generics.Defaults。このコードは

function _LookupVtableInfo(intf: TDefaultGenericInterface; info: PTypeInfo; size: Integer): Pointer;
var
  pinfo: PVtableInfo;
begin
  if info <> nil then
  begin
    pinfo := @VtableInfo[intf, info^.Kind];
    Result := pinfo^.Data;
    if ifSelector in pinfo^.Flags then
      Result := TTypeInfoSelector(Result)(info, size);
    if ifVariableSize in pinfo^.Flags then
      Result := MakeInstance(Result, size);
  end
  else
  begin
    case intf of
      giComparer: Result := Comparer_Selector_Binary(info, size);
      giEqualityComparer: Result := EqualityComparer_Selector_Binary(info, size);
    else
      System.Error(reRangeError);
      Result := nil;
    end;
  end;
end;

と呼ばれています

IComparer<T>(_LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T)))

私はこれをかなり見てきましたが、それが何をしているのか本当によくわかりません。メモリ内のビットを互いに比較するだけですか、それとも正確には何ですか?

質問の 2 番目の部分は、実際にデフォルトのコンパレーターを使用する可能性が高い状況、または実際に使用する可能性が低い状況の、より一般化されたものです。

4

3 に答える 3

5

そこに投稿した関数は、実際には比較関数ではなく、TypeInfo と SizeOf T に基づいて比較関数を返す関数です。

それをさらに深くたどると、Generics.Defaults には次の形式の多くの関数が表示されます。

function Compare_型の名前(Inst: Pointer; const Left, Right:Type): Integer;

これらはすべて同じ本体を持っています (ただし、左右のタイプが異なることに注意してください)

begin
  if Left < Right then
    Result := -1
  else if Left > Right then
    Result := 1
  else
    Result := 0;
end;

そして最後に残ったすべてのために

function BinaryCompare(const Left, Right: Pointer; Size: Integer): Integer;
var
  pl, pr: PByte;
  len: Integer;
begin
  pl := Left;
  pr := Right;
  len := Size;
  while len > 0 do
  begin
    Result := pl^ - pr^;
    if Result <> 0 then
      Exit;
    Dec(len);
    Inc(pl);
    Inc(pr);
  end;
  Result := 0;
end;
于 2013-07-31T10:35:23.647 に答える
3

David は、既定の比較子がどのように機能するかをテキストで説明するという素晴らしい仕事をしましたが、基礎となるコードがどのように構造化されているかを確認する (そして、既定の比較子が適用されるかどうかを判断する) 方が理解しやすいかもしれません。

Compare_比較のスタイルのみをカバーします。スタイルはEquals_同様の方法で機能します。

何が起こるかというと、スタイル比較用のインターフェース(およびスタイル用の ) を_LookupVtableInfo選択することです。IComparerCompare_IEqualityComparerEquals_

これらのインターフェイスの下には、通常のインターフェイスではなく、次のCompare_スタイルのグローバル関数のインターフェイス ラッパーがあります。

function Compare_t<T>(Inst: Pointer; const Left, Right: T): Integer;

スタイルのこの形式のグローバル プロシージャEquals_:

function Equals_t<T>(Inst: Pointer; const Left, Right: T): Integer;
function GetHashCode_t<T>(Inst: Pointer; const Left, Right: T): Integer;

スタイル関数の結果Compare_は簡単ですが、一部の人が期待する -1、0、+1 とは少し異なります。

< 0 for Left < Right
= 0 for Left = Right
> 0 for Left > Right

ほとんどの場合、実装は非常に簡単です。

Compare_これを行う方法によってスタイル関数をグループ化しました。

  • 序数型 (列挙子と Int64 を含む)。
  • 浮動小数点 (Real) 型 (Comp および Currency を含む)。
  • 短い文字列 (Turbo Pascal / Delphi 1 日から)。
  • ワイド文字列 (OLE スタイルのもの)。
  • メソッド。
  • ポインター (クラス、インターフェイス、クラス参照、およびプロシージャを含む)。

(1、2、4、8 バイトの範囲外の序数型と、4、8、10 バイトの範囲外の実数型は不正であるため、エラーが発生します)。

最初のグループは、右から左を減算するだけです: 1 または 2 バイト長の符号付き/符号なし整数

function Compare_I1(Inst: Pointer; const Left, Right: Shortint): Integer;
function Compare_I2(Inst: Pointer; const Left, Right: Smallint): Integer;
function Compare_U1(Inst: Pointer; const Left, Right: Byte): Integer;
function Compare_U2(Inst: Pointer; const Left, Right: Word): Integer;

  Result := Left - Right;

2 番目のグループは比較を行います。

function Compare_I4(Inst: Pointer; const Left, Right: Integer): Integer;
function Compare_I8(Inst: Pointer; const Left, Right: Int64): Integer;
function Compare_U4(Inst: Pointer; const Left, Right: LongWord): Integer;
function Compare_U8(Inst: Pointer; const Left, Right: UInt64): Integer;
function Compare_R4(Inst: Pointer; const Left, Right: Single): Integer;
function Compare_R8(Inst: Pointer; const Left, Right: Double): Integer;
function Compare_R10(Inst: Pointer; const Left, Right: Extended): Integer;
function Compare_RI8(Inst: Pointer; const Left, Right: Comp): Integer;
function Compare_RC8(Inst: Pointer; const Left, Right: Currency): Integer;
function Compare_WString(Inst: PSimpleInstance; const Left, Right: WideString): Integer;
function Compare_Pointer(Inst: PSimpleInstance; Left, Right: NativeUInt): Integer;

type
{$IFNDEF NEXTGEN}
  TPS1 = string[1];
  TPS2 = string[2];
  TPS3 = string[3];
{$ELSE NEXTGEN}
  OpenString = type string;
  TPS1 = string;
  TPS2 = string;
  TPS3 = string;
{$ENDIF !NEXTGEN}

function Compare_PS1(Inst: PSimpleInstance; const Left, Right: TPS1): Integer;
function Compare_PS2(Inst: PSimpleInstance; const Left, Right: TPS2): Integer;
function Compare_PS3(Inst: PSimpleInstance; const Left, Right: TPS3): Integer;
// OpenString allows for any String[n], see http://my.safaribooksonline.com/book/programming/borland-delphi/1565926595/5dot-language-reference/ch05-openstring
function Compare_PSn(Inst: PSimpleInstance; const Left, Right: OpenString): Integer;

  if Left < Right then
    Result := -1
  else if Left > Right then
    Result := 1
  else
    Result := 0;

function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
var
  LMethod, RMethod: TMethod;
begin
  LMethod := TMethod(Left);
  RMethod := TMethod(Right);
  if LMethod < RMethod then
    Result := -1
  else if LMethod > RMethod then
    Result := 1
  else
    Result := 0;
end;

ここで、興味深い部分、つまりそれほど単純ではない結果に進みます。

ストリングス使用CompareStr。何か違うものが必要な場合は、使用できますTOrdinalIStringComparer

function Compare_LString(Inst: PSimpleInstance; const Left, Right: AnsiString): Integer;
function Compare_UString(Inst: PSimpleInstance; const Left, Right: UnicodeString): Integer;

  Result := CompareStr(Left, Right);

BinaryCompare次の目的で使用されます。

  • 不明、Char/WChar、Set、Array、Record を含むバイナリ データ。例外として、バイナリ データが x86 および x64 では 1、2、または 4 バイト サイズであり、x64 では 8 バイト サイズである場合、整数として比較されます。
  • 動的キャリー (多次元の場合は注意してください!)。
  • 最後の手段としてのバリアント (詳細は以下を参照)

比較可能なレコードの場合、演算子のオーバーロードを実行し、比較子にそれらの演算子を使用させることは理にかなっています。

1、2、4、または 8 バイトのバイナリ データは例外であり、リトル エンディアン マシン (Intel x86 および x64、およびリトル エンディアン モードのバイ エンディアン Arm) では奇妙な結果になります。

function Comparer_Selector_Binary(info: PTypeInfo; size: Integer): Pointer;
begin
  case size of
    // NOTE: Little-endianness may cause counterintuitive results,
    // but the results will at least be consistent.
    1: Result := @Comparer_Instance_U1;
    2: Result := @Comparer_Instance_U2;
    4: Result := @Comparer_Instance_U4;
    {$IFDEF CPUX64}
    // 64-bit will pass const args in registers
    8: Result := @Comparer_Instance_U8;
    {$ENDIF}
  else
    Result := MakeInstance(@Comparer_Vtable_Binary, size);
  end;
end;

残りは純粋なバイナリです。

function Compare_Binary(Inst: PSimpleInstance; const Left, Right): Integer;
begin
  Result := BinaryCompare(@Left, @Right, Inst^.Size);
end;

function Compare_DynArray(Inst: PSimpleInstance; Left, Right: Pointer): NativeInt;
var
  len, lenDiff: NativeInt;
begin
  len := DynLen(Left);
  lenDiff := len - DynLen(Right);
  if lenDiff < 0 then
    Inc(len, lenDiff);
  Result := BinaryCompare(Left, Right, Inst^.Size * len);
  if Result = 0 then
    Result := lenDiff;
end;

いつものようにVariants、独自のリーグにいます。最初VarCompareValueに試されます。それが失敗した場合は、Compare_UString試行されます。それも失敗した場合BinaryCompareは、試行されます。それが失敗した場合:運が悪い。

function Compare_Variant(Inst: PSimpleInstance; Left, Right: Pointer): Integer;
var
  l, r: Variant;
  lAsString, rAsString: string;
begin
  Result := 0; // Avoid warning.
  l := PVariant(Left)^;
  r := PVariant(Right)^;
  try
    case VarCompareValue(l, r) of
      vrEqual:        Exit(0);
      vrLessThan:     Exit(-1);
      vrGreaterThan:  Exit(1);
      vrNotEqual:
      begin
        if VarIsEmpty(L) or VarIsNull(L) then
          Exit(1)
        else
          Exit(-1);
      end;
    end;
  except // if comparison failed with exception, compare as string.
    try
      lAsString := PVariant(Left)^;
      rAsString := PVariant(Right)^;
      Result := Compare_UString(nil, lAsString, rAsString);
    except  // if comparison fails again, compare bytes.
      Result := BinaryCompare(Left, Right, SizeOf(Variant));
    end;
  end;
end;
于 2013-08-06T07:50:17.240 に答える