utils/uutlComparer.pas

unit uutlComparer;

{$mode objfpc}{$H+}
{$IFDEF UTL_NESTED_PROCVARS}
  {$modeswitch nestedprocvars}
{$ENDIF}

interface

uses
  Classes, SysUtils,
  uutlInterfaces;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlEqualityComparer<T> = class(
    TInterfacedObject,
    specialize IutlEqualityComparer<T>)

  public
    function EqualityCompare(constref i1, i2: T): Boolean;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlEqualityCompareEvent<T>  = function(constref i1, i2: T): Boolean;
  generic TutlEqualityCompareEventO<T> = function(constref i1, i2: T): Boolean of object;
  {$IFDEF UTL_NESTED_PROCVARS}
  generic TutlEqualityCompareEventN<T> = function(constref i1, i2: T): Boolean is nested;
  {$ENDIF}

  generic TutlCallbackEqualityComparer<T> = class(
    TInterfacedObject,
    specialize IutlEqualityComparer<T>)

  private type
    TEqualityCompareEventType = (eetNormal, eetObject, eetNested);

  public type
    TCompareEvent = specialize TutlEqualityCompareEvent<T>;
    TCompareEventO = specialize TutlEqualityCompareEventO<T>;
    {$IFDEF UTL_NESTED_PROCVARS}
    TCompareEventN = specialize TutlEqualityCompareEventN<T>;
    {$ENDIF}

  strict private
    fType: TEqualityCompareEventType;
    fEvent: TCompareEvent;
    fEventO: TCompareEventO;
    {$IFDEF UTL_NESTED_PROCVARS}
    fEventN: TCompareEventN;
    {$ENDIF}

  public
    function EqualityCompare(constref i1, i2: T): Boolean;

    constructor Create(const aEvent: TCompareEvent); overload;
    constructor Create(const aEvent: TCompareEventO); overload;
    {$IFDEF UTL_NESTED_PROCVARS}
    constructor Create(const aEvent: TCompareEventN); overload;
    {$ENDIF}
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlComparer<T> = class(
    specialize TutlEqualityComparer<T>,
    specialize IutlEqualityComparer<T>,
    specialize IutlComparer<T>)

  public
    function Compare(constref i1, i2: T): Integer;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCompareEvent<T>  = function(constref i1, i2: T): Integer;
  generic TutlCompareEventO<T> = function(constref i1, i2: T): Integer of object;
  {$IFDEF UTL_NESTED_PROCVARS}
  generic TutlCompareEventN<T> = function(constref i1, i2: T): Integer is nested;
  {$ENDIF}

  generic TutlCallbackComparer<T> = class(
    TInterfacedObject,
    specialize IutlEqualityComparer<T>,
    specialize IutlComparer<T>)

  private type
    TCompareEventType = (cetNormal, cetObject, cetNested);

  public type
    TCompareEvent  = specialize TutlCompareEvent<T>;
    TCompareEventO = specialize TutlCompareEventO<T>;
    {$IFDEF UTL_NESTED_PROCVARS}
    TCompareEventN = specialize TutlCompareEventN<T>;
    {$ENDIF}

  strict private
    fType: TCompareEventType;
    fEvent: TCompareEvent;
    fEventO: TCompareEventO;
    {$IFDEF UTL_NESTED_PROCVARS}
    fEventN: TCompareEventN;
    {$ENDIF}

  public
    function Compare(constref i1, i2: T): Integer;
    function EqualityCompare(constref i1, i2: T): Boolean;

    constructor Create(const aEvent: TCompareEvent); overload;
    constructor Create(const aEvent: TCompareEventO); overload;
    {$IFDEF UTL_NESTED_PROCVARS}
    constructor Create(const aEvent: TCompareEventN); overload;
    {$ENDIF}
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator <(const i1, i2: TObject): Boolean; inline;
operator >(const i1, i2: TObject): Boolean; inline;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator <(const i1, i2: TObject): Boolean; inline;
begin
  result := Pointer(i1) < Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator >(const i1, i2: TObject): Boolean; inline;
begin
  result := Pointer(i1) > Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
  result := (i1 = i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
  result := false;
  case fType of
    eetNormal: result := fEvent (i1, i2);
    eetObject: result := fEventO(i1, i2);
    {$IFDEF UTL_NESTED_PROCVARS}
    eetNested: result := fEventN(i1, i2);
    {$ENDIF}
  else
    raise Exception.Create('invalid or unknown callback type');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEvent);
begin
  inherited Create;
  fType  := eetNormal;
  fEvent := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEventO);
begin
  inherited Create;
  fType   := eetObject;
  fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEventN);
begin
  inherited Create;
  fType   := eetNested;
  fEventN := aEvent;
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlComparer.Compare(constref i1, i2: T): Integer;
begin
  if (i1 < i2) then
    result := -1
  else if (i1 > i2) then
    result := 1
  else
    result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackComparer.Compare(constref i1, i2: T): Integer;
begin
  result := 0;
  case fType of
    cetNormal: result := fEvent (i1, i2);
    cetObject: result := fEventO(i1, i2);
    {$IFDEF UTL_NESTED_PROCVARS}
    cetNested: result := fEventN(i1, i2);
    {$ENDIF}
  else
    raise Exception.Create('invalid or unknown callback type');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
  result := (Compare(i1, i2) = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackComparer.Create(const aEvent: TCompareEvent);
begin
  inherited Create;
  fType   := cetNormal;
  fEvent  := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackComparer.Create(const aEvent: TCompareEventO);
begin
  inherited Create;
  fType   := cetObject;
  fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
begin
  inherited Create;
  fType   := cetNested;
  fEventN := aEvent;
end;
{$ENDIF}

end.