1 {
2   Copyright (C) 2014 Yann Mérignac
3 
4   This library is free software; you can redistribute it and/or modify
5   it under the terms of the GNU Lesser General Public License as
6   published by the Free Software Foundation; either version 2.1 of the
7   License, or (at your option) any later version.
8 
9   This library is distributed in the hope that it will be useful, but
10   WITHOUT ANY WARRANTY; without even the implied warranty of
11   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12   Lesser General Public License for more details.
13 
14   As a special exception, the copyright holders of this library give
15   you permission to link this library with independent modules to
16   produce an executable, regardless of the license terms of these
17   independent modules,and to copy and distribute the resulting
18   executable under terms of your choice, provided that you also meet,
19   for each linked independent module, the terms and conditions of the
20   license of that module. An independent module is a module which is
21   not derived from or based on this library. If you modify this
22   library, you may extend this exception to your version of the
23   library, but you are not obligated to do so. If you do not wish to
24   do so, delete this exception statement from your version.
25 
26   You should have received a copy of the GNU Lesser General Public
27   License along with this library. If not, see
28   <http://www.gnu.org/licenses/>.
29 }
30 unit GContnrs;
31 
32 {$mode objfpc}{$H+}
33 
34 interface
35 
36 uses Classes, SysUtils;
37 
38 const
39   MIN_BUCKET_COUNT = 4;
40   MAX_BUCKET_COUNT = 1 shl 30;
41   DEFAULT_HASHMAP_LOAD_FACTOR = 1.0;
42 
43 type
44   EContainerError = class(Exception);
45 
46   { TContainer }
47   TContainer = class
48   protected
49     procedure RaiseContainerEmpty;
50     procedure RaiseCursorDenotesWrongContainer;
51     procedure RaiseCursorIsNil;
52     procedure RaiseError(const Msg: String);
53     procedure RaiseIndexOutOfRange;
54     procedure RaiseItemAlreadyInSet;
55     procedure RaiseItemNotInSet;
56     procedure RaiseKeyAlreadyInMap;
57     procedure RaiseKeyNotInMap;
58     procedure RaiseMethodNotRedefined;
59     procedure Unused(P: Pointer); inline;
60   end;
61 
62   { TGenEnumerator }
63 
64   generic TGenEnumerator<_TItem_, _TPosition_> = class
65   public type
onstnull66     TGetCurrent = function(const Pos: _TPosition_) : _TItem_ of object;
arnull67     TMoveNext = function(var Pos:_TPosition_) : Boolean of object;
68   private
69     fGetter : TGetCurrent;
70     fMover : TMoveNext;
71     fPos : _TPosition_;
72 
GetCurrentnull73     function GetCurrent : _TItem_;
74   public
75     constructor Create(const Pos : _TPosition_; Mover: TMoveNext;
76       Getter: TGetCurrent);
MoveNextnull77     function MoveNext: Boolean;
78     property Current: _TItem_ read GetCurrent;
79   end;
80 
81   { TAbstractVector }
82 
83   TAbstractVector = class(TContainer)
84   protected
85     fCapacity : Integer;
86     fSize : Integer;
87 
88     procedure CheckIndex(Index: Integer); inline;
89     procedure CheckIndexForAdd(Index: Integer); inline;
90     procedure InsertSpaceFast(Position, Count: Integer); virtual; abstract;
ItemToStringnull91     function ItemToString(Index: Integer) : String; virtual; abstract;
92     procedure SetCapacity(ACapacity : Integer); virtual; abstract;
93   public
94     {** Removes all the items from the container. }
95     procedure Clear;
96 
97     {** Deletes Count items begining at Position. }
98     procedure Delete(Position: Integer; Count: Integer = 1);
99 
100     {** Deletes the first Count items. }
101     procedure DeleteFirst(Count: Integer = 1);
102 
103     {** Deletes the last Count items. }
104     procedure DeleteLast(Count: Integer = 1);
105 
106     {** Deletes all items in the range [PosFrom..PosTo]. }
107     procedure DeleteRange(PosFrom, PosTo: Integer);
108 
109     {** Inserts Count undefined items at Position. }
110     procedure InsertSpace(Position: Integer; Count: Integer = 1);
111 
112     {** Returns true if the container is empty. }
IsEmptynull113     function IsEmpty: Boolean; inline;
114 
115     {** Copies Count items from Src to Dst. }
116     procedure Move(Src, Dst, Count: Integer); virtual; abstract;
117 
118     {** If necessary, increases the capacity of the container to ensure that it
119       can hold at least MinCapacity items. }
120     procedure Reserve(MinCapacity: Integer);
121 
122     {** Resizes the container to contain NewSize items. }
123     procedure Resize(NewSize: Integer);
124 
125     {** Reorders the items in reverse order. }
126     procedure Reverse;
127 
128     {** Reorders the items in the range [PosFrom..PosTo] in reverse order. }
129     procedure ReverseRange(PosFrom, PosTo: Integer);
130 
131     {** Rearrange items randomly. }
132     procedure Shuffle;
133 
134     {** Rearrange items in the range [PosFrom..PosTo] randomly. }
135     procedure Shuffle(PosFrom, PosTo: Integer);
136 
137     {** Swaps the values of the items designated by I and J. }
138     procedure Swap(I, J: Integer);
139 
140     {** Swaps the values of the items designated by I and J (no bounds check). }
141     procedure SwapFast(I, J: Integer); virtual; abstract;
142 
143     {** Return a string representation for the container. }
ToStringnull144     function ToString : String; override;
145 
146     {** Capacity of the container. }
147     property Capacity : Integer read fCapacity;
148 
149     {** Number of items. }
150     property Size: Integer read fSize;
151   end;
152 
153   { TGenVector }
154 
155   generic TGenVector<_TItem_> = class(TAbstractVector)
156   public type
157     PItem = ^_TItem_;
158     TCompareItems = function (const A, B: _TItem_) : Integer of object;
159     TItemToString = function (const Item: _TItem_) : String of object;
160     TProcessItem = procedure(var Item: _TItem_) of object;
161     TEnumerator = specialize TGenEnumerator<_TItem_, Integer>;
162 
163   strict private
164     fItems : array of _TItem_;
165     fOnCompareItems: TCompareItems;
166     fOnItemToString: TItemToString;
167 
EnumeratorGetnull168     function EnumeratorGet(const Pos: Integer) : _TItem_;
EnumeratorNextnull169     function EnumeratorNext(var Pos: Integer) : Boolean;
170     procedure Fill(Index, Count: Integer; const Value: _TItem_);
GetItemFastnull171     function GetItemFast(Position: Integer) : _TItem_; inline;
GetItemPtrFastnull172     function GetItemPtrFast(Position: Integer): PItem;
173     procedure InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
174     procedure Quicksort(Left, Right: Integer; Comparator: TCompareItems);
175     class procedure RealMove(Src, Dst: TGenVector;
176       SrcFirst, DstFirst, Count: Integer);
177     procedure SetOnCompareItems(AValue: TCompareItems);
178     procedure SetOnItemToString(AValue: TItemToString);
179 
180   protected
181     procedure InsertSpaceFast(Position, Count: Integer); override;
ItemToStringnull182     function ItemToString(Index: Integer) : String; override;
183     procedure SetCapacity(ACapacity : Integer); override;
184   public
185     {** Inserts Count times Item at the end of the container. }
186     procedure Append(const Item: _TItem_);
187 
188     {** Inserts all the items of Src at the end of the container. }
189     procedure AppendAll(Src: TGenVector);
190 
191     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
192       the container. }
193     procedure AppendRange(Src: TGenVector; PosFrom, PosTo: Integer);
194 
195     {** Searches for Item using the binary search algorithm. Returns the index of
196       Item if its found. Otherwise, returns ( - InsertionPoint - 1 ).
197       InsertionPoint is the point at which the key would be inserted into the
198       container. }
BinarySearchnull199     function BinarySearch(const Item: _TItem_) : Integer;
BinarySearchnull200     function BinarySearch(const Item: _TItem_;
201       Comparator: TCompareItems) : Integer;
202 
203     {** Searches for Item in range [PosFrom..PosTo] using the binary search
204       algorithm. Returns the index of Item if its found. Otherwise, returns
205       ( - InsertionPoint - 1 ). InsertionPoint is the point at which the key
206       would be inserted into the range. }
BinarySearchnull207     function BinarySearch(const Item: _TItem_;
208       PosFrom, PosTo: Integer) : Integer;
BinarySearchnull209     function BinarySearch(const Item: _TItem_;
210       PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
211 
212     {** Returns true if the container contains Item. }
Containsnull213     function Contains(const Item: _TItem_) : Boolean;
Containsnull214     function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
215 
216     {** Creates an empty vector and sets his capacity to InitialCapacity. }
217     constructor Create(InitialCapacity: Integer = 16);
218 
DefaultCompareItemsnull219     function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull220     function DefaultItemToString(const Item: _TItem_) : String; virtual;
221 
222     {** Destroys the container. }
223     destructor Destroy; override;
224 
225     {** If Obj = Self then returns true, else if Obj is not a TGenVector returns
226       false, else returns true if Self and Obj contain the sames items. }
Equalsnull227     function Equals(Obj: TObject) : Boolean; override;
Equalsnull228     function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
229 
230     {** Returns the index of the first item equal to Item or -1. }
FindIndexnull231     function FindIndex(const Item: _TItem_) : Integer;
FindIndexnull232     function FindIndex(const Item: _TItem_;
233       Comparator: TCompareItems) : Integer;
234 
235     {** Returns a cursor on the first item equal to Item or NilCursor. The search
236       starts at the element From.  }
FindIndexnull237     function FindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
FindIndexnull238     function FindIndex(const Item: _TItem_; PosFrom: Integer;
239       Comparator: TCompareItems) : Integer;
240 
241     {** Returns the first Item. }
FirstItemnull242     function FirstItem : _TItem_; inline;
243 
GetEnumeratornull244     function GetEnumerator : TEnumerator;
245 
246     {** Returns item at position Position. }
GetItemnull247     function GetItem(Position: Integer) : _TItem_; inline;
248 
249     {** Returns a pointer designating item at position Position. }
GetItemPtrnull250     function GetItemPtr(Position: Integer): PItem;
251 
252     {** Inserts Count times Item before Before. }
253     procedure Insert(Before: Integer; const Item: _TItem_;
254       Count: Integer = 1);
255 
256     {** Inserts all the items of Src before Before. }
257     procedure InsertAll(Before: Integer; Src: TGenVector);
258 
259     {** Inserts before Before all the items of Src in the range
260       [PosFrom..PosTo]. }
261     procedure InsertRange(Before: Integer; Src: TGenVector;
262       PosFrom, PosTo: Integer);
263 
264     {** Returns true if the items are sorted. }
IsSortednull265     function IsSorted : Boolean;
IsSortednull266     function IsSorted(Comparator: TCompareItems): Boolean;
267 
268     {** Invokes Process on each items. }
269     procedure Iterate(Process: TProcessItem);
270 
271     {** Invokes Process on each items in range [PosFrom..PosTo]. }
272     procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
273 
274     {** Returns the last Item. }
LastItemnull275     function LastItem: _TItem_; inline;
276 
277     {** Returns index of the greatest item. }
MaxPosnull278     function MaxPos : Integer;
MaxPosnull279     function MaxPos(Comparator: TCompareItems) : Integer;
280 
281     {** Returns index of the greatest item in the range [PosFrom..PosTo]. }
MaxPosnull282     function MaxPos(PosFrom, PosTo: Integer) : Integer;
MaxPosnull283     function MaxPos(PosFrom, PosTo: Integer;
284       Comparator: TCompareItems) : Integer;
285 
286     {** Removes items from Src and inserts them into Self. Afterwards, Self
287       contains the union of the items that were initially in Src and Self. Src
288       is left empty. If Self and Src are initially sorted, then Self is
289       sorted. }
290     procedure Merge(Src: TGenVector);
291     procedure Merge(Src: TGenVector; Comparator: TCompareItems);
292 
293     {** Returns index of the lowest item. }
MinPosnull294     function MinPos : Integer;
MinPosnull295     function MinPos(Comparator: TCompareItems) : Integer;
296 
297     {** Returns index of the lowest item in the range [PosFrom..PosTo]. }
MinPosnull298     function MinPos(PosFrom, PosTo: Integer) : Integer;
MinPosnull299     function MinPos(PosFrom, PosTo: Integer;
300       Comparator: TCompareItems) : Integer;
301 
302     {** Copies Count items from Src to Dst. }
303     procedure Move(Src, Dst, Count: Integer); override;
304 
305     {** Inserts Count times Item at the begining of the container. }
306     procedure Prepend(const Item: _TItem_; Count: Integer = 1);
307 
308     {** Inserts all the items of Src at the begining of the container. }
309     procedure PrependAll(Src: TGenVector);
310 
311     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
312       begining of the container. }
313     procedure PrependRange(Src: TGenVector; PosFrom, PosTo: Integer);
314 
315     procedure ReadFirstItem(out Value : _TItem_); inline;
316 
317     procedure ReadItem(Position: Integer; out Value: _TItem_);
318 
319     procedure ReadItemFast(Position: Integer; out Value: _TItem_); inline;
320 
321     procedure ReadLastItem(out Value : _TItem_); inline;
322 
323     {** Replaces items in range [Index..Index + Count - 1] by Value. }
324     procedure Replace(Index, Count: Integer; const Value: _TItem_);
325 
326     {** Returns the index of the first item equal to Item or -1. }
ReverseFindIndexnull327     function ReverseFindIndex(const Item: _TItem_) : Integer;
ReverseFindIndexnull328     function ReverseFindIndex(const Item: _TItem_;
329       Comparator: TCompareItems) : Integer;
330 
331     {** Returns a cursor on the first item equal to Item or NilCursor. The search
332       starts at the element From.  }
ReverseFindIndexnull333     function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
ReverseFindIndexnull334     function ReverseFindIndex(const Item: _TItem_;
335       PosFrom: Integer; Comparator: TCompareItems) : Integer;
336 
337     {** Assigns the value Value to the item at Position. }
338     procedure SetItem(Position: Integer; const Value: _TItem_); inline;
339 
340     procedure SetItemFast(Position: Integer; const Value: _TItem_); inline;
341 
342     {** Sorts the items. }
343     procedure Sort;
344     procedure Sort(Comparator: TCompareItems);
345 
346     {** Sorts the items in the range [PosFrom..PosTo]. }
347     procedure Sort(PosFrom, PosTo: Integer);
348     procedure Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
349 
350     {** Swaps the values of the items designated by I and J (no bounds check). }
351     procedure SwapFast(I, J: Integer); override;
352 
353     {** Provides access to the items in the container. }
354     property Items[Index: Integer] : _TItem_ read GetItemFast
355       write SetItemFast; default;
356 
357     {** Provides access to pointers on the items in the container. }
358     property ItemsPtr[Index: Integer] : PItem read GetItemPtrFast;
359 
360     property OnCompareItems : TCompareItems read fOnCompareItems
361       write SetOnCompareItems;
362 
363     property OnItemToString : TItemToString read fOnItemToString
364       write SetOnItemToString;
365   end;
366 
367   { TGenDeque }
368 
369   generic TGenDeque<_TItem_> = class(TAbstractVector)
370   public type
371     PItem = ^_TItem_;
372     TCompareItems = function (const A, B: _TItem_) : Integer of object;
373     TItemToString = function (const Item: _TItem_) : String of object;
374     TProcessItem = procedure(var Item: _TItem_) of object;
375     TEnumerator = specialize TGenEnumerator<_TItem_, Integer>;
376 
377   strict private
378     fItems : array of _TItem_;
379     fOnCompareItems: TCompareItems;
380     fOnItemToString: TItemToString;
381     fStart : Integer;
382 
383     procedure DecRank(var Rank: Integer); inline;
Equalsnull384     function Equals(Deque: TGenDeque; Comparator: TCompareItems): Boolean;
EnumeratorGetnull385     function EnumeratorGet(const Pos: Integer) : _TItem_;
EnumeratorNextnull386     function EnumeratorNext(var Pos: Integer) : Boolean;
387     procedure Fill(Index, Count: Integer; const Value: _TItem_);
GetItemPtrFastnull388     function GetItemPtrFast(Position: Integer): PItem;
389     procedure IncRank(var Rank: Integer); inline;
390     procedure IncreaseCapacity(ACapacity : Integer);
IndexToRanknull391     function IndexToRank(Index: Integer) : Integer; inline;
392     procedure InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
393     procedure Quicksort(Left, Right: Integer; Comparator: TCompareItems);
RankToIndexnull394     function RankToIndex(Rank: Integer) : Integer; inline;
395     class procedure RealMoveIndex(Src, Dst: TGenDeque;
396       SrcFirst, DstFirst, Count: Integer);
397     procedure RealMoveRank(Src, Dst, Count: Integer);
398     procedure ReduceCapacity(ACapacity : Integer);
399     procedure SetOnCompareItems(AValue: TCompareItems);
400     procedure SetOnItemToString(AValue: TItemToString);
401 
402   protected
403     procedure InsertSpaceFast(Position, Count: Integer); override;
ItemToStringnull404     function ItemToString(Index: Integer) : String; override;
405     procedure SetCapacity(ACapacity : Integer); override;
406   public
407     {** Inserts Count times Item at the end of the container. }
408     procedure Append(const Item: _TItem_; Count: Integer = 1);
409 
410     {** Inserts all the items of Src at the end of the container. }
411     procedure AppendAll(Src: TGenDeque);
412 
413     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
414       the container. }
415     procedure AppendRange(Src: TGenDeque; PosFrom, PosTo: Integer);
416 
417     {** Searches for Item using the binary search algorithm. Returns the index of
418       Item if its found. Otherwise, returns ( - InsertionPoint - 1 ).
419       InsertionPoint is the point at which the key would be inserted into the
420       container. }
BinarySearchnull421     function BinarySearch(const Item: _TItem_) : Integer;
BinarySearchnull422     function BinarySearch(const Item: _TItem_; Comparator: TCompareItems) : Integer;
423 
424     {** Searches for Item in range [PosFrom..PosTo] using the binary search
425       algorithm. Returns the index of Item if its found. Otherwise, returns
426       ( - InsertionPoint - 1 ). InsertionPoint is the point at which the key
427       would be inserted into the range. }
BinarySearchnull428     function BinarySearch(const Item: _TItem_; PosFrom, PosTo: Integer) : Integer;
BinarySearchnull429     function BinarySearch(const Item: _TItem_;
430       PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
431 
432     {** Returns true if the container contains Item. }
Containsnull433     function Contains(const Item: _TItem_) : Boolean;
Containsnull434     function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
435 
436     {** Creates an empty deque and sets his capacity to InitialCapacity. }
437     constructor Create(InitialCapacity: Integer = 16);
438 
DefaultCompareItemsnull439     function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull440     function DefaultItemToString(const Item: _TItem_) : String; virtual;
441 
442     {** Destroys the container. }
443     destructor Destroy; override;
444 
445     {** If Obj = Self then returns @true, else if Obj is not a TGenDeque returns
446       false, else returns @true if Self and Obj contain the sames items. }
Equalsnull447     function Equals(Obj: TObject) : Boolean; override;
Equalsnull448     function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
449 
450     {** Returns the index of the first item equal to Item or -1. }
FindIndexnull451     function FindIndex(const Item: _TItem_) : Integer;
FindIndexnull452     function FindIndex(const Item: _TItem_; Comparator: TCompareItems) : Integer;
453 
454     {** Returns a cursor on the first item equal to Item or NilCursor. The search
455       starts at the element From.  }
FindIndexnull456     function FindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
FindIndexnull457     function FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems) : Integer;
458 
459     {** Returns the first Item. }
FirstItemnull460     function FirstItem : _TItem_; inline;
461 
GetEnumeratornull462     function GetEnumerator : TEnumerator;
463 
GetItemFastnull464     function GetItemFast(Position: Integer) : _TItem_; inline;
465 
466     {** Returns item at position Position. }
GetItemnull467     function GetItem(Position: Integer) : _TItem_; inline;
468 
469     {** Returns a pointer designating item at position Position. }
GetItemPtrnull470     function GetItemPtr(Position: Integer): PItem;
471 
472     {** Inserts Count times Item before Before. }
473     procedure Insert(Before: Integer; const Item: _TItem_;
474       Count: Integer = 1);
475 
476     {** Inserts all the items of Src before Before. }
477     procedure InsertAll(Before: Integer; Src: TGenDeque);
478 
479     {** Inserts before Before all the items of Src in the range
480       [PosFrom..PosTo]. }
481     procedure InsertRange(Before: Integer; Src: TGenDeque;
482       PosFrom, PosTo: Integer);
483 
484     {** Returns true if the items are sorted. }
IsSortednull485     function IsSorted: Boolean;
IsSortednull486     function IsSorted(Comparator: TCompareItems): Boolean;
487 
488     {** Invokes Process on each items. }
489     procedure Iterate(Process: TProcessItem);
490 
491     {** Invokes Process on each items in range [PosFrom..PosTo]. }
492     procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
493 
494     {** Returns the last Item. }
LastItemnull495     function LastItem: _TItem_; inline;
496 
497     {** Returns index of the greatest item. }
MaxPosnull498     function MaxPos : Integer;
MaxPosnull499     function MaxPos(Comparator: TCompareItems) : Integer;
500 
501     {** Returns index of the greatest item in the range [PosFrom..PosTo]. }
MaxPosnull502     function MaxPos(PosFrom, PosTo: Integer) : Integer;
MaxPosnull503     function MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
504 
505     {** Removes items from Src and inserts them into Self. Afterwards, Self
506       contains the union of the items that were initially in Src and Self. Src
507       is left empty. If Self and Src are initially sorted, then Self is
508       sorted. }
509     procedure Merge(Src: TGenDeque);
510     procedure Merge(Src: TGenDeque; Comparator: TCompareItems);
511 
512     {** Returns index of the lowest item. }
MinPosnull513     function MinPos : Integer;
MinPosnull514     function MinPos(Comparator: TCompareItems) : Integer;
515 
516     {** Returns index of the lowest item in the range [PosFrom..PosTo]. }
MinPosnull517     function MinPos(PosFrom, PosTo: Integer) : Integer;
MinPosnull518     function MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
519 
520     {** Copies Count items from Src to Dst. }
521     procedure Move(Src, Dst, Count: Integer); override;
522 
523     {** Inserts Count times Item at the begining of the container. }
524     procedure Prepend(const Item: _TItem_; Count: Integer = 1);
525 
526     {** Inserts all the items of Src at the begining of the container. }
527     procedure PrependAll(Src: TGenDeque);
528 
529     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
530       begining of the container. }
531     procedure PrependRange(Src: TGenDeque; PosFrom, PosTo: Integer);
532 
533     procedure ReadFirstItem(out Value : _TItem_); inline;
534 
535     procedure ReadItem(Position: Integer; out Value: _TItem_);
536 
537     procedure ReadItemFast(Position: Integer; out Value: _TItem_); inline;
538 
539     procedure ReadLastItem(out Value : _TItem_); inline;
540 
541     {** Replaces items in range [Index..Index + Count - 1] by Value. }
542     procedure Replace(Index, Count: Integer; const Value: _TItem_);
543 
544     {** Returns the index of the first item equal to Item or -1. }
ReverseFindIndexnull545     function ReverseFindIndex(const Item: _TItem_) : Integer;
ReverseFindIndexnull546     function ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems) : Integer;
547 
548     {** Returns a cursor on the first item equal to Item or NilCursor. The search
549       starts at the element From.  }
ReverseFindIndexnull550     function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
ReverseFindIndexnull551     function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer;
552       Comparator: TCompareItems) : Integer;
553 
554     {** Assigns the value Value to the item at Position. }
555     procedure SetItem(Position: Integer; const Value: _TItem_); inline;
556 
557     procedure SetItemFast(Position: Integer; const Value: _TItem_); inline;
558 
559     {** Sorts the items. }
560     procedure Sort;
561     procedure Sort(Comparator: TCompareItems);
562 
563     {** Sorts the items in the range [PosFrom..PosTo]. }
564     procedure Sort(PosFrom, PosTo: Integer);
565     procedure Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
566 
567     procedure SwapFast(I, J: Integer); override;
568 
569     {** Provides access to the items in the container. }
570     property Items[Index: Integer] : _TItem_ read GetItemFast
571       write SetItemFast; default;
572 
573     {** Provides access to pointers on the items in the container. }
574     property ItemsPtr[Index: Integer] : PItem read GetItemPtrFast;
575 
576     property OnCompareItems : TCompareItems read fOnCompareItems
577       write SetOnCompareItems;
578 
579     property OnItemToString : TItemToString read fOnItemToString
580       write SetOnItemToString;
581   end;
582 
583   TAbstractList = class;
584 
585   { TListCursor }
586 
587   TListCursor = object
588   strict private
589     fList : TAbstractList;
590     fNode : Pointer;
591 
592   public
593     {** Check if the cursors designate the same item. }
Equalsnull594     function Equals(const Cursor: TListCursor) : Boolean; inline;
595 
596     {** Check if the cursors designate an item. }
HasItemnull597     function HasItem: Boolean; inline;
598 
599     constructor Init(AList : TAbstractList; ANode: Pointer);
600 
601     {** Returns true if the cursor designates the first element. }
IsFirstnull602     function IsFirst: Boolean; inline;
603 
604     {** Returns true if the cursor designates the last element. }
IsLastnull605     function IsLast: Boolean; inline;
606 
607     {** Equivalent to not HasItem. }
IsNilnull608     function IsNil: Boolean; inline;
609 
610     {** If cursor is nil then do nothing, else if cursor is last then cursor
611       becomes nil cursor, otherwise move cursor to the next item.  }
612     procedure MoveNext; inline;
613 
614     {** If cursor is nil then do nothing, else if cursor is first then cursor
615       becomes nil cursor, otherwise move cursor to the previous item.  }
616     procedure MovePrevious; inline;
617 
618     {** The designated List. }
619     property List : TAbstractList read fList;
620 
621     {** The designated node. }
622     property Node : Pointer read fNode write fNode;
623   end;
624 
625   { TAbstractList }
626 
627   TAbstractList = class(TContainer)
628   protected
629     procedure CheckValid(const Cursor: TListCursor);
630     procedure CheckNotNil(const Cursor: TListCursor);
CursorIsFirstnull631     function CursorIsFirst(const Cursor: TListCursor) : Boolean; virtual; abstract;
CursorIsLastnull632     function CursorIsLast(const Cursor: TListCursor) : Boolean; virtual; abstract;
633     procedure CursorMoveNext(var Cursor: TListCursor); virtual; abstract;
634     procedure CursorMovePrev(var Cursor: TListCursor); virtual; abstract;
635   end;
636 
637   { TGenList }
638 
639   generic TGenList<_TItem_> = class(TAbstractList)
640   public type
641     PItem = ^_TItem_;
642     TCompareItems = function (const A, B: _TItem_) : Integer of object;
643     TItemToString = function (const Item: _TItem_) : String of object;
644     TProcessItem = procedure(var Item: _TItem_) of object;
645     TEnumerator = specialize TGenEnumerator<_TItem_, TListCursor>;
646 
647   strict private type
648     PNode = ^TNode;
649     TNode = record
650       Item : _TItem_;
651       Next, Previous : PNode;
652     end;
653 
654   strict private
655     fHead : PNode;
656     fOnCompareItems: TCompareItems;
657     fOnItemToString: TItemToString;
658     fTail : PNode;
659     fSize : Integer;
660     fNilCursor : TListCursor;
661 
662     procedure DeleteNodesBackward(From: PNode; Count: Integer);
663     procedure DeleteNodesBetween(NodeFrom, NodeTo: PNode);
664     procedure DeleteNodesForward(From: PNode; Count: Integer);
EnumeratorGetnull665     function EnumeratorGet(const Pos: TListCursor) : _TItem_;
EnumeratorNextnull666     function EnumeratorNext(var Pos: TListCursor) : Boolean;
Equalsnull667     function Equals(List: TGenList; Comparator: TCompareItems) : Boolean;
GetItemFastnull668     function GetItemFast(const Position: TListCursor) : _TItem_; inline;
GetItemPtrFastnull669     function GetItemPtrFast(const Position: TListCursor) : PItem; inline;
670     procedure InsertItem(const Item: _TItem_; Pos: PNode; Count: Integer);
671     procedure Partition(Pivot, Back: PNode; Comparator: TCompareItems);
672     procedure RealSort(Front, Back: PNode; Comparator: TCompareItems);
673     procedure SetOnCompareItems(AValue: TCompareItems);
674     procedure SetOnItemToString(AValue: TItemToString);
675     procedure SpliceNodes(Before, PosFrom, PosTo: PNode);
676 
677   protected
CursorIsFirstnull678     function CursorIsFirst(const Cursor: TListCursor) : Boolean; override;
CursorIsLastnull679     function CursorIsLast(const Cursor: TListCursor) : Boolean; override;
680     procedure CursorMoveNext(var Cursor: TListCursor); override;
681     procedure CursorMovePrev(var Cursor: TListCursor); override;
682 
683   public
684     {** Inserts Count times Item at the end of the container. }
685     procedure Append(const Item: _TItem_; Count: Integer = 1);
686 
687     {** Inserts all the items of Src at the end of the container. }
688     procedure AppendAll(Src: TGenList);
689 
690     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
691       the container. }
692     procedure AppendRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
693 
694     {** Removes all the items from the container. }
695     procedure Clear;
696 
697     {** Returns true if the container contains Item. }
Containsnull698     function Contains(const Item: _TItem_) : Boolean;
Containsnull699     function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
700 
701     {** Creates an empty list. }
702     constructor Create;
703 
DefaultCompareItemsnull704     function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull705     function DefaultItemToString(const Item: _TItem_) : String; virtual;
706 
707     {** Deletes Count items begining at Position and then sets Position to
708       NilCursor. }
709     procedure Delete(var Position: TListCursor; Count: Integer = 1);
710 
711     {** Deletes the first Count items. }
712     procedure DeleteFirst(Count: Integer = 1);
713 
714     {** Deletes the last Count items. }
715     procedure DeleteLast(Count: Integer = 1);
716 
717     {** Deletes all items in the range [PosFrom..PosTo]. }
718     procedure DeleteRange(const PosFrom, PosTo: TListCursor);
719 
720     {** Destroys the container. }
721     destructor Destroy; override;
722 
723     {** If Obj = Self then returns true, else if Obj is not a TGenList returns false,
724       else returns true if Self and Obj contain the sames items. }
Equalsnull725     function Equals(Obj: TObject) : Boolean; override;
Equalsnull726     function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
727 
728     {** Returns a cursor on the first item equal to Item or NilCursor. }
Findnull729     function Find(const Item: _TItem_) : TListCursor;
730 
Findnull731     function Find(const Item: _TItem_; Comparator: TCompareItems) : TListCursor;
732 
733     {** Returns a cursor on the first item equal to Item or NilCursor.The search
734       starts at the first element if Position is NilCursor, and at the element
735       designated by Position otherwise.  }
Findnull736     function Find(const Item: _TItem_; const Position: TListCursor) : TListCursor;
737 
Findnull738     function Find(const Item: _TItem_; const Position: TListCursor; Comparator: TCompareItems): TListCursor;
739 
740     {** Returns a cursor that designates the first element of the container or
741       NilCursor if the container is empty. }
Firstnull742     function First: TListCursor;
743 
744     {** Returns the first Item. }
FirstItemnull745     function FirstItem : _TItem_; inline;
746 
747     {** If Index is not in the range [0..Size - 1], then returns NilCursor.
748       Otherwise, returns a cursor designating the item at position Index. }
GetCursornull749     function GetCursor(Index: Integer): TListCursor;
750 
GetEnumeratornull751     function GetEnumerator : TEnumerator;
752 
753     {** Returns the item designated by Position. }
GetItemnull754     function GetItem(const Position: TListCursor) : _TItem_; inline;
755 
756     {** Returns a pointer designating the item designated by Position. }
GetItemPtrnull757     function GetItemPtr(const Position: TListCursor) : PItem; inline;
758 
759     {** Inserts Count times Item before Before. }
760     procedure Insert(const Before: TListCursor; const Item: _TItem_;
761       Count: Integer = 1);
762 
763     {** Inserts Count times Item before Before. Position designates the first
764       newly-inserted element. }
765     procedure Insert(const Before: TListCursor; const Item: _TItem_;
766       out Position: TListCursor; Count: Integer);
767 
768     {** Inserts all the items of Src before Before. }
769     procedure InsertAll(const Before: TListCursor; Src: TGenList);
770 
771     {** Inserts before Before all the items of Src in the range
772       [PosFrom..PosTo]. }
773     procedure InsertRange(const Before : TListCursor; Src: TGenList;
774       const PosFrom, PosTo: TListCursor);
775 
776     {** Returns true if the list is empty. }
IsEmptynull777     function IsEmpty: Boolean; inline;
778 
779     {** Returns @true if the items are sorted. }
IsSortednull780     function IsSorted : Boolean;
781 
IsSortednull782     function IsSorted(Comparator: TCompareItems) : Boolean;
783 
784     procedure Iterate(Process: TProcessItem);
785 
786     procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: TListCursor);
787 
788     {** Returns a cursor that designates the last element of the container or
789       NilCursor if the container is empty. }
Lastnull790     function Last: TListCursor;
791 
792     {** Returns the last Item. }
LastItemnull793     function LastItem: _TItem_; inline;
794 
795     {** Removes items from Src and inserts them into Self. Afterwards, Self
796       contains the union of the items that were initially in Src and Self. Src
797       is left empty. If Self and Src are initially sorted, then Self is
798       sorted. }
799     procedure Merge(Src: TGenList);
800     procedure Merge(Src: TGenList; Comparator: TCompareItems);
801 
802     {** Inserts Count times Item at the begining of the container. }
803     procedure Prepend(const Item: _TItem_; Count: Integer = 1);
804 
805     {** Inserts all the items of Src at the begining of the container. }
806     procedure PrependAll(Src: TGenList);
807 
808     {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
809       begining of the container. }
810     procedure PrependRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
811 
812     procedure ReadFirstItem(out Value : _TItem_); inline;
813 
814     procedure ReadItem(const Position: TListCursor; out Value: _TItem_);
815 
816     procedure ReadItemFast(const Position: TListCursor; out Value: _TItem_); inline;
817 
818     procedure ReadLastItem(out Value : _TItem_); inline;
819 
820     {** Replaces items in range [Position..Position + Count - 1] by Value. }
821     procedure Replace(const Position: TListCursor; Count: Integer;
822       const Value: _TItem_);
823 
824     {** Reorders the items in reverse order. }
825     procedure Reverse;
826 
827     {** Returns a cursor on the first item equal to Item or NilCursor. }
ReverseFindnull828     function ReverseFind(const Item: _TItem_) : TListCursor;
ReverseFindnull829     function ReverseFind(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
830 
831     {** Returns a cursor on the first item equal to Item or NilCursor.The search
832       starts at the last element if Position is NilCursor, and at the element
833       designated by Position otherwise.  }
ReverseFindnull834     function ReverseFind(const Item: _TItem_; const Position: TListCursor) : TListCursor;
ReverseFindnull835     function ReverseFind(const Item: _TItem_; const Position: TListCursor;
836       Comparator: TCompareItems) : TListCursor;
837 
838     {** Reorders the items in the range [PosFrom..PosTo] in reverse order. }
839     procedure ReverseRange(const PosFrom, PosTo: TListCursor);
840 
841     {** Assigns the value Value to the item designated by Position. }
842     procedure SetItem(const Position: TListCursor; const Value: _TItem_);
843 
844     procedure SetItemFast(const Position: TListCursor; const Value: _TItem_); inline;
845 
846     {** Sorts the items. }
847     procedure Sort;
848     procedure Sort(Comparator: TCompareItems);
849 
850     {** Sorts the items in the range [PosFrom..PosTo]. }
851     procedure Sort(const PosFrom, PosTo: TListCursor);
852     procedure Sort(const PosFrom, PosTo: TListCursor; Comparator: TCompareItems);
853 
854     {** Removes all items of Src and moves them to Self before Before. }
855     procedure Splice(const Before: TListCursor; Src: TGenList);
856 
857     {** Removes from Src the item designated by Position and moves it to Self
858       before Before. }
859     procedure Splice(const Before: TListCursor; Src: TGenList;
860       const Position: TListCursor);
861 
862     {** Removes all items of Src in the range [SrcFrom..SrcTo] and moves them to
863       Self before Before. }
864     procedure Splice(const Before: TListCursor; Src: TGenList;
865       const SrcFrom, SrcTo: TListCursor);
866 
867     {** Swaps the values of the items designated by I and J. }
868     procedure Swap(const I, J: TListCursor);
869 
870     {** Swaps the nodes designated by I and J. }
871     procedure SwapLinks(const I, J: TListCursor);
872 
873     {** Return a string representation for the container. }
ToStringnull874     function ToString : String; override;
875 
876     {** Provides access to the items in the container. }
877     property Items[const Index: TListCursor] : _TItem_
878       read GetItemFast write SetItemFast; default;
879 
880     {** Provides access to pointers on the items in the container. }
881     property ItemsPtr[const Index: TListCursor] : PItem read GetItemPtrFast;
882 
883     {** A nil cursor. }
884     property NilCursor: TListCursor read fNilCursor;
885 
886     property OnCompareItems : TCompareItems read fOnCompareItems
887       write SetOnCompareItems;
888 
889     property OnItemToString : TItemToString read fOnItemToString
890       write SetOnItemToString;
891 
892     {** Number of elements in the list. }
893     property Size: Integer read fSize;
894   end;
895 
896   { TGenPriorityQueue }
897 
898   generic TGenPriorityQueue<_TItem_> = class(TContainer)
899   public type
900     TCompareItems = function (const A, B: _TItem_) : Integer of object;
901 
902   strict private
903     fCapacity : Integer;
904     fItems : array of _TItem_;
905     fOnCompareItems: TCompareItems;
906     fSize : Integer;
907 
908     procedure SetOnCompareItems(AValue: TCompareItems);
909     procedure MoveDown(Index: Integer; const Item: _TItem_);
910     procedure MoveUp(Index: Integer; const Item: _TItem_);
911 
912   public
913     {** Empty the queue of all items. }
914     procedure Clear;
915 
916     {** Creates an empty priority queue. }
917     constructor Create(InitialCapacity : Integer = 16);
918 
DefaultCompareItemsnull919     function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
920 
921     {** Returns true if the priority queue is empty. }
IsEmptynull922     function IsEmpty: Boolean; inline;
923 
924     {** Frees unused memory. }
925     procedure Pack;
926 
927     {** Removes the item from the top of the stack. }
928     procedure Pop;
929 
930     {** Adds Item to the top of the stack. }
931     procedure Push(const Item: _TItem_);
932 
933     procedure ReadTop(out Value: _TItem_);
934 
935     {** If necessary, increases the capacity of the container to ensure that it
936       can hold at least MinCapacity items. }
937     procedure Reserve(MinCapacity : Integer);
938 
939     {** Returns the item at the top of the stack. }
Topnull940     function Top : _TItem_;
941 
942     {** Capacity of the container. }
943     property Capacity : Integer read fCapacity;
944 
945     property OnCompareItems : TCompareItems read fOnCompareItems write SetOnCompareItems;
946 
947     {** Number of elements. }
948     property Size: Integer read fSize;
949   end;
950 
951   { TGenQueue }
952 
953   generic TGenQueue<_TItem_, _TContainer_> = class(TContainer)
954   private
955     fData : _TContainer_;
GetSizenull956     function GetSize: Integer; inline;
957 
958   public
959     {** Add the item to the back of the queue. }
960     procedure Append(const Item: _TItem_);
961 
962     {** Empty the queue of all items. }
963     procedure Clear;
964 
965     {** Creates an empty queue. }
966     constructor Create;
967 
968     {** Destroys the container. }
969     destructor Destroy; override;
970 
971     {** Returns a copy of the item at the front of the queue. }
Frontnull972     function Front : _TItem_;
973 
974     {** Returns true if the queue is empty. }
IsEmptynull975     function IsEmpty: Boolean; inline;
976 
977     {** Removes the item from the front of the queue. }
978     procedure Pop;
979 
980     procedure ReadFront(out Value: _TItem_);
981 
982     {** Number of items. }
983     property Size : Integer read GetSize;
984   end;
985 
986   { TGenStack }
987 
988   generic TGenStack<_TItem_, _TContainer_> = class(TContainer)
989   private
990     fData : _TContainer_;
GetSizenull991     function GetSize: Integer; inline;
992 
993   public
994     {** Removes all the items from the stack. }
995     procedure Clear;
996 
997     {** Creates an empty stack. }
998     constructor Create;
999 
1000     {** Destroys the stack. }
1001     destructor Destroy; override;
1002 
1003     {** Returns true if the stack is empty. }
IsEmptynull1004     function IsEmpty: Boolean; inline;
1005 
1006     {** Removes the item from the top of the stack. }
1007     procedure Pop;
1008 
1009     {** Adds Item to the top of the stack. }
1010     procedure Push(const Item: _TItem_);
1011 
1012     procedure ReadTop(out Value : _TItem_);
1013 
1014     {** Returns the item at the top of the stack. }
Topnull1015     function Top : _TItem_;
1016 
1017     {** Number of items. }
1018     property Size : Integer read GetSize;
1019   end;
1020 
1021   TAbstractHashMap = class;
1022 
1023   { THashMapCursor }
1024 
1025   THashMapCursor = object
1026     strict private
1027       fBucket : Integer;
1028       fHashMap : TAbstractHashMap;
1029       fEntry : Pointer;
1030       fPrevious : Pointer;
1031 
1032     public
1033       {** Check if the cursors designate the same item. }
Equalsnull1034       function Equals(const Cursor: THashMapCursor) : Boolean; inline;
1035 
1036       {** Check if the cursors designate an item. }
HasItemnull1037       function HasItem: Boolean; inline;
1038 
1039       {** Constructor. }
1040       constructor Init(HashMap : TAbstractHashMap; BucketNum: Integer;
1041         AEntry, APrevious: Pointer);
1042 
1043       {** Returns true if the cursor designates the first element. }
IsFirstnull1044       function IsFirst: Boolean; inline;
1045 
1046       {** Returns true if the cursor designates the last element. }
IsLastnull1047       function IsLast: Boolean; inline;
1048 
1049       {** Equivalent to not HasItem. }
IsNilnull1050       function IsNil: Boolean; inline;
1051 
1052       {** If cursor is nil then do nothing, else if cursor is last then cursor
1053         becomes nil cursor, otherwise move cursor to the next item.  }
1054       procedure MoveNext; inline;
1055 
1056       {** Designated bucket. }
1057       property Bucket : Integer read fBucket write fBucket;
1058 
1059       property HashMap : TAbstractHashMap read fHashMap;
1060 
1061       {** Designated entry. }
1062       property Entry : Pointer read fEntry write fEntry;
1063 
1064       property Previous : Pointer read fPrevious write fPrevious;
1065   end;
1066 
1067   { TAbstractHashMap }
1068 
1069   TAbstractHashMap = class(TContainer)
1070   protected
CursorIsFirstnull1071     function CursorIsFirst(const Cursor: THashMapCursor): Boolean; virtual; abstract;
CursorIsLastnull1072     function CursorIsLast(const Cursor: THashMapCursor): Boolean; virtual; abstract;
1073     procedure CursorMoveNext(const Cursor: THashMapCursor); virtual; abstract;
1074   end;
1075 
1076   { TGenHashMap }
1077 
1078   generic TGenHashMap<_TKey_, _TItem_> = class(TAbstractHashMap)
1079   public type
1080     THashKey = function (const Key: _TKey_) : Integer of object;
1081     TItemToString = function (const Item: _TItem_) : String of object;
1082     TKeysEqual = function (const A, B: _TKey_) : Boolean of object;
1083     TKeyToString = function (const Key: _TKey_) : String of object;
1084     TEnumerator = specialize TGenEnumerator<_TItem_, THashMapCursor>;
1085 
1086   private type
1087     PPEntry = ^PEntry;
1088     PEntry = ^TEntry;
1089     TEntry = record
1090       Key : _TKey_;
1091       Value : _TItem_;
1092       Next : PEntry;
1093     end;
1094 
1095   strict private
1096     fBucketCount : Integer;
1097     fBuckets : PPEntry;
1098     fFirstNonEmptyBucket: Integer;
1099     fLastNonEmptyBucket : Integer;
1100     fMaxBucketCount : Integer;
1101     fMaxLoadFactor : Real;
1102     fNilCursor : THashMapCursor;
1103     fOnHashKey: THashKey;
1104     fOnItemToString: TItemToString;
1105     fOnKeysEqual: TKeysEqual;
1106     fOnKeyToString: TKeyToString;
1107     fSize : Integer;
1108     fThreshold : Integer;
1109 
1110     procedure AppendBuckets(Count: Integer);
CollectEntriesnull1111     function CollectEntries : PEntry;
1112 
1113     procedure DeleteEntry(Bucket : Integer; Entry, Previous: PEntry);
1114     procedure DisposeEntries(E: PEntry);
EnumeratorGetnull1115     function EnumeratorGet(const Pos: THashMapCursor) : _TItem_;
EnumeratorNextnull1116     function EnumeratorNext(var Pos: THashMapCursor) : Boolean;
FindEntrynull1117     function FindEntry(Bucket: Integer; const Key: _TKey_) : PEntry;
FindEntrynull1118     function FindEntry(Bucket: Integer; const Key: _TKey_; out Previous : PEntry) : PEntry;
GetEntrynull1119     function GetEntry(const Key: _TKey_): PEntry; inline;
GetEntryAtnull1120     function GetEntryAt(const Position: THashMapCursor): PEntry; inline;
GetLoadFactornull1121     function GetLoadFactor: Real;
IndexFornull1122     function IndexFor(Hash: Integer) : Integer; inline;
1123     procedure InsertCollectedEntries(CollectedEntries: PEntry);
1124     procedure InsertEntry(Bucket: Integer; Entry: PEntry);
1125     procedure InsertEntry(Entry, Before: PEntry);
NextNonEmptyBucketnull1126     function NextNonEmptyBucket(Bucket: Integer) : Integer;
NewEntrynull1127     function NewEntry(const Key: _TKey_; const Value: _TItem_) : PEntry; inline;
1128     procedure NilifyBuckets(BucketFrom, Count: Integer);
PreviousNonEmptyBucketnull1129     function PreviousNonEmptyBucket(Bucket: Integer) : Integer;
1130     procedure Resize(NewCapacity: Integer);
1131     procedure SetOnHashKey(AValue: THashKey);
1132     procedure SetOnItemToString(AValue: TItemToString);
1133     procedure SetOnKeysEqual(AValue: TKeysEqual);
1134     procedure SetOnKeyToString(AValue: TKeyToString);
1135 
1136   protected
CursorIsFirstnull1137     function CursorIsFirst(const Cursor: THashMapCursor): Boolean; override;
CursorIsLastnull1138     function CursorIsLast(const Cursor: THashMapCursor): Boolean; override;
1139     procedure CursorMoveNext(const Cursor: THashMapCursor); override;
1140   public
1141     {** Removes all the items from the container. }
1142     procedure Clear;
1143 
1144     {** Returns true if the container contains Key. }
Containsnull1145     function Contains(const Key : _TKey_) : Boolean;
1146 
1147     {** Creates an empty hash map and sets his capacity to InitialCapacity. }
1148     constructor Create(InitialCapacity: Integer = MIN_BUCKET_COUNT);
1149 
1150     {** Creates an empty hash map and sets his load factor to MaxLoadFact. }
1151     constructor Create(MaxLoadFact: Real);
1152 
1153     {** Creates an empty hash map and sets his capacity to InitialCapacity and
1154       his load factor to MaxLoadFact. }
1155     constructor Create(InitialCapacity: Integer; MaxLoadFact: Real);
1156 
DefaultHashKeynull1157     function DefaultHashKey(const Key: _TKey_) : Integer; virtual;
DefaultItemToStringnull1158     function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultKeysEqualnull1159     function DefaultKeysEqual(const A, B: _TKey_) : Boolean; virtual;
DefaultKeyToStringnull1160     function DefaultKeyToString(const Key: _TKey_) : String; virtual;
1161 
1162     {** Checks if an item with the key Key is present. If a match is found,
1163       removes the item from the map. Otherwise raises an exception. }
1164     procedure Delete(const Key: _TKey_);
1165 
1166     {** Deletes the item designated by Position. }
1167     procedure DeleteAt(const Position: THashMapCursor);
1168 
1169     {** Destroys the container. }
1170     destructor Destroy; override;
1171 
1172     {** Checks if an item with the key Key is present. If a match is found,
1173       removes the item from the map. }
1174     procedure Exclude(const Key : _TKey_);
1175 
1176     {** Checks if an item associated with Key is present. If a match is found,
1177       a cursor designating the matching item is returned. Otherwise,
1178       NilCursor is returned. }
Findnull1179     function Find(const Key : _TKey_) : THashMapCursor;
1180 
1181     {** Returns a cursor that designates the first element of the container
1182       or NilCursor if the container is empty. }
Firstnull1183     function First: THashMapCursor;
1184 
GetEnumeratornull1185     function GetEnumerator : TEnumerator;
1186 
GetItemnull1187     function GetItem(const Key: _TKey_): _TItem_;
1188 
GetItemAtnull1189     function GetItemAt(const Position: THashMapCursor): _TItem_;
1190 
GetKeyAtnull1191     function GetKeyAt(const Position : THashMapCursor) : _TKey_;
1192 
1193     {** Inserts Key and Value into the map. If an entry with the same Key is
1194       already in the map, then the old value is replaced. }
1195     procedure Include(const Key : _TKey_; const Value: _TItem_);
1196 
1197     {** Inserts Key and Value into the map. If an entry with the same Key is
1198       already in the map, then an exception is raised. }
1199     procedure Insert(const Key : _TKey_; const Value: _TItem_);
1200 
1201     {** If an entry with the key Key is already in the map, then Inserted is set
1202       to false. Otherwise, Insert inserts Key and Value into the map and sets
1203       Inserted to true. }
1204     procedure Insert(const Key : _TKey_; const Value: _TItem_;
1205       out Inserted: Boolean);
1206 
1207     {** Returns true if the container is empty. }
IsEmptynull1208     function IsEmpty: Boolean; inline;
1209 
1210     procedure ReadItem(const Key: _TKey_; out Value: _TItem_);
1211     procedure ReadItemAt(const Position: THashMapCursor; out Value: _TItem_);
1212     procedure ReadKeyAt(const Position : THashMapCursor; out Key: _TKey_);
1213 
1214     {** Checks if an entry with the key Key is present. If a match is found,
1215       assigns Key and Value to the matching entry. Otherwise, an exception is
1216       raised. }
1217     procedure Replace(const Key : _TKey_; const Value: _TItem_);
1218 
1219     procedure SetItemAt(const Position: THashMapCursor; AValue: _TItem_);
1220 
1221     {** Return a string representation for the container. }
ToStringnull1222     function ToString : String; override;
1223 
1224     property BucketCount : Integer read fBucketCount;
1225 
1226     {** Provides access to the items in the container. }
1227     property ItemAt[const Position: THashMapCursor] : _TItem_ read GetItemAt
1228       write SetItemAt;
1229 
1230     {** Provides access to the items in the container. }
1231     property Items[const Key: _TKey_] : _TItem_ read GetItem write Include;
1232       default;
1233 
1234     {** Provides access to the keys in the container. }
1235     property Keys[const Position: THashMapCursor] : _TKey_ read GetKeyAt;
1236 
1237     property LoadFactor : Real read GetLoadFactor;
1238 
1239     property MaxBucketCount : Integer read fMaxBucketCount;
1240 
1241     property MaxLoadFactor : Real read fMaxLoadFactor;
1242 
1243     {** A nil cursor. }
1244     property NilCursor: THashMapCursor read fNilCursor;
1245 
1246     property OnHashKey : THashKey read fOnHashKey write SetOnHashKey;
1247     property OnItemToString : TItemToString read fOnItemToString write SetOnItemToString;
1248     property OnKeysEqual : TKeysEqual read fOnKeysEqual write SetOnKeysEqual;
1249     property OnKeyToString : TKeyToString read fOnKeyToString write SetOnKeyToString;
1250 
1251     {** Number of items. }
1252     property Size : Integer read fSize;
1253   end;
1254 
1255   TAbstractHashSet = class(TContainer)
1256   end;
1257 
1258   { THashSetCursor }
1259 
1260   THashSetCursor = object
1261   strict private
1262     fHashSet : TAbstractHashSet;
1263     fPos : THashMapCursor;
1264 
1265   public
1266     {** Check if the cursors designate the same item. }
Equalsnull1267     function Equals(const Cursor: THashSetCursor) : Boolean;
1268 
1269     {** Check if the cursors designate an item. }
HasItemnull1270     function HasItem: Boolean; inline;
1271 
1272     {** Constructor. }
1273     constructor Init(HashSet : TAbstractHashSet; const APos: THashMapCursor);
1274 
1275     {** Returns true if the cursor designates the first element. }
IsFirstnull1276     function IsFirst: Boolean; inline;
1277 
1278     {** Returns true if the cursor designates the last element. }
IsLastnull1279     function IsLast: Boolean; inline;
1280 
1281     {** Equivalent to (not HasItem). }
IsNilnull1282     function IsNil: Boolean; inline;
1283 
1284     {** If cursor is nil then do nothing, else if is last then cursor becomes nil
1285       cursor, otherwise move cursor to the next item.  }
1286     procedure MoveNext;
1287 
1288     property HashSet : TAbstractHashSet read fHashSet;
1289 
1290     {** Designated entry. }
1291     property Pos : THashMapCursor read fPos;
1292   end;
1293 
1294   { TGenHashSet }
1295 
1296   generic TGenHashSet<_TItem_> = class(TAbstractHashSet)
1297   strict private type
1298     TItemEquals = function (const A, B: _TItem_) : Boolean of object;
1299     TItemToString = function (const Item: _TItem_) : String of object;
1300     THashItem = function (const Item: _TItem_) : Integer of object;
1301     TMap = specialize TGenHashMap<_TItem_, Integer>;
1302     TEnumerator = specialize TGenEnumerator<_TItem_, THashSetCursor>;
1303 
1304   strict private
1305     fMap : TMap;
1306     fNilCursor : THashSetCursor;
1307 
EnumeratorGetnull1308     function EnumeratorGet(const Pos: THashSetCursor) : _TItem_;
EnumeratorNextnull1309     function EnumeratorNext(var Pos: THashSetCursor) : Boolean;
1310     procedure ExchangeContent(ASet: TGenHashSet);
GetItemToStringnull1311     function GetItemToString: TItemToString;
GetOnHashItemnull1312     function GetOnHashItem: THashItem;
GetOnItemsEqualnull1313     function GetOnItemsEqual: TItemEquals;
GetSizenull1314     function GetSize: Integer; inline;
1315     procedure SetOnHashItem(AValue: THashItem);
1316     procedure SetOnItemsEqual(AValue: TItemEquals);
1317     procedure SetOnItemToString(AValue: TItemToString);
1318 
1319   public
1320     {** Removes all the items from the container. }
1321     procedure Clear;
1322 
1323     {** Returns true if the container contains Item. }
Containsnull1324     function Contains(const Item: _TItem_) : Boolean;
1325 
1326     {** Creates an empty hash set and sets his capacity to InitialCapacity. }
1327     constructor Create(InitialCapacity: Integer = 16);
1328 
1329     {** Creates an empty hash set and sets his load factor to LoadFact. }
1330     constructor Create(LoadFact: Real);
1331 
1332     {** Creates an empty hash set and sets his capacity to InitialCapacity and
1333       his load factor to LoadFact. }
1334     constructor Create(InitialCapacity: Integer; LoadFact: Real);
1335 
DefaultItemsEqualnull1336     function DefaultItemsEqual(const A, B: _TItem_) : Boolean; virtual;
DefaultItemToStringnull1337     function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultHashItemnull1338     function DefaultHashItem(const Item: _TItem_) : Integer; virtual;
1339 
1340     {** Checks if Item is present in the container. If a match is found, removes
1341       the element from the set. Otherwise, raises an exception. }
1342     procedure Delete(const Item: _TItem_);
1343 
1344     {** Deletes the item designated by Position. }
1345     procedure DeleteAt(const Position: THashSetCursor);
1346 
1347     destructor Destroy; override;
1348 
1349     {** Clears Self and then adds to Self all the items of Left that are not
1350       present in Right. }
1351     procedure Difference(Left, Right: TGenHashSet);
1352 
1353     {** Checks if Item is present in the container. If a match is found, removes
1354       the item from the set. }
1355     procedure Exclude(const Item: _TItem_);
1356 
1357     {** Excludes all the items of ASet. }
1358     procedure ExcludeAll(ASet: TGenHashSet);
1359 
1360     {** Returns a cursor that designates the first element of the container or
1361       NilCursor if the container is empty. }
Firstnull1362     function First: THashSetCursor;
1363 
GetEnumeratornull1364     function GetEnumerator : TEnumerator;
1365 
GetItemAtnull1366     function GetItemAt(const Position: THashSetCursor): _TItem_;
1367 
1368     {** Checks if Item is present in the container. If no match is found, inserts
1369       the item into the set.}
1370     procedure Include(const Item: _TItem_);
1371 
1372     {** Includes all the items of ASet. }
1373     procedure IncludeAll(ASet: TGenHashSet);
1374 
1375     {** Checks if Item is present in the container. If no match is found, inserts
1376       the item into the set. Otherwise, raises an exception. }
1377     procedure Insert(const Item: _TItem_);
1378 
1379     {** Checks if Item is present in the container. If no match is found, inserts
1380       the item into the set and sets Inserted to true. Otherwise, sets Inserted
1381       to false. }
1382     procedure Insert(const Item: _TItem_; out Inserted: Boolean);
1383 
1384     {** Clears Self and then adds to Self all the items of Left that are present
1385       in Right. }
1386     procedure Intersection(Left, Right: TGenHashSet);
1387 
1388     {** Returns true if the container is empty. }
IsEmptynull1389     function IsEmpty: Boolean; inline;
1390 
1391     {** Returns true if all the items in Self are present in OfSet. }
IsSubsetnull1392     function IsSubset(OfSet: TGenHashSet) : Boolean;
1393 
1394     {** Returns true if at least one item of Self is present in ASet. }
Overlapsnull1395     function Overlaps(ASet: TGenHashSet) : Boolean;
1396 
1397     procedure ReadItemAt(const Position: THashSetCursor; out Value: _TItem_);
1398 
1399     {** Clears Self and then adds to Self all the items of Left that are not
1400       present in Right all the items of Right that are not present in Left. }
1401     procedure SymmetricDifference(Left, Right: TGenHashSet);
1402 
1403     {** Return a string representation for the container. }
ToStringnull1404     function ToString : String; override;
1405 
1406     {** Clears Self and then adds to Self all the items of Left and all the items
1407       of Right. }
1408     procedure Union(Left, Right: TGenHashSet);
1409 
1410     {** Provides access to the items in the container. }
1411     property Items[const Position: THashSetCursor] : _TItem_ read GetItemAt;
1412       default;
1413 
1414     {** A nil cursor. }
1415     property NilCursor: THashSetCursor read fNilCursor;
1416 
1417     property OnItemsEqual : TItemEquals read GetOnItemsEqual write SetOnItemsEqual;
1418     property OnItemToString : TItemToString read GetItemToString write SetOnItemToString;
1419     property OnHashItem : THashItem read GetOnHashItem write SetOnHashItem;
1420 
1421     property Size : Integer read GetSize;
1422   end;
1423 
1424   TAbstractTreeMap = class;
1425 
1426   { TTreeMapCursor }
1427 
1428   TTreeMapCursor = object
1429   strict private
1430     fTreeMap : TAbstractTreeMap;
1431     fEntry : Pointer;
1432 
1433   public
1434     {** Check if the cursors designate the same item. }
Equalsnull1435     function Equals(const Cursor: TTreeMapCursor) : Boolean; inline;
1436 
1437     {** Check if the cursors designate an item. }
HasItemnull1438     function HasItem: Boolean; inline;
1439 
1440     {** Constructor. }
1441     constructor Init(Map : TAbstractTreeMap; AnEntry: Pointer = nil);
1442 
1443     {** Returns true if the cursor designates the first element. }
IsFirstnull1444     function IsFirst: Boolean; inline;
1445 
1446     {** Returns true if the cursor designates the last element. }
IsLastnull1447     function IsLast: Boolean; inline;
1448 
1449     {** Equivalent to (not HasItem). }
IsNilnull1450     function IsNil: Boolean; inline;
1451 
1452     {** If cursor is nil then do nothing, else if cursor is last then cursor
1453       becomes nil cursor, otherwise move cursor to the next item.  }
1454     procedure MoveNext; inline;
1455 
1456     {** If cursor is nil then do nothing, else if cursor is first then cursor
1457       becomes nil cursor, otherwise move cursor to the previous item.  }
1458     procedure MovePrevious; inline;
1459 
1460     property TreeMap : TAbstractTreeMap read fTreeMap;
1461 
1462     {** Designated entry. }
1463     property Entry : Pointer read fEntry write fEntry;
1464   end;
1465 
1466   TAbstractTreeMap = class(TContainer)
1467   protected
CursorIsFirstnull1468     function CursorIsFirst(const Cursor: TTreeMapCursor) : Boolean; virtual; abstract;
CursorIsLastnull1469     function CursorIsLast(const Cursor: TTreeMapCursor) : Boolean; virtual; abstract;
1470     procedure CursorMoveNext(const Cursor: TTreeMapCursor); virtual; abstract;
1471     procedure CursorMovePrev(const Cursor: TTreeMapCursor); virtual; abstract;
1472   end;
1473 
1474   { TGenTreeMap }
1475 
1476   generic TGenTreeMap<_TKey_, _TItem_> = class(TAbstractTreeMap)
1477   public type
1478     TCompareKeys = function (const A, B: _TKey_) : Integer of object;
1479     TItemToString = function (const Item: _TItem_) : String of object;
1480     TKeyToString = function (const Key: _TKey_) : String of object;
1481     TEnumerator = specialize TGenEnumerator<_TItem_, TTreeMapCursor>;
1482 
1483     PItem = ^_TItem_;
1484 
1485   private type
1486     TColor = (cBlack, cRed);
1487 
1488     PEntry = ^TEntry;
1489 
1490     TEntry = record
1491       Color : TColor;
1492       Key : _TKey_;
1493       Left : PEntry;
1494       Parent : PEntry;
1495       Right : PEntry;
1496       Value : _TItem_;
1497     end;
1498   strict private
1499     fNilCursor : TTreeMapCursor;
1500     fOnCompareKeys: TCompareKeys;
1501     fOnItemToString: TItemToString;
1502     fOnKeyToString: TKeyToString;
1503     fSize : Integer;
1504     fRoot : PEntry;
1505 
ColorOfnull1506     function ColorOf(E: PEntry) : TColor; inline;
1507     procedure DeleteEntry(E: PEntry);
1508     procedure DeleteTree(E: PEntry);
EnumeratorGetnull1509     function EnumeratorGet(const Pos: TTreeMapCursor) : _TItem_;
EnumeratorNextnull1510     function EnumeratorNext(var Pos: TTreeMapCursor) : Boolean;
1511     procedure RepairAfterDelete(E: PEntry);
1512     procedure RepairAfterInsert(E: PEntry);
GetCeilingEntrynull1513     function GetCeilingEntry(const Key: _TKey_) : PEntry;
GetEntrynull1514     function GetEntry(const Key: _TKey_) : PEntry;
GetFirstEntrynull1515     function GetFirstEntry : PEntry;
GetFloorEntrynull1516     function GetFloorEntry(const Key: _TKey_) : PEntry;
GetLastEntrynull1517     function GetLastEntry : PEntry;
LeftOfnull1518     function LeftOf(E: PEntry) : PEntry; inline;
NewEntrynull1519     function NewEntry(AParent: PEntry; const AKey: _TKey_;
1520       const AValue: _TItem_) : PEntry;
ParentOfnull1521     function ParentOf(E: PEntry) : PEntry; inline;
Predecessornull1522     function Predecessor(E: PEntry) : PEntry;
RightOfnull1523     function RightOf(E: PEntry) : PEntry; inline;
1524     procedure RotateLeft(E: PEntry);
1525     procedure RotateRight(E: PEntry);
1526     procedure SetColor(E: PEntry; Color: TColor);
1527     procedure SetOnCompareKeys(AValue: TCompareKeys);
1528     procedure SetOnItemToString(AValue: TItemToString);
1529     procedure SetOnKeyToString(AValue: TKeyToString);
Successornull1530     function Successor(E: PEntry) : PEntry;
1531 
1532   protected
CursorIsFirstnull1533     function CursorIsFirst(const Cursor: TTreeMapCursor) : Boolean; override;
CursorIsLastnull1534     function CursorIsLast(const Cursor: TTreeMapCursor) : Boolean;  override;
1535     procedure CursorMoveNext(const Cursor: TTreeMapCursor); override;
1536     procedure CursorMovePrev(const Cursor: TTreeMapCursor); override;
1537 
1538   public
1539     {** Searches for the first entry whose key is not less than Key. If such an
1540       entry is found, a cursor that designates it is returned. Otherwise
1541       NilCursor is returned. }
Ceilingnull1542     function Ceiling(const Key: _TKey_) : TTreeMapCursor;
1543 
1544     {** Removes all the items from the container. }
1545     procedure Clear;
1546 
1547     {** Returns true if the container contains Key. }
Containsnull1548     function Contains(const Key : _TKey_) : Boolean;
1549 
1550     {** Creates an empty tree map. }
1551     constructor Create;
1552 
DefaultCompareKeysnull1553     function DefaultCompareKeys(const A, B: _TKey_) : Integer; virtual;
DefaultItemToStringnull1554     function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultKeyToStringnull1555     function DefaultKeyToString(const Key: _TKey_) : String; virtual;
1556 
1557     {** Checks if an item with the key to Key is present. If a match is found,
1558       removes the item from the map. Otherwise raise an exception. }
1559     procedure Delete(const Key: _TKey_);
1560 
1561     {** Deletes the item designated by Position. }
1562     procedure DeleteAt(const Position: TTreeMapCursor);
1563 
1564     {** Deletes the first item. }
1565     procedure DeleteFirst;
1566 
1567     {** Deletes the last item. }
1568     procedure DeleteLast;
1569 
1570     {** Destroys the container. }
1571     destructor Destroy; override;
1572 
1573     {** Checks if an item with the key Key is present. If a match is found,
1574       removes the item from the map. }
1575     procedure Exclude(const Key : _TKey_);
1576 
1577     {** Checks if an item associated with Key is present. If a match is found, a
1578       cursor designating the matching item is returned. Otherwise, NilCursor
1579       is returned. }
Findnull1580     function Find(const Key : _TKey_) : TTreeMapCursor;
1581 
1582     {** Returns a cursor that designates the first element of the container or
1583       NilCursor if the container is empty. }
Firstnull1584     function First: TTreeMapCursor;
1585 
1586     {** Returns the first Item. }
FirstItemnull1587     function FirstItem: _TItem_;
1588 
1589     {** If the map is empty raises an exception. Otherwise, returns the smallest
1590       Key. }
FirstKeynull1591     function FirstKey: _TKey_;
1592 
1593     {** Searches for the last entry whose key is not greater than Key. If such
1594       an entry is found, a cursor that designates it is returned. Otherwise
1595       NilCursor is returned. }
Floornull1596     function Floor(const Key: _TKey_) : TTreeMapCursor;
1597 
GetEnumeratornull1598     function GetEnumerator : TEnumerator;
1599 
GetItemnull1600     function GetItem(const Key: _TKey_): _TItem_;
1601 
GetItemAtnull1602     function GetItemAt(const Position: TTreeMapCursor): _TItem_;
1603 
GetKeyAtnull1604     function GetKeyAt(const Position : TTreeMapCursor) : _TKey_;
1605 
1606     {** Inserts Key and Value into the map. If an entry with the same Key is
1607       already in the map, then the old value is replaced. }
1608     procedure Include(const Key : _TKey_; const Value: _TItem_);
1609 
1610     {** Inserts Key and Value into the map. If an entry with the same Key is
1611       already in the map, then an exception is raised. }
1612     procedure Insert(const Key : _TKey_; const Value: _TItem_);
1613 
1614     {** If an entry with the same Key is already in the map, then Inserted is
1615       set to false. Otherwise, Insert inserts Key and Value into the map and
1616       sets Inserted to true. }
1617     procedure Insert(const Key : _TKey_; const Value: _TItem_;
1618       out Inserted: Boolean);
1619 
1620     {** Returns true if the container is empty. }
IsEmptynull1621     function IsEmpty: Boolean; inline;
1622 
1623     {** Returns a cursor that designates the last element of the container or
1624       NilCursor if the container is empty. }
Lastnull1625     function Last: TTreeMapCursor;
1626 
1627     {** Returns the last Item. }
LastItemnull1628     function LastItem: _TItem_;
1629 
1630     {** If the map is empty raises an exception. Otherwise, returns the greatest
1631       Key. }
LastKeynull1632     function LastKey: _TKey_;
1633 
1634     procedure ReadFirstItem(out Value : _TItem_); inline;
1635 
1636     procedure ReadFirstKey(out Key : _TKey_); inline;
1637 
1638     procedure ReadItem(const Key: _TKey_; out Value: _TItem_);
1639 
1640     procedure ReadItemAt(const Position: TTreeMapCursor; out Value: _TItem_);
1641 
1642     procedure ReadKeyAt(const Position : TTreeMapCursor; out Key: _TKey_);
1643 
1644     procedure ReadLastItem(out Value : _TItem_); inline;
1645 
1646     procedure ReadLastKey(out Key : _TKey_); inline;
1647 
1648     {** Checks if an entry with the key Key is present. If a match is found,
1649       assigns Key and Value to the matching entry. Otherwise, an exception is
1650       raised. }
1651     procedure Replace(const Key : _TKey_; const Value: _TItem_);
1652 
1653     procedure SetItemAt(const Position: TTreeMapCursor; Value: _TItem_);
1654 
1655     {** Return a string representation for the container. }
ToStringnull1656     function ToString : String; override;
1657 
1658     {** Provides access to the items in the container. }
1659     property ItemAt[const Position: TTreeMapCursor] : _TItem_ read GetItemAt
1660       write SetItemAt;
1661 
1662     {** Provides access to the items in the container. }
1663     property Items[const Key: _TKey_] : _TItem_ read GetItem write Include;
1664       default;
1665 
1666     {** Provides access to the keys in the container. }
1667     property Keys[const Position: TTreeMapCursor] : _TKey_ read GetKeyAt;
1668 
1669     {** A nil cursor. }
1670     property NilCursor: TTreeMapCursor read fNilCursor;
1671 
1672     property OnCompareKeys : TCompareKeys read fOnCompareKeys write SetOnCompareKeys;
1673     property OnItemToString : TItemToString read fOnItemToString write SetOnItemToString;
1674     property OnKeyToString : TKeyToString read fOnKeyToString write SetOnKeyToString;
1675 
1676     {** Number of items. }
1677     property Size : Integer read fSize;
1678   end;
1679 
1680   TAbstractTreeSet = class(TContainer)
1681   end;
1682 
1683   TTreeSetCursor = object
1684   strict private
1685     fTreeSet : TAbstractTreeSet;
1686     fPos : TTreeMapCursor;
1687 
1688   public
1689     {** Check if the cursors designate the same item. }
Equalsnull1690     function Equals(const Cursor: TTreeSetCursor) : Boolean;
1691 
1692     {** Check if the cursors designate an item. }
HasItemnull1693     function HasItem: Boolean; inline;
1694 
1695     {** Constructor. }
1696     constructor Init(TreeSet : TAbstractTreeSet; const APos: TTreeMapCursor);
1697 
1698     {** Returns true if the cursor designates the first element. }
IsFirstnull1699     function IsFirst: Boolean; inline;
1700 
1701     {** Returns true if the cursor designates the last element. }
IsLastnull1702     function IsLast: Boolean; inline;
1703 
1704     {** Equivalent to (not HasItem). }
IsNilnull1705     function IsNil: Boolean; inline;
1706 
1707     {** If cursor is nil then do nothing, else if cursor is last then cursor
1708       becomes nil cursor, otherwise move cursor to the next item.  }
1709     procedure MoveNext;
1710 
1711     {** If cursor is nil then do nothing, else if cursor is first then cursor
1712       becomes nil cursor, otherwise move cursor to the previous item.  }
1713     procedure MovePrevious;
1714 
1715     property TreeSet : TAbstractTreeSet read fTreeSet;
1716 
1717     {** Designated entry. }
1718     property Pos : TTreeMapCursor read fPos;
1719   end;
1720 
1721   { TGenTreeSet }
1722 
1723   generic TGenTreeSet<_TItem_> = class(TAbstractTreeSet)
1724   public type
1725     TCompareItems = function (const A, B: _TItem_) : Integer of object;
1726     TItemToString = function (const Item: _TItem_) : String of object;
1727     TEnumerator = specialize TGenEnumerator<_TItem_, TTreeSetCursor>;
1728 
1729   private type
1730     TMap = specialize TGenTreeMap<_TItem_, Integer>;
1731 
1732   private
1733     fMap : TMap;
1734     fNilCursor : TTreeSetCursor;
1735 
EnumeratorGetnull1736     function EnumeratorGet(const Pos: TTreeSetCursor) : _TItem_;
EnumeratorNextnull1737     function EnumeratorNext(var Pos: TTreeSetCursor) : Boolean;
1738     procedure ExchangeContent(ASet: TGenTreeSet);
GetOnCompareItemsnull1739     function GetOnCompareItems: TCompareItems;
GetOnItemToStringnull1740     function GetOnItemToString: TItemToString;
GetSizenull1741     function GetSize: Integer; inline;
1742     procedure SetOnCompareItems(AValue: TCompareItems);
1743     procedure SetOnItemToString(AValue: TItemToString);
1744 
1745   public
1746     {** Searches for the first item which is not less than Item. If such an item
1747       is found, a cursor that designates it is returned. Otherwise NilCursor is
1748       returned. }
Ceilingnull1749     function Ceiling(const Item: _TItem_) : TTreeSetCursor;
1750 
1751     {** Removes all the items from the container. }
1752     procedure Clear;
1753 
1754     {** Returns true if the container contains Item. }
Containsnull1755     function Contains(const Item: _TItem_) : Boolean;
1756 
1757     {** Creates an empty tree set. }
1758     constructor Create;
1759 
DefaultCompareItemsnull1760     function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull1761     function DefaultItemToString(const Item: _TItem_) : String; virtual;
1762 
1763     {** Checks if Item is present in the container. If a match is found, removes
1764       the element from the set. Otherwise, raises an exception. }
1765     procedure Delete(const Item: _TItem_);
1766 
1767     {** Deletes the item designated by Position. }
1768     procedure DeleteAt(const Position: TTreeSetCursor);
1769 
1770     {** Deletes the first item. }
1771     procedure DeleteFirst;
1772 
1773     {** Deletes the last item. }
1774     procedure DeleteLast;
1775 
1776     destructor Destroy; override;
1777 
1778     {** Clears Self and then adds to Self all the items of Left that are not
1779       present in Right. }
1780     procedure Difference(Left, Right: TGenTreeSet);
1781 
1782     {** Checks if Item is present in the container. If a match is found, removes
1783       the item from the set. }
1784     procedure Exclude(const Item: _TItem_);
1785 
1786     {** Excludes all the items of ASet. }
1787     procedure ExcludeAll(ASet: TGenTreeSet);
1788 
1789     {** Returns a cursor that designates the first element of the container or
1790       NilCursor if the container is empty. }
Firstnull1791     function First: TTreeSetCursor;
1792 
1793     {** Returns the first Item. }
FirstItemnull1794     function FirstItem: _TItem_;
1795 
1796     {** Searches for the last item which is not greater than Item. If such an
1797       item is found, a cursor that designates it is returned. Otherwise
1798       NilCursor is returned. }
Floornull1799     function Floor(const Item: _TItem_) : TTreeSetCursor;
1800 
GetEnumeratornull1801     function GetEnumerator : TEnumerator;
1802 
GetItemAtnull1803     function GetItemAt(const Position: TTreeSetCursor): _TItem_;
1804 
1805     {** Checks if Item is present in the container. If no match is found, inserts
1806       the item into the set.}
1807     procedure Include(const Item: _TItem_);
1808 
1809     {** Includes all the items of ASet. }
1810     procedure IncludeAll(ASet: TGenTreeSet);
1811 
1812     {** Checks if Item is present in the container. If no match is found, inserts
1813       the item into the set. Otherwise, raises an exception. }
1814     procedure Insert(const Item: _TItem_);
1815 
1816     {** Checks if Item is present in the container. If no match is found, inserts
1817       the item into the set and sets Inserted to true. Otherwise, sets Inserted
1818       to false. }
1819     procedure Insert(const Item: _TItem_; out Inserted: Boolean);
1820 
1821     {** Clears Self and then adds to Self all the items of Left that are present
1822       in Right. }
1823     procedure Intersection(Left, Right: TGenTreeSet);
1824 
1825     {** Returns true if the set is empty. }
IsEmptynull1826     function IsEmpty: Boolean; inline;
1827 
1828     {** Returns true if all the items in Self are present in OfSet. }
IsSubsetnull1829     function IsSubset(OfSet: TGenTreeSet) : Boolean;
1830 
1831     {** Returns a cursor that designates the last element of the container
1832       or NilCursor if the container is empty. }
Lastnull1833     function Last: TTreeSetCursor;
1834 
1835     {** Returns the last Item. }
LastItemnull1836     function LastItem: _TItem_;
1837 
1838     {** Returns true if at least one item of Self is present in ASet. }
Overlapsnull1839     function Overlaps(ASet: TGenTreeSet) : Boolean;
1840 
1841     procedure ReadFirstItem(out Value : _TItem_); inline;
1842 
1843     procedure ReadItemAt(const Position: TTreeSetCursor; out Value: _TItem_);
1844 
1845     procedure ReadLastItem(out Value : _TItem_); inline;
1846 
1847     {** Clears Self and then adds to Self all the items of Left that are not
1848       present in Right all the items of Right that are not present in Left. }
1849     procedure SymmetricDifference(Left, Right: TGenTreeSet);
1850 
1851     {** Return a string representation for the container. }
ToStringnull1852     function ToString : String; override;
1853 
1854     {** Clears Self and then adds to Self all the items of Left and all the
1855       items of Right. }
1856     procedure Union(Left, Right: TGenTreeSet);
1857 
1858     {** Provides access to the items in the container. }
1859     property Items[const Position: TTreeSetCursor] : _TItem_ read GetItemAt; default;
1860 
1861     {** A nil cursor. }
1862     property NilCursor: TTreeSetCursor read fNilCursor;
1863 
1864     property OnCompareItems : TCompareItems read GetOnCompareItems write SetOnCompareItems;
1865 
1866     property OnItemToString : TItemToString read GetOnItemToString write SetOnItemToString;
1867 
1868     {** Number of items. }
1869     property Size : Integer read GetSize;
1870   end;
1871 
1872 
1873   { TBitSet }
1874 
1875   {** Class to store collections of bits. }
1876 
1877   TBitSet = class(TContainer)
1878   private
1879     fBits : array of Byte;
1880     fExtraMask : Byte;
1881     fLen : Integer;
1882     fSize : Integer;
1883 
1884     procedure ClearExtraBits;
1885   public
1886     {** Performs a logical AND on the bits in the bitset with the bits of
1887       BitSet. }
1888     procedure AndBits(BitSet : TBitSet);
1889 
1890     {** Returns @true if all the bits of the bitset are set, and @false
1891       otherwise. }
Allnull1892     function All : Boolean;
1893 
1894     {** Returns @true if any of the bits in the bitset is set, and @false
1895       otherwise. }
Anynull1896     function Any : Boolean;
1897 
1898     {** Returns the number of bits in the bitset that are set. }
Cardinalitynull1899     function Cardinality : Integer;
1900 
1901     {** Sets to @false the bit at position Index.}
1902     procedure Clear(Index: Integer);
1903 
1904     {** Sets to @false all bits in the bitset.}
1905     procedure ClearAll;
1906 
1907     constructor Create(Size: Integer);
1908 
1909     constructor Create(Size: Integer; Value: QWord);
1910 
1911     constructor Create(Size: Integer; const Value: String);
1912 
1913     constructor Create(Value: TBitSet);
1914 
1915     constructor Create(Size: Integer; Value: TBitSet);
1916 
1917     procedure Debug;
1918 
1919     {** Returns @true only if the bitset and Value are of the same size and have
1920       exactly the same set of bits set to @true.}
Equalsnull1921     function Equals(Obj: TObject) : Boolean; override;
1922 
1923     {** Flips the bit at position Index. }
1924     procedure Flip(Index: Integer);
1925 
1926     {** Flips all bits in the bitset. }
1927     procedure FlipAll;
1928 
1929     procedure FlipFast(Index: Integer); inline;
1930 
1931     procedure Initialize(Value: Int64);
1932 
1933     procedure Initialize(const Value : String);
1934 
1935     procedure Initialize(Value : TBitSet);
1936 
1937     {** Returns @true if none of the bits in the bitset is set to @true, and
1938       @false otherwise.}
Nonenull1939     function None : Boolean;
1940 
1941     procedure NotBits(BitSet : TBitSet);
1942 
1943     {** Performs a logical OR on the bits in the bitset with the bits of
1944       BitSet. }
1945     procedure OrBits(BitSet : TBitSet);
1946 
1947     {** Sets to @true all bits in the bitset.}
1948     procedure SetAll;
1949 
1950     {** Sets to Value the bit at position Index.}
1951     procedure SetBit(Index : Integer; Value: Boolean);
1952 
1953     procedure SetBitFast(Index : Integer; Value: Boolean); inline;
1954 
1955     {** Sets to @true the bit at position Index.}
1956     procedure SetOn(Index: Integer);
1957 
1958     procedure ShiftLeft(Count : Integer = 1);
1959 
1960     procedure ShiftRight(Count : Integer = 1);
1961 
1962     {** Returns @true if the bit at position Index is set, and @false
1963       otherwise.}
Testnull1964     function Test(Index: Integer) : Boolean;
1965 
TestFastnull1966     function TestFast(Index : Integer): Boolean; inline;
1967 
ToIntegernull1968     function ToInteger: Integer;
1969 
ToInt64null1970     function ToInt64: Int64;
1971 
ToQWordnull1972     function ToQWord: QWord;
1973 
ToStringnull1974     function ToString: String; override;
1975 
1976     {** Performs a logical XOR on the bits in the bitset with the bits of
1977       BitSet. }
1978     procedure XorBits(BitSet : TBitSet);
1979 
1980     property Bits[Index : Integer] : Boolean read TestFast
1981       write SetBitFast; default;
1982 
1983     property Size : Integer read fSize;
1984   end;
1985 
HashDatanull1986 function HashData(Data : PByte; DataSize: Integer) : Integer;
HashStringnull1987 function HashString(const Str: String) : Integer;
1988 
1989 implementation
1990 
1991 uses Math;
1992 
1993 const
1994   S_BitSetsAreIncompatible = 'bit sets are incompatible';
1995   S_ContainerEmpty = 'container is empty';
1996   S_CursorIsNil = 'cursor is nil';
1997   S_CursorDenotesWrongContainer = 'cursor denotes wrong container';
1998   S_IndexOutOfRange = 'index out of range';
1999   S_InvalidBitSetSize = 'invalid bit set size';
2000   S_InvalidBinaryValue = 'invalid binary value';
2001   S_ItemNotInSet = 'item not in set';
2002   S_ItemAlreadyInSet = 'item already in set';
2003   S_KeyNotInMap = 'key not in map';
2004   S_KeyAlreadyInMap = 'key already in map';
2005   S_MethodNotRedefined = 'method not redefined';
2006 
2007   SBox : array [Byte] of LongWord = ( $F53E1837, $5F14C86B, $9EE3964C,
2008     $FA796D53, $32223FC3, $4D82BC98, $A0C7FA62, $63E2C982, $24994A5B, $1ECE7BEE,
2009     $292B38EF, $D5CD4E56, $514F4303, $7BE12B83, $7192F195, $82DC7300, $084380B4,
2010     $480B55D3, $5F430471, $13F75991, $3F9CF22C, $2FE0907A, $FD8E1E69, $7B1D5DE8,
2011     $D575A85C, $AD01C50A, $7EE00737, $3CE981E8, $0E447EFA, $23089DD6, $B59F149F,
2012     $13600EC7, $E802C8E6, $670921E4, $7207EFF0, $E74761B0, $69035234, $BFA40F19,
2013     $F63651A0, $29E64C26, $1F98CCA7, $D957007E, $E71DDC75, $3E729595, $7580B7CC,
2014     $D7FAF60B, $92484323, $A44113EB, $E4CBDE08, $346827C9, $3CF32AFA, $0B29BCF1,
2015     $6E29F7DF, $B01E71CB, $3BFBC0D1, $62EDC5B8, $B7DE789A, $A4748EC9, $E17A4C4F,
2016     $67E5BD03, $F3B33D1A, $97D8D3E9, $09121BC0, $347B2D2C, $79A1913C, $504172DE,
2017     $7F1F8483, $13AC3CF6, $7A2094DB, $C778FA12, $ADF7469F, $21786B7B, $71A445D0,
2018     $A8896C1B, $656F62FB, $83A059B3, $972DFE6E, $4122000C, $97D9DA19, $17D5947B,
2019     $B1AFFD0C, $6EF83B97, $AF7F780B, $4613138A, $7C3E73A6, $CF15E03D, $41576322,
2020     $672DF292, $B658588D, $33EBEFA9, $938CBF06, $06B67381, $07F192C6, $2BDA5855,
2021     $348EE0E8, $19DBB6E3, $3222184B, $B69D5DBA, $7E760B88, $AF4D8154, $007A51AD,
2022     $35112500, $C9CD2D7D, $4F4FB761, $694772E3, $694C8351, $4A7E3AF5, $67D65CE1,
2023     $9287DE92, $2518DB3C, $8CB4EC06, $D154D38F, $E19A26BB, $295EE439, $C50A1104,
2024     $2153C6A7, $82366656, $0713BC2F, $6462215A, $21D9BFCE, $BA8EACE6, $AE2DF4C1,
2025     $2A8D5E80, $3F7E52D1, $29359399, $FEA1D19C, $18879313, $455AFA81, $FADFE838,
2026     $62609838, $D1028839, $0736E92F, $3BCA22A3, $1485B08A, $2DA7900B, $852C156D,
2027     $E8F24803, $00078472, $13F0D332, $2ACFD0CF, $5F747F5C, $87BB1E2F, $A7EFCB63,
2028     $23F432F0, $E6CE7C5C, $1F954EF6, $B609C91B, $3B4571BF, $EED17DC0, $E556CDA0,
2029     $A7846A8D, $FF105F94, $52B7CCDE, $0E33E801, $664455EA, $F2C70414, $73E7B486,
2030     $8F830661, $8B59E826, $BB8AEDCA, $F3D70AB9, $D739F2B9, $4A04C34A, $88D0F089,
2031     $E02191A2, $D89D9C78, $192C2749, $FC43A78F, $0AAC88CB, $9438D42D, $9E280F7A,
2032     $36063802, $38E8D018, $1C42A9CB, $92AAFF6C, $A24820C5, $007F077F, $CE5BC543,
2033     $69668D58, $10D6FF74, $BE00F621, $21300BBE, $2E9E8F46, $5ACEA629, $FA1F86C7,
2034     $52F206B8, $3EDF1A75, $6DA8D843, $CF719928, $73E3891F, $B4B95DD6, $B2A42D27,
2035     $EDA20BBF, $1A58DBDF, $A449AD03, $6DDEF22B, $900531E6, $3D3BFF35, $5B24ABA2,
2036     $472B3E4C, $387F2D75, $4D8DBA36, $71CB5641, $E3473F3F, $F6CD4B7F, $BF7D1428,
2037     $344B64D0, $C5CDFCB6, $FE2E0182, $2C37A673, $DE4EB7A3, $63FDC933, $01DC4063,
2038     $611F3571, $D167BFAF, $4496596F, $3DEE0689, $D8704910, $7052A114, $068C9EC5,
2039     $75D0E766, $4D54CC20, $B44ECDE2, $4ABC653E, $2C550A21, $1A52C0DB, $CFED03D0,
2040     $119BAFE2, $876A6133, $BC232088, $435BA1B2, $AE99BBFA, $BB4F08E4, $A62B5F49,
2041     $1DA4B695, $336B84DE, $DC813D31, $00C134FB, $397A98E6, $151F0E64, $D9EB3E69,
2042     $D3C7DF60, $D2F2C336, $2DDD067B, $BD122835, $B0B3BD3A, $B0D54E46, $8641F1E4,
2043     $A0B38F96, $51D39199, $37A6AD75, $DF84EE41, $3C034CBA, $ACDA62FC, $11923B8B,
2044     $45EF170A);
2045 
2046   Card : array [Byte] of Byte = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
2047     1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2,
2048     3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2,
2049     2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4,
2050     5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5,
2051     4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3,
2052     4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4,
2053     4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6,
2054     7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6,
2055     4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4,
2056     5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
2057 
2058 {--- HashData ---}
2059 {$PUSH}
2060 {$O-}{$R-}{$Q-}
HashDatanull2061 function HashData(Data : PByte; DataSize: Integer) : Integer;
2062 var
2063   I : Integer;
2064 begin
2065   Result := 0;
2066   for I := 1 to DataSize do
2067   begin
2068     Result := Result xor Integer(SBox[Data^]);
2069     Result := Result * 3;
2070     Inc(Data);
2071   end;
2072 end;
2073 {$POP}
2074 
2075 {--- HashString ---}
HashStringnull2076 function HashString(const Str: String): Integer;
2077 begin
2078   if Str = '' then
2079     Result := 0
2080   else
2081     Result := HashData(@Str[1], Length(Str));
2082 end;
2083 
2084 {===============}
2085 {=== TBitSet ===}
2086 {===============}
2087 
2088 {$push}
2089 {$rangechecks off}
2090 {$overflowchecks off}
2091 
2092 {--- TBitSet.ClearExtraBits ---}
2093 procedure TBitSet.ClearExtraBits;
2094 begin
2095   if fExtraMask <> High(Byte) then
2096     fBits[fLen - 1] := fBits[fLen - 1] and fExtraMask;
2097 end;
2098 
2099 {--- TBitSet.AndBits ---}
2100 procedure TBitSet.AndBits(BitSet: TBitSet);
2101 var
2102   I: Integer;
2103 begin
2104   if BitSet.fSize <> fSize then
2105     RaiseError(S_BitSetsAreIncompatible);
2106 
2107   for I := 0 to fLen - 1 do
2108     fBits[I] := fBits[I] and BitSet.fBits[I];
2109 
2110   ClearExtraBits;
2111 end;
2112 
2113 {--- TBitSet.All ---}
Allnull2114 function TBitSet.All: Boolean;
2115 var
2116   I: Integer;
2117 begin
2118   for I := 0 to fLen - 2 do
2119     if fBits[I] <> High(Byte) then
2120     begin
2121       Result := false;
2122       Exit;
2123     end;
2124 
2125   Result := (fBits[fLen - 1] = fExtraMask);
2126 end;
2127 
2128 {--- TBitSet.Any ---}
Anynull2129 function TBitSet.Any: Boolean;
2130 var
2131   I: Integer;
2132 begin
2133   Result := false;
2134   for I := 0 to fLen - 1 do
2135     if fBits[I] <> 0 then
2136     begin
2137       Result := true;
2138       Break;
2139     end;
2140 end;
2141 
2142 {--- TBitSet.Cardinality ---}
Cardinalitynull2143 function TBitSet.Cardinality: Integer;
2144 var
2145   I : Integer;
2146 begin
2147   Result := 0;
2148 
2149   for I := 0 to fLen - 2 do
2150     Result := Result + Card[fBits[I]];
2151   Result := Result + Card[(fBits[fLen - 1] and fExtraMask)];
2152 end;
2153 
2154 {--- TBitSet.Clear ---}
2155 procedure TBitSet.Clear(Index: Integer);
2156 begin
2157   if (Index < 0) or (Index >= fSize) then
2158     RaiseIndexOutOfRange;
2159   SetBitFast(Index, false);
2160 end;
2161 
2162 {--- TBitSet.ClearAll ---}
2163 procedure TBitSet.ClearAll;
2164 var
2165   I: Integer;
2166 begin
2167   for I := Low(fBits) to High(fBits) do
2168     fBits[I] := 0;
2169 end;
2170 
2171 {--- TBitSet.Create ---}
2172 constructor TBitSet.Create(Size: Integer);
2173 var
2174   ArraySize, I : Integer;
2175 begin
2176   if Size <= 0 then
2177     RaiseError(S_InvalidBitSetSize);
2178 
2179   fSize := Size;
2180   fLen := (fSize + (SizeOf(Byte) * 8) - 1) div (SizeOf(Byte) * 8);
2181 
2182   SetLength(fBits, fLen);
2183 
2184   ArraySize := fLen * SizeOf(Byte) * 8;
2185   if ArraySize = Size then
2186     fExtraMask := High(Byte)
2187   else
2188   begin
2189     fExtraMask := 1;
2190     for I := 2 to SizeOf(Byte) * 8 - (ArraySize - Size) do
2191       fExtraMask := (fExtraMask shl 1) or 1;
2192   end;
2193 end;
2194 
2195 {--- TBitSet.Create ---}
2196 constructor TBitSet.Create(Size: Integer; Value: QWord);
2197 begin
2198   Create(Size);
2199   Initialize(Value);
2200 end;
2201 
2202 {--- TBitSet.Create ---}
2203 constructor TBitSet.Create(Size: Integer; const Value: String);
2204 begin
2205   Create(Size);
2206   Initialize(Value);
2207 end;
2208 
2209 {--- TBitSet.Create ---}
2210 constructor TBitSet.Create(Value: TBitSet);
2211 begin
2212   Create(Value.fSize, Value);
2213 end;
2214 
2215 {--- TBitSet.Create ---}
2216 constructor TBitSet.Create(Size: Integer; Value: TBitSet);
2217 var
2218   I, IMax: Integer;
2219 begin
2220   Create(Size);
2221 
2222   IMax := Min(Size - 1, Value.fSize - 1);
2223   for I := 0 to IMax do
2224     if Value.TestFast(I) then
2225       SetBitFast(I, true);
2226 end;
2227 
2228 {--- TBitSet.Debug ---}
2229 procedure TBitSet.Debug;
2230 var
2231   I: Integer;
2232 begin
2233   Write('TBitSet@', HexStr(Self), ' : fLen=', fLen, ' fSize=', fSize);
2234   WriteLn(' fExtraMask=', BinStr(fExtraMask, SizeOf(fExtraMask) * 8));
2235   Write('fBits=[');
2236   for I := Low(fBits) to High(fBits) do
2237     Write(fBits[I], ' ');
2238   WriteLn(']');
2239 end;
2240 
2241 {--- TBitSet.Equals ---}
Equalsnull2242 function TBitSet.Equals(Obj: TObject): Boolean;
2243 var
2244   I: Integer;
2245   Value : TBitSet;
2246 begin
2247   if Obj is TBitSet then
2248   begin
2249     Value := Obj as TBitSet;
2250     if fSize <> Value.fSize then
2251       RaiseError(S_BitSetsAreIncompatible);
2252 
2253     Result := true;
2254     for I := Low(fBits) to High(fBits) do
2255       if fBits[I] <> Value.fBits[I] then
2256       begin
2257         Result := false;
2258         Exit;
2259       end;
2260   end
2261   else
2262     Result := false;
2263 end;
2264 
2265 {--- TBitSet.Flip ---}
2266 procedure TBitSet.Flip(Index: Integer);
2267 var
2268   Rank, NBit : Integer;
2269 begin
2270   if (Index < 0) or (Index >= fSize) then
2271     RaiseIndexOutOfRange;
2272 
2273   Rank := Index div (SizeOf(Byte) * 8);
2274   NBit := Index mod (SizeOf(Byte) * 8);
2275 
2276   fBits[Rank] := fBits[Rank] xor (Byte(1) shl NBit);
2277 end;
2278 
2279 {--- TBitSet.FlipAll ---}
2280 procedure TBitSet.FlipAll;
2281 var
2282   I: Integer;
2283 begin
2284   for I := Low(fBits) to High(fBits) do
2285     fBits[I] := not fBits[I];
2286   ClearExtraBits;
2287 end;
2288 
2289 {--- TBitSet.FlipFast ---}
2290 procedure TBitSet.FlipFast(Index: Integer);
2291 var
2292   Rank, NBit : Integer;
2293 begin
2294   Rank := Index div (SizeOf(Byte) * 8);
2295   NBit := Index mod (SizeOf(Byte) * 8);
2296 
2297   fBits[Rank] := fBits[Rank] xor (Byte(1) shl NBit);
2298 end;
2299 
2300 {--- TBitSet.Initialize ---}
2301 procedure TBitSet.Initialize(Value: Int64);
2302 const
2303   NBits = SizeOf(Int64) * 8;
2304 var
2305   I, IMax: Integer;
2306 begin
2307   ClearAll;
2308 
2309   IMax := Min(NBits - 1, fSize - 1);
2310   for I := 0 to IMax do
2311   begin
2312     if (Value and 1) <> 0 then
2313       SetBitFast(I, true);
2314     Value := Value shr 1;
2315   end;
2316 end;
2317 
2318 {--- TBitSet.Initialize ---}
2319 procedure TBitSet.Initialize(const Value: String);
2320 var
2321   I, IMax, Len: Integer;
2322 begin
2323   ClearAll;
2324 
2325   Len := Length(Value);
2326   IMax := Min(Len, fSize);
2327   for I := 1 to IMax do
2328   begin
2329     if Value[I] = '1' then
2330       SetBitFast(IMax - I, true)
2331     else if Value[I] <> '0' then
2332       RaiseError(S_InvalidBinaryValue);
2333   end;
2334 end;
2335 
2336 {--- TBitSet.Initialize ---}
2337 procedure TBitSet.Initialize(Value: TBitSet);
2338 var
2339   I, IMax : Integer;
2340 begin
2341   ClearAll;
2342   IMax := Min(fSize - 1, Value.fSize - 1);
2343   for I := 0 to IMax do
2344     SetBitFast(I, Value.TestFast(I));
2345 end;
2346 
2347 {--- TBitSet.None ---}
TBitSet.Nonenull2348 function TBitSet.None: Boolean;
2349 begin
2350   Result := not Any;
2351 end;
2352 
2353 {--- TBitSet.NotBits ---}
2354 procedure TBitSet.NotBits(BitSet: TBitSet);
2355 var
2356   I: Integer;
2357   B : Integer;
2358 begin
2359   if BitSet.fSize <> fSize then
2360     RaiseError(S_BitSetsAreIncompatible);
2361 
2362   for I := 0 to fLen - 1 do
2363   begin
2364     B := fBits[I];
2365     fBits[I] := B and (B xor BitSet.fBits[I]);
2366   end;
2367 
2368   ClearExtraBits;
2369 end;
2370 
2371 {--- TBitSet.OrBits ---}
2372 procedure TBitSet.OrBits(BitSet: TBitSet);
2373 var
2374   I: Integer;
2375 begin
2376   if BitSet.fSize <> fSize then
2377     RaiseError(S_BitSetsAreIncompatible);
2378 
2379   for I := 0 to fLen - 1 do
2380     fBits[I] := fBits[I] or BitSet.fBits[I];
2381 
2382   ClearExtraBits;
2383 end;
2384 
2385 {--- TBitSet.SetAll ---}
2386 procedure TBitSet.SetAll;
2387 var
2388   I: Integer;
2389 begin
2390   for I := Low(fBits) to High(fBits) do
2391     fBits[I] := High(Byte);
2392   ClearExtraBits;
2393 end;
2394 
2395 {--- TBitSet.SetBit ---}
2396 procedure TBitSet.SetBit(Index: Integer; Value: Boolean);
2397 begin
2398   if (Index < 0) or (Index >= fSize) then
2399     RaiseIndexOutOfRange;
2400   SetBitFast(Index, Value);
2401 end;
2402 
2403 {--- TBitSet.SetBitFast ---}
2404 procedure TBitSet.SetBitFast(Index : Integer; Value: Boolean);
2405 var
2406   Rank, NBit : Integer;
2407   Mask : Byte;
2408 begin
2409   Rank := Index div (SizeOf(Byte) * 8);
2410   NBit := Index mod (SizeOf(Byte) * 8);
2411 
2412   Mask := 1 shl NBit;
2413 
2414   if Value then
2415     fBits[Rank] := fBits[Rank] or Mask
2416   else
2417   begin
2418     Mask := not Mask;
2419     fBits[Rank] := fBits[Rank] and Mask;
2420   end;
2421 
2422 end;
2423 
2424 {--- TBitSet.SetOn ---}
2425 procedure TBitSet.SetOn(Index: Integer);
2426 begin
2427   if (Index < 0) or (Index >= fSize) then
2428     RaiseIndexOutOfRange;
2429   SetBitFast(Index, true);
2430 end;
2431 
2432 {--- TBitSet.ShiftLeft ---}
2433 procedure TBitSet.ShiftLeft(Count: Integer);
2434 var
2435   I: Integer;
2436 begin
2437   if Count = 0 then
2438     Exit
2439   else if Count < 0 then
2440     ShiftRight(- Count)
2441   else if Count >= fSize then
2442     ClearAll
2443   else if Count mod 8 = 0 then
2444   begin
2445     Count := Count div 8;
2446 
2447     for I := fLen - Count - 1 downto 0 do
2448       fBits[I + Count] := fBits[I];
2449 
2450     for I := 0 to Count - 1 do
2451       fBits[I] := 0;
2452 
2453     ClearExtraBits;
2454   end
2455   else
2456   begin
2457     for I := fSize - Count - 1 downto 0  do
2458       SetBitFast(I + Count, TestFast(I));
2459 
2460     for I := 0 to Count - 1  do
2461       SetBitFast(I, false);
2462   end;
2463 end;
2464 
2465 {--- TBitSet.ShiftRight ---}
2466 procedure TBitSet.ShiftRight(Count: Integer);
2467 var
2468   I : Integer;
2469 begin
2470   if Count = 0 then
2471     Exit
2472   else if Count < 0 then
2473     ShiftLeft(- Count)
2474   else if Count >= fSize then
2475     ClearAll
2476   else if Count mod 8 = 0 then
2477   begin
2478     Count := Count div 8;
2479 
2480     for I := Count to fLen - 1 do
2481       fBits[I - Count] := fBits[I];
2482 
2483     for I := fLen - 1 downto fLen - Count do
2484       fBits[I] := 0;
2485 
2486     ClearExtraBits;
2487   end
2488   else
2489   begin
2490     for I := Count to fSize - 1 do
2491       SetBitFast(I - Count, TestFast(I));
2492 
2493     for I := fSize - Count to fSize - 1 do
2494       SetBitFast(I, false);
2495   end;
2496 end;
2497 
2498 {--- TBitSet.Test ---}
Testnull2499 function TBitSet.Test(Index: Integer): Boolean;
2500 begin
2501   if (Index < 0) or (Index >= fSize) then
2502     RaiseIndexOutOfRange;
2503   Result := TestFast(Index);
2504 end;
2505 
2506 {--- TBitSet.TestFast ---}
TestFastnull2507 function TBitSet.TestFast(Index : Integer): Boolean;
2508 var
2509   Rank, NBit : Integer;
2510 begin
2511   Rank := Index div (SizeOf(Byte) * 8);
2512   NBit := Index mod (SizeOf(Byte) * 8);
2513 
2514   Result := (fBits[Rank] and (1 shl NBit)) <> 0;
2515 end;
2516 
2517 {--- TBitSet.ToInteger ---}
TBitSet.ToIntegernull2518 function TBitSet.ToInteger: Integer;
2519 var
2520   I, IMax : Integer;
2521 begin
2522   Result := 0;
2523 
2524   IMax := Min(fSize - 1, SizeOf(Integer) * 8 - 1);
2525   for I := IMax downto 0 do
2526   begin
2527     Result := Result shl 1;
2528     if TestFast(I) then
2529       Result := Result or 1;
2530   end;
2531 end;
2532 
2533 {--- TBitSet.ToInt64 ---}
TBitSet.ToInt64null2534 function TBitSet.ToInt64: Int64;
2535 begin
2536   Result := Int64(ToQWord);
2537 end;
2538 
2539 {--- TBitSet.ToQWord ---}
ToQWordnull2540 function TBitSet.ToQWord: QWord;
2541 var
2542   I, IMax : Integer;
2543 begin
2544   Result := 0;
2545 
2546   IMax := Min(fSize - 1, SizeOf(QWord) * 8 - 1);
2547   for I := IMax downto 0 do
2548   begin
2549     Result := Result shl 1;
2550     if TestFast(I) then
2551       Result := Result or 1;
2552   end;
2553 end;
2554 
2555 {--- TBitSet.ToString ---}
TBitSet.ToStringnull2556 function TBitSet.ToString: String;
2557 var
2558   Bit : Char;
2559   I: Integer;
2560 begin
2561   SetLength(Result, fSize);
2562 
2563   for I := 0 to fSize - 1 do
2564   begin
2565     if TestFast(I) then
2566       Bit := '1'
2567     else
2568       Bit := '0';
2569 
2570     Result[fSize - I] := Bit;
2571   end;
2572 end;
2573 
2574 {--- TBitSet.XorBits ---}
2575 procedure TBitSet.XorBits(BitSet: TBitSet);
2576 var
2577   I: Integer;
2578 begin
2579   if BitSet.fSize <> fSize then
2580     RaiseError(S_BitSetsAreIncompatible);
2581 
2582   for I := 0 to fLen - 1 do
2583     fBits[I] := fBits[I] xor BitSet.fBits[I];
2584 
2585   ClearExtraBits;
2586 end;
2587 
2588 {$pop}
2589 
2590 {======================}
2591 {=== TGenEnumerator ===}
2592 {======================}
2593 
2594 {--- TGenEnumerator.GetCurrent ---}
GetCurrentnull2595 function TGenEnumerator.GetCurrent: _TItem_;
2596 begin
2597   Result := fGetter(fPos);
2598 end;
2599 
2600 {--- TGenEnumerator.Create ---}
2601 constructor TGenEnumerator.Create(const Pos: _TPosition_; Mover: TMoveNext;
2602   Getter: TGetCurrent);
2603 begin
2604   fPos := Pos;
2605   fMover := Mover;
2606   fGetter := Getter;
2607 end;
2608 
2609 {--- TGenEnumerator.MoveNext ---}
TGenEnumerator.MoveNextnull2610 function TGenEnumerator.MoveNext: Boolean;
2611 begin
2612   Result := fMover(fPos);
2613 end;
2614 
2615 {==================}
2616 {=== TContainer ===}
2617 {==================}
2618 
2619 {--- TContainer.RaiseContainerEmpty ---}
2620 procedure TContainer.RaiseContainerEmpty;
2621 begin
2622   raise EContainerError.Create(S_ContainerEmpty);
2623 end;
2624 
2625 {--- TContainer.RaiseCursorDenotesWrongContainer ---}
2626 procedure TContainer.RaiseCursorDenotesWrongContainer;
2627 begin
2628   raise EContainerError.Create(S_CursorDenotesWrongContainer);
2629 end;
2630 
2631 {--- TContainer.RaiseCursorIsNil ---}
2632 procedure TContainer.RaiseCursorIsNil;
2633 begin
2634   raise EContainerError.Create(S_CursorIsNil);
2635 end;
2636 
2637 {--- TContainer.RaiseError ---}
2638 procedure TContainer.RaiseError(const Msg: String);
2639 begin
2640   raise EContainerError.Create(Msg);
2641 end;
2642 
2643 {--- TContainer.RaiseIndexOutOfRange ---}
2644 procedure TContainer.RaiseIndexOutOfRange;
2645 begin
2646   raise EContainerError.Create(S_IndexOutOfRange);
2647 end;
2648 
2649 {--- TContainer.RaiseItemAlreadyInSet ---}
2650 procedure TContainer.RaiseItemAlreadyInSet;
2651 begin
2652   raise EContainerError.Create(S_ItemAlreadyInSet);
2653 end;
2654 
2655 {--- TContainer.RaiseItemNotInSet ---}
2656 procedure TContainer.RaiseItemNotInSet;
2657 begin
2658   raise EContainerError.Create(S_ItemNotInSet);
2659 end;
2660 
2661 {--- TContainer.RaiseKeyAlreadyInMap ---}
2662 procedure TContainer.RaiseKeyAlreadyInMap;
2663 begin
2664   raise EContainerError.Create(S_KeyAlreadyInMap);
2665 end;
2666 
2667 {--- TContainer.RaiseKeyNotInMap ---}
2668 procedure TContainer.RaiseKeyNotInMap;
2669 begin
2670   raise EContainerError.Create(S_KeyNotInMap);
2671 end;
2672 
2673 {--- TContainer.RaiseMethodNotRedefined ---}
2674 procedure TContainer.RaiseMethodNotRedefined;
2675 begin
2676   raise EContainerError.Create(S_MethodNotRedefined);
2677 end;
2678 
2679 {--- TContainer.Unused ---}
2680 {$PUSH}
2681 {$HINTS OFF}
2682 procedure TContainer.Unused(P: Pointer); inline;
2683 begin
2684 end;
2685 {$POP}
2686 
2687 {=======================}
2688 {=== TAbstractVector ===}
2689 {=======================}
2690 
2691 {--- TAbstractVector.CheckIndex ---}
2692 procedure TAbstractVector.CheckIndex(Index: Integer);
2693 begin
2694   if (Index < 0) or (Index >= fSize) then
2695     RaiseIndexOutOfRange;
2696 end;
2697 
2698 {--- TAbstractVector.CheckIndexForAdd ---}
2699 procedure TAbstractVector.CheckIndexForAdd(Index: Integer);
2700 begin
2701   if (Index < 0) or (Index > fSize) then
2702     RaiseIndexOutOfRange;
2703 end;
2704 
2705 {--- TAbstractVector.Clear ---}
2706 procedure TAbstractVector.Clear;
2707 begin
2708   Resize(0);
2709 end;
2710 
2711 {--- TAbstractVector.Delete ---}
2712 procedure TAbstractVector.Delete(Position: Integer; Count: Integer);
2713 var
2714   CountAtEnd: Integer;
2715 begin
2716   CheckIndex(Position);
2717 
2718   if Position + Count > fSize then
2719     Count := fSize - Position;
2720 
2721   if Count > 0 then
2722   begin
2723     CountAtEnd := fSize - (Position + Count);
2724     if CountAtEnd > 0 then
2725       Move(Position + Count, Position, CountAtEnd);
2726 
2727     fSize := fSize - Count;
2728   end;
2729 end;
2730 
2731 {--- TAbstractVector.DeleteFirst ---}
2732 procedure TAbstractVector.DeleteFirst(Count: Integer);
2733 begin
2734   if Count > 0 then
2735     Delete(0, Count);
2736 end;
2737 
2738 {--- TAbstractVector.DeleteLast ---}
2739 procedure TAbstractVector.DeleteLast(Count: Integer);
2740 begin
2741   if Count > 0 then
2742     Resize(fSize - Count);
2743 end;
2744 
2745 {--- TAbstractVector.DeleteRange ---}
2746 procedure TAbstractVector.DeleteRange(PosFrom, PosTo: Integer);
2747 begin
2748   CheckIndex(PosFrom);
2749   CheckIndex(PosTo);
2750 
2751   if PosTo >= PosFrom then
2752     Delete(PosFrom, PosTo - PosFrom + 1);
2753 end;
2754 
2755 {--- TAbstractVector.InsertSpace ---}
2756 procedure TAbstractVector.InsertSpace(Position: Integer; Count: Integer);
2757 begin
2758   CheckIndexForAdd(Position);
2759   InsertSpaceFast(Position, Count);
2760 end;
2761 
2762 {--- TAbstractVector.IsEmpty ---}
IsEmptynull2763 function TAbstractVector.IsEmpty: Boolean;
2764 begin
2765   Result := (fSize = 0);
2766 end;
2767 
2768 {--- TAbstractVector.Reserve ---}
2769 procedure TAbstractVector.Reserve(MinCapacity: Integer);
2770 var
2771   NewCapacity : Integer;
2772 begin
2773   if MinCapacity > Capacity then
2774   begin
2775     NewCapacity := (Capacity * 3) div 2;
2776     if NewCapacity < MinCapacity then
2777       NewCapacity := MinCapacity;
2778     SetCapacity(NewCapacity);
2779   end;
2780 end;
2781 
2782 {--- TAbstractVector.Resize ---}
2783 procedure TAbstractVector.Resize(NewSize: Integer);
2784 begin
2785   if NewSize > fSize then
2786     Reserve(NewSize);
2787 
2788   if NewSize < 0 then
2789     NewSize := 0;
2790 
2791   fSize := NewSize;
2792 end;
2793 
2794 {--- TAbstractVector.Reverse ---}
2795 procedure TAbstractVector.Reverse;
2796 begin
2797   if fSize > 1 then
2798     ReverseRange(0, fSize - 1);
2799 end;
2800 
2801 {--- TAbstractVector.ReverseRange ---}
2802 procedure TAbstractVector.ReverseRange(PosFrom, PosTo: Integer);
2803 var
2804   TmpIndex : Integer;
2805 begin
2806   CheckIndex(PosFrom);
2807   CheckIndex(PosTo);
2808 
2809   if PosTo < PosFrom then
2810   begin
2811     TmpIndex := PosFrom;
2812     PosFrom := PosTo;
2813     PosTo := TmpIndex;
2814   end;
2815 
2816   while PosFrom < PosTo do
2817   begin
2818     SwapFast(PosFrom, PosTo);
2819     Inc(PosFrom);
2820     Dec(PosTo);
2821   end;
2822 end;
2823 
2824 {--- TAbstractVector.Shuffle ---}
2825 procedure TAbstractVector.Shuffle;
2826 begin
2827   if fSize > 1 then
2828     Shuffle(0, fSize - 1);
2829 end;
2830 
2831 {--- TAbstractVector.Shuffle ---}
2832 procedure TAbstractVector.Shuffle(PosFrom, PosTo: Integer);
2833 var
2834   I, J: Integer;
2835 begin
2836   CheckIndex(PosFrom);
2837   CheckIndex(PosTo);
2838 
2839   I := PosTo;
2840   while I > PosFrom  do
2841   begin
2842     J := Random(I - PosFrom) + PosFrom;
2843     if J <> I then
2844       SwapFast(J, I);
2845     Dec(I);
2846   end;
2847 end;
2848 
2849 {--- TAbstractVector.Swap ---}
2850 procedure TAbstractVector.Swap(I, J: Integer);
2851 begin
2852   CheckIndex(I);
2853   CheckIndex(J);
2854   SwapFast(I, J);
2855 end;
2856 
2857 {--- TAbstractVector.ToString ---}
TAbstractVector.ToStringnull2858 function TAbstractVector.ToString: String;
2859 var
2860   I : Integer;
2861 begin
2862   Result := '[';
2863 
2864   if fSize > 0 then
2865   begin
2866     for I := 0 to fSize - 2 do
2867       Result := Result + ItemToString(I) + ', ';
2868     Result := Result + ItemToString(fSize - 1);
2869   end;
2870 
2871   Result := Result + ']';
2872 end;
2873 
2874 {==================}
2875 {=== TGenVector ===}
2876 {==================}
2877 
2878 {--- TGenVector.Append ---}
2879 procedure TGenVector.Append(const Item: _TItem_);
2880 begin
2881   Insert(fSize, Item);
2882 end;
2883 
2884 {--- TGenVector.AppendAll ---}
2885 procedure TGenVector.AppendAll(Src: TGenVector);
2886 begin
2887   InsertAll(fSize, Src);
2888 end;
2889 
2890 {--- TGenVector.AppendRange ---}
2891 procedure TGenVector.AppendRange(Src: TGenVector; PosFrom, PosTo: Integer);
2892 begin
2893   InsertRange(fSize, Src, PosFrom, PosTo);
2894 end;
2895 
2896 {--- TGenVector.BinarySearch ---}
BinarySearchnull2897 function TGenVector.BinarySearch(const Item: _TItem_): Integer;
2898 begin
2899   Result := BinarySearch(Item, fOnCompareItems);
2900 end;
2901 
2902 {--- TGenVector.BinarySearch ---}
BinarySearchnull2903 function TGenVector.BinarySearch(const Item: _TItem_; Comparator: TCompareItems): Integer;
2904 begin
2905   if fSize > 0 then
2906     Result := BinarySearch(Item, 0, fSize - 1, Comparator)
2907   else
2908     Result := -1;
2909 end;
2910 
2911 {--- TGenVector.BinarySearch ---}
BinarySearchnull2912 function TGenVector.BinarySearch(const Item: _TItem_;
2913   PosFrom, PosTo: Integer): Integer;
2914 begin
2915   Result := BinarySearch(Item, PosFrom, PosTo, fOnCompareItems);
2916 end;
2917 
2918 {--- TGenVector.BinarySearch ---}
BinarySearchnull2919 function TGenVector.BinarySearch(const Item: _TItem_;
2920   PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
2921 var
2922   Low, Mid, High, Cmp : Integer;
2923 begin
2924   CheckIndex(PosFrom);
2925   CheckIndex(PosTo);
2926 
2927   Low := PosFrom;
2928   Mid := -1;
2929   High := PosTo;
2930 
2931   while Low <= High do
2932   begin
2933     Mid := (Low + High) div 2;
2934     Cmp := Comparator(fItems[Mid], Item);
2935 
2936     if Cmp = 0 then
2937     begin
2938       Result := Mid;
2939       Exit;
2940     end;
2941 
2942     if Cmp < 0 then
2943       Low := Mid + 1
2944     else
2945       High := Mid - 1;
2946   end;
2947 
2948   if Mid < 0 then
2949     Result := -1
2950   else if Comparator(fItems[Mid], Item) > 0 then
2951     Result := - Mid - 1
2952   else
2953     Result := - Mid - 2;
2954 end;
2955 
2956 {--- TGenVector.DefaultCompareItems ---}
TGenVector.DefaultCompareItemsnull2957 function TGenVector.DefaultCompareItems(const A, B: _TItem_): Integer;
2958 begin
2959   Unused(@A);
2960   Unused(@B);
2961   RaiseMethodNotRedefined;
2962   Result := 0;
2963 end;
2964 
2965 {--- TGenVector.Contains ---}
Containsnull2966 function TGenVector.Contains(const Item: _TItem_): Boolean;
2967 begin
2968   Result := Contains(Item, fOnCompareItems);
2969 end;
2970 
2971 {--- TGenVector.Contains ---}
Containsnull2972 function TGenVector.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
2973 begin
2974   if fSize = 0 then
2975     Result := false
2976   else
2977     Result := (FindIndex(Item, 0, Comparator) >= 0);
2978 end;
2979 
2980 {--- TGenVector.Create ---}
2981 constructor TGenVector.Create(InitialCapacity: Integer);
2982 begin
2983   if InitialCapacity < 0 then
2984     InitialCapacity := 16;
2985 
2986   fSize := 0;
2987 
2988   SetCapacity(InitialCapacity);
2989 
2990   SetOnCompareItems(nil);
2991   SetOnItemToString(nil);
2992 end;
2993 
2994 {--- TGenVector.Destroy ---}
2995 destructor TGenVector.Destroy;
2996 begin
2997   SetCapacity(0);
2998   inherited Destroy;
2999 end;
3000 
3001 {--- TGenVector.Equals ---}
TGenVector.Equalsnull3002 function TGenVector.Equals(Obj: TObject): Boolean;
3003 begin
3004   Result := Equals(Obj, fOnCompareItems);
3005 end;
3006 
3007 {--- TGenVector.Equals ---}
TGenVector.Equalsnull3008 function TGenVector.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
3009 var
3010   Vector: TGenVector;
3011   I : Integer;
3012 begin
3013   if Obj = Self  then
3014     Result := true
3015   else if Obj is TGenVector then
3016   begin
3017     Vector := Obj as TGenVector;
3018 
3019     if fSize <> Vector.fSize then
3020       Result := false
3021     else
3022     begin
3023       Result := true;
3024       for I := 0 to fSize - 1 do
3025         if Comparator(fItems[I], Vector.fItems[I]) <> 0 then
3026         begin
3027           Result := false;
3028           Break;
3029         end;
3030     end;
3031   end
3032   else
3033     Result := false;
3034 end;
3035 
3036 {--- TGenVector.EnumeratorGet ---}
EnumeratorGetnull3037 function TGenVector.EnumeratorGet(const Pos: Integer): _TItem_;
3038 begin
3039   Result := fItems[Pos];
3040 end;
3041 
3042 {--- TGenVector.EnumeratorNext ---}
TGenVector.EnumeratorNextnull3043 function TGenVector.EnumeratorNext(var Pos: Integer): Boolean;
3044 begin
3045   Inc(Pos);
3046   Result := Pos < fSize;
3047 end;
3048 
3049 {--- TGenVector.Fill ---}
3050 procedure TGenVector.Fill(Index, Count: Integer; const Value: _TItem_);
3051 var
3052   I: Integer;
3053 begin
3054   if Count > 0 then
3055     for I := Index to Index + (Count - 1) do
3056       fItems[I] := Value;
3057 end;
3058 
3059 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3060 function TGenVector.FindIndex(const Item: _TItem_): Integer;
3061 begin
3062   Result := FindIndex(Item, fOnCompareItems);
3063 end;
3064 
3065 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3066 function TGenVector.FindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3067 begin
3068   if fSize = 0 then
3069     Result := -1
3070   else
3071     Result := FindIndex(Item, 0, Comparator);
3072 end;
3073 
3074 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3075 function TGenVector.FindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
3076 begin
3077   Result := FindIndex(Item, PosFrom, fOnCompareItems);
3078 end;
3079 
3080 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3081 function TGenVector.FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems): Integer;
3082 var
3083   I: Integer;
3084 begin
3085   CheckIndex(PosFrom);
3086 
3087   Result := -1;
3088 
3089   for I := PosFrom to fSize - 1 do
3090     if Comparator(fItems[I], Item) = 0 then
3091     begin
3092       Result := I;
3093       Break;
3094     end;
3095 end;
3096 
3097 {--- TGenVector.FirstItem ---}
FirstItemnull3098 function TGenVector.FirstItem: _TItem_;
3099 begin
3100   if fSize = 0 then
3101     RaiseContainerEmpty;
3102 
3103   Result := fItems[0];
3104 end;
3105 
3106 {--- TGenVector.GetEnumerator ---}
TGenVector.GetEnumeratornull3107 function TGenVector.GetEnumerator: TEnumerator;
3108 begin
3109   Result := TEnumerator.Create(-1, @EnumeratorNext, @EnumeratorGet);
3110 end;
3111 
3112 {--- TGenVector.GetItem ---}
GetItemnull3113 function TGenVector.GetItem(Position: Integer): _TItem_;
3114 begin
3115   CheckIndex(Position);
3116   Result := fItems[Position];
3117 end;
3118 
3119 {--- TGenVector.GetItemFast ---}
TGenVector.GetItemFastnull3120 function TGenVector.GetItemFast(Position: Integer): _TItem_;
3121 begin
3122   Result := fItems[Position];
3123 end;
3124 
3125 {--- TGenVector.GetItemPtr ---}
TGenVector.GetItemPtrnull3126 function TGenVector.GetItemPtr(Position: Integer): PItem;
3127 begin
3128   CheckIndex(Position);
3129   Result := @fItems[Position];
3130 end;
3131 
3132 {--- TGenVector.GetItemPtrFast ---}
TGenVector.GetItemPtrFastnull3133 function TGenVector.GetItemPtrFast(Position: Integer): PItem;
3134 begin
3135   Result := @fItems[Position];
3136 end;
3137 
3138 {--- TGenVector.Insert ---}
3139 procedure TGenVector.Insert(Before: Integer; const Item: _TItem_; Count: Integer);
3140 begin
3141   CheckIndexForAdd(Before);
3142 
3143   if Count > 0 then
3144   begin
3145     InsertSpaceFast(Before, Count);
3146     Fill(Before, Count, Item);
3147   end;
3148 end;
3149 
3150 {--- TGenVector.InsertAll ---}
3151 procedure TGenVector.InsertAll(Before: Integer; Src: TGenVector);
3152 begin
3153   if Src.fSize > 0 then
3154     InsertRange(Before, Src, 0, Src.fSize - 1);
3155 end;
3156 
3157 {--- TGenVector.InsertionSort ---}
3158 procedure TGenVector.InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
3159 var
3160   I, J : Integer;
3161   Tmp, Item : _TItem_;
3162 begin
3163   if PosFrom >= PosTo then
3164     Exit;
3165 
3166   for I := PosFrom + 1 to PosTo do
3167   begin
3168     Tmp := fItems[I];
3169 
3170     J := I - 1;
3171     while (J >= PosFrom) do
3172     begin
3173       Item := fItems[J];
3174       if Comparator(Item, Tmp) <= 0 then
3175         Break;
3176       fItems[J + 1] :=  fItems[J];
3177       Dec(J);
3178     end;
3179 
3180     fItems[J + 1] := Tmp;
3181   end;
3182 end;
3183 
3184 {--- TGenVector.Quicksort ---}
3185 procedure TGenVector.Quicksort(Left, Right: Integer; Comparator: TCompareItems);
3186 var
3187   I, J : Integer;
3188   Pivot : _TItem_;
3189 Begin
3190   if Right - Left <= 15 then
3191   begin
3192     InsertionSort(Left, Right, Comparator);
3193     Exit;
3194   end;
3195 
3196   I := Left;
3197   J := Right;
3198   Pivot := fItems[(Left + Right) div 2];
3199   repeat
3200     while Comparator(Pivot, fItems[I]) > 0 do
3201       Inc(I);
3202 
3203     while Comparator(Pivot, fItems[J]) < 0 do
3204       Dec(J);
3205 
3206     if I <= J then
3207     begin
3208       SwapFast(I, J);
3209       Dec(J);
3210       Inc(I);
3211     end;
3212   until I > J;
3213 
3214   if Left < J then
3215     QuickSort(Left, J, Comparator);
3216 
3217   if I < Right then
3218     QuickSort(I, Right, Comparator);
3219 end;
3220 
3221 {--- TGenVector.InsertRange ---}
3222 procedure TGenVector.InsertRange(Before: Integer; Src: TGenVector;
3223   PosFrom, PosTo: Integer);
3224 var
3225   Count : Integer;
3226 begin
3227   CheckIndexForAdd(Before);
3228   Src.CheckIndex(PosFrom);
3229   Src.CheckIndex(PosTo);
3230 
3231   Count := PosTo - PosFrom + 1;
3232   if Count > 0 then
3233   begin
3234     InsertSpaceFast(Before, Count);
3235     RealMove(Src, Self, PosFrom, Before, Count);
3236   end;
3237 end;
3238 
3239 {--- TGenVector.InsertSpaceFast ---}
3240 procedure TGenVector.InsertSpaceFast(Position, Count: Integer);
3241 var
3242   ItemsAfterPos : Integer;
3243 begin
3244   if Count > 0 then
3245   begin
3246     ItemsAfterPos := fSize - Position;
3247     Resize(fSize + Count);
3248     if ItemsAfterPos > 0 then
3249       Move(Position, Position + Count, ItemsAfterPos);
3250   end;
3251 end;
3252 
3253 {--- TGenVector.ItemToString ---}
TGenVector.ItemToStringnull3254 function TGenVector.ItemToString(Index: Integer): String;
3255 begin
3256   Result := fOnItemToString(fItems[Index]);
3257 end;
3258 
3259 {--- TGenVector.IsSorted ---}
IsSortednull3260 function TGenVector.IsSorted : Boolean;
3261 begin
3262   Result := IsSorted(fOnCompareItems);
3263 end;
3264 
3265 {--- TGenVector.IsSorted ---}
IsSortednull3266 function TGenVector.IsSorted(Comparator: TCompareItems): Boolean;
3267 var
3268   I : Integer;
3269 begin
3270   Result := true;
3271 
3272   if fSize > 1 then
3273     for I := 1 to fSize - 1 do
3274       if Comparator(fItems[I], fItems[I - 1]) < 0 then
3275       begin
3276         Result := false;
3277         Break;
3278       end;
3279 end;
3280 
3281 {--- TGenVector.DefaultItemToString ---}
TGenVector.DefaultItemToStringnull3282 function TGenVector.DefaultItemToString(const Item: _TItem_): String;
3283 begin
3284   Unused(@Item);
3285   RaiseMethodNotRedefined;
3286   Result := '';
3287 end;
3288 
3289 {--- TGenVector.Iterate ---}
3290 procedure TGenVector.Iterate(Process: TProcessItem);
3291 begin
3292   Iterate(Process, 0, fSize - 1);
3293 end;
3294 
3295 {--- TGenVector.Iterate ---}
3296 procedure TGenVector.Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
3297 var
3298   I : Integer;
3299   P : PItem;
3300 begin
3301   CheckIndex(PosFrom);
3302   CheckIndex(PosTo);
3303 
3304   P := @fItems[PosFrom];
3305   for I := PosFrom to PosTo do
3306   begin
3307     Process(P^);
3308     P := P + 1;
3309   end;
3310 end;
3311 
3312 {--- TGenVector.LastItem ---}
LastItemnull3313 function TGenVector.LastItem: _TItem_;
3314 begin
3315   if fSize = 0 then
3316     RaiseContainerEmpty;
3317 
3318   Result := fItems[fSize - 1];
3319 end;
3320 
3321 {--- TGenVector.MaxPos ---}
MaxPosnull3322 function TGenVector.MaxPos(PosFrom, PosTo: Integer): Integer;
3323 begin
3324   Result := MaxPos(PosFrom, PosTo, fOnCompareItems);
3325 end;
3326 
3327 {--- TGenVector.MaxPos ---}
MaxPosnull3328 function TGenVector.MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3329 var
3330   I : Integer;
3331   Max : _TItem_;
3332 begin
3333   CheckIndex(PosFrom);
3334   CheckIndex(PosTo);
3335 
3336   if PosTo < PosFrom then
3337   begin
3338     I := PosFrom;
3339     PosFrom := PosTo;
3340     PosTo := I;
3341   end;
3342 
3343   Max := fItems[PosFrom];
3344   Result := PosFrom;
3345   for I := PosFrom + 1 to PosTo do
3346     if Comparator(fItems[I], Max) > 0 then
3347     begin
3348       Result := I;
3349       Max := fItems[I];
3350     end;
3351 end;
3352 
3353 {--- TGenVector.MaxPos ---}
MaxPosnull3354 function TGenVector.MaxPos : Integer;
3355 begin
3356   Result := MaxPos(fOnCompareItems);
3357 end;
3358 
3359 {--- TGenVector.MaxPos ---}
MaxPosnull3360 function TGenVector.MaxPos(Comparator: TCompareItems): Integer;
3361 begin
3362   if fSize = 0 then
3363     RaiseContainerEmpty;
3364 
3365   Result := MaxPos(0, fSize - 1, Comparator);
3366 end;
3367 
3368 {--- TGenVector.Merge ---}
3369 procedure TGenVector.Merge(Src: TGenVector);
3370 begin
3371   Merge(Src, fOnCompareItems);
3372 end;
3373 
3374 {--- TGenVector.Merge ---}
3375 procedure TGenVector.Merge(Src: TGenVector; Comparator: TCompareItems);
3376 var
3377   A, B, C : Integer;
3378 begin
3379   if Src.fSize = 0 then
3380     Exit;
3381 
3382   if fSize = 0 then
3383     AppendAll(Src)
3384   else if Comparator(Src.FirstItem, LastItem) >= 0 then
3385     AppendAll(Src)
3386   else if Comparator(FirstItem, Src.LastItem) >= 0 then
3387     PrependAll(Src)
3388   else
3389   begin
3390     A := fSize - 1;
3391     B := Src.fSize - 1;
3392 
3393     InsertSpace(fSize, Src.fSize);
3394     C := fSize - 1;
3395 
3396     while C > 0 do
3397     begin
3398       if Comparator(fItems[A], Src.fItems[B]) > 0 then
3399       begin
3400         fItems[C] := fItems[A];
3401         Dec(A);
3402         if A < 0 then
3403           Break;
3404       end
3405       else
3406       begin
3407         fItems[C] := Src.fItems[B];
3408         Dec(B);
3409         if B < 0 then
3410           Break;
3411       end;
3412       Dec(C);
3413     end;
3414 
3415     if (C >= 0) and (B >= 0) then
3416       while B >= 0 do
3417       begin
3418         fItems[B] := Src.fItems[B];
3419         Dec(B);
3420       end;
3421 
3422   end;
3423   Src.Clear;
3424 end;
3425 
3426 {--- TGenVector.MinPos ---}
MinPosnull3427 function TGenVector.MinPos(PosFrom, PosTo: Integer): Integer;
3428 begin
3429   Result := MinPos(PosFrom, PosTo, fOnCompareItems);
3430 end;
3431 
3432 {--- TGenVector.MinPos ---}
MinPosnull3433 function TGenVector.MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3434 var
3435   I : Integer;
3436   Min : _TItem_;
3437 begin
3438   CheckIndex(PosFrom);
3439   CheckIndex(PosTo);
3440 
3441   if PosTo < PosFrom then
3442   begin
3443     I := PosFrom;
3444     PosFrom := PosTo;
3445     PosTo := I;
3446   end;
3447 
3448   Result := -1;
3449   Min := fItems[PosFrom];
3450   Result := PosFrom;
3451   for I := PosFrom + 1 to PosTo do
3452     if Comparator(fItems[I], Min) < 0 then
3453     begin
3454       Result := I;
3455       Min := fItems[I];
3456     end;
3457 end;
3458 
3459 {--- TGenVector.MinPos ---}
MinPosnull3460 function TGenVector.MinPos : Integer;
3461 begin
3462   Result := MinPos(fOnCompareItems);
3463 end;
3464 
3465 {--- TGenVector.MinPos ---}
MinPosnull3466 function TGenVector.MinPos(Comparator: TCompareItems): Integer;
3467 begin
3468   if fSize = 0 then
3469     RaiseContainerEmpty;
3470 
3471   Result := MinPos(0, fSize - 1, Comparator);
3472 end;
3473 
3474 {--- TGenVector.Move ---}
3475 procedure TGenVector.Move(Src, Dst, Count: Integer);
3476 begin
3477   CheckIndex(Src);
3478   CheckIndex(Dst);
3479 
3480   if Count > 0 then
3481   begin
3482     if Src + Count > fSize then
3483       Count := fSize - Src;
3484 
3485     if Dst + Count > fSize then
3486       Count := fSize - Dst;
3487 
3488     if Count > 0 then
3489       RealMove(Self, Self, Src, Dst, Count);
3490   end;
3491 end;
3492 
3493 {--- TGenVector.Prepend ---}
3494 procedure TGenVector.Prepend(const Item: _TItem_; Count: Integer);
3495 begin
3496   Insert(0, Item, Count);
3497 end;
3498 
3499 {--- TGenVector.PrependAll ---}
3500 procedure TGenVector.PrependAll(Src: TGenVector);
3501 begin
3502   InsertAll(0, Src);
3503 end;
3504 
3505 {--- TGenVector.PrependRange ---}
3506 procedure TGenVector.PrependRange(Src: TGenVector; PosFrom, PosTo: Integer);
3507 begin
3508   InsertRange(0, Src, PosFrom, PosTo);
3509 end;
3510 
3511 {--- TGenVector.ReadFirstItem ---}
3512 procedure TGenVector.ReadFirstItem(out Value : _TItem_);
3513 begin
3514   if fSize = 0 then
3515     RaiseContainerEmpty;
3516 
3517   Value := fItems[0];
3518 end;
3519 
3520 {--- TGenVector.ReadItem ---}
3521 procedure TGenVector.ReadItem(Position: Integer; out Value: _TItem_);
3522 begin
3523   CheckIndex(Position);
3524   Value := fItems[Position];
3525 end;
3526 
3527 {--- TGenVector.ReadItemFast ---}
3528 procedure TGenVector.ReadItemFast(Position: Integer; out Value: _TItem_);
3529 begin
3530   Value := fItems[Position];
3531 end;
3532 
3533 {--- TGenVector.ReadLastItem ---}
3534 procedure TGenVector.ReadLastItem(out Value : _TItem_);
3535 begin
3536   if fSize = 0 then
3537     RaiseContainerEmpty;
3538 
3539   Value := fItems[fSize - 1];
3540 end;
3541 
3542 {--- TGenVector.Sort ---}
3543 procedure TGenVector.Sort(PosFrom, PosTo: Integer);
3544 begin
3545   Sort(PosFrom, PosTo, fOnCompareItems);
3546 end;
3547 
3548 {--- TGenVector.Sort ---}
3549 procedure TGenVector.Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
3550 begin
3551   CheckIndex(PosFrom);
3552   CheckIndex(PosTo);
3553 
3554   if PosFrom >= PosTo then
3555     Exit;
3556 
3557   Quicksort(PosFrom, PosTo, Comparator);
3558 end;
3559 
3560 {--- TGenVector.Sort ---}
3561 procedure TGenVector.Sort;
3562 begin
3563   Sort(fOnCompareItems);
3564 end;
3565 
3566 {--- TGenVector.Sort ---}
3567 procedure TGenVector.Sort(Comparator: TCompareItems);
3568 begin
3569   if fSize > 1 then
3570     Sort(0, fSize - 1, Comparator);
3571 end;
3572 
3573 {--- TGenVector.RealMove ---}
3574 class procedure TGenVector.RealMove(Src, Dst: TGenVector;
3575   SrcFirst, DstFirst, Count: Integer);
3576 var
3577   SrcLast, I, DstCurrent: Integer;
3578 begin
3579   SrcLast := SrcFirst + Count - 1;
3580   if (Src = Dst) and ( (DstFirst >= SrcFirst) and (DstFirst <= SrcLast) ) then
3581   begin
3582     DstCurrent := DstFirst + Count - 1;
3583     for I := SrcLast downto SrcFirst do
3584     begin
3585       Dst.fItems[DstCurrent] := Src.fItems[I];
3586       Dec(DstCurrent);
3587     end
3588   end
3589   else
3590   begin
3591     DstCurrent := DstFirst;
3592     for I := SrcFirst to SrcLast do
3593     begin
3594       Dst.fItems[DstCurrent] := Src.fItems[I];
3595       Inc(DstCurrent);
3596     end;
3597   end;
3598 end;
3599 
3600 {--- TGenVector.Replace ---}
3601 procedure TGenVector.Replace(Index, Count: Integer; const Value: _TItem_);
3602 begin
3603   CheckIndex(Index);
3604 
3605   if Count > 0 then
3606   begin
3607     if Index + Count >= fSize then
3608       Count := fSize - Index;
3609 
3610     if Count > 0 then
3611       Fill(Index, Count, Value);
3612   end;
3613 end;
3614 
3615 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3616 function TGenVector.ReverseFindIndex(const Item: _TItem_): Integer;
3617 begin
3618   Result := ReverseFindIndex(Item, fOnCompareItems);
3619 end;
3620 
3621 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3622 function TGenVector.ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3623 begin
3624   if fSize = 0 then
3625     Result := -1
3626   else
3627     Result := ReverseFindIndex(Item, fSize - 1, Comparator);
3628 end;
3629 
3630 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3631 function TGenVector.ReverseFindIndex(const Item: _TItem_;
3632   PosFrom: Integer): Integer;
3633 begin
3634   Result := ReverseFindIndex(Item, PosFrom, fOnCompareItems);
3635 end;
3636 
3637 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3638 function TGenVector.ReverseFindIndex(const Item: _TItem_;
3639   PosFrom: Integer; Comparator: TCompareItems): Integer;
3640 var
3641   I: Integer;
3642 begin
3643   CheckIndex(PosFrom);
3644 
3645   Result := -1;
3646   for I := PosFrom downto 0 do
3647     if Comparator(fItems[I], Item) = 0 then
3648     begin
3649       Result := I;
3650       Break;
3651     end;
3652 end;
3653 
3654 {--- TGenVector.SetCapacity ---}
3655 procedure TGenVector.SetCapacity(ACapacity: Integer);
3656 begin
3657   SetLength(fItems, ACapacity);
3658   fCapacity := ACapacity;
3659 end;
3660 
3661 {--- TGenVector.SetOnCompareItems ---}
3662 procedure TGenVector.SetOnCompareItems(AValue: TCompareItems);
3663 begin
3664   if AValue = nil then
3665     fOnCompareItems := @DefaultCompareItems
3666   else
3667     fOnCompareItems := AValue;
3668 end;
3669 
3670 {--- TGenVector.SetOnItemToString ---}
3671 procedure TGenVector.SetOnItemToString(AValue: TItemToString);
3672 begin
3673   if AValue = nil then
3674     fOnItemToString := @DefaultItemToString
3675   else
3676     fOnItemToString := AValue;
3677 end;
3678 
3679 {--- TGenVector.SetItem ---}
3680 procedure TGenVector.SetItem(Position: Integer; const Value: _TItem_);
3681 begin
3682   CheckIndex(Position);
3683   fItems[Position] := Value;
3684 end;
3685 
3686 {--- TGenVector.SetItemFast ---}
3687 procedure TGenVector.SetItemFast(Position: Integer; const Value: _TItem_);
3688 begin
3689   fItems[Position] := Value;
3690 end;
3691 
3692 {--- TGenVector.SwapFast ---}
3693 procedure TGenVector.SwapFast(I, J: Integer);
3694 var
3695   Temp: _TItem_;
3696 begin
3697   Temp := fItems[I];
3698   fItems[I] := fItems[J];
3699   fItems[J] := Temp;
3700 end;
3701 
3702 {=================}
3703 {=== TGenDeque ===}
3704 {=================}
3705 
3706 {--- TGenDeque.Append ---}
3707 procedure TGenDeque.Append(const Item: _TItem_; Count: Integer);
3708 begin
3709   Insert(fSize, Item, Count);
3710 end;
3711 
3712 {--- TGenDeque.AppendAll ---}
3713 procedure TGenDeque.AppendAll(Src: TGenDeque);
3714 begin
3715   InsertAll(fSize, Src);
3716 end;
3717 
3718 {--- TGenDeque.AppendRange ---}
3719 procedure TGenDeque.AppendRange(Src: TGenDeque; PosFrom, PosTo: Integer);
3720 begin
3721   InsertRange(fSize, Src, PosFrom, PosTo);
3722 end;
3723 
3724 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3725 function TGenDeque.BinarySearch(const Item: _TItem_): Integer;
3726 begin
3727   Result := BinarySearch(Item, fOnCompareItems);
3728 end;
3729 
3730 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3731 function TGenDeque.BinarySearch(const Item: _TItem_; Comparator: TCompareItems): Integer;
3732 begin
3733   if fSize > 0 then
3734     Result := BinarySearch(Item, 0, fSize - 1, Comparator)
3735   else
3736     Result := -1;
3737 end;
3738 
3739 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3740 function TGenDeque.BinarySearch(const Item: _TItem_; PosFrom, PosTo: Integer): Integer;
3741 begin
3742   Result := BinarySearch(Item, PosFrom, PosTo, fOnCompareItems);
3743 end;
3744 
3745 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3746 function TGenDeque.BinarySearch(const Item: _TItem_;
3747   PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3748 var
3749   Low, Mid, High, Cmp: Integer;
3750 begin
3751   CheckIndex(PosFrom);
3752   CheckIndex(PosTo);
3753 
3754   Low := PosFrom;
3755   Mid := -1;
3756   High := PosTo;
3757 
3758   while Low <= High do
3759   begin
3760     Mid := (Low + High) div 2;
3761     Cmp := Comparator(fItems[ IndexToRank(Mid) ], Item);
3762 
3763     if Cmp = 0 then
3764     begin
3765       Result := Mid;
3766       Exit;
3767     end;
3768 
3769     if Cmp < 0 then
3770       Low := Mid + 1
3771     else
3772       High := Mid - 1;
3773   end;
3774 
3775   if Mid < 0 then
3776     Result := -1
3777   else if Comparator(fItems[ IndexToRank(Mid) ], Item) > 0 then
3778     Result := - Mid - 1
3779   else
3780     Result := - Mid - 2;
3781 end;
3782 
3783 {--- TGenDeque.DefaultCompareItems ---}
TGenDeque.DefaultCompareItemsnull3784 function TGenDeque.DefaultCompareItems(const A, B: _TItem_): Integer;
3785 begin
3786   Unused(@A);
3787   Unused(@B);
3788   RaiseMethodNotRedefined;
3789   Result := 0;
3790 end;
3791 
3792 {--- TGenDeque.Contains ---}
Containsnull3793 function TGenDeque.Contains(const Item: _TItem_): Boolean;
3794 begin
3795   Result := Contains(Item, fOnCompareItems);
3796 end;
3797 
3798 {--- TGenDeque.Contains ---}
Containsnull3799 function TGenDeque.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
3800 begin
3801   Result := (FindIndex(Item, Comparator) >= 0);
3802 end;
3803 
3804 {--- TGenDeque.Create ---}
3805 constructor TGenDeque.Create(InitialCapacity: Integer);
3806 begin
3807   fSize := 0;
3808 
3809   if InitialCapacity < 0 then
3810     InitialCapacity := 16;
3811 
3812   fCapacity := InitialCapacity;
3813   SetLength(fItems, fCapacity);
3814 
3815   fStart := 0;
3816 
3817   SetOnCompareItems(nil);
3818   SetOnItemToString(nil);
3819 end;
3820 
3821 {--- TGenDeque.Destroy ---}
3822 destructor TGenDeque.Destroy;
3823 begin
3824   SetLength(fItems, 0);
3825   inherited Destroy;
3826 end;
3827 
3828 {--- TGenDeque.DecRank ---}
3829 procedure TGenDeque.DecRank(var Rank: Integer);
3830 begin
3831   if Rank = 0 then
3832     Rank := fCapacity - 1
3833   else
3834     Dec(Rank);
3835 end;
3836 
3837 {--- TGenDeque.Equals ---}
Equalsnull3838 function TGenDeque.Equals(Deque: TGenDeque; Comparator: TCompareItems): Boolean;
3839 var
3840   I, IRank, JRank : Integer;
3841 begin
3842   if fSize <> Deque.fSize then
3843     Result := false
3844   else
3845   begin
3846     Result := true;
3847     IRank := fStart;
3848     JRank := Deque.fStart;
3849     for I := 0 to fSize - 1 do
3850     begin
3851       if Comparator(fItems[IRank], Deque.fItems[JRank]) <> 0 then
3852       begin
3853         Result := false;
3854         Break;
3855       end;
3856       IncRank(IRank);
3857       Deque.IncRank(JRank);
3858     end;
3859   end;
3860 end;
3861 
3862 {--- TGenDeque.EnumeratorGet ---}
EnumeratorGetnull3863 function TGenDeque.EnumeratorGet(const Pos: Integer): _TItem_;
3864 begin
3865   Result := fItems[ IndexToRank(Pos) ];
3866 end;
3867 
3868 {--- TGenDeque.EnumeratorNext ---}
EnumeratorNextnull3869 function TGenDeque.EnumeratorNext(var Pos: Integer): Boolean;
3870 begin
3871   Inc(Pos);
3872   Result := Pos < fSize;
3873 end;
3874 
3875 {--- TGenDeque.Equals ---}
Equalsnull3876 function TGenDeque.Equals(Obj: TObject): Boolean;
3877 begin
3878   Result := Equals(Obj, fOnCompareItems);
3879 end;
3880 
3881 {--- TGenDeque.Equals ---}
Equalsnull3882 function TGenDeque.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
3883 begin
3884   if Obj = Self  then
3885     Result := true
3886   else if Obj is TGenDeque then
3887     Result := Equals(Obj as TGenDeque, Comparator)
3888   else
3889     Result := false;
3890 end;
3891 
3892 {--- TGenDeque.FindIndex ---}
FindIndexnull3893 function TGenDeque.FindIndex(const Item: _TItem_): Integer;
3894 begin
3895   Result := FindIndex(Item, fOnCompareItems);
3896 end;
3897 
3898 {--- TGenDeque.FindIndex ---}
FindIndexnull3899 function TGenDeque.FindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3900 begin
3901   if fSize = 0 then
3902     Result := -1
3903   else
3904     Result := FindIndex(Item, 0, Comparator);
3905 end;
3906 
3907 {--- TGenDeque.Fill ---}
3908 procedure TGenDeque.Fill(Index, Count: Integer; const Value: _TItem_);
3909 begin
3910   Index := IndexToRank(Index);
3911   while Count > 0 do
3912   begin
3913     fItems[Index] := Value;
3914     IncRank(Index);
3915     Dec(Count);
3916   end;
3917 end;
3918 
3919 {--- TGenDeque.FindIndex ---}
FindIndexnull3920 function TGenDeque.FindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
3921 begin
3922   Result := FindIndex(Item, PosFrom, fOnCompareItems);
3923 end;
3924 
3925 {--- TGenDeque.FindIndex ---}
FindIndexnull3926 function TGenDeque.FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems): Integer;
3927 var
3928   I, Pos : Integer;
3929 begin
3930   CheckIndex(PosFrom);
3931 
3932   Result := -1;
3933   Pos := IndexToRank(PosFrom);
3934   for I := PosFrom to fSize - 1 do
3935   begin
3936     if Comparator(fItems[Pos], Item) = 0 then
3937     begin
3938       Result := I;
3939       Break;
3940     end;
3941     IncRank(Pos);
3942   end;
3943 end;
3944 
3945 {--- TGenDeque.FirstItem ---}
FirstItemnull3946 function TGenDeque.FirstItem: _TItem_;
3947 begin
3948   if fSize = 0 then
3949     RaiseContainerEmpty;
3950 
3951   Result := fItems[fStart];
3952 end;
3953 
3954 {--- TGenDeque.GetEnumerator ---}
TGenDeque.GetEnumeratornull3955 function TGenDeque.GetEnumerator: TEnumerator;
3956 begin
3957   Result := TEnumerator.Create(-1, @EnumeratorNext, @EnumeratorGet);
3958 end;
3959 
3960 {--- TGenDeque.GetItem ---}
GetItemnull3961 function TGenDeque.GetItem(Position: Integer): _TItem_;
3962 begin
3963   CheckIndex(Position);
3964   Result := fItems[ IndexToRank(Position)];
3965 end;
3966 
3967 {--- TGenDeque.GetItemPtr ---}
TGenDeque.GetItemPtrnull3968 function TGenDeque.GetItemPtr(Position: Integer): PItem;
3969 begin
3970   CheckIndex(Position);
3971   Result := @fItems[ IndexToRank(Position)];
3972 end;
3973 
3974 {--- TGenDeque.GetItemFast ---}
GetItemFastnull3975 function TGenDeque.GetItemFast(Position: Integer): _TItem_;
3976 begin
3977   Result := fItems[ IndexToRank(Position) ];
3978 end;
3979 
3980 {--- TGenDeque.GetItemPtrFast ---}
GetItemPtrFastnull3981 function TGenDeque.GetItemPtrFast(Position: Integer): PItem;
3982 begin
3983   Result := @fItems[ IndexToRank(Position) ];
3984 end;
3985 
3986 {--- TGenDeque.IncRank ---}
3987 procedure TGenDeque.IncRank(var Rank: Integer);
3988 begin
3989   if Rank = fCapacity - 1 then
3990     Rank := 0
3991   else
3992     Inc(Rank);
3993 end;
3994 
3995 {--- TGenDeque.IncreaseCapacity ---}
3996 procedure TGenDeque.IncreaseCapacity(ACapacity: Integer);
3997 var
3998   Dst : Integer;
3999   ItemsAtBegining, ItemsAtEnd : Integer;
4000 begin
4001   SetLength(fItems, ACapacity);
4002 
4003   if fStart + fSize >= fCapacity then { Are items in 2 parts ? }
4004   begin
4005     ItemsAtEnd := fCapacity - fStart;
4006     ItemsAtBegining := fSize - ItemsAtEnd;
4007 
4008     if ItemsAtEnd < ItemsAtBegining then
4009     begin
4010       Dst := ACapacity - ItemsAtEnd;
4011       RealMoveRank(fStart, Dst, ItemsAtEnd);
4012       fStart := Dst;
4013     end
4014     else
4015     begin
4016       Dst := fStart + ItemsAtEnd;
4017       RealMoveRank(0, Dst, ItemsAtBegining);
4018     end;
4019   end;
4020 
4021   fCapacity := ACapacity;
4022 end;
4023 
4024 {--- TGenDeque.IndexToRank ---}
IndexToRanknull4025 function TGenDeque.IndexToRank(Index: Integer): Integer;
4026 var
4027   AtEnd : Integer;
4028 begin
4029   AtEnd := fCapacity - fStart;
4030   if Index < AtEnd then
4031     Result := fStart + Index
4032   else
4033     Result := Index - AtEnd;
4034 end;
4035 
4036 {--- TGenDeque.Insert ---}
4037 procedure TGenDeque.Insert(Before: Integer; const Item: _TItem_; Count: Integer);
4038 begin
4039   CheckIndexForAdd(Before);
4040 
4041   if Count <= 0 then
4042     Exit;
4043 
4044   InsertSpaceFast(Before, Count);
4045   Fill(Before, Count, Item);
4046 end;
4047 
4048 {--- TGenDeque.InsertAll ---}
4049 procedure TGenDeque.InsertAll(Before: Integer; Src: TGenDeque);
4050 begin
4051   if Src.fSize > 0 then
4052     InsertRange(Before, Src, 0, Src.fSize - 1);
4053 end;
4054 
4055 {--- TGenDeque.InsertionSort ---}
4056 procedure TGenDeque.InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
4057 var
4058   I, J : Integer;
4059   IRank, JRank, NextJRank: Integer;
4060   Tmp, Item : _TItem_;
4061 begin
4062   if PosFrom >= PosTo then
4063     Exit;
4064 
4065   IRank := IndexToRank(PosFrom + 1);
4066   for I := PosFrom + 1 to PosTo do
4067   begin
4068     Tmp := fItems[IRank];
4069 
4070     J := I - 1;
4071     JRank := IRank;
4072     DecRank(JRank);
4073     while (J >= PosFrom) do
4074     begin
4075       Item := fItems[JRank];
4076       if Comparator(Item, Tmp) <= 0 then
4077         Break;
4078       NextJRank := JRank;
4079       IncRank(NextJRank);
4080       fItems[NextJRank] :=  fItems[JRank];
4081       Dec(J);
4082       DecRank(JRank);
4083     end;
4084 
4085     fItems[IndexToRank(J + 1)] := Tmp;
4086     IncRank(IRank);
4087   end;
4088 end;
4089 
4090 {--- TGenDeque.Quicksort ---}
4091 procedure TGenDeque.Quicksort(Left, Right: Integer; Comparator: TCompareItems);
4092 var
4093   I, J : Integer;
4094   Pivot : _TItem_;
4095 Begin
4096   if Right - Left <= 15 then
4097   begin
4098     InsertionSort(Left, Right, Comparator);
4099     Exit;
4100   end;
4101 
4102   I := Left;
4103   J := Right;
4104   Pivot := fItems[ IndexToRank((Left + Right) div 2) ];
4105   repeat
4106     while Comparator(Pivot, fItems[IndexToRank(I)]) > 0 do
4107       Inc(I);
4108 
4109     while Comparator(Pivot, fItems[IndexToRank(J)]) < 0 do
4110       Dec(J);
4111 
4112     if I <= J then
4113     begin
4114       SwapFast(I, J);
4115       Dec(J);
4116       Inc(I);
4117     end;
4118   until I > J;
4119 
4120   if Left < J then
4121     QuickSort(Left, J, Comparator);
4122 
4123   if I < Right then
4124     QuickSort(I, Right, Comparator);
4125 end;
4126 
4127 {--- TGenDeque.InsertRange ---}
4128 procedure TGenDeque.InsertRange(Before: Integer; Src: TGenDeque;
4129   PosFrom, PosTo: Integer);
4130 var
4131   Count : Integer;
4132 begin
4133   CheckIndexForAdd(Before);
4134   Src.CheckIndex(PosFrom);
4135   Src.CheckIndex(PosTo);
4136 
4137   Count := PosTo - PosFrom + 1;
4138   if Count > 0 then
4139   begin
4140     InsertSpaceFast(Before, Count);
4141     RealMoveIndex(Src, Self, PosFrom, Before, Count);
4142   end;
4143 end;
4144 
4145 {--- TGenDeque.InsertSpaceFast ---}
4146 procedure TGenDeque.InsertSpaceFast(Position, Count: Integer);
4147 var
4148   Rank : Integer;
4149   NewStart : Integer;
4150   ItemsToMove : Integer;
4151 begin
4152   if Count <= 0 then
4153     Exit;
4154 
4155   if Position = 0 then
4156   begin
4157     Resize(fSize + Count);
4158 
4159     NewStart := fStart - Count;
4160     if NewStart < 0 then
4161       fStart := fCapacity + NewStart
4162     else
4163       fStart := NewStart;
4164   end
4165   else if Position = fSize then
4166   begin
4167     Resize(fSize + Count);
4168   end
4169   else
4170   begin
4171     Resize(fSize + Count);
4172     Rank := IndexToRank(Position);
4173 
4174     if (Rank >= fStart) and (fStart + fSize > fCapacity) then
4175     begin
4176       ItemsToMove := Rank - fStart;
4177       if ItemsToMove > 0 then
4178         RealMoveRank(fStart, fStart - Count , ItemsToMove);
4179       fStart := fStart - Count;
4180     end
4181     else
4182     begin
4183       ItemsToMove :=  fSize - Position - Count;
4184 
4185       if ItemsToMove > 0 then
4186         RealMoveRank(Rank, Rank + Count, ItemsToMove)
4187     end;
4188   end;
4189 end;
4190 
4191 {--- TGenDeque.ItemToString ---}
TGenDeque.ItemToStringnull4192 function TGenDeque.ItemToString(Index: Integer): String;
4193 begin
4194   Result := fOnItemToString(fItems[IndexToRank(Index)]);
4195 end;
4196 
4197 {--- TGenDeque.RankToIndex ---}
RankToIndexnull4198 function TGenDeque.RankToIndex(Rank: Integer): Integer;
4199 begin
4200   if Rank >= fStart then
4201     Result := Rank - fStart
4202   else
4203     Result := Rank + (fCapacity - fStart);
4204 end;
4205 
4206 {--- TGenDeque.IsSorted ---}
IsSortednull4207 function TGenDeque.IsSorted : Boolean;
4208 begin
4209   Result := IsSorted(fOnCompareItems);
4210 end;
4211 
4212 {--- TGenDeque.IsSorted ---}
IsSortednull4213 function TGenDeque.IsSorted(Comparator: TCompareItems): Boolean;
4214 var
4215   I, Rank, PrevRank: Integer;
4216 begin
4217   Result := true;
4218 
4219   if fSize > 1 then
4220   begin
4221     PrevRank := fStart;
4222     Rank := IndexToRank(1);
4223     for I := 1 to fSize - 1 do
4224     begin
4225       if Comparator(fItems[Rank], fItems[PrevRank]) < 0 then
4226       begin
4227         Result := false;
4228         Break;
4229       end;
4230       PrevRank := Rank;
4231       IncRank(Rank);
4232     end;
4233   end;
4234 end;
4235 
4236 {--- TGenDeque.DefaultItemToString ---}
DefaultItemToStringnull4237 function TGenDeque.DefaultItemToString(const Item: _TItem_): String;
4238 begin
4239   Unused(@Item);
4240   RaiseMethodNotRedefined;
4241   Result := '';
4242 end;
4243 
4244 {--- TGenDeque.Iterate ---}
4245 procedure TGenDeque.Iterate(Process: TProcessItem);
4246 begin
4247   Iterate(Process, 0, fSize - 1);
4248 end;
4249 
4250 {--- TGenDeque.Iterate ---}
4251 procedure TGenDeque.Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
4252 var
4253   I, Rank : Integer;
4254 begin
4255   CheckIndex(PosFrom);
4256   CheckIndex(PosTo);
4257 
4258   Rank := IndexToRank(PosFrom);
4259   for I := PosFrom to PosTo do
4260   begin
4261     Process(fItems[Rank]);
4262     IncRank(Rank);
4263   end;
4264 end;
4265 
4266 {--- TGenDeque.LastItem ---}
LastItemnull4267 function TGenDeque.LastItem: _TItem_;
4268 begin
4269   if fSize = 0 then
4270     RaiseContainerEmpty;
4271 
4272   Result := fItems[ IndexToRank(fSize - 1) ];
4273 end;
4274 
4275 {--- TGenDeque.MaxPos ---}
MaxPosnull4276 function TGenDeque.MaxPos(PosFrom, PosTo: Integer): Integer;
4277 begin
4278   Result := MaxPos(PosFrom, PosTo, fOnCompareItems);
4279 end;
4280 
4281 {--- TGenDeque.MaxPos ---}
MaxPosnull4282 function TGenDeque.MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
4283 var
4284   I, IRank : Integer;
4285   Max : _TItem_;
4286 begin
4287   CheckIndex(PosFrom);
4288   CheckIndex(PosTo);
4289 
4290   if PosTo < PosFrom then
4291   begin
4292     I := PosFrom;
4293     PosFrom := PosTo;
4294     PosTo := I;
4295   end;
4296 
4297   Max := fItems[ IndexToRank(PosFrom) ];
4298   Result := PosFrom;
4299   IRank := IndexToRank(PosFrom + 1);
4300   for I := PosFrom + 1 to PosTo do
4301   begin
4302     if Comparator(fItems[IRank], Max) > 0 then
4303     begin
4304       Result := I;
4305       Max := fItems[IRank];
4306     end;
4307     IncRank(IRank);
4308   end;
4309 end;
4310 
4311 {--- TGenDeque.MaxPos ---}
MaxPosnull4312 function TGenDeque.MaxPos : Integer;
4313 begin
4314   Result := MaxPos(fOnCompareItems);
4315 end;
4316 
4317 {--- TGenDeque.MaxPos ---}
MaxPosnull4318 function TGenDeque.MaxPos(Comparator: TCompareItems): Integer;
4319 begin
4320   if fSize = 0 then
4321     RaiseContainerEmpty;
4322 
4323   Result := MaxPos(0, fSize - 1, Comparator);
4324 end;
4325 
4326 {--- TGenDeque.Merge ---}
4327 procedure TGenDeque.Merge(Src: TGenDeque);
4328 begin
4329   Merge(Src, fOnCompareItems);
4330 end;
4331 
4332 {--- TGenDeque.Merge ---}
4333 procedure TGenDeque.Merge(Src: TGenDeque; Comparator: TCompareItems);
4334 var
4335   A, B, C : Integer;
4336   ARank, BRank, CRank : Integer;
4337 begin
4338   if Src.fSize = 0 then
4339     Exit;
4340 
4341   if fSize = 0 then
4342     AppendAll(Src)
4343   else if Comparator(Src.FirstItem, LastItem) >= 0 then
4344     AppendAll(Src)
4345   else if Comparator(FirstItem, Src.LastItem) >= 0 then
4346     PrependAll(Src)
4347   else
4348   begin
4349     A := fSize - 1;
4350     B := Src.fSize - 1;
4351 
4352     InsertSpace(fSize, Src.fSize);
4353     C := fSize - 1;
4354 
4355     ARank := IndexToRank(A);
4356     BRank := Src.IndexToRank(B);
4357     CRank := IndexToRank(C);
4358 
4359     while C > 0 do
4360     begin
4361       if Comparator(fItems[ARank], Src.fItems[BRank]) > 0 then
4362       begin
4363         fItems[CRank] := fItems[ARank];
4364         Dec(A);
4365         if A < 0 then
4366           Break;
4367         DecRank(ARank);
4368       end
4369       else
4370       begin
4371         fItems[CRank] := Src.fItems[BRank];
4372         Dec(B);
4373         if B < 0 then
4374           Break;
4375         Src.DecRank(BRank);
4376       end;
4377       Dec(C);
4378       DecRank(CRank);
4379     end;
4380 
4381     if (C >= 0) and (B >= 0) then
4382     begin
4383       BRank := Src.IndexToRank(B);
4384       ARank := IndexToRank(B);
4385       while B >= 0 do
4386       begin
4387         fItems[ARank] := Src.fItems[BRank];
4388         Dec(B);
4389         DecRank(BRank);
4390         DecRank(ARank);
4391       end;
4392     end;
4393 
4394   end;
4395   Src.Clear;
4396 end;
4397 
4398 {--- TGenDeque.MinPos ---}
MinPosnull4399 function TGenDeque.MinPos(PosFrom, PosTo: Integer): Integer;
4400 begin
4401   Result := MinPos(PosFrom, PosTo, fOnCompareItems);
4402 end;
4403 
4404 {--- TGenDeque.MinPos ---}
MinPosnull4405 function TGenDeque.MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
4406 var
4407   I, IRank : Integer;
4408   Min : _TItem_;
4409 begin
4410   CheckIndex(PosFrom);
4411   CheckIndex(PosTo);
4412 
4413   if PosTo < PosFrom then
4414   begin
4415     I := PosFrom;
4416     PosFrom := PosTo;
4417     PosTo := I;
4418   end;
4419 
4420   Result := -1;
4421   Min := fItems[ IndexToRank(PosFrom) ];
4422   Result := PosFrom;
4423   IRank := IndexToRank(PosFrom + 1);
4424   for I := PosFrom + 1 to PosTo do
4425   begin
4426     if Comparator(fItems[IRank], Min) < 0 then
4427     begin
4428       Result := I;
4429       Min := fItems[IRank];
4430     end;
4431     IncRank(IRank);
4432   end;
4433 end;
4434 
4435 {--- TGenDeque.MinPos ---}
MinPosnull4436 function TGenDeque.MinPos: Integer;
4437 begin
4438   Result := MinPos(fOnCompareItems);
4439 end;
4440 
4441 {--- TGenDeque.MinPos ---}
MinPosnull4442 function TGenDeque.MinPos(Comparator: TCompareItems): Integer;
4443 begin
4444   if fSize = 0 then
4445     RaiseContainerEmpty;
4446 
4447   Result := MinPos(0, fSize - 1, Comparator);
4448 end;
4449 
4450 {--- TGenDeque.Move ---}
4451 procedure TGenDeque.Move(Src, Dst, Count: Integer);
4452 var
4453   I: Integer;
4454 begin
4455   CheckIndex(Src);
4456   CheckIndex(Dst);
4457 
4458   if Src + Count > fSize then
4459     Count := fSize - Src;
4460 
4461   if Dst + Count > fSize then
4462     Count := fSize - Dst;
4463 
4464   if Count > 0 then
4465   begin
4466     if (Dst >= Src) and (Dst <= Src + Count - 1) then
4467     begin
4468       Dst := Dst + Count - 1;
4469       Src := Src + Count - 1;
4470 
4471       Dst := IndexToRank(Dst);
4472       Src := IndexToRank(Src);
4473 
4474       for I := 1 to Count do
4475       begin
4476         fItems[Dst] := fItems[Src];
4477         DecRank(Src);
4478         DecRank(Dst);
4479       end;
4480     end
4481     else
4482     begin
4483       Dst := IndexToRank(Dst);
4484       Src := IndexToRank(Src);
4485 
4486       for I := 1 to Count do
4487       begin
4488         fItems[Dst] := fItems[Src];
4489         IncRank(Src);
4490         IncRank(Dst);
4491       end;
4492     end;
4493   end;
4494 end;
4495 
4496 {--- TGenDeque.Prepend ---}
4497 procedure TGenDeque.Prepend(const Item: _TItem_; Count: Integer);
4498 begin
4499   Insert(0, Item, Count);
4500 end;
4501 
4502 {--- TGenDeque.PrependAll ---}
4503 procedure TGenDeque.PrependAll(Src: TGenDeque);
4504 begin
4505   InsertAll(0, Src);
4506 end;
4507 
4508 {--- TGenDeque.PrependRange ---}
4509 procedure TGenDeque.PrependRange(Src: TGenDeque; PosFrom, PosTo: Integer);
4510 begin
4511   InsertRange(0, Src, PosFrom, PosTo);
4512 end;
4513 
4514 {--- TGenDeque.ReadFirstItem ---}
4515 procedure TGenDeque.ReadFirstItem(out Value : _TItem_);
4516 begin
4517   if fSize = 0 then
4518     RaiseContainerEmpty;
4519 
4520   Value := fItems[fStart];
4521 end;
4522 
4523 {--- TGenDeque.ReadItem ---}
4524 procedure TGenDeque.ReadItem(Position: Integer; out Value: _TItem_);
4525 begin
4526   CheckIndex(Position);
4527   Value := fItems[ IndexToRank(Position)];
4528 end;
4529 
4530 {--- TGenDeque.ReadItemFast ---}
4531 procedure TGenDeque.ReadItemFast(Position: Integer; out Value: _TItem_);
4532 begin
4533   Value := fItems[ IndexToRank(Position)];
4534 end;
4535 
4536 {--- TGenDeque.ReadLastItem ---}
4537 procedure TGenDeque.ReadLastItem(out Value : _TItem_);
4538 begin
4539   if fSize = 0 then
4540     RaiseContainerEmpty;
4541 
4542   Value := fItems[ IndexToRank(fSize - 1) ];
4543 end;
4544 
4545 {--- TGenDeque.Sort ---}
4546 procedure TGenDeque.Sort(PosFrom, PosTo: Integer);
4547 begin
4548   Sort(PosFrom, PosTo, fOnCompareItems);
4549 end;
4550 
4551 {--- TGenDeque.Sort ---}
4552 procedure TGenDeque.Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
4553 begin
4554   CheckIndex(PosFrom);
4555   CheckIndex(PosTo);
4556 
4557   if PosFrom >= PosTo then
4558     Exit;
4559 
4560   Quicksort(PosFrom, PosTo, Comparator);
4561 end;
4562 
4563 {--- TGenDeque.Sort ---}
4564 procedure TGenDeque.Sort;
4565 begin
4566   Sort(fOnCompareItems);
4567 end;
4568 
4569 {--- TGenDeque.Sort ---}
4570 procedure TGenDeque.Sort(Comparator: TCompareItems);
4571 begin
4572   if fSize > 1 then
4573     Sort(0, fSize - 1, Comparator);
4574 end;
4575 
4576 {--- TGenDeque.RealMoveRank ---}
4577 procedure TGenDeque.RealMoveRank(Src, Dst, Count: Integer);
4578 var
4579   SrcLast, I, DstCurrent: Integer;
4580 begin
4581   if Count <= 0 then
4582     Exit;
4583 
4584   SrcLast := Src + Count - 1;
4585   if (Dst >= Src) and (Dst <= SrcLast) then
4586   begin
4587     DstCurrent := Dst + Count - 1;
4588     for I := SrcLast downto Src do
4589     begin
4590       fItems[DstCurrent] := fItems[I];
4591       Dec(DstCurrent);
4592     end
4593   end
4594   else
4595   begin
4596     DstCurrent := Dst;
4597     for I := Src to SrcLast do
4598     begin
4599       fItems[DstCurrent] := fItems[I];
4600       Inc(DstCurrent);
4601     end;
4602   end;
4603 end;
4604 
4605 {--- TGenDeque.RealMoveIndex ---}
4606 class procedure TGenDeque.RealMoveIndex(Src, Dst: TGenDeque;
4607   SrcFirst, DstFirst, Count: Integer);
4608 var
4609   SrcLast, I, DstCurrent: Integer;
4610 begin
4611   SrcLast := SrcFirst + Count - 1;
4612   if (Src = Dst) and ( (DstFirst >= SrcFirst) and (DstFirst <= SrcLast) ) then
4613   begin
4614     DstCurrent := DstFirst + Count - 1;
4615     for I := SrcLast downto SrcFirst do
4616     begin
4617       Dst[DstCurrent] := Src[I];
4618       Dec(DstCurrent);
4619     end
4620   end
4621   else
4622   begin
4623     DstCurrent := DstFirst;
4624     for I := SrcFirst to SrcLast do
4625     begin
4626       Dst[DstCurrent] := Src[I];
4627       Inc(DstCurrent);
4628     end;
4629   end;
4630 end;
4631 
4632 {--- TGenDeque.ReduceCapacity ---}
4633 procedure TGenDeque.ReduceCapacity(ACapacity: Integer);
4634 var
4635   NewStart, ItemsAtEnd : Integer;
4636 begin
4637   if fStart + fSize >= fCapacity then
4638   begin
4639     ItemsAtEnd := fCapacity - fStart;
4640     NewStart := ACapacity - ItemsAtEnd;
4641     RealMoveRank(fStart, NewStart, ItemsAtEnd);
4642     fStart := NewStart;
4643   end;
4644 
4645   SetLength(fItems, ACapacity);
4646   fCapacity := ACapacity;
4647 end;
4648 
4649 {--- TGenDeque.Replace ---}
4650 procedure TGenDeque.Replace(Index, Count: Integer; const Value: _TItem_);
4651 begin
4652   CheckIndex(Index);
4653 
4654   if Count > 0 then
4655   begin
4656     if Index + Count >= fSize then
4657       Count := fSize - Index;
4658     Fill(Index, Count, Value);
4659   end;
4660 end;
4661 
4662 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4663 function TGenDeque.ReverseFindIndex(const Item: _TItem_): Integer;
4664 begin
4665   Result := ReverseFindIndex(Item, fOnCompareItems);
4666 end;
4667 
4668 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4669 function TGenDeque.ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
4670 begin
4671   if fSize = 0 then
4672     Result := -1
4673   else
4674     Result := ReverseFindIndex(Item, fSize - 1, Comparator);
4675 end;
4676 
4677 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4678 function TGenDeque.ReverseFindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
4679 begin
4680   Result := ReverseFindIndex(Item, PosFrom, fOnCompareItems);
4681 end;
4682 
4683 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4684 function TGenDeque.ReverseFindIndex(const Item: _TItem_;
4685   PosFrom: Integer; Comparator: TCompareItems): Integer;
4686 var
4687   I, Pos: Integer;
4688 begin
4689   CheckIndex(PosFrom);
4690 
4691   Result := -1;
4692   Pos := IndexToRank(PosFrom);
4693   for I := PosFrom downto 0 do
4694   begin
4695     if Comparator(fItems[Pos], Item) = 0 then
4696     begin
4697       Result := I;
4698       Break;
4699     end;
4700     DecRank(Pos);
4701   end;
4702 end;
4703 
4704 {--- TGenDeque.SetCapacity ---}
4705 procedure TGenDeque.SetCapacity(ACapacity: Integer);
4706 begin
4707   if ACapacity <= fCapacity then
4708     ReduceCapacity(ACapacity)
4709   else if ACapacity > fCapacity then
4710     IncreaseCapacity(ACapacity);
4711 end;
4712 
4713 {--- TGenDeque.SetOnCompareItems ---}
4714 procedure TGenDeque.SetOnCompareItems(AValue: TCompareItems);
4715 begin
4716   if AValue = nil then
4717     fOnCompareItems := @DefaultCompareItems
4718   else
4719     fOnCompareItems := AValue;
4720 end;
4721 
4722 {--- TGenDeque.SetOnItemToString ---}
4723 procedure TGenDeque.SetOnItemToString(AValue: TItemToString);
4724 begin
4725   if AValue = nil then
4726     fOnItemToString := @DefaultItemToString
4727   else
4728     fOnItemToString := AValue;
4729 end;
4730 
4731 {--- TGenDeque.SetItem ---}
4732 procedure TGenDeque.SetItem(Position: Integer; const Value: _TItem_);
4733 begin
4734   CheckIndex(Position);
4735   fItems[ IndexToRank(Position) ] := Value;
4736 end;
4737 
4738 {--- TGenDeque.SetItemFast ---}
4739 procedure TGenDeque.SetItemFast(Position: Integer; const Value: _TItem_);
4740 begin
4741   fItems[ IndexToRank(Position) ] := Value;
4742 end;
4743 
4744 {--- TGenDeque.SwapFast ---}
4745 procedure TGenDeque.SwapFast(I, J: Integer);
4746 var
4747   Temp: _TItem_;
4748 begin
4749   I := IndexToRank(I);
4750   J := IndexToRank(J);
4751 
4752   Temp := fItems[I];
4753   fItems[I] := fItems[J];
4754   fItems[J] := Temp;
4755 end;
4756 
4757 {===================}
4758 {=== TListCursor ===}
4759 {===================}
4760 
4761 {--- TListCursor.Equals ---}
Equalsnull4762 function TListCursor.Equals(const Cursor: TListCursor): Boolean;
4763 begin
4764   Result := (fList = Cursor.fList) and (fNode = Cursor.fNode);
4765 end;
4766 
4767 {--- TListCursor.HasItem ---}
HasItemnull4768 function TListCursor.HasItem: Boolean;
4769 begin
4770   Result := (fNode <> nil);
4771 end;
4772 
4773 {--- TListCursor.Init ---}
4774 constructor TListCursor.Init(AList: TAbstractList; ANode: Pointer);
4775 begin
4776   fList := AList;
4777   fNode := ANode;
4778 end;
4779 
4780 {--- TListCursor.IsFirst ---}
TListCursor.IsFirstnull4781 function TListCursor.IsFirst: Boolean;
4782 begin
4783   Result := fList.CursorIsFirst(Self);
4784 end;
4785 
4786 {--- TListCursor.IsLast ---}
IsLastnull4787 function TListCursor.IsLast: Boolean;
4788 begin
4789   Result := fList.CursorIsLast(Self);
4790 end;
4791 
4792 {--- TListCursor.IsNil ---}
TListCursor.IsNilnull4793 function TListCursor.IsNil: Boolean;
4794 begin
4795   Result := (fNode = nil);
4796 end;
4797 
4798 {--- TListCursor.MoveNext ---}
4799 procedure TListCursor.MoveNext;
4800 begin
4801   fList.CursorMoveNext(Self);
4802 end;
4803 
4804 {--- TListCursor.MovePrevious ---}
4805 procedure TListCursor.MovePrevious;
4806 begin
4807   fList.CursorMovePrev(Self);
4808 end;
4809 
4810 {=====================}
4811 {=== TAbstractList ===}
4812 {=====================}
4813 
4814 {--- TAbstractList.CheckValid ---}
4815 procedure TAbstractList.CheckValid(const Cursor: TListCursor);
4816 begin
4817   if Cursor.List <> Self then
4818     RaiseCursorDenotesWrongContainer;
4819 end;
4820 
4821 {--- TAbstractList.CheckNotNil ---}
4822 procedure TAbstractList.CheckNotNil(const Cursor: TListCursor);
4823 begin
4824   CheckValid(Cursor);
4825   if Cursor.IsNil then
4826     RaiseCursorIsNil;
4827 end;
4828 
4829 {================}
4830 {=== TGenList ===}
4831 {================}
4832 
4833 {--- TGenList.Append ---}
4834 procedure TGenList.Append(const Item: _TItem_; Count: Integer);
4835 begin
4836   Insert(fNilCursor, Item, Count);
4837 end;
4838 
4839 {--- TGenList.AppendAll ---}
4840 procedure TGenList.AppendAll(Src: TGenList);
4841 begin
4842   InsertAll(fNilCursor, Src);
4843 end;
4844 
4845 {--- TGenList.AppendRange ---}
4846 procedure TGenList.AppendRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
4847 begin
4848   InsertRange(fNilCursor, Src, PosFrom, PosTo);
4849 end;
4850 
4851 {--- TGenList.Clear ---}
4852 procedure TGenList.Clear;
4853 begin
4854   DeleteFirst(fSize);
4855 end;
4856 
4857 {--- TGenList.DefaultCompareItems ---}
TGenList.DefaultCompareItemsnull4858 function TGenList.DefaultCompareItems(const A, B: _TItem_): Integer;
4859 begin
4860   Unused(@A);
4861   Unused(@B);
4862   RaiseMethodNotRedefined;
4863   Result := 0;
4864 end;
4865 
4866 {--- TGenList.Contains ---}
Containsnull4867 function TGenList.Contains(const Item: _TItem_): Boolean;
4868 begin
4869   Result := Contains(Item, fOnCompareItems);
4870 end;
4871 
4872 {--- TGenList.Contains ---}
Containsnull4873 function TGenList.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
4874 begin
4875   Result := not Find(Item, Comparator).IsNil;
4876 end;
4877 
4878 {--- TGenList.Create ---}
4879 constructor TGenList.Create;
4880 begin
4881   inherited Create;
4882 
4883   New(fHead);
4884   New(fTail);
4885   fHead^.Next := fTail;
4886   fTail^.Previous := fHead;
4887 
4888   fNilCursor.Init(Self, nil);
4889 
4890   SetOnCompareItems(nil);
4891   SetOnItemToString(nil);
4892 end;
4893 
4894 {--- TGenList.Delete ---}
4895 procedure TGenList.Delete(var Position: TListCursor; Count: Integer);
4896 begin
4897   CheckNotNil(Position);
4898   DeleteNodesForward(PNode(Position.Node), Count);
4899   Position := fNilCursor;
4900 end;
4901 
4902 {--- TGenList.DeleteFirst ---}
4903 procedure TGenList.DeleteFirst(Count: Integer);
4904 begin
4905   if (fSize > 0) and (Count > 0) then
4906     DeleteNodesForward(fHead^.Next, Count);
4907 end;
4908 
4909 {--- TGenList.DeleteLast ---}
4910 procedure TGenList.DeleteLast(Count: Integer);
4911 begin
4912   if (fSize > 0) and (Count > 0) then
4913     DeleteNodesBackward(fTail^.Previous, Count);
4914 end;
4915 
4916 {--- TGenList.DeleteNodesBackward ---}
4917 procedure TGenList.DeleteNodesBackward(From: PNode; Count: Integer);
4918 var
4919   Current, AfterFrom : PNode;
4920 begin
4921   AfterFrom := From^.Next;
4922 
4923   Current := From;
4924   while (Count > 0) and (Current <> fHead) do
4925   begin
4926     Current^.Previous^.Next := AfterFrom;
4927     AfterFrom^.Previous := Current^.Previous;
4928 
4929     Dispose(Current);
4930     Dec(fSize);
4931     Dec(Count);
4932     Current := AfterFrom^.Previous;
4933   end;
4934 end;
4935 
4936 {--- TGenList.DeleteNodesBetween ---}
4937 procedure TGenList.DeleteNodesBetween(NodeFrom, NodeTo: PNode);
4938 var
4939   Current, Previous, Limit: PNode;
4940 begin
4941   Current := NodeFrom;
4942   Previous := Current^.Previous;
4943   Limit := NodeTo^.Next;
4944 
4945   while Current <> Limit do
4946   begin
4947     Previous^.Next := Current^.Next;
4948     Current^.Next^.Previous := Previous;
4949 
4950     Dispose(Current);
4951     Dec(fSize);
4952     Current := Previous^.Next;
4953   end;
4954 end;
4955 
4956 {--- TGenList.DeleteNodesForward ---}
4957 procedure TGenList.DeleteNodesForward(From: PNode; Count: Integer);
4958 var
4959   Current, BeforeFrom : PNode;
4960 begin
4961   BeforeFrom := From^.Previous;
4962   Current := From;
4963   while (Count > 0) and (Current <> fTail) do
4964   begin
4965     BeforeFrom^.Next := Current^.Next;
4966     Current^.Next^.Previous := BeforeFrom;
4967 
4968     Dispose(Current);
4969     Dec(fSize);
4970     Dec(Count);
4971     Current := BeforeFrom^.Next;
4972   end;
4973 end;
4974 
4975 {--- TGenList.EnumeratorGet ---}
EnumeratorGetnull4976 function TGenList.EnumeratorGet(const Pos: TListCursor): _TItem_;
4977 begin
4978   ReadItemFast(Pos, Result);
4979 end;
4980 
4981 {--- TGenList.EnumeratorNext ---}
EnumeratorNextnull4982 function TGenList.EnumeratorNext(var Pos: TListCursor): Boolean;
4983 begin
4984   if Pos.IsNil then
4985     Pos := First
4986   else
4987     Pos.MoveNext;
4988   Result := Pos.HasItem;
4989 end;
4990 
4991 {--- TGenList.DeleteRange ---}
4992 procedure TGenList.DeleteRange(const PosFrom, PosTo: TListCursor);
4993 begin
4994   CheckNotNil(PosFrom);
4995   CheckNotNil(PosTo);
4996   DeleteNodesBetween(PosFrom.Node, PosTo.Node);
4997 end;
4998 
4999 {--- TGenList.Destroy ---}
5000 destructor TGenList.Destroy;
5001 begin
5002   Clear;
5003   Dispose(fHead);
5004   Dispose(fTail);
5005   inherited Destroy;
5006 end;
5007 
5008 {--- TGenList.Equals ---}
Equalsnull5009 function TGenList.Equals(List: TGenList; Comparator: TCompareItems): Boolean;
5010 var
5011   N1, N2 : PNode;
5012 begin
5013   if fSize <> List.fSize then
5014   begin
5015     Result := false;
5016     Exit;
5017   end;
5018 
5019   Result := true;
5020   N1 := fHead^.Next;
5021   N2 := List.fHead^.Next;
5022 
5023   while N1 <> fTail do
5024   begin
5025     if Comparator(N1^.Item, N2^.Item) <> 0 then
5026     begin
5027       Result := false;
5028       Break;
5029     end;
5030     N1 := N1^.Next;
5031     N2 := N2^.Next;
5032   end;
5033 end;
5034 
5035 {--- TGenList.Equals ---}
Equalsnull5036 function TGenList.Equals(Obj: TObject): Boolean;
5037 begin
5038   Result := Equals(Obj, fOnCompareItems);
5039 end;
5040 
5041 {--- TGenList.Equals ---}
Equalsnull5042 function TGenList.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
5043 begin
5044   if Obj = Self  then
5045     Result := true
5046   else if Obj is TGenList then
5047     Result := Equals(Obj as TGenList, Comparator)
5048   else
5049     Result := false;
5050 end;
5051 
5052 {--- TGenList.Find ---}
Findnull5053 function TGenList.Find(const Item: _TItem_): TListCursor;
5054 begin
5055   Result := Find(Item, fOnCompareItems);
5056 end;
5057 
5058 {--- TGenList.Find ---}
Findnull5059 function TGenList.Find(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
5060 begin
5061   if fSize = 0 then
5062     Result := fNilCursor
5063   else
5064     Result := Find(Item, First, Comparator);
5065 end;
5066 
5067 {--- TGenList.Find ---}
Findnull5068 function TGenList.Find(const Item: _TItem_; const Position: TListCursor): TListCursor;
5069 begin
5070   Result := Find(Item, Position, fOnCompareItems);
5071 end;
5072 
5073 {--- TGenList.Find ---}
Findnull5074 function TGenList.Find(const Item: _TItem_; const Position: TListCursor; Comparator: TCompareItems): TListCursor;
5075 var
5076   Node : PNode;
5077   I : _TItem_;
5078 begin
5079   CheckValid(Position);
5080 
5081   if Position.IsNil then
5082     Node := fHead^.Next
5083   else
5084     Node := Position.Node;
5085 
5086   while Node <> fTail do
5087   begin
5088     I := Node^.Item;
5089     if Comparator(Item, I) = 0 then
5090       Break;
5091     Node := Node^.Next;
5092   end;
5093 
5094   if (Node = fTail) or (Node = fHead) then
5095     Node := nil;
5096 
5097   Result.Init(Self, Node);
5098 end;
5099 
5100 {--- TGenList.First ---}
TGenList.Firstnull5101 function TGenList.First: TListCursor;
5102 begin
5103   if fSize > 0 then
5104     Result.Init(Self, fHead^.Next)
5105   else
5106     Result := fNilCursor;
5107 end;
5108 
5109 {--- TGenList.FirstItem ---}
FirstItemnull5110 function TGenList.FirstItem: _TItem_;
5111 begin
5112   if fSize = 0 then
5113     RaiseContainerEmpty;
5114 
5115   Result := fHead^.Next^.Item;
5116 end;
5117 
5118 {--- TGenList.GetCursor ---}
GetCursornull5119 function TGenList.GetCursor(Index: Integer): TListCursor;
5120 var
5121   DistanceFromHead, DistanceFromTail : LongInt;
5122   Node : PNode;
5123 begin
5124   if (Index < -1) or (Index > fSize) then
5125     Result := fNilCursor
5126   else
5127   begin
5128     DistanceFromHead := Index + 1;
5129     DistanceFromTail := fSize - Index;
5130 
5131     if DistanceFromHead < DistanceFromTail then
5132     begin
5133       Node := fHead;
5134       while DistanceFromHead > 0 do
5135       begin
5136         Node := Node^.Next;
5137         Dec(DistanceFromHead);
5138       end;
5139     end
5140     else
5141     begin
5142       Node := fTail;
5143       while DistanceFromTail > 0 do
5144       begin
5145         Node := Node^.Previous;
5146         Dec(DistanceFromTail);
5147       end;
5148     end;
5149 
5150     Result.Init(Self, Node);
5151   end;
5152 end;
5153 
5154 {--- TGenList.GetEnumerator ---}
TGenList.GetEnumeratornull5155 function TGenList.GetEnumerator: TEnumerator;
5156 begin
5157   Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
5158 end;
5159 
5160 {--- TGenList.GetItem ---}
GetItemnull5161 function TGenList.GetItem(const Position: TListCursor): _TItem_;
5162 begin
5163   CheckNotNil(Position);
5164   Result := PNode(Position.Node)^.Item;
5165 end;
5166 
5167 {--- TGenList.GetItemFast ---}
GetItemFastnull5168 function TGenList.GetItemFast(const Position: TListCursor): _TItem_;
5169 begin
5170   Result := PNode(Position.Node)^.Item;
5171 end;
5172 
5173 {--- TGenList.GetItemFast ---}
GetItemPtrnull5174 function TGenList.GetItemPtr(const Position: TListCursor): PItem;
5175 begin
5176   CheckNotNil(Position);
5177   Result := @PNode(Position.Node)^.Item;
5178 end;
5179 
5180 {--- TGenList.GetItemFast ---}
TGenList.GetItemPtrFastnull5181 function TGenList.GetItemPtrFast(const Position: TListCursor): PItem;
5182 begin
5183   Result := @PNode(Position.Node)^.Item;
5184 end;
5185 
5186 {--- TGenList.Insert ---}
5187 procedure TGenList.Insert(const Before: TListCursor; const Item: _TItem_;
5188   Count: Integer);
5189 var
5190   BeforeNode : PNode;
5191 begin
5192   CheckValid(Before);
5193 
5194   if Before.HasItem then
5195     BeforeNode := PNode(Before.Node)
5196   else
5197     BeforeNode := fTail;
5198 
5199   InsertItem(Item, BeforeNode, Count);
5200 end;
5201 
5202 {--- TGenList.Insert ---}
5203 procedure TGenList.Insert(const Before: TListCursor; const Item: _TItem_;
5204   out Position: TListCursor; Count: Integer);
5205 var
5206   Prev, BeforeNode : PNode;
5207 begin
5208   CheckValid(Before);
5209 
5210   if Before.HasItem then
5211     BeforeNode := PNode(Before.Node)
5212   else
5213     BeforeNode := fTail;
5214 
5215   Prev := BeforeNode^.Previous;
5216 
5217   InsertItem(Item, BeforeNode, Count);
5218 
5219   Position.Init(Self, Prev^.Next);
5220 end;
5221 
5222 {--- TGenList.InsertAll ---}
5223 procedure TGenList.InsertAll(const Before: TListCursor; Src: TGenList);
5224 begin
5225   if Src.fSize > 0 then
5226     InsertRange(Before, Src, Src.First, Src.Last);
5227 end;
5228 
5229 {--- TGenList.InsertItem ---}
5230 procedure TGenList.InsertItem(const Item: _TItem_; Pos: PNode; Count: Integer);
5231 var
5232   Node : PNode;
5233 begin
5234   while Count > 0 do
5235   begin
5236     New(Node);
5237     Node^.Item := Item;
5238 
5239     Pos^.Previous^.Next := Node;
5240 
5241     Node^.Previous := Pos^.Previous;
5242     Node^.Next := Pos;
5243 
5244     Pos^.Previous := Node;
5245 
5246     Inc(fSize);
5247     Dec(Count);
5248   end;
5249 end;
5250 
5251 {--- TGenList.InsertRange ---}
5252 procedure TGenList.InsertRange(const Before : TListCursor; Src: TGenList;
5253   const PosFrom, PosTo: TListCursor);
5254 var
5255   Copy: TGenList;
5256   Node, LastNode: PNode;
5257 begin
5258   CheckValid(Before);
5259   Src.CheckNotNil(PosFrom);
5260   Src.CheckNotNil(PosTo);
5261 
5262   Copy := TGenList.Create;
5263   try
5264     Node := PNode(PosFrom.Node);
5265     LastNode := PNode(PosTo.Node)^.Next;
5266 
5267     while Node <> LastNode do
5268     begin
5269       Copy.Append(Node^.Item);
5270       Node := Node^.Next;
5271     end;
5272 
5273     Splice(Before, Copy);
5274   finally
5275     Copy.Free;
5276   end;
5277 end;
5278 
5279 {--- TGenList.IsEmpty ---}
IsEmptynull5280 function TGenList.IsEmpty: Boolean;
5281 begin
5282   Result := (fSize = 0);
5283 end;
5284 
5285 {--- TGenList.IsSorted ---}
IsSortednull5286 function TGenList.IsSorted : Boolean;
5287 begin
5288   Result := IsSorted(fOnCompareItems);
5289 end;
5290 
5291 {--- TGenList.IsSorted ---}
IsSortednull5292 function TGenList.IsSorted(Comparator: TCompareItems) : Boolean;
5293 var
5294   N : PNode;
5295   I : Integer;
5296 begin
5297   Result := true;
5298 
5299   N := fHead^.Next;
5300   for I := 2 to fSize do
5301   begin
5302     if Comparator(N^.Item, N^.Next^.Item) > 0 then
5303     begin
5304       Result := false;
5305       Break;
5306     end;
5307     N := N^.Next;
5308   end;
5309 end;
5310 
5311 {--- TGenList.DefaultItemToString ---}
DefaultItemToStringnull5312 function TGenList.DefaultItemToString(const Item: _TItem_): String;
5313 begin
5314   Unused(@Item);
5315   RaiseMethodNotRedefined;
5316   Result := '';
5317 end;
5318 
5319 {--- TGenList.Iterate ---}
5320 procedure TGenList.Iterate(Process: TProcessItem);
5321 begin
5322   if fSize > 0 then
5323     Iterate(Process, First, Last);
5324 end;
5325 
5326 {--- TGenList.Iterate ---}
5327 procedure TGenList.Iterate(Process: TProcessItem; const PosFrom, PosTo: TListCursor);
5328 var
5329   Node, Limit : PNode;
5330 begin
5331   CheckNotNil(PosFrom);
5332   CheckNotNil(PosTo);
5333 
5334   Node := PNode(PosFrom.Node);
5335   Limit := PNode(PosTo.Node)^.Next ;
5336 
5337   while Node <> Limit do
5338   begin
5339     Process(Node^.Item);
5340     Node := Node^.Next;
5341   end;
5342 end;
5343 
5344 {--- TGenList.Last ---}
Lastnull5345 function TGenList.Last: TListCursor;
5346 begin
5347   if fSize > 0 then
5348     Result.Init(Self, fTail^.Previous)
5349   else
5350     Result.Init(Self, nil);
5351 end;
5352 
5353 {--- TGenList.LastItem ---}
LastItemnull5354 function TGenList.LastItem: _TItem_;
5355 begin
5356   if fSize = 0 then
5357     RaiseContainerEmpty;
5358 
5359   Result := fTail^.Previous^.Item;
5360 end;
5361 
5362 {--- TGenList.Merge ---}
5363 procedure TGenList.Merge(Src: TGenList);
5364 begin
5365   Merge(Src, fOnCompareItems);
5366 end;
5367 
5368 {--- TGenList.Merge ---}
5369 procedure TGenList.Merge(Src: TGenList; Comparator: TCompareItems);
5370 var
5371   Node, SrcNode, N : PNode;
5372 begin
5373   if Src = Self then
5374     Exit;
5375 
5376   Node := fHead^.Next;
5377   SrcNode := Src.fHead^.Next;
5378 
5379   while SrcNode <> Src.fTail do
5380   begin
5381     if Node = fTail then
5382     begin
5383       SpliceNodes(fTail, SrcNode, SrcNode);
5384       fSize := fSize + Src.fSize;
5385       Src.fSize := 0;
5386       Break;
5387     end;
5388 
5389     if Comparator(SrcNode^.Item, Node^.Item) < 0 then
5390     begin
5391       N := SrcNode^.Next;
5392       SpliceNodes(Node, SrcNode, SrcNode);
5393       Dec(Src.fSize);
5394       Inc(fSize);
5395       SrcNode := N;
5396     end
5397     else
5398       Node := Node^.Next;
5399   end;
5400 end;
5401 
5402 {--- TGenList.Partition ---}
5403 procedure TGenList.Partition(Pivot, Back: PNode; Comparator: TCompareItems);
5404 var
5405   Node, Next : PNode;
5406 begin
5407   Node := Pivot^.Next;
5408   while Node <> Back do
5409     if Comparator(Node^.Item, Pivot^.Item) < 0 then
5410     begin
5411       Next := Node^.Next;
5412       SpliceNodes(Pivot, Node, Node);
5413       Node := Next;
5414     end
5415     else
5416       Node := Node^.Next;
5417 end;
5418 
5419 {--- TGenList.Prepend ---}
5420 procedure TGenList.Prepend(const Item: _TItem_; Count: Integer);
5421 begin
5422   Insert(First, Item, Count);
5423 end;
5424 
5425 {--- TGenList.PrependAll ---}
5426 procedure TGenList.PrependAll(Src: TGenList);
5427 begin
5428   InsertAll(First, Src);
5429 end;
5430 
5431 {--- TGenList.PrependRange ---}
5432 procedure TGenList.PrependRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
5433 begin
5434   InsertRange(First, Src, PosFrom, PosTo);
5435 end;
5436 
5437 {--- TGenList.ReadFirstItem ---}
5438 procedure TGenList.ReadFirstItem(out Value : _TItem_);
5439 begin
5440   if fSize = 0 then
5441     RaiseContainerEmpty;
5442 
5443   Value := fHead^.Next^.Item;
5444 end;
5445 
5446 {--- TGenList.ReadItem ---}
5447 procedure TGenList.ReadItem(const Position: TListCursor; out Value: _TItem_);
5448 begin
5449   CheckNotNil(Position);
5450   Value := PNode(Position.Node)^.Item;
5451 end;
5452 
5453 {--- TGenList.ReadItemFast ---}
5454 procedure TGenList.ReadItemFast(const Position: TListCursor; out Value: _TItem_);
5455 begin
5456   Value := PNode(Position.Node)^.Item;
5457 end;
5458 
5459 {--- TGenList.ReadLastItem ---}
5460 procedure TGenList.ReadLastItem(out Value : _TItem_);
5461 begin
5462   if fSize = 0 then
5463     RaiseContainerEmpty;
5464 
5465   Value := fTail^.Previous^.Item;
5466 end;
5467 
5468 {--- TGenList.RealSort ---}
5469 procedure TGenList.RealSort(Front, Back: PNode; Comparator: TCompareItems);
5470 var
5471   Pivot : PNode;
5472 begin
5473   Pivot := Front^.Next;
5474   if Pivot <> Back then
5475   begin
5476     Partition(Pivot, Back, Comparator);
5477     RealSort(Front, Pivot, Comparator);
5478     RealSort(Pivot, Back, Comparator)
5479   end;
5480 end;
5481 
5482 {--- TGenList.SetOnCompareItems ---}
5483 procedure TGenList.SetOnCompareItems(AValue: TCompareItems);
5484 begin
5485   if AValue = nil then
5486     fOnCompareItems := @DefaultCompareItems
5487   else
5488     fOnCompareItems := AValue;
5489 end;
5490 
5491 {--- TGenList.SetOnItemToString ---}
5492 procedure TGenList.SetOnItemToString(AValue: TItemToString);
5493 begin
5494   if AValue = nil then
5495     fOnItemToString := @DefaultItemToString
5496   else
5497     fOnItemToString := AValue;
5498 end;
5499 
5500 {--- TGenList.Replace ---}
5501 procedure TGenList.Replace(const Position: TListCursor; Count: Integer;
5502   const Value: _TItem_);
5503 var
5504   Node : PNode;
5505 begin
5506   CheckNotNil(Position);
5507 
5508   Node := PNode(Position.Node);
5509   while (Count > 0) and (Node <> fTail) do
5510   begin
5511     Node^.Item := Value;
5512     Dec(Count);
5513     Node := Node^.Next;
5514   end;
5515 end;
5516 
5517 {--- TGenList.Reverse ---}
5518 procedure TGenList.Reverse;
5519 begin
5520   if fSize > 1 then
5521     ReverseRange(First, Last);
5522 end;
5523 
5524 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5525 function TGenList.ReverseFind(const Item: _TItem_): TListCursor;
5526 begin
5527   Result := ReverseFind(Item, fOnCompareItems);
5528 end;
5529 
5530 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5531 function TGenList.ReverseFind(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
5532 begin
5533   if fSize = 0 then
5534     Result := fNilCursor
5535   else
5536     Result := ReverseFind(Item, Last, Comparator);
5537 end;
5538 
5539 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5540 function TGenList.ReverseFind(const Item: _TItem_; const Position: TListCursor): TListCursor;
5541 begin
5542   Result := ReverseFind(Item, Position, fOnCompareItems);
5543 end;
5544 
5545 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5546 function TGenList.ReverseFind(const Item: _TItem_;
5547   const Position: TListCursor; Comparator: TCompareItems): TListCursor;
5548 var
5549   Node : PNode;
5550   I : _TItem_;
5551 begin
5552   CheckValid(Position);
5553 
5554   if Position.IsNil then
5555     Node := fTail^.Previous
5556   else
5557     Node := PNode(Position.Node);
5558 
5559   if Node = fTail then
5560     Node := Node^.Previous;
5561 
5562   while Node <> fHead do
5563   begin
5564     I := Node^.Item;
5565     if Comparator(Item, I) = 0 then
5566       Break;
5567     Node := Node^.Previous;
5568   end;
5569 
5570   if (Node = fTail) or (Node = fHead) then
5571     Node := nil;
5572 
5573   Result.Init(Self, Node);
5574 end;
5575 
5576 {--- TGenList.ReverseRange ---}
5577 procedure TGenList.ReverseRange(const PosFrom, PosTo: TListCursor);
5578 var
5579   Left, Right : PNode;
5580   Tmp : _TItem_;
5581 begin
5582   CheckNotNil(PosFrom);
5583   CheckNotNil(PosTo);
5584 
5585   if not PosFrom.Equals(PosTo) then
5586   begin
5587     Left := PNode(PosFrom.Node);
5588     Right := PNode(PosTo.Node);
5589     while true do
5590     begin
5591       Tmp := Left^.Item;
5592       Left^.Item := Right^.Item;
5593       Right^.Item := Tmp;
5594 
5595       Left := Left^.Next;
5596       if Left = Right then
5597         Break;
5598 
5599       Right := Right^.Previous;
5600       if Left = Right then
5601         Break;
5602     end;
5603   end;
5604 end;
5605 
5606 {--- TGenList.SetItem ---}
5607 procedure TGenList.SetItem(const Position: TListCursor; const Value: _TItem_);
5608 begin
5609   CheckNotNil(Position);
5610   PNode(Position.Node)^.Item := Value;
5611 end;
5612 
5613 {--- TGenList.SetItemFast ---}
5614 procedure TGenList.SetItemFast(const Position: TListCursor; const Value: _TItem_);
5615 begin
5616   PNode(Position.Node)^.Item := Value;
5617 end;
5618 
5619 {--- TGenList.Sort ---}
5620 procedure TGenList.Sort(const PosFrom, PosTo: TListCursor);
5621 begin
5622   Sort(PosFrom, PosTo, fOnCompareItems);
5623 end;
5624 
5625 {--- TGenList.Sort ---}
5626 procedure TGenList.Sort(const PosFrom, PosTo: TListCursor; Comparator: TCompareItems);
5627 begin
5628   CheckNotNil(PosFrom);
5629   CheckNotNil(PosTo);
5630   RealSort(PNode(PosFrom.Node)^.Previous, PNode(PosTo.Node)^.Next, Comparator);
5631 end;
5632 
5633 {--- TGenList.Sort ---}
5634 procedure TGenList.Sort;
5635 begin
5636   Sort(fOnCompareItems);
5637 end;
5638 
5639 {--- TGenList.Sort ---}
5640 procedure TGenList.Sort(Comparator: TCompareItems);
5641 begin
5642   if fSize > 1 then
5643     Sort(First, Last, Comparator);
5644 end;
5645 
5646 {--- TGenList.Splice ---}
5647 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList);
5648 var
5649   Where : PNode;
5650 begin
5651   CheckValid(Before);
5652 
5653   if (Self <> Src) and (Src.fSize > 0) then
5654   begin
5655     if Before.IsNil then
5656       Where := fTail
5657     else
5658       Where := PNode(Before.Node);
5659 
5660     SpliceNodes(Where, Src.fHead^.Next, Src.fTail^.Previous);
5661     Inc(fSize, Src.fSize);
5662     Src.fSize:=0;
5663   end;
5664 end;
5665 
5666 {--- TGenList.Splice ---}
5667 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList;
5668   const SrcFrom, SrcTo: TListCursor);
5669 var
5670   Node, Where : PNode;
5671   Count : Integer = 0;
5672 begin
5673   CheckValid(Before);
5674   Src.CheckNotNil(SrcFrom);
5675   Src.CheckNotNil(SrcTo);
5676 
5677   if (Src = Self) and Before.HasItem then
5678   begin
5679     if Before.Equals(SrcFrom) or Before.Equals(SrcTo) then
5680       RaiseError('cursor `Before'' is in range [SrcFrom..SrcTo]');
5681 
5682     Node := PNode(SrcFrom.Node)^.Next;
5683     while Node <> PNode(SrcTo.Node) do
5684     begin
5685       if Node = PNode(Before.Node) then
5686         RaiseError('cursor `Before'' is in range [SrcFrom..SrcTo]');
5687       Node := Node^.Next;
5688     end;
5689   end
5690   else if Src <> Self then
5691   begin
5692     Node := PNode(SrcFrom.Node);
5693     while Node <> PNode(SrcTo.Node) do
5694     begin
5695       Node := Node^.Next;
5696       Inc(Count);
5697     end;
5698     Inc(Count);
5699   end;
5700 
5701   if Before.HasItem then
5702     Where := PNode(Before.Node)
5703   else
5704     Where := fTail;
5705 
5706   SpliceNodes(Where, PNode(SrcFrom.Node), PNode(SrcTo.Node));
5707   Inc(fSize, Count);
5708   Dec(Src.fSize, Count);
5709 end;
5710 
5711 {--- TGenList.Splice ---}
5712 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList;
5713   const Position: TListCursor);
5714 var
5715   Where : PNode;
5716 begin
5717   CheckValid(Before);
5718   Src.CheckNotNil(Position);
5719 
5720   if not Position.Equals(Before) then
5721   begin
5722     if Before.HasItem then
5723       Where := PNode(Before.Node)
5724     else
5725       Where := fTail;
5726 
5727     SpliceNodes(Where, PNode(Position.Node), PNode(Position.Node));
5728     Inc(fSize);
5729     Dec(Src.fSize);
5730   end;
5731 end;
5732 
5733 {--- TGenList.SpliceNodes ---}
5734 procedure TGenList.SpliceNodes(Before, PosFrom, PosTo: PNode);
5735 begin
5736   PosFrom^.Previous^.Next := PosTo^.Next;
5737   PosTo^.Next^.Previous := PosFrom^.Previous;
5738 
5739   Before^.Previous^.Next := PosFrom;
5740   PosFrom^.Previous := Before^.Previous;
5741 
5742   PosTo^.Next := Before;
5743   Before^.Previous := PosTo;
5744 end;
5745 
5746 {--- TGenList.CursorIsFirst ---}
CursorIsFirstnull5747 function TGenList.CursorIsFirst(const Cursor: TListCursor): Boolean;
5748 begin
5749   Result := (PNode(Cursor.Node) = (Cursor.List as TGenList).fHead^.Next) and
5750             (PNode(Cursor.Node) <> (Cursor.List as TGenList).fTail);
5751 end;
5752 
5753 {--- TGenList.CursorIsLast ---}
TGenList.CursorIsLastnull5754 function TGenList.CursorIsLast(const Cursor: TListCursor): Boolean;
5755 begin
5756   Result := (PNode(Cursor.Node) = (Cursor.List as TGenList).fTail^.Previous) and
5757             (PNode(Cursor.Node) <> (Cursor.List as TGenList).fHead);
5758 end;
5759 
5760 {--- TGenList.CursorMoveNext ---}
5761 procedure TGenList.CursorMoveNext(var Cursor: TListCursor);
5762 begin
5763   if Cursor.Node <> nil then
5764   begin
5765     Cursor.Node := PNode(Cursor.Node)^.Next;
5766     if PNode(Cursor.Node) = (Cursor.List as TGenList).fTail then
5767       Cursor.Node := nil;
5768   end;
5769 end;
5770 
5771 {--- TGenList.CursorMovePrev ---}
5772 procedure TGenList.CursorMovePrev(var Cursor: TListCursor);
5773 begin
5774   if Cursor.Node <> nil then
5775   begin
5776     Cursor.Node := PNode(Cursor.Node)^.Previous;
5777     if PNode(Cursor.Node) = (Cursor.List as TGenList).fHead then
5778       Cursor.Node := nil;
5779   end;
5780 end;
5781 
5782 {--- TGenList.Swap ---}
5783 procedure TGenList.Swap(const I, J: TListCursor);
5784 var
5785   Tmp : _TItem_;
5786 begin
5787   CheckNotNil(I);
5788   CheckNotNil(J);
5789 
5790   if I.Node <> J.Node then
5791   begin
5792     Tmp := PNode(I.Node)^.Item;
5793     PNode(I.Node)^.Item := PNode(J.Node)^.Item;
5794     PNode(J.Node)^.Item := Tmp;
5795   end;
5796 end;
5797 
5798 {--- TGenList.SwapLinks ---}
5799 procedure TGenList.SwapLinks(const I, J: TListCursor);
5800 var
5801   NextI : PNode;
5802 begin
5803   CheckNotNil(I);
5804   CheckNotNil(J);
5805 
5806   if I.Node <> J.Node then
5807   begin
5808     NextI := PNode(I.Node)^.Next;
5809 
5810     if NextI = PNode(J.Node) then
5811       SpliceNodes(PNode(I.Node), PNode(J.Node), PNode(J.Node))
5812     else
5813     begin
5814       SpliceNodes(PNode(J.Node), PNode(I.Node), PNode(I.Node));
5815       SpliceNodes(NextI, PNode(J.Node), PNode(J.Node) );
5816     end;
5817   end;
5818 end;
5819 
5820 {--- TGenList.ToString ---}
TGenList.ToStringnull5821 function TGenList.ToString: String;
5822 var
5823   Node : PNode;
5824 begin
5825   Result := '(';
5826 
5827   if fSize > 0 then
5828   begin
5829     Node := fHead^.Next;
5830     while Node <> fTail do
5831     begin
5832       Result := Result + fOnItemToString(Node^.Item) + ', ';
5833       Node := Node^.Next;
5834     end;
5835     SetLength(Result, Length(Result) - 2);
5836   end;
5837 
5838   Result := Result + ')';
5839 end;
5840 
5841 {=========================}
5842 {=== TGenPriorityQueue ===}
5843 {=========================}
5844 
5845 {--- TGenPriorityQueue.Clear ---}
5846 procedure TGenPriorityQueue.Clear;
5847 begin
5848   SetLength(fItems, 1);
5849   fCapacity := 1;
5850   fSize := 0;
5851 end;
5852 
5853 {--- TGenPriorityQueue.Create ---}
5854 constructor TGenPriorityQueue.Create(InitialCapacity : Integer);
5855 begin
5856   inherited Create;
5857 
5858   if InitialCapacity < 1 then
5859     InitialCapacity := 1;
5860 
5861   SetLength(fItems, InitialCapacity);
5862   fCapacity := InitialCapacity;
5863 
5864   fSize := 0;
5865 
5866   SetOnCompareItems(nil);
5867 end;
5868 
5869 {--- TGenPriorityQueue.DefaultCompareItems ---}
TGenPriorityQueue.DefaultCompareItemsnull5870 function TGenPriorityQueue.DefaultCompareItems(const A, B: _TItem_): Integer;
5871 begin
5872   Unused(@A);
5873   Unused(@B);
5874   RaiseMethodNotRedefined;
5875   Result := 0;
5876 end;
5877 
5878 {--- TGenPriorityQueue.IsEmpty ---}
IsEmptynull5879 function TGenPriorityQueue.IsEmpty: Boolean;
5880 begin
5881   Result := (fSize = 0);
5882 end;
5883 
5884 {--- TGenPriorityQueue.Pack ---}
5885 procedure TGenPriorityQueue.Pack;
5886 begin
5887   SetLength(fItems, fSize);
5888   fCapacity := fSize;
5889 end;
5890 
5891 {--- TGenPriorityQueue.Pop ---}
5892 procedure TGenPriorityQueue.Pop;
5893 begin
5894   if fSize = 0 then
5895     RaiseContainerEmpty;
5896 
5897   Dec(fSize);
5898   if fSize > 0 then
5899     MoveDown(0, fItems[fSize]);
5900 end;
5901 
5902 {--- TGenPriorityQueue.Push ---}
5903 procedure TGenPriorityQueue.Push(const Item: _TItem_);
5904 begin
5905   if fSize = fCapacity then
5906     Reserve(fSize + 1);
5907 
5908   if fSize = 0 then
5909     fItems[0] := Item
5910   else
5911     MoveUp(fSize, Item);
5912 
5913   Inc(fSize);
5914 end;
5915 
5916 {--- TGenPriorityQueue.ReadTop ---}
5917 procedure TGenPriorityQueue.ReadTop(out Value: _TItem_);
5918 begin
5919   if fSize = 0 then
5920     RaiseContainerEmpty;
5921 
5922   Value := fItems[0];
5923 end;
5924 
5925 {--- TGenPriorityQueue.Reserve ---}
5926 procedure TGenPriorityQueue.Reserve(MinCapacity: Integer);
5927 var
5928   NewCapacity : Integer;
5929 begin
5930   if MinCapacity > fCapacity then
5931   begin
5932     if fCapacity <= 128 then
5933       NewCapacity := fCapacity *  2
5934     else
5935       NewCapacity := (fCapacity * 3) div 2;
5936 
5937     if NewCapacity < MinCapacity then
5938       NewCapacity := MinCapacity;
5939 
5940     SetLength(fItems, NewCapacity);
5941     fCapacity := NewCapacity;
5942   end;
5943 end;
5944 
5945 {--- TGenPriorityQueue.MoveDown ---}
5946 procedure TGenPriorityQueue.MoveDown(Index: Integer; const Item: _TItem_);
5947 var
5948   Half, Child, Right : Integer;
5949 begin
5950   Half := fSize shr 1;
5951 
5952   while Index < Half do
5953   begin
5954     Child := (Index shl 1) + 1;
5955 
5956     Right := Child + 1;
5957 
5958     if (Right < fSize) and
5959         (fOnCompareItems(fItems[Child], fItems[Right]) > 0) then
5960       Child := Right;
5961 
5962     if fOnCompareItems(Item, fItems[Child]) <= 0 then
5963       Break;
5964 
5965     fItems[Index] := fItems[Child];
5966     Index := Child;
5967   end;
5968   fItems[Index] := Item;
5969 end;
5970 
5971 {--- TGenPriorityQueue.SetOnCompareItems ---}
5972 procedure TGenPriorityQueue.SetOnCompareItems(AValue: TCompareItems);
5973 begin
5974   if AValue = nil then
5975     fOnCompareItems := @DefaultCompareItems
5976   else
5977     fOnCompareItems := AValue;
5978 end;
5979 
5980 {--- TGenPriorityQueue.MoveUp ---}
5981 procedure TGenPriorityQueue.MoveUp(Index: Integer; const Item: _TItem_);
5982 var
5983   Parent : Integer;
5984 begin
5985   while Index > 0 do
5986   begin
5987     Parent := (Index - 1) shr 1;
5988 
5989     if fOnCompareItems(Item, fItems[Parent]) >= 0 then
5990       Break;
5991 
5992     fItems[Index] := fItems[Parent];
5993     Index := Parent;
5994   end;
5995   fItems[Index] := Item;
5996 end;
5997 
5998 {--- TGenPriorityQueue.Top ---}
Topnull5999 function TGenPriorityQueue.Top: _TItem_;
6000 begin
6001   if fSize = 0 then
6002     RaiseContainerEmpty;
6003 
6004   Result := fItems[0];
6005 end;
6006 
6007 {=================}
6008 {=== TGenQueue ===}
6009 {=================}
6010 
6011 {--- TGenQueue.Append ---}
6012 procedure TGenQueue.Append(const Item: _TItem_);
6013 begin
6014   fData.Append(Item);
6015 end;
6016 
6017 {--- TGenQueue.Clear ---}
6018 procedure TGenQueue.Clear;
6019 begin
6020   fData.Clear;
6021 end;
6022 
6023 {--- TGenQueue.Create ---}
6024 constructor TGenQueue.Create;
6025 begin
6026   inherited Create;
6027   fData := _TContainer_.Create;
6028 end;
6029 
6030 {--- TGenQueue.Destroy ---}
6031 destructor TGenQueue.Destroy;
6032 begin
6033   fData.Free;
6034   inherited Destroy;
6035 end;
6036 
6037 {--- TGenQueue.Front ---}
TGenQueue.Frontnull6038 function TGenQueue.Front: _TItem_;
6039 begin
6040   fData.ReadFirstItem(Result);
6041 end;
6042 
6043 {--- TGenQueue.GetSize ---}
GetSizenull6044 function TGenQueue.GetSize: Integer;
6045 begin
6046   Result := fData.Size;
6047 end;
6048 
6049 {--- TGenQueue.IsEmpty ---}
IsEmptynull6050 function TGenQueue.IsEmpty: Boolean;
6051 begin
6052   Result := fData.Size = 0;
6053 end;
6054 
6055 {--- TGenQueue.Pop ---}
6056 procedure TGenQueue.Pop;
6057 begin
6058   fData.DeleteFirst;
6059 end;
6060 
6061 {--- TGenQueue.ReadFront ---}
6062 procedure TGenQueue.ReadFront(out Value: _TItem_);
6063 begin
6064   fData.ReadFirstItem(Value);
6065 end;
6066 
6067 {=================}
6068 {=== TGenStack ===}
6069 {=================}
6070 
6071 {--- TGenStack.Clear ---}
6072 procedure TGenStack.Clear;
6073 begin
6074   fData.Clear;
6075 end;
6076 
6077 {--- TGenStack.Create ---}
6078 constructor TGenStack.Create;
6079 begin
6080   inherited Create;
6081   fData := _TContainer_.Create;
6082 end;
6083 
6084 {--- TGenStack.Destroy ---}
6085 destructor TGenStack.Destroy;
6086 begin
6087   fData.Free;
6088   inherited Destroy;
6089 end;
6090 
6091 {--- TGenStack.GetSize ---}
TGenStack.GetSizenull6092 function TGenStack.GetSize: Integer;
6093 begin
6094   Result := fData.Size;
6095 end;
6096 
6097 {--- TGenStack.IsEmpty ---}
IsEmptynull6098 function TGenStack.IsEmpty: Boolean;
6099 begin
6100   Result := (fData.Size = 0);
6101 end;
6102 
6103 {--- TGenStack.Pop ---}
6104 procedure TGenStack.Pop;
6105 begin
6106   fData.DeleteLast;
6107 end;
6108 
6109 {--- TGenStack.Push ---}
6110 procedure TGenStack.Push(const Item: _TItem_);
6111 begin
6112   fData.Append(Item);
6113 end;
6114 
6115 {--- TGenStack.ReadTop ---}
6116 procedure TGenStack.ReadTop(out Value : _TItem_);
6117 begin
6118   fData.ReadLastItem(Value);
6119 end;
6120 
6121 {--- TGenStack.Top ---}
Topnull6122 function TGenStack.Top: _TItem_;
6123 begin
6124   fData.ReadLastItem(Result);
6125 end;
6126 
6127 {======================}
6128 {=== THashMapCursor ===}
6129 {======================}
6130 
6131 {--- THashMapCursor.Equals ---}
Equalsnull6132 function THashMapCursor.Equals(const Cursor: THashMapCursor): Boolean;
6133 begin
6134   Result := (fHashMap = Cursor.fHashMap) and (fBucket = Cursor.fBucket)
6135             and (fEntry = Cursor.fEntry);
6136 end;
6137 
6138 {--- THashMapCursor.HasItem ---}
THashMapCursor.HasItemnull6139 function THashMapCursor.HasItem: Boolean;
6140 begin
6141   Result := (fEntry <> nil);
6142 end;
6143 
6144 {--- THashMapCursor.Init ---}
6145 constructor THashMapCursor.Init(HashMap: TAbstractHashMap; BucketNum: Integer;
6146   AEntry, APrevious: Pointer);
6147 begin
6148   fHashMap := HashMap;
6149   fBucket := BucketNum;
6150   fEntry := AEntry;
6151   fPrevious := APrevious;
6152 end;
6153 
6154 {--- THashMapCursor.IsFirst ---}
IsFirstnull6155 function THashMapCursor.IsFirst: Boolean;
6156 begin
6157   Result := fHashMap.CursorIsFirst(Self);
6158 end;
6159 
6160 {--- THashMapCursor.IsLast ---}
IsLastnull6161 function THashMapCursor.IsLast: Boolean;
6162 begin
6163   Result := fHashMap.CursorIsLast(Self);
6164 end;
6165 
6166 {--- THashMapCursor.IsNil ---}
THashMapCursor.IsNilnull6167 function THashMapCursor.IsNil: Boolean;
6168 begin
6169   Result := (fEntry = nil);
6170 end;
6171 
6172 {--- THashMapCursor.MoveNext ---}
6173 procedure THashMapCursor.MoveNext;
6174 begin
6175   fHashMap.CursorMoveNext(Self);
6176 end;
6177 
6178 {===================}
6179 {=== TGenHashMap ===}
6180 {===================}
6181 
6182 {--- TGenHashMap.AppendBuckets ---}
6183 procedure TGenHashMap.AppendBuckets(Count: Integer);
6184 begin
6185   if Count > 0 then
6186   begin
6187     ReallocMem(fBuckets, SizeOf(PEntry) * (fBucketCount + Count));
6188     NilifyBuckets(fBucketCount, Count);
6189     fBucketCount := fBucketCount + Count;
6190   end;
6191 end;
6192 
6193 {--- TGenHashMap.CollectEntries ---}
TGenHashMap.CollectEntriesnull6194 function TGenHashMap.CollectEntries: PEntry;
6195 var
6196   I : Integer;
6197   FirstEntry, LastEntry : PEntry;
6198 begin
6199   Result := nil;
6200 
6201   for I := 0 to fBucketCount - 1 do
6202   begin
6203     FirstEntry := fBuckets[I];
6204 
6205     if FirstEntry <> nil then
6206     begin
6207       LastEntry := FirstEntry;
6208       while LastEntry^.Next <> nil do
6209         LastEntry := LastEntry^.Next;
6210 
6211       LastEntry^.Next := Result;
6212       Result := FirstEntry;
6213     end;
6214   end;
6215 end;
6216 
6217 {--- TGenHashMap.Clear ---}
6218 procedure TGenHashMap.Clear;
6219 var
6220   I : Integer;
6221 begin
6222   for I := 0 to fBucketCount - 1 do
6223   begin
6224     if fBuckets[I] <> nil then
6225     begin
6226       DisposeEntries(fBuckets[I]);
6227       fBuckets[I] := nil;
6228     end;
6229   end;
6230 
6231   fSize := 0;
6232   fFirstNonEmptyBucket := -1;
6233   fLastNonEmptyBucket := -1;
6234 end;
6235 
6236 {--- TGenHashMap.Contains ---}
TGenHashMap.Containsnull6237 function TGenHashMap.Contains(const Key: _TKey_): Boolean;
6238 begin
6239   Result := GetEntry(Key) <> nil;
6240 end;
6241 
6242 {--- TGenHashMap.Create ---}
6243 constructor TGenHashMap.Create(InitialCapacity: Integer);
6244 begin
6245   Create(InitialCapacity, DEFAULT_HASHMAP_LOAD_FACTOR)
6246 end;
6247 
6248 {--- TGenHashMap.Create ---}
6249 constructor TGenHashMap.Create(InitialCapacity: Integer; MaxLoadFact: Real);
6250 var
6251   Capacity : Integer;
6252 begin
6253   inherited Create;
6254 
6255   if InitialCapacity <= 0 then
6256     InitialCapacity := MIN_BUCKET_COUNT;
6257 
6258   if InitialCapacity > MAX_BUCKET_COUNT then
6259     InitialCapacity := MAX_BUCKET_COUNT;
6260 
6261   if MaxLoadFact <= 0 then
6262     MaxLoadFact := DEFAULT_HASHMAP_LOAD_FACTOR;
6263 
6264   Capacity := MIN_BUCKET_COUNT;
6265   while Capacity < InitialCapacity do
6266     Capacity := Capacity * 2;
6267 
6268   fSize := 0;
6269 
6270   fMaxLoadFactor := MaxLoadFact;
6271   fThreshold := Round(Capacity * MaxLoadFact);
6272 
6273   fMaxBucketCount := MAX_BUCKET_COUNT;
6274 
6275   fBuckets := nil;
6276   fBucketCount := 0;
6277   AppendBuckets(Capacity);
6278 
6279   fFirstNonEmptyBucket := -1;
6280   fLastNonEmptyBucket := -1;
6281 
6282   fNilCursor.Init(Self, -1, nil, nil);
6283 
6284   SetOnHashKey(nil);
6285   SetOnItemToString(nil);
6286   SetOnKeysEqual(nil);
6287   SetOnKeyToString(nil);
6288 end;
6289 
6290 {--- TGenHashMap.Create ---}
6291 constructor TGenHashMap.Create(MaxLoadFact: Real);
6292 begin
6293   Create(MIN_BUCKET_COUNT, MaxLoadFact);
6294 end;
6295 
6296 {--- TGenHashMap.Delete ---}
6297 procedure TGenHashMap.Delete(const Key: _TKey_);
6298 var
6299   Bucket: Integer;
6300   Entry, Previous : PEntry;
6301 begin
6302   Bucket := IndexFor(fOnHashKey(Key));
6303   Entry := FindEntry(Bucket, Key, Previous);
6304 
6305   if Entry = nil then
6306     RaiseKeyNotInMap
6307   else
6308     DeleteEntry(Bucket, Entry, Previous);
6309 end;
6310 
6311 {--- TGenHashMap.DeleteAt ---}
6312 procedure TGenHashMap.DeleteAt(const Position: THashMapCursor);
6313 begin
6314   if Position.HashMap <> Self then
6315     RaiseCursorDenotesWrongContainer;
6316 
6317   if Position.IsNil then
6318     RaiseCursorIsNil;
6319 
6320   DeleteEntry(Position.Bucket, Position.Entry, Position.Previous)
6321 end;
6322 
6323 {--- TGenHashMap.DeleteEntry ---}
6324 procedure TGenHashMap.DeleteEntry(Bucket: Integer; Entry, Previous: PEntry);
6325 var
6326   Next : PEntry;
6327 begin
6328   Next := Entry^.Next;
6329 
6330   if Previous <> nil then
6331     Previous^.Next := Next;
6332 
6333   if fBuckets[Bucket] = Entry then
6334   begin
6335     fBuckets[Bucket] := Next;
6336 
6337     if Next = nil then
6338     begin
6339       if Bucket = fFirstNonEmptyBucket then
6340         fFirstNonEmptyBucket := NextNonEmptyBucket(Bucket + 1);
6341 
6342       if Bucket = fLastNonEmptyBucket then
6343         fLastNonEmptyBucket := PreviousNonEmptyBucket(Bucket - 1);
6344     end;
6345   end;
6346 
6347   Dispose(Entry);
6348   Dec(fSize);
6349 end;
6350 
6351 {--- TGenHashMap.DisposeEntries ---}
6352 procedure TGenHashMap.DisposeEntries(E: PEntry);
6353 var
6354   N: PEntry;
6355 begin
6356   while E <> nil do
6357   begin
6358     N := E^.Next;
6359     Dispose(E);
6360     E := N;
6361   end;
6362 end;
6363 
6364 {--- TGenHashMap.EnumeratorGet ---}
EnumeratorGetnull6365 function TGenHashMap.EnumeratorGet(const Pos: THashMapCursor): _TItem_;
6366 begin
6367   ReadItemAt(Pos, Result);
6368 end;
6369 
6370 {--- TGenHashMap.EnumeratorNext ---}
EnumeratorNextnull6371 function TGenHashMap.EnumeratorNext(var Pos: THashMapCursor): Boolean;
6372 begin
6373   if Pos.IsNil then
6374     Pos := First
6375   else
6376     Pos.MoveNext;
6377   Result := Pos.HasItem;
6378 end;
6379 
6380 {--- TGenHashMap.Destroy ---}
6381 destructor TGenHashMap.Destroy;
6382 begin
6383   Clear;
6384   FreeMem(fBuckets);
6385   inherited Destroy;
6386 end;
6387 
6388 {--- TGenHashMap.Exclude ---}
6389 procedure TGenHashMap.Exclude(const Key: _TKey_);
6390 var
6391   Bucket : Integer;
6392   Entry, Previous : PEntry;
6393 begin
6394   Bucket := IndexFor(fOnHashKey(Key));
6395   Entry := FindEntry(Bucket, Key, Previous);
6396 
6397   if Entry <> nil then
6398     DeleteEntry(Bucket, Entry, Previous);
6399 end;
6400 
6401 {--- TGenHashMap.Find ---}
Findnull6402 function TGenHashMap.Find(const Key: _TKey_): THashMapCursor;
6403 var
6404   Bucket : Integer;
6405   Entry, Previous : PEntry;
6406 begin
6407   Bucket := IndexFor(fOnHashKey(Key));
6408 
6409   Entry := FindEntry(Bucket, Key, Previous);
6410 
6411   Result.Init(Self, Bucket, Entry, Previous);
6412 end;
6413 
6414 {--- TGenHashMap.FindEntry ---}
TGenHashMap.FindEntrynull6415 function TGenHashMap.FindEntry(Bucket: Integer; const Key: _TKey_): PEntry;
6416 begin
6417   Result := fBuckets[Bucket];
6418   while Result <> nil do
6419   begin
6420     if fOnKeysEqual(Result^.Key, Key) then
6421       Break;
6422     Result := Result^.Next;
6423   end;
6424 end;
6425 
6426 {--- TGenHashMap.FindEntry ---}
TGenHashMap.FindEntrynull6427 function TGenHashMap.FindEntry(Bucket: Integer; const Key: _TKey_; out Previous: PEntry) : PEntry;
6428 begin
6429   Previous := nil;
6430   Result := fBuckets[Bucket];
6431   while Result <> nil do
6432   begin
6433     if fOnKeysEqual(Result^.Key, Key) then
6434       Break;
6435     Previous := Result;
6436     Result := Result^.Next;
6437   end;
6438 end;
6439 
6440 {--- TGenHashMap.First ---}
TGenHashMap.Firstnull6441 function TGenHashMap.First: THashMapCursor;
6442 begin
6443   if fSize > 0 then
6444     Result.Init(Self, fFirstNonEmptyBucket, fBuckets[fFirstNonEmptyBucket], nil)
6445   else
6446     Result := fNilCursor;
6447 end;
6448 
6449 {--- TGenHashMap.GetEnumerator ---}
GetEnumeratornull6450 function TGenHashMap.GetEnumerator: TEnumerator;
6451 begin
6452   Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
6453 end;
6454 
6455 {--- TGenHashMap.GetEntry ---}
TGenHashMap.GetEntrynull6456 function TGenHashMap.GetEntry(const Key: _TKey_): PEntry;
6457 begin
6458   Result := FindEntry( IndexFor(fOnHashKey(Key)), Key);
6459 end;
6460 
6461 {--- TGenHashMap.GetEntryAt ---}
TGenHashMap.GetEntryAtnull6462 function TGenHashMap.GetEntryAt(const Position: THashMapCursor): PEntry;
6463 begin
6464   if Position.HashMap <> Self then
6465     RaiseCursorDenotesWrongContainer;
6466 
6467   if Position.IsNil then
6468     RaiseCursorIsNil;
6469 
6470   Result := Position.Entry;
6471 end;
6472 
6473 {--- TGenHashMap.GetItem ---}
GetItemnull6474 function TGenHashMap.GetItem(const Key: _TKey_): _TItem_;
6475 var
6476   Entry : PEntry;
6477 begin
6478   Entry := GetEntry(Key);
6479 
6480   if Entry = nil then
6481     RaiseKeyNotInMap
6482   else
6483     Result := Entry^.Value;
6484 end;
6485 
6486 {--- TGenHashMap.GetItemAt ---}
TGenHashMap.GetItemAtnull6487 function TGenHashMap.GetItemAt(const Position: THashMapCursor): _TItem_;
6488 begin
6489   Result := GetEntryAt(Position)^.Value;
6490 end;
6491 
6492 {--- TGenHashMap.GetKeyAt ---}
TGenHashMap.GetKeyAtnull6493 function TGenHashMap.GetKeyAt(const Position: THashMapCursor): _TKey_;
6494 begin
6495   Result := GetEntryAt(Position)^.Key;
6496 end;
6497 
6498 {--- TGenHashMap.DefaultHashKey ---}
TGenHashMap.DefaultHashKeynull6499 function TGenHashMap.DefaultHashKey(const Key: _TKey_): Integer;
6500 begin
6501   Unused(@Key);
6502   RaiseMethodNotRedefined;
6503   Result := 0;
6504 end;
6505 
6506 {--- TGenHashMap.GetLoadFactor ---}
TGenHashMap.GetLoadFactornull6507 function TGenHashMap.GetLoadFactor: Real;
6508 begin
6509   Result := fSize / fBucketCount;
6510 end;
6511 
6512 {--- TGenHashMap.Include ---}
6513 procedure TGenHashMap.Include(const Key: _TKey_; const Value: _TItem_);
6514 var
6515   Hash, Bucket : Integer;
6516   Entry, Previous : PEntry;
6517 begin
6518   Hash := fOnHashKey(Key);
6519   Bucket := IndexFor(Hash);
6520 
6521   Entry := FindEntry(Bucket, Key, Previous);
6522   if Entry <> nil then
6523     Entry^.Value := Value
6524   else
6525   begin
6526     Entry := NewEntry(Key, Value);
6527 
6528     if Previous <> nil then
6529       InsertEntry(Entry, Previous)
6530     else
6531       InsertEntry(Bucket, Entry);
6532   end;
6533 end;
6534 
6535 {--- TGenHashMap.IndexFor ---}
IndexFornull6536 function TGenHashMap.IndexFor(Hash: Integer): Integer;
6537 begin
6538   Result := LongWord(Hash) and (fBucketCount - 1);
6539 end;
6540 
6541 {--- TGenHashMap.InsertCollectedEntries ---}
6542 procedure TGenHashMap.InsertCollectedEntries(CollectedEntries: PEntry);
6543 var
6544   Entry, NextEntry : PEntry;
6545   Bucket : Integer;
6546 begin
6547   Entry := CollectedEntries;
6548   while Entry <> nil do
6549   begin
6550     NextEntry := Entry^.Next;
6551 
6552     Bucket := IndexFor(fOnHashKey(Entry^.Key));
6553     Entry^.Next := fBuckets[Bucket];
6554     fBuckets[Bucket] := Entry;
6555 
6556     Entry := NextEntry;
6557   end;
6558 end;
6559 
6560 {--- TGenHashMap.Insert ---}
6561 procedure TGenHashMap.Insert(const Key: _TKey_; const Value: _TItem_);
6562 var
6563   Inserted : Boolean;
6564 begin
6565   Insert(Key, Value, Inserted);
6566   if not Inserted then
6567     RaiseKeyAlreadyInMap;
6568 end;
6569 
6570 {--- TGenHashMap.Insert ---}
6571 procedure TGenHashMap.Insert(const Key: _TKey_; const Value: _TItem_; out
6572   Inserted: Boolean);
6573 var
6574   Hash, Bucket : Integer;
6575   Entry, Previous : PEntry;
6576 begin
6577   Hash := fOnHashKey(Key);
6578   Bucket := IndexFor(Hash);
6579 
6580   Entry := FindEntry(Bucket, Key, Previous);
6581 
6582   if Entry <> nil then
6583     Inserted := false
6584   else
6585   begin
6586     Entry := NewEntry(Key, Value);
6587 
6588     if Previous <> nil then
6589       InsertEntry(Entry, Previous)
6590     else
6591       InsertEntry(Bucket, Entry);
6592 
6593     Inserted := true;
6594   end;
6595 end;
6596 
6597 {--- TGenHashMap.InsertEntry ---}
6598 procedure TGenHashMap.InsertEntry(Bucket: Integer; Entry: PEntry);
6599 begin
6600   Entry^.Next := fBuckets[Bucket];
6601   fBuckets[Bucket] := Entry;
6602 
6603   if (fFirstNonEmptyBucket = -1) or (Bucket < fFirstNonEmptyBucket) then
6604     fFirstNonEmptyBucket := Bucket;
6605 
6606   if (fLastNonEmptyBucket = -1) or (Bucket > fLastNonEmptyBucket) then
6607     fLastNonEmptyBucket := Bucket;
6608 
6609   Inc(fSize);
6610   if fSize > fThreshold then
6611     Resize(2 * fBucketCount);
6612 end;
6613 
6614 {--- TGenHashMap.InsertEntry ---}
6615 procedure TGenHashMap.InsertEntry(Entry, Before: PEntry);
6616 begin
6617   Before^.Next := Entry;
6618   Entry^.Next := nil;
6619 
6620   Inc(fSize);
6621   if fSize > fThreshold then
6622     Resize(2 * fBucketCount);
6623 end;
6624 
6625 {--- TGenHashMap.IsEmpty ---}
IsEmptynull6626 function TGenHashMap.IsEmpty: Boolean;
6627 begin
6628   Result := (fSize = 0);
6629 end;
6630 
6631 {--- TGenHashMap.DefaultItemToString ---}
DefaultItemToStringnull6632 function TGenHashMap.DefaultItemToString(const Item: _TItem_): String;
6633 begin
6634   Unused(@Item);
6635   RaiseMethodNotRedefined;
6636   Result := '';
6637 end;
6638 
6639 {--- TGenHashMap.DefaultKeysEqual ---}
DefaultKeysEqualnull6640 function TGenHashMap.DefaultKeysEqual(const A, B: _TKey_): Boolean;
6641 begin
6642   Unused(@A);
6643   Unused(@B);
6644   RaiseMethodNotRedefined;
6645   Result := false;
6646 end;
6647 
6648 {--- TGenHashMap.DefaultKeyToString ---}
DefaultKeyToStringnull6649 function TGenHashMap.DefaultKeyToString(const Key: _TKey_): String;
6650 begin
6651   Unused(@Key);
6652   RaiseMethodNotRedefined;
6653   Result := '';
6654 end;
6655 
6656 {--- TGenHashMap.NextNonEmptyBucket ---}
NextNonEmptyBucketnull6657 function TGenHashMap.NextNonEmptyBucket(Bucket: Integer): Integer;
6658 var
6659   I : Integer;
6660 begin
6661   Result := -1;
6662   for I := Bucket to fBucketCount - 1 do
6663     if fBuckets[I] <> nil then
6664     begin
6665       Result := I;
6666       Exit;
6667     end;
6668 end;
6669 
6670 {--- TGenHashMap.NewEntry ---}
NewEntrynull6671 function TGenHashMap.NewEntry(const Key: _TKey_; const Value: _TItem_) : PEntry;
6672 begin
6673   New(Result);
6674   Result^.Key := Key;
6675   Result^.Value := Value;
6676 end;
6677 
6678 {--- TGenHashMap.NilifyBuckets ---}
6679 procedure TGenHashMap.NilifyBuckets(BucketFrom, Count: Integer);
6680 var
6681   I : Integer;
6682 begin
6683   for I := BucketFrom to BucketFrom + Count - 1 do
6684     fBuckets[I] := nil;
6685 end;
6686 
6687 {--- TGenHashMap.PreviousNonEmptyBucket ---}
TGenHashMap.PreviousNonEmptyBucketnull6688 function TGenHashMap.PreviousNonEmptyBucket(Bucket: Integer): Integer;
6689 var
6690   I : Integer;
6691 begin
6692   Result := -1;
6693   for I := Bucket downto 0 do
6694     if fBuckets[I] <> nil then
6695     begin
6696       Result := I;
6697       Break;
6698     end;
6699 end;
6700 
6701 {--- TGenHashMap.ReadItem ---}
6702 procedure TGenHashMap.ReadItem(const Key: _TKey_; out Value: _TItem_);
6703 var
6704   Entry : PEntry;
6705 begin
6706   Entry := GetEntry(Key);
6707 
6708   if Entry = nil then
6709     RaiseKeyNotInMap
6710   else
6711     Value := Entry^.Value;
6712 end;
6713 
6714 {--- TGenHashMap.ReadItemAt ---}
6715 procedure TGenHashMap.ReadItemAt(const Position: THashMapCursor; out Value: _TItem_);
6716 begin
6717   Value := GetEntryAt(Position)^.Value;
6718 end;
6719 
6720 {--- TGenHashMap.ReadKeyAt ---}
6721 procedure TGenHashMap.ReadKeyAt(const Position : THashMapCursor; out Key: _TKey_);
6722 begin
6723   Key := GetEntryAt(Position)^.Key;
6724 end;
6725 
6726 {--- TGenHashMap.Replace ---}
6727 procedure TGenHashMap.Replace(const Key: _TKey_; const Value: _TItem_);
6728 var
6729   Bucket : Integer;
6730   Entry : PEntry;
6731 begin
6732   Bucket := IndexFor(fOnHashKey(Key));
6733 
6734   Entry := FindEntry(Bucket, Key);
6735 
6736   if Entry = nil then
6737     RaiseKeyNotInMap;
6738 
6739   Entry^.Value := Value;
6740 end;
6741 
6742 {--- TGenHashMap.Resize ---}
6743 procedure TGenHashMap.Resize(NewCapacity: Integer);
6744 var
6745   CollectedEntries : PEntry;
6746   OldCapacity : Integer;
6747 begin
6748   OldCapacity := fBucketCount;
6749 
6750   if OldCapacity = MAX_BUCKET_COUNT then
6751   begin
6752     fThreshold := High(Integer);
6753     Exit;
6754   end;
6755 
6756   { Collect all entries }
6757   CollectedEntries := CollectEntries;
6758 
6759   if (fFirstNonEmptyBucket >= 0) and (fLastNonEmptyBucket >= 0) then
6760     NilifyBuckets(fFirstNonEmptyBucket, fLastNonEmptyBucket - fFirstNonEmptyBucket + 1)
6761   else
6762     NilifyBuckets(0, fBucketCount);
6763 
6764   { Create necessary buckets }
6765   AppendBuckets(NewCapacity - OldCapacity);
6766   fThreshold := Round(NewCapacity * fMaxLoadFactor);
6767 
6768   { Re-insert collected entries }
6769   InsertCollectedEntries(CollectedEntries);
6770 
6771   fFirstNonEmptyBucket := NextNonEmptyBucket(0);
6772   fLastNonEmptyBucket := PreviousNonEmptyBucket(fBucketCount - 1);
6773 end;
6774 
6775 {--- TGenHashMap.SetOnHashKey ---}
6776 procedure TGenHashMap.SetOnHashKey(AValue: THashKey);
6777 begin
6778   if AValue = nil then
6779     fOnHashKey := @DefaultHashKey
6780   else
6781     fOnHashKey:=AValue;
6782 end;
6783 
6784 {--- TGenHashMap.SetOnItemToString ---}
6785 procedure TGenHashMap.SetOnItemToString(AValue: TItemToString);
6786 begin
6787   if AValue = nil then
6788     fOnItemToString := @DefaultItemToString
6789   else
6790     fOnItemToString := AValue;
6791 end;
6792 
6793 {--- TGenHashMap.SetOnKeysEqual ---}
6794 procedure TGenHashMap.SetOnKeysEqual(AValue: TKeysEqual);
6795 begin
6796   if AValue = nil then
6797     fOnKeysEqual := @DefaultKeysEqual
6798   else
6799     fOnKeysEqual := AValue;
6800 end;
6801 
6802 {--- TGenHashMap.SetOnKeyToString ---}
6803 procedure TGenHashMap.SetOnKeyToString(AValue: TKeyToString);
6804 begin
6805   if AValue = nil then
6806     fOnKeyToString := @DefaultKeyToString
6807   else
6808     fOnKeyToString:=AValue;
6809 end;
6810 
6811 {--- TGenHashMap.CursorIsFirst ---}
CursorIsFirstnull6812 function TGenHashMap.CursorIsFirst(const Cursor: THashMapCursor): Boolean;
6813 var
6814   Map : TGenHashMap;
6815 begin
6816   Map := Cursor.HashMap as TGenHashMap;
6817   Result := false;
6818   if Cursor.Bucket = Map.fFirstNonEmptyBucket then
6819     Result := Map.fBuckets[Map.fFirstNonEmptyBucket] = Cursor.Entry;
6820 end;
6821 
6822 {--- TGenHashMap.CursorIsLast ---}
TGenHashMap.CursorIsLastnull6823 function TGenHashMap.CursorIsLast(const Cursor: THashMapCursor): Boolean;
6824 var
6825   Map : TGenHashMap;
6826   Entry : PEntry;
6827 begin
6828   Map := Cursor.HashMap as TGenHashMap;
6829   Entry := PEntry(Cursor.Entry);
6830   Result := (Cursor.Bucket = Map.fLastNonEmptyBucket) and (Entry^.Next = nil);
6831 end;
6832 
6833 {--- TGenHashMap.CursorMoveNext ---}
6834 procedure TGenHashMap.CursorMoveNext(const Cursor: THashMapCursor);
6835 var
6836   Map : TGenHashMap;
6837 begin
6838   if Cursor.Bucket <> -1 then
6839   begin
6840     Map := Cursor.HashMap as TGenHashMap;
6841 
6842     Cursor.Previous := Cursor.Entry;
6843     Cursor.Entry := PEntry(Cursor.Entry)^.Next;
6844     if Cursor.Entry = nil then
6845     begin
6846       Cursor.Bucket := Map.NextNonEmptyBucket(Cursor.Bucket + 1);
6847       Cursor.Previous := nil;
6848       if Cursor.Bucket >= 0 then
6849         Cursor.Entry := Map.fBuckets[Cursor.Bucket];
6850     end;
6851   end;
6852 end;
6853 
6854 {--- TGenHashMap.SetItemAt ---}
6855 procedure TGenHashMap.SetItemAt(const Position: THashMapCursor; AValue: _TItem_);
6856 begin
6857   GetEntryAt(Position)^.Value := AValue;
6858 end;
6859 
6860 {--- TGenHashMap.ToString ---}
TGenHashMap.ToStringnull6861 function TGenHashMap.ToString: String;
6862 var
6863   Bucket, LastBucket, I : Integer;
6864   Entry : PEntry;
6865 begin
6866   Result := '{';
6867 
6868   I := 1;
6869   LastBucket := fBucketCount - 1;
6870   for Bucket := 0 to LastBucket do
6871   begin
6872     Entry := fBuckets[Bucket];
6873 
6874     while Entry <> nil do
6875     begin
6876       Result := Result + '(' + fOnKeyToString(Entry^.Key) + '=>' +
6877         fOnItemToString(Entry^.Value) + ')';
6878 
6879       if I < fSize then
6880         Result := Result + ', ';
6881 
6882       Inc(I);
6883       Entry := Entry^.Next;
6884     end;
6885   end;
6886 
6887   Result := Result + '}';
6888 end;
6889 
6890 {======================}
6891 {=== THashSetCursor ===}
6892 {======================}
6893 
6894 {--- THashSetCursor.Equals ---}
Equalsnull6895 function THashSetCursor.Equals(const Cursor: THashSetCursor): Boolean;
6896 begin
6897   Result := fPos.Equals(Cursor.fPos)
6898 end;
6899 
6900 {--- THashSetCursor.HasItem ---}
HasItemnull6901 function THashSetCursor.HasItem: Boolean;
6902 begin
6903   Result := fPos.HasItem;
6904 end;
6905 
6906 {--- THashSetCursor.Init ---}
6907 constructor THashSetCursor.Init(HashSet: TAbstractHashSet;
6908   const APos: THashMapCursor);
6909 begin
6910   fHashSet := HashSet;
6911   fPos := APos;
6912 end;
6913 
6914 {--- THashSetCursor.IsFirst ---}
THashSetCursor.IsFirstnull6915 function THashSetCursor.IsFirst: Boolean;
6916 begin
6917   Result := fPos.IsFirst;
6918 end;
6919 
6920 {--- THashSetCursor.IsLast ---}
IsLastnull6921 function THashSetCursor.IsLast: Boolean;
6922 begin
6923   Result := fPos.IsLast;
6924 end;
6925 
6926 {--- THashSetCursor.IsNil ---}
THashSetCursor.IsNilnull6927 function THashSetCursor.IsNil: Boolean;
6928 begin
6929   Result := fPos.IsNil;
6930 end;
6931 
6932 {--- THashSetCursor.MoveNext ---}
6933 procedure THashSetCursor.MoveNext;
6934 begin
6935   fPos.MoveNext;
6936 end;
6937 
6938 {===================}
6939 {=== TGenHashSet ===}
6940 {===================}
6941 
6942 {--- TGenHashSet.Clear ---}
6943 procedure TGenHashSet.Clear;
6944 begin
6945   fMap.Clear;
6946 end;
6947 
6948 {--- TGenHashSet.Contains ---}
Containsnull6949 function TGenHashSet.Contains(const Item: _TItem_): Boolean;
6950 begin
6951   Result := fMap.Contains(Item);
6952 end;
6953 
6954 {--- TGenHashSet.Create ---}
6955 constructor TGenHashSet.Create(InitialCapacity: Integer);
6956 begin
6957   Create(InitialCapacity, 0.75);
6958 end;
6959 
6960 {--- TGenHashSet.Create ---}
6961 constructor TGenHashSet.Create(InitialCapacity: Integer; LoadFact: Real);
6962 begin
6963   fMap := TMap.Create(InitialCapacity, LoadFact);
6964   fNilCursor.Init(Self, fMap.NilCursor);
6965   SetOnHashItem(nil);
6966   SetOnItemToString(nil);
6967   SetOnItemsEqual(nil);
6968 end;
6969 
6970 {--- TGenHashSet.Create ---}
6971 constructor TGenHashSet.Create(LoadFact: Real);
6972 begin
6973   Create(16, LoadFact);
6974 end;
6975 
6976 {--- TGenHashSet.Delete ---}
6977 procedure TGenHashSet.Delete(const Item: _TItem_);
6978 var
6979   C : THashMapCursor;
6980 begin
6981   C := fMap.Find(Item);
6982 
6983   if C.IsNil then
6984     RaiseItemNotInSet;
6985 
6986   fMap.DeleteAt(C);
6987 end;
6988 
6989 {--- TGenHashSet.DeleteAt ---}
6990 procedure TGenHashSet.DeleteAt(const Position: THashSetCursor);
6991 begin
6992   fMap.DeleteAt(Position.Pos);
6993 end;
6994 
6995 {--- TGenHashSet.Destroy ---}
6996 destructor TGenHashSet.Destroy;
6997 begin
6998   fMap.Free;
6999   inherited Destroy;
7000 end;
7001 
7002 {--- TGenHashSet.Difference ---}
7003 procedure TGenHashSet.Difference(Left, Right: TGenHashSet);
7004 begin
7005   if Left <> Self then
7006   begin
7007     Clear;
7008     IncludeAll(Left);
7009   end;
7010 
7011   if Left <> Right then
7012     ExcludeAll(Right)
7013   else
7014     Clear;
7015 end;
7016 
7017 {--- TGenHashSet.DefaultItemsEqual ---}
DefaultItemsEqualnull7018 function TGenHashSet.DefaultItemsEqual(const A, B: _TItem_): Boolean;
7019 begin
7020   Unused(@A);
7021   Unused(@B);
7022   RaiseMethodNotRedefined;
7023   Result := true;
7024 end;
7025 
7026 {--- TGenHashSet.DefaultItemToString ---}
DefaultItemToStringnull7027 function TGenHashSet.DefaultItemToString(const Item: _TItem_): String;
7028 begin
7029   Unused(@Item);
7030   RaiseMethodNotRedefined;
7031   Result := '';
7032 end;
7033 
7034 {--- TGenHashSet.DefaultHashItem ---}
DefaultHashItemnull7035 function TGenHashSet.DefaultHashItem(const Item: _TItem_): Integer;
7036 begin
7037   Unused(@Item);
7038   RaiseMethodNotRedefined;
7039   Result := 0;
7040 end;
7041 
7042 {--- TGenHashSet.EnumeratorGet ---}
EnumeratorGetnull7043 function TGenHashSet.EnumeratorGet(const Pos: THashSetCursor): _TItem_;
7044 begin
7045   ReadItemAt(Pos, Result);
7046 end;
7047 
7048 {--- TGenHashSet.EnumeratorNext ---}
EnumeratorNextnull7049 function TGenHashSet.EnumeratorNext(var Pos: THashSetCursor): Boolean;
7050 begin
7051   if Pos.IsNil then
7052     Pos := First
7053   else
7054     Pos.MoveNext;
7055   Result := Pos.HasItem;
7056 end;
7057 
7058 {--- TGenHashSet.ExchangeContent ---}
7059 procedure TGenHashSet.ExchangeContent(ASet: TGenHashSet);
7060 var
7061   Tmp : TMap;
7062 begin
7063   Tmp := fMap;
7064   fMap := ASet.fMap;
7065   ASet.fMap := Tmp;
7066 end;
7067 
7068 {--- TGenHashSet.GetItemToString ---}
GetItemToStringnull7069 function TGenHashSet.GetItemToString: TItemToString;
7070 begin
7071   Result := fMap.OnKeyToString;
7072 end;
7073 
7074 {--- TGenHashSet.GetOnHashItem ---}
TGenHashSet.GetOnHashItemnull7075 function TGenHashSet.GetOnHashItem: THashItem;
7076 begin
7077   Result := fMap.OnHashKey;
7078 end;
7079 
7080 {--- TGenHashSet.GetOnItemsEqual ---}
GetOnItemsEqualnull7081 function TGenHashSet.GetOnItemsEqual: TItemEquals;
7082 begin
7083   Result := fMap.OnKeysEqual;
7084 end;
7085 
7086 {--- TGenHashSet.Exclude ---}
7087 procedure TGenHashSet.Exclude(const Item: _TItem_);
7088 begin
7089   fMap.Exclude(Item);
7090 end;
7091 
7092 {--- TGenHashSet.ExcludeAll ---}
7093 procedure TGenHashSet.ExcludeAll(ASet: TGenHashSet);
7094 var
7095   C: THashMapCursor;
7096   I: Integer;
7097 begin
7098   if ASet.GetSize > 0 then
7099   begin
7100     C := ASet.fMap.First;
7101     for I := 1 to ASet.GetSize do
7102     begin
7103       Exclude(ASet.fMap.Keys[C]);
7104       C.MoveNext;
7105     end;
7106   end;
7107 end;
7108 
7109 {--- TGenHashSet.First ---}
TGenHashSet.Firstnull7110 function TGenHashSet.First: THashSetCursor;
7111 begin
7112   Result.Init(Self, fMap.First);
7113 end;
7114 
7115 {--- TGenHashSet.GetEnumerator ---}
GetEnumeratornull7116 function TGenHashSet.GetEnumerator: TEnumerator;
7117 begin
7118   Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
7119 end;
7120 
7121 {--- TGenHashSet.GetItemAt ---}
GetItemAtnull7122 function TGenHashSet.GetItemAt(const Position: THashSetCursor): _TItem_;
7123 begin
7124   fMap.ReadKeyAt(Position.Pos, Result);
7125 end;
7126 
7127 {--- TGenHashSet.GetSize ---}
GetSizenull7128 function TGenHashSet.GetSize: Integer;
7129 begin
7130   Result := fMap.Size;
7131 end;
7132 
7133 {--- TGenHashSet.SetOnHashItem ---}
7134 procedure TGenHashSet.SetOnHashItem(AValue: THashItem);
7135 begin
7136   if AValue = nil then
7137     fMap.OnHashKey := @DefaultHashItem
7138   else
7139     fMap.OnHashKey := AValue;
7140 end;
7141 
7142 {--- TGenHashSet.SetOnItemsEqual ---}
7143 procedure TGenHashSet.SetOnItemsEqual(AValue: TItemEquals);
7144 begin
7145   if AValue = nil then
7146     fMap.OnKeysEqual := @DefaultItemsEqual
7147   else
7148     fMap.OnKeysEqual := AValue;
7149 end;
7150 
7151 {--- TGenHashSet.SetOnItemToString ---}
7152 procedure TGenHashSet.SetOnItemToString(AValue: TItemToString);
7153 begin
7154   if AValue = nil then
7155     fMap.OnKeyToString := @DefaultItemToString
7156   else
7157     fMap.OnKeyToString := AValue;
7158 end;
7159 
7160 {--- TGenHashSet.Include ---}
7161 procedure TGenHashSet.Include(const Item: _TItem_);
7162 begin
7163   fMap.Include(Item, 0);
7164 end;
7165 
7166 {--- TGenHashSet.IncludeAll ---}
7167 procedure TGenHashSet.IncludeAll(ASet: TGenHashSet);
7168 var
7169   C: THashMapCursor;
7170   I: Integer;
7171 begin
7172   if ASet.GetSize > 0 then
7173   begin
7174     C := ASet.fMap.First;
7175     for I := 1 to ASet.GetSize do
7176     begin
7177       Include(ASet.fMap.Keys[C]);
7178       C.MoveNext;
7179     end;
7180   end;
7181 end;
7182 
7183 {--- TGenHashSet.Insert ---}
7184 procedure TGenHashSet.Insert(const Item: _TItem_);
7185 var
7186   Inserted : Boolean;
7187 begin
7188   Insert(Item, Inserted);
7189   if not Inserted then
7190     RaiseItemAlreadyInSet;
7191 end;
7192 
7193 {--- TGenHashSet.Insert ---}
7194 procedure TGenHashSet.Insert(const Item: _TItem_; out Inserted: Boolean);
7195 begin
7196   fMap.Insert(Item, 0, Inserted);
7197 end;
7198 
7199 {--- TGenHashSet.Intersection ---}
7200 procedure TGenHashSet.Intersection(Left, Right: TGenHashSet);
7201 var
7202   Inter, Tmp : TGenHashSet;
7203   I : Integer;
7204   C : THashMapCursor;
7205   Item : _TItem_;
7206 begin
7207   if (Left.GetSize = 0) or (Right.GetSize = 0) then
7208     Clear
7209   else
7210   begin
7211     Inter := TGenHashSet.Create;
7212     Inter.OnHashItem := OnHashItem;
7213     Inter.OnItemsEqual := OnItemsEqual;
7214     Inter.OnItemToString := OnItemToString;
7215 
7216     try
7217       if Left.GetSize < Right.GetSize then
7218       begin
7219         Tmp := Left;
7220         Left := Right;
7221         Right := Tmp;
7222       end;
7223 
7224       C := Left.fMap.First;
7225       for I := 1 to Left.GetSize do
7226       begin
7227         Item := Left.fMap.Keys[C];
7228         if Right.fMap.Contains(Item) then
7229           Inter.Include(Item);
7230         C.MoveNext;
7231       end;
7232 
7233       ExchangeContent(Inter);
7234     finally
7235       Inter.Free;
7236     end;
7237   end;
7238 end;
7239 
7240 {--- TGenHashSet.IsEmpty ---}
IsEmptynull7241 function TGenHashSet.IsEmpty: Boolean;
7242 begin
7243   Result := (fMap.Size = 0);
7244 end;
7245 
7246 {--- TGenHashSet.IsSubset ---}
TGenHashSet.IsSubsetnull7247 function TGenHashSet.IsSubset(OfSet: TGenHashSet): Boolean;
7248 var
7249   I : Integer;
7250   C : THashMapCursor;
7251 begin
7252   if GetSize > 0 then
7253   begin
7254     C := fMap.First;
7255     for I := 1 to GetSize do
7256     begin
7257       if not OfSet.fMap.Contains(fMap.Keys[C]) then
7258       begin
7259         Result := false;
7260         Exit;
7261       end;
7262       C.MoveNext;
7263     end;
7264   end;
7265   Result := true;
7266 end;
7267 
7268 {--- TGenHashSet.Overlaps ---}
Overlapsnull7269 function TGenHashSet.Overlaps(ASet: TGenHashSet): Boolean;
7270 var
7271   I : Integer;
7272   C : THashMapCursor;
7273 begin
7274   Result := false;
7275   if GetSize > 0 then
7276   begin
7277     C := fMap.First;
7278     for I := 1 to GetSize do
7279     begin
7280       if ASet.fMap.Contains(fMap.Keys[C]) then
7281       begin
7282         Result := true;
7283         Break;
7284       end;
7285       C.MoveNext;
7286     end;
7287   end;
7288 end;
7289 
7290 {--- TGenHashSet.ReadItemAt ---}
7291 procedure TGenHashSet.ReadItemAt(const Position: THashSetCursor;
7292   out Value: _TItem_);
7293 begin
7294   fMap.ReadKeyAt(Position.Pos, Value);
7295 end;
7296 
7297 {--- TGenHashSet.SymmetricDifference ---}
7298 procedure TGenHashSet.SymmetricDifference(Left, Right: TGenHashSet);
7299 var
7300   Inter: TGenHashSet;
7301 begin
7302   Inter := TGenHashSet.Create;
7303   Inter.OnHashItem := OnHashItem;
7304   Inter.OnItemsEqual := OnItemsEqual;
7305   Inter.OnItemToString := OnItemToString;
7306 
7307   try
7308     Inter.Intersection(Left, Right);
7309 
7310     Union(Left, Right);
7311     Difference(Self, Inter);
7312   finally
7313     Inter.Free;
7314   end;
7315 end;
7316 
7317 {--- TGenHashSet.ToString ---}
TGenHashSet.ToStringnull7318 function TGenHashSet.ToString: String;
7319 var
7320   C : THashMapCursor;
7321 begin
7322   Result := '{';
7323   if GetSize > 0 then
7324   begin
7325     C := fMap.First;
7326     while C.HasItem do
7327     begin
7328       Result := Result + fMap.OnKeyToString(fMap.Keys[C]);
7329       if not C.IsLast then
7330         Result := Result + '; ';
7331       C.MoveNext;
7332     end;
7333   end;
7334   Result := Result + '}';
7335 end;
7336 
7337 {--- TGenHashSet.Union ---}
7338 procedure TGenHashSet.Union(Left, Right: TGenHashSet);
7339 begin
7340   if Left <> Self then
7341   begin
7342     Clear;
7343     IncludeAll(Left);
7344   end;
7345 
7346   if Left <> Right then
7347     IncludeAll(Right);
7348 end;
7349 
7350 {======================}
7351 {=== TTreeMapCursor ===}
7352 {======================}
7353 
7354 {--- TTreeMapCursor.Equals ---}
Equalsnull7355 function TTreeMapCursor.Equals(const Cursor: TTreeMapCursor): Boolean;
7356 begin
7357   Result := (fTreeMap = Cursor.fTreeMap) and (fEntry = Cursor.fEntry);
7358 end;
7359 
7360 {--- TTreeMapCursor.HasItem ---}
HasItemnull7361 function TTreeMapCursor.HasItem: Boolean;
7362 begin
7363   Result := (fEntry <> nil);
7364 end;
7365 
7366 {--- TTreeMapCursor.Init ---}
7367 constructor TTreeMapCursor.Init(Map: TAbstractTreeMap; AnEntry: Pointer);
7368 begin
7369   fTreeMap := Map;
7370   fEntry := AnEntry;
7371 end;
7372 
7373 {--- TTreeMapCursor.IsFirst ---}
IsFirstnull7374 function TTreeMapCursor.IsFirst: Boolean;
7375 begin
7376   Result := fTreeMap.CursorIsFirst(Self);
7377 end;
7378 
7379 {--- TTreeMapCursor.IsLast ---}
IsLastnull7380 function TTreeMapCursor.IsLast: Boolean;
7381 begin
7382   Result := fTreeMap.CursorIsLast(Self);
7383 end;
7384 
7385 {--- TTreeMapCursor.IsNil ---}
TTreeMapCursor.IsNilnull7386 function TTreeMapCursor.IsNil: Boolean;
7387 begin
7388   Result := (fEntry = nil);
7389 end;
7390 
7391 {--- TTreeMapCursor.MoveNext ---}
7392 procedure TTreeMapCursor.MoveNext;
7393 begin
7394   fTreeMap.CursorMoveNext(Self);
7395 end;
7396 
7397 {--- TTreeMapCursor.MovePrevious ---}
7398 procedure TTreeMapCursor.MovePrevious;
7399 begin
7400   fTreeMap.CursorMovePrev(Self);
7401 end;
7402 
7403 {===================}
7404 {=== TGenTreeMap ===}
7405 {===================}
7406 
7407 {--- TGenTreeMap.Ceiling ---}
TGenTreeMap.Ceilingnull7408 function TGenTreeMap.Ceiling(const Key: _TKey_): TTreeMapCursor;
7409 begin
7410   Result.Init(Self, GetCeilingEntry(Key));
7411 end;
7412 
7413 {--- TGenTreeMap.Clear ---}
7414 procedure TGenTreeMap.Clear;
7415 begin
7416   DeleteTree(fRoot);
7417   fRoot := nil;
7418 end;
7419 
7420 {--- TGenTreeMap.ColorOf ---}
TGenTreeMap.ColorOfnull7421 function TGenTreeMap.ColorOf(E: PEntry): TColor;
7422 begin
7423   if E = nil then
7424     Result := cBlack
7425   else
7426     Result := E^.Color;
7427 end;
7428 
7429 {--- TGenTreeMap.Contains ---}
Containsnull7430 function TGenTreeMap.Contains(const Key: _TKey_): Boolean;
7431 begin
7432   Result := GetEntry(Key) <> nil;
7433 end;
7434 
7435 {--- TGenTreeMap.Create ---}
7436 constructor TGenTreeMap.Create;
7437 begin
7438   inherited Create;
7439   fSize := 0;
7440   fRoot := nil;
7441   fNilCursor.Init(Self, nil);
7442   SetOnCompareKeys(nil);
7443   SetOnItemToString(nil);
7444   SetOnKeyToString(nil);
7445 end;
7446 
7447 {--- TGenTreeMap.DefaultCompareKeys ---}
DefaultCompareKeysnull7448 function TGenTreeMap.DefaultCompareKeys(const A, B: _TKey_): Integer;
7449 begin
7450   Unused(@A);
7451   Unused(@B);
7452   RaiseMethodNotRedefined;
7453   Result := 0;
7454 end;
7455 
7456 {--- TGenTreeMap.DefaultItemToString ---}
DefaultItemToStringnull7457 function TGenTreeMap.DefaultItemToString(const Item: _TItem_): String;
7458 begin
7459   Unused(@Item);
7460   RaiseMethodNotRedefined;
7461   Result := '';
7462 end;
7463 
7464 {--- TGenTreeMap.DefaultKeyToString ---}
TGenTreeMap.DefaultKeyToStringnull7465 function TGenTreeMap.DefaultKeyToString(const Key: _TKey_): String;
7466 begin
7467   Unused(@Key);
7468   RaiseMethodNotRedefined;
7469   Result := '';
7470 end;
7471 
7472 {--- TGenTreeMap.Delete ---}
7473 procedure TGenTreeMap.Delete(const Key: _TKey_);
7474 var
7475   Entry : PEntry;
7476 begin
7477   Entry := GetEntry(Key);
7478   if Entry = nil then
7479     RaiseKeyNotInMap;
7480 
7481   DeleteEntry(Entry);
7482 end;
7483 
7484 {--- TGenTreeMap.DeleteAt ---}
7485 procedure TGenTreeMap.DeleteAt(const Position: TTreeMapCursor);
7486 begin
7487   if Position.TreeMap <> Self then
7488     RaiseCursorDenotesWrongContainer;
7489 
7490   if Position.IsNil then
7491     RaiseCursorIsNil;
7492 
7493   DeleteEntry(Position.Entry);
7494 end;
7495 
7496 {--- TGenTreeMap.DeleteEntry ---}
7497 procedure TGenTreeMap.DeleteEntry(E: PEntry);
7498 var
7499   S, Replacement : PEntry;
7500 begin
7501   Dec(fSize);
7502 
7503   if (E^.Left <> nil) and (E^.Right <> nil) then
7504   begin
7505     S := Successor(E);
7506     E^.Key := S^.Key;
7507     E^.Value := S^.Value;
7508     E := S;
7509   end;
7510 
7511   if E^.Left <> nil then
7512     Replacement := E^.Left
7513   else
7514     Replacement := E^.Right;
7515 
7516   if Replacement <> nil then
7517   begin
7518     Replacement^.Parent := E^.Parent;
7519 
7520     if E^.Parent = nil then
7521       fRoot := Replacement
7522     else if E = E^.Parent^.Left then
7523       E^.Parent^.Left := Replacement
7524     else
7525       E^.Parent^.Right := Replacement;
7526 
7527     E^.Left := nil;
7528     E^.Right := nil;
7529     E^.Parent := nil;
7530 
7531     if E^.Color = cBlack then
7532       RepairAfterDelete(Replacement);
7533   end
7534   else if E^.Parent = nil then
7535     fRoot := nil
7536   else
7537   begin
7538     if E^.Color = cBlack then
7539       RepairAfterDelete(E);
7540 
7541     if E^.Parent <> nil then
7542     begin
7543       if E = E^.Parent^.Left then
7544         E^.Parent^.Left := nil
7545       else if E = E^.Parent^.Right then
7546         E^.Parent^.Right := nil;
7547 
7548       E^.Parent := nil;
7549     end;
7550   end;
7551   Dispose(E);
7552 end;
7553 
7554 {--- TGenTreeMap.DeleteFirst ---}
7555 procedure TGenTreeMap.DeleteFirst;
7556 begin
7557   if fSize = 0 then
7558     RaiseContainerEmpty;
7559 
7560   DeleteEntry(GetFirstEntry);
7561 end;
7562 
7563 {--- TGenTreeMap.DeleteLast ---}
7564 procedure TGenTreeMap.DeleteLast;
7565 begin
7566   if fSize = 0 then
7567     RaiseContainerEmpty;
7568 
7569   DeleteEntry(GetLastEntry);
7570 end;
7571 
7572 {--- TGenTreeMap.DeleteTree ---}
7573 procedure TGenTreeMap.DeleteTree(E: PEntry);
7574 var
7575   R, L : PEntry;
7576 begin
7577   while true do
7578   begin
7579     if E = nil then
7580       Exit;
7581 
7582     R := E^.Right;
7583     L := E^.Left;
7584 
7585     Dispose(E);
7586     Dec(fSize);
7587 
7588     DeleteTree(L);
7589 
7590     E := R;
7591   end;
7592 end;
7593 
7594 {--- TGenTreeMap.EnumeratorGet ---}
TGenTreeMap.EnumeratorGetnull7595 function TGenTreeMap.EnumeratorGet(const Pos: TTreeMapCursor): _TItem_;
7596 begin
7597   ReadItemAt(Pos, Result);
7598 end;
7599 
7600 {--- TGenTreeMap.EnumeratorNext ---}
TGenTreeMap.EnumeratorNextnull7601 function TGenTreeMap.EnumeratorNext(var Pos: TTreeMapCursor): Boolean;
7602 begin
7603   if Pos.IsNil then
7604     Pos := First
7605   else
7606     Pos.MoveNext;
7607   Result := Pos.HasItem;
7608 end;
7609 
7610 {--- TGenTreeMap.Destroy ---}
7611 destructor TGenTreeMap.Destroy;
7612 begin
7613   Clear;
7614   inherited Destroy;
7615 end;
7616 
7617 {--- TGenTreeMap.Exclude ---}
7618 procedure TGenTreeMap.Exclude(const Key: _TKey_);
7619 var
7620   Entry: PEntry;
7621 begin
7622   Entry := GetEntry(Key);
7623   if Entry <> nil then
7624     DeleteEntry(Entry);
7625 end;
7626 
7627 {--- TGenTreeMap.Find ---}
Findnull7628 function TGenTreeMap.Find(const Key: _TKey_): TTreeMapCursor;
7629 begin
7630   Result.Init(Self, GetEntry(Key));
7631 end;
7632 
7633 {--- TGenTreeMap.First ---}
Firstnull7634 function TGenTreeMap.First: TTreeMapCursor;
7635 begin
7636   Result.Init(Self, GetFirstEntry);
7637 end;
7638 
7639 {--- TGenTreeMap.FirstItem ---}
TGenTreeMap.FirstItemnull7640 function TGenTreeMap.FirstItem: _TItem_;
7641 begin
7642   if fSize = 0 then
7643     RaiseContainerEmpty;
7644 
7645   Result := GetFirstEntry^.Value;
7646 end;
7647 
7648 {--- TGenTreeMap.FirstKey ---}
TGenTreeMap.FirstKeynull7649 function TGenTreeMap.FirstKey: _TKey_;
7650 begin
7651   if fSize = 0 then
7652     RaiseContainerEmpty;
7653 
7654   Result := GetFirstEntry^.Key;
7655 end;
7656 
7657 {--- TGenTreeMap.RepairAfterDelete ---}
7658 procedure TGenTreeMap.RepairAfterDelete(E: PEntry);
7659 var
7660   Sib : PEntry;
7661 begin
7662   while (E <> fRoot) and (ColorOf(E) = cBlack) do
7663   begin
7664     if E = LeftOf(ParentOf(E)) then
7665     begin
7666       Sib := RightOf(ParentOf(E));
7667 
7668       if ColorOf(Sib) = cRed then
7669       begin
7670         SetColor(Sib, cBlack);
7671         SetColor(ParentOf(E), cRed);
7672         RotateLeft(ParentOf(E));
7673         Sib := RightOf(ParentOf(E));
7674       end;
7675 
7676       if (ColorOf(LeftOf(Sib)) = cBlack) and (ColorOf(RightOf(Sib)) = cBlack) then
7677       begin
7678         SetColor(Sib, cRed);
7679         E := ParentOf(E);
7680       end
7681       else
7682       begin
7683         if ColorOf(RightOf(Sib)) = cBlack then
7684         begin
7685           SetColor(LeftOf(Sib), cBlack);
7686           SetColor(Sib, cRed);
7687           RotateRight(Sib);
7688           Sib := RightOf(ParentOf(E));
7689         end;
7690 
7691         SetColor(Sib, ColorOf(ParentOf(E)));
7692         SetColor(ParentOf(E), cBlack);
7693         SetColor(RightOf(Sib), cBlack);
7694         RotateLeft(ParentOf(E));
7695         E := fRoot;
7696       end;
7697     end
7698     else
7699     begin
7700       Sib := LeftOf(ParentOf(E));
7701 
7702       if ColorOf(Sib) = cRed then
7703       begin
7704         SetColor(Sib, cBlack);
7705         SetColor(ParentOf(E), cRed);
7706         RotateRight(ParentOf(E));
7707         Sib := LeftOf(ParentOf(E));
7708       end;
7709 
7710       if (ColorOf(RightOf(Sib)) = cBlack) and (ColorOf(LeftOf(Sib)) = cBlack) then
7711       begin
7712         SetColor(Sib, cRed);
7713         E := ParentOf(E);
7714       end
7715       else
7716       begin
7717 
7718         if ColorOf(LeftOf(Sib)) = cBlack then
7719         begin
7720           SetColor(RightOf(Sib), cBlack);
7721           SetColor(Sib, cRed);
7722           RotateLeft(Sib);
7723           Sib := LeftOf(ParentOf(E));
7724         end;
7725 
7726         SetColor(Sib, ColorOf(ParentOf(E)));
7727         SetColor(ParentOf(E), cBlack);
7728         SetColor(LeftOf(Sib), cBlack);
7729         RotateRight(ParentOf(E));
7730         E := fRoot;
7731       end;
7732     end;
7733   end;
7734 
7735   SetColor(E, cBlack);
7736 end;
7737 
7738 {--- TGenTreeMap.RepairAfterInsert ---}
7739 procedure TGenTreeMap.RepairAfterInsert(E: PEntry);
7740 var
7741   Y : PEntry;
7742 begin
7743   E^.Color := cRed;
7744 
7745   while (E <> nil) and (E <> fRoot) and (E^.Parent^.Color = cRed) do
7746   begin
7747     if ParentOf(E) = LeftOf(ParentOf(ParentOf(E))) then
7748     begin
7749       Y := RightOf(ParentOf(ParentOf(E)));
7750       if ColorOf(Y) = cRed then
7751       begin
7752         SetColor(ParentOf(E), cBlack);
7753         SetColor(Y, cBlack);
7754         SetColor(ParentOf(ParentOf(E)), cRed);
7755         E := ParentOf(ParentOf(E));
7756       end
7757       else
7758       begin
7759         if E = RightOf(ParentOf(E)) then
7760         begin
7761           E := ParentOf(E);
7762           RotateLeft(E);
7763         end;
7764         SetColor(ParentOf(E), cBlack);
7765         SetColor(ParentOf(ParentOf(E)), cRed);
7766         RotateRight(ParentOf(ParentOf(E)));
7767       end;
7768     end
7769     else
7770     begin
7771       Y := LeftOf(ParentOf(ParentOf(E)));
7772       if ColorOf(Y) = cRed then
7773       begin
7774         SetColor(ParentOf(E), cBlack);
7775         SetColor(Y, cBlack);
7776         SetColor(ParentOf(ParentOf(E)), cRed);
7777         E := ParentOf(ParentOf(E));
7778       end
7779       else
7780       begin
7781         if E = LeftOf(ParentOf(E)) then
7782         begin
7783           E := ParentOf(E);
7784           RotateRight(E);
7785         end;
7786         SetColor(ParentOf(E), cBlack);
7787         SetColor(ParentOf(ParentOf(E)), cRed);
7788         RotateLeft(ParentOf(ParentOf(E)));
7789       end;
7790     end;
7791   end;
7792 
7793   fRoot^.Color := cBlack;
7794 end;
7795 
7796 {--- TGenTreeMap.Floor ---}
Floornull7797 function TGenTreeMap.Floor(const Key: _TKey_): TTreeMapCursor;
7798 begin
7799   Result.Init(Self, GetFloorEntry(Key));
7800 end;
7801 
7802 {--- TGenTreeMap.GetEnumerator ---}
TGenTreeMap.GetEnumeratornull7803 function TGenTreeMap.GetEnumerator: TEnumerator;
7804 begin
7805   Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
7806 end;
7807 
7808 {--- TGenTreeMap.GetCeilingEntry ---}
GetCeilingEntrynull7809 function TGenTreeMap.GetCeilingEntry(const Key: _TKey_): PEntry;
7810 var
7811   Cmp : Integer;
7812   Ch, Parent : PEntry;
7813 begin
7814   Result := fRoot;
7815   while Result <> nil do
7816   begin
7817     Cmp := fOnCompareKeys(Key, Result^.Key);
7818     if Cmp < 0 then
7819     begin
7820       if Result^.Left <> nil then
7821         Result := Result^.Left
7822       else
7823         Exit;
7824     end
7825     else if Cmp > 0 then
7826     begin
7827       if Result^.Right <> nil then
7828         Result := Result^.Right
7829       else
7830       begin
7831         Parent := Result^.Parent;
7832         Ch := Result;
7833         while (Parent <> nil) and (Ch = Parent^.Right) do
7834         begin
7835           Ch := Parent;
7836           Parent := Parent^.Parent;
7837         end;
7838         Result := Parent;
7839         Exit;
7840       end;
7841     end
7842     else
7843       Exit;
7844   end;
7845   Result := nil;
7846 end;
7847 
7848 {--- TGenTreeMap.GetEntry ---}
TGenTreeMap.GetEntrynull7849 function TGenTreeMap.GetEntry(const Key: _TKey_): PEntry;
7850 var
7851   Entry: PEntry;
7852   Cmp : Integer;
7853 begin
7854   Entry := fRoot;
7855   while Entry <> nil do
7856   begin
7857     Cmp := fOnCompareKeys(Key, Entry^.Key);
7858 
7859     if Cmp < 0 then
7860       Entry := Entry^.Left
7861     else if Cmp > 0 then
7862       Entry := Entry^.Right
7863     else
7864     begin
7865       Result := Entry;
7866       Exit;
7867     end;
7868   end;
7869   Result := nil;
7870 end;
7871 
7872 {--- TGenTreeMap.GetFirstEntry ---}
GetFirstEntrynull7873 function TGenTreeMap.GetFirstEntry: PEntry;
7874 begin
7875   Result := fRoot;
7876   if Result <> nil then
7877     while Result^.Left <> nil do
7878       Result := Result^.Left;
7879 end;
7880 
7881 {--- TGenTreeMap.GetFloorEntry ---}
GetFloorEntrynull7882 function TGenTreeMap.GetFloorEntry(const Key: _TKey_): PEntry;
7883 var
7884   Cmp : Integer;
7885   Ch, Parent : PEntry;
7886 begin
7887   Result := fRoot;
7888   while Result <> nil do
7889   begin
7890     Cmp := fOnCompareKeys(Key, Result^.Key);
7891     if Cmp > 0 then
7892     begin
7893       if Result^.Right <> nil then
7894         Result := Result^.Right
7895       else
7896         Exit;
7897     end
7898     else if Cmp < 0 then
7899     begin
7900       if Result^.Left <> nil then
7901         Result := Result^.Left
7902       else
7903       begin
7904         Parent := Result^.Parent;
7905         Ch := Result;
7906         while (Parent <> nil) and (Ch = Parent^.Left) do
7907         begin
7908           Ch := Parent;
7909           Parent := Parent^.Parent;
7910         end;
7911         Result := Parent;
7912         Exit;
7913       end;
7914     end
7915     else
7916       Exit;
7917   end;
7918   Result := nil;
7919 end;
7920 
7921 {--- TGenTreeMap.GetItem ---}
GetItemnull7922 function TGenTreeMap.GetItem(const Key: _TKey_): _TItem_;
7923 var
7924   Entry : PEntry;
7925 begin
7926   Entry := GetEntry(Key);
7927   if Entry = nil then
7928     RaiseKeyNotInMap;
7929 
7930   Result := Entry^.Value;
7931 end;
7932 
7933 {--- TGenTreeMap.GetItemAt ---}
GetItemAtnull7934 function TGenTreeMap.GetItemAt(const Position: TTreeMapCursor): _TItem_;
7935 begin
7936   if Position.TreeMap <> Self then
7937     RaiseCursorDenotesWrongContainer;
7938 
7939   if Position.IsNil then
7940     RaiseCursorIsNil;
7941 
7942   Result := PEntry(Position.Entry)^.Value;
7943 end;
7944 
7945 {--- TGenTreeMap.GetKeyAt ---}
TGenTreeMap.GetKeyAtnull7946 function TGenTreeMap.GetKeyAt(const Position: TTreeMapCursor): _TKey_;
7947 begin
7948   if Position.TreeMap <> Self then
7949     RaiseCursorDenotesWrongContainer;
7950 
7951   if Position.IsNil then
7952     RaiseCursorIsNil;
7953 
7954   Result := PEntry(Position.Entry)^.Key;
7955 end;
7956 
7957 {--- TGenTreeMap.GetLastEntry ---}
GetLastEntrynull7958 function TGenTreeMap.GetLastEntry: PEntry;
7959 begin
7960   Result := fRoot;
7961   if Result <> nil then
7962     while Result^.Right <> nil do
7963       Result := Result^.Right;
7964 end;
7965 
7966 {--- TGenTreeMap.Include ---}
7967 procedure TGenTreeMap.Include(const Key: _TKey_; const Value: _TItem_);
7968 var
7969   T, Parent, N : PEntry;
7970   Cmp : Integer;
7971 begin
7972   if fRoot = nil then
7973   begin
7974     fRoot := NewEntry(nil, Key, Value);
7975     fSize := 1;
7976   end
7977   else
7978   begin
7979     T := fRoot;
7980     repeat
7981       Parent := T;
7982       Cmp := fOnCompareKeys(Key, T^.Key);
7983       if Cmp < 0 then
7984         T := T^.Left
7985       else if Cmp > 0 then
7986         T := T^.Right
7987       else
7988       begin
7989         T^.Value := Value;
7990         Exit;
7991       end;
7992     until T = nil;
7993 
7994     N := NewEntry(Parent, Key, Value);
7995     if Cmp < 0 then
7996       Parent^.Left := N
7997     else
7998       Parent^.Right := N;
7999     RepairAfterInsert(N);
8000     Inc(fSize);
8001   end;
8002 end;
8003 
8004 {--- TGenTreeMap.Insert ---}
8005 procedure TGenTreeMap.Insert(const Key: _TKey_; const Value: _TItem_);
8006 var
8007   Inserted : Boolean;
8008 begin
8009   Insert(Key, Value, Inserted);
8010   if not Inserted then
8011     RaiseKeyAlreadyInMap;
8012 end;
8013 
8014 {--- TGenTreeMap.Insert ---}
8015 procedure TGenTreeMap.Insert(const Key: _TKey_; const Value: _TItem_; out
8016   Inserted: Boolean);
8017 var
8018   T, Parent, N : PEntry;
8019   Cmp : Integer;
8020 begin
8021   Inserted := false;
8022   if fRoot = nil then
8023   begin
8024     fRoot := NewEntry(nil, Key, Value);
8025     fSize := 1;
8026     Inserted := true;
8027   end
8028   else
8029   begin
8030     T := fRoot;
8031     repeat
8032       Parent := T;
8033       Cmp := fOnCompareKeys(Key, T^.Key);
8034       if Cmp < 0 then
8035         T := T^.Left
8036       else if Cmp > 0 then
8037         T := T^.Right
8038       else
8039         Exit;
8040     until T = nil;
8041 
8042     N := NewEntry(Parent, Key, Value);
8043     if Cmp < 0 then
8044       Parent^.Left := N
8045     else
8046       Parent^.Right := N;
8047     RepairAfterInsert(N);
8048     Inc(fSize);
8049     Inserted := true;
8050   end;
8051 end;
8052 
8053 {--- TGenTreeMap.IsEmpty ---}
IsEmptynull8054 function TGenTreeMap.IsEmpty: Boolean;
8055 begin
8056   Result := (fSize = 0);
8057 end;
8058 
8059 {--- TGenTreeMap.Last ---}
Lastnull8060 function TGenTreeMap.Last: TTreeMapCursor;
8061 begin
8062   Result.Init(Self, GetLastEntry);
8063 end;
8064 
8065 {--- TGenTreeMap.LastItem ---}
LastItemnull8066 function TGenTreeMap.LastItem: _TItem_;
8067 begin
8068   if fSize = 0 then
8069     RaiseContainerEmpty;
8070 
8071   Result := GetLastEntry^.Value;
8072 end;
8073 
8074 {--- TGenTreeMap.LastKey ---}
LastKeynull8075 function TGenTreeMap.LastKey: _TKey_;
8076 begin
8077   if fSize = 0 then
8078     RaiseContainerEmpty;
8079 
8080   Result := GetLastEntry^.Key;
8081 end;
8082 
8083 {--- TGenTreeMap.LeftOf ---}
LeftOfnull8084 function TGenTreeMap.LeftOf(E: PEntry): PEntry;
8085 begin
8086   if E = nil then
8087     Result := nil
8088   else
8089     Result := E^.Left;
8090 end;
8091 
8092 {--- TGenTreeMap.NewEntry ---}
NewEntrynull8093 function TGenTreeMap.NewEntry(AParent: PEntry; const AKey: _TKey_;
8094   const AValue: _TItem_) : PEntry;
8095 begin
8096   New(Result);
8097   Result^.Parent := AParent;
8098   Result^.Key := AKey;
8099   Result^.Value := AValue;
8100   Result^.Left := nil;
8101   Result^.Right := nil;
8102 end;
8103 
8104 {--- TGenTreeMap.ParentOf ---}
ParentOfnull8105 function TGenTreeMap.ParentOf(E: PEntry): PEntry;
8106 begin
8107   if E = nil then
8108     Result := nil
8109   else
8110     Result := E^.Parent;
8111 end;
8112 
8113 {--- TGenTreeMap.Predecessor ---}
Predecessornull8114 function TGenTreeMap.Predecessor(E: PEntry): PEntry;
8115 var
8116   Ch : PEntry;
8117 begin
8118   if E = nil then
8119     Result := nil
8120   else if E^.Left <> nil then
8121   begin
8122     Result := E^.Left;
8123     while Result^.Right <> nil do
8124       Result := Result^.Right;
8125   end
8126   else
8127   begin
8128     Result := E^.Parent;
8129     Ch := E;
8130     while (Result <> nil) and (Ch = Result^.Left) do
8131     begin
8132       Ch := Result;
8133       Result := Result^.Parent;
8134     end;
8135   end;
8136 end;
8137 
8138 {--- TGenTreeMap.ReadFirstItem ---}
8139 procedure TGenTreeMap.ReadFirstItem(out Value : _TItem_);
8140 begin
8141   if fSize = 0 then
8142     RaiseContainerEmpty;
8143 
8144   Value := GetFirstEntry^.Value;
8145 end;
8146 
8147 {--- TGenTreeMap.ReadFirstKey ---}
8148 procedure TGenTreeMap.ReadFirstKey(out Key : _TKey_); inline;
8149 begin
8150   if fSize = 0 then
8151     RaiseContainerEmpty;
8152 
8153   Key := GetFirstEntry^.Key;
8154 end;
8155 
8156 {--- TGenTreeMap.ReadItem ---}
8157 procedure TGenTreeMap.ReadItem(const Key: _TKey_; out Value: _TItem_);
8158 var
8159   Entry : PEntry;
8160 begin
8161   Entry := GetEntry(Key);
8162   if Entry = nil then
8163     RaiseKeyNotInMap;
8164 
8165   Value := Entry^.Value;
8166 end;
8167 
8168 {--- TGenTreeMap.ReadItemAt ---}
8169 procedure TGenTreeMap.ReadItemAt(const Position: TTreeMapCursor; out Value: _TItem_);
8170 begin
8171   if Position.TreeMap <> Self then
8172     RaiseCursorDenotesWrongContainer;
8173 
8174   if Position.IsNil then
8175     RaiseCursorIsNil;
8176 
8177   Value :=  PEntry(Position.Entry)^.Value;
8178 end;
8179 
8180 {--- TGenTreeMap.ReadKeyAt ---}
8181 procedure TGenTreeMap.ReadKeyAt(const Position : TTreeMapCursor; out Key: _TKey_);
8182 begin
8183   if Position.TreeMap <> Self then
8184     RaiseCursorDenotesWrongContainer;
8185 
8186   if Position.IsNil then
8187     RaiseCursorIsNil;
8188 
8189   Key :=  PEntry(Position.Entry)^.Key;
8190 end;
8191 
8192 {--- TGenTreeMap.ReadLastItem ---}
8193 procedure TGenTreeMap.ReadLastItem(out Value : _TItem_);
8194 begin
8195   if fSize = 0 then
8196     RaiseContainerEmpty;
8197 
8198   Value := GetLastEntry^.Value;
8199 end;
8200 
8201 {--- TGenTreeMap.ReadLastKey ---}
8202 procedure TGenTreeMap.ReadLastKey(out Key : _TKey_); inline;
8203 begin
8204   if fSize = 0 then
8205     RaiseContainerEmpty;
8206 
8207   Key := GetLastEntry^.Key;
8208 end;
8209 
8210 {--- TGenTreeMap.Replace ---}
8211 procedure TGenTreeMap.Replace(const Key: _TKey_; const Value: _TItem_);
8212 var
8213   Entry : PEntry;
8214 begin
8215   Entry := GetEntry(Key);
8216   if Entry = nil then
8217     RaiseKeyNotInMap;
8218 
8219   Entry^.Value := Value;
8220 end;
8221 
8222 {--- TGenTreeMap.RightOf ---}
TGenTreeMap.RightOfnull8223 function TGenTreeMap.RightOf(E: PEntry): PEntry;
8224 begin
8225   if E = nil then
8226     Result := nil
8227   else
8228     Result := E^.Right;
8229 end;
8230 
8231 {--- TGenTreeMap.RotateLeft ---}
8232 procedure TGenTreeMap.RotateLeft(E: PEntry);
8233 var
8234   R : PEntry;
8235 begin
8236   if E <> nil then
8237   begin
8238     R := E^.Right;
8239 
8240     E^.Right := R^.Left;
8241 
8242     if R^.Left <> nil then
8243       R^.Left^.Parent := E;
8244 
8245     R^.Parent := E^.Parent;
8246     if E^.Parent = nil then
8247       fRoot := R
8248     else if E^.Parent^.Left = E then
8249       E^.Parent^.Left := R
8250     else
8251       E^.Parent^.Right := R;
8252     R^.Left := E;
8253     E^.Parent := R;
8254   end;
8255 end;
8256 
8257 {--- TGenTreeMap.RotateRight ---}
8258 procedure TGenTreeMap.RotateRight(E: PEntry);
8259 var
8260   L : PEntry;
8261 begin
8262   if E <> nil then
8263   begin
8264     L := E^.Left;
8265     E^.Left := L^.Right;
8266     if L^.Right <> nil then
8267       L^.Right^.Parent := E;
8268     L^.Parent := E^.Parent;
8269     if E^.Parent = nil then
8270       fRoot := L
8271     else if E^.Parent^.Right = E then
8272       E^.Parent^.Right := L
8273     else
8274       E^.Parent^.Left := L;
8275     L^.Right := E;
8276     E^.Parent := L;
8277   end;
8278 end;
8279 
8280 {--- TGenTreeMap.SetColor ---}
8281 procedure TGenTreeMap.SetColor(E: PEntry; Color: TColor);
8282 begin
8283   if E <> nil then
8284     E^.Color := Color;
8285 end;
8286 
8287 {--- TGenTreeMap.SetOnCompareKeys ---}
8288 procedure TGenTreeMap.SetOnCompareKeys(AValue: TCompareKeys);
8289 begin
8290   if AValue = nil then
8291     fOnCompareKeys := @DefaultCompareKeys
8292   else
8293     fOnCompareKeys := AValue;
8294 end;
8295 
8296 {--- TGenTreeMap.SetOnItemToString ---}
8297 procedure TGenTreeMap.SetOnItemToString(AValue: TItemToString);
8298 begin
8299   if AValue = nil then
8300     fOnItemToString := @DefaultItemToString
8301   else
8302     fOnItemToString := AValue;
8303 end;
8304 
8305 {--- TGenTreeMap.SetOnKeyToString ---}
8306 procedure TGenTreeMap.SetOnKeyToString(AValue: TKeyToString);
8307 begin
8308   if AValue = nil then
8309     fOnKeyToString := @DefaultKeyToString
8310   else
8311     fOnKeyToString := AValue;
8312 end;
8313 
8314 {--- TGenTreeMap.SetItemAt ---}
8315 procedure TGenTreeMap.SetItemAt(const Position: TTreeMapCursor; Value: _TItem_);
8316 begin
8317   if Position.TreeMap <> Self then
8318     RaiseCursorDenotesWrongContainer;
8319 
8320   if Position.IsNil then
8321     RaiseCursorIsNil;
8322 
8323   PEntry(Position.Entry)^.Value := Value;
8324 end;
8325 
8326 {--- TGenTreeMap.Successor ---}
Successornull8327 function TGenTreeMap.Successor(E: PEntry): PEntry;
8328 var
8329   P, Ch : PEntry;
8330 begin
8331   if E = nil then
8332     Result := nil
8333   else if E^.Right <> nil then
8334   begin
8335     P := E^.Right;
8336     while P^.Left <> nil do
8337       P := P^.Left;
8338     Result := P;
8339   end
8340   else
8341   begin
8342     P := E^.Parent;
8343     Ch := E;
8344     while (P <> nil) and (Ch = P^.Right) do
8345     begin
8346       Ch := P;
8347       P := P^.Parent;
8348     end;
8349     Result := P;
8350   end;
8351 end;
8352 
8353 {--- TGenTreeMap.CursorIsFirst ---}
CursorIsFirstnull8354 function TGenTreeMap.CursorIsFirst(const Cursor: TTreeMapCursor): Boolean;
8355 begin
8356   Result := (Cursor.Entry <> nil)
8357     and (Cursor.Entry = (Cursor.TreeMap as TGenTreeMap).GetFirstEntry);
8358 end;
8359 
8360 {--- TGenTreeMap.CursorIsLast ---}
TGenTreeMap.CursorIsLastnull8361 function TGenTreeMap.CursorIsLast(const Cursor: TTreeMapCursor): Boolean;
8362 begin
8363   Result := (Cursor.Entry <> nil)
8364     and (Cursor.Entry = (Cursor.TreeMap as TGenTreeMap).GetLastEntry);
8365 end;
8366 
8367 {--- TGenTreeMap.CursorMoveNext ---}
8368 procedure TGenTreeMap.CursorMoveNext(const Cursor: TTreeMapCursor);
8369 begin
8370   if Cursor.Entry <> nil then
8371     Cursor.Entry := (Cursor.TreeMap as TGenTreeMap).Successor(Cursor.Entry);
8372 end;
8373 
8374 {--- TGenTreeMap.CursorMovePrev ---}
8375 procedure TGenTreeMap.CursorMovePrev(const Cursor: TTreeMapCursor);
8376 begin
8377   if Cursor.Entry <> nil then
8378     Cursor.Entry := (Cursor.TreeMap as TGenTreeMap).Predecessor(Cursor.Entry);
8379 end;
8380 
8381 {--- TGenTreeMap.ToString ---}
TGenTreeMap.ToStringnull8382 function TGenTreeMap.ToString: String;
8383 var
8384   Entry, LastEntry : PEntry;
8385 begin
8386   Result := '{';
8387 
8388   LastEntry := GetLastEntry;
8389 
8390   Entry := GetFirstEntry;
8391   while Entry <> nil do
8392   begin
8393     Result := Result + '(' + fOnKeyToString(Entry^.Key) + '=>' +
8394       fOnItemToString(Entry^.Value) + ')';
8395 
8396     if Entry <> LastEntry then
8397       Result := Result + ', ';
8398 
8399     Entry := Successor(Entry);
8400   end;
8401 
8402   Result := Result + '}';
8403 end;
8404 
8405 {======================}
8406 {=== TTreeSetCursor ===}
8407 {======================}
8408 
8409 {--- TTreeSetCursor.Equals ---}
TTreeSetCursor.Equalsnull8410 function TTreeSetCursor.Equals(const Cursor: TTreeSetCursor): Boolean;
8411 begin
8412   Result := fPos.Equals(Cursor.fPos)
8413 end;
8414 
8415 {--- TTreeSetCursor.HasItem ---}
HasItemnull8416 function TTreeSetCursor.HasItem: Boolean;
8417 begin
8418   Result := fPos.HasItem;
8419 end;
8420 
8421 {--- TTreeSetCursor.Init ---}
8422 constructor TTreeSetCursor.Init(TreeSet: TAbstractTreeSet; const APos: TTreeMapCursor);
8423 begin
8424   fTreeSet := TreeSet;
8425   fPos := APos;
8426 end;
8427 
8428 {--- TTreeSetCursor.IsFirst ---}
IsFirstnull8429 function TTreeSetCursor.IsFirst: Boolean;
8430 begin
8431   Result := fPos.IsFirst;
8432 end;
8433 
8434 {--- TTreeSetCursor.IsLast ---}
IsLastnull8435 function TTreeSetCursor.IsLast: Boolean;
8436 begin
8437   Result := fPos.IsLast;
8438 end;
8439 
8440 {--- TTreeSetCursor.IsNil ---}
TTreeSetCursor.IsNilnull8441 function TTreeSetCursor.IsNil: Boolean;
8442 begin
8443   Result := fPos.IsNil;
8444 end;
8445 
8446 {--- TTreeSetCursor.MoveNext ---}
8447 procedure TTreeSetCursor.MoveNext;
8448 begin
8449   fPos.MoveNext;
8450 end;
8451 
8452 {--- TTreeSetCursor.MovePrevious ---}
8453 procedure TTreeSetCursor.MovePrevious;
8454 begin
8455   fPos.MovePrevious;
8456 end;
8457 
8458 {===================}
8459 {=== TGenTreeSet ===}
8460 {===================}
8461 
8462 {--- TGenTreeSet.Ceiling ---}
TGenTreeSet.Ceilingnull8463 function TGenTreeSet.Ceiling(const Item: _TItem_): TTreeSetCursor;
8464 begin
8465   Result.Init(Self, fMap.Ceiling(Item));
8466 end;
8467 
8468 {--- TGenTreeSet.Clear ---}
8469 procedure TGenTreeSet.Clear;
8470 begin
8471   fMap.Clear;
8472 end;
8473 
8474 {--- TGenTreeSet.Contains ---}
Containsnull8475 function TGenTreeSet.Contains(const Item: _TItem_): Boolean;
8476 begin
8477   Result := fMap.Contains(Item);
8478 end;
8479 
8480 {--- TGenTreeSet.Create ---}
8481 constructor TGenTreeSet.Create;
8482 begin
8483   fMap := TMap.Create;
8484   fNilCursor.Init(Self, fMap.NilCursor);
8485   SetOnCompareItems(nil);
8486   SetOnItemToString(nil);
8487 end;
8488 
8489 {--- TGenTreeSet.DefaultCompareItems ---}
DefaultCompareItemsnull8490 function TGenTreeSet.DefaultCompareItems(const A, B: _TItem_): Integer;
8491 begin
8492   Unused(@A);
8493   Unused(@B);
8494   RaiseMethodNotRedefined;
8495   Result := 0;
8496 end;
8497 
8498 {--- TGenTreeSet.DefaultItemToString ---}
DefaultItemToStringnull8499 function TGenTreeSet.DefaultItemToString(const Item: _TItem_): String;
8500 begin
8501   Unused(@Item);
8502   RaiseMethodNotRedefined;
8503   Result := '';
8504 end;
8505 
8506 {--- TGenTreeSet.Delete ---}
8507 procedure TGenTreeSet.Delete(const Item: _TItem_);
8508 var
8509   C : TTreeMapCursor;
8510 begin
8511   C := fMap.Find(Item);
8512 
8513   if C.IsNil then
8514     RaiseItemNotInSet;
8515 
8516   fMap.DeleteAt(C);
8517 end;
8518 
8519 {--- TGenTreeSet.DeleteAt ---}
8520 procedure TGenTreeSet.DeleteAt(const Position: TTreeSetCursor);
8521 begin
8522   fMap.DeleteAt(Position.Pos);
8523 end;
8524 
8525 {--- TGenTreeSet.DeleteFirst ---}
8526 procedure TGenTreeSet.DeleteFirst;
8527 begin
8528   fMap.DeleteFirst;
8529 end;
8530 
8531 {--- TGenTreeSet.DeleteLast ---}
8532 procedure TGenTreeSet.DeleteLast;
8533 begin
8534   fMap.DeleteLast;
8535 end;
8536 
8537 {--- TGenTreeSet.Destroy ---}
8538 destructor TGenTreeSet.Destroy;
8539 begin
8540   fMap.Free;
8541   inherited;
8542 end;
8543 
8544 {--- TGenTreeSet.Difference ---}
8545 procedure TGenTreeSet.Difference(Left, Right: TGenTreeSet);
8546 begin
8547   if Left <> Self then
8548   begin
8549     Clear;
8550     IncludeAll(Left);
8551   end;
8552 
8553   if Left <> Right then
8554     ExcludeAll(Right)
8555   else
8556     Clear;
8557 end;
8558 
8559 {--- TGenTreeSet.EnumeratorGet ---}
EnumeratorGetnull8560 function TGenTreeSet.EnumeratorGet(const Pos: TTreeSetCursor): _TItem_;
8561 begin
8562   ReadItemAt(Pos, Result);
8563 end;
8564 
8565 {--- TGenTreeSet.EnumeratorNext ---}
EnumeratorNextnull8566 function TGenTreeSet.EnumeratorNext(var Pos: TTreeSetCursor): Boolean;
8567 begin
8568   if Pos.IsNil then
8569     Pos := First
8570   else
8571     Pos.MoveNext;
8572   Result := Pos.HasItem;
8573 end;
8574 
8575 {--- TGenTreeSet.ExchangeContent ---}
8576 procedure TGenTreeSet.ExchangeContent(ASet: TGenTreeSet);
8577 var
8578   Tmp : TMap;
8579 begin
8580   Tmp := fMap;
8581   fMap := ASet.fMap;
8582   ASet.fMap := Tmp;
8583 end;
8584 
8585 {--- TGenTreeSet.GetOnCompareItems ---}
TGenTreeSet.GetOnCompareItemsnull8586 function TGenTreeSet.GetOnCompareItems: TCompareItems;
8587 begin
8588   Result := fMap.OnCompareKeys;
8589 end;
8590 
8591 {--- TGenTreeSet.GetOnItemToString ---}
TGenTreeSet.GetOnItemToStringnull8592 function TGenTreeSet.GetOnItemToString: TItemToString;
8593 begin
8594   Result := fMap.OnKeyToString;
8595 end;
8596 
8597 {--- TGenTreeSet.Exclude ---}
8598 procedure TGenTreeSet.Exclude(const Item: _TItem_);
8599 begin
8600   fMap.Exclude(Item);
8601 end;
8602 
8603 {--- TGenTreeSet.ExcludeAll ---}
8604 procedure TGenTreeSet.ExcludeAll(ASet: TGenTreeSet);
8605 var
8606   C: TTreeMapCursor;
8607   I: Integer;
8608 begin
8609   if ASet.GetSize > 0 then
8610   begin
8611 
8612     C := ASet.fMap.First;
8613     for I := 1 to ASet.GetSize do
8614     begin
8615       Exclude(ASet.fMap.Keys[C]);
8616       C.MoveNext;
8617     end;
8618   end;
8619 end;
8620 
8621 {--- TTreeSetCursor ---}
Firstnull8622 function TGenTreeSet.First: TTreeSetCursor;
8623 begin
8624   Result.Init(Self, fMap.First);
8625 end;
8626 
8627 {--- TGenTreeSet.FirstItem ---}
TGenTreeSet.FirstItemnull8628 function TGenTreeSet.FirstItem: _TItem_;
8629 begin
8630   fMap.ReadFirstKey(Result);
8631 end;
8632 
8633 {--- TGenTreeSet.Floor ---}
Floornull8634 function TGenTreeSet.Floor(const Item: _TItem_): TTreeSetCursor;
8635 begin
8636   Result.Init(Self, fMap.Floor(Item));
8637 end;
8638 
8639 {--- TGenTreeSet.GetEnumerator ---}
GetEnumeratornull8640 function TGenTreeSet.GetEnumerator: TEnumerator;
8641 begin
8642   Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
8643 end;
8644 
8645 {--- TGenTreeSet.GetItemAt ---}
GetItemAtnull8646 function TGenTreeSet.GetItemAt(const Position: TTreeSetCursor): _TItem_;
8647 begin
8648   fMap.ReadKeyAt(Position.Pos, Result);
8649 end;
8650 
8651 {--- TGenTreeSet.GetSize ---}
GetSizenull8652 function TGenTreeSet.GetSize: Integer;
8653 begin
8654   Result := fMap.Size;
8655 end;
8656 
8657 {--- TGenTreeSet.SetOnCompareItems ---}
8658 procedure TGenTreeSet.SetOnCompareItems(AValue: TCompareItems);
8659 begin
8660   if AValue = nil then
8661     fMap.OnCompareKeys := @DefaultCompareItems
8662   else
8663     fMap.OnCompareKeys := AValue;
8664 end;
8665 
8666 {--- TGenTreeSet.SetOnItemToString ---}
8667 procedure TGenTreeSet.SetOnItemToString(AValue: TItemToString);
8668 begin
8669   if AValue = nil then
8670     fMap.OnKeyToString := @DefaultItemToString
8671   else
8672     fMap.OnKeyToString := AValue;
8673 end;
8674 
8675 {--- TGenTreeSet.Include ---}
8676 procedure TGenTreeSet.Include(const Item: _TItem_);
8677 begin
8678   fMap.Include(Item, 0);
8679 end;
8680 
8681 {--- TGenTreeSet.IncludeAll ---}
8682 procedure TGenTreeSet.IncludeAll(ASet: TGenTreeSet);
8683 var
8684   C: TTreeMapCursor;
8685   I: Integer;
8686 begin
8687   if ASet.GetSize > 0 then
8688   begin
8689     C := ASet.fMap.First;
8690 
8691     for I := 1 to ASet.GetSize do
8692     begin
8693       Include(ASet.fMap.Keys[C]);
8694       C.MoveNext;
8695     end;
8696   end;
8697 end;
8698 
8699 {--- TGenTreeSet.Insert ---}
8700 procedure TGenTreeSet.Insert(const Item: _TItem_);
8701 var
8702   Inserted : Boolean;
8703 begin
8704   Insert(Item, Inserted);
8705   if not Inserted then
8706     RaiseItemAlreadyInSet;
8707 end;
8708 
8709 {--- TGenTreeSet.Insert ---}
8710 procedure TGenTreeSet.Insert(const Item: _TItem_; out Inserted: Boolean);
8711 begin
8712   fMap.Insert(Item, 0, Inserted);
8713 end;
8714 
8715 {--- TGenTreeSet.Intersection ---}
8716 procedure TGenTreeSet.Intersection(Left, Right: TGenTreeSet);
8717 var
8718   Inter, Tmp : TGenTreeSet;
8719   I : Integer;
8720   C : TTreeMapCursor;
8721   Item : _TItem_;
8722 begin
8723   if (Left.GetSize = 0) or (Right.GetSize = 0) then
8724     Clear
8725   else
8726   begin
8727     Inter := TGenTreeSet.Create;
8728     Inter.OnCompareItems := OnCompareItems;
8729     Inter.OnItemToString := OnItemToString;
8730 
8731     try
8732       if Left.GetSize < Right.GetSize then
8733       begin
8734         Tmp := Left;
8735         Left := Right;
8736         Right := Tmp;
8737       end;
8738 
8739       C := Left.fMap.First;
8740       for I := 1 to Left.GetSize do
8741       begin
8742         Item := Left.fMap.Keys[C];
8743         if Right.fMap.Contains(Item) then
8744           Inter.Include(Item);
8745         C.MoveNext;
8746       end;
8747 
8748       ExchangeContent(Inter);
8749     finally
8750       Inter.Free;
8751     end;
8752   end;
8753 end;
8754 
8755 {--- TGenTreeSet.IsEmpty ---}
IsEmptynull8756 function TGenTreeSet.IsEmpty: Boolean;
8757 begin
8758   Result := fMap.Size = 0;
8759 end;
8760 
8761 {--- TGenTreeSet.IsSubset ---}
TGenTreeSet.IsSubsetnull8762 function TGenTreeSet.IsSubset(OfSet: TGenTreeSet): Boolean;
8763 var
8764   I : Integer;
8765   C : TTreeMapCursor;
8766 begin
8767   if GetSize > 0 then
8768   begin
8769     C := fMap.First;
8770     for I := 1 to GetSize do
8771     begin
8772       if not OfSet.fMap.Contains(fMap.Keys[C]) then
8773       begin
8774         Result := false;
8775         Exit;
8776       end;
8777       C.MoveNext;
8778     end;
8779   end;
8780   Result := true;
8781 end;
8782 
8783 {--- TGenTreeSet.Last ---}
Lastnull8784 function TGenTreeSet.Last: TTreeSetCursor;
8785 begin
8786   Result.Init(Self, fMap.Last);
8787 end;
8788 
8789 {--- TGenTreeSet.LastItem ---}
LastItemnull8790 function TGenTreeSet.LastItem: _TItem_;
8791 begin
8792   fMap.ReadLastKey(Result);
8793 end;
8794 
8795 {--- TGenTreeSet.Overlaps ---}
Overlapsnull8796 function TGenTreeSet.Overlaps(ASet: TGenTreeSet): Boolean;
8797 var
8798   I : Integer;
8799   C : TTreeMapCursor;
8800 begin
8801   Result := false;
8802   if GetSize > 0 then
8803   begin
8804     C := fMap.First;
8805     for I := 1 to GetSize do
8806     begin
8807       if ASet.fMap.Contains(fMap.Keys[C]) then
8808       begin
8809         Result := true;
8810         Break;
8811       end;
8812       C.MoveNext;
8813     end;
8814   end;
8815 end;
8816 
8817 {--- TGenTreeSet.ReadFirstItem ---}
8818 procedure TGenTreeSet.ReadFirstItem(out Value : _TItem_);
8819 begin
8820   fMap.ReadFirstKey(Value);
8821 end;
8822 
8823 {--- TGenTreeSet.ReadItemAt ---}
8824 procedure TGenTreeSet.ReadItemAt(const Position: TTreeSetCursor;
8825   out Value: _TItem_);
8826 begin
8827   fMap.ReadKeyAt(Position.Pos, Value);
8828 end;
8829 
8830 {--- TGenTreeSet.ReadLastItem ---}
8831 procedure TGenTreeSet.ReadLastItem(out Value : _TItem_);
8832 begin
8833   fMap.ReadLastKey(Value);
8834 end;
8835 
8836 {--- TGenTreeSet.SymmetricDifference ---}
8837 procedure TGenTreeSet.SymmetricDifference(Left, Right: TGenTreeSet);
8838 var
8839   Inter: TGenTreeSet;
8840 begin
8841   Inter := TGenTreeSet.Create;
8842   Inter.OnCompareItems := OnCompareItems;
8843   Inter.OnItemToString := OnItemToString;
8844   try
8845     Inter.Intersection(Left, Right);
8846     Union(Left, Right);
8847     Difference(Self, Inter);
8848   finally
8849     Inter.Free;
8850   end;
8851 end;
8852 
8853 {--- TGenTreeSet.ToString ---}
TGenTreeSet.ToStringnull8854 function TGenTreeSet.ToString: String;
8855 var
8856   C : TTreeMapCursor;
8857 begin
8858   Result := '{';
8859 
8860   if GetSize > 0 then
8861   begin
8862     C := fMap.First;
8863     while C.HasItem do
8864     begin
8865       Result := Result + fMap.OnKeyToString(fMap.Keys[C]);
8866       if not C.IsLast then
8867         Result := Result + '; ';
8868       C.MoveNext;
8869     end;
8870   end;
8871 
8872   Result := Result + '}';
8873 end;
8874 
8875 {--- TGenTreeSet.Union ---}
8876 procedure TGenTreeSet.Union(Left, Right: TGenTreeSet);
8877 begin
8878   if Left <> Self then
8879   begin
8880     Clear;
8881     IncludeAll(Left);
8882   end;
8883 
8884   if Left <> Right then
8885     IncludeAll(Right);
8886 end;
8887 
8888 end.
8889