Snippets

Stefan Glienke Record comparer

You are viewing an old version of this snippet. View the current version.
Revised by Stefan Glienke 2a3fec6
snippet.p
Raw 
 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
unit RecComparer;

interface

uses
  Generics.Defaults;

type
  TRecordEqualityComparer<T: record> = class(TEqualityComparer<T>)
  private class var
    EqualityComparer_Vtable: array[0..4] of Pointer;
    EqualityComparer_Instance: Pointer;
    Equals: function(const left, right: T): Boolean;
    GetHashCode: function(Self: Pointer): Integer;
    class function EqualsProxy(inst: Pointer; const left, right: T): Boolean; static;
    class function GetHashCodeProxy(inst: Pointer; const value: T): Integer; static;
  public
    class constructor Create;
    class function Default: IEqualityComparer<T>; static;
  end;

function NopAddref(inst: Pointer): Integer; stdcall;
function NopRelease(inst: Pointer): Integer; stdcall;
function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;

implementation

uses
  Rtti;

function NopAddref(inst: Pointer): Integer; stdcall;
begin
  Result := -1;
end;

function NopRelease(inst: Pointer): Integer; stdcall;
begin
  Result := -1;
end;

function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE;
end;


{ TRecordEqualityComparer<T> }

class constructor TRecordEqualityComparer<T>.Create;
var
  ctx: TRttiContext;
  m: TRttiMethod;
  p: Pointer;
begin
  EqualityComparer_Vtable[0] := @NopQueryInterface;
  EqualityComparer_Vtable[1] := @NopAddref;
  EqualityComparer_Vtable[2] := @NopRelease;
  EqualityComparer_Vtable[3] := @TRecordEqualityComparer<T>.EqualsProxy;
  EqualityComparer_Vtable[4] := @TRecordEqualityComparer<T>.GetHashCodeProxy;
  EqualityComparer_Instance := @EqualityComparer_Vtable;

  m := ctx.GetType(TypeInfo(T)).GetMethod('&op_Equality');
  if Assigned(m) then
    Equals := m.CodeAddress;
  m := ctx.GetType(TypeInfo(T)).GetMethod('GetHashCode');
  if Assigned(m) then
    GetHashCode := m.CodeAddress;
end;

class function TRecordEqualityComparer<T>.Default: IEqualityComparer<T>;
begin
  Assert(GetTypeKind(T) = tkRecord);
  Assert(Assigned(Equals));

  IInterface(Result) := nil;
  Pointer(Result) := @EqualityComparer_Instance;
end;

class function TRecordEqualityComparer<T>.EqualsProxy(inst: Pointer; const left,
  right: T): Boolean;
begin
  Result := Equals(left, right);
end;

class function TRecordEqualityComparer<T>.GetHashCodeProxy(inst: Pointer;
  const value: T): Integer;
begin
  Result := GetHashCode(@value);
end;

end.
HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.