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;
      fCurrent: Integer;

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

    public { IEnumerator }
      function  GetCurrent: T; override;

    public
      constructor Create(const aOwner: TutlQueue);
    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;

    public { IEnumerator }
      procedure InternalReset; override;

    public
      constructor Create(const aOwner: TutlStack); 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;
    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;

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

  generic TutlEnumHelper<T> = class
  public type
    TEnumType = T;
    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;

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

  private
    class function  IsSet     (constref aSet: TSet; aEnum: TEnum): Boolean;
    class procedure SetValue  (var aSet: TSet; aEnum: TEnum);
    class procedure ClearValue(var aSet: TSet; aEnum: TEnum);

  public
    class function  ToString  (const aValue: TSet; const aSeperator: String = ', '): String; reintroduce;
    class function  TryToSet  (const aStr: String; out aValue: TSet): Boolean; overload;
    class function  TryToSet  (const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; overload;
    class function  ToSet     (const aStr: String; const aDefault: TSet): TSet; overload;
    class function  ToSet     (const aStr: String): TSet; overload;
    class function  Compare   (const aSet1, aSet2: TSet): Integer;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue.TEnumerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.TEnumerator.InternalMoveNext: Boolean;
begin
  inc(fCurrent);
  result := (fCurrent < fOwner.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.TEnumerator.InternalReset;
begin
  fCurrent := -1;
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlQueue.TEnumerator.Create(const aOwner: TutlQueue);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner := aOwner;
  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);
  result.Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetUtlEnumerator: IutlEnumerator;
begin
  result := TEnumerator.Create(self);
  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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlStack.TEnumerator.Create(const aOwner: TutlStack);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner := aOwner;
  inherited Create(nil, 0);
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);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStack.GetUtlEnumerator: IutlEnumerator;
begin
  result := TEnumerator.Create(self);
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
  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.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;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSetHelper/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.IsSet(constref aSet: TSet; aEnum: TEnum): Boolean;
begin
  result := ((PByte(@aSet)[Integer(aEnum) shr 3] and (1 shl (Integer(aEnum) and 7))) <> 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelper.SetValue(var aSet: TSet; aEnum: TEnum);
begin
  PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] or (1 shl (Integer(aEnum) and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelper.ClearValue(var aSet: TSet; aEnum: TEnum);
begin
  PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] and not (1 shl (Integer(aEnum) and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.ToString(const aValue: TSet; const aSeperator: String): String;
var
  e: TEnum;
begin
  result := '';
  for e in TEnumHelper.Values do begin
    if IsSet(aValue, e) then begin
      if result > '' then
        result := result + aSeperator;
      result := result + TEnumHelper.ToString(e);
    end;
  end;
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.TryToSet(const aStr: String; const aSeperator: String; out aValue: TSet): Boolean;
var
  i, j: Integer;
  s: String;
  e: TEnum;
begin
  if (aSeperator = '') then
    raise EArgumentException.Create('''aSeperator'' can not be empty');

  result := true;
  aValue := [];
  i := 1;
  j := 1;

  while (i <= Length(aStr)) do begin
    if (Copy(aStr, i, Length(aSeperator)) = aSeperator) then begin
      s := Trim(copy(aStr, j, i - j));
      if (s <> '') then begin
        result := result and TEnumHelper.TryToEnum(s, e);
        if not result then
          exit;
        SetValue(aValue, e);
        j := i + Length(aSeperator);
      end;
    end;
    inc(i);
  end;

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.Compare(const aSet1, aSet2: TSet): Integer;
var
  e: TEnum;
begin
  result := 0;
  for e in TEnumHelper.Values do begin
    if IsSet(aSet1, e) and not IsSet(aSet2, e) then begin
      result := 1;
      break;
    end else if not IsSet(aSet1, e) and IsSet(aSet2, e) then begin
      result := -1;
      break;
    end;
  end;
end;

end.