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,
  SysUtils,
  TypInfo;

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;
  method: TRttiMethod;
  returnType: Pointer;
  params: TArray<TRttiParameter>;
  isStatic: Boolean;
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;

  // TODO: possibly use low level RTTI to be quicker and not have dependency on Rtti.pas
  for method in ctx.GetType(TypeInfo(T)).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 = 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 = 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(T))
        and (pfConst in params[0].Flags)
        and (params[1].ParamType.Handle = TypeInfo(T))
        and (pfConst in params[0].Flags) then
      begin
        Equals := method.CodeAddress;
        Continue;
      end;
    end;
  end;
end;

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

  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.