Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

1859 rindas
74 KiB

  1. unit uutlGenerics;
  2. {$mode objfpc}{$H+}
  3. {$modeswitch nestedprocvars}
  4. interface
  5. uses
  6. Classes, SysUtils, TypInfo,
  7. uutlExceptions, uutlInterfaces, uutlAlgorithm, uutlCommon;
  8. type
  9. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  10. //Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  11. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  12. generic TutlLinkedList<T> = class(TutlInterfaceNoRefCount,
  13. specialize IutlEnumerable<T>)
  14. public type
  15. Iterator = specialize IutlBidirectionalInputOutputIterator<T>;
  16. private type
  17. PElement = ^TElement;
  18. TElement = packed record
  19. prev: PElement;
  20. next: PElement;
  21. data: T;
  22. end;
  23. TIterator = class(TInterfacedObject,
  24. Iterator,
  25. IutlBidirectionalIterator,
  26. IutlIterator)
  27. strict private
  28. fOwner: TutlLinkedList;
  29. fElement: PElement;
  30. private
  31. procedure ReleaseElement(const aElement: PElement);
  32. public { IutlIterator }
  33. function MoveNext: Boolean;
  34. function Clone: IutlIterator;
  35. function Equals(const aOther: IutlIterator): Boolean; overload;
  36. function GetIsValid: Boolean;
  37. property IsValid: Boolean read GetIsValid;
  38. public { IutlBidirectionalIterator }
  39. function MovePrev: Boolean;
  40. public { IutlBidirectionalInputOutputIterator }
  41. function GetItem: T;
  42. procedure SetItem(aValue: T);
  43. public
  44. property Element: PElement read fElement;
  45. property Owner: TutlLinkedList read fOwner;
  46. constructor Create(const aElement: PElement; const aOwner: TutlLinkedList);
  47. destructor Destroy; override;
  48. end;
  49. strict private
  50. fOwnsItems: Boolean;
  51. fCount: Integer;
  52. fFirst: PElement;
  53. fLast: PElement;
  54. fIterators: array of TIterator;
  55. function GetFirst: T;
  56. function GetLast: T;
  57. function GetIsEmpty: Boolean;
  58. function GetFirstIterator: Iterator;
  59. function GetLastIterator: Iterator;
  60. procedure LinkElement (const aElement: PElement);
  61. procedure InsertBefore (const aElement: PElement; constref aItem: T);
  62. procedure InsertAfter (const aElement: PElement; constref aItem: T);
  63. function Remove (const aElement: PElement; const aFreeItem: Boolean): T;
  64. function CreateIterator (const aElement: PElement): TIterator;
  65. procedure DestroyIterator (const aIterator: TIterator);
  66. protected
  67. procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
  68. public { IutlEnumerable }
  69. function GetEnumerator: specialize IEnumerator<T>;
  70. function GetUtlEnumerator: specialize IutlEnumerator<T>;
  71. public
  72. property Count: Integer read fCount;
  73. property IsEmpty: Boolean read GetIsEmpty;
  74. property First: T read GetFirst;
  75. property Last: T read GetLast;
  76. property FirstIterator: Iterator read GetFirstIterator;
  77. property LastIterator: Iterator read GetLastIterator;
  78. procedure PushFirst (constref aItem: T);
  79. function PopFirst (const aFreeItem: Boolean): T;
  80. procedure PopFirst;
  81. procedure PushLast (constref aItem: T);
  82. function PopLast (const aFreeItem: Boolean): T;
  83. procedure PopLast;
  84. procedure InsertBefore (const aIterator: IutlIterator; constref aItem: T);
  85. procedure InsertAfter (const aIterator: IutlIterator; constref aItem: T);
  86. function Remove (const aIterator: IutlIterator; const aFreeItem: Boolean): T;
  87. procedure Remove (const aIterator: IutlIterator);
  88. procedure Clear;
  89. constructor Create (const aOwnsItems: Boolean);
  90. destructor Destroy; override;
  91. end;
  92. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  93. generic __TutlArrayContainer<T> = class(TutlInterfaceNoRefCount)
  94. protected type
  95. PT = ^T;
  96. strict private
  97. fList: PT;
  98. function GetIsEmpty: Boolean;
  99. protected
  100. fCapacity: Integer;
  101. fOwnsItems: Boolean;
  102. fCanShrink: Boolean;
  103. fCanExpand: Boolean;
  104. protected
  105. function GetCount: Integer; virtual; abstract;
  106. function GetInternalItem (const aIndex: Integer): PT;
  107. procedure SetCapacity (const aValue: integer); virtual;
  108. procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
  109. procedure Shrink (const aExactFit: Boolean);
  110. procedure Expand;
  111. protected
  112. property Count: Integer read GetCount;
  113. property IsEmpty: Boolean read GetIsEmpty;
  114. property Capacity: Integer read fCapacity write SetCapacity;
  115. property CanShrink: Boolean read fCanShrink write fCanShrink;
  116. property CanExpand: Boolean read fCanExpand write fCanExpand;
  117. property OwnsItems: Boolean read fOwnsItems write fOwnsItems;
  118. public
  119. constructor Create(const aOwnsItems: Boolean);
  120. destructor Destroy; override;
  121. end;
  122. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  123. generic TutlQueue<T> = class(specialize __TutlArrayContainer<T>,
  124. specialize IutlEnumerable<T>)
  125. strict private
  126. fCount: Integer;
  127. fReadPos: Integer;
  128. fWritePos: Integer;
  129. protected
  130. function GetCount: Integer; override;
  131. procedure SetCapacity(const aValue: integer); override;
  132. public { IutlEnumerable }
  133. function GetEnumerator: specialize IEnumerator<T>;
  134. function GetUtlEnumerator: specialize IutlEnumerator<T>;
  135. property Enumerator: specialize IutlEnumerator<T> read GetUtlEnumerator;
  136. public
  137. property Count;
  138. property IsEmpty;
  139. property Capacity;
  140. property CanExpand;
  141. property CanShrink;
  142. property OwnsItems;
  143. procedure Enqueue(constref aItem: T);
  144. function Dequeue: T;
  145. function Dequeue(const aFreeItem: Boolean): T;
  146. function Peek: T;
  147. procedure ShrinkToFit;
  148. procedure Clear;
  149. constructor Create(const aOwnsItems: Boolean);
  150. destructor Destroy; override;
  151. end;
  152. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  153. generic TutlStack<T> = class(specialize __TutlArrayContainer<T>,
  154. specialize IutlEnumerable<T>)
  155. strict private
  156. fCount: Integer;
  157. protected
  158. function GetCount: Integer; override;
  159. public { IutlEnumerable }
  160. function GetEnumerator: specialize IEnumerator<T>;
  161. function GetUtlEnumerator: specialize IutlEnumerator<T>;
  162. property Enumerator: specialize IutlEnumerator<T> read GetUtlEnumerator;
  163. public
  164. property Count;
  165. property IsEmpty;
  166. property Capacity;
  167. property CanExpand;
  168. property CanShrink;
  169. property OwnsItems;
  170. procedure Push(constref aItem: T);
  171. function Pop: T;
  172. function Pop(const aFreeItem: Boolean): T;
  173. function Peek: T;
  174. procedure ShrinkToFit;
  175. procedure Clear;
  176. constructor Create(const aOwnsItems: Boolean);
  177. destructor Destroy; override;
  178. end;
  179. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  180. generic __TutlListBase<T> = class(specialize __TutlArrayContainer<T>,
  181. specialize IutlEnumerable<T>)
  182. strict private
  183. fCount: Integer;
  184. protected
  185. function GetCount: Integer; override;
  186. function GetItem (const aIndex: Integer): T; virtual;
  187. procedure SetItem (const aIndex: Integer; aValue: T); virtual;
  188. procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
  189. procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;
  190. public { IutlEnumerable }
  191. function GetEnumerator: specialize IEnumerator<T>;
  192. function GetUtlEnumerator: specialize IutlEnumerator<T>;
  193. property Enumerator: specialize IutlEnumerator<T> read GetUtlEnumerator;
  194. public
  195. property Count;
  196. property IsEmpty;
  197. property Capacity;
  198. property CanShrink;
  199. property CanExpand;
  200. property OwnsItems;
  201. procedure Clear;
  202. procedure ShrinkToFit;
  203. constructor Create(const aOwnsItems: Boolean);
  204. destructor Destroy; override;
  205. end;
  206. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  207. generic TutlSimpleList<T> = class(specialize __TutlListBase<T>,
  208. specialize IutlReadOnlyIndexer<T>,
  209. specialize IutlIndexer<T>)
  210. strict private
  211. function GetFirst: T;
  212. function GetLast: T;
  213. public
  214. property First: T read GetFirst;
  215. property Last: T read GetLast;
  216. property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
  217. function Add (constref aItem: T): Integer;
  218. procedure Insert (const aIndex: Integer; constref aItem: T);
  219. procedure Exchange (const aIndex1, aIndex2: Integer);
  220. procedure Move (const aCurrentIndex, aNewIndex: Integer);
  221. procedure Delete (const aIndex: Integer);
  222. function Extract (const aIndex: Integer): T;
  223. procedure PushFirst (constref aItem: T);
  224. function PopFirst (const aFreeItem: Boolean): T;
  225. procedure PushLast (constref aItem: T);
  226. function PopLast (const aFreeItem: Boolean): T;
  227. end;
  228. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  229. generic TutlCustomList<T> = class(specialize TutlSimpleList<T>)
  230. public type
  231. IEqualityComparer = specialize IutlEqualityComparer<T>;
  232. strict private
  233. fEqualityComparer: IEqualityComparer;
  234. public
  235. function IndexOf (const aItem: T): Integer;
  236. function Extract (const aItem: T; const aDefault: T): T; overload;
  237. function Remove (const aItem: T): Integer;
  238. constructor Create (const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
  239. destructor Destroy; override;
  240. end;
  241. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  242. generic TutlList<T> = class(specialize TutlCustomList<T>)
  243. public type
  244. TEqualityComparer = specialize TutlEqualityComparer<T>;
  245. public
  246. constructor Create(const aOwnsItems: Boolean);
  247. end;
  248. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  249. generic TutlCustomHashSet<T> = class(specialize __TutlListBase<T>,
  250. specialize IutlReadOnlyIndexer<T>,
  251. specialize IutlIndexer<T>)
  252. private type
  253. TBinarySearch = specialize TutlBinarySearch<T>;
  254. public type
  255. IComparer = specialize IutlComparer<T>;
  256. strict private
  257. fComparer: IComparer;
  258. protected
  259. procedure SetItem(const aIndex: Integer; aValue: T); override;
  260. public
  261. property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
  262. function Add (constref aItem: T): Boolean;
  263. function Contains (constref aItem: T): Boolean;
  264. function IndexOf (constref aItem: T): Integer;
  265. function Remove (constref aItem: T): Boolean;
  266. procedure Delete (const aIndex: Integer);
  267. constructor Create(const aComparer: IComparer; const aOwnsItems: Boolean);
  268. destructor Destroy; override;
  269. end;
  270. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  271. generic TutlHastSet<T> = class(specialize TutlCustomHashSet<T>)
  272. public type
  273. TComparer = specialize TutlComparer<T>;
  274. public
  275. constructor Create(const aOwnsItems: Boolean);
  276. end;
  277. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  278. EutlMap = class(EutlException);
  279. generic TutlCustomMap<TKey, TValue> = class(TutlInterfaceNoRefCount)
  280. public type
  281. ////////////////////////////////////////////////////////////////////////////////////////////////
  282. IComparer = specialize IutlComparer<TKey>;
  283. TKeyValuePair = packed record
  284. Key: TKey;
  285. Value: TValue;
  286. end;
  287. ////////////////////////////////////////////////////////////////////////////////////////////////
  288. THashSet = class(specialize TutlCustomHashSet<TKeyValuePair>)
  289. strict private
  290. fOwner: TutlCustomMap;
  291. protected
  292. procedure Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); override;
  293. public
  294. constructor Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
  295. end;
  296. ////////////////////////////////////////////////////////////////////////////////////////////////
  297. TKeyValuePairComparer = class(TInterfacedObject, THashSet.IComparer)
  298. private
  299. fComparer: IComparer;
  300. public { IutlEqualityComparer }
  301. function EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;
  302. public { IutlComparer }
  303. function Compare(constref i1, i2: TKeyValuePair): Integer;
  304. public
  305. constructor Create(aComparer: IComparer);
  306. destructor Destroy; override;
  307. end;
  308. ////////////////////////////////////////////////////////////////////////////////////////////////
  309. TKeyCollection = class(TutlInterfaceNoRefCount,
  310. specialize IutlEnumerable<TKey>,
  311. specialize IutlReadOnlyIndexer<TKey>)
  312. private
  313. fHashSet: THashSet;
  314. public { IutlEnumerable }
  315. function GetEnumerator: specialize IEnumerator<TKey>;
  316. function GetUtlEnumerator: specialize IutlEnumerator<TKey>;
  317. public { IutlReadOnlyIndexer }
  318. function GetItem(const aIndex: Integer): TKey;
  319. function GetCount: Integer;
  320. public
  321. property Items[const aIndex: Integer]: TKey read GetItem; default;
  322. property Count: Integer read GetCount;
  323. //property Enumerator: specialize IutlEnumerator<TKey> read GetUtlEnumerator;
  324. constructor Create(const aHashSet: THashSet);
  325. end;
  326. ////////////////////////////////////////////////////////////////////////////////////////////////
  327. TKeyValuePairCollection = class(TutlInterfaceNoRefCount,
  328. specialize IutlEnumerable<TKeyValuePair>,
  329. specialize IutlReadOnlyIndexer<TKeyValuePair>)
  330. private
  331. fHashSet: THashSet;
  332. public { IutlEnumerable }
  333. function GetEnumerator: specialize IEnumerator<TKeyValuePair>;
  334. function GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>;
  335. public { IutlReadOnlyIndexer }
  336. function GetItem(const aIndex: Integer): TKeyValuePair;
  337. function GetCount: Integer;
  338. public
  339. property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;
  340. property Count: Integer read GetCount;
  341. property Enumerator: specialize IutlEnumerator<TKeyValuePair> read GetUtlEnumerator;
  342. constructor Create(const aHashSet: THashSet);
  343. end;
  344. strict private
  345. fAutoCreate: Boolean;
  346. fOwnsKeys: Boolean;
  347. fOwnsValues: Boolean;
  348. fHashSetRef: THashSet;
  349. fKeyCollection: TKeyCollection;
  350. fKeyValuePairCollection: TKeyValuePairCollection;
  351. function GetValue (aKey: TKey): TValue;
  352. function GetValueAt (const aIndex: Integer): TValue;
  353. function GetCount: Integer;
  354. function GetIsEmpty: Boolean;
  355. function GetCapacity: Integer;
  356. function GetCanShrink: Boolean;
  357. function GetCanExpand: Boolean;
  358. procedure SetValue (aKey: TKey; const aValue: TValue);
  359. procedure SetValueAt (const aIndex: Integer; const aValue: TValue);
  360. procedure SetCapacity (const aValue: Integer);
  361. procedure SetCanShrink (const aValue: Boolean);
  362. procedure SetCanExpand (const aValue: Boolean);
  363. public
  364. property Values [aKey: TKey]: TValue read GetValue write SetValue; default;
  365. property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;
  366. property Keys: TKeyCollection read fKeyCollection;
  367. property KeyValuePairs: TKeyValuePairCollection read fKeyValuePairCollection;
  368. property Count: Integer read GetCount;
  369. property IsEmpty: Boolean read GetIsEmpty;
  370. property Capacity: Integer read GetCapacity write SetCapacity;
  371. property CanShrink: Boolean read GetCanShrink write SetCanShrink;
  372. property CanExpand: Boolean read GetCanExpand write SetCanExpand;
  373. property OwnsKeys: Boolean read fOwnsKeys write fOwnsKeys;
  374. property OwnsValues: Boolean read fOwnsValues write fOwnsValues;
  375. property AutoCreate: Boolean read fAutoCreate write fAutoCreate;
  376. procedure Add (constref aKey: TKey; constref aValue: TValue);
  377. function TryAdd (constref aKey: TKey; constref aValue: TValue): Boolean;
  378. function TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean;
  379. function IndexOf (constref aKey: TKey): Integer;
  380. function Contains (constref aKey: TKey): Boolean;
  381. procedure Delete (constref aKey: TKey);
  382. procedure DeleteAt (const aIndex: Integer);
  383. procedure Clear;
  384. constructor Create(const aHashSet: THashSet; const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
  385. destructor Destroy; override;
  386. end;
  387. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  388. generic TutlMap<TKey, TValue> = class(specialize TutlCustomMap<TKey, TValue>)
  389. public type
  390. TComparer = specialize TutlComparer<TKey>;
  391. strict private
  392. fHashSetImpl: THashSet;
  393. public
  394. constructor Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
  395. destructor Destroy; override;
  396. end;
  397. procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
  398. implementation
  399. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  400. //Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  401. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  402. procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
  403. var
  404. o: TObject;
  405. begin
  406. case aTypeInfo^.Kind of
  407. tkClass: begin
  408. if (aFreeObject) then begin
  409. o := TObject(obj);
  410. Pointer(obj) := nil;
  411. if Assigned(o) then
  412. o.Free;
  413. end;
  414. end;
  415. tkInterface: begin
  416. IUnknown(obj) := nil;
  417. end;
  418. tkAString: begin
  419. AnsiString(Obj) := '';
  420. end;
  421. tkUString: begin
  422. UnicodeString(Obj) := '';
  423. end;
  424. tkString: begin
  425. String(Obj) := '';
  426. end;
  427. end;
  428. end;
  429. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  430. //TutlLinkedList.TIterator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  431. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  432. procedure TutlLinkedList.TIterator.ReleaseElement(const aElement: PElement);
  433. begin
  434. if (aElement = fElement) then
  435. fElement := nil;
  436. end;
  437. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  438. function TutlLinkedList.TIterator.MoveNext: Boolean;
  439. begin
  440. if not Assigned(fElement) then
  441. raise EutlInvalidOperation.Create('this is the null iterator');
  442. result := Assigned(fElement^.next);
  443. if result then
  444. fElement := fElement^.next;
  445. end;
  446. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  447. function TutlLinkedList.TIterator.Clone: IutlIterator;
  448. begin
  449. result := fOwner.CreateIterator(fElement);
  450. end;
  451. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  452. function TutlLinkedList.TIterator.Equals(const aOther: IutlIterator): Boolean;
  453. var
  454. o: TIterator;
  455. begin
  456. result := Supports(aOther, TIterator, o)
  457. and not (Assigned(fElement) xor Assigned(o.fElement))
  458. and (fElement = o.fElement)
  459. and (fOwner = o.fOwner);
  460. end;
  461. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  462. function TutlLinkedList.TIterator.GetIsValid: Boolean;
  463. begin
  464. result := Assigned(fElement);
  465. end;
  466. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  467. function TutlLinkedList.TIterator.MovePrev: Boolean;
  468. begin
  469. if not Assigned(fElement) then
  470. raise EutlInvalidOperation.Create('this is the null iterator');
  471. result := Assigned(fElement^.prev);
  472. if result then
  473. fElement := fElement^.prev;
  474. end;
  475. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  476. function TutlLinkedList.TIterator.GetItem: T;
  477. begin
  478. if not Assigned(fElement) then
  479. raise EutlInvalidOperation.Create('this is the null iterator');
  480. result := fElement^.data;
  481. end;
  482. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  483. procedure TutlLinkedList.TIterator.SetItem(aValue: T);
  484. begin
  485. if not Assigned(fElement) then
  486. raise EutlInvalidOperation.Create('this is the null iterator');
  487. fElement^.data := aValue;
  488. end;
  489. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  490. constructor TutlLinkedList.TIterator.Create(const aElement: PElement; const aOwner: TutlLinkedList);
  491. begin
  492. inherited Create;
  493. fOwner := aOwner;
  494. fElement := aElement;
  495. end;
  496. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  497. destructor TutlLinkedList.TIterator.Destroy;
  498. begin
  499. if Assigned(fOwner) then
  500. fOwner.DestroyIterator(self);
  501. inherited Destroy;
  502. end;
  503. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  504. //TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  505. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  506. function TutlLinkedList.GetFirst: T;
  507. begin
  508. if IsEmpty then
  509. raise EutlInvalidOperation.Create('list is empty');
  510. result := fFirst^.data;
  511. end;
  512. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  513. function TutlLinkedList.GetLast: T;
  514. begin
  515. if IsEmpty then
  516. raise EutlInvalidOperation.Create('list is empty');
  517. result := fLast^.data;
  518. end;
  519. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  520. function TutlLinkedList.GetIsEmpty: Boolean;
  521. begin
  522. result := (fCount = 0);
  523. end;
  524. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  525. function TutlLinkedList.GetFirstIterator: Iterator;
  526. begin
  527. if IsEmpty then
  528. raise EutlInvalidOperation.Create('list is empty');
  529. result := CreateIterator(fFirst);
  530. end;
  531. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  532. function TutlLinkedList.GetLastIterator: Iterator;
  533. begin
  534. if IsEmpty then
  535. raise EutlInvalidOperation.Create('list is empty');
  536. result := CreateIterator(fLast);
  537. end;
  538. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  539. procedure TutlLinkedList.LinkElement(const aElement: PElement);
  540. begin
  541. if Assigned(aElement^.prev) then begin
  542. aElement^.prev^.next := aElement;
  543. if (aElement^.prev = fLast) then
  544. fLast := aElement;
  545. end;
  546. if Assigned(aElement^.next) then begin
  547. aElement^.next^.prev := aElement;
  548. if (aElement^.next = fFirst) then
  549. fFirst := aElement;
  550. end;
  551. if not Assigned(fFirst) then
  552. fFirst := aElement;
  553. if not Assigned(fLast) then
  554. fLast := aElement;
  555. end;
  556. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  557. procedure TutlLinkedList.InsertBefore(const aElement: PElement; constref aItem: T);
  558. var
  559. e: PElement;
  560. begin
  561. new(e);
  562. e^.data := aItem;
  563. if Assigned(aElement) then begin
  564. e^.next := aElement;
  565. e^.prev := aElement^.prev;
  566. end else begin
  567. e^.next := nil;
  568. e^.prev := nil;
  569. end;
  570. inc(fCount);
  571. LinkElement(e);
  572. end;
  573. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  574. procedure TutlLinkedList.InsertAfter(const aElement: PElement; constref aItem: T);
  575. var
  576. e: PElement;
  577. begin
  578. new(e);
  579. e^.data := aItem;
  580. if Assigned(aElement) then begin
  581. e^.prev := aElement;
  582. e^.next := aElement^.next;
  583. end else begin
  584. e^.next := nil;
  585. e^.prev := nil;
  586. end;
  587. inc(fCount);
  588. LinkElement(e);
  589. end;
  590. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  591. function TutlLinkedList.Remove(const aElement: PElement; const aFreeItem: Boolean): T;
  592. var
  593. i: Integer;
  594. begin
  595. if (aElement = fFirst) then
  596. fFirst := aElement^.next;
  597. if (aElement = fLast) then
  598. fLast := aElement^.prev;
  599. if Assigned(aElement^.prev) then
  600. aElement^.prev^.next := aElement^.next;
  601. if Assigned(aElement^.next) then
  602. aElement^.next^.prev := aElement^.prev;
  603. if aFreeItem
  604. then FillByte(result{%H-}, SizeOf(result), 0)
  605. else result := aElement^.data;
  606. Release(aElement^.data, aFreeItem);
  607. for i := Low(fIterators) to High(fIterators) do
  608. fIterators[i].ReleaseElement(aElement);
  609. dec(fCount);
  610. Dispose(aElement);
  611. end;
  612. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  613. function TutlLinkedList.CreateIterator(const aElement: PElement): TIterator;
  614. begin
  615. result := TIterator.Create(aElement, self);
  616. SetLength(fIterators, Length(fIterators) + 1);
  617. fIterators[High(fIterators)] := result;
  618. end;
  619. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  620. procedure TutlLinkedList.DestroyIterator(const aIterator: TIterator);
  621. var
  622. i: Integer;
  623. begin
  624. for i := Low(fIterators) to High(fIterators) do begin
  625. if (fIterators[i] = aIterator) then begin
  626. if (i < High(fIterators)) then
  627. System.Move(fIterators[i+1], fIterators[i], (High(fIterators)-i) * SizeOf(TIterator));
  628. SetLength(fIterators, High(fIterators));
  629. exit;
  630. end;
  631. end;
  632. end;
  633. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  634. procedure TutlLinkedList.Release(var aItem: T; const aFreeItem: Boolean);
  635. begin
  636. FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
  637. FillByte(aItem, SizeOf(aItem), 0);
  638. end;
  639. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  640. function TutlLinkedList.GetEnumerator: specialize IEnumerator<T>;
  641. begin
  642. // TODO
  643. end;
  644. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  645. function TutlLinkedList.GetUtlEnumerator: specialize IutlEnumerator<T>;
  646. begin
  647. // TODO
  648. end;
  649. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  650. procedure TutlLinkedList.PushFirst(constref aItem: T);
  651. begin
  652. InsertBefore(fFirst, aItem);
  653. end;
  654. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  655. function TutlLinkedList.PopFirst(const aFreeItem: Boolean): T;
  656. begin
  657. if IsEmpty then
  658. raise EutlInvalidOperation.Create('list is empty');
  659. result := Remove(fFirst, aFreeItem);
  660. end;
  661. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  662. procedure TutlLinkedList.PopFirst;
  663. begin
  664. PopFirst(true);
  665. end;
  666. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  667. procedure TutlLinkedList.PushLast(constref aItem: T);
  668. begin
  669. InsertAfter(fLast, aItem)
  670. end;
  671. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  672. function TutlLinkedList.PopLast(const aFreeItem: Boolean): T;
  673. begin
  674. if IsEmpty then
  675. raise EutlInvalidOperation.Create('list is empty');
  676. result := Remove(fLast, aFreeItem);
  677. end;
  678. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  679. procedure TutlLinkedList.PopLast;
  680. begin
  681. PopLast(true);
  682. end;
  683. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  684. procedure TutlLinkedList.InsertBefore(const aIterator: IutlIterator; constref aItem: T);
  685. var
  686. i: TIterator;
  687. begin
  688. if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
  689. raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
  690. if not Assigned(i.Element) then
  691. raise EutlInvalidOperation.Create('this is the null iterator');
  692. InsertBefore(i.Element, aItem);
  693. end;
  694. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  695. procedure TutlLinkedList.InsertAfter(const aIterator: IutlIterator; constref aItem: T);
  696. var
  697. i: TIterator;
  698. begin
  699. if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
  700. raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
  701. if not Assigned(i.Element) then
  702. raise EutlInvalidOperation.Create('this is the null iterator');
  703. InsertAfter(i.Element, aItem);
  704. end;
  705. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  706. function TutlLinkedList.Remove(const aIterator: IutlIterator; const aFreeItem: Boolean): T;
  707. var
  708. i: TIterator;
  709. begin
  710. if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
  711. raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
  712. if not Assigned(i.Element) then
  713. raise EutlInvalidOperation.Create('this is the null iterator');
  714. result := Remove(i.Element, aFreeItem);
  715. end;
  716. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  717. procedure TutlLinkedList.Remove(const aIterator: IutlIterator);
  718. begin
  719. Remove(aIterator, true);
  720. end;
  721. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  722. procedure TutlLinkedList.Clear;
  723. begin
  724. while (Count > 0) do
  725. PopLast(true);
  726. end;
  727. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  728. constructor TutlLinkedList.Create(const aOwnsItems: Boolean);
  729. begin
  730. inherited Create;
  731. fOwnsItems := aOwnsItems;
  732. fFirst := nil;
  733. fLast := nil;
  734. fCount := 0;
  735. end;
  736. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  737. destructor TutlLinkedList.Destroy;
  738. begin
  739. Clear;
  740. inherited Destroy;
  741. end;
  742. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  743. //__TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  744. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  745. function __TutlArrayContainer.GetIsEmpty: Boolean;
  746. begin
  747. result := (Count = 0);
  748. end;
  749. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  750. function __TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
  751. begin
  752. if (aIndex < 0) or (aIndex >= fCapacity) then
  753. raise EutlOutOfRange.Create('capacity out of range', aIndex, 0, fCapacity-1);
  754. result := fList + aIndex;
  755. end;
  756. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  757. procedure __TutlArrayContainer.SetCapacity(const aValue: integer);
  758. begin
  759. if (fCapacity = aValue) then
  760. exit;
  761. if (aValue < Count) then
  762. raise EutlArgument.Create('can not reduce capacity below count', 'Capacity');
  763. ReAllocMem(fList, aValue * SizeOf(T));
  764. FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0);
  765. fCapacity := aValue;
  766. end;
  767. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  768. procedure __TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
  769. begin
  770. FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
  771. FillByte(aItem, SizeOf(aItem), 0);
  772. end;
  773. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  774. procedure __TutlArrayContainer.Shrink(const aExactFit: Boolean);
  775. begin
  776. if not fCanShrink then
  777. raise EutlInvalidOperation.Create('shrinking is not allowed');
  778. if (aExactFit) then
  779. SetCapacity(Count)
  780. else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used
  781. SetCapacity(fCapacity shr 1); // shrink to 50%
  782. end;
  783. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  784. procedure __TutlArrayContainer.Expand;
  785. begin
  786. if (Count < fCapacity) then
  787. exit;
  788. if not fCanExpand then
  789. raise EutlInvalidOperation.Create('expanding is not allowed');
  790. if (fCapacity <= 0) then
  791. SetCapacity(4)
  792. else if (fCapacity < 128) then
  793. SetCapacity(fCapacity shl 1) // + 100%
  794. else
  795. SetCapacity(fCapacity + fCapacity shr 2); // + 25%
  796. end;
  797. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  798. constructor __TutlArrayContainer.Create(const aOwnsItems: Boolean);
  799. begin
  800. inherited Create;
  801. fOwnsItems := aOwnsItems;
  802. fList := nil;
  803. fCapacity := 0;
  804. fCanExpand := true;
  805. fCanShrink := true;
  806. end;
  807. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  808. destructor __TutlArrayContainer.Destroy;
  809. begin
  810. if Assigned(fList) then begin
  811. FreeMem(fList);
  812. fList := nil;
  813. end;
  814. inherited Destroy;
  815. end;
  816. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  817. //TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  818. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  819. function TutlQueue.GetCount: Integer;
  820. begin
  821. result := fCount;
  822. end;
  823. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  824. procedure TutlQueue.SetCapacity(const aValue: integer);
  825. var
  826. cnt: Integer;
  827. begin
  828. if (aValue < Count) then
  829. raise EutlArgument.Create('can not reduce capacity below count', 'Capacity');
  830. if (aValue < Capacity) then begin // is shrinking
  831. if (fReadPos <= fWritePos) then begin // ReadPos Before WritePos -> Move To Begin
  832. System.Move(GetInternalItem(fReadPos)^, GetInternalItem(0)^, SizeOf(T) * Count);
  833. fReadPos := 0;
  834. fWritePos := Count;
  835. end else if (fReadPos > fWritePos) then begin // ReadPos Behind WritePos
  836. cnt := Capacity - aValue;
  837. System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
  838. dec(fReadPos, cnt);
  839. end;
  840. end;
  841. inherited SetCapacity(aValue);
  842. // ReadPos After WritePos and Expanding
  843. if (fReadPos > fWritePos) and (aValue > Capacity) then begin
  844. cnt := aValue - Capacity;
  845. System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
  846. inc(fReadPos, cnt);
  847. end;
  848. end;
  849. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  850. function TutlQueue.GetEnumerator: specialize IEnumerator<T>;
  851. begin
  852. // TODO
  853. end;
  854. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  855. function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator<T>;
  856. begin
  857. // TODO
  858. end;
  859. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  860. procedure TutlQueue.Enqueue(constref aItem: T);
  861. begin
  862. if (Count = Capacity) then
  863. Expand;
  864. fWritePos := fWritePos mod Capacity;
  865. GetInternalItem(fWritePos)^ := aItem;
  866. inc(fCount);
  867. inc(fWritePos);
  868. end;
  869. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  870. function TutlQueue.Dequeue: T;
  871. begin
  872. result := Dequeue(false);
  873. end;
  874. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  875. function TutlQueue.Dequeue(const aFreeItem: Boolean): T;
  876. var
  877. p: PT;
  878. begin
  879. if IsEmpty then
  880. raise EutlInvalidOperation.Create('queue is empty');
  881. p := GetInternalItem(fReadPos);
  882. if aFreeItem
  883. then FillByte(result{%H-}, SizeOf(result), 0)
  884. else result := p^;
  885. Release(p^, aFreeItem);
  886. dec(fCount);
  887. fReadPos := (fReadPos + 1) mod Capacity;
  888. end;
  889. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  890. function TutlQueue.Peek: T;
  891. begin
  892. if IsEmpty then
  893. raise EutlInvalidOperation.Create('queue is empty');
  894. result := GetInternalItem(fReadPos)^;
  895. end;
  896. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  897. procedure TutlQueue.ShrinkToFit;
  898. begin
  899. Shrink(true);
  900. end;
  901. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  902. procedure TutlQueue.Clear;
  903. begin
  904. while (fReadPos <> fWritePos) do begin
  905. Release(GetInternalItem(fReadPos)^, true);
  906. fReadPos := (fReadPos + 1) mod Capacity;
  907. end;
  908. fCount := 0;
  909. if CanShrink then
  910. ShrinkToFit;
  911. end;
  912. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  913. constructor TutlQueue.Create(const aOwnsItems: Boolean);
  914. begin
  915. inherited Create(aOwnsItems);
  916. fCount := 0;
  917. fReadPos := 0;
  918. fWritePos := 0;
  919. end;
  920. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  921. destructor TutlQueue.Destroy;
  922. begin
  923. Clear;
  924. inherited Destroy;
  925. end;
  926. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  927. //TutlStack/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  928. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  929. function TutlStack.GetCount: Integer;
  930. begin
  931. result := fCount;
  932. end;
  933. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  934. function TutlStack.GetEnumerator: specialize IEnumerator<T>;
  935. begin
  936. // TODO
  937. end;
  938. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  939. function TutlStack.GetUtlEnumerator: specialize IutlEnumerator<T>;
  940. begin
  941. // TODO
  942. end;
  943. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  944. procedure TutlStack.Push(constref aItem: T);
  945. begin
  946. if (Count = Capacity) then
  947. Expand;
  948. GetInternalItem(fCount)^ := aItem;
  949. inc(fCount);
  950. end;
  951. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  952. function TutlStack.Pop: T;
  953. begin
  954. Pop(false);
  955. end;
  956. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  957. function TutlStack.Pop(const aFreeItem: Boolean): T;
  958. var
  959. p: PT;
  960. begin
  961. if IsEmpty then
  962. raise EutlInvalidOperation.Create('stack is empty');
  963. p := GetInternalItem(fCount-1);
  964. if aFreeItem
  965. then FillByte(result{%H-}, SizeOf(result), 0)
  966. else result := p^;
  967. Release(p^, aFreeItem);
  968. dec(fCount);
  969. end;
  970. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  971. function TutlStack.Peek: T;
  972. begin
  973. if IsEmpty then
  974. raise EutlInvalidOperation.Create('stack is empty');
  975. result := GetInternalItem(fCount-1)^;
  976. end;
  977. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  978. procedure TutlStack.ShrinkToFit;
  979. begin
  980. Shrink(true);
  981. end;
  982. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  983. procedure TutlStack.Clear;
  984. begin
  985. while (fCount > 0) do begin
  986. dec(fCount);
  987. Release(GetInternalItem(fCount)^, true);
  988. end;
  989. if CanShrink then
  990. ShrinkToFit;
  991. end;
  992. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  993. constructor TutlStack.Create(const aOwnsItems: Boolean);
  994. begin
  995. inherited Create(aOwnsItems);
  996. fCount := 0
  997. end;
  998. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  999. destructor TutlStack.Destroy;
  1000. begin
  1001. Clear;
  1002. inherited Destroy;
  1003. end;
  1004. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1005. //__TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1006. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1007. function __TutlListBase.GetCount: Integer;
  1008. begin
  1009. result := fCount;
  1010. end;
  1011. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1012. function __TutlListBase.GetItem(const aIndex: Integer): T;
  1013. begin
  1014. if (aIndex < 0) or (aIndex >= Count) then
  1015. raise EutlOutOfRange.Create(aIndex, 0, Count-1);
  1016. result := GetInternalItem(aIndex)^;
  1017. end;
  1018. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1019. procedure __TutlListBase.SetItem(const aIndex: Integer; aValue: T);
  1020. var
  1021. p: PT;
  1022. begin
  1023. if (aIndex < 0) or (aIndex >= Count) then
  1024. raise EutlOutOfRange.Create(aIndex, 0, Count-1);
  1025. p := GetInternalItem(aIndex);
  1026. Release(p^, true);
  1027. p^ := aValue;
  1028. end;
  1029. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1030. procedure __TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
  1031. var
  1032. p: PT;
  1033. begin
  1034. if (aIndex < 0) or (aIndex > fCount) then
  1035. raise EutlOutOfRange.Create(aIndex, 0, fCount);
  1036. if (fCount = Capacity) then
  1037. Expand;
  1038. p := GetInternalItem(aIndex);
  1039. if (aIndex < fCount) then
  1040. System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
  1041. p^ := aValue;
  1042. inc(fCount);
  1043. end;
  1044. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1045. procedure __TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
  1046. var
  1047. p: PT;
  1048. begin
  1049. if (aIndex < 0) or (aIndex >= fCount) then
  1050. raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
  1051. dec(fCount);
  1052. p := GetInternalItem(aIndex);
  1053. Release(p^, aFreeItem);
  1054. System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
  1055. if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used
  1056. SetCapacity(Capacity shr 1); // set to 50% Capacity
  1057. FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
  1058. end;
  1059. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1060. function __TutlListBase.GetEnumerator: specialize IEnumerator<T>;
  1061. begin
  1062. // TODO
  1063. end;
  1064. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1065. function __TutlListBase.GetUtlEnumerator: specialize IutlEnumerator<T>;
  1066. begin
  1067. // TODO
  1068. end;
  1069. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1070. procedure __TutlListBase.Clear;
  1071. begin
  1072. while (Count > 0) do begin
  1073. dec(fCount);
  1074. Release(GetInternalItem(fCount)^, true);
  1075. end;
  1076. fCount := 0;
  1077. if CanShrink then
  1078. ShrinkToFit;
  1079. end;
  1080. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1081. procedure __TutlListBase.ShrinkToFit;
  1082. begin
  1083. Shrink(true);
  1084. end;
  1085. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1086. constructor __TutlListBase.Create(const aOwnsItems: Boolean);
  1087. begin
  1088. inherited Create(aOwnsItems);
  1089. fCount := 0;
  1090. end;
  1091. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1092. destructor __TutlListBase.Destroy;
  1093. begin
  1094. Clear;
  1095. inherited Destroy;
  1096. end;
  1097. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1098. //TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1099. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1100. function TutlSimpleList.GetFirst: T;
  1101. begin
  1102. if IsEmpty then
  1103. raise EutlInvalidOperation.Create('list is empty');
  1104. result := GetInternalItem(0)^;
  1105. end;
  1106. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1107. function TutlSimpleList.GetLast: T;
  1108. begin
  1109. if IsEmpty then
  1110. raise EutlInvalidOperation.Create('list is empty');
  1111. result := GetInternalItem(Count-1)^;
  1112. end;
  1113. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1114. function TutlSimpleList.Add(constref aItem: T): Integer;
  1115. begin
  1116. result := Count;
  1117. InsertIntern(result, aItem);
  1118. end;
  1119. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1120. procedure TutlSimpleList.Insert(const aIndex: Integer; constref aItem: T);
  1121. begin
  1122. InsertIntern(aIndex, aItem);
  1123. end;
  1124. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1125. procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
  1126. var
  1127. tmp: T;
  1128. p1, p2: PT;
  1129. begin
  1130. if (aIndex1 < 0) or (aIndex1 >= Count) then
  1131. raise EutlOutOfRange.Create(aIndex1, 0, Count-1);
  1132. if (aIndex2 < 0) or (aIndex2 >= Count) then
  1133. raise EutlOutOfRange.Create(aIndex2, 0, Count-1);
  1134. p1 := GetInternalItem(aIndex1);
  1135. p2 := GetInternalItem(aIndex2);
  1136. System.Move(p1^, tmp{%H-}, SizeOf(T));
  1137. System.Move(p2^, p1^, SizeOf(T));
  1138. System.Move(tmp, p2^, SizeOf(T));
  1139. FillByte(tmp, SizeOf(tmp), 0)
  1140. end;
  1141. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1142. procedure TutlSimpleList.Move(const aCurrentIndex, aNewIndex: Integer);
  1143. var
  1144. tmp: T;
  1145. cur, new: PT;
  1146. begin
  1147. if (aCurrentIndex < 0) or (aCurrentIndex >= Count) then
  1148. raise EutlOutOfRange.Create(aCurrentIndex, 0, Count-1);
  1149. if (aNewIndex < 0) or (aNewIndex >= Count) then
  1150. raise EutlOutOfRange.Create(aNewIndex, 0, Count-1);
  1151. if (aCurrentIndex = aNewIndex) then
  1152. exit;
  1153. cur := GetInternalItem(aCurrentIndex);
  1154. new := GetInternalItem(aNewIndex);
  1155. System.Move(cur^, tmp{%H-}, SizeOf(T));
  1156. if (aNewIndex > aCurrentIndex) then begin
  1157. System.Move((cur+1)^, cur^, SizeOf(T) * (aNewIndex - aCurrentIndex));
  1158. end else begin
  1159. System.Move(new^, (new+1)^, SizeOf(T) * (aCurrentIndex - aNewIndex));
  1160. end;
  1161. System.Move(tmp, new^, SizeOf(T));
  1162. FillByte(tmp, SizeOf(tmp), 0);
  1163. end;
  1164. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1165. procedure TutlSimpleList.Delete(const aIndex: Integer);
  1166. begin
  1167. DeleteIntern(aIndex, true);
  1168. end;
  1169. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1170. function TutlSimpleList.Extract(const aIndex: Integer): T;
  1171. begin
  1172. result := GetItem(aIndex);
  1173. DeleteIntern(aIndex, false);
  1174. end;
  1175. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1176. procedure TutlSimpleList.PushFirst(constref aItem: T);
  1177. begin
  1178. InsertIntern(0, aItem);
  1179. end;
  1180. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1181. function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
  1182. begin
  1183. if aFreeItem
  1184. then FillByte(result{%H-}, SizeOf(result), 0)
  1185. else result := GetItem(0);
  1186. DeleteIntern(0, aFreeItem);
  1187. end;
  1188. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1189. procedure TutlSimpleList.PushLast(constref aItem: T);
  1190. begin
  1191. InsertIntern(Count, aItem);
  1192. end;
  1193. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1194. function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
  1195. begin
  1196. if aFreeItem
  1197. then FillByte(result{%H-}, SizeOf(result), 0)
  1198. else result := GetItem(Count-1);
  1199. DeleteIntern(Count-1, aFreeItem);
  1200. end;
  1201. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1202. //TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1203. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1204. function TutlCustomList.IndexOf(const aItem: T): Integer;
  1205. begin
  1206. result := Count-1;
  1207. while (result >= 0)
  1208. and not fEqualityComparer.EqualityCompare(Items[result], aItem)
  1209. do
  1210. dec(result);
  1211. end;
  1212. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1213. function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
  1214. var
  1215. i: Integer;
  1216. begin
  1217. i := IndexOf(aItem);
  1218. if (i >= 0) then begin
  1219. result := Items[i];
  1220. DeleteIntern(i, false);
  1221. end else
  1222. result := aDefault;
  1223. end;
  1224. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1225. function TutlCustomList.Remove(const aItem: T): Integer;
  1226. begin
  1227. result := IndexOf(aItem);
  1228. if (result >= 0) then
  1229. DeleteIntern(result, true);
  1230. end;
  1231. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1232. constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
  1233. begin
  1234. if not Assigned(aEqualityComparer) then
  1235. raise EutlArgumentNil.Create('aEqualityComparer');
  1236. inherited Create(aOwnsItems);
  1237. fEqualityComparer := aEqualityComparer;
  1238. end;
  1239. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1240. destructor TutlCustomList.Destroy;
  1241. begin
  1242. fEqualityComparer := nil;
  1243. inherited Destroy;
  1244. end;
  1245. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1246. //TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1247. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1248. constructor TutlList.Create(const aOwnsItems: Boolean);
  1249. begin
  1250. inherited Create(TEqualityComparer.Create, aOwnsItems);
  1251. end;
  1252. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1253. //TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1254. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1255. procedure TutlCustomHashSet.SetItem(const aIndex: Integer; aValue: T);
  1256. begin
  1257. if not fComparer.EqualityCompare(GetItem(aIndex), aValue) then
  1258. EutlInvalidOperation.Create('values are not equal');
  1259. inherited SetItem(aIndex, aValue);
  1260. end;
  1261. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1262. function TutlCustomHashSet.Add(constref aItem: T): Boolean;
  1263. var
  1264. i: Integer;
  1265. begin
  1266. result := not TBinarySearch.Search(self, fComparer, aItem, i);
  1267. if result then
  1268. InsertIntern(i, aItem);
  1269. end;
  1270. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1271. function TutlCustomHashSet.Contains(constref aItem: T): Boolean;
  1272. var
  1273. i: Integer;
  1274. begin
  1275. result := TBinarySearch.Search(self, fComparer, aItem, i);
  1276. end;
  1277. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1278. function TutlCustomHashSet.IndexOf(constref aItem: T): Integer;
  1279. begin
  1280. if not TBinarySearch.Search(self, fComparer, aItem, result) then
  1281. result := -1;
  1282. end;
  1283. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1284. function TutlCustomHashSet.Remove(constref aItem: T): Boolean;
  1285. var
  1286. i: Integer;
  1287. begin
  1288. result := TBinarySearch.Search(self, fComparer, aItem, i);
  1289. if result then
  1290. DeleteIntern(i, true);
  1291. end;
  1292. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1293. procedure TutlCustomHashSet.Delete(const aIndex: Integer);
  1294. begin
  1295. DeleteIntern(aIndex, true);
  1296. end;
  1297. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1298. constructor TutlCustomHashSet.Create(const aComparer: IComparer; const aOwnsItems: Boolean);
  1299. begin
  1300. inherited Create(aOwnsItems);
  1301. fComparer := aComparer;
  1302. end;
  1303. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1304. destructor TutlCustomHashSet.Destroy;
  1305. begin
  1306. fComparer := nil;
  1307. inherited Destroy;
  1308. end;
  1309. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1310. //TutlHastSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1311. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1312. constructor TutlHastSet.Create(const aOwnsItems: Boolean);
  1313. begin
  1314. inherited Create(TComparer.Create, aOwnsItems);
  1315. end;
  1316. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1317. //TutlCustomMap.THashSet////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1318. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1319. procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean);
  1320. begin
  1321. FinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem);
  1322. FinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem);
  1323. inherited Release(aItem, aFreeItem);
  1324. end;
  1325. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1326. constructor TutlCustomMap.THashSet.Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
  1327. begin
  1328. inherited Create(aComparer, true);
  1329. fOwner := aOwner;
  1330. end;
  1331. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1332. //TutlCustomMap.TKeyValuePairComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1333. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1334. function TutlCustomMap.TKeyValuePairComparer.EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;
  1335. begin
  1336. result := (Compare(i1, i2) = 0);
  1337. end;
  1338. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1339. function TutlCustomMap.TKeyValuePairComparer.Compare(constref i1, i2: TKeyValuePair): Integer;
  1340. begin
  1341. result := fComparer.Compare(i1.Key, i2.Key);
  1342. end;
  1343. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1344. constructor TutlCustomMap.TKeyValuePairComparer.Create(aComparer: IComparer);
  1345. begin
  1346. inherited Create;
  1347. fComparer := aComparer;
  1348. end;
  1349. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1350. destructor TutlCustomMap.TKeyValuePairComparer.Destroy;
  1351. begin
  1352. fComparer := nil;
  1353. inherited Destroy;
  1354. end;
  1355. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1356. //TutlCustomMap.TKeyCollection//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1357. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1358. function TutlCustomMap.TKeyCollection.GetEnumerator: specialize IEnumerator<TKey>;
  1359. begin
  1360. result := GetUtlEnumerator;
  1361. end;
  1362. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1363. function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator<TKey>;
  1364. begin
  1365. // TODO
  1366. end;
  1367. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1368. function TutlCustomMap.TKeyCollection.GetItem(const aIndex: Integer): TKey;
  1369. begin
  1370. result := fHashSet[aIndex].Key;
  1371. end;
  1372. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1373. function TutlCustomMap.TKeyCollection.GetCount: Integer;
  1374. begin
  1375. result := fHashSet.Count;
  1376. end;
  1377. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1378. constructor TutlCustomMap.TKeyCollection.Create(const aHashSet: THashSet);
  1379. begin
  1380. inherited Create;
  1381. fHashSet := aHashSet;
  1382. end;
  1383. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1384. //TutlCustomMap.TKeyValuePairCollection/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1385. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1386. function TutlCustomMap.TKeyValuePairCollection.GetEnumerator: specialize IEnumerator<TKeyValuePair>;
  1387. begin
  1388. result := GetUtlEnumerator;
  1389. end;
  1390. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1391. function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>;
  1392. begin
  1393. // TODO
  1394. end;
  1395. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1396. function TutlCustomMap.TKeyValuePairCollection.GetItem(const aIndex: Integer): TKeyValuePair;
  1397. begin
  1398. result := fHashSet[aIndex];
  1399. end;
  1400. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1401. function TutlCustomMap.TKeyValuePairCollection.GetCount: Integer;
  1402. begin
  1403. result := fHashSet.Count;
  1404. end;
  1405. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1406. constructor TutlCustomMap.TKeyValuePairCollection.Create(const aHashSet: THashSet);
  1407. begin
  1408. inherited Create;
  1409. fHashSet := aHashSet;
  1410. end;
  1411. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1412. //TutlCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1413. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1414. function TutlCustomMap.GetValue(aKey: TKey): TValue;
  1415. var
  1416. i: Integer;
  1417. kvp: TKeyValuePair;
  1418. begin
  1419. kvp.Key := aKey;
  1420. i := fHashSetRef.IndexOf(kvp);
  1421. if (i < 0)
  1422. then FillByte(result{%H-}, SizeOf(result), 0)
  1423. else result := fHashSetRef[i].Value;
  1424. end;
  1425. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1426. function TutlCustomMap.GetValueAt(const aIndex: Integer): TValue;
  1427. begin
  1428. result := fHashSetRef[aIndex].Value;
  1429. end;
  1430. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1431. function TutlCustomMap.GetCount: Integer;
  1432. begin
  1433. result := fHashSetRef.Count;
  1434. end;
  1435. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1436. function TutlCustomMap.GetIsEmpty: Boolean;
  1437. begin
  1438. result := (fHashSetRef.Count <= 0);
  1439. end;
  1440. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1441. function TutlCustomMap.GetCapacity: Integer;
  1442. begin
  1443. result := fHashSetRef.Capacity;
  1444. end;
  1445. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1446. function TutlCustomMap.GetCanShrink: Boolean;
  1447. begin
  1448. result := fHashSetRef.CanShrink;
  1449. end;
  1450. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1451. function TutlCustomMap.GetCanExpand: Boolean;
  1452. begin
  1453. result := fHashSetRef.CanExpand;
  1454. end;
  1455. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1456. procedure TutlCustomMap.SetValue(aKey: TKey; const aValue: TValue);
  1457. var
  1458. i: Integer;
  1459. kvp: TKeyValuePair;
  1460. begin
  1461. kvp.Key := aKey;
  1462. kvp.Value := aValue;
  1463. i := fHashSetRef.IndexOf(kvp);
  1464. if (i < 0) then begin
  1465. if not fAutoCreate then
  1466. raise EutlMap.Create('key not found');
  1467. fHashSetRef.Add(kvp);
  1468. end else
  1469. fHashSetRef[i] := kvp;
  1470. end;
  1471. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1472. procedure TutlCustomMap.SetValueAt(const aIndex: Integer; const aValue: TValue);
  1473. var
  1474. kvp: TKeyValuePair;
  1475. begin
  1476. kvp := fHashSetRef[aIndex];
  1477. kvp.Value := aValue;
  1478. fHashSetRef[aIndex] := kvp;
  1479. end;
  1480. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. procedure TutlCustomMap.SetCapacity(const aValue: Integer);
  1482. begin
  1483. fHashSetRef.Capacity := aValue;
  1484. end;
  1485. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1486. procedure TutlCustomMap.SetCanShrink(const aValue: Boolean);
  1487. begin
  1488. fHashSetRef.CanShrink := aValue;
  1489. end;
  1490. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. procedure TutlCustomMap.SetCanExpand(const aValue: Boolean);
  1492. begin
  1493. fHashSetRef.CanExpand := aValue;
  1494. end;
  1495. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1496. procedure TutlCustomMap.Add(constref aKey: TKey; constref aValue: TValue);
  1497. begin
  1498. if not TryAdd(aKey, aValue) then
  1499. raise EutlMap.Create('key already exists');
  1500. end;
  1501. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1502. function TutlCustomMap.TryAdd(constref aKey: TKey; constref aValue: TValue): Boolean;
  1503. var
  1504. kvp: TKeyValuePair;
  1505. begin
  1506. kvp.Key := aKey;
  1507. kvp.Value := aValue;
  1508. result := fHashSetRef.Add(kvp);
  1509. end;
  1510. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1511. function TutlCustomMap.TryGetValue(constref aKey: TKey; out aValue: TValue): Boolean;
  1512. var
  1513. i: Integer;
  1514. begin
  1515. i := IndexOf(aKey);
  1516. result := (i >= 0);
  1517. if result
  1518. then aValue := fHashSetRef[i].Value
  1519. else FillByte(result, SizeOf(result), 0);
  1520. end;
  1521. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1522. function TutlCustomMap.IndexOf(constref aKey: TKey): Integer;
  1523. var
  1524. kvp: TKeyValuePair;
  1525. begin
  1526. kvp.Key := aKey;
  1527. result := fHashSetRef.IndexOf(kvp);
  1528. end;
  1529. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1530. function TutlCustomMap.Contains(constref aKey: TKey): Boolean;
  1531. begin
  1532. result := (IndexOf(aKey) >= 0);
  1533. end;
  1534. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1535. procedure TutlCustomMap.Delete(constref aKey: TKey);
  1536. var
  1537. kvp: TKeyValuePair;
  1538. begin
  1539. kvp.Key := aKey;
  1540. if not fHashSetRef.Remove(kvp) then
  1541. raise EutlMap.Create('key not found');
  1542. end;
  1543. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1544. procedure TutlCustomMap.DeleteAt(const aIndex: Integer);
  1545. begin
  1546. fHashSetRef.Delete(aIndex);
  1547. end;
  1548. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1549. procedure TutlCustomMap.Clear;
  1550. begin
  1551. fHashSetRef.Clear;
  1552. end;
  1553. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1554. constructor TutlCustomMap.Create(
  1555. const aHashSet: THashSet;
  1556. const aOwnsKeys: Boolean;
  1557. const aOwnsValues: Boolean);
  1558. begin
  1559. if not Assigned(aHashSet) then
  1560. EutlArgumentNil.Create('aHashSet');
  1561. inherited Create;
  1562. fAutoCreate := false;
  1563. fHashSetRef := aHashSet;
  1564. fOwnsKeys := aOwnsKeys;
  1565. fOwnsValues := aOwnsValues;
  1566. fKeyCollection := TKeyCollection.Create(fHashSetRef);
  1567. fKeyValuePairCollection := TKeyValuePairCollection.Create(fHashSetRef);
  1568. end;
  1569. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1570. destructor TutlCustomMap.Destroy;
  1571. begin
  1572. FreeAndNil(fKeyValuePairCollection);
  1573. FreeAndNil(fKeyCollection);
  1574. fHashSetRef := nil;
  1575. inherited Destroy;
  1576. end;
  1577. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. //TutlMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1579. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1580. constructor TutlMap.Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
  1581. begin
  1582. fHashSetImpl := THashSet.Create(self, TKeyValuePairComparer.Create(TComparer.Create));
  1583. inherited Create(fHashSetImpl, aOwnsKeys, aOwnsValues);
  1584. end;
  1585. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1586. destructor TutlMap.Destroy;
  1587. begin
  1588. Clear;
  1589. inherited Destroy;
  1590. FreeAndNil(fHashSetImpl);
  1591. end;
  1592. end.