mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-11 13:42:49 +02:00
3305 lines
142 KiB
ObjectPascal
3305 lines
142 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2014 by Maciej Izak (hnb)
|
|
member of the Free Sparta development team (http://freesparta.com)
|
|
|
|
Copyright(c) 2004-2014 DaThoX
|
|
|
|
It contains the Free Pascal generics library
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
Acknowledgment
|
|
|
|
Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
|
|
many new types and major refactoring of entire library
|
|
|
|
Thanks to mORMot (http://synopse.info) project for the best implementations
|
|
of hashing functions like crc32c and xxHash32 :)
|
|
|
|
**********************************************************************}
|
|
|
|
unit Generics.Defaults;
|
|
|
|
{$MODE DELPHI}{$H+}
|
|
{$POINTERMATH ON}
|
|
{$MACRO ON}
|
|
{$COPERATORS ON}
|
|
{$HINTS OFF}
|
|
{$WARNINGS OFF}
|
|
{$NOTES OFF}
|
|
{$OVERFLOWCHECKS OFF}
|
|
{$RANGECHECKS OFF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Generics.Hashes, TypInfo, Variants, Math, Generics.Strings, Generics.Helpers;
|
|
|
|
type
|
|
IComparer<T> = interface
|
|
function Compare(constref Left, Right: T): Integer; overload;
|
|
end;
|
|
|
|
TOnComparison<T> = function(constref Left, Right: T): Integer of object;
|
|
TComparisonFunc<T> = function(constref Left, Right: T): Integer;
|
|
|
|
TComparer<T> = class(TInterfacedObject, IComparer<T>)
|
|
public
|
|
class function Default: IComparer<T>; static;
|
|
function Compare(constref ALeft, ARight: T): Integer; virtual; abstract; overload;
|
|
|
|
class function Construct(const AComparison: TOnComparison<T>): IComparer<T>; overload;
|
|
class function Construct(const AComparison: TComparisonFunc<T>): IComparer<T>; overload;
|
|
end;
|
|
|
|
TDelegatedComparerEvents<T> = class(TComparer<T>)
|
|
private
|
|
FComparison: TOnComparison<T>;
|
|
public
|
|
function Compare(constref ALeft, ARight: T): Integer; override;
|
|
constructor Create(AComparison: TOnComparison<T>);
|
|
end;
|
|
|
|
TDelegatedComparerFunc<T> = class(TComparer<T>)
|
|
private
|
|
FComparison: TComparisonFunc<T>;
|
|
public
|
|
function Compare(constref ALeft, ARight: T): Integer; override;
|
|
constructor Create(AComparison: TComparisonFunc<T>);
|
|
end;
|
|
|
|
IEqualityComparer<T> = interface
|
|
function Equals(constref ALeft, ARight: T): Boolean;
|
|
function GetHashCode(constref AValue: T): UInt32;
|
|
end;
|
|
|
|
IExtendedEqualityComparer<T> = interface(IEqualityComparer<T>)
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); // for double hashing and more
|
|
end;
|
|
|
|
ShortString1 = string[1];
|
|
ShortString2 = string[2];
|
|
ShortString3 = string[3];
|
|
|
|
{ TAbstractInterface }
|
|
|
|
TInterface = class
|
|
public
|
|
function QueryInterface(constref {%H-}IID: TGUID;{%H-} out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
|
|
function _AddRef: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual; abstract;
|
|
function _Release: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual; abstract;
|
|
end;
|
|
|
|
{ TRawInterface }
|
|
|
|
TRawInterface = class(TInterface)
|
|
public
|
|
function _AddRef: LongInt; override;
|
|
function _Release: LongInt; override;
|
|
end;
|
|
|
|
{ TComTypeSizeInterface }
|
|
|
|
// INTERNAL USE ONLY!
|
|
TComTypeSizeInterface = class(TInterface)
|
|
public
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
function _AddRef: LongInt; override;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
function _Release: LongInt; override;
|
|
end;
|
|
|
|
{ TSingletonImplementation }
|
|
|
|
TSingletonImplementation = class(TRawInterface, IInterface)
|
|
public
|
|
function QueryInterface(constref IID: TGUID; out Obj): HResult; override;
|
|
end;
|
|
|
|
TCompare = class
|
|
protected
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function _Binary(constref ALeft, ARight): Integer;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function _DynArray(constref ALeft, ARight: Pointer): Integer;
|
|
public
|
|
class function Integer(constref ALeft, ARight: Integer): Integer;
|
|
class function Int8(constref ALeft, ARight: Int8): Integer;
|
|
class function Int16(constref ALeft, ARight: Int16): Integer;
|
|
class function Int32(constref ALeft, ARight: Int32): Integer;
|
|
class function Int64(constref ALeft, ARight: Int64): Integer;
|
|
class function UInt8(constref ALeft, ARight: UInt8): Integer;
|
|
class function UInt16(constref ALeft, ARight: UInt16): Integer;
|
|
class function UInt32(constref ALeft, ARight: UInt32): Integer;
|
|
class function UInt64(constref ALeft, ARight: UInt64): Integer;
|
|
class function Single(constref ALeft, ARight: Single): Integer;
|
|
class function Double(constref ALeft, ARight: Double): Integer;
|
|
class function Extended(constref ALeft, ARight: Extended): Integer;
|
|
class function Currency(constref ALeft, ARight: Currency): Integer;
|
|
class function Comp(constref ALeft, ARight: Comp): Integer;
|
|
class function Binary(constref ALeft, ARight; const ASize: SizeInt): Integer;
|
|
class function DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Integer;
|
|
class function ShortString1(constref ALeft, ARight: ShortString1): Integer;
|
|
class function ShortString2(constref ALeft, ARight: ShortString2): Integer;
|
|
class function ShortString3(constref ALeft, ARight: ShortString3): Integer;
|
|
class function &String(constref ALeft, ARight: string): Integer;
|
|
class function ShortString(constref ALeft, ARight: ShortString): Integer;
|
|
class function AnsiString(constref ALeft, ARight: AnsiString): Integer;
|
|
class function WideString(constref ALeft, ARight: WideString): Integer;
|
|
class function UnicodeString(constref ALeft, ARight: UnicodeString): Integer;
|
|
class function Method(constref ALeft, ARight: TMethod): Integer;
|
|
class function Variant(constref ALeft, ARight: PVariant): Integer;
|
|
class function Pointer(constref ALeft, ARight: PtrUInt): Integer;
|
|
end;
|
|
|
|
{ TEquals }
|
|
|
|
TEquals = class
|
|
protected
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function _Binary(constref ALeft, ARight): Boolean;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function _DynArray(constref ALeft, ARight: Pointer): Boolean;
|
|
public
|
|
class function Integer(constref ALeft, ARight: Integer): Boolean;
|
|
class function Int8(constref ALeft, ARight: Int8): Boolean;
|
|
class function Int16(constref ALeft, ARight: Int16): Boolean;
|
|
class function Int32(constref ALeft, ARight: Int32): Boolean;
|
|
class function Int64(constref ALeft, ARight: Int64): Boolean;
|
|
class function UInt8(constref ALeft, ARight: UInt8): Boolean;
|
|
class function UInt16(constref ALeft, ARight: UInt16): Boolean;
|
|
class function UInt32(constref ALeft, ARight: UInt32): Boolean;
|
|
class function UInt64(constref ALeft, ARight: UInt64): Boolean;
|
|
class function Single(constref ALeft, ARight: Single): Boolean;
|
|
class function Double(constref ALeft, ARight: Double): Boolean;
|
|
class function Extended(constref ALeft, ARight: Extended): Boolean;
|
|
class function Currency(constref ALeft, ARight: Currency): Boolean;
|
|
class function Comp(constref ALeft, ARight: Comp): Boolean;
|
|
class function Binary(constref ALeft, ARight; const ASize: SizeInt): Boolean;
|
|
class function DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Boolean;
|
|
class function &Class(constref ALeft, ARight: TObject): Boolean;
|
|
class function ShortString1(constref ALeft, ARight: ShortString1): Boolean;
|
|
class function ShortString2(constref ALeft, ARight: ShortString2): Boolean;
|
|
class function ShortString3(constref ALeft, ARight: ShortString3): Boolean;
|
|
class function &String(constref ALeft, ARight: String): Boolean;
|
|
class function ShortString(constref ALeft, ARight: ShortString): Boolean;
|
|
class function AnsiString(constref ALeft, ARight: AnsiString): Boolean;
|
|
class function WideString(constref ALeft, ARight: WideString): Boolean;
|
|
class function UnicodeString(constref ALeft, ARight: UnicodeString): Boolean;
|
|
class function Method(constref ALeft, ARight: TMethod): Boolean;
|
|
class function Variant(constref ALeft, ARight: PVariant): Boolean;
|
|
class function Pointer(constref ALeft, ARight: PtrUInt): Boolean;
|
|
end;
|
|
|
|
THashServiceClass = class of THashService;
|
|
TExtendedHashServiceClass = class of TExtendedHashService;
|
|
THashFactoryClass = class of THashFactory;
|
|
|
|
TExtendedHashFactoryClass = class of TExtendedHashFactory;
|
|
|
|
{ TComparerService }
|
|
|
|
{$DEFINE STD_RAW_INTERFACE_METHODS :=
|
|
QueryInterface: @TRawInterface.QueryInterface;
|
|
_AddRef : @TRawInterface._AddRef;
|
|
_Release : @TRawInterface._Release
|
|
}
|
|
|
|
{$DEFINE STD_COM_TYPESIZE_INTERFACE_METHODS :=
|
|
QueryInterface: @TComTypeSizeInterface.QueryInterface;
|
|
_AddRef : @TComTypeSizeInterface._AddRef;
|
|
_Release : @TComTypeSizeInterface._Release
|
|
}
|
|
|
|
TGetHashListOptions = set of (ghloHashListAsInitData);
|
|
|
|
THashFactory = class
|
|
private type
|
|
PPEqualityComparerVMT = ^PEqualityComparerVMT;
|
|
PEqualityComparerVMT = ^TEqualityComparerVMT;
|
|
TEqualityComparerVMT = packed record
|
|
QueryInterface: CodePointer;
|
|
_AddRef: CodePointer;
|
|
_Release: CodePointer;
|
|
Equals: CodePointer;
|
|
GetHashCode: CodePointer;
|
|
__Reserved: Pointer; // initially or TExtendedEqualityComparerVMT compatibility
|
|
// (important when ExtendedEqualityComparer is calling Binary method)
|
|
__ClassRef: THashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
|
|
end;
|
|
|
|
private
|
|
(***********************************************************************************************************************
|
|
Hashes
|
|
(**********************************************************************************************************************)
|
|
|
|
class function Int8 (constref AValue: Int8 ): UInt32; overload;
|
|
class function Int16 (constref AValue: Int16 ): UInt32; overload;
|
|
class function Int32 (constref AValue: Int32 ): UInt32; overload;
|
|
class function Int64 (constref AValue: Int64 ): UInt32; overload;
|
|
class function UInt8 (constref AValue: UInt8 ): UInt32; overload;
|
|
class function UInt16 (constref AValue: UInt16 ): UInt32; overload;
|
|
class function UInt32 (constref AValue: UInt32 ): UInt32; overload;
|
|
class function UInt64 (constref AValue: UInt64 ): UInt32; overload;
|
|
class function Single (constref AValue: Single ): UInt32; overload;
|
|
class function Double (constref AValue: Double ): UInt32; overload;
|
|
class function Extended (constref AValue: Extended ): UInt32; overload;
|
|
class function Currency (constref AValue: Currency ): UInt32; overload;
|
|
class function Comp (constref AValue: Comp ): UInt32; overload;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function Binary (constref AValue ): UInt32; overload;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class function DynArray (constref AValue: Pointer ): UInt32; overload;
|
|
class function &Class (constref AValue: TObject ): UInt32; overload;
|
|
class function ShortString1 (constref AValue: ShortString1 ): UInt32; overload;
|
|
class function ShortString2 (constref AValue: ShortString2 ): UInt32; overload;
|
|
class function ShortString3 (constref AValue: ShortString3 ): UInt32; overload;
|
|
class function ShortString (constref AValue: ShortString ): UInt32; overload;
|
|
class function AnsiString (constref AValue: AnsiString ): UInt32; overload;
|
|
class function WideString (constref AValue: WideString ): UInt32; overload;
|
|
class function UnicodeString(constref AValue: UnicodeString): UInt32; overload;
|
|
class function Method (constref AValue: TMethod ): UInt32; overload;
|
|
class function Variant (constref AValue: PVariant ): UInt32; overload;
|
|
class function Pointer (constref AValue: Pointer ): UInt32; overload;
|
|
public
|
|
const MAX_HASHLIST_COUNT = 1;
|
|
const HASH_FUNCTIONS_COUNT = 1;
|
|
const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (1);
|
|
const HASH_FUNCTIONS_MASK_SIZE = 1;
|
|
|
|
class function GetHashService: THashServiceClass; virtual; abstract;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; virtual; abstract; reintroduce;
|
|
end;
|
|
|
|
TExtendedHashFactory = class(THashFactory)
|
|
private type
|
|
PPExtendedEqualityComparerVMT = ^PExtendedEqualityComparerVMT;
|
|
PExtendedEqualityComparerVMT = ^TExtendedEqualityComparerVMT;
|
|
TExtendedEqualityComparerVMT = packed record
|
|
QueryInterface: CodePointer;
|
|
_AddRef: CodePointer;
|
|
_Release: CodePointer;
|
|
Equals: CodePointer;
|
|
GetHashCode: CodePointer;
|
|
GetHashList: CodePointer;
|
|
__ClassRef: TExtendedHashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
|
|
end;
|
|
private
|
|
(***********************************************************************************************************************
|
|
Hashes 2
|
|
(**********************************************************************************************************************)
|
|
|
|
class procedure Int8 (constref AValue: Int8 ; AHashList: PUInt32); overload;
|
|
class procedure Int16 (constref AValue: Int16 ; AHashList: PUInt32); overload;
|
|
class procedure Int32 (constref AValue: Int32 ; AHashList: PUInt32); overload;
|
|
class procedure Int64 (constref AValue: Int64 ; AHashList: PUInt32); overload;
|
|
class procedure UInt8 (constref AValue: UInt8 ; AHashList: PUInt32); overload;
|
|
class procedure UInt16 (constref AValue: UInt16 ; AHashList: PUInt32); overload;
|
|
class procedure UInt32 (constref AValue: UInt32 ; AHashList: PUInt32); overload;
|
|
class procedure UInt64 (constref AValue: UInt64 ; AHashList: PUInt32); overload;
|
|
class procedure Single (constref AValue: Single ; AHashList: PUInt32); overload;
|
|
class procedure Double (constref AValue: Double ; AHashList: PUInt32); overload;
|
|
class procedure Extended (constref AValue: Extended ; AHashList: PUInt32); overload;
|
|
class procedure Currency (constref AValue: Currency ; AHashList: PUInt32); overload;
|
|
class procedure Comp (constref AValue: Comp ; AHashList: PUInt32); overload;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class procedure Binary (constref AValue ; AHashList: PUInt32); overload;
|
|
// warning ! self as PSpoofInterfacedTypeSizeObject
|
|
class procedure DynArray (constref AValue: Pointer ; AHashList: PUInt32); overload;
|
|
class procedure &Class (constref AValue: TObject ; AHashList: PUInt32); overload;
|
|
class procedure ShortString1 (constref AValue: ShortString1 ; AHashList: PUInt32); overload;
|
|
class procedure ShortString2 (constref AValue: ShortString2 ; AHashList: PUInt32); overload;
|
|
class procedure ShortString3 (constref AValue: ShortString3 ; AHashList: PUInt32); overload;
|
|
class procedure ShortString (constref AValue: ShortString ; AHashList: PUInt32); overload;
|
|
class procedure AnsiString (constref AValue: AnsiString ; AHashList: PUInt32); overload;
|
|
class procedure WideString (constref AValue: WideString ; AHashList: PUInt32); overload;
|
|
class procedure UnicodeString(constref AValue: UnicodeString; AHashList: PUInt32); overload;
|
|
class procedure Method (constref AValue: TMethod ; AHashList: PUInt32); overload;
|
|
class procedure Variant (constref AValue: PVariant ; AHashList: PUInt32); overload;
|
|
class procedure Pointer (constref AValue: Pointer ; AHashList: PUInt32); overload;
|
|
public
|
|
class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); virtual; abstract;
|
|
end;
|
|
|
|
TComparerService = class abstract
|
|
private type
|
|
TSelectMethod = function(ATypeData: PTypeData; ASize: SizeInt): Pointer of object;
|
|
private
|
|
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
|
|
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
|
|
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
|
|
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
|
|
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
|
|
private type
|
|
PSpoofInterfacedTypeSizeObject = ^TSpoofInterfacedTypeSizeObject;
|
|
TSpoofInterfacedTypeSizeObject = record
|
|
VMT: Pointer;
|
|
RefCount: LongInt;
|
|
Size: SizeInt;
|
|
end;
|
|
|
|
PInstance = ^TInstance;
|
|
TInstance = record
|
|
class function Create(ASelector: Boolean; AInstance: Pointer): TComparerService.TInstance; static;
|
|
class function CreateSelector(ASelectorInstance: CodePointer): TComparerService.TInstance; static;
|
|
|
|
case Selector: Boolean of
|
|
false: (Instance: Pointer);
|
|
true: (SelectorInstance: CodePointer);
|
|
end;
|
|
|
|
PComparerVMT = ^TComparerVMT;
|
|
TComparerVMT = packed record
|
|
QueryInterface: CodePointer;
|
|
_AddRef: CodePointer;
|
|
_Release: CodePointer;
|
|
Compare: CodePointer;
|
|
end;
|
|
|
|
TSelectFunc = function(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
|
|
private
|
|
class function CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject; static;
|
|
|
|
class function SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
class function SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
class function SelectFloatComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
class function SelectShortStringComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
class function SelectBinaryComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
class function SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
|
|
private const
|
|
// IComparer VMT
|
|
Comparer_Int8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int8);
|
|
Comparer_Int16_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int16 );
|
|
Comparer_Int32_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int32 );
|
|
Comparer_Int64_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int64 );
|
|
Comparer_UInt8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt8 );
|
|
Comparer_UInt16_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt16);
|
|
Comparer_UInt32_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt32);
|
|
Comparer_UInt64_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt64);
|
|
|
|
Comparer_Single_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Single );
|
|
Comparer_Double_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Double );
|
|
Comparer_Extended_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Extended);
|
|
|
|
Comparer_Currency_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Currency);
|
|
Comparer_Comp_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Comp );
|
|
|
|
Comparer_Binary_VMT : TComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Compare: @TCompare._Binary );
|
|
Comparer_DynArray_VMT: TComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Compare: @TCompare._DynArray);
|
|
|
|
Comparer_ShortString1_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString1 );
|
|
Comparer_ShortString2_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString2 );
|
|
Comparer_ShortString3_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString3 );
|
|
Comparer_ShortString_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString );
|
|
Comparer_AnsiString_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.AnsiString );
|
|
Comparer_WideString_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.WideString );
|
|
Comparer_UnicodeString_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UnicodeString);
|
|
|
|
Comparer_Method_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Method );
|
|
Comparer_Variant_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Variant);
|
|
Comparer_Pointer_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Pointer);
|
|
|
|
// Instances
|
|
Comparer_Int8_Instance : Pointer = @Comparer_Int8_VMT ;
|
|
Comparer_Int16_Instance : Pointer = @Comparer_Int16_VMT ;
|
|
Comparer_Int32_Instance : Pointer = @Comparer_Int32_VMT ;
|
|
Comparer_Int64_Instance : Pointer = @Comparer_Int64_VMT ;
|
|
Comparer_UInt8_Instance : Pointer = @Comparer_UInt8_VMT ;
|
|
Comparer_UInt16_Instance: Pointer = @Comparer_UInt16_VMT;
|
|
Comparer_UInt32_Instance: Pointer = @Comparer_UInt32_VMT;
|
|
Comparer_UInt64_Instance: Pointer = @Comparer_UInt64_VMT;
|
|
|
|
Comparer_Single_Instance : Pointer = @Comparer_Single_VMT ;
|
|
Comparer_Double_Instance : Pointer = @Comparer_Double_VMT ;
|
|
Comparer_Extended_Instance: Pointer = @Comparer_Extended_VMT;
|
|
|
|
Comparer_Currency_Instance: Pointer = @Comparer_Currency_VMT;
|
|
Comparer_Comp_Instance : Pointer = @Comparer_Comp_VMT ;
|
|
|
|
//Comparer_Binary_Instance : Pointer = @Comparer_Binary_VMT ; // dynamic instance
|
|
//Comparer_DynArray_Instance: Pointer = @Comparer_DynArray_VMT; // dynamic instance
|
|
|
|
Comparer_ShortString1_Instance : Pointer = @Comparer_ShortString1_VMT ;
|
|
Comparer_ShortString2_Instance : Pointer = @Comparer_ShortString2_VMT ;
|
|
Comparer_ShortString3_Instance : Pointer = @Comparer_ShortString3_VMT ;
|
|
Comparer_ShortString_Instance : Pointer = @Comparer_ShortString_VMT ;
|
|
Comparer_AnsiString_Instance : Pointer = @Comparer_AnsiString_VMT ;
|
|
Comparer_WideString_Instance : Pointer = @Comparer_WideString_VMT ;
|
|
Comparer_UnicodeString_Instance: Pointer = @Comparer_UnicodeString_VMT;
|
|
|
|
Comparer_Method_Instance : Pointer = @Comparer_Method_VMT ;
|
|
Comparer_Variant_Instance: Pointer = @Comparer_Variant_VMT;
|
|
Comparer_Pointer_Instance: Pointer = @Comparer_Pointer_VMT;
|
|
|
|
ComparerInstances: array[TTypeKind] of TInstance =
|
|
(
|
|
// tkUnknown
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer),
|
|
// tkInteger
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectIntegerComparer),
|
|
// tkChar
|
|
(Selector: False; Instance: @Comparer_UInt8_Instance),
|
|
// tkEnumeration
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectIntegerComparer),
|
|
// tkFloat
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectFloatComparer),
|
|
// tkSet
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer),
|
|
// tkMethod
|
|
(Selector: False; Instance: @Comparer_Method_Instance),
|
|
// tkSString
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectShortStringComparer),
|
|
// tkLString - only internal use / deprecated in compiler
|
|
(Selector: False; Instance: @Comparer_AnsiString_Instance), // <- unsure
|
|
// tkAString
|
|
(Selector: False; Instance: @Comparer_AnsiString_Instance),
|
|
// tkWString
|
|
(Selector: False; Instance: @Comparer_WideString_Instance),
|
|
// tkVariant
|
|
(Selector: False; Instance: @Comparer_Variant_Instance),
|
|
// tkArray
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer),
|
|
// tkRecord
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer),
|
|
// tkInterface
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkClass
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkObject
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer),
|
|
// tkWChar
|
|
(Selector: False; Instance: @Comparer_UInt16_Instance),
|
|
// tkBool
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectIntegerComparer),
|
|
// tkInt64
|
|
(Selector: False; Instance: @Comparer_Int64_Instance),
|
|
// tkQWord
|
|
(Selector: False; Instance: @Comparer_UInt64_Instance),
|
|
// tkDynArray
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectDynArrayComparer),
|
|
// tkInterfaceRaw
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkProcVar
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkUString
|
|
(Selector: False; Instance: @Comparer_UnicodeString_Instance),
|
|
// tkUChar - WTF? ... http://bugs.freepascal.org/view.php?id=24609
|
|
(Selector: False; Instance: @Comparer_UInt16_Instance), // <- unsure maybe Comparer_UInt32_Instance
|
|
// tkHelper
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkFile
|
|
(Selector: True; SelectorInstance: @TComparerService.SelectBinaryComparer), // <- unsure what type?
|
|
// tkClassRef
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance),
|
|
// tkPointer
|
|
(Selector: False; Instance: @Comparer_Pointer_Instance)
|
|
);
|
|
public
|
|
class function LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; static;
|
|
end;
|
|
|
|
THashService = class(TComparerService)
|
|
public
|
|
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
|
|
end;
|
|
|
|
TExtendedHashService = class(THashService)
|
|
public
|
|
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
|
|
end;
|
|
|
|
{$DEFINE HASH_FACTORY := PPEqualityComparerVMT(Self)^.__ClassRef}
|
|
{$DEFINE EXTENDED_HASH_FACTORY := PPExtendedEqualityComparerVMT(Self)^.__ClassRef}
|
|
|
|
{ THashService }
|
|
|
|
THashService<T: THashFactory> = class(THashService)
|
|
private
|
|
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
private const
|
|
// IEqualityComparer VMT templates
|
|
{$WARNINGS OFF}
|
|
EqualityComparer_Int8_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int8 ; GetHashCode: @THashFactory.Int8 );
|
|
EqualityComparer_Int16_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int16 ; GetHashCode: @THashFactory.Int16 );
|
|
EqualityComparer_Int32_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int32 ; GetHashCode: @THashFactory.Int32 );
|
|
EqualityComparer_Int64_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int64 ; GetHashCode: @THashFactory.Int64 );
|
|
EqualityComparer_UInt8_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt8 ; GetHashCode: @THashFactory.UInt8 );
|
|
EqualityComparer_UInt16_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt16; GetHashCode: @THashFactory.UInt16);
|
|
EqualityComparer_UInt32_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt32; GetHashCode: @THashFactory.UInt32);
|
|
EqualityComparer_UInt64_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt64; GetHashCode: @THashFactory.UInt64);
|
|
|
|
EqualityComparer_Single_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Single ; GetHashCode: @THashFactory.Single );
|
|
EqualityComparer_Double_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Double ; GetHashCode: @THashFactory.Double );
|
|
EqualityComparer_Extended_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Extended; GetHashCode: @THashFactory.Extended);
|
|
|
|
EqualityComparer_Currency_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Currency; GetHashCode: @THashFactory.Currency);
|
|
EqualityComparer_Comp_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Comp ; GetHashCode: @THashFactory.Comp );
|
|
|
|
EqualityComparer_Binary_VMT : THashFactory.TEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._Binary ; GetHashCode: @THashFactory.Binary );
|
|
EqualityComparer_DynArray_VMT: THashFactory.TEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._DynArray; GetHashCode: @THashFactory.DynArray);
|
|
|
|
EqualityComparer_Class_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.&Class; GetHashCode: @THashFactory.&Class);
|
|
|
|
EqualityComparer_ShortString1_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString1 ; GetHashCode: @THashFactory.ShortString1 );
|
|
EqualityComparer_ShortString2_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString2 ; GetHashCode: @THashFactory.ShortString2 );
|
|
EqualityComparer_ShortString3_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString3 ; GetHashCode: @THashFactory.ShortString3 );
|
|
EqualityComparer_ShortString_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString ; GetHashCode: @THashFactory.ShortString );
|
|
EqualityComparer_AnsiString_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.AnsiString ; GetHashCode: @THashFactory.AnsiString );
|
|
EqualityComparer_WideString_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.WideString ; GetHashCode: @THashFactory.WideString );
|
|
EqualityComparer_UnicodeString_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UnicodeString; GetHashCode: @THashFactory.UnicodeString);
|
|
|
|
EqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method );
|
|
EqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant);
|
|
EqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer);
|
|
{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
|
|
private class var
|
|
// IEqualityComparer VMT
|
|
FEqualityComparer_Int8_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Int16_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Int32_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Int64_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_UInt8_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_UInt16_VMT: THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_UInt32_VMT: THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_UInt64_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Single_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Double_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Extended_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Currency_VMT: THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Comp_VMT : THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Binary_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_DynArray_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Class_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_ShortString1_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_ShortString2_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_ShortString3_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_ShortString_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_AnsiString_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_WideString_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_UnicodeString_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT;
|
|
FEqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT;
|
|
|
|
FEqualityComparer_Int8_Instance : Pointer;
|
|
FEqualityComparer_Int16_Instance : Pointer;
|
|
FEqualityComparer_Int32_Instance : Pointer;
|
|
FEqualityComparer_Int64_Instance : Pointer;
|
|
FEqualityComparer_UInt8_Instance : Pointer;
|
|
FEqualityComparer_UInt16_Instance : Pointer;
|
|
FEqualityComparer_UInt32_Instance : Pointer;
|
|
FEqualityComparer_UInt64_Instance : Pointer;
|
|
|
|
FEqualityComparer_Single_Instance : Pointer;
|
|
FEqualityComparer_Double_Instance : Pointer;
|
|
FEqualityComparer_Extended_Instance : Pointer;
|
|
|
|
FEqualityComparer_Currency_Instance : Pointer;
|
|
FEqualityComparer_Comp_Instance : Pointer;
|
|
|
|
//FEqualityComparer_Binary_Instance : Pointer; // dynamic instance
|
|
//FEqualityComparer_DynArray_Instance : Pointer; // dynamic instance
|
|
|
|
FEqualityComparer_ShortString1_Instance : Pointer;
|
|
FEqualityComparer_ShortString2_Instance : Pointer;
|
|
FEqualityComparer_ShortString3_Instance : Pointer;
|
|
FEqualityComparer_ShortString_Instance : Pointer;
|
|
FEqualityComparer_AnsiString_Instance : Pointer;
|
|
FEqualityComparer_WideString_Instance : Pointer;
|
|
FEqualityComparer_UnicodeString_Instance: Pointer;
|
|
|
|
FEqualityComparer_Method_Instance : Pointer;
|
|
FEqualityComparer_Variant_Instance : Pointer;
|
|
FEqualityComparer_Pointer_Instance : Pointer;
|
|
|
|
|
|
FEqualityComparerInstances: array[TTypeKind] of TInstance;
|
|
private
|
|
class constructor Create;
|
|
public
|
|
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
|
|
end;
|
|
|
|
{ TExtendedHashService }
|
|
|
|
TExtendedHashService<T: TExtendedHashFactory> = class(TExtendedHashService)
|
|
private
|
|
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
|
|
private const
|
|
// IExtendedEqualityComparer VMT templates
|
|
{$WARNINGS OFF}
|
|
ExtendedEqualityComparer_Int8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int8 ; GetHashCode: @THashFactory.Int8 ; GetHashList: @TExtendedHashFactory.Int8 );
|
|
ExtendedEqualityComparer_Int16_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int16 ; GetHashCode: @THashFactory.Int16 ; GetHashList: @TExtendedHashFactory.Int16 );
|
|
ExtendedEqualityComparer_Int32_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int32 ; GetHashCode: @THashFactory.Int32 ; GetHashList: @TExtendedHashFactory.Int32 );
|
|
ExtendedEqualityComparer_Int64_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int64 ; GetHashCode: @THashFactory.Int64 ; GetHashList: @TExtendedHashFactory.Int64 );
|
|
ExtendedEqualityComparer_UInt8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt8 ; GetHashCode: @THashFactory.UInt8 ; GetHashList: @TExtendedHashFactory.UInt8 );
|
|
ExtendedEqualityComparer_UInt16_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt16; GetHashCode: @THashFactory.UInt16; GetHashList: @TExtendedHashFactory.UInt16);
|
|
ExtendedEqualityComparer_UInt32_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt32; GetHashCode: @THashFactory.UInt32; GetHashList: @TExtendedHashFactory.UInt32);
|
|
ExtendedEqualityComparer_UInt64_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt64; GetHashCode: @THashFactory.UInt64; GetHashList: @TExtendedHashFactory.UInt64);
|
|
|
|
ExtendedEqualityComparer_Single_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Single ; GetHashCode: @THashFactory.Single ; GetHashList: @TExtendedHashFactory.Single );
|
|
ExtendedEqualityComparer_Double_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Double ; GetHashCode: @THashFactory.Double ; GetHashList: @TExtendedHashFactory.Double );
|
|
ExtendedEqualityComparer_Extended_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Extended; GetHashCode: @THashFactory.Extended; GetHashList: @TExtendedHashFactory.Extended);
|
|
|
|
ExtendedEqualityComparer_Currency_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Currency; GetHashCode: @THashFactory.Currency; GetHashList: @TExtendedHashFactory.Currency);
|
|
ExtendedEqualityComparer_Comp_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Comp ; GetHashCode: @THashFactory.Comp ; GetHashList: @TExtendedHashFactory.Comp );
|
|
|
|
ExtendedEqualityComparer_Binary_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._Binary ; GetHashCode: @THashFactory.Binary ; GetHashList: @TExtendedHashFactory.Binary );
|
|
ExtendedEqualityComparer_DynArray_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._DynArray; GetHashCode: @THashFactory.DynArray; GetHashList: @TExtendedHashFactory.DynArray);
|
|
|
|
ExtendedEqualityComparer_Class_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.&Class; GetHashCode: @THashFactory.&Class; GetHashList: @TExtendedHashFactory.&Class);
|
|
|
|
ExtendedEqualityComparer_ShortString1_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString1 ; GetHashCode: @THashFactory.ShortString1 ; GetHashList: @TExtendedHashFactory.ShortString1 );
|
|
ExtendedEqualityComparer_ShortString2_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString2 ; GetHashCode: @THashFactory.ShortString2 ; GetHashList: @TExtendedHashFactory.ShortString2 );
|
|
ExtendedEqualityComparer_ShortString3_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString3 ; GetHashCode: @THashFactory.ShortString3 ; GetHashList: @TExtendedHashFactory.ShortString3 );
|
|
ExtendedEqualityComparer_ShortString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString ; GetHashCode: @THashFactory.ShortString ; GetHashList: @TExtendedHashFactory.ShortString );
|
|
ExtendedEqualityComparer_AnsiString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.AnsiString ; GetHashCode: @THashFactory.AnsiString ; GetHashList: @TExtendedHashFactory.AnsiString );
|
|
ExtendedEqualityComparer_WideString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.WideString ; GetHashCode: @THashFactory.WideString ; GetHashList: @TExtendedHashFactory.WideString );
|
|
ExtendedEqualityComparer_UnicodeString_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UnicodeString; GetHashCode: @THashFactory.UnicodeString; GetHashList: @TExtendedHashFactory.UnicodeString);
|
|
|
|
ExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method ; GetHashList: @TExtendedHashFactory.Method );
|
|
ExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant; GetHashList: @TExtendedHashFactory.Variant);
|
|
ExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer; GetHashList: @TExtendedHashFactory.Pointer);
|
|
{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
|
|
private class var
|
|
// IExtendedEqualityComparer VMT
|
|
FExtendedEqualityComparer_Int8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Int16_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Int32_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Int64_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_UInt8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_UInt16_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_UInt32_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_UInt64_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Single_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Double_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Extended_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Currency_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Comp_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Binary_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_DynArray_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Class_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_ShortString1_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_ShortString2_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_ShortString3_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_ShortString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_AnsiString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_WideString_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_UnicodeString_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
FExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
|
|
|
|
FExtendedEqualityComparer_Int8_Instance : Pointer;
|
|
FExtendedEqualityComparer_Int16_Instance : Pointer;
|
|
FExtendedEqualityComparer_Int32_Instance : Pointer;
|
|
FExtendedEqualityComparer_Int64_Instance : Pointer;
|
|
FExtendedEqualityComparer_UInt8_Instance : Pointer;
|
|
FExtendedEqualityComparer_UInt16_Instance : Pointer;
|
|
FExtendedEqualityComparer_UInt32_Instance : Pointer;
|
|
FExtendedEqualityComparer_UInt64_Instance : Pointer;
|
|
|
|
FExtendedEqualityComparer_Single_Instance : Pointer;
|
|
FExtendedEqualityComparer_Double_Instance : Pointer;
|
|
FExtendedEqualityComparer_Extended_Instance : Pointer;
|
|
|
|
FExtendedEqualityComparer_Currency_Instance : Pointer;
|
|
FExtendedEqualityComparer_Comp_Instance : Pointer;
|
|
|
|
//FExtendedEqualityComparer_Binary_Instance : Pointer; // dynamic instance
|
|
//FExtendedEqualityComparer_DynArray_Instance : Pointer; // dynamic instance
|
|
|
|
FExtendedEqualityComparer_ShortString1_Instance : Pointer;
|
|
FExtendedEqualityComparer_ShortString2_Instance : Pointer;
|
|
FExtendedEqualityComparer_ShortString3_Instance : Pointer;
|
|
FExtendedEqualityComparer_ShortString_Instance : Pointer;
|
|
FExtendedEqualityComparer_AnsiString_Instance : Pointer;
|
|
FExtendedEqualityComparer_WideString_Instance : Pointer;
|
|
FExtendedEqualityComparer_UnicodeString_Instance: Pointer;
|
|
|
|
FExtendedEqualityComparer_Method_Instance : Pointer;
|
|
FExtendedEqualityComparer_Variant_Instance : Pointer;
|
|
FExtendedEqualityComparer_Pointer_Instance : Pointer;
|
|
|
|
// all instances
|
|
FExtendedEqualityComparerInstances: array[TTypeKind] of TInstance;
|
|
private
|
|
class constructor Create;
|
|
public
|
|
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
|
|
end;
|
|
|
|
TOnEqualityComparison<T> = function(constref ALeft, ARight: T): Boolean of object;
|
|
TEqualityComparisonFunc<T> = function(constref ALeft, ARight: T): Boolean;
|
|
|
|
TOnHasher<T> = function(constref AValue: T): UInt32 of object;
|
|
TOnExtendedHasher<T> = procedure(constref AValue: T; AHashList: PUInt32) of object;
|
|
THasherFunc<T> = function(constref AValue: T): UInt32;
|
|
TExtendedHasherFunc<T> = procedure(constref AValue: T; AHashList: PUInt32);
|
|
|
|
TEqualityComparer<T> = class(TInterfacedObject, IEqualityComparer<T>)
|
|
public
|
|
class function Default: IEqualityComparer<T>; static; overload;
|
|
class function Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>; static; overload;
|
|
|
|
class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>): IEqualityComparer<T>; overload;
|
|
class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>): IEqualityComparer<T>; overload;
|
|
|
|
function Equals(constref ALeft, ARight: T): Boolean; virtual; overload; abstract;
|
|
function GetHashCode(constref AValue: T): UInt32; virtual; overload; abstract;
|
|
end;
|
|
|
|
{ TDelegatedEqualityComparerEvent }
|
|
|
|
TDelegatedEqualityComparerEvents<T> = class(TEqualityComparer<T>)
|
|
private
|
|
FEqualityComparison: TOnEqualityComparison<T>;
|
|
FHasher: TOnHasher<T>;
|
|
public
|
|
function Equals(constref ALeft, ARight: T): Boolean; override;
|
|
function GetHashCode(constref AValue: T): UInt32; override;
|
|
|
|
constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>);
|
|
end;
|
|
|
|
TDelegatedEqualityComparerFunc<T> = class(TEqualityComparer<T>)
|
|
private
|
|
FEqualityComparison: TEqualityComparisonFunc<T>;
|
|
FHasher: THasherFunc<T>;
|
|
public
|
|
function Equals(constref ALeft, ARight: T): Boolean; override;
|
|
function GetHashCode(constref AValue: T): UInt32; override;
|
|
|
|
constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>);
|
|
end;
|
|
|
|
{ TExtendedEqualityComparer }
|
|
|
|
TExtendedEqualityComparer<T> = class(TEqualityComparer<T>, IExtendedEqualityComparer<T>)
|
|
public
|
|
class function Default: IExtendedEqualityComparer<T>; static; overload; reintroduce;
|
|
class function Default(AExtenedHashFactoryClass: TExtendedHashFactoryClass): IExtendedEqualityComparer<T>; static; overload; reintroduce;
|
|
|
|
class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
|
|
class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
|
|
class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
|
|
class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
|
|
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); virtual; abstract;
|
|
end;
|
|
|
|
TDelegatedExtendedEqualityComparerEvents<T> = class(TExtendedEqualityComparer<T>)
|
|
private
|
|
FEqualityComparison: TOnEqualityComparison<T>;
|
|
FHasher: TOnHasher<T>;
|
|
FExtendedHasher: TOnExtendedHasher<T>;
|
|
|
|
function GetHashCodeMethod(constref AValue: T): UInt32;
|
|
public
|
|
function Equals(constref ALeft, ARight: T): Boolean; override;
|
|
function GetHashCode(constref AValue: T): UInt32; override;
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
|
|
|
|
constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>); overload;
|
|
constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AExtendedHasher: TOnExtendedHasher<T>); overload;
|
|
end;
|
|
|
|
TDelegatedExtendedEqualityComparerFunc<T> = class(TExtendedEqualityComparer<T>)
|
|
private
|
|
FEqualityComparison: TEqualityComparisonFunc<T>;
|
|
FHasher: THasherFunc<T>;
|
|
FExtendedHasher: TExtendedHasherFunc<T>;
|
|
public
|
|
function Equals(constref ALeft, ARight: T): Boolean; override;
|
|
function GetHashCode(constref AValue: T): UInt32; override;
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
|
|
|
|
constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>); overload;
|
|
constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AExtendedHasher: TExtendedHasherFunc<T>); overload;
|
|
end;
|
|
|
|
{ TDelphiHashFactory }
|
|
|
|
TDelphiHashFactory = class(THashFactory)
|
|
public
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
end;
|
|
|
|
TmORMotHashFactory = class(THashFactory)
|
|
public
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
end;
|
|
|
|
{ TAdler32HashFactory }
|
|
|
|
TAdler32HashFactory = class(THashFactory)
|
|
public
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
end;
|
|
|
|
{ TSdbmHashFactory }
|
|
|
|
TSdbmHashFactory = class(THashFactory)
|
|
public
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
end;
|
|
|
|
{ TSdbmHashFactory }
|
|
|
|
TSimpleChecksumFactory = class(THashFactory)
|
|
public
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
end;
|
|
|
|
{ TDelphiDoubleHashFactory }
|
|
|
|
TDelphiDoubleHashFactory = class(TExtendedHashFactory)
|
|
public
|
|
const MAX_HASHLIST_COUNT = 2;
|
|
const HASH_FUNCTIONS_COUNT = 1;
|
|
const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2);
|
|
const HASH_FUNCTIONS_MASK_SIZE = 1;
|
|
const HASH_FUNCTIONS_MASK = 1; // 00000001b
|
|
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
|
|
end;
|
|
|
|
TDelphiQuadrupleHashFactory = class(TExtendedHashFactory)
|
|
public
|
|
const MAX_HASHLIST_COUNT = 4;
|
|
const HASH_FUNCTIONS_COUNT = 2;
|
|
const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2, 2);
|
|
const HASH_FUNCTIONS_MASK_SIZE = 2;
|
|
const HASH_FUNCTIONS_MASK = 3; // 00000011b
|
|
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
|
|
end;
|
|
|
|
TDelphiSixfoldHashFactory = class(TExtendedHashFactory)
|
|
public
|
|
const MAX_HASHLIST_COUNT = 6;
|
|
const HASH_FUNCTIONS_COUNT = 3;
|
|
const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2, 2, 2);
|
|
const HASH_FUNCTIONS_MASK_SIZE = 3;
|
|
const HASH_FUNCTIONS_MASK = 7; // 00000111b
|
|
|
|
class function GetHashService: THashServiceClass; override;
|
|
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
|
|
class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
|
|
end;
|
|
|
|
TDefaultHashFactory = TmORMotHashFactory;
|
|
|
|
TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
|
|
|
|
TCustomComparer<T> = class(TSingletonImplementation, IComparer<T>, IEqualityComparer<T>, IExtendedEqualityComparer<T>)
|
|
protected
|
|
function Compare(constref Left, Right: T): Integer; virtual; abstract;
|
|
function Equals(constref Left, Right: T): Boolean; reintroduce; overload; virtual; abstract;
|
|
function GetHashCode(constref Value: T): UInt32; reintroduce; overload; virtual; abstract;
|
|
procedure GetHashList(constref Value: T; AHashList: PUInt32); virtual; abstract;
|
|
end;
|
|
|
|
TOrdinalComparer<T, THashFactory> = class(TCustomComparer<T>)
|
|
protected class var
|
|
FComparer: IComparer<T>;
|
|
FEqualityComparer: IEqualityComparer<T>;
|
|
FExtendedEqualityComparer: IExtendedEqualityComparer<T>;
|
|
|
|
class constructor Create;
|
|
public
|
|
class function Ordinal: TCustomComparer<T>; virtual; abstract;
|
|
end;
|
|
|
|
// TGStringComparer will be renamed to TStringComparer -> bug #26030
|
|
// anyway class var can't be used safely -> bug #24848
|
|
|
|
TGStringComparer<T, THashFactory> = class(TOrdinalComparer<T, THashFactory>)
|
|
private class var
|
|
FOrdinal: TCustomComparer<T>;
|
|
class destructor Destroy;
|
|
public
|
|
class function Ordinal: TCustomComparer<T>; override;
|
|
end;
|
|
|
|
TGStringComparer<T> = class(TGStringComparer<T, TDelphiQuadrupleHashFactory>);
|
|
TStringComparer = class(TGStringComparer<string>);
|
|
TAnsiStringComparer = class(TGStringComparer<AnsiString>);
|
|
TUnicodeStringComparer = class(TGStringComparer<UnicodeString>);
|
|
|
|
{ TGOrdinalStringComparer }
|
|
|
|
// TGOrdinalStringComparer will be renamed to TOrdinalStringComparer -> bug #26030
|
|
// anyway class var can't be used safely -> bug #24848
|
|
TGOrdinalStringComparer<T, THashFactory> = class(TGStringComparer<T, THashFactory>)
|
|
public
|
|
function Compare(constref ALeft, ARight: T): Integer; override;
|
|
function Equals(constref ALeft, ARight: T): Boolean; overload; override;
|
|
function GetHashCode(constref AValue: T): UInt32; overload; override;
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
|
|
end;
|
|
|
|
TGOrdinalStringComparer<T> = class(TGOrdinalStringComparer<T, TDelphiQuadrupleHashFactory>);
|
|
TOrdinalStringComparer = class(TGOrdinalStringComparer<string>);
|
|
|
|
TGIStringComparer<T, THashFactory> = class(TOrdinalComparer<T, THashFactory>)
|
|
private class var
|
|
FOrdinal: TCustomComparer<T>;
|
|
class destructor Destroy;
|
|
public
|
|
class function Ordinal: TCustomComparer<T>; override;
|
|
end;
|
|
|
|
TGIStringComparer<T> = class(TGIStringComparer<T, TDelphiQuadrupleHashFactory>);
|
|
TIStringComparer = class(TGIStringComparer<string>);
|
|
TIAnsiStringComparer = class(TGIStringComparer<AnsiString>);
|
|
TIUnicodeStringComparer = class(TGIStringComparer<UnicodeString>);
|
|
|
|
TGOrdinalIStringComparer<T, THashFactory> = class(TGIStringComparer<T, THashFactory>)
|
|
public
|
|
function Compare(constref ALeft, ARight: T): Integer; override;
|
|
function Equals(constref ALeft, ARight: T): Boolean; overload; override;
|
|
function GetHashCode(constref AValue: T): UInt32; overload; override;
|
|
procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
|
|
end;
|
|
|
|
TGOrdinalIStringComparer<T> = class(TGOrdinalIStringComparer<T, TDelphiQuadrupleHashFactory>);
|
|
TOrdinalIStringComparer = class(TGOrdinalIStringComparer<string>);
|
|
|
|
// Delphi version of Bob Jenkins Hash
|
|
function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer; // same result as HashLittle_Delphi, just different interface
|
|
function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer; inline;
|
|
|
|
function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; inline;
|
|
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
|
|
AFactory: THashFactoryClass): Pointer;
|
|
|
|
implementation
|
|
|
|
{ TComparer<T> }
|
|
|
|
class function TComparer<T>.Default: IComparer<T>;
|
|
begin
|
|
Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T));
|
|
end;
|
|
|
|
class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;
|
|
begin
|
|
Result := TDelegatedComparerEvents<T>.Create(AComparison);
|
|
end;
|
|
|
|
class function TComparer<T>.Construct(const AComparison: TComparisonFunc<T>): IComparer<T>;
|
|
begin
|
|
Result := TDelegatedComparerFunc<T>.Create(AComparison);
|
|
end;
|
|
|
|
function TDelegatedComparerEvents<T>.Compare(constref ALeft, ARight: T): Integer;
|
|
begin
|
|
Result := FComparison(ALeft, ARight);
|
|
end;
|
|
|
|
constructor TDelegatedComparerEvents<T>.Create(AComparison: TOnComparison<T>);
|
|
begin
|
|
FComparison := AComparison;
|
|
end;
|
|
|
|
function TDelegatedComparerFunc<T>.Compare(constref ALeft, ARight: T): Integer;
|
|
begin
|
|
Result := FComparison(ALeft, ARight);
|
|
end;
|
|
|
|
constructor TDelegatedComparerFunc<T>.Create(AComparison: TComparisonFunc<T>);
|
|
begin
|
|
FComparison := AComparison;
|
|
end;
|
|
|
|
{ TInterface }
|
|
|
|
function TInterface.QueryInterface(constref IID: TGUID; out Obj): HResult;
|
|
begin
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
{ TRawInterface }
|
|
|
|
function TRawInterface._AddRef: LongInt;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRawInterface._Release: LongInt;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
{ TComTypeSizeInterface }
|
|
|
|
function TComTypeSizeInterface._AddRef: LongInt;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := InterLockedIncrement(_self.RefCount);
|
|
end;
|
|
|
|
function TComTypeSizeInterface._Release: LongInt;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := InterLockedDecrement(_self.RefCount);
|
|
if _self.RefCount = 0 then
|
|
Dispose(_self);
|
|
end;
|
|
|
|
{ TSingletonImplementation }
|
|
|
|
function TSingletonImplementation.QueryInterface(constref IID: TGUID; out Obj): HResult;
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := S_OK
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
{ TCompare }
|
|
|
|
(***********************************************************************************************************************
|
|
Comparers
|
|
(**********************************************************************************************************************)
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers Int8 - Int32 and UInt8 - UInt32
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Integer(constref ALeft, ARight: Integer): Integer;
|
|
begin
|
|
Result := Math.CompareValue(ALeft, ARight);
|
|
end;
|
|
|
|
class function TCompare.Int8(constref ALeft, ARight: Int8): Integer;
|
|
begin
|
|
Result := ALeft - ARight;
|
|
end;
|
|
|
|
class function TCompare.Int16(constref ALeft, ARight: Int16): Integer;
|
|
begin
|
|
Result := ALeft - ARight;
|
|
end;
|
|
|
|
class function TCompare.Int32(constref ALeft, ARight: Int32): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.Int64(constref ALeft, ARight: Int64): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.UInt8(constref ALeft, ARight: UInt8): Integer;
|
|
begin
|
|
Result := System.Integer(ALeft) - System.Integer(ARight);
|
|
end;
|
|
|
|
class function TCompare.UInt16(constref ALeft, ARight: UInt16): Integer;
|
|
begin
|
|
Result := System.Integer(ALeft) - System.Integer(ARight);
|
|
end;
|
|
|
|
class function TCompare.UInt32(constref ALeft, ARight: UInt32): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.UInt64(constref ALeft, ARight: UInt64): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for Float types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Single(constref ALeft, ARight: Single): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.Double(constref ALeft, ARight: Double): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.Extended(constref ALeft, ARight: Extended): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for other number types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Currency(constref ALeft, ARight: Currency): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.Comp(constref ALeft, ARight: Comp): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for binary data (records etc) and dynamics arrays
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare._Binary(constref ALeft, ARight): Integer;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := CompareMemRange(@ALeft, @ARight, _self.Size);
|
|
end;
|
|
|
|
class function TCompare._DynArray(constref ALeft, ARight: Pointer): Integer;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
LLength, LLeftLength, LRightLength: Integer;
|
|
begin
|
|
LLeftLength := DynArraySize(ALeft);
|
|
LRightLength := DynArraySize(ARight);
|
|
if LLeftLength > LRightLength then
|
|
LLength := LRightLength
|
|
else
|
|
LLength := LLeftLength;
|
|
|
|
Result := CompareMemRange(ALeft, ARight, LLength * _self.Size);
|
|
|
|
if Result = 0 then
|
|
Result := LLeftLength - LRightLength;
|
|
end;
|
|
|
|
class function TCompare.Binary(constref ALeft, ARight; const ASize: SizeInt): Integer;
|
|
begin
|
|
Result := CompareMemRange(@ALeft, @ARight, ASize);
|
|
end;
|
|
|
|
class function TCompare.DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Integer;
|
|
var
|
|
LLength, LLeftLength, LRightLength: Integer;
|
|
begin
|
|
LLeftLength := DynArraySize(ALeft);
|
|
LRightLength := DynArraySize(ARight);
|
|
if LLeftLength > LRightLength then
|
|
LLength := LRightLength
|
|
else
|
|
LLength := LLeftLength;
|
|
|
|
Result := CompareMemRange(ALeft, ARight, LLength * AElementSize);
|
|
|
|
if Result = 0 then
|
|
Result := LLeftLength - LRightLength;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for string types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.ShortString1(constref ALeft, ARight: ShortString1): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.ShortString2(constref ALeft, ARight: ShortString2): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.ShortString3(constref ALeft, ARight: ShortString3): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.ShortString(constref ALeft, ARight: ShortString): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
class function TCompare.&String(constref ALeft, ARight: String): Integer;
|
|
begin
|
|
Result := CompareStr(ALeft, ARight);
|
|
end;
|
|
|
|
class function TCompare.AnsiString(constref ALeft, ARight: AnsiString): Integer;
|
|
begin
|
|
Result := AnsiCompareStr(ALeft, ARight);
|
|
end;
|
|
|
|
class function TCompare.WideString(constref ALeft, ARight: WideString): Integer;
|
|
begin
|
|
Result := WideCompareStr(ALeft, ARight);
|
|
end;
|
|
|
|
class function TCompare.UnicodeString(constref ALeft, ARight: UnicodeString): Integer;
|
|
begin
|
|
Result := UnicodeCompareStr(ALeft, ARight);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for Delegates
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Method(constref ALeft, ARight: TMethod): Integer;
|
|
begin
|
|
Result := CompareMemRange(@ALeft, @ARight, SizeOf(System.TMethod));
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for Variant
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Variant(constref ALeft, ARight: PVariant): Integer;
|
|
var
|
|
LLeftString, LRightString: string;
|
|
begin
|
|
try
|
|
case VarCompareValue(ALeft^, ARight^) of
|
|
vrGreaterThan:
|
|
Exit(1);
|
|
vrLessThan:
|
|
Exit(-1);
|
|
vrEqual:
|
|
Exit(0);
|
|
vrNotEqual:
|
|
if VarIsEmpty(ALeft^) or VarIsNull(ALeft^) then
|
|
Exit(1)
|
|
else
|
|
Exit(-1);
|
|
end;
|
|
except
|
|
try
|
|
LLeftString := ALeft^;
|
|
LRightString := ARight^;
|
|
Result := CompareStr(LLeftString, LRightString);
|
|
except
|
|
Result := CompareMemRange(ALeft, ARight, SizeOf(System.Variant));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Comparers for Pointer
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TCompare.Pointer(constref ALeft, ARight: PtrUInt): Integer;
|
|
begin
|
|
if ALeft > ARight then
|
|
Exit(1)
|
|
else if ALeft < ARight then
|
|
Exit(-1)
|
|
else
|
|
Exit(0);
|
|
end;
|
|
|
|
{ TEquals }
|
|
|
|
(***********************************************************************************************************************
|
|
Equality Comparers
|
|
(**********************************************************************************************************************)
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers Int8 - Int32 and UInt8 - UInt32
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Integer(constref ALeft, ARight: Integer): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Int8(constref ALeft, ARight: Int8): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Int16(constref ALeft, ARight: Int16): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Int32(constref ALeft, ARight: Int32): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Int64(constref ALeft, ARight: Int64): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.UInt8(constref ALeft, ARight: UInt8): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.UInt16(constref ALeft, ARight: UInt16): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.UInt32(constref ALeft, ARight: UInt32): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.UInt64(constref ALeft, ARight: UInt64): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for Float types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Single(constref ALeft, ARight: Single): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Double(constref ALeft, ARight: Double): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Extended(constref ALeft, ARight: Extended): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for other number types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Currency(constref ALeft, ARight: Currency): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.Comp(constref ALeft, ARight: Comp): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for binary data (records etc) and dynamics arrays
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals._Binary(constref ALeft, ARight): Boolean;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := CompareMem(@ALeft, @ARight, _self.Size);
|
|
end;
|
|
|
|
class function TEquals._DynArray(constref ALeft, ARight: Pointer): Boolean;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
LLength: Integer;
|
|
begin
|
|
LLength := DynArraySize(ALeft);
|
|
if LLength <> DynArraySize(ARight) then
|
|
Exit(False);
|
|
|
|
Result := CompareMem(ALeft, ARight, LLength * _self.Size);
|
|
end;
|
|
|
|
class function TEquals.Binary(constref ALeft, ARight; const ASize: SizeInt): Boolean;
|
|
begin
|
|
Result := CompareMem(@ALeft, @ARight, ASize);
|
|
end;
|
|
|
|
class function TEquals.DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Boolean;
|
|
var
|
|
LLength: Integer;
|
|
begin
|
|
LLength := DynArraySize(ALeft);
|
|
if LLength <> DynArraySize(ARight) then
|
|
Exit(False);
|
|
|
|
Result := CompareMem(ALeft, ARight, LLength * AElementSize);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for classes
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.&class(constref ALeft, ARight: TObject): Boolean;
|
|
begin
|
|
if ALeft <> nil then
|
|
Exit(ALeft.Equals(ARight))
|
|
else
|
|
Exit(ARight = nil);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for string types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.ShortString1(constref ALeft, ARight: ShortString1): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.ShortString2(constref ALeft, ARight: ShortString2): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.ShortString3(constref ALeft, ARight: ShortString3): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.&String(constref ALeft, ARight: String): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.ShortString(constref ALeft, ARight: ShortString): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.AnsiString(constref ALeft, ARight: AnsiString): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.WideString(constref ALeft, ARight: WideString): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
class function TEquals.UnicodeString(constref ALeft, ARight: UnicodeString): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for Delegates
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Method(constref ALeft, ARight: TMethod): Boolean;
|
|
begin
|
|
Result := (ALeft.Code = ARight.Code) and (ALeft.Data = ARight.Data);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for Variant
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Variant(constref ALeft, ARight: PVariant): Boolean;
|
|
begin
|
|
Result := VarCompareValue(ALeft^, ARight^) = vrEqual;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
Equality Comparers for Pointer
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function TEquals.Pointer(constref ALeft, ARight: PtrUInt): Boolean;
|
|
begin
|
|
Result := ALeft = ARight;
|
|
end;
|
|
|
|
(***********************************************************************************************************************
|
|
Hashes
|
|
(**********************************************************************************************************************)
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode Int8 - Int32 and UInt8 - UInt32
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Int8(constref AValue: Int8): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int8), 0);
|
|
end;
|
|
|
|
class function THashFactory.Int16(constref AValue: Int16): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int16), 0);
|
|
end;
|
|
|
|
class function THashFactory.Int32(constref AValue: Int32): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int32), 0);
|
|
end;
|
|
|
|
class function THashFactory.Int64(constref AValue: Int64): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
|
|
end;
|
|
|
|
class function THashFactory.UInt8(constref AValue: UInt8): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt8), 0);
|
|
end;
|
|
|
|
class function THashFactory.UInt16(constref AValue: UInt16): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt16), 0);
|
|
end;
|
|
|
|
class function THashFactory.UInt32(constref AValue: UInt32): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt32), 0);
|
|
end;
|
|
|
|
class function THashFactory.UInt64(constref AValue: UInt64): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt64), 0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Float types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Single(constref AValue: Single): UInt32;
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
|
|
Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
|
|
end;
|
|
|
|
class function THashFactory.Double(constref AValue: Double): UInt32;
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
|
|
Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
|
|
end;
|
|
|
|
class function THashFactory.Extended(constref AValue: Extended): UInt32;
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
|
|
Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for other number types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Currency(constref AValue: Currency): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
|
|
end;
|
|
|
|
class function THashFactory.Comp(constref AValue: Comp): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for binary data (records etc) and dynamics arrays
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Binary(constref AValue): UInt32;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, _self.Size, 0);
|
|
end;
|
|
|
|
class function THashFactory.DynArray(constref AValue: Pointer): UInt32;
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(AValue, DynArraySize(AValue) * _self.Size, 0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for classes
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.&Class(constref AValue: TObject): UInt32;
|
|
begin
|
|
if AValue = nil then
|
|
Exit($2A);
|
|
|
|
Result := AValue.GetHashCode;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for string types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.ShortString1(constref AValue: ShortString1): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
|
|
end;
|
|
|
|
class function THashFactory.ShortString2(constref AValue: ShortString2): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
|
|
end;
|
|
|
|
class function THashFactory.ShortString3(constref AValue: ShortString3): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
|
|
end;
|
|
|
|
class function THashFactory.ShortString(constref AValue: ShortString): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
|
|
end;
|
|
|
|
class function THashFactory.AnsiString(constref AValue: AnsiString): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.AnsiChar), 0);
|
|
end;
|
|
|
|
class function THashFactory.WideString(constref AValue: WideString): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.WideChar), 0);
|
|
end;
|
|
|
|
class function THashFactory.UnicodeString(constref AValue: UnicodeString): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.UnicodeChar), 0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Delegates
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Method(constref AValue: TMethod): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.TMethod), 0);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Variant
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Variant(constref AValue: PVariant): UInt32;
|
|
begin
|
|
try
|
|
Result := HASH_FACTORY.UnicodeString(AValue^);
|
|
except
|
|
Result := HASH_FACTORY.GetHashCode(AValue, SizeOf(System.Variant), 0);
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Pointer
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class function THashFactory.Pointer(constref AValue: Pointer): UInt32;
|
|
begin
|
|
Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Pointer), 0);
|
|
end;
|
|
|
|
{ TExtendedHashFactory }
|
|
|
|
(***********************************************************************************************************************
|
|
Hashes 2
|
|
(**********************************************************************************************************************)
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode Int8 - Int32 and UInt8 - UInt32
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Int8(constref AValue: Int8; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int8), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Int16(constref AValue: Int16; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int16), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Int32(constref AValue: Int32; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int32), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Int64(constref AValue: Int64; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.UInt8(constref AValue: UInt8; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt8), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.UInt16(constref AValue: UInt16; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt16), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.UInt32(constref AValue: UInt32; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt32), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.UInt64(constref AValue: UInt64; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt64), AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Float types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Single(constref AValue: Single; AHashList: PUInt32);
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Double(constref AValue: Double; AHashList: PUInt32);
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Extended(constref AValue: Extended; AHashList: PUInt32);
|
|
var
|
|
LMantissa: Float;
|
|
LExponent: Integer;
|
|
begin
|
|
Frexp(AValue, LMantissa, LExponent);
|
|
|
|
if LMantissa = 0 then
|
|
LMantissa := Abs(LMantissa);
|
|
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for other number types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Currency(constref AValue: Currency; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.Comp(constref AValue: Comp; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for binary data (records etc) and dynamics arrays
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Binary(constref AValue; AHashList: PUInt32);
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, _self.Size, AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.DynArray(constref AValue: Pointer; AHashList: PUInt32);
|
|
var
|
|
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(AValue, DynArraySize(AValue) * _self.Size, AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for classes
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.&Class(constref AValue: TObject; AHashList: PUInt32);
|
|
var
|
|
LValue: PtrInt;
|
|
begin
|
|
if AValue = nil then
|
|
begin
|
|
LValue := $2A;
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LValue, SizeOf(LValue), AHashList, []);
|
|
Exit;
|
|
end;
|
|
|
|
LValue := AValue.GetHashCode;
|
|
EXTENDED_HASH_FACTORY.GetHashList(@LValue, SizeOf(LValue), AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for string types
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.ShortString1(constref AValue: ShortString1; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.ShortString2(constref AValue: ShortString2; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.ShortString3(constref AValue: ShortString3; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.ShortString(constref AValue: ShortString; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.AnsiString(constref AValue: AnsiString; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.AnsiChar), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.WideString(constref AValue: WideString; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.WideChar), AHashList, []);
|
|
end;
|
|
|
|
class procedure TExtendedHashFactory.UnicodeString(constref AValue: UnicodeString; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.UnicodeChar), AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Delegates
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Method(constref AValue: TMethod; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.TMethod), AHashList, []);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Variant
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Variant(constref AValue: PVariant; AHashList: PUInt32);
|
|
begin
|
|
try
|
|
EXTENDED_HASH_FACTORY.UnicodeString(AValue^, AHashList);
|
|
except
|
|
EXTENDED_HASH_FACTORY.GetHashList(AValue, SizeOf(System.Variant), AHashList, []);
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------------------------------------------------
|
|
GetHashCode for Pointer
|
|
{----------------------------------------------------------------------------------------------------------------------}
|
|
|
|
class procedure TExtendedHashFactory.Pointer(constref AValue: Pointer; AHashList: PUInt32);
|
|
begin
|
|
EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Pointer), AHashList, []);
|
|
end;
|
|
|
|
{ TComparerService }
|
|
|
|
class function TComparerService.CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject;
|
|
begin
|
|
Result := New(PSpoofInterfacedTypeSizeObject);
|
|
Result.VMT := AVMT;
|
|
Result.RefCount := 0;
|
|
Result.Size := ASize;
|
|
end;
|
|
|
|
class function TComparerService.SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.OrdType of
|
|
otSByte:
|
|
Exit(@Comparer_Int8_Instance);
|
|
otUByte:
|
|
Exit(@Comparer_UInt8_Instance);
|
|
otSWord:
|
|
Exit(@Comparer_Int16_Instance);
|
|
otUWord:
|
|
Exit(@Comparer_UInt16_Instance);
|
|
otSLong:
|
|
Exit(@Comparer_Int32_Instance);
|
|
otULong:
|
|
Exit(@Comparer_UInt32_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function TComparerService.SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
if ATypeData.MaxInt64Value > ATypeData.MinInt64Value then
|
|
Exit(@Comparer_Int64_Instance)
|
|
else
|
|
Exit(@Comparer_UInt64_Instance);
|
|
end;
|
|
|
|
class function TComparerService.SelectFloatComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.FloatType of
|
|
ftSingle:
|
|
Exit(@Comparer_Single_Instance);
|
|
ftDouble:
|
|
Exit(@Comparer_Double_Instance);
|
|
ftExtended:
|
|
Exit(@Comparer_Extended_Instance);
|
|
ftComp:
|
|
Exit(@Comparer_Comp_Instance);
|
|
ftCurr:
|
|
Exit(@Comparer_Currency_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function TComparerService.SelectShortStringComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
2: Exit(@Comparer_ShortString1_Instance);
|
|
3: Exit(@Comparer_ShortString2_Instance);
|
|
4: Exit(@Comparer_ShortString3_Instance);
|
|
else
|
|
Exit(@Comparer_ShortString_Instance);
|
|
end;
|
|
end;
|
|
|
|
class function TComparerService.SelectBinaryComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
1: Exit(@Comparer_UInt8_Instance);
|
|
2: Exit(@Comparer_UInt16_Instance);
|
|
4: Exit(@Comparer_UInt32_Instance);
|
|
{$IFDEF CPU64}
|
|
8: Exit(@Comparer_UInt64_Instance)
|
|
{$ENDIF}
|
|
else
|
|
Result := CreateInterface(@Comparer_Binary_VMT, ASize);
|
|
end;
|
|
end;
|
|
|
|
class function TComparerService.SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
Result := CreateInterface(@Comparer_DynArray_VMT, ATypeData.elSize);
|
|
end;
|
|
|
|
class function TComparerService.LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
|
|
var
|
|
LInstance: PInstance;
|
|
begin
|
|
if ATypeInfo = nil then
|
|
Exit(SelectBinaryComparer(GetTypeData(ATypeInfo), ASize))
|
|
else
|
|
begin
|
|
LInstance := @ComparerInstances[ATypeInfo.Kind];
|
|
Result := LInstance.Instance;
|
|
if LInstance.Selector then
|
|
Result := TSelectFunc(Result)(GetTypeData(ATypeInfo), ASize);
|
|
end;
|
|
end;
|
|
|
|
{ TComparerService.TInstance }
|
|
|
|
class function TComparerService.TInstance.Create(ASelector: Boolean;
|
|
AInstance: Pointer): TComparerService.TInstance;
|
|
begin
|
|
Result.Selector := ASelector;
|
|
Result.Instance := AInstance;
|
|
end;
|
|
|
|
class function TComparerService.TInstance.CreateSelector(ASelectorInstance: CodePointer): TComparerService.TInstance;
|
|
begin
|
|
Result.Selector := True;
|
|
Result.SelectorInstance := ASelectorInstance;
|
|
end;
|
|
|
|
{ THashService }
|
|
|
|
class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.OrdType of
|
|
otSByte:
|
|
Exit(@FEqualityComparer_Int8_Instance);
|
|
otUByte:
|
|
Exit(@FEqualityComparer_UInt8_Instance);
|
|
otSWord:
|
|
Exit(@FEqualityComparer_Int16_Instance);
|
|
otUWord:
|
|
Exit(@FEqualityComparer_UInt16_Instance);
|
|
otSLong:
|
|
Exit(@FEqualityComparer_Int32_Instance);
|
|
otULong:
|
|
Exit(@FEqualityComparer_UInt32_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function THashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.FloatType of
|
|
ftSingle:
|
|
Exit(@FEqualityComparer_Single_Instance);
|
|
ftDouble:
|
|
Exit(@FEqualityComparer_Double_Instance);
|
|
ftExtended:
|
|
Exit(@FEqualityComparer_Extended_Instance);
|
|
ftComp:
|
|
Exit(@FEqualityComparer_Comp_Instance);
|
|
ftCurr:
|
|
Exit(@FEqualityComparer_Currency_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function THashService<T>.SelectShortStringEqualityComparer(
|
|
ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
2: Exit(@FEqualityComparer_ShortString1_Instance);
|
|
3: Exit(@FEqualityComparer_ShortString2_Instance);
|
|
4: Exit(@FEqualityComparer_ShortString3_Instance);
|
|
else
|
|
Exit(@FEqualityComparer_ShortString_Instance);
|
|
end
|
|
end;
|
|
|
|
class function THashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
1: Exit(@FEqualityComparer_UInt8_Instance);
|
|
2: Exit(@FEqualityComparer_UInt16_Instance);
|
|
4: Exit(@FEqualityComparer_UInt32_Instance);
|
|
{$IFDEF CPU64}
|
|
8: Exit(@FEqualityComparer_UInt64_Instance)
|
|
{$ENDIF}
|
|
else
|
|
Result := CreateInterface(@FEqualityComparer_Binary_VMT, ASize);
|
|
end;
|
|
end;
|
|
|
|
class function THashService<T>.SelectDynArrayEqualityComparer(
|
|
ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
Result := CreateInterface(@FEqualityComparer_DynArray_VMT, ATypeData.elSize);
|
|
end;
|
|
|
|
class function THashService<T>.LookupEqualityComparer(ATypeInfo: PTypeInfo;
|
|
ASize: SizeInt): Pointer;
|
|
var
|
|
LInstance: PInstance;
|
|
LSelectMethod: TSelectMethod;
|
|
begin
|
|
if ATypeInfo = nil then
|
|
Exit(SelectBinaryEqualityComparer(GetTypeData(ATypeInfo), ASize))
|
|
else
|
|
begin
|
|
LInstance := @FEqualityComparerInstances[ATypeInfo.Kind];
|
|
Result := LInstance.Instance;
|
|
if LInstance.Selector then
|
|
begin
|
|
TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
|
|
TMethod(LSelectMethod).Data := Self;
|
|
Result := LSelectMethod(GetTypeData(ATypeInfo), ASize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class constructor THashService<T>.Create;
|
|
begin
|
|
FEqualityComparer_Int8_VMT := EqualityComparer_Int8_VMT ;
|
|
FEqualityComparer_Int16_VMT := EqualityComparer_Int16_VMT ;
|
|
FEqualityComparer_Int32_VMT := EqualityComparer_Int32_VMT ;
|
|
FEqualityComparer_Int64_VMT := EqualityComparer_Int64_VMT ;
|
|
FEqualityComparer_UInt8_VMT := EqualityComparer_UInt8_VMT ;
|
|
FEqualityComparer_UInt16_VMT := EqualityComparer_UInt16_VMT ;
|
|
FEqualityComparer_UInt32_VMT := EqualityComparer_UInt32_VMT ;
|
|
FEqualityComparer_UInt64_VMT := EqualityComparer_UInt64_VMT ;
|
|
FEqualityComparer_Single_VMT := EqualityComparer_Single_VMT ;
|
|
FEqualityComparer_Double_VMT := EqualityComparer_Double_VMT ;
|
|
FEqualityComparer_Extended_VMT := EqualityComparer_Extended_VMT ;
|
|
FEqualityComparer_Currency_VMT := EqualityComparer_Currency_VMT ;
|
|
FEqualityComparer_Comp_VMT := EqualityComparer_Comp_VMT ;
|
|
FEqualityComparer_Binary_VMT := EqualityComparer_Binary_VMT ;
|
|
FEqualityComparer_DynArray_VMT := EqualityComparer_DynArray_VMT ;
|
|
FEqualityComparer_Class_VMT := EqualityComparer_Class_VMT ;
|
|
FEqualityComparer_ShortString1_VMT := EqualityComparer_ShortString1_VMT ;
|
|
FEqualityComparer_ShortString2_VMT := EqualityComparer_ShortString2_VMT ;
|
|
FEqualityComparer_ShortString3_VMT := EqualityComparer_ShortString3_VMT ;
|
|
FEqualityComparer_ShortString_VMT := EqualityComparer_ShortString_VMT ;
|
|
FEqualityComparer_AnsiString_VMT := EqualityComparer_AnsiString_VMT ;
|
|
FEqualityComparer_WideString_VMT := EqualityComparer_WideString_VMT ;
|
|
FEqualityComparer_UnicodeString_VMT := EqualityComparer_UnicodeString_VMT;
|
|
FEqualityComparer_Method_VMT := EqualityComparer_Method_VMT ;
|
|
FEqualityComparer_Variant_VMT := EqualityComparer_Variant_VMT ;
|
|
FEqualityComparer_Pointer_VMT := EqualityComparer_Pointer_VMT ;
|
|
|
|
/////
|
|
FEqualityComparer_Int8_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Int16_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Int32_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Int64_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_UInt8_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_UInt16_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_UInt32_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_UInt64_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Single_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Double_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Extended_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Currency_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Comp_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Binary_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_DynArray_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Class_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_ShortString1_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_ShortString2_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_ShortString3_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_ShortString_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_AnsiString_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_WideString_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_UnicodeString_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Method_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Variant_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
FEqualityComparer_Pointer_VMT.__ClassRef := THashFactoryClass(T.ClassType);
|
|
|
|
///////
|
|
FEqualityComparer_Int8_Instance := @FEqualityComparer_Int8_VMT ;
|
|
FEqualityComparer_Int16_Instance := @FEqualityComparer_Int16_VMT ;
|
|
FEqualityComparer_Int32_Instance := @FEqualityComparer_Int32_VMT ;
|
|
FEqualityComparer_Int64_Instance := @FEqualityComparer_Int64_VMT ;
|
|
FEqualityComparer_UInt8_Instance := @FEqualityComparer_UInt8_VMT ;
|
|
FEqualityComparer_UInt16_Instance := @FEqualityComparer_UInt16_VMT ;
|
|
FEqualityComparer_UInt32_Instance := @FEqualityComparer_UInt32_VMT ;
|
|
FEqualityComparer_UInt64_Instance := @FEqualityComparer_UInt64_VMT ;
|
|
FEqualityComparer_Single_Instance := @FEqualityComparer_Single_VMT ;
|
|
FEqualityComparer_Double_Instance := @FEqualityComparer_Double_VMT ;
|
|
FEqualityComparer_Extended_Instance := @FEqualityComparer_Extended_VMT ;
|
|
FEqualityComparer_Currency_Instance := @FEqualityComparer_Currency_VMT ;
|
|
FEqualityComparer_Comp_Instance := @FEqualityComparer_Comp_VMT ;
|
|
//FEqualityComparer_Binary_Instance := @FEqualityComparer_Binary_VMT ; // dynamic instance
|
|
//FEqualityComparer_DynArray_Instance := @FEqualityComparer_DynArray_VMT ; // dynamic instance
|
|
FEqualityComparer_ShortString1_Instance := @FEqualityComparer_ShortString1_VMT ;
|
|
FEqualityComparer_ShortString2_Instance := @FEqualityComparer_ShortString2_VMT ;
|
|
FEqualityComparer_ShortString3_Instance := @FEqualityComparer_ShortString3_VMT ;
|
|
FEqualityComparer_ShortString_Instance := @FEqualityComparer_ShortString_VMT ;
|
|
FEqualityComparer_AnsiString_Instance := @FEqualityComparer_AnsiString_VMT ;
|
|
FEqualityComparer_WideString_Instance := @FEqualityComparer_WideString_VMT ;
|
|
FEqualityComparer_UnicodeString_Instance := @FEqualityComparer_UnicodeString_VMT;
|
|
FEqualityComparer_Method_Instance := @FEqualityComparer_Method_VMT ;
|
|
FEqualityComparer_Variant_Instance := @FEqualityComparer_Variant_VMT ;
|
|
FEqualityComparer_Pointer_Instance := @FEqualityComparer_Pointer_VMT ;
|
|
|
|
//////
|
|
FEqualityComparerInstances[tkUnknown] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkInteger] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkChar] := TInstance.Create(False, @FEqualityComparer_UInt8_Instance);
|
|
FEqualityComparerInstances[tkEnumeration] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkFloat] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectFloatEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkSet] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkMethod] := TInstance.Create(False, @FEqualityComparer_Method_Instance);
|
|
FEqualityComparerInstances[tkSString] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectShortStringEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkLString] := TInstance.Create(False, @FEqualityComparer_AnsiString_Instance);
|
|
FEqualityComparerInstances[tkAString] := TInstance.Create(False, @FEqualityComparer_AnsiString_Instance);
|
|
FEqualityComparerInstances[tkWString] := TInstance.Create(False, @FEqualityComparer_WideString_Instance);
|
|
FEqualityComparerInstances[tkVariant] := TInstance.Create(False, @FEqualityComparer_Variant_Instance);
|
|
FEqualityComparerInstances[tkArray] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkRecord] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkInterface] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkClass] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkObject] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkWChar] := TInstance.Create(False, @FEqualityComparer_UInt16_Instance);
|
|
FEqualityComparerInstances[tkBool] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkInt64] := TInstance.Create(False, @FEqualityComparer_Int64_Instance);
|
|
FEqualityComparerInstances[tkQWord] := TInstance.Create(False, @FEqualityComparer_UInt64_Instance);
|
|
FEqualityComparerInstances[tkDynArray] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectDynArrayEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkInterfaceRaw] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkProcVar] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkUString] := TInstance.Create(False, @FEqualityComparer_UnicodeString_Instance);
|
|
FEqualityComparerInstances[tkUChar] := TInstance.Create(False, @FEqualityComparer_UInt16_Instance);
|
|
FEqualityComparerInstances[tkHelper] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkFile] := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FEqualityComparerInstances[tkClassRef] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
|
|
FEqualityComparerInstances[tkPointer] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance)
|
|
end;
|
|
|
|
{ TExtendedHashService }
|
|
|
|
class function TExtendedHashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.OrdType of
|
|
otSByte:
|
|
Exit(@FExtendedEqualityComparer_Int8_Instance);
|
|
otUByte:
|
|
Exit(@FExtendedEqualityComparer_UInt8_Instance);
|
|
otSWord:
|
|
Exit(@FExtendedEqualityComparer_Int16_Instance);
|
|
otUWord:
|
|
Exit(@FExtendedEqualityComparer_UInt16_Instance);
|
|
otSLong:
|
|
Exit(@FExtendedEqualityComparer_Int32_Instance);
|
|
otULong:
|
|
Exit(@FExtendedEqualityComparer_UInt32_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function TExtendedHashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
case ATypeData.FloatType of
|
|
ftSingle:
|
|
Exit(@FExtendedEqualityComparer_Single_Instance);
|
|
ftDouble:
|
|
Exit(@FExtendedEqualityComparer_Double_Instance);
|
|
ftExtended:
|
|
Exit(@FExtendedEqualityComparer_Extended_Instance);
|
|
ftComp:
|
|
Exit(@FExtendedEqualityComparer_Comp_Instance);
|
|
ftCurr:
|
|
Exit(@FExtendedEqualityComparer_Currency_Instance);
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
class function TExtendedHashService<T>.SelectShortStringEqualityComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
2: Exit(@FExtendedEqualityComparer_ShortString1_Instance);
|
|
3: Exit(@FExtendedEqualityComparer_ShortString2_Instance);
|
|
4: Exit(@FExtendedEqualityComparer_ShortString3_Instance);
|
|
else
|
|
Exit(@FExtendedEqualityComparer_ShortString_Instance);
|
|
end
|
|
end;
|
|
|
|
class function TExtendedHashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
|
|
ASize: SizeInt): Pointer;
|
|
begin
|
|
case ASize of
|
|
1: Exit(@FExtendedEqualityComparer_UInt8_Instance);
|
|
2: Exit(@FExtendedEqualityComparer_UInt16_Instance);
|
|
4: Exit(@FExtendedEqualityComparer_UInt32_Instance);
|
|
{$IFDEF CPU64}
|
|
8: Exit(@FExtendedEqualityComparer_UInt64_Instance)
|
|
{$ENDIF}
|
|
else
|
|
Result := CreateInterface(@FExtendedEqualityComparer_Binary_VMT, ASize);
|
|
end;
|
|
end;
|
|
|
|
class function TExtendedHashService<T>.SelectDynArrayEqualityComparer(
|
|
ATypeData: PTypeData; ASize: SizeInt): Pointer;
|
|
begin
|
|
Result := CreateInterface(@FExtendedEqualityComparer_DynArray_VMT, ATypeData.elSize);
|
|
end;
|
|
|
|
class function TExtendedHashService<T>.LookupExtendedEqualityComparer(
|
|
ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
|
|
var
|
|
LInstance: PInstance;
|
|
LSelectMethod: TSelectMethod;
|
|
begin
|
|
if ATypeInfo = nil then
|
|
Exit(SelectBinaryEqualityComparer(GetTypeData(ATypeInfo), ASize))
|
|
else
|
|
begin
|
|
LInstance := @FExtendedEqualityComparerInstances[ATypeInfo.Kind];
|
|
Result := LInstance.Instance;
|
|
if LInstance.Selector then
|
|
begin
|
|
TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
|
|
TMethod(LSelectMethod).Data := Self;
|
|
Result := LSelectMethod(GetTypeData(ATypeInfo), ASize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class constructor TExtendedHashService<T>.Create;
|
|
begin
|
|
FExtendedEqualityComparer_Int8_VMT := ExtendedEqualityComparer_Int8_VMT ;
|
|
FExtendedEqualityComparer_Int16_VMT := ExtendedEqualityComparer_Int16_VMT ;
|
|
FExtendedEqualityComparer_Int32_VMT := ExtendedEqualityComparer_Int32_VMT ;
|
|
FExtendedEqualityComparer_Int64_VMT := ExtendedEqualityComparer_Int64_VMT ;
|
|
FExtendedEqualityComparer_UInt8_VMT := ExtendedEqualityComparer_UInt8_VMT ;
|
|
FExtendedEqualityComparer_UInt16_VMT := ExtendedEqualityComparer_UInt16_VMT ;
|
|
FExtendedEqualityComparer_UInt32_VMT := ExtendedEqualityComparer_UInt32_VMT ;
|
|
FExtendedEqualityComparer_UInt64_VMT := ExtendedEqualityComparer_UInt64_VMT ;
|
|
FExtendedEqualityComparer_Single_VMT := ExtendedEqualityComparer_Single_VMT ;
|
|
FExtendedEqualityComparer_Double_VMT := ExtendedEqualityComparer_Double_VMT ;
|
|
FExtendedEqualityComparer_Extended_VMT := ExtendedEqualityComparer_Extended_VMT ;
|
|
FExtendedEqualityComparer_Currency_VMT := ExtendedEqualityComparer_Currency_VMT ;
|
|
FExtendedEqualityComparer_Comp_VMT := ExtendedEqualityComparer_Comp_VMT ;
|
|
FExtendedEqualityComparer_Binary_VMT := ExtendedEqualityComparer_Binary_VMT ;
|
|
FExtendedEqualityComparer_DynArray_VMT := ExtendedEqualityComparer_DynArray_VMT ;
|
|
FExtendedEqualityComparer_Class_VMT := ExtendedEqualityComparer_Class_VMT ;
|
|
FExtendedEqualityComparer_ShortString1_VMT := ExtendedEqualityComparer_ShortString1_VMT ;
|
|
FExtendedEqualityComparer_ShortString2_VMT := ExtendedEqualityComparer_ShortString2_VMT ;
|
|
FExtendedEqualityComparer_ShortString3_VMT := ExtendedEqualityComparer_ShortString3_VMT ;
|
|
FExtendedEqualityComparer_ShortString_VMT := ExtendedEqualityComparer_ShortString_VMT ;
|
|
FExtendedEqualityComparer_AnsiString_VMT := ExtendedEqualityComparer_AnsiString_VMT ;
|
|
FExtendedEqualityComparer_WideString_VMT := ExtendedEqualityComparer_WideString_VMT ;
|
|
FExtendedEqualityComparer_UnicodeString_VMT := ExtendedEqualityComparer_UnicodeString_VMT;
|
|
FExtendedEqualityComparer_Method_VMT := ExtendedEqualityComparer_Method_VMT ;
|
|
FExtendedEqualityComparer_Variant_VMT := ExtendedEqualityComparer_Variant_VMT ;
|
|
FExtendedEqualityComparer_Pointer_VMT := ExtendedEqualityComparer_Pointer_VMT ;
|
|
|
|
/////
|
|
FExtendedEqualityComparer_Int8_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Int16_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Int32_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Int64_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_UInt8_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_UInt16_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_UInt32_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_UInt64_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Single_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Double_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Extended_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Currency_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Comp_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Binary_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_DynArray_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Class_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_ShortString1_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_ShortString2_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_ShortString3_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_ShortString_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_AnsiString_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_WideString_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_UnicodeString_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Method_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Variant_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
FExtendedEqualityComparer_Pointer_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
|
|
|
|
///////
|
|
FExtendedEqualityComparer_Int8_Instance := @FExtendedEqualityComparer_Int8_VMT ;
|
|
FExtendedEqualityComparer_Int16_Instance := @FExtendedEqualityComparer_Int16_VMT ;
|
|
FExtendedEqualityComparer_Int32_Instance := @FExtendedEqualityComparer_Int32_VMT ;
|
|
FExtendedEqualityComparer_Int64_Instance := @FExtendedEqualityComparer_Int64_VMT ;
|
|
FExtendedEqualityComparer_UInt8_Instance := @FExtendedEqualityComparer_UInt8_VMT ;
|
|
FExtendedEqualityComparer_UInt16_Instance := @FExtendedEqualityComparer_UInt16_VMT ;
|
|
FExtendedEqualityComparer_UInt32_Instance := @FExtendedEqualityComparer_UInt32_VMT ;
|
|
FExtendedEqualityComparer_UInt64_Instance := @FExtendedEqualityComparer_UInt64_VMT ;
|
|
FExtendedEqualityComparer_Single_Instance := @FExtendedEqualityComparer_Single_VMT ;
|
|
FExtendedEqualityComparer_Double_Instance := @FExtendedEqualityComparer_Double_VMT ;
|
|
FExtendedEqualityComparer_Extended_Instance := @FExtendedEqualityComparer_Extended_VMT ;
|
|
FExtendedEqualityComparer_Currency_Instance := @FExtendedEqualityComparer_Currency_VMT ;
|
|
FExtendedEqualityComparer_Comp_Instance := @FExtendedEqualityComparer_Comp_VMT ;
|
|
//FExtendedEqualityComparer_Binary_Instance := @FExtendedEqualityComparer_Binary_VMT ; // dynamic instance
|
|
//FExtendedEqualityComparer_DynArray_Instance := @FExtendedEqualityComparer_DynArray_VMT ; // dynamic instance
|
|
FExtendedEqualityComparer_ShortString1_Instance := @FExtendedEqualityComparer_ShortString1_VMT ;
|
|
FExtendedEqualityComparer_ShortString2_Instance := @FExtendedEqualityComparer_ShortString2_VMT ;
|
|
FExtendedEqualityComparer_ShortString3_Instance := @FExtendedEqualityComparer_ShortString3_VMT ;
|
|
FExtendedEqualityComparer_ShortString_Instance := @FExtendedEqualityComparer_ShortString_VMT ;
|
|
FExtendedEqualityComparer_AnsiString_Instance := @FExtendedEqualityComparer_AnsiString_VMT ;
|
|
FExtendedEqualityComparer_WideString_Instance := @FExtendedEqualityComparer_WideString_VMT ;
|
|
FExtendedEqualityComparer_UnicodeString_Instance := @FExtendedEqualityComparer_UnicodeString_VMT;
|
|
FExtendedEqualityComparer_Method_Instance := @FExtendedEqualityComparer_Method_VMT ;
|
|
FExtendedEqualityComparer_Variant_Instance := @FExtendedEqualityComparer_Variant_VMT ;
|
|
FExtendedEqualityComparer_Pointer_Instance := @FExtendedEqualityComparer_Pointer_VMT ;
|
|
|
|
//////
|
|
FExtendedEqualityComparerInstances[tkUnknown] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkInteger] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkChar] := TInstance.Create(False, @FExtendedEqualityComparer_UInt8_Instance);
|
|
FExtendedEqualityComparerInstances[tkEnumeration] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkFloat] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectFloatEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkSet] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkMethod] := TInstance.Create(False, @FExtendedEqualityComparer_Method_Instance);
|
|
FExtendedEqualityComparerInstances[tkSString] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectShortStringEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkLString] := TInstance.Create(False, @FExtendedEqualityComparer_AnsiString_Instance);
|
|
FExtendedEqualityComparerInstances[tkAString] := TInstance.Create(False, @FExtendedEqualityComparer_AnsiString_Instance);
|
|
FExtendedEqualityComparerInstances[tkWString] := TInstance.Create(False, @FExtendedEqualityComparer_WideString_Instance);
|
|
FExtendedEqualityComparerInstances[tkVariant] := TInstance.Create(False, @FExtendedEqualityComparer_Variant_Instance);
|
|
FExtendedEqualityComparerInstances[tkArray] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkRecord] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkInterface] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkClass] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkObject] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkWChar] := TInstance.Create(False, @FExtendedEqualityComparer_UInt16_Instance);
|
|
FExtendedEqualityComparerInstances[tkBool] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkInt64] := TInstance.Create(False, @FExtendedEqualityComparer_Int64_Instance);
|
|
FExtendedEqualityComparerInstances[tkQWord] := TInstance.Create(False, @FExtendedEqualityComparer_UInt64_Instance);
|
|
FExtendedEqualityComparerInstances[tkDynArray] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectDynArrayEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkInterfaceRaw] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkProcVar] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkUString] := TInstance.Create(False, @FExtendedEqualityComparer_UnicodeString_Instance);
|
|
FExtendedEqualityComparerInstances[tkUChar] := TInstance.Create(False, @FExtendedEqualityComparer_UInt16_Instance);
|
|
FExtendedEqualityComparerInstances[tkHelper] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkFile] := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
|
|
FExtendedEqualityComparerInstances[tkClassRef] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
FExtendedEqualityComparerInstances[tkPointer] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
|
|
end;
|
|
|
|
{ TEqualityComparer<T> }
|
|
|
|
class function TEqualityComparer<T>.Default: IEqualityComparer<T>;
|
|
begin
|
|
Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T));
|
|
end;
|
|
|
|
class function TEqualityComparer<T>.Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>;
|
|
begin
|
|
if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then
|
|
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass)
|
|
else if AHashFactoryClass.InheritsFrom(THashFactory) then
|
|
Result := _LookupVtableInfoEx(giEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass);
|
|
end;
|
|
|
|
class function TEqualityComparer<T>.Construct(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>): IEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedEqualityComparerEvents<T>.Create(AEqualityComparison, AHasher);
|
|
end;
|
|
|
|
class function TEqualityComparer<T>.Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>): IEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedEqualityComparerFunc<T>.Create(AEqualityComparison, AHasher);
|
|
end;
|
|
|
|
{ TDelegatedEqualityComparerEvents<T> }
|
|
|
|
function TDelegatedEqualityComparerEvents<T>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparison(ALeft, ARight);
|
|
end;
|
|
|
|
function TDelegatedEqualityComparerEvents<T>.GetHashCode(constref AValue: T): UInt32;
|
|
begin
|
|
Result := FHasher(AValue);
|
|
end;
|
|
|
|
constructor TDelegatedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>);
|
|
begin
|
|
FEqualityComparison := AEqualityComparison;
|
|
FHasher := AHasher;
|
|
end;
|
|
|
|
{ TDelegatedEqualityComparerFunc<T> }
|
|
|
|
function TDelegatedEqualityComparerFunc<T>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparison(ALeft, ARight);
|
|
end;
|
|
|
|
function TDelegatedEqualityComparerFunc<T>.GetHashCode(constref AValue: T): UInt32;
|
|
begin
|
|
Result := FHasher(AValue);
|
|
end;
|
|
|
|
constructor TDelegatedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>);
|
|
begin
|
|
FEqualityComparison := AEqualityComparison;
|
|
FHasher := AHasher;
|
|
end;
|
|
|
|
{ TDelegatedExtendedEqualityComparerEvents<T> }
|
|
|
|
function TDelegatedExtendedEqualityComparerEvents<T>.GetHashCodeMethod(constref AValue: T): UInt32;
|
|
var
|
|
LHashList: array[0..1] of Int32;
|
|
LHashListParams: array[0..3] of Int16 absolute LHashList;
|
|
begin
|
|
LHashListParams[0] := -1;
|
|
FExtendedHasher(AValue, @LHashList[0]);
|
|
Result := LHashList[1];
|
|
end;
|
|
|
|
function TDelegatedExtendedEqualityComparerEvents<T>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparison(ALeft, ARight);
|
|
end;
|
|
|
|
function TDelegatedExtendedEqualityComparerEvents<T>.GetHashCode(constref AValue: T): UInt32;
|
|
begin
|
|
Result := FHasher(AValue);
|
|
end;
|
|
|
|
procedure TDelegatedExtendedEqualityComparerEvents<T>.GetHashList(constref AValue: T; AHashList: PUInt32);
|
|
begin
|
|
FExtendedHasher(AValue, AHashList);
|
|
end;
|
|
|
|
constructor TDelegatedExtendedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>);
|
|
begin
|
|
FEqualityComparison := AEqualityComparison;
|
|
FHasher := AHasher;
|
|
FExtendedHasher := AExtendedHasher;
|
|
end;
|
|
|
|
constructor TDelegatedExtendedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AExtendedHasher: TOnExtendedHasher<T>);
|
|
begin
|
|
Create(AEqualityComparison, GetHashCodeMethod, AExtendedHasher);
|
|
end;
|
|
|
|
{ TDelegatedExtendedEqualityComparerFunc<T> }
|
|
|
|
function TDelegatedExtendedEqualityComparerFunc<T>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparison(ALeft, ARight);
|
|
end;
|
|
|
|
function TDelegatedExtendedEqualityComparerFunc<T>.GetHashCode(constref AValue: T): UInt32;
|
|
var
|
|
LHashList: array[0..1] of Int32;
|
|
LHashListParams: array[0..3] of Int16 absolute LHashList;
|
|
begin
|
|
if not Assigned(FHasher) then
|
|
begin
|
|
LHashListParams[0] := -1;
|
|
FExtendedHasher(AValue, @LHashList[0]);
|
|
Result := LHashList[1];
|
|
end
|
|
else
|
|
Result := FHasher(AValue);
|
|
end;
|
|
|
|
procedure TDelegatedExtendedEqualityComparerFunc<T>.GetHashList(constref AValue: T; AHashList: PUInt32);
|
|
begin
|
|
FExtendedHasher(AValue, AHashList);
|
|
end;
|
|
|
|
constructor TDelegatedExtendedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>);
|
|
begin
|
|
FEqualityComparison := AEqualityComparison;
|
|
FHasher := AHasher;
|
|
FExtendedHasher := AExtendedHasher;
|
|
end;
|
|
|
|
constructor TDelegatedExtendedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AExtendedHasher: TExtendedHasherFunc<T>);
|
|
begin
|
|
Create(AEqualityComparison, nil, AExtendedHasher);
|
|
end;
|
|
|
|
{ TExtendedEqualityComparer<T> }
|
|
|
|
class function TExtendedEqualityComparer<T>.Default: IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T));
|
|
end;
|
|
|
|
class function TExtendedEqualityComparer<T>.Default(
|
|
AExtenedHashFactoryClass: TExtendedHashFactoryClass
|
|
): IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AExtenedHashFactoryClass);
|
|
end;
|
|
|
|
class function TExtendedEqualityComparer<T>.Construct(
|
|
const AEqualityComparison: TOnEqualityComparison<T>; const AHasher: TOnHasher<T>;
|
|
const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedExtendedEqualityComparerEvents<T>.Create(AEqualityComparison, AHasher, AExtendedHasher);
|
|
end;
|
|
|
|
class function TExtendedEqualityComparer<T>.Construct(
|
|
const AEqualityComparison: TEqualityComparisonFunc<T>; const AHasher: THasherFunc<T>;
|
|
const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedExtendedEqualityComparerFunc<T>.Create(AEqualityComparison, AHasher, AExtendedHasher);
|
|
end;
|
|
|
|
class function TExtendedEqualityComparer<T>.Construct(
|
|
const AEqualityComparison: TOnEqualityComparison<T>;
|
|
const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedExtendedEqualityComparerEvents<T>.Create(AEqualityComparison, AExtendedHasher);
|
|
end;
|
|
|
|
class function TExtendedEqualityComparer<T>.Construct(
|
|
const AEqualityComparison: TEqualityComparisonFunc<T>;
|
|
const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>;
|
|
begin
|
|
Result := TDelegatedExtendedEqualityComparerFunc<T>.Create(AEqualityComparison, AExtendedHasher);
|
|
end;
|
|
|
|
{ TDelphiHashFactory }
|
|
|
|
class function TDelphiHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := THashService<TDelphiHashFactory>;
|
|
end;
|
|
|
|
class function TDelphiHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := DelphiHashLittle(AKey, ASize, AInitVal);
|
|
end;
|
|
|
|
{ TmORMotHashFactory }
|
|
|
|
class function TmORMotHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := THashService<TmORMotHashFactory>;
|
|
end;
|
|
|
|
class function TmORMotHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := mORMotHasher(AInitVal, AKey, ASize);
|
|
end;
|
|
|
|
{ TAdler32HashFactory }
|
|
|
|
class function TAdler32HashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := THashService<TAdler32HashFactory>;
|
|
end;
|
|
|
|
class function TAdler32HashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
|
|
AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := Adler32(AKey, ASize);
|
|
end;
|
|
|
|
{ TSdbmHashFactory }
|
|
|
|
class function TSdbmHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := THashService<TSdbmHashFactory>;
|
|
end;
|
|
|
|
class function TSdbmHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
|
|
AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := sdbm(AKey, ASize);
|
|
end;
|
|
|
|
{ TSimpleChecksumFactory }
|
|
|
|
class function TSimpleChecksumFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := THashService<TSimpleChecksumFactory>;
|
|
end;
|
|
|
|
class function TSimpleChecksumFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
|
|
AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := SimpleChecksumHash(AKey, ASize);
|
|
end;
|
|
|
|
{ TDelphiDoubleHashFactory }
|
|
|
|
class function TDelphiDoubleHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := TExtendedHashService<TDelphiDoubleHashFactory>;
|
|
end;
|
|
|
|
class function TDelphiDoubleHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := DelphiHashLittle(AKey, ASize, AInitVal);
|
|
end;
|
|
|
|
class procedure TDelphiDoubleHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
|
|
AOptions: TGetHashListOptions);
|
|
var
|
|
LHash: UInt32;
|
|
AHashListParams: PUInt16 absolute AHashList;
|
|
begin
|
|
{$WARNINGS OFF}
|
|
case AHashListParams[0] of
|
|
-2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
0: Exit;
|
|
1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 0;
|
|
AHashList[2] := 0;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
|
|
end;
|
|
|
|
{ TDelphiQuadrupleHashFactory }
|
|
|
|
class function TDelphiQuadrupleHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := TExtendedHashService<TDelphiQuadrupleHashFactory>;
|
|
end;
|
|
|
|
class function TDelphiQuadrupleHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := DelphiHashLittle(AKey, ASize, AInitVal);
|
|
end;
|
|
|
|
class procedure TDelphiQuadrupleHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
|
|
AOptions: TGetHashListOptions);
|
|
var
|
|
LHash: UInt32;
|
|
AHashListParams: PInt16 absolute AHashList;
|
|
begin
|
|
case AHashListParams[0] of
|
|
-4:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 1988;
|
|
LHash := 2004;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-3:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 2004;
|
|
LHash := 1988;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
-2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
0: Exit;
|
|
1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
case AHashListParams[1] of
|
|
0, 1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 0;
|
|
AHashList[2] := 0;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 2004;
|
|
AHashList[2] := 1988;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
end;
|
|
4:
|
|
case AHashListParams[1] of
|
|
1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 0;
|
|
AHashList[2] := 0;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[3] := 2004;
|
|
AHashList[4] := 1988;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[3], AHashList[4]);
|
|
Exit;
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
end;
|
|
|
|
{ TDelphiSixfoldHashFactory }
|
|
|
|
class function TDelphiSixfoldHashFactory.GetHashService: THashServiceClass;
|
|
begin
|
|
Result := TExtendedHashService<TDelphiSixfoldHashFactory>;
|
|
end;
|
|
|
|
class function TDelphiSixfoldHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
|
|
begin
|
|
Result := DelphiHashLittle(AKey, ASize, AInitVal);
|
|
end;
|
|
|
|
class procedure TDelphiSixfoldHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
|
|
AOptions: TGetHashListOptions);
|
|
var
|
|
LHash: UInt32;
|
|
AHashListParams: PInt16 absolute AHashList;
|
|
begin
|
|
case AHashListParams[0] of
|
|
-6:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 2;
|
|
LHash := 1;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-5:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 1;
|
|
LHash := 2;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
-4:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 1988;
|
|
LHash := 2004;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-3:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 2004;
|
|
LHash := 1988;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
-2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
|
|
Exit;
|
|
end;
|
|
-1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
0: Exit;
|
|
1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
AHashList[1] := 0;
|
|
LHash := 0;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
case AHashListParams[1] of
|
|
0, 1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 0;
|
|
AHashList[2] := 0;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 2004;
|
|
AHashList[2] := 1988;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
end;
|
|
6:
|
|
case AHashListParams[1] of
|
|
1:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[1] := 0;
|
|
AHashList[2] := 0;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
|
|
Exit;
|
|
end;
|
|
2:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[3] := 2004;
|
|
AHashList[4] := 1988;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[3], AHashList[4]);
|
|
Exit;
|
|
end;
|
|
3:
|
|
begin
|
|
if not (ghloHashListAsInitData in AOptions) then
|
|
begin
|
|
AHashList[5] := 1;
|
|
AHashList[6] := 2;
|
|
end;
|
|
DelphiHashLittle2(AKey, ASize, AHashList[5], AHashList[6]);
|
|
Exit;
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
else
|
|
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
|
|
end;
|
|
end;
|
|
|
|
{ TOrdinalComparer<T, THashFactory> }
|
|
|
|
class constructor TOrdinalComparer<T, THashFactory>.Create;
|
|
begin
|
|
if THashFactory.InheritsFrom(TExtendedHashService) then
|
|
begin
|
|
FExtendedEqualityComparer := TExtendedEqualityComparer<T>.Default(TExtendedHashFactoryClass(THashFactory));
|
|
FEqualityComparer := IEqualityComparer<T>(FExtendedEqualityComparer);
|
|
end
|
|
else
|
|
FEqualityComparer := TEqualityComparer<T>.Default(THashFactory);
|
|
FComparer := TComparer<T>.Default;
|
|
end;
|
|
|
|
{ TGStringComparer<T, THashFactory> }
|
|
|
|
class destructor TGStringComparer<T, THashFactory>.Destroy;
|
|
begin
|
|
if Assigned(FOrdinal) then
|
|
FOrdinal.Free;
|
|
end;
|
|
|
|
class function TGStringComparer<T, THashFactory>.Ordinal: TCustomComparer<T>;
|
|
begin
|
|
if not Assigned(FOrdinal) then
|
|
FOrdinal := TGOrdinalStringComparer<T, THashFactory>.Create;
|
|
Result := FOrdinal;
|
|
end;
|
|
|
|
{ TGOrdinalStringComparer<T, THashFactory> }
|
|
|
|
function TGOrdinalStringComparer<T, THashFactory>.Compare(constref ALeft, ARight: T): Integer;
|
|
begin
|
|
Result := FComparer.Compare(ALeft, ARight);
|
|
end;
|
|
|
|
function TGOrdinalStringComparer<T, THashFactory>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparer.Equals(ALeft, ARight);
|
|
end;
|
|
|
|
function TGOrdinalStringComparer<T, THashFactory>.GetHashCode(constref AValue: T): UInt32;
|
|
begin
|
|
Result := FEqualityComparer.GetHashCode(AValue);
|
|
end;
|
|
|
|
procedure TGOrdinalStringComparer<T, THashFactory>.GetHashList(constref AValue: T; AHashList: PUInt32);
|
|
begin
|
|
FExtendedEqualityComparer.GetHashList(AValue, AHashList);
|
|
end;
|
|
|
|
{ TGIStringComparer<T, THashFactory> }
|
|
|
|
class destructor TGIStringComparer<T, THashFactory>.Destroy;
|
|
begin
|
|
if Assigned(FOrdinal) then
|
|
FOrdinal.Free;
|
|
end;
|
|
|
|
class function TGIStringComparer<T, THashFactory>.Ordinal: TCustomComparer<T>;
|
|
begin
|
|
if not Assigned(FOrdinal) then
|
|
FOrdinal := TGOrdinalIStringComparer<T, THashFactory>.Create;
|
|
Result := FOrdinal;
|
|
end;
|
|
|
|
{ TGOrdinalIStringComparer<T, THashFactory> }
|
|
|
|
function TGOrdinalIStringComparer<T, THashFactory>.Compare(constref ALeft, ARight: T): Integer;
|
|
begin
|
|
Result := FComparer.Compare(ALeft.ToLower, ARight.ToLower);
|
|
end;
|
|
|
|
function TGOrdinalIStringComparer<T, THashFactory>.Equals(constref ALeft, ARight: T): Boolean;
|
|
begin
|
|
Result := FEqualityComparer.Equals(ALeft.ToLower, ARight.ToLower);
|
|
end;
|
|
|
|
function TGOrdinalIStringComparer<T, THashFactory>.GetHashCode(constref AValue: T): UInt32;
|
|
begin
|
|
Result := FEqualityComparer.GetHashCode(AValue.ToLower);
|
|
end;
|
|
|
|
procedure TGOrdinalIStringComparer<T, THashFactory>.GetHashList(constref AValue: T; AHashList: PUInt32);
|
|
begin
|
|
FExtendedEqualityComparer.GetHashList(AValue.ToLower, AHashList);
|
|
end;
|
|
|
|
function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer;
|
|
begin
|
|
Result := DelphiHashLittle(@AData, ALength, AInitData);
|
|
end;
|
|
|
|
function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer;
|
|
begin
|
|
Result := CompareMemRange(ALeft, ARight, ASize);
|
|
end;
|
|
|
|
function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
|
|
begin
|
|
Result := _LookupVtableInfoEx(AGInterface, ATypeInfo, ASize, nil);
|
|
end;
|
|
|
|
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
|
|
AFactory: THashFactoryClass): Pointer;
|
|
begin
|
|
case AGInterface of
|
|
giComparer:
|
|
Exit(
|
|
TComparerService.LookupComparer(ATypeInfo, ASize));
|
|
giEqualityComparer:
|
|
begin
|
|
if AFactory = nil then
|
|
AFactory := TDefaultHashFactory;
|
|
|
|
Exit(
|
|
AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize));
|
|
end;
|
|
giExtendedEqualityComparer:
|
|
begin
|
|
if AFactory = nil then
|
|
AFactory := TDelphiDoubleHashFactory;
|
|
|
|
Exit(
|
|
TExtendedHashServiceClass(AFactory.GetHashService).LookupExtendedEqualityComparer(ATypeInfo, ASize));
|
|
end;
|
|
else
|
|
System.Error(reRangeError);
|
|
Exit(nil);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|