|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371 |
- 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.
-
|