utils/uutlGenerics.pas

unit uutlGenerics;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, typinfo,
  uutlCommon, uutlArrayContainer, uutlListBase, uutlComparer, uutlAlgorithm, uutlInterfaces,
  uutlEnumerator;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlQueue<T> = class(
    specialize TutlArrayContainer<T>
    , specialize IEnumerable<T>
    , specialize IutlEnumerable<T>
    , specialize IutlReadOnlyArray<T>)

  private type
    TEnumerator = class(
    specialize TutlEnumerator<T>
    , specialize IEnumerator<T>
    , specialize IutlEnumerator<T>)
    strict private
      fOwner: TutlQueue;
      fReversed: Boolean;
      fCurrent: Integer;

    protected { TutlEnumerator }
      function  InternalMoveNext: Boolean; override;
      procedure InternalReset; override;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerator }
      function Reverse: IutlEnumerator; override;
    {$ENDIF}

    public { IEnumerator }
      function  GetCurrent: T; override;

    public
      constructor Create(const aOwner: TutlQueue; const aReversed: Boolean);
    end;

  public type
    IEnumerator = specialize IEnumerator<T>;
    IutlEnumerator = specialize IutlEnumerator<T>;

  strict private
    fCount: Integer;
    fReadPos: Integer;
    fWritePos: Integer;

    function  GetItem(const aIndex: Integer): T;
    procedure SetItem(const aIndex: Integer; aItem: T);

  protected
    function  GetCount: Integer; override;
    procedure SetCount(const aValue: Integer); override;
    procedure SetCapacity(const aValue: integer); override;

  public { IEnumerable }
    function GetEnumerator: IEnumerator;

  public { IutlEnumerable }
    function GetUtlEnumerator: IutlEnumerator;

  public
    property Count: Integer read GetCount;
    property IsEmpty;
    property Capacity;
    property CanExpand;
    property CanShrink;
    property OwnsItems;
    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;

    procedure Enqueue(constref aItem: T);
    function  Dequeue: T;
    function  Dequeue(const aFreeItem: Boolean): T;
    function  Peek: T;
    procedure ShrinkToFit;
    procedure Clear;

    constructor Create(const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlStack<T> = class(
    specialize TutlArrayContainer<T>
    , specialize IEnumerable<T>
    , specialize IutlEnumerable<T>
    , specialize IutlReadOnlyArray<T>)

  private type
    TEnumerator = class(
      specialize TutlMemoryEnumerator<T>
      , specialize IEnumerator<T>
      , specialize IutlEnumerator<T>)
    private
      fOwner: TutlStack;

    protected { IEnumerator }
      procedure InternalReset; override;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerator }
      function Reverse: IutlEnumerator; override;
    {$ENDIF}

    public
      constructor Create(const aOwner: TutlStack; const aReversed: Boolean); reintroduce;
    end;

  public type
    IEnumerator = specialize IEnumerator<T>;
    IutlEnumerator = specialize IutlEnumerator<T>;

  strict private
    fCount: Integer;

    function  GetItem(const aIndex: Integer): T;
    procedure SetItem(const aIndex: Integer; aValue: T);

  protected
    function  GetCount: Integer; override;
    procedure SetCount(const aValue: Integer); override;

  public { IEnumerable }
    function GetEnumerator: IEnumerator;

  public { IutlEnumerable }
    function GetUtlEnumerator: IutlEnumerator;

  public
    property Count: Integer read GetCount;
    property IsEmpty;
    property Capacity;
    property CanExpand;
    property CanShrink;
    property OwnsItems;
    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;

    procedure Push(constref aItem: T);
    function  Pop: T;
    function  Pop(const aFreeItem: Boolean): T;
    function  Peek: T;
    procedure ShrinkToFit;
    procedure Clear;

    constructor Create(const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlSimpleList<T> = class(
    specialize TutlListBase<T>
    , specialize IutlReadOnlyArray<T>
    , specialize IutlArray<T>)

  strict private
    function  GetFirst: T;
    function  GetLast:  T;

  public
    property First: T read GetFirst;
    property Last:  T read GetLast;

    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;

    function  Add         (constref aItem: T): Integer;
    procedure Insert      (const aIndex: Integer; constref aItem: T);
    procedure Exchange    (const aIndex1, aIndex2: Integer);
    procedure Move        (const aCurrentIndex, aNewIndex: Integer);
    procedure Delete      (const aIndex: Integer);
    function  Extract     (const aIndex: Integer): T;

    procedure PushFirst   (constref aItem: T);
    function  PopFirst    (const aFreeItem: Boolean): T;

    procedure PushLast    (constref aItem: T);
    function  PopLast     (const aFreeItem: Boolean): T;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomList<T> = class(
    specialize TutlSimpleList<T>)

  public type
    IEqualityComparer = specialize IutlEqualityComparer<T>;

  strict private
    fEqualityComparer: IEqualityComparer;

  public
    function  IndexOf     (const aItem: T): Integer;
    function  Extract     (const aItem: T; const aDefault: T): T; overload;
    function  Remove      (const aItem: T): Integer;

    constructor Create    (const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlList<T> = class(
    specialize TutlCustomList<T>)

  public type
    TEqualityComparer = specialize TutlEqualityComparer<T>;

  public
    constructor Create(const aOwnsItems: Boolean);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomHashSet<T> = class(
    specialize TutlListBase<T>
    , specialize IutlReadOnlyArray<T>)

  private type
    TBinarySearch = specialize TutlBinarySearch<T>;

  public type
    IComparer = specialize IutlComparer<T>;

  strict private
    fComparer: IComparer;

  protected
    procedure SetCount  (const aValue: Integer); override;
    procedure SetItem   (const aIndex: Integer; aValue: T); override;

  public
    property Count: Integer read GetCount;
    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;

    function  Add       (constref aItem: T): Boolean;
    function  Contains  (constref aItem: T): Boolean;
    function  IndexOf   (constref aItem: T): Integer;
    function  Remove    (constref aItem: T): Boolean;
    procedure Delete    (const aIndex: Integer);

    constructor Create  (const aComparer: IComparer; const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlHashSet<T> = class(
    specialize TutlCustomHashSet<T>)

  public type
    TComparer = specialize TutlComparer<T>;

  public
    constructor Create(const aOwnsItems: Boolean);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomMap<TKey, TValue> = class(
    TutlInterfaceNoRefCount
    , specialize IutlEnumerable<TValue>)

  public type
    ////////////////////////////////////////////////////////////////////////////////////////////////
    TKeyValuePair = packed record
      Key: TKey;
      Value: TValue;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    IValueEnumerator = specialize IEnumerator<TValue>;
    IutlValueEnumerator = specialize IutlEnumerator<TValue>;
    IKeyEnumerator = specialize IEnumerator<TKey>;
    IutlKeyEnumerator = specialize IutlEnumerator<TKey>;
    IKeyValuePairEnumerator = specialize IEnumerator<TKeyValuePair>;
    IutlKeyValuePairEnumerator = specialize IutlEnumerator<TKeyValuePair>;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    THashSet = class(
      specialize TutlCustomHashSet<TKeyValuePair>)

    strict private
      fOwner: TutlCustomMap;

    protected
      procedure Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); override;

    public
      constructor Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    IComparer = specialize IutlComparer<TKey>;
    TKeyValuePairComparer = class(
      TInterfacedObject
      , THashSet.IComparer)

    strict private
      fComparer: IComparer;

    public { IutlEqualityComparer }
      function EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;

    public { IutlComparer }
      function Compare(constref i1, i2: TKeyValuePair): Integer;

    public
      constructor Create(aComparer: IComparer);
      destructor Destroy; override;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    TKeyEnumerator = class(
      specialize TutlEnumerator<TKey>
      , IKeyEnumerator
      , IutlKeyEnumerator)

    strict private
      fEnumerator: IutlKeyValuePairEnumerator;

    protected { TutlEnumerator }
      function  InternalMoveNext: Boolean; override;
      procedure InternalReset; override;

    public { IEnumerator }
      function  GetCurrent: TKey; override;

    public
      constructor Create(aEnumerator: IutlKeyValuePairEnumerator);
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    TValueEnumerator = class(
      specialize TutlEnumerator<TValue>
      , IValueEnumerator
      , IutlValueEnumerator)

    strict private
      fEnumerator: IutlKeyValuePairEnumerator;

    protected { TutlEnumerator }
      function  InternalMoveNext: Boolean; override;
      procedure InternalReset; override;

    public { IEnumerator }
      function  GetCurrent: TValue; override;

    public
      constructor Create(aEnumerator: IutlKeyValuePairEnumerator);
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    TKeyCollection = class(
      TutlInterfaceNoRefCount
      , specialize IutlReadOnlyArray<TKey>
      , specialize IutlEnumerable<TKey>)

    strict private
      fHashSet: THashSet;

    public { IEnumerable }
      function GetEnumerator: IKeyEnumerator;

    public { IutlEnumerable }
      function GetUtlEnumerator: IutlKeyEnumerator;

    public { IutlReadOnlyArray }
      function GetCount: Integer;
      function GetItem(const aIndex: Integer): TKey;

      property Count: Integer read GetCount;
      property Items[const aIndex: Integer]: TKey read GetItem; default;

    public
      constructor Create(const aHashSet: THashSet);
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    TKeyValuePairCollection = class(
      TutlInterfaceNoRefCount
      , specialize IutlReadOnlyArray<TKeyValuePair>
      , specialize IutlEnumerable<TKeyValuePair>)

    strict private
      fHashSet: THashSet;

    public { IEnumerable }
      function GetEnumerator: IKeyValuePairEnumerator;

    public { IutlEnumerable }
      function GetUtlEnumerator: IutlKeyValuePairEnumerator;

    public { IutlReadOnlyArray }
      function GetCount: Integer;
      function GetItem(const aIndex: Integer): TKeyValuePair;

      property Count: Integer read GetCount;
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;

    public
      constructor Create(const aHashSet: THashSet);
    end;

  strict private
    fAutoCreate: Boolean;
    fOwnsKeys: Boolean;
    fOwnsValues: Boolean;
    fHashSetRef: THashSet;
    fKeyCollection: TKeyCollection;
    fKeyValuePairCollection: TKeyValuePairCollection;

    function  GetValue      (aKey: TKey): TValue;            inline;
    function  GetValueAt    (const aIndex: Integer): TValue; inline;
    function  GetCount:     Integer;                         inline;
    function  GetIsEmpty:   Boolean;                         inline;
    function  GetCapacity:  Integer;                         inline;
    function  GetCanShrink: Boolean;                         inline;
    function  GetCanExpand: Boolean;                         inline;

    procedure SetCapacity   (const aValue: Integer);                        inline;
    procedure SetCanShrink  (const aValue: Boolean);                        inline;
    procedure SetCanExpand  (const aValue: Boolean);                        inline;

  protected
    procedure SetValue      (aKey: TKey; const aValue: TValue);             virtual;
    procedure SetValueAt    (const aIndex: Integer; const aValue: TValue);  virtual;

  public { IEnumerable }
    function GetEnumerator: IValueEnumerator;

  public { IutlEnumerable }
    function GetUtlEnumerator: IutlValueEnumerator;

  public
    property Values [aKey: TKey]:            TValue read GetValue   write SetValue; default;
    property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;

    property Keys:          TKeyCollection          read fKeyCollection;
    property KeyValuePairs: TKeyValuePairCollection read fKeyValuePairCollection;

    property Count:      Integer read GetCount;
    property IsEmpty:    Boolean read GetIsEmpty;
    property Capacity:   Integer read GetCapacity  write SetCapacity;
    property CanShrink:  Boolean read GetCanShrink write SetCanShrink;
    property CanExpand:  Boolean read GetCanExpand write SetCanExpand;
    property OwnsKeys:   Boolean read fOwnsKeys    write fOwnsKeys;
    property OwnsValues: Boolean read fOwnsValues  write fOwnsValues;
    property AutoCreate: Boolean read fAutoCreate  write fAutoCreate;

    procedure Add         (constref aKey: TKey; constref aValue: TValue);
    function  TryAdd      (constref aKey: TKey; constref aValue: TValue): Boolean;
    function  TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean;
    function  IndexOf     (constref aKey: TKey): Integer;
    function  Contains    (constref aKey: TKey): Boolean;
    function  Remove      (constref aKey: TKey): Boolean;
    procedure Delete      (constref aKey: TKey);
    procedure DeleteAt    (const aIndex: Integer);
    procedure Clear;

    constructor Create(const aHashSet: THashSet; const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlMap<TKey, TValue> = class(
    specialize TutlCustomMap<TKey, TValue>)

  public type
    TComparer = specialize TutlComparer<TKey>;

  strict private
    fHashSetImpl: THashSet;

  public
    constructor Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
    destructor Destroy; override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlHandle = QWord;
  generic TutlHandleManager<T> = class(TObject)
  private type
    THandleData = packed record
      case Integer of
        0: (
              Handle: TutlHandle      //  0..63
           );

        1: (
              Index: Cardinal;        //  0..31
              Counter: Word;          // 32..47
              Identifier: Word        // 48..63
           );
    end;

    THandleEntry = bitpacked record
      Data: T;
      NextFreeIndex: Cardinal;        //  0..31
      Counter: Word;                  // 32..47
      IsActive: Boolean;              // 48
      __reserved: 0..((1 shl 15)-1);  // 49..63
    end;

  private
    fCount: Integer;
    fGrowSize: Integer;
    fEntries: array of THandleEntry;
    fFirstFreeIndex: Cardinal;
    fOwnsValues: Boolean;

    procedure Grow;

  public
    function  Get    (const aHandle: TutlHandle): T;
    function  TryGet (const aHandle: TutlHandle; out aData: T): Boolean;
    function  Add    (constref aData: T; const aIdentifier: Word): TutlHandle;
    function  IsValid(const aHandle: TutlHandle): Boolean; inline;
    procedure Update (const aHandle: TutlHandle; aData: T);
    procedure Remove (const aHandle: TutlHandle);
    procedure Clear;

  public
    property Items[const aHandle: TutlHandle]: T read Get write Update;
    property Count: Integer read fCount;

    constructor Create(const aOwnsValues: Boolean);
    destructor  Destroy; override;

  public
    class function GetIdentifier(const aHandle: TutlHandle): Word; inline;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  EEnumConvertException = class(EConvertError)
  public
    constructor Create(const aValue, aExpectedType: String);
  end;

  TutlEnumHelperBaseClass = class of TutlEnumHelperBase;
  TutlEnumHelperBase = class
  public type
    TIntArray = array of Integer;
    TStringArray = array of String;

  private type
    TValuesMap = specialize TutlMap<string, TIntArray>;
    TNamesMap  = specialize TutlMap<string, TStringArray>;

  private class var
    fValuesMap: TValuesMap;
    fNamesMap: TNamesMap;

  protected
    class procedure RegisterType  (const aValues: TIntArray; const aNames: TStringArray);
    class procedure UnregisterType();

  public
    class function ToString   (const aValue: Integer; const aAllowOrd: Boolean = false): String; reintroduce;
    class function TryToEnum  (const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean;
    class function ToEnum     (const aStr: String; const aAllowOrd: Boolean = false): Integer; overload;
    class function ToEnum     (const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean = false): Integer; overload;

    class function IntValues: TIntArray;
    class function Names:     TStringArray;

  public
    class constructor Initialize;
    class destructor  Finalize;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlEnumHelper<T> = class(TutlEnumHelperBase)
  public type
    TEnumType = T;
    TValueArray = array of T;

  private class var
    fValues: TValueArray;
    fNames: TStringArray;
    fIntValues: TIntArray;
    fTypeInfo: PTypeInfo;

  public
    class function ToString   (const aValue: T; const aAllowOrd: Boolean = false): String; reintroduce;
    class function TryToEnum  (const aStr: String; out aValue: T; const aAllowOrd: Boolean = false): Boolean;
    class function ToEnum     (const aStr: String; const aAllowOrd: Boolean = false): T; overload;
    class function ToEnum     (const aStr: String; const aDefault: T; const aAllowOrd: Boolean = false): T; overload;

    class function Values:    TValueArray; inline;
    class function IntValues: TIntArray; inline;
    class function Names:     TStringArray; inline;
    class function TypeInfo:  PTypeInfo; inline;

    class constructor Initialize;
    class destructor  Finalize;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlSetHelperBase = class
  private type
    TEnumHelperMap = specialize TutlMap<string, TutlEnumHelperBaseClass>;

  private class var
    fEnumHelpers: TEnumHelperMap;

  private
    class function  IsSet     (const aSet; const aSize: Integer; const aValue: Integer): Boolean;
    class procedure SetValue  (var   aSet; const aSize: Integer; const aValue: Integer);
    class procedure ClearValue(var   aSet; const aSize: Integer; const aValue: Integer);

  protected
    class procedure RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass);
    class procedure UnregisterEnumHelper;

  public
    class function ToString(
      const     aSet;
      const     aSize: Integer;
      const     aSeparator: String = ', ';
      const     aAllowOrd: Boolean = false): String; reintroduce;

    class function TryToSet(
      const     aStr: String;
      out       aSet;
      const     aSize: Integer;
      const     aAllowOrd: Boolean = false): Boolean;

    class function TryToSet(
      const     aStr: String;
      const     aSeparator: String;
      out       aSet;
      const     aSize: Integer;
      const     aAllowOrd: Boolean = false): Boolean;

    class function Compare(
      const     aSet1;
      const     aSet2;
      const     aSize: Integer): Integer;

    class function EnumHelper: TutlEnumHelperBaseClass;

    class constructor Initialize;
    class destructor  Finalize;
  end;
  TutlSetHelperBaseClass = class of TutlSetHelperBase;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlSetHelper<TEnum, TSet> = class(TutlSetHelperBase)
  public type
    TEnumHelper = specialize TutlEnumHelper<TEnum>;
    TEnumType = TEnum;
    TSetType = TSet;

  public
    class function ToString(
      const aValue: TSet;
      const aSeparator: String = ', ';
      const aAllowOrd: Boolean = false): String; overload;

    class function TryToSet(
      const aStr: String;
      out aValue: TSet;
      const aAllowOrd: Boolean = false): Boolean; overload;

    class function TryToSet(
      const aStr: String;
      const aSeparator: String;
      out aValue: TSet;
      const aAllowOrd: Boolean = false): Boolean; overload;

    class function ToSet(
      const aStr: String;
      const aDefault: TSet;
      const aAllowOrd: Boolean = false): TSet; overload;

    class function ToSet(
      const aStr: String;
      const aAllowOrd: Boolean = false): TSet; overload;

    class function Compare(
      const aSet1, aSet2: TSet): Integer; overload;

    class constructor Initialize;
    class destructor  Finalize;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue.TEnumerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.TEnumerator.InternalMoveNext: Boolean;
begin
  if fReversed
    then dec(fCurrent)
    else inc(fCurrent);
  result := (0 <= fCurrent) and (fCurrent < fOwner.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.TEnumerator.InternalReset;
begin
  if fReversed
    then fCurrent := fOwner.Count
    else fCurrent := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlQueue.TEnumerator.Reverse: IutlEnumerator;
begin
  result := TEnumerator.Create(fOwner, not fReversed);
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.TEnumerator.GetCurrent: T;
begin
  result := fOwner[fCurrent];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlQueue.TEnumerator.Create(const aOwner: TutlQueue; const aReversed: Boolean);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner    := aOwner;
  fReversed := aReversed;
  inherited Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetItem(const aIndex: Integer): T;
var
  i: Integer;
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  i := fReadPos + aIndex;
  if (i >= Capacity) then
    i := i - Capacity;
  result := GetInternalItem(i)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.SetItem(const aIndex: Integer; aItem: T);
var
  i: Integer;
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  i := fReadPos + aIndex;
  if (i >= Capacity) then
    i := i - Capacity;
  GetInternalItem(i)^ := aItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetCount: Integer;
begin
  result := fCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.SetCount(const aValue: Integer);
begin
  raise ENotSupportedException.Create('SetCount not supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.SetCapacity(const aValue: integer);
var
  cnt: Integer;
begin
  if (aValue < Count) then
    raise EArgumentException.Create('can not reduce capacity below count');

  if (aValue < Capacity) then begin // is shrinking
    if (fReadPos <= fWritePos) then begin // ReadPos Before WritePos -> Move To Begin
      System.Move(GetInternalItem(fReadPos)^, GetInternalItem(0)^, SizeOf(T) * Count);
      fReadPos  := 0;
      fWritePos := Count;
    end else if (fReadPos > fWritePos) then begin // ReadPos Behind WritePos
      cnt := Capacity - aValue;
      System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
      dec(fReadPos, cnt);
    end;
  end;

  inherited SetCapacity(aValue);

  // ReadPos After WritePos and Expanding
  if (fReadPos > fWritePos) and (aValue > Capacity) then begin
    cnt := aValue - Capacity;
    System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
    inc(fReadPos, cnt);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetEnumerator: IEnumerator;
begin
  result := TEnumerator.Create(self, false);
  result.Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetUtlEnumerator: IutlEnumerator;
begin
  result := TEnumerator.Create(self, false);
  result.Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Enqueue(constref aItem: T);
begin
  if (Count = Capacity) then
    Expand;
  fWritePos := fWritePos mod Capacity;
  GetInternalItem(fWritePos)^ := aItem;
  inc(fCount);
  inc(fWritePos);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Dequeue: T;
begin
  result := Dequeue(false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Dequeue(const aFreeItem: Boolean): T;
var
  p: PT;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('queue is empty');
  p := GetInternalItem(fReadPos);
  if aFreeItem
    then FillByte(result{%H-}, SizeOf(result), 0)
    else result := p^;
  Release(p^, aFreeItem);
  dec(fCount);
  fReadPos := (fReadPos + 1) mod Capacity;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Peek: T;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('queue is empty');
  result := GetInternalItem(fReadPos)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.ShrinkToFit;
begin
  Shrink(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Clear;
begin
  while (fReadPos <> fWritePos) do begin
    Release(GetInternalItem(fReadPos)^, true);
    fReadPos := (fReadPos + 1) mod Capacity;
  end;
  fCount := 0;
  if CanShrink then
    ShrinkToFit;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlQueue.Create(const aOwnsItems: Boolean);
begin
  inherited Create(aOwnsItems);
  fCount    := 0;
  fReadPos  := 0;
  fWritePos := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlQueue.Destroy;
begin
  Clear;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStack.TEnumerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.TEnumerator.InternalReset;
begin
  First  := 0;
  Last   := fOwner.Count-1;
  if (Last >= First)
    then Memory := fOwner.GetInternalItem(0)
    else Memory := nil;
  inherited InternalReset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlStack.TEnumerator.Reverse: IutlEnumerator;
begin
  result := TEnumerator.Create(fOwner, not Reversed);
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlStack.TEnumerator.Create(const aOwner: TutlStack; const aReversed: Boolean);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner := aOwner;
  inherited Create(nil, aReversed, 0, -1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStack/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.GetItem(const aIndex: Integer): T;
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  result := GetInternalItem(aIndex)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.SetItem(const aIndex: Integer; aValue: T);
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  GetInternalItem(aIndex)^ := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.GetCount: Integer;
begin
  result := fCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.SetCount(const aValue: Integer);
begin
  raise ENotSupportedException.Create('SetCount not supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.GetEnumerator: IEnumerator;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.GetUtlEnumerator: IutlEnumerator;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.Push(constref aItem: T);
begin
  if (Count = Capacity) then
    Expand;
  GetInternalItem(fCount)^ := aItem;
  inc(fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.Pop: T;
begin
  Pop(false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.Pop(const aFreeItem: Boolean): T;
var
  p: PT;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('stack is empty');
  p := GetInternalItem(fCount-1);
  if aFreeItem
    then FillByte(result{%H-}, SizeOf(result), 0)
    else result := p^;
  Release(p^, aFreeItem);
  dec(fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.Peek: T;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('stack is empty');
  result := GetInternalItem(fCount-1)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.ShrinkToFit;
begin
  Shrink(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.Clear;
begin
  while (fCount > 0) do begin
    dec(fCount);
    Release(GetInternalItem(fCount)^, true);
  end;
  if CanShrink then
    ShrinkToFit;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlStack.Create(const aOwnsItems: Boolean);
begin
  inherited Create(aOwnsItems);
  fCount := 0
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlStack.Destroy;
begin
  Clear;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.GetFirst: T;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('list is empty');
  result := GetInternalItem(0)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.GetLast: T;
begin
  if IsEmpty then
    raise EInvalidOperation.Create('list is empty');
  result := GetInternalItem(Count-1)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Add(constref aItem: T): Integer;
begin
  result := Count;
  InsertIntern(result, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Insert(const aIndex: Integer; constref aItem: T);
begin
  InsertIntern(aIndex, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
var
  tmp: T;
  p1, p2: PT;
begin
  if (aIndex1 < 0) or (aIndex1 >= Count) then
    raise EOutOfRangeException.Create(aIndex1, 0, Count-1);
  if (aIndex2 < 0) or (aIndex2 >= Count) then
    raise EOutOfRangeException.Create(aIndex2, 0, Count-1);
  p1  := GetInternalItem(aIndex1);
  p2  := GetInternalItem(aIndex2);
  System.Move(p1^, tmp{%H-}, SizeOf(T));
  System.Move(p2^, p1^, SizeOf(T));
  System.Move(tmp, p2^, SizeOf(T));
  FillByte(tmp, SizeOf(tmp), 0)
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Move(const aCurrentIndex, aNewIndex: Integer);
var
  tmp: T;
  cur, new: PT;
begin
  if (aCurrentIndex < 0) or (aCurrentIndex >= Count) then
    raise EOutOfRangeException.Create(aCurrentIndex, 0, Count-1);
  if (aNewIndex < 0) or (aNewIndex >= Count) then
    raise EOutOfRangeException.Create(aNewIndex, 0, Count-1);
  if (aCurrentIndex = aNewIndex) then
    exit;
  cur := GetInternalItem(aCurrentIndex);
  new := GetInternalItem(aNewIndex);
  System.Move(cur^, tmp{%H-}, SizeOf(T));
  if (aNewIndex > aCurrentIndex) then begin
    System.Move((cur+1)^, cur^, SizeOf(T) * (aNewIndex - aCurrentIndex));
  end else begin
    System.Move(new^, (new+1)^, SizeOf(T) * (aCurrentIndex - aNewIndex));
  end;
  System.Move(tmp, new^, SizeOf(T));
  FillByte(tmp, SizeOf(tmp), 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Extract(const aIndex: Integer): T;
begin
  result := GetItem(aIndex);
  DeleteIntern(aIndex, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushFirst(constref aItem: T);
begin
  InsertIntern(0, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
begin
  if aFreeItem
    then FillByte(result{%H-}, SizeOf(result), 0)
    else result := GetItem(0);
  DeleteIntern(0, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushLast(constref aItem: T);
begin
  InsertIntern(Count, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
begin
  if aFreeItem
    then FillByte(result{%H-}, SizeOf(result), 0)
    else result := GetItem(Count-1);
  DeleteIntern(Count-1, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.IndexOf(const aItem: T): Integer;
begin
  result := Count-1;
  while     (result >= 0)
        and not fEqualityComparer.EqualityCompare(Items[result], aItem)
  do
    dec(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
var
  i: Integer;
begin
  i := IndexOf(aItem);
  if (i >= 0) then begin
    result := Items[i];
    DeleteIntern(i, false);
  end else
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Remove(const aItem: T): Integer;
begin
  result := IndexOf(aItem);
  if (result >= 0) then
    DeleteIntern(result, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
begin
  if not Assigned(aEqualityComparer) then
    raise EArgumentNilException.Create('aEqualityComparer');
  inherited Create(aOwnsItems);
  fEqualityComparer := aEqualityComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomList.Destroy;
begin
  fEqualityComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlList.Create(const aOwnsItems: Boolean);
begin
  inherited Create(TEqualityComparer.Create, aOwnsItems);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomHashSet.SetCount(const aValue: Integer);
begin
  raise ENotSupportedException.Create('SetCount not supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomHashSet.SetItem(const aIndex: Integer; aValue: T);
begin
  if not fComparer.EqualityCompare(GetItem(aIndex), aValue) then
    EInvalidOperation.Create('values are not equal');
  inherited SetItem(aIndex, aValue);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Add(constref aItem: T): Boolean;
var
  i: Integer;
begin
  result := not TBinarySearch.Search(self, fComparer, aItem, i);
  if result then
    InsertIntern(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Contains(constref aItem: T): Boolean;
var
  i: Integer;
begin
  result := TBinarySearch.Search(self, fComparer, aItem, i);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.IndexOf(constref aItem: T): Integer;
begin
  if not TBinarySearch.Search(self, fComparer, aItem, result) then
    result := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Remove(constref aItem: T): Boolean;
var
  i: Integer;
begin
  result := TBinarySearch.Search(self, fComparer, aItem, i);
  if result then
    DeleteIntern(i, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomHashSet.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomHashSet.Create(const aComparer: IComparer; const aOwnsItems: Boolean);
begin
  inherited Create(aOwnsItems);
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomHashSet.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHastSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlHashSet.Create(const aOwnsItems: Boolean);
begin
  inherited Create(TComparer.Create, aOwnsItems);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.THashSet////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean);
begin
  if not utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem) then
    Finalize(aItem.Key);
  if not utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem) then
    Finalize(aItem.Key);
  inherited Release(aItem, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.THashSet.Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
begin
  inherited Create(aComparer, true);
  fOwner := aOwner;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyValuePairComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairComparer.EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;
begin
  result := fComparer.EqualityCompare(i1.Key, i2.Key);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairComparer.Compare(constref i1, i2: TKeyValuePair): Integer;
begin
  result := fComparer.Compare(i1.Key, i2.Key);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyValuePairComparer.Create(aComparer: IComparer);
begin
  if not Assigned(aComparer) then
    raise EArgumentNilException.Create('aComparer');
  inherited Create;
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.TKeyValuePairComparer.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyEnumerator.InternalMoveNext: Boolean;
begin
  result := fEnumerator.MoveNext;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.TKeyEnumerator.InternalReset;
begin
  fEnumerator.Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyEnumerator.GetCurrent: TKey;
begin
  result := fEnumerator.GetCurrent.Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyEnumerator.Create(aEnumerator: IutlKeyValuePairEnumerator);
begin
  if not Assigned(aEnumerator) then
    raise EArgumentNilException.Create('aEnumerator');
  fEnumerator := aEnumerator;
  inherited Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TValueEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TValueEnumerator.InternalMoveNext: Boolean;
begin
  result := fEnumerator.MoveNext;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.TValueEnumerator.InternalReset;
begin
  fEnumerator.Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TValueEnumerator.GetCurrent: TValue;
begin
  result := fEnumerator.GetCurrent.Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TValueEnumerator.Create(aEnumerator: IutlKeyValuePairEnumerator);
begin
  if not Assigned(aEnumerator) then
    raise EArgumentNilException.Create('aEnumerator');
  fEnumerator := aEnumerator;
  inherited Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyCollection//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyCollection.GetEnumerator: IKeyEnumerator;
begin
  result := TKeyEnumerator.Create(fHashSet.GetUtlEnumerator);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyCollection.GetUtlEnumerator: IutlKeyEnumerator;
begin
  result := TKeyEnumerator.Create(fHashSet.GetUtlEnumerator);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyCollection.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyCollection.GetItem(const aIndex: Integer): TKey;
begin
  result := fHashSet[aIndex].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyCollection.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyValuePairCollection/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairCollection.GetEnumerator: IKeyValuePairEnumerator;
begin
  result := fHashSet.GetEnumerator;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: IutlKeyValuePairEnumerator;
begin
  result := fHashSet.GetUtlEnumerator;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairCollection.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairCollection.GetItem(const aIndex: Integer): TKeyValuePair;
begin
  result := fHashSet[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyValuePairCollection.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetValue(aKey: TKey): TValue;
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  i := fHashSetRef.IndexOf(kvp);
  if (i < 0)
    then FillByte(result{%H-}, SizeOf(result), 0)
    else result := fHashSetRef[i].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetValueAt(const aIndex: Integer): TValue;
begin
  result := fHashSetRef[aIndex].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetCount: Integer;
begin
  result := fHashSetRef.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetIsEmpty: Boolean;
begin
  result := fHashSetRef.IsEmpty;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetCapacity: Integer;
begin
  result := fHashSetRef.Capacity;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetCanShrink: Boolean;
begin
  result := fHashSetRef.CanShrink;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetCanExpand: Boolean;
begin
  result := fHashSetRef.CanExpand;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetCapacity(const aValue: Integer);
begin
  fHashSetRef.Capacity := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetCanShrink(const aValue: Boolean);
begin
  fHashSetRef.CanShrink := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetCanExpand(const aValue: Boolean);
begin
  fHashSetRef.CanExpand := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetValue(aKey: TKey; const aValue: TValue);
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  i         := fHashSetRef.IndexOf(kvp);
  if (i < 0) then begin
    if not fAutoCreate then
      raise EInvalidOperation.Create('key not found');
    fHashSetRef.Add(kvp);
  end else
    fHashSetRef[i] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetValueAt(const aIndex: Integer; const aValue: TValue);
var
  kvp: TKeyValuePair;
begin
  kvp := fHashSetRef[aIndex];
  kvp.Value := aValue;
  fHashSetRef[aIndex] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetEnumerator: IValueEnumerator;
begin
  result := TValueEnumerator.Create(fHashSetRef.GetUtlEnumerator);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetUtlEnumerator: IutlValueEnumerator;
begin
  result := TValueEnumerator.Create(fHashSetRef.GetUtlEnumerator);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Add(constref aKey: TKey; constref aValue: TValue);
begin
  if not TryAdd(aKey, aValue) then
    raise EInvalidOperation.Create('key already exists');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TryAdd(constref aKey: TKey; constref aValue: TValue): Boolean;
var
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  result := fHashSetRef.Add(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TryGetValue(constref aKey: TKey; out aValue: TValue): Boolean;
var
  i: Integer;
begin
  i := IndexOf(aKey);
  result := (i >= 0);
  if result
    then aValue := fHashSetRef[i].Value
    else FillByte(result, SizeOf(result), 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.IndexOf(constref aKey: TKey): Integer;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result  := fHashSetRef.IndexOf(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.Contains(constref aKey: TKey): Boolean;
begin
  result := (IndexOf(aKey) >= 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.Remove(constref aKey: TKey): Boolean;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result := fHashSetRef.Remove(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Delete(constref aKey: TKey);
begin
  if not Remove(aKey) then
    raise EInvalidOperation.Create('key not found');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.DeleteAt(const aIndex: Integer);
begin
  fHashSetRef.Delete(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Clear;
begin
  fHashSetRef.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.Create(
  const aHashSet: THashSet;
  const aOwnsKeys: Boolean;
  const aOwnsValues: Boolean);
begin
  if not Assigned(aHashSet) then
    EArgumentNilException.Create('aHashSet');

  inherited Create;

  fAutoCreate := false;
  fHashSetRef := aHashSet;
  fOwnsKeys   := aOwnsKeys;
  fOwnsValues := aOwnsValues;

  fKeyCollection          := TKeyCollection.Create(fHashSetRef);
  fKeyValuePairCollection := TKeyValuePairCollection.Create(fHashSetRef);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.Destroy;
begin
  Clear;
  FreeAndNil(fKeyValuePairCollection);
  FreeAndNil(fKeyCollection);
  fHashSetRef := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMap.Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
begin
  fHashSetImpl := THashSet.Create(self, TKeyValuePairComparer.Create(TComparer.Create));
  inherited Create(fHashSetImpl, aOwnsKeys, aOwnsValues);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMap.Destroy;
begin
  inherited Destroy;
  FreeAndNil(fHashSetImpl);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHandleManager//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHandleManager.Grow;
var
  oldIdx, newIdx, i: Integer;
begin
  oldIdx := High(fEntries);
  SetLength(fEntries, Length(fEntries) + fGrowSize);
  newIdx := High(fEntries);
  for i := oldIdx to newIdx do
    fEntries[i].NextFreeIndex := i + 1;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHandleManager.Get(const aHandle: TutlHandle): T;
begin
  if not TryGet(aHandle, result) then
    raise EArgumentException.Create('unknown or invalid handle');
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHandleManager.TryGet(const aHandle: TutlHandle; out aData: T): Boolean;
begin
  with THandleData(aHandle) do begin
    result := IsValid(aHandle);
    if result
      then aData := fEntries[Index].Data
      else FillByte(aData, SizeOf(T), 0);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHandleManager.Add(constref aData: T; const aIdentifier: Word): TutlHandle;
var
  i: Integer;
begin
  i := fFirstFreeIndex;
  if (High(fEntries) < i) then
    Grow;
  Assert(not fEntries[i].IsActive);
  fFirstFreeIndex := fEntries[i].NextFreeIndex;
  fEntries[i].NextFreeIndex := 0;
  fEntries[i].Counter       := fEntries[i].Counter + 1;
  if (fEntries[i].Counter = 0) then
    fEntries[i].Counter := 1;
  fEntries[i].IsActive  := true;
  fEntries[i].Data      := aData;
  inc(fCount);
  with THandleData(result) do begin
    Index      := i;
    Counter    := fEntries[i].Counter;
    Identifier := aIdentifier;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHandleManager.IsValid(const aHandle: TutlHandle): Boolean;
begin
  with THandleData(aHandle) do begin
    result :=     (fEntries[Index].Counter = Counter)
              and (fEntries[Index].IsActive)
              and (h.Index <= High(fEntries));
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHandleManager.Update(const aHandle: TutlHandle; aData: T);
begin
  if not IsValid(aHandle) then
    raise EArgumentException.Create('unknown or invalid handle');
  with THandleData(aHandle) do begin
    if not utlFinalizeObject(fEntries[Index].Data, TypeInfo(T), fOwnsValues) then
      Finalize(fEntries[Index].Data);
    fEntries[Index].Data := aData;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHandleManager.Remove(const aHandle: TutlHandle);
begin
  if not IsValid(aHandle) then
    raise EArgumentException.Create('unknown or invalid handle');
  with THandleData(aHandle) do begin
    fEntries[Index].NextFreeIndex := fFirstFreeIndex;
    fEntries[Index].IsActive      := false;
    fFirstFreeIndex               := Index;
    if not utlFinalizeObject(fEntries[Index].Data, TypeInfo(T), fOwnsValues) then
      Finalize(fEntries[Index].Data);
  end;
  dec(fCount);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHandleManager.Clear;
var
  i: Integer;
begin
  for i := low(fEntries) to high(fEntries) do begin
    if fEntries[i].IsActive and not utlFinalizeObject(fEntries[i].Data, TypeInfo(T), fOwnsValues) then
      Finalize(fEntries[i].Data);
  end;
  SetLength(fEntries, 0);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlHandleManager.Create(const aOwnsValues: Boolean);
begin
  inherited Create;
  fGrowSize       := 50;
  fCount          := 0;
  fFirstFreeIndex := 0;
  fOwnsValues     := aOwnsValues;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlHandleManager.Destroy;
begin
  Clear;
  inherited Destroy;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlHandleManager.GetIdentifier(const aHandle: TutlHandle): Word;
begin
  result := THandleData(aHandle).Identifier;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//EutlEnumConvert///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EEnumConvertException.Create(const aValue, aExpectedType: String);
begin
  inherited Create(Format('%s is not a %s', [aValue, aExpectedType]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelperBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlEnumHelperBase.RegisterType(const aValues: TIntArray; const aNames: TStringArray);
begin
  fValuesMap.Add(ClassName, aValues);
  fNamesMap.Add (ClassName, aNames);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlEnumHelperBase.UnregisterType;
begin
  fValuesMap.Remove(ClassName);
  fNamesMap.Remove(ClassName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToString(const aValue: Integer; const aAllowOrd: Boolean = false): String;
var
  i: Integer;
  iArr: TIntArray;
  sArr: TStringArray;
begin
  iArr := fValuesMap[ClassName];
  sArr := fNamesMap[ClassName];
  for i := low(iArr) to high(iArr) do begin
    if (iArr[i] = aValue) then begin
      result := sArr[i];
      exit;
    end;
  end;
  if aAllowOrd
    then result := IntToStr(aValue)
    else result := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.TryToEnum(const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean;
var
  i: Integer;
  iArr: TIntArray;
  sArr: TStringArray;
begin
  iArr := fValuesMap[ClassName];
  sArr := fNamesMap[ClassName];
  for i := low(sArr) to high(sArr) do begin
    if (sArr[i] = aStr) then begin
      result := true;
      aValue := iArr[i];
      exit;
    end;
  end;
  if aAllowOrd
    then result := TryStrToInt(aStr, aValue)
    else result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aAllowOrd: Boolean): Integer;
begin
  if not TryToEnum(aStr, result, aAllowOrd) then
    raise EConvertError.Create(aStr + ' is an unknown enum value');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean): Integer;
begin
  if not TryToEnum(aStr, result, aAllowOrd) then
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.IntValues: TIntArray;
begin
  result := fValuesMap[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.Names: TStringArray;
begin
  result := fNamesMap[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlEnumHelperBase.Initialize;
begin
  fNamesMap  := TNamesMap.Create(true, true);
  fValuesMap := TValuesMap.Create(true, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlEnumHelperBase.Finalize;
begin
  FreeAndNil(fNamesMap);
  FreeAndNil(fValuesMap);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(const aValue: T; const aAllowOrd: Boolean): String;
begin
  {$Push}
  {$IOChecks OFF}
  WriteStr(Result, aValue);
  if IOResult = 107 then
    Result := '';
  {$Pop}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(const aStr: String; out aValue: T; const aAllowOrd: Boolean): Boolean;
var
  a: T;
  i: Integer;
begin
  a := T(0);
  Result := false;
  if Length(aStr) = 0 then
    exit;

  {$Push}
  {$IOChecks OFF}
  ReadStr(aStr, a);
  Result := IOResult <> 106;
  {$Pop}
  if Result then
    aValue := a
  else if aAllowOrd then begin
    result := TryStrToInt(aStr, i);
    if result then
      aValue := T(i);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(const aStr: String; const aAllowOrd: Boolean): T;
begin
  if not TryToEnum(aStr, result, aAllowOrd) then
    raise EEnumConvertException.Create(aStr, TypeInfo^.Name);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(const aStr: String; const aDefault: T; const aAllowOrd: Boolean): T;
begin
  if not TryToEnum(aStr, result, aAllowOrd) then
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Values: TValueArray;
begin
  result := fValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.IntValues: TIntArray;
begin
  result := fIntValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Names: TStringArray;
begin
  result := fNames;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TypeInfo: PTypeInfo;
begin
  result := fTypeInfo;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlEnumHelper.Initialize;
var
  tiArray: PTypeInfo;
  tdArray, tdEnum: PTypeData;
  PName: PShortString;
  i: integer;
  en: T;
  sl: TStringList;
begin
  {
    See FPC Bug http://bugs.freepascal.org/view.php?id=27622
    For Sparse Enums, the compiler won't give us TypeInfo, because it contains some wrong data. This is
    safe, but sadly we don't even get the *correct* fields (TypeName, NameList), even though they are
    generated in any case.
    Fortunately, arrays do know this type info segment as their Element Type (and we declared one anyway).
  }
  tiArray   := System.TypeInfo(TValueArray);
  tdArray   := GetTypeData(tiArray);
  fTypeInfo := tdArray^.elType2;

  {
   Now that we have the TypeInfo, fill our values from it. This is safe because while the *values* in
   TypeData are wrong for Sparse Enums, the *PName* are always correct.
  }
  tdEnum := GetTypeData(FTypeInfo);
  PName  := @tdEnum^.NameList;
  sl     := TStringList.Create;
  try
    while Length(PName^) > 0 do begin
      {
        Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
        This can normally not be the same as a valid enum value, because it is in the same identifier
        namespace. However, with scoped enums we might have the same name for module and element, because
        the full identifier for the element would be TypeName.ElementName.
        In either case, the next PShortString will point to a zero-length string, and the loop is left
        with the last element being invalid (either empty or whatever value the unit-named element has).
      }
      sl.Add(PName^);
      if TryToEnum(PName^, en) then
        sl.Objects[sl.Count-1] := TObject({%H-}Pointer(PtrUInt(en)));
      inc(PByte(PName), Length(PName^) + 1);
    end;

    sl.Delete(sl.Count-1); // remove the EnumUnitName item
    SetLength(fValues,    sl.Count);
    SetLength(fIntValues, sl.Count);
    SetLength(fNames,     sl.Count);
    for i := 0 to sl.Count-1 do begin
      fNames[i]     := sl[i];
      fValues[i]    := T(PtrUInt(sl.Objects[i]));
      fIntValues[i] := Integer(fValues[i]);
    end;

  finally
    FreeAndNil(sl);
  end;

  RegisterType(fIntValues, fNames);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlEnumHelper.Finalize;
begin
  Finalize(fNames);
  Finalize(fValues);
  Finalize(fIntValues);
  UnregisterType;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSetHelperBase/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.IsSet(const aSet; const aSize: Integer; const aValue: Integer): Boolean;
begin
  if (aValue >= 8*aSize) then
    raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
  result := ((PByte(@aSet)[aValue shr 3] and (1 shl (aValue and 7))) <> 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelperBase.SetValue(var aSet; const aSize: Integer; const aValue: Integer);
begin
  if (aValue >= 8*aSize) then
    raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
  PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] or (1 shl (aValue and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelperBase.ClearValue(var aSet; const aSize: Integer; const aValue: Integer);
begin
  if (aValue >= 8*aSize) then
    raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
  PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] and not (1 shl (aValue and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelperBase.RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass);
begin
  fEnumHelpers.Add(ClassName, aHelper);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelperBase.UnregisterEnumHelper;
begin
  fEnumHelpers.Remove(ClassName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.ToString(const aSet; const aSize: Integer; const aSeparator: String;
  const aAllowOrd: Boolean): String;
var
  i: Integer;
  h: TutlEnumHelperBaseClass;
  arr: TutlEnumHelperBase.TIntArray;
begin
  h := EnumHelper;
  if not Assigned(h) then
    raise EInvalidOperation.Create('enum helper class is not set');
  result := '';
  arr    := h.IntValues;
  for i in arr do begin
    if IsSet(aSet, aSize, i) then begin
      if result > '' then
        result := result + aSeparator;
      result := result + h.ToString(i, aAllowOrd);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.TryToSet(const aStr: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean;
begin
  result := TryToSet(aStr, ',', aSet, aSize, aAllowOrd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.TryToSet(const aStr: String; const aSeparator: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean;
var
  i, j, e: Integer;
  s: String;
  h: TutlEnumHelperBaseClass;
begin
  if (aSeparator = '') then
    raise EArgumentException.Create('''aSeparator'' can not be empty');
  h := EnumHelper;
  if not Assigned(h) then
    raise EInvalidOperation.Create('enum helper class is not set');

  result := true;
  i      := 1;
  j      := 1;

  FillByte(aSet{%H-}, aSize, 0);
  while (i <= Length(aStr)) do begin
    if (Copy(aStr, i, Length(aSeparator)) = aSeparator) then begin
      s := Trim(copy(aStr, j, i - j));
      if (s <> '') then begin
        result := result and h.TryToEnum(s, e);
        if not result then
          exit;
        SetValue(aSet, aSize, e);
        j := i + Length(aSeparator);
      end;
    end;
    inc(i);
  end;

  s := Trim(copy(aStr, j, i - j));
  if (s <> '') then begin
    result := result and h.TryToEnum(s, e);
    if not result then
      exit;
    SetValue(aSet, aSize, e);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.Compare(const aSet1; const aSet2; const aSize: Integer): Integer;
var
  e: Integer;
  h: TutlEnumHelperBaseClass;
begin
  h := EnumHelper;
  if not Assigned(h) then
    raise EInvalidOperation.Create('enum helper class is not set');

  result := 0;
  for e in h.IntValues do begin
    if IsSet(aSet1, aSize, e) and not IsSet(aSet2, aSize, e) then begin
      result := 1;
      break;
    end else
    if not IsSet(aSet1, aSize, e) and IsSet(aSet2, aSize, e) then begin
      result := -1;
      break;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.EnumHelper: TutlEnumHelperBaseClass;
begin
  result := fEnumHelpers[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlSetHelperBase.Initialize;
begin
  fEnumHelpers := TEnumHelperMap.Create(true, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlSetHelperBase.Finalize;
begin
  FreeAndNil(fEnumHelpers);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSetHelper/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.ToString(const aValue: TSet; const aSeparator: String; const aAllowOrd: Boolean): String;
begin
  result := ToString(aValue, SizeOf(aValue), aSeparator, aAllowOrd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean;
begin
  result := TryToSet(aStr, ',', aValue, SizeOf(aValue), aAllowOrd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.TryToSet(const aStr: String; const aSeparator: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean;
begin
  result := TryToSet(aStr, aSeparator, aValue, SizeOf(aValue), aAllowOrd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.ToSet(const aStr: String; const aDefault: TSet; const aAllowOrd: Boolean): TSet;
begin
  if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.ToSet(const aStr: String; const aAllowOrd: Boolean): TSet;
begin
  if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then
    raise EEnumConvertException.CreateFmt('"%s" is an invalid value', [aStr]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.Compare(const aSet1, aSet2: TSet): Integer;
begin
  result := Compare(aSet1, aSet2, SizeOf(aSet1));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlSetHelper.Initialize;
begin
  RegisterEnumHelper(TEnumHelper);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlSetHelper.Finalize;
begin
  UnregisterEnumHelper();
end;

end.