utils/uutlGenerics.pas

unit uutlGenerics;

{$mode objfpc}{$H+}

interface

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

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlQueue<T> = class(
    specialize TutlArrayContainer<T>
    , specialize IEnumerable<T>
    {$IFDEF UTL_ENUMERATORS}
    , specialize IutlEnumerable<T>
    {$ENDIF})

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

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

  public { IEnumerable }
    function GetEnumerator: specialize IEnumerator<T>;

  {$IFDEF UTL_ENUMERATORS}
  public { IutlEnumerable }
    function GetUtlEnumerator: specialize IutlEnumerator<T>;
  {$ENDIF}

  public
    property Count: Integer read GetCount;
    property IsEmpty;
    property Capacity;
    property CanExpand;
    property CanShrink;
    property OwnsItems;

    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>
    {$IFDEF UTL_ENUMERATORS}
    , specialize IutlEnumerable<T>
    {$ENDIF})

  strict private
    fCount: Integer;

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

  public { IEnumerable }
    function GetEnumerator: specialize IEnumerator<T>;

  {$IFDEF UTL_ENUMERATORS}
  public { IUtlEnumerable }
    function GetUtlEnumerator: specialize IutlEnumerator<T>;
  {$ENDIF}

  public
    property Count: Integer read GetCount;
    property IsEmpty;
    property Capacity;
    property CanExpand;
    property CanShrink;
    property OwnsItems;

    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
    {$IFDEF UTL_ENUMERATORS}
    , specialize IutlEnumerable<TValue>
    {$ENDIF})

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

    ////////////////////////////////////////////////////////////////////////////////////////////////
    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;

    ////////////////////////////////////////////////////////////////////////////////////////////////
    TKeyCollection = class(
      TutlInterfaceNoRefCount
      , specialize IutlReadOnlyArray<TKey>
      {$IFDEF UTL_ENUMERATORS}
      , specialize IutlEnumerable<TKey>
      {$ENDIF})

    strict private
      fHashSet: THashSet;

    public { IEnumerable }
      function GetEnumerator: specialize IEnumerator<TKey>;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerable }
      function GetUtlEnumerator: specialize IutlEnumerator<TKey>;
    {$ENDIF}

    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>
      {$IFDEF UTL_ENUMERATORS}
      , specialize IutlEnumerable<TKeyValuePair>
      {$ENDIF})

    strict private
      fHashSet: THashSet;

    public { IEnumerable }
      function GetEnumerator: specialize IEnumerator<TKeyValuePair>;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerable }
      function GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>;
    {$ENDIF}

    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 SetValue      (aKey: TKey; const aValue: TValue);             inline;
    procedure SetValueAt    (const aIndex: Integer; const aValue: TValue);  inline;
    procedure SetCapacity   (const aValue: Integer);                        inline;
    procedure SetCanShrink  (const aValue: Boolean);                        inline;
    procedure SetCanExpand  (const aValue: Boolean);                        inline;

  public { IEnumerable }
    function GetEnumerator: specialize IEnumerator<TValue>;

  {$IFDEF UTL_ENUMERATORS}
  public { IutlEnumerable }
    function GetUtlEnumerator: specialize IutlEnumerator<TValue>;
  {$ENDIF}

  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;
    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;

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

  generic TutlEnumHelper<T> = class
  public type
    TValueArray = array of T;
    TStringArray = array of String;

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

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

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

    class constructor Initialize;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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: specialize IEnumerator<T>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator<T>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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: specialize IEnumerator<T>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlStack.GetUtlEnumerator: specialize IutlEnumerator<T>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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
  utlFinalizeObject(aItem.Key,   TypeInfo(aItem.Key),   fOwner.OwnsKeys   and aFreeItem);
  utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem);
  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.TKeyCollection//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyCollection.GetEnumerator: specialize IEnumerator<TKey>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator<TKey>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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: specialize IEnumerator<TKeyValuePair>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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.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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetEnumerator: specialize IEnumerator<TValue>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlCustomMap.GetUtlEnumerator: specialize IutlEnumerator<TValue>;
begin
  result := nil; // TODO
  raise ENotSupportedException.Create('not yet supported');
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Delete(constref aKey: TKey);
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  if not fHashSetRef.Remove(kvp) 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
  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
  Clear;
  inherited Destroy;
  FreeAndNil(fHashSetImpl);
end;

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
var
  a: T;
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;
end;

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Values: TValueArray;
begin
  result := fValues;
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;
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;
  SetLength(fValues, 0);
  SetLength(fNames,  0);
  i:= 0;
  while Length(PName^) > 0 do begin
    SetLength(fValues, i+1);
    SetLength(fNames,  i+1);
    {
      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).
    }
    fNames[i] := PName^;
    if TryToEnum(PName^, en) then
      fValues[i]:= en;

    inc(i);
    inc(PByte(PName), Length(PName^) + 1);
  end;
  // remove the EnumUnitName item
  SetLength(fValues, High(fValues));
  SetLength(fNames,  High(fNames));
end;

end.