Snippets
Revised by
Stefan Glienke
ab7082a
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | unit RecComparer;
interface
uses
Generics.Defaults;
type
PComparerData = ^TComparerData;
TComparerData = record // same layout as Generics.Defaults.TSimpleInstance
Vtable: TArray<Pointer>;
RefCount: Integer;
Size: Integer;
Default: IInterface;
Equals: Pointer;
GetHashCode: Pointer;
constructor Create(typeSize: Integer; typeInfo: Pointer;
const defaultComparer: IInterface;
equalsAddr, getHashCodeAddr: Pointer);
end;
TRecordEqualityComparer<T{: record}> = class
strict private class var
Instance: TComparerData;
class function Equals(inst: PComparerData; const left, right: T): Boolean; reintroduce; static;
class function GetHashCode(inst: PComparerData; const value: T): Integer; reintroduce; static;
public
class constructor Create;
class function Default: IEqualityComparer<T>; static;
end;
implementation
uses
Rtti,
SysUtils,
TypInfo;
function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
Result := E_NOINTERFACE;
end;
function NopAddRef(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
function NopRelease(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
constructor TComparerData.Create(typeSize: Integer; typeInfo: Pointer;
const defaultComparer: IInterface; equalsAddr, getHashCodeAddr: Pointer);
type
PPVtable = ^PVtable;
PVtable = ^TVtable;
TVtable = array[0..4] of Pointer;
var
ctx: TRttiContext;
method: TRttiMethod;
returnType: Pointer;
params: TArray<TRttiParameter>;
isStatic: Boolean;
begin
SetLength(Vtable, 5);
Vtable[0] := @NopQueryInterface;
Vtable[1] := @NopAddRef;
Vtable[2] := @NopRelease;
Default := defaultComparer;
RefCount := 0;
Size := typeSize;
// TODO: possibly use low level RTTI to be quicker and not have dependency on Rtti.pas
for method in ctx.GetType(typeInfo).GetMethods do
begin
if Assigned(GetHashCode) and Assigned(Equals) then
Break;
if method.ReturnType = nil then
Continue;
returnType := method.ReturnType.Handle;
isStatic := method.IsStatic;
if (returnType = System.TypeInfo(Integer)) and not isStatic
and SameText(method.Name, 'GetHashCode') then
begin
params := method.GetParameters;
if Length(params) = 0 then
begin
GetHashCode := method.CodeAddress;
Continue;
end;
end;
if (returnType = System.TypeInfo(Boolean)) and isStatic
and SameText(method.Name, '&op_Equality') then
begin
params := method.GetParameters;
if (Length(params) = 2)
and (params[0].ParamType.Handle = typeInfo)
and (pfConst in params[0].Flags)
and (params[1].ParamType.Handle = typeInfo)
and (pfConst in params[0].Flags) then
begin
Equals := method.CodeAddress;
Continue;
end;
end;
end;
if Assigned(Equals) then
Vtable[3] := equalsAddr
else
Vtable[3] := PPVTable(Default)^^[3];
if Assigned(GetHashCode) then
Vtable[4] := getHashCodeAddr
else
Vtable[4] := PPVTable(Default)^^[4];
end;
{ TRecordEqualityComparer<T> }
class constructor TRecordEqualityComparer<T>.Create;
begin
Instance := TComparerData.Create(SizeOf(T), TypeInfo(T),
TEqualityComparer<T>.Default, @Equals, @GetHashCode);
end;
class function TRecordEqualityComparer<T>.Default: IEqualityComparer<T>;
begin
Assert(GetTypeKind(T) = tkRecord);
IInterface(Result) := nil;
Pointer(Result) := @Instance;
end;
class function TRecordEqualityComparer<T>.Equals(inst: PComparerData;
const left, right: T): Boolean;
type
TEquals = function(const left, right: T): Boolean;
begin
Result := TEquals(inst.Equals)(left, right);
end;
class function TRecordEqualityComparer<T>.GetHashCode(
inst: PComparerData; const value: T): Integer;
type
TGetHashCode = function(Self: Pointer): Integer;
begin
Result := TGetHashCode(inst.GetHashCode)(@value);
end;
end.
|
You can clone a snippet to your computer for local editing. Learn more.