Snippets

Stefan Glienke Record comparer

Updated by Stefan Glienke
View revision

File snippet.p Modified

  • Ignore whitespace
  • Hide word diff 
     GetHashCode: Pointer;
     constructor Create(typeSize: Integer; typeInfo: Pointer;
       const defaultComparer: IInterface;
-      equalsAddr, getHashCodeAddr: Pointer);
+      proxyEquals, proxyGetHashCode: Pointer);
   end;
 
   TRecordEqualityComparer<T{: record}> = class
 end;
 
 constructor TComparerData.Create(typeSize: Integer; typeInfo: Pointer;
-  const defaultComparer: IInterface; equalsAddr, getHashCodeAddr: Pointer);
+  const defaultComparer: IInterface; proxyEquals, proxyGetHashCode: Pointer);
 type
   PPVtable = ^PVtable;
   PVtable = ^TVtable;
   params: TArray<TRttiParameter>;
   isStatic: Boolean;
 begin
+  Default := defaultComparer;
+  RefCount := 0;
+  Size := typeSize;
+
   SetLength(Vtable, 5);
   Vtable[0] := @NopQueryInterface;
   Vtable[1] := @NopAddRef;
   Vtable[2] := @NopRelease;
-  Default := defaultComparer;
-  RefCount := 0;
-  Size := typeSize;
+  Vtable[3] := PPVTable(defaultComparer)^^[3];
+  Vtable[4] := PPVTable(defaultComparer)^^[4];
 
   // TODO: possibly use low level RTTI to be quicker and not have dependency on Rtti.pas
   for method in ctx.GetType(typeInfo).GetMethods do
       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
         and (pfConst in params[0].Flags) then
       begin
         Equals := method.CodeAddress;
+        Vtable[3] := proxyEquals;
+        Continue;
+      end;
+    end;
+    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;
+        Vtable[4] := proxyGetHashCode;
         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> }
Updated by Stefan Glienke
View revision

File snippet.p Modified

  • Ignore whitespace
  • Hide word diff 
   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;
+  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;
 
-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
   SysUtils,
   TypInfo;
 
-function NopAddref(inst: Pointer): Integer; stdcall;
+function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
 begin
-  Result := -1;
+  Result := E_NOINTERFACE;
 end;
 
-function NopRelease(inst: Pointer): Integer; stdcall;
+function NopAddRef(inst: Pointer): Integer; stdcall;
 begin
   Result := -1;
 end;
 
-function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
+function NopRelease(inst: Pointer): Integer; stdcall;
 begin
-  Result := E_NOINTERFACE;
+  Result := -1;
 end;
 
-
-{ TRecordEqualityComparer<T> }
-
-class constructor TRecordEqualityComparer<T>.Create;
+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;
   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;
+  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(T)).GetMethods do
+  for method in ctx.GetType(typeInfo).GetMethods do
   begin
     if Assigned(GetHashCode) and Assigned(Equals) then
       Break;
       Continue;
     returnType := method.ReturnType.Handle;
     isStatic := method.IsStatic;
-    if (returnType = TypeInfo(Integer)) and not isStatic
+    if (returnType = System.TypeInfo(Integer)) and not isStatic
       and SameText(method.Name, 'GetHashCode') then
     begin
       params := method.GetParameters;
         Continue;
       end;
     end;
-    if (returnType = TypeInfo(Boolean)) and isStatic
+    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(T))
+        and (params[0].ParamType.Handle = typeInfo)
         and (pfConst in params[0].Flags)
-        and (params[1].ParamType.Handle = TypeInfo(T))
+        and (params[1].ParamType.Handle = typeInfo)
         and (pfConst in params[0].Flags) then
       begin
         Equals := method.CodeAddress;
       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);
-  Assert(Assigned(Equals));
-  Assert(Assigned(GetHashCode));
 
   IInterface(Result) := nil;
-  Pointer(Result) := @EqualityComparer_Instance;
+  Pointer(Result) := @Instance;
 end;
 
-class function TRecordEqualityComparer<T>.EqualsProxy(inst: Pointer; const left,
-  right: T): Boolean;
+class function TRecordEqualityComparer<T>.Equals(inst: PComparerData;
+  const left, right: T): Boolean;
+type
+  TEquals = function(const left, right: T): Boolean;
 begin
-  Result := Equals(left, right);
+  Result := TEquals(inst.Equals)(left, right);
 end;
 
-class function TRecordEqualityComparer<T>.GetHashCodeProxy(inst: Pointer;
-  const value: T): Integer;
+class function TRecordEqualityComparer<T>.GetHashCode(
+  inst: PComparerData; const value: T): Integer;
+type
+  TGetHashCode = function(Self: Pointer): Integer;
 begin
-  Result := GetHashCode(@value);
+  Result := TGetHashCode(inst.GetHashCode)(@value);
 end;
 
 end.
Updated by Stefan Glienke
View revision

File snippet.p Modified

  • Ignore whitespace
  • Hide word diff 
 implementation
 
 uses
-  Rtti;
+  Rtti,
+  SysUtils,
+  TypInfo;
 
 function NopAddref(inst: Pointer): Integer; stdcall;
 begin
 class constructor TRecordEqualityComparer<T>.Create;
 var
   ctx: TRttiContext;
-  m: TRttiMethod;
-  p: Pointer;
+  method: TRttiMethod;
+  returnType: Pointer;
+  params: TArray<TRttiParameter>;
+  isStatic: Boolean;
 begin
   EqualityComparer_Vtable[0] := @NopQueryInterface;
   EqualityComparer_Vtable[1] := @NopAddref;
   EqualityComparer_Vtable[4] := @TRecordEqualityComparer<T>.GetHashCodeProxy;
   EqualityComparer_Instance := @EqualityComparer_Vtable;
 
-  // TODO check signature for compatibility
-  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;
+  // 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>;
Updated by Stefan Glienke
View revision

File snippet.p Modified

  • Ignore whitespace
  • Hide word diff 
   EqualityComparer_Vtable[4] := @TRecordEqualityComparer<T>.GetHashCodeProxy;
   EqualityComparer_Instance := @EqualityComparer_Vtable;
 
+  // TODO check signature for compatibility
   m := ctx.GetType(TypeInfo(T)).GetMethod('&op_Equality');
   if Assigned(m) then
     Equals := m.CodeAddress;
 begin
   Assert(GetTypeKind(T) = tkRecord);
   Assert(Assigned(Equals));
+  Assert(Assigned(GetHashCode));
 
   IInterface(Result) := nil;
   Pointer(Result) := @EqualityComparer_Instance;
Created by Stefan Glienke
View revision

File snippet.p Added

  • Ignore whitespace
  • Hide word diff 
+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.