unit uutlGenerics; {$mode objfpc}{$H+} {$modeswitch nestedprocvars} interface uses Classes, SysUtils, TypInfo, uutlExceptions, uutlInterfaces, uutlAlgorithm, uutlCommon; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //Container///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlLinkedList = class(TutlInterfaceNoRefCount, specialize IutlEnumerable) public type Iterator = specialize IutlBidirectionalInputOutputIterator; private type PElement = ^TElement; TElement = packed record prev: PElement; next: PElement; data: T; end; TIterator = class(TInterfacedObject, Iterator, IutlBidirectionalIterator, IutlIterator) strict private fOwner: TutlLinkedList; fElement: PElement; private procedure ReleaseElement(const aElement: PElement); public { IutlIterator } function MoveNext: Boolean; function Clone: IutlIterator; function Equals(const aOther: IutlIterator): Boolean; overload; function GetIsValid: Boolean; property IsValid: Boolean read GetIsValid; public { IutlBidirectionalIterator } function MovePrev: Boolean; public { IutlBidirectionalInputOutputIterator } function GetItem: T; procedure SetItem(aValue: T); public property Element: PElement read fElement; property Owner: TutlLinkedList read fOwner; constructor Create(const aElement: PElement; const aOwner: TutlLinkedList); destructor Destroy; override; end; strict private fOwnsItems: Boolean; fCount: Integer; fFirst: PElement; fLast: PElement; fIterators: array of TIterator; function GetFirst: T; function GetLast: T; function GetIsEmpty: Boolean; function GetFirstIterator: Iterator; function GetLastIterator: Iterator; procedure LinkElement (const aElement: PElement); procedure InsertBefore (const aElement: PElement; constref aItem: T); procedure InsertAfter (const aElement: PElement; constref aItem: T); function Remove (const aElement: PElement; const aFreeItem: Boolean): T; function CreateIterator (const aElement: PElement): TIterator; procedure DestroyIterator (const aIterator: TIterator); protected procedure Release (var aItem: T; const aFreeItem: Boolean); virtual; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; public property Count: Integer read fCount; property IsEmpty: Boolean read GetIsEmpty; property First: T read GetFirst; property Last: T read GetLast; property FirstIterator: Iterator read GetFirstIterator; property LastIterator: Iterator read GetLastIterator; procedure PushFirst (constref aItem: T); function PopFirst (const aFreeItem: Boolean): T; procedure PopFirst; procedure PushLast (constref aItem: T); function PopLast (const aFreeItem: Boolean): T; procedure PopLast; procedure InsertBefore (const aIterator: IutlIterator; constref aItem: T); procedure InsertAfter (const aIterator: IutlIterator; constref aItem: T); function Remove (const aIterator: IutlIterator; const aFreeItem: Boolean): T; procedure Remove (const aIterator: IutlIterator); procedure Clear; constructor Create (const aOwnsItems: Boolean); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic __TutlArrayContainer = class(TutlInterfaceNoRefCount) protected type PT = ^T; strict private fList: PT; function GetIsEmpty: Boolean; protected fCapacity: Integer; fOwnsItems: Boolean; fCanShrink: Boolean; fCanExpand: Boolean; protected function GetCount: Integer; virtual; abstract; function GetInternalItem (const aIndex: Integer): PT; procedure SetCapacity (const aValue: integer); virtual; procedure Release (var aItem: T; const aFreeItem: Boolean); virtual; procedure Shrink (const aExactFit: Boolean); procedure Expand; protected property Count: Integer read GetCount; property IsEmpty: Boolean read GetIsEmpty; property Capacity: Integer read fCapacity write SetCapacity; property CanShrink: Boolean read fCanShrink write fCanShrink; property CanExpand: Boolean read fCanExpand write fCanExpand; property OwnsItems: Boolean read fOwnsItems write fOwnsItems; public constructor Create(const aOwnsItems: Boolean); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlQueue = class(specialize __TutlArrayContainer, specialize IutlEnumerable) strict private fCount: Integer; fReadPos: Integer; fWritePos: Integer; protected function GetCount: Integer; override; procedure SetCapacity(const aValue: integer); override; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; property Enumerator: specialize IutlEnumerator read GetUtlEnumerator; public property Count; 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 = class(specialize __TutlArrayContainer, specialize IutlEnumerable) strict private fCount: Integer; protected function GetCount: Integer; override; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; property Enumerator: specialize IutlEnumerator read GetUtlEnumerator; public property Count; 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 __TutlListBase = class(specialize __TutlArrayContainer, specialize IutlEnumerable) strict private fCount: Integer; protected function GetCount: Integer; override; function GetItem (const aIndex: Integer): T; virtual; procedure SetItem (const aIndex: Integer; aValue: T); virtual; procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; property Enumerator: specialize IutlEnumerator read GetUtlEnumerator; public property Count; property IsEmpty; property Capacity; property CanShrink; property CanExpand; property OwnsItems; procedure Clear; procedure ShrinkToFit; constructor Create(const aOwnsItems: Boolean); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlSimpleList = class(specialize __TutlListBase, specialize IutlReadOnlyIndexer, specialize IutlIndexer) 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 = class(specialize TutlSimpleList) public type IEqualityComparer = specialize IutlEqualityComparer; 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 = class(specialize TutlCustomList) public type TEqualityComparer = specialize TutlEqualityComparer; public constructor Create(const aOwnsItems: Boolean); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlCustomHashSet = class(specialize __TutlListBase, specialize IutlReadOnlyIndexer, specialize IutlIndexer) private type TBinarySearch = specialize TutlBinarySearch; public type IComparer = specialize IutlComparer; strict private fComparer: IComparer; protected procedure SetItem(const aIndex: Integer; aValue: T); override; public 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 TutlHastSet = class(specialize TutlCustomHashSet) public type TComparer = specialize TutlComparer; public constructor Create(const aOwnsItems: Boolean); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// EutlMap = class(EutlException); generic TutlCustomMap = class(TutlInterfaceNoRefCount) public type //////////////////////////////////////////////////////////////////////////////////////////////// IComparer = specialize IutlComparer; TKeyValuePair = packed record Key: TKey; Value: TValue; end; //////////////////////////////////////////////////////////////////////////////////////////////// THashSet = class(specialize TutlCustomHashSet) strict private fOwner: TutlCustomMap; protected procedure Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); override; public constructor Create(const aOwner: TutlCustomMap; const aComparer: IComparer); end; //////////////////////////////////////////////////////////////////////////////////////////////// TKeyValuePairComparer = class(TInterfacedObject, THashSet.IComparer) 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 IutlEnumerable, specialize IutlReadOnlyIndexer) private fHashSet: THashSet; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; public { IutlReadOnlyIndexer } function GetItem(const aIndex: Integer): TKey; function GetCount: Integer; public property Items[const aIndex: Integer]: TKey read GetItem; default; property Count: Integer read GetCount; //property Enumerator: specialize IutlEnumerator read GetUtlEnumerator; constructor Create(const aHashSet: THashSet); end; //////////////////////////////////////////////////////////////////////////////////////////////// TKeyValuePairCollection = class(TutlInterfaceNoRefCount, specialize IutlEnumerable, specialize IutlReadOnlyIndexer) private fHashSet: THashSet; public { IutlEnumerable } function GetEnumerator: specialize IEnumerator; function GetUtlEnumerator: specialize IutlEnumerator; public { IutlReadOnlyIndexer } function GetItem(const aIndex: Integer): TKeyValuePair; function GetCount: Integer; public property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default; property Count: Integer read GetCount; property Enumerator: specialize IutlEnumerator read GetUtlEnumerator; 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; function GetValueAt (const aIndex: Integer): TValue; function GetCount: Integer; function GetIsEmpty: Boolean; function GetCapacity: Integer; function GetCanShrink: Boolean; function GetCanExpand: Boolean; procedure SetValue (aKey: TKey; const aValue: TValue); procedure SetValueAt (const aIndex: Integer; const aValue: TValue); procedure SetCapacity (const aValue: Integer); procedure SetCanShrink (const aValue: Boolean); procedure SetCanExpand (const aValue: Boolean); 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 = class(specialize TutlCustomMap) public type TComparer = specialize TutlComparer; strict private fHashSetImpl: THashSet; public constructor Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean); destructor Destroy; override; end; procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); implementation //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); var o: TObject; begin case aTypeInfo^.Kind of tkClass: begin if (aFreeObject) then begin o := TObject(obj); Pointer(obj) := nil; if Assigned(o) then o.Free; end; end; tkInterface: begin IUnknown(obj) := nil; end; tkAString: begin AnsiString(Obj) := ''; end; tkUString: begin UnicodeString(Obj) := ''; end; tkString: begin String(Obj) := ''; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlLinkedList.TIterator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.TIterator.ReleaseElement(const aElement: PElement); begin if (aElement = fElement) then fElement := nil; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.MoveNext: Boolean; begin if not Assigned(fElement) then raise EutlInvalidOperation.Create('this is the null iterator'); result := Assigned(fElement^.next); if result then fElement := fElement^.next; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.Clone: IutlIterator; begin result := fOwner.CreateIterator(fElement); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.Equals(const aOther: IutlIterator): Boolean; var o: TIterator; begin result := Supports(aOther, TIterator, o) and not (Assigned(fElement) xor Assigned(o.fElement)) and (fElement = o.fElement) and (fOwner = o.fOwner); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.GetIsValid: Boolean; begin result := Assigned(fElement); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.MovePrev: Boolean; begin if not Assigned(fElement) then raise EutlInvalidOperation.Create('this is the null iterator'); result := Assigned(fElement^.prev); if result then fElement := fElement^.prev; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.TIterator.GetItem: T; begin if not Assigned(fElement) then raise EutlInvalidOperation.Create('this is the null iterator'); result := fElement^.data; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.TIterator.SetItem(aValue: T); begin if not Assigned(fElement) then raise EutlInvalidOperation.Create('this is the null iterator'); fElement^.data := aValue; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlLinkedList.TIterator.Create(const aElement: PElement; const aOwner: TutlLinkedList); begin inherited Create; fOwner := aOwner; fElement := aElement; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlLinkedList.TIterator.Destroy; begin if Assigned(fOwner) then fOwner.DestroyIterator(self); inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlLinkedList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetFirst: T; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := fFirst^.data; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetLast: T; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := fLast^.data; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetIsEmpty: Boolean; begin result := (fCount = 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetFirstIterator: Iterator; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := CreateIterator(fFirst); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetLastIterator: Iterator; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := CreateIterator(fLast); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.LinkElement(const aElement: PElement); begin if Assigned(aElement^.prev) then begin aElement^.prev^.next := aElement; if (aElement^.prev = fLast) then fLast := aElement; end; if Assigned(aElement^.next) then begin aElement^.next^.prev := aElement; if (aElement^.next = fFirst) then fFirst := aElement; end; if not Assigned(fFirst) then fFirst := aElement; if not Assigned(fLast) then fLast := aElement; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.InsertBefore(const aElement: PElement; constref aItem: T); var e: PElement; begin new(e); e^.data := aItem; if Assigned(aElement) then begin e^.next := aElement; e^.prev := aElement^.prev; end else begin e^.next := nil; e^.prev := nil; end; inc(fCount); LinkElement(e); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.InsertAfter(const aElement: PElement; constref aItem: T); var e: PElement; begin new(e); e^.data := aItem; if Assigned(aElement) then begin e^.prev := aElement; e^.next := aElement^.next; end else begin e^.next := nil; e^.prev := nil; end; inc(fCount); LinkElement(e); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.Remove(const aElement: PElement; const aFreeItem: Boolean): T; var i: Integer; begin if (aElement = fFirst) then fFirst := aElement^.next; if (aElement = fLast) then fLast := aElement^.prev; if Assigned(aElement^.prev) then aElement^.prev^.next := aElement^.next; if Assigned(aElement^.next) then aElement^.next^.prev := aElement^.prev; if aFreeItem then FillByte(result{%H-}, SizeOf(result), 0) else result := aElement^.data; Release(aElement^.data, aFreeItem); for i := Low(fIterators) to High(fIterators) do fIterators[i].ReleaseElement(aElement); dec(fCount); Dispose(aElement); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.CreateIterator(const aElement: PElement): TIterator; begin result := TIterator.Create(aElement, self); SetLength(fIterators, Length(fIterators) + 1); fIterators[High(fIterators)] := result; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.DestroyIterator(const aIterator: TIterator); var i: Integer; begin for i := Low(fIterators) to High(fIterators) do begin if (fIterators[i] = aIterator) then begin if (i < High(fIterators)) then System.Move(fIterators[i+1], fIterators[i], (High(fIterators)-i) * SizeOf(TIterator)); SetLength(fIterators, High(fIterators)); exit; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.Release(var aItem: T; const aFreeItem: Boolean); begin FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem); FillByte(aItem, SizeOf(aItem), 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetEnumerator: specialize IEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.PushFirst(constref aItem: T); begin InsertBefore(fFirst, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.PopFirst(const aFreeItem: Boolean): T; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := Remove(fFirst, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.PopFirst; begin PopFirst(true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.PushLast(constref aItem: T); begin InsertAfter(fLast, aItem) end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.PopLast(const aFreeItem: Boolean): T; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := Remove(fLast, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.PopLast; begin PopLast(true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.InsertBefore(const aIterator: IutlIterator; constref aItem: T); var i: TIterator; begin if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then raise EutlArgument.Create('iterator belongs not to this object', 'aIterator'); if not Assigned(i.Element) then raise EutlInvalidOperation.Create('this is the null iterator'); InsertBefore(i.Element, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.InsertAfter(const aIterator: IutlIterator; constref aItem: T); var i: TIterator; begin if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then raise EutlArgument.Create('iterator belongs not to this object', 'aIterator'); if not Assigned(i.Element) then raise EutlInvalidOperation.Create('this is the null iterator'); InsertAfter(i.Element, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLinkedList.Remove(const aIterator: IutlIterator; const aFreeItem: Boolean): T; var i: TIterator; begin if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then raise EutlArgument.Create('iterator belongs not to this object', 'aIterator'); if not Assigned(i.Element) then raise EutlInvalidOperation.Create('this is the null iterator'); result := Remove(i.Element, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.Remove(const aIterator: IutlIterator); begin Remove(aIterator, true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlLinkedList.Clear; begin while (Count > 0) do PopLast(true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlLinkedList.Create(const aOwnsItems: Boolean); begin inherited Create; fOwnsItems := aOwnsItems; fFirst := nil; fLast := nil; fCount := 0; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlLinkedList.Destroy; begin Clear; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //__TutlArrayContainer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlArrayContainer.GetIsEmpty: Boolean; begin result := (Count = 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT; begin if (aIndex < 0) or (aIndex >= fCapacity) then raise EutlOutOfRange.Create('capacity out of range', aIndex, 0, fCapacity-1); result := fList + aIndex; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlArrayContainer.SetCapacity(const aValue: integer); begin if (fCapacity = aValue) then exit; if (aValue < Count) then raise EutlArgument.Create('can not reduce capacity below count', 'Capacity'); ReAllocMem(fList, aValue * SizeOf(T)); FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0); fCapacity := aValue; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean); begin FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem); FillByte(aItem, SizeOf(aItem), 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlArrayContainer.Shrink(const aExactFit: Boolean); begin if not fCanShrink then raise EutlInvalidOperation.Create('shrinking is not allowed'); if (aExactFit) then SetCapacity(Count) else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used SetCapacity(fCapacity shr 1); // shrink to 50% end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlArrayContainer.Expand; begin if (Count < fCapacity) then exit; if not fCanExpand then raise EutlInvalidOperation.Create('expanding is not allowed'); if (fCapacity <= 0) then SetCapacity(4) else if (fCapacity < 128) then SetCapacity(fCapacity shl 1) // + 100% else SetCapacity(fCapacity + fCapacity shr 2); // + 25% end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor __TutlArrayContainer.Create(const aOwnsItems: Boolean); begin inherited Create; fOwnsItems := aOwnsItems; fList := nil; fCapacity := 0; fCanExpand := true; fCanShrink := true; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor __TutlArrayContainer.Destroy; begin if Assigned(fList) then begin FreeMem(fList); fList := nil; end; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlQueue///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlQueue.GetCount: Integer; begin result := fCount; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlQueue.SetCapacity(const aValue: integer); var cnt: Integer; begin if (aValue < Count) then raise EutlArgument.Create('can not reduce capacity below count', 'Capacity'); 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; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO 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 EutlInvalidOperation.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 EutlInvalidOperation.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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStack.GetEnumerator: specialize IEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStack.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO 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 EutlInvalidOperation.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 EutlInvalidOperation.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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //__TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlListBase.GetCount: Integer; begin result := fCount; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlListBase.GetItem(const aIndex: Integer): T; begin if (aIndex < 0) or (aIndex >= Count) then raise EutlOutOfRange.Create(aIndex, 0, Count-1); result := GetInternalItem(aIndex)^; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlListBase.SetItem(const aIndex: Integer; aValue: T); var p: PT; begin if (aIndex < 0) or (aIndex >= Count) then raise EutlOutOfRange.Create(aIndex, 0, Count-1); p := GetInternalItem(aIndex); Release(p^, true); p^ := aValue; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T); var p: PT; begin if (aIndex < 0) or (aIndex > fCount) then raise EutlOutOfRange.Create(aIndex, 0, fCount); if (fCount = Capacity) then Expand; p := GetInternalItem(aIndex); if (aIndex < fCount) then System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T)); p^ := aValue; inc(fCount); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var p: PT; begin if (aIndex < 0) or (aIndex >= fCount) then raise EutlOutOfRange.Create(aIndex, 0, fCount-1); dec(fCount); p := GetInternalItem(aIndex); Release(p^, aFreeItem); System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex)); if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used SetCapacity(Capacity shr 1); // set to 50% Capacity FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlListBase.GetEnumerator: specialize IEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function __TutlListBase.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlListBase.Clear; begin while (Count > 0) do begin dec(fCount); Release(GetInternalItem(fCount)^, true); end; fCount := 0; if CanShrink then ShrinkToFit; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure __TutlListBase.ShrinkToFit; begin Shrink(true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor __TutlListBase.Create(const aOwnsItems: Boolean); begin inherited Create(aOwnsItems); fCount := 0; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor __TutlListBase.Destroy; begin Clear; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlSimpleList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlSimpleList.GetFirst: T; begin if IsEmpty then raise EutlInvalidOperation.Create('list is empty'); result := GetInternalItem(0)^; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlSimpleList.GetLast: T; begin if IsEmpty then raise EutlInvalidOperation.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 EutlOutOfRange.Create(aIndex1, 0, Count-1); if (aIndex2 < 0) or (aIndex2 >= Count) then raise EutlOutOfRange.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 EutlOutOfRange.Create(aCurrentIndex, 0, Count-1); if (aNewIndex < 0) or (aNewIndex >= Count) then raise EutlOutOfRange.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 EutlArgumentNil.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.SetItem(const aIndex: Integer; aValue: T); begin if not fComparer.EqualityCompare(GetItem(aIndex), aValue) then EutlInvalidOperation.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 TutlHastSet.Create(const aOwnsItems: Boolean); begin inherited Create(TComparer.Create, aOwnsItems); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlCustomMap.THashSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); begin FinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem); FinalizeObject(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 := (Compare(i1, i2) = 0); 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 inherited Create; fComparer := aComparer; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlCustomMap.TKeyValuePairComparer.Destroy; begin fComparer := nil; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlCustomMap.TKeyCollection////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetEnumerator: specialize IEnumerator; begin result := GetUtlEnumerator; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetItem(const aIndex: Integer): TKey; begin result := fHashSet[aIndex].Key; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetCount: Integer; begin result := fHashSet.Count; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlCustomMap.TKeyCollection.Create(const aHashSet: THashSet); begin inherited Create; fHashSet := aHashSet; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlCustomMap.TKeyValuePairCollection///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetEnumerator: specialize IEnumerator; begin result := GetUtlEnumerator; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator; begin // TODO end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetItem(const aIndex: Integer): TKeyValuePair; begin result := fHashSet[aIndex]; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetCount: Integer; begin result := fHashSet.Count; 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.Count <= 0); 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 EutlMap.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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlCustomMap.Add(constref aKey: TKey; constref aValue: TValue); begin if not TryAdd(aKey, aValue) then raise EutlMap.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 EutlMap.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 EutlArgumentNil.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; end.