generics.collections.pas 50 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081
  1. unit Generics.Collections;
  2. {$Mode Delphi}
  3. {$COperators On}
  4. interface
  5. uses
  6. Classes, SysUtils, rtlconsts, Types,
  7. {$IFDEF Pas2js}JS,{$ENDIF}
  8. Generics.Strings, Generics.Defaults;
  9. type
  10. TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
  11. TCollectionNotifyEvent<T> = procedure(ASender: TObject; const AItem: T;
  12. AAction: TCollectionNotification) of object;
  13. { TBinarySearchResult }
  14. TBinarySearchResult = record
  15. FoundIndex, CandidateIndex: SizeInt;
  16. CompareResult: SizeInt;
  17. end;
  18. { TCustomArrayHelper }
  19. TCustomArrayHelper<T> = class abstract
  20. protected
  21. class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
  22. const AComparer: IComparer<T>); virtual; abstract;
  23. public
  24. //class procedure Sort(var AValues: array of T); overload;
  25. class procedure Sort(var AValues: array of T;
  26. const AComparer: IComparer<T>); overload;
  27. class procedure Sort(var AValues: array of T;
  28. const AComparer: IComparer<T>; AIndex, ACount: SizeInt); overload;
  29. class function BinarySearch(const AValues: array of T; const AItem: T;
  30. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
  31. AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
  32. class function BinarySearch(const AValues: array of T; const AItem: T;
  33. out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  34. AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
  35. class function BinarySearch(const AValues: array of T; const AItem: T;
  36. out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
  37. class function BinarySearch(const AValues: array of T; const AItem: T;
  38. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>): Boolean; overload;
  39. // No support for automatically creating a comparer.
  40. // class function BinarySearch(const AValues: array of T; const AItem: T;
  41. // out AFoundIndex: SizeInt): Boolean; overload;
  42. // class function BinarySearch(const AValues: array of T; const AItem: T;
  43. // out ASearchResult: TBinarySearchResult): Boolean; overload;
  44. end;
  45. { TArrayHelper }
  46. TArrayHelper<T> = class(TCustomArrayHelper<T>)
  47. protected
  48. class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
  49. const AComparer: IComparer<T>); override;
  50. public
  51. class function BinarySearch(const AValues: array of T; const AItem: T;
  52. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
  53. AIndex, ACount: SizeInt): Boolean; override; overload;
  54. class function BinarySearch(const AValues: array of T; const AItem: T;
  55. out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  56. AIndex, ACount: SizeInt): Boolean; override; overload;
  57. end;
  58. { TEnumerator }
  59. TEnumerator<T> = class abstract
  60. protected
  61. function DoGetCurrent: T; virtual; abstract;
  62. function DoMoveNext: boolean; virtual; abstract;
  63. public
  64. property Current: T read DoGetCurrent;
  65. function MoveNext: boolean;
  66. end;
  67. { TEnumerable }
  68. TEnumerable<T> = class abstract
  69. protected
  70. type
  71. TMyEnumerator = TEnumerator<T>;
  72. function DoGetEnumerator: TMyEnumerator; virtual; abstract;
  73. public
  74. type
  75. TMyArray = TArray<T>;
  76. function GetEnumerator: TMyEnumerator; inline;
  77. function ToArray: TMyArray; virtual;
  78. end;
  79. { TCustomList }
  80. TCustomList<T> = class abstract(TEnumerable<T>)
  81. private
  82. FOnNotify: TCollectionNotifyEvent<T>;
  83. function GetCapacity: SizeInt; inline;
  84. protected
  85. type TMyArrayHelper = TArrayHelper<T>;
  86. protected
  87. FLength: SizeInt;
  88. FItems: array of T;
  89. function PrepareAddingItem: SizeInt; virtual;
  90. function PrepareAddingRange(ACount: SizeInt): SizeInt; virtual;
  91. procedure Notify(const AValue: T; ACollectionNotification: TCollectionNotification); virtual;
  92. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; virtual;
  93. procedure SetCapacity(AValue: SizeInt); virtual; abstract;
  94. function GetCount: SizeInt; virtual;
  95. public
  96. property Count: SizeInt read GetCount;
  97. property Capacity: SizeInt read GetCapacity write SetCapacity;
  98. property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
  99. procedure TrimExcess; virtual; abstract;
  100. end;
  101. { TCustomListEnumerator }
  102. TCustomListEnumerator<T> = class abstract(TEnumerator<T>)
  103. private
  104. FList: TCustomList<T>;
  105. FIndex: SizeInt;
  106. protected
  107. function DoMoveNext: boolean; override;
  108. function DoGetCurrent: T; override;
  109. function GetCurrent: T; virtual;
  110. public
  111. constructor Create(AList: TCustomList<T>);
  112. end;
  113. { TCustomInvertedListEnumerator }
  114. TCustomInvertedListEnumerator<T> = class abstract(TEnumerator<T>)
  115. private
  116. FList: TCustomList<T>;
  117. FIndex: SizeInt;
  118. protected
  119. function DoMoveNext: boolean; override;
  120. function DoGetCurrent: T; override;
  121. function GetCurrent: T; virtual;
  122. public
  123. constructor Create(AList: TCustomList<T>);
  124. end;
  125. { TList }
  126. {$SCOPEDENUMS ON}
  127. TDirection = (FromBeginning,fromEnd);
  128. {$SCOPEDENUMS OFF}
  129. TList<T> = class(TCustomList<T>)
  130. private
  131. FComparer: IComparer<T>;
  132. function SameValue(const Left, Right: T): Boolean;
  133. protected
  134. procedure SetCapacity(AValue: SizeInt); override;
  135. procedure SetCount(AValue: SizeInt);
  136. procedure InitializeList; virtual;
  137. procedure InternalInsert(AIndex: SizeInt; const AValue: T);
  138. function DoGetEnumerator: TEnumerator<T>; override;
  139. private
  140. function GetItem(AIndex: SizeInt): T;
  141. procedure SetItem(AIndex: SizeInt; const AValue: T);
  142. public
  143. type
  144. TEnumerator = class(TCustomListEnumerator<T>);
  145. TMyType = TList<T>;
  146. function GetEnumerator: TEnumerator; reintroduce;
  147. public
  148. constructor Create; overload;
  149. constructor Create(const AComparer: IComparer<T>); overload;
  150. constructor Create(ACollection: TEnumerable<T>); overload;
  151. destructor Destroy; override;
  152. function Add(const AValue: T): SizeInt; virtual;
  153. procedure AddRange(const AValues: array of T); virtual; overload;
  154. procedure AddRange(const AEnumerable: IEnumerable<T>); overload;
  155. procedure AddRange(AEnumerable: TEnumerable<T>); overload;
  156. procedure Insert(AIndex: SizeInt; const AValue: T); virtual;
  157. procedure InsertRange(AIndex: SizeInt; const AValues: array of T); virtual; overload;
  158. procedure InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>); overload;
  159. procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>); overload;
  160. function Remove(const AValue: T): SizeInt;
  161. function RemoveItem(const AValue: T; Direction : TDirection): SizeInt;
  162. procedure Delete(AIndex: SizeInt); inline;
  163. procedure DeleteRange(AIndex, ACount: SizeInt);
  164. function ExtractIndex(const AIndex: SizeInt): T; overload;
  165. function Extract(const AValue: T): T; overload;
  166. procedure Exchange(AIndex1, AIndex2: SizeInt); virtual;
  167. procedure Move(AIndex, ANewIndex: SizeInt); virtual;
  168. function First: T; inline;
  169. function Last: T; inline;
  170. procedure Clear;
  171. function Contains(const AValue: T): Boolean; inline;
  172. function IndexOf(const AValue: T): SizeInt; virtual;
  173. function LastIndexOf(const AValue: T): SizeInt; virtual;
  174. procedure Reverse;
  175. procedure TrimExcess; override;
  176. procedure Sort; overload;
  177. procedure Sort(const AComparer: IComparer<T>); overload;
  178. function BinarySearch(const AItem: T; out AIndex: SizeInt): Boolean; overload;
  179. function BinarySearch(const AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
  180. property Count: SizeInt read FLength write SetCount;
  181. property Items[Index: SizeInt]: T read GetItem write SetItem; default;
  182. end;
  183. TObjectList<T: class> = class(TList<T>)
  184. private
  185. FObjectsOwner: Boolean;
  186. protected
  187. procedure Notify(const aValue: T; Action: TCollectionNotification); override;
  188. public
  189. constructor Create(aOwnsObjects: Boolean = True); overload;
  190. constructor Create(const AComparer: IComparer<T>; aOwnsObjects: Boolean = True); overload;
  191. constructor Create(const aCollection: TEnumerable<T>; aOwnsObjects: Boolean = True); overload;
  192. property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
  193. end;
  194. { TThreadList }
  195. // This is provided for delphi/FPC compatibility
  196. // No locking is done, since Javascript is single-threaded. We do keep a lock count for debugging purposes.
  197. TThreadList<T> = class
  198. private
  199. FList: TList<T>;
  200. FLock: Integer;
  201. FDuplicates: TDuplicates;
  202. public
  203. constructor Create;
  204. destructor Destroy; override;
  205. procedure Add(const Item: T);
  206. procedure Clear;
  207. function LockList: TList<T>;
  208. procedure Remove(const Item: T); inline;
  209. procedure RemoveItem(const Item: T; Direction: TDirection);
  210. procedure UnlockList; inline;
  211. property Duplicates: TDuplicates read FDuplicates write FDuplicates;
  212. end;
  213. { TQueue }
  214. TQueue<T> = class(TCustomList<T>)
  215. private
  216. FMaxGapLength: Integer;
  217. FLow: SizeInt;
  218. protected
  219. function DoGetEnumerator: TEnumerator<T>; override;
  220. public
  221. type
  222. TMyType = TQueue<T>;
  223. { TEnumerator }
  224. TEnumerator = class(TCustomListEnumerator<T>)
  225. public
  226. constructor Create(AQueue: TMyType);
  227. end;
  228. function GetEnumerator: TEnumerator; reintroduce;
  229. protected
  230. Procedure Rebase; virtual;
  231. procedure SetCapacity(AValue: SizeInt); override;
  232. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
  233. function GetCount: SizeInt; override;
  234. public
  235. Constructor Create; overload;
  236. constructor Create(ACollection: TEnumerable<T>); overload;
  237. destructor Destroy; override;
  238. procedure Enqueue(const AValue: T);
  239. function Dequeue: T;
  240. function Extract: T;
  241. function Peek: T;
  242. procedure Clear;
  243. procedure TrimExcess; override;
  244. // Maximum gap (=amount of empty slots in array before first element)
  245. // before doing a rebase of the list. Defaults to 10.
  246. Property MaxGapLength : Integer Read FMaxGapLength Write FMaxGapLength;
  247. end;
  248. { TObjectQueue }
  249. TObjectQueue<T: class> = class(TQueue<T>)
  250. private
  251. FOwnsObjects: Boolean;
  252. protected
  253. procedure Notify(const Value: T; Action: TCollectionNotification); override;
  254. public
  255. constructor Create(AOwnsObjects: Boolean = True); overload;
  256. constructor Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
  257. procedure Dequeue; reintroduce; // Can't use the result, it might have been freed;
  258. property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
  259. end;
  260. { TStack }
  261. TStack<T> = class(TCustomList<T>)
  262. private
  263. protected
  264. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
  265. procedure SetCapacity(AValue: SizeInt); override;
  266. function DoGetEnumerator: TEnumerator<T>; override;
  267. public
  268. type
  269. TMyType = TStack<T>;
  270. { TEnumerator }
  271. TEnumerator = class(TCustomListEnumerator<T>)
  272. public
  273. constructor Create(AStack: TMyType);
  274. end;
  275. function GetEnumerator: TEnumerator; reintroduce;
  276. Public
  277. destructor Destroy; override;
  278. procedure Clear;
  279. procedure Push(const aValue: T);
  280. function Pop: T;
  281. function Peek: T;
  282. function Extract: T;
  283. procedure TrimExcess; override;
  284. property Count: SizeInt read GetCount;
  285. end;
  286. { TObjectStack }
  287. TObjectStack<T: class> = class(TStack<T>)
  288. private
  289. FOwnsObjects: Boolean;
  290. protected
  291. procedure Notify(const aValue: T; Action: TCollectionNotification); override;
  292. public
  293. constructor Create(AOwnsObjects: Boolean = True); overload;
  294. constructor Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
  295. procedure Pop; reintroduce; // Can't use the result, it might have been freed;
  296. property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
  297. end;
  298. { TPair }
  299. TPair<TKey,TValue> = record
  300. Key: TKey;
  301. Value: TValue;
  302. constructor Create(const AKey: TKey; const AValue: TValue);
  303. end;
  304. // Hash table using linear probing
  305. { TDictionary }
  306. EDictionary = Class(Exception);
  307. TDictionary<TKey,TValue> = class(TEnumerable<TPair<TKey,TValue>>)
  308. private
  309. FMap: TJSMap;
  310. FComparer: IComparer<TKey>;
  311. function GetEffectiveKey(Key : TKey) : TKey;
  312. function GetItem(const Key: TKey): TValue;
  313. procedure SetItem(const Key: TKey; const Value: TValue);
  314. procedure DoAdd(const Key: TKey; const Value: TValue);
  315. function DoRemove(const Key: TKey; Notification: TCollectionNotification): TValue;
  316. Function GetCount : Integer;
  317. protected
  318. Function CanClearMap : Boolean; virtual;
  319. function DoGetEnumerator: TEnumerator<TPair<TKey,TValue>>; override;
  320. procedure PairNotify(const Key: TKey; Value : TValue; Action: TCollectionNotification); virtual;
  321. procedure KeyNotify(const Key: TKey; Action: TCollectionNotification); virtual;
  322. procedure ValueNotify(const Value: TValue; Action: TCollectionNotification); virtual;
  323. public
  324. Type
  325. TMyType = TDictionary<TKey,TValue>;
  326. TMyPair = TPair<TKey,TValue>;
  327. constructor Create(ACapacity: Integer=0); overload;
  328. constructor Create(const Collection: TEnumerable<TMyPair>); overload;
  329. constructor Create(const AComparer: IComparer<TKey>); overload;
  330. destructor Destroy; override;
  331. procedure Add(const Key: TKey; const Value: TValue);
  332. procedure Remove(const Key: TKey);
  333. function ExtractPair(const Key: TKey): TMyPair;
  334. procedure Clear;
  335. function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
  336. procedure AddOrSetValue(const Key: TKey; const Value: TValue);
  337. function ContainsKey(const Key: TKey): Boolean;
  338. function ContainsValue(const Value: TValue): Boolean;
  339. function ToArray: TArray<TMyPair>; override;
  340. property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
  341. property Count: Integer read GetCount;
  342. type
  343. { TPairEnumerator }
  344. TPairEnumerator = class(TEnumerator<TMyPair>)
  345. private
  346. FIter: TJSIterator;
  347. FVal : TJSIteratorValue;
  348. function GetCurrent: TMyPair;
  349. protected
  350. function DoGetCurrent: TMyPair; override;
  351. function DoMoveNext: Boolean; override;
  352. public
  353. constructor Create(const ADictionary: TMyType);
  354. function MoveNext: Boolean; reintroduce;
  355. property Current: TMyPair read GetCurrent;
  356. end;
  357. { TKeyEnumerator }
  358. TKeyEnumerator = class(TEnumerator<TKey>)
  359. private
  360. FIter: TJSIterator;
  361. FVal : TJSIteratorValue;
  362. function GetCurrent: TKey;
  363. protected
  364. function DoGetCurrent: TKey; override;
  365. function DoMoveNext: Boolean; override;
  366. public
  367. constructor Create(const AIter: TJSIterator); overload;
  368. constructor Create(const ADictionary: TMyType); overload;
  369. function MoveNext: Boolean; reintroduce;
  370. property Current: TKey read GetCurrent;
  371. end;
  372. { TValueEnumerator }
  373. TValueEnumerator = class(TEnumerator<TValue>)
  374. private
  375. FIter: TJSIterator;
  376. FVal : TJSIteratorValue;
  377. function GetCurrent: TValue;
  378. protected
  379. function DoGetCurrent: TValue; override;
  380. function DoMoveNext: Boolean; override;
  381. public
  382. constructor Create(const AIter: TJSIterator); overload;
  383. constructor Create(const ADictionary: TMyType); overload;
  384. function MoveNext: Boolean; reintroduce;
  385. property Current: TValue read GetCurrent;
  386. end;
  387. { TValueCollection }
  388. TValueCollection = class(TEnumerable<TValue>)
  389. private
  390. FMap: TJSMap;
  391. function GetCount: Integer;
  392. protected
  393. function DoGetEnumerator: TEnumerator<TValue>; override;
  394. public
  395. constructor Create(const ADictionary: TMyType);
  396. function GetEnumerator: TValueEnumerator; reintroduce;
  397. function ToArray: TArray<TValue>; override;
  398. property Count: Integer read GetCount;
  399. end;
  400. { TKeyCollection }
  401. TKeyCollection = class(TEnumerable<TKey>)
  402. private
  403. FMap: TJSMap;
  404. function GetCount: Integer;
  405. protected
  406. function DoGetEnumerator: TEnumerator<TKey>; override;
  407. public
  408. constructor Create(const ADictionary: TMyType);
  409. function GetEnumerator: TKeyEnumerator; reintroduce;
  410. function ToArray: TArray<TKey>; override;
  411. property Count: Integer read GetCount;
  412. end;
  413. private
  414. FOnKeyNotify: TCollectionNotifyEvent<TKey>;
  415. FOnValueNotify: TCollectionNotifyEvent<TValue>;
  416. FKeyCollection: TKeyCollection;
  417. FValueCollection: TValueCollection;
  418. function GetKeys: TKeyCollection;
  419. function GetValues: TValueCollection;
  420. public
  421. function GetEnumerator: TPairEnumerator; reintroduce;
  422. property Keys: TKeyCollection read GetKeys;
  423. property Values: TValueCollection read GetValues;
  424. property OnKeyNotify: TCollectionNotifyEvent<TKey> read FOnKeyNotify write FOnKeyNotify;
  425. property OnValueNotify: TCollectionNotifyEvent<TValue> read FOnValueNotify write FOnValueNotify;
  426. end;
  427. TDictionaryOwnership = (doOwnsKeys, doOwnsValues);
  428. TDictionaryOwnerships = set of TDictionaryOwnership;
  429. { TObjectDictionary }
  430. TObjectDictionary<TKey,TValue> = class(TDictionary<TKey,TValue>)
  431. private
  432. FOwnerships: TDictionaryOwnerships;
  433. protected
  434. Function CanClearMap : Boolean; override;
  435. procedure KeyNotify(const Key: TKey; Action: TCollectionNotification); override;
  436. procedure ValueNotify(const Value: TValue; Action: TCollectionNotification); override;
  437. public
  438. constructor Create(aOwnerships: TDictionaryOwnerships; ACapacity: Integer); overload;
  439. constructor Create(aOwnerships: TDictionaryOwnerships); overload;
  440. Property OwnerShips : TDictionaryOwnerships Read FOwnerships Write FOwnerShips;
  441. end;
  442. implementation
  443. { TCustomArrayHelper }
  444. class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
  445. const AComparer: IComparer<T>);
  446. begin
  447. QuickSort(AValues, 0, Length(AValues), AComparer);
  448. end;
  449. class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
  450. const AComparer: IComparer<T>; AIndex, ACount: SizeInt);
  451. begin
  452. if ACount <= 1 then
  453. Exit;
  454. QuickSort(AValues, AIndex, Pred(AIndex + ACount), AComparer);
  455. end;
  456. class function TCustomArrayHelper<T>.BinarySearch(const AValues: array of T;
  457. const AItem: T; out AFoundIndex: SizeInt; const AComparer: IComparer<T>
  458. ): Boolean;
  459. begin
  460. Result := BinarySearch(AValues, AItem, AFoundIndex, AComparer,
  461. 0, Length(AValues));
  462. end;
  463. class function TCustomArrayHelper<T>.BinarySearch(const AValues: array of T;
  464. const AItem: T; out ASearchResult: TBinarySearchResult;
  465. const AComparer: IComparer<T>): Boolean;
  466. begin
  467. Result := BinarySearch(AValues, AItem, ASearchResult, AComparer,
  468. 0, Length(AValues));
  469. end;
  470. { TArrayHelper }
  471. class procedure TArrayHelper<T>.QuickSort(var AValues: array of T; ALeft,
  472. ARight: SizeInt; const AComparer: IComparer<T>);
  473. var
  474. I, J: SizeInt;
  475. P, Q: T;
  476. begin
  477. if ((ARight - ALeft) <= 0) or (Length(AValues) = 0) then
  478. Exit;
  479. repeat
  480. I := ALeft;
  481. J := ARight;
  482. P := AValues[ALeft + (ARight - ALeft) shr 1];
  483. repeat
  484. while AComparer.Compare(AValues[I], P) < 0 do
  485. Inc(I);
  486. while AComparer.Compare(AValues[J], P) > 0 do
  487. Dec(J);
  488. if I <= J then
  489. begin
  490. if I <> J then
  491. begin
  492. Q := AValues[I];
  493. AValues[I] := AValues[J];
  494. AValues[J] := Q;
  495. end;
  496. Inc(I);
  497. Dec(J);
  498. end;
  499. until I > J;
  500. // sort the smaller range recursively
  501. // sort the bigger range via the loop
  502. // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
  503. if J - ALeft < ARight - I then
  504. begin
  505. if ALeft < J then
  506. QuickSort(AValues, ALeft, J, AComparer);
  507. ALeft := I;
  508. end
  509. else
  510. begin
  511. if I < ARight then
  512. QuickSort(AValues, I, ARight, AComparer);
  513. ARight := J;
  514. end;
  515. until ALeft >= ARight;
  516. end;
  517. class function TArrayHelper<T>.BinarySearch(const AValues: array of T;
  518. const AItem: T; out ASearchResult: TBinarySearchResult;
  519. const AComparer: IComparer<T>; AIndex, ACount: SizeInt): Boolean;
  520. var
  521. imin, imax, imid, ilo: Int32;
  522. begin
  523. // Writeln('Enter ',Length(aValues),' Idx ',aIndex,' acount: ',aCount);
  524. // continually narrow search until just one element remains
  525. imin := AIndex;
  526. imax := Pred(AIndex + ACount);
  527. // Writeln('Start Imax, imin : ',Imax, ' - ', imin);
  528. ilo:=imid * imid;
  529. imid:=ilo*imid;
  530. while (imin < imax) do
  531. begin
  532. imid := (imax+imin) div 2;
  533. // writeln('imid',imid);
  534. ASearchResult.CompareResult := AComparer.Compare(AValues[imid], AItem);
  535. // reduce the search
  536. if (ASearchResult.CompareResult < 0) then
  537. imin := imid + 1
  538. else
  539. begin
  540. if ASearchResult.CompareResult = 0 then
  541. begin
  542. ASearchResult.FoundIndex := imid;
  543. ASearchResult.CandidateIndex := imid;
  544. Exit(True);
  545. end;
  546. imax := imid;
  547. end;
  548. end;
  549. // At exit of while:
  550. // if A[] is empty, then imax < imin
  551. // otherwise imax == imin
  552. // deferred test for equality
  553. // Writeln('End Imax, imin : ',Imax, ' - ', imin);
  554. Result:=(imax = imin);
  555. if Result then
  556. begin
  557. ASearchResult.CompareResult := AComparer.Compare(AValues[imin], AItem);
  558. ASearchResult.CandidateIndex := imin;
  559. Result:=(ASearchResult.CompareResult = 0);
  560. if Result then
  561. ASearchResult.FoundIndex := imin
  562. else
  563. ASearchResult.FoundIndex := -1;
  564. end
  565. else
  566. begin
  567. ASearchResult.CompareResult := 0;
  568. ASearchResult.FoundIndex := -1;
  569. ASearchResult.CandidateIndex := -1;
  570. end;
  571. end;
  572. class function TArrayHelper<T>.BinarySearch(const AValues: array of T;
  573. const AItem: T; out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  574. AIndex, ACount: SizeInt): Boolean;
  575. var
  576. imin, imax, imid: Int32;
  577. LCompare: SizeInt;
  578. begin
  579. // continually narrow search until just one element remains
  580. imin := AIndex;
  581. imax := Pred(AIndex + ACount);
  582. // http://en.wikipedia.org/wiki/Binary_search_algorithm
  583. while (imin < imax) do
  584. begin
  585. imid := (imin + imax) div 2;
  586. // code must guarantee the interval is reduced at each iteration
  587. // assert(imid < imax);
  588. // note: 0 <= imin < imax implies imid will always be less than imax
  589. LCompare := AComparer.Compare(AValues[imid], AItem);
  590. // reduce the search
  591. if (LCompare < 0) then
  592. imin := imid + 1
  593. else
  594. begin
  595. if LCompare = 0 then
  596. begin
  597. AFoundIndex := imid;
  598. Exit(True);
  599. end;
  600. imax := imid;
  601. end;
  602. end;
  603. // At exit of while:
  604. // if A[] is empty, then imax < imin
  605. // otherwise imax == imin
  606. // deferred test for equality
  607. LCompare := AComparer.Compare(AValues[imin], AItem);
  608. Result:=(imax = imin) and (LCompare = 0);
  609. if Result then
  610. AFoundIndex := imin
  611. else
  612. AFoundIndex := -1;
  613. end;
  614. { TEnumerator }
  615. function TEnumerator<T>.MoveNext: boolean;
  616. begin
  617. Result:=DoMoveNext;
  618. end;
  619. { TEnumerable }
  620. function TEnumerable<T>.GetEnumerator: TMyEnumerator;
  621. begin
  622. Result:=DoGetEnumerator;
  623. end;
  624. function TEnumerable<T>.ToArray: TMyArray;
  625. var
  626. LEnumerator: TMyEnumerator;
  627. begin
  628. Result:=[];
  629. LEnumerator := GetEnumerator;
  630. try
  631. while LEnumerator.MoveNext do
  632. TJSArray(Result).push(LEnumerator.Current);
  633. finally
  634. LEnumerator.Free;
  635. end;
  636. end;
  637. { TCustomList }
  638. function TCustomList<T>.GetCapacity: SizeInt;
  639. begin
  640. Result:=length(FItems);
  641. end;
  642. function TCustomList<T>.PrepareAddingItem: SizeInt;
  643. begin
  644. if FLength=length(FItems) then
  645. TJSArray(FItems).push(Default(T));
  646. Result := FLength;
  647. Inc(FLength);
  648. end;
  649. function TCustomList<T>.PrepareAddingRange(ACount: SizeInt): SizeInt;
  650. var
  651. l: SizeInt;
  652. begin
  653. if ACount < 0 then
  654. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  655. if ACount = 0 then
  656. Exit(FLength - 1);
  657. for l:=length(FItems)+1 to FLength+ACount do
  658. TJSArray(FItems).push(Default(T));
  659. Result := FLength;
  660. Inc(FLength, ACount);
  661. end;
  662. procedure TCustomList<T>.Notify(const AValue: T;
  663. ACollectionNotification: TCollectionNotification);
  664. begin
  665. if Assigned(FOnNotify) then
  666. FOnNotify(Self, AValue, ACollectionNotification);
  667. end;
  668. function TCustomList<T>.DoRemove(AIndex: SizeInt;
  669. ACollectionNotification: TCollectionNotification): T;
  670. begin
  671. if (AIndex < 0) or (AIndex >= FLength) then
  672. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  673. Result := FItems[AIndex];
  674. Dec(FLength);
  675. FItems[AIndex] := Default(T); // needed for refcounted types
  676. TJSArray(FItems).splice(AIndex,1);
  677. Notify(Result, ACollectionNotification);
  678. end;
  679. function TCustomList<T>.GetCount: SizeInt;
  680. begin
  681. Result := FLength;
  682. end;
  683. { TCustomListEnumerator }
  684. function TCustomListEnumerator<T>.DoMoveNext: boolean;
  685. begin
  686. Inc(FIndex);
  687. Result := (FList.FLength > 0) and (FIndex < FList.FLength)
  688. end;
  689. function TCustomListEnumerator<T>.DoGetCurrent: T;
  690. begin
  691. Result := GetCurrent;
  692. end;
  693. function TCustomListEnumerator<T>.GetCurrent: T;
  694. begin
  695. Result := FList.FItems[FIndex];
  696. end;
  697. constructor TCustomListEnumerator<T>.Create(AList: TCustomList<T>);
  698. begin
  699. inherited Create;
  700. FIndex := -1;
  701. FList := AList;
  702. end;
  703. { TList }
  704. function TList<T>.SameValue(const Left, Right: T): Boolean;
  705. begin
  706. if Assigned(FComparer) then
  707. Result:=(FComparer.Compare(Left, Right) = 0)
  708. else
  709. Result:=(Left = Right);
  710. end;
  711. procedure TList<T>.SetCapacity(AValue: SizeInt);
  712. begin
  713. if AValue < Count then
  714. Count := AValue;
  715. SetLength(FItems, AValue);
  716. end;
  717. procedure TList<T>.SetCount(AValue: SizeInt);
  718. begin
  719. if AValue < 0 then
  720. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  721. if AValue > Capacity then
  722. Capacity := AValue
  723. else if AValue < Count then
  724. DeleteRange(AValue, Count - AValue);
  725. FLength := AValue;
  726. end;
  727. procedure TList<T>.InitializeList;
  728. begin
  729. end;
  730. procedure TList<T>.InternalInsert(AIndex: SizeInt; const AValue: T);
  731. begin
  732. if (AIndex < 0) or (AIndex > Count) then
  733. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  734. TJSArray(FItems).splice(AIndex,0,AValue);
  735. inc(FLength);
  736. FItems[AIndex] := AValue;
  737. Notify(AValue, cnAdded);
  738. end;
  739. function TList<T>.DoGetEnumerator: TEnumerator<T>;
  740. begin
  741. Result := GetEnumerator;
  742. end;
  743. function TList<T>.GetItem(AIndex: SizeInt): T;
  744. begin
  745. if (AIndex < 0) or (AIndex >= Count) then
  746. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  747. Result := FItems[AIndex];
  748. end;
  749. procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
  750. begin
  751. if (AIndex < 0) or (AIndex >= Count) then
  752. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  753. Notify(FItems[AIndex], cnRemoved);
  754. FItems[AIndex] := AValue;
  755. Notify(AValue, cnAdded);
  756. end;
  757. function TList<T>.GetEnumerator: TEnumerator;
  758. begin
  759. Result := TEnumerator.Create(Self);
  760. end;
  761. constructor TList<T>.Create;
  762. begin
  763. InitializeList;
  764. end;
  765. constructor TList<T>.Create(const AComparer: IComparer<T>);
  766. begin
  767. InitializeList;
  768. FComparer := AComparer;
  769. end;
  770. constructor TList<T>.Create(ACollection: TEnumerable<T>);
  771. var
  772. LItem: T;
  773. begin
  774. Create;
  775. for LItem in ACollection do
  776. Add(LItem);
  777. end;
  778. destructor TList<T>.Destroy;
  779. begin
  780. SetCapacity(0);
  781. end;
  782. function TList<T>.Add(const AValue: T): SizeInt;
  783. begin
  784. Result := PrepareAddingItem;
  785. FItems[Result] := AValue;
  786. Notify(AValue, cnAdded);
  787. end;
  788. procedure TList<T>.AddRange(const AValues: array of T);
  789. begin
  790. InsertRange(Count, AValues);
  791. end;
  792. procedure TList<T>.AddRange(const AEnumerable: IEnumerable<T>);
  793. var
  794. LValue: T;
  795. begin
  796. for LValue in AEnumerable do
  797. Add(LValue);
  798. end;
  799. procedure TList<T>.AddRange(AEnumerable: TEnumerable<T>);
  800. var
  801. LValue: T;
  802. begin
  803. for LValue in AEnumerable do
  804. Add(LValue);
  805. end;
  806. procedure TList<T>.Insert(AIndex: SizeInt; const AValue: T);
  807. begin
  808. if (AIndex < 0) or (AIndex > Count) then
  809. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  810. InternalInsert(AIndex, AValue);
  811. end;
  812. procedure TList<T>.InsertRange(AIndex: SizeInt; const AValues: array of T);
  813. var
  814. LLength, i: sizeint;
  815. LValue: T;
  816. begin
  817. if (AIndex < 0) or (AIndex > Count) then
  818. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  819. LLength := Length(AValues);
  820. if LLength = 0 then
  821. Exit;
  822. if AIndex <> PrepareAddingRange(LLength) then
  823. begin
  824. for i := AIndex to Count - LLength -1 do
  825. FItems[i+LLength] := FItems[i];
  826. for i := 0 to LLength -1 do
  827. FItems[AIndex+i] := Default(T);
  828. end;
  829. for i := 0 to Pred(LLength) do
  830. begin
  831. LValue:=AValues[i];
  832. FItems[i+AIndex] := LValue;
  833. Notify(LValue, cnAdded);
  834. end;
  835. end;
  836. procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>);
  837. var
  838. LValue: T;
  839. i: SizeInt;
  840. begin
  841. if (AIndex < 0) or (AIndex > Count) then
  842. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  843. i := 0;
  844. for LValue in AEnumerable do
  845. begin
  846. InternalInsert(AIndex + i, LValue);
  847. Inc(i);
  848. end;
  849. end;
  850. procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>);
  851. var
  852. LValue: T;
  853. i: SizeInt;
  854. begin
  855. if (AIndex < 0) or (AIndex > Count) then
  856. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  857. i := 0;
  858. for LValue in AEnumerable do
  859. begin
  860. InternalInsert(Aindex + i, LValue);
  861. Inc(i);
  862. end;
  863. end;
  864. function TList<T>.RemoveItem(const AValue: T; Direction : TDirection): SizeInt;
  865. begin
  866. if Direction=TDirection.FromEnd then
  867. Result := LastIndexOf(AValue)
  868. else
  869. Result := IndexOf(AValue);
  870. if Result >= 0 then
  871. DoRemove(Result, cnRemoved);
  872. end;
  873. function TList<T>.Remove(const AValue: T): SizeInt;
  874. begin
  875. Result := IndexOf(AValue);
  876. if Result >= 0 then
  877. DoRemove(Result, cnRemoved);
  878. end;
  879. procedure TList<T>.Delete(AIndex: SizeInt);
  880. begin
  881. DoRemove(AIndex, cnRemoved);
  882. end;
  883. procedure TList<T>.DeleteRange(AIndex, ACount: SizeInt);
  884. var
  885. LDeleted: TMyArray;
  886. i: SizeInt;
  887. begin
  888. if ACount = 0 then
  889. Exit;
  890. if (ACount < 0) or (AIndex < 0) or (AIndex + ACount > Count) then
  891. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  892. LDeleted:=TMyArray(TJSArray(FItems).splice(AIndex,Count));
  893. Dec(FLength, ACount);
  894. for i := 0 to High(LDeleted) do
  895. Notify(LDeleted[i], cnRemoved);
  896. end;
  897. function TList<T>.ExtractIndex(const AIndex: SizeInt): T;
  898. begin
  899. Result := DoRemove(AIndex, cnExtracted);
  900. end;
  901. function TList<T>.Extract(const AValue: T): T;
  902. var
  903. LIndex: SizeInt;
  904. begin
  905. LIndex := IndexOf(AValue);
  906. if LIndex < 0 then
  907. Result:=Default(T)
  908. else
  909. Result := DoRemove(LIndex, cnExtracted);
  910. end;
  911. procedure TList<T>.Exchange(AIndex1, AIndex2: SizeInt);
  912. var
  913. LTemp: T;
  914. begin
  915. LTemp := FItems[AIndex1];
  916. FItems[AIndex1] := FItems[AIndex2];
  917. FItems[AIndex2] := LTemp;
  918. end;
  919. procedure TList<T>.Move(AIndex, ANewIndex: SizeInt);
  920. var
  921. Arr: TJSArray;
  922. LTemp: JSValue;
  923. i: SizeInt;
  924. begin
  925. if ANewIndex = AIndex then
  926. Exit;
  927. if (ANewIndex < 0) or (ANewIndex >= Count) then
  928. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  929. Arr := TJSArray(FItems);
  930. LTemp := Arr[AIndex];
  931. if AIndex < ANewIndex then
  932. for i := AIndex to ANewIndex-1 do
  933. Arr[i] := Arr[i+1]
  934. else
  935. for i := ANewIndex downto AIndex+1 do
  936. Arr[i] := Arr[i-1];
  937. Arr[ANewIndex] := LTemp;
  938. end;
  939. function TList<T>.First: T;
  940. begin
  941. Result := Items[0];
  942. end;
  943. function TList<T>.Last: T;
  944. begin
  945. Result := Items[Pred(Count)];
  946. end;
  947. procedure TList<T>.Clear;
  948. begin
  949. SetCount(0);
  950. SetCapacity(0);
  951. end;
  952. function TList<T>.Contains(const AValue: T): Boolean;
  953. begin
  954. Result := IndexOf(AValue) >= 0;
  955. end;
  956. function TList<T>.IndexOf(const AValue: T): SizeInt;
  957. var
  958. i: SizeInt;
  959. begin
  960. for i := 0 to Count - 1 do
  961. if SameValue(AValue, FItems[i]) then
  962. Exit(i);
  963. Result:=-1;
  964. end;
  965. function TList<T>.LastIndexOf(const AValue: T): SizeInt;
  966. var
  967. i: SizeInt;
  968. begin
  969. for i := Count - 1 downto 0 do
  970. if SameValue(AValue, FItems[i]) then
  971. Exit(i);
  972. Result:=-1;
  973. end;
  974. procedure TList<T>.Reverse;
  975. var
  976. a, b: SizeInt;
  977. LTemp: T;
  978. begin
  979. a := 0;
  980. b := Count - 1;
  981. while a < b do
  982. begin
  983. LTemp := FItems[a];
  984. FItems[a] := FItems[b];
  985. FItems[b] := LTemp;
  986. Inc(a);
  987. Dec(b);
  988. end;
  989. end;
  990. procedure TList<T>.TrimExcess;
  991. begin
  992. SetCapacity(Count);
  993. end;
  994. procedure TList<T>.Sort;
  995. begin
  996. TMyArrayHelper.Sort(FItems, FComparer, 0, Count);
  997. end;
  998. procedure TList<T>.Sort(const AComparer: IComparer<T>);
  999. begin
  1000. TMyArrayHelper.Sort(FItems, AComparer, 0, Count);
  1001. end;
  1002. function TList<T>.BinarySearch(const AItem: T; out AIndex: SizeInt): Boolean;
  1003. begin
  1004. Result := TMyArrayHelper.BinarySearch(FItems, AItem, AIndex, FComparer, 0, Count);
  1005. end;
  1006. function TList<T>.BinarySearch(const AItem: T; out AIndex: SizeInt;
  1007. const AComparer: IComparer<T>): Boolean;
  1008. begin
  1009. Result := TMyArrayHelper.BinarySearch(FItems, AItem, AIndex, AComparer, 0, Count);
  1010. end;
  1011. { TPair }
  1012. constructor TPair<TKey,TValue>.Create(const AKey: TKey; const AValue: TValue);
  1013. begin
  1014. Key:=aKey;
  1015. Value:=aValue;
  1016. end;
  1017. { TDictionary }
  1018. ResourceString
  1019. SErrDictKeyNotFound = 'Key value not found';
  1020. SErrDictDuplicateKey = 'Duplicate key value';
  1021. function TDictionary<TKey, TValue>.GetEffectiveKey(Key: TKey): TKey;
  1022. Var
  1023. it : TJSIterator;
  1024. v : TJSIteratorValue;
  1025. vv : JSValue;
  1026. begin
  1027. if Not assigned(FComparer) then
  1028. Exit(key);
  1029. it:=FMap.Keys;
  1030. v:=it.next;
  1031. While not v.Done do
  1032. begin
  1033. Result:=TKey(v.Value);
  1034. if FComparer.Compare(Result,Key)=0 then
  1035. exit;
  1036. v:=it.Next;
  1037. end;
  1038. Result:=Key;
  1039. end;
  1040. function TDictionary<TKey, TValue>.GetItem(const Key: TKey): TValue;
  1041. Var
  1042. V : JSValue;
  1043. begin
  1044. v:=FMap.Get(GetEffectiveKey(Key));
  1045. if isUndefined(v) then
  1046. Raise EDictionary.Create(SErrDictKeyNotFound);
  1047. Result:=TValue(V);
  1048. end;
  1049. procedure TDictionary<TKey, TValue>.SetItem(const Key: TKey; const Value: TValue);
  1050. Var
  1051. V : JSValue;
  1052. begin
  1053. v:=FMap.Get(GetEffectiveKey(Key));
  1054. if Not isUndefined(v) then
  1055. ValueNotify(TValue(V),cnRemoved);
  1056. FMap.&Set(Key,Value);
  1057. ValueNotify(Value, cnAdded);
  1058. end;
  1059. procedure TDictionary<TKey, TValue>.DoAdd(const Key: TKey; const Value: TValue);
  1060. Var
  1061. k : Tkey;
  1062. begin
  1063. FMap.&Set(GetEffectiveKey(Key),Value);
  1064. KeyNotify(Key,cnAdded);
  1065. ValueNotify(Value,cnAdded);
  1066. end;
  1067. function TDictionary<TKey, TValue>.DoRemove(const Key: TKey; Notification: TCollectionNotification): TValue;
  1068. Var
  1069. V : JSValue;
  1070. K : TKey;
  1071. begin
  1072. K:=GetEffectiveKey(Key);
  1073. V:=FMap.Get(k);
  1074. if Not isUndefined(v) then
  1075. begin
  1076. FMap.Delete(k);
  1077. Result:=TValue(v);
  1078. KeyNotify(Key,Notification);
  1079. ValueNotify(Result,Notification);
  1080. end;
  1081. end;
  1082. function TDictionary<TKey, TValue>.GetCount: Integer;
  1083. begin
  1084. Result:=FMap.Size;
  1085. end;
  1086. function TDictionary<TKey, TValue>.DoGetEnumerator: TEnumerator<TPair<TKey,
  1087. TValue>>;
  1088. begin
  1089. Result:=TPairEnumerator.Create(Self);
  1090. end;
  1091. procedure TDictionary<TKey, TValue>.PairNotify(const Key: TKey; Value : TValue; Action: TCollectionNotification);
  1092. begin
  1093. KeyNotify(Key,action);
  1094. ValueNotify(Value,action);
  1095. end;
  1096. procedure TDictionary<TKey, TValue>.KeyNotify(const Key: TKey; Action: TCollectionNotification);
  1097. begin
  1098. if Assigned(FOnKeyNotify) then
  1099. FOnKeyNotify(Self,Key,Action);
  1100. end;
  1101. procedure TDictionary<TKey, TValue>.ValueNotify(const Value: TValue; Action: TCollectionNotification);
  1102. begin
  1103. if Assigned(FOnValueNotify) then
  1104. FOnValueNotify(Self,Value,Action);
  1105. end;
  1106. constructor TDictionary<TKey, TValue>.Create(ACapacity: Integer = 0);
  1107. begin
  1108. FMap:=TJSMap.New;
  1109. end;
  1110. constructor TDictionary<TKey, TValue>.Create(const Collection: TEnumerable<TMyPair>);
  1111. Var
  1112. aPair : TMyPair;
  1113. begin
  1114. Create(0);
  1115. For aPair in Collection do
  1116. Add(aPair.Key,aPair.Value);
  1117. end;
  1118. constructor TDictionary<TKey, TValue>.Create(const AComparer: IComparer<TKey>);
  1119. begin
  1120. Create(0);
  1121. FComparer:=aComparer;
  1122. end;
  1123. destructor TDictionary<TKey, TValue>.Destroy;
  1124. begin
  1125. FreeAndNil(FKeyCollection);
  1126. FreeAndNil(FValueCollection);
  1127. Clear;
  1128. FMap:=Nil;
  1129. inherited Destroy;
  1130. end;
  1131. procedure TDictionary<TKey, TValue>.Add(const Key: TKey; const Value: TValue);
  1132. begin
  1133. if FMap.Has(GetEffectiveKey(Key)) then
  1134. Raise EDictionary.Create(SErrDictDuplicateKey);
  1135. DoAdd(Key,Value);
  1136. end;
  1137. procedure TDictionary<TKey, TValue>.Remove(const Key: TKey);
  1138. begin
  1139. doRemove(Key,cnRemoved);
  1140. end;
  1141. function TDictionary<TKey, TValue>.ExtractPair(const Key: TKey): TMyPair;
  1142. Var
  1143. K : TKey;
  1144. begin
  1145. Result:=Default(TMyPair);
  1146. K:=GetEffectiveKey(Key);
  1147. if FMap.Has(K) then
  1148. begin
  1149. Result.Create(Key,TValue(FMap.get(K)));
  1150. FMap.Delete(k);
  1151. end
  1152. else
  1153. Result.Create(Key,Default(TValue));
  1154. end;
  1155. function TDictionary<TKey, TValue>.CanClearMap: Boolean;
  1156. begin
  1157. Result:=(FOnKeyNotify=Nil) and (FOnValueNotify=Nil);
  1158. end;
  1159. procedure TDictionary<TKey, TValue>.Clear;
  1160. Var
  1161. Iter : TJSIterator;
  1162. IVal : TJSIteratorValue;
  1163. A : TJSValueDynArray;
  1164. K : TKey;
  1165. V : TValue;
  1166. begin
  1167. if CanClearMap then
  1168. Fmap.Clear
  1169. else
  1170. begin
  1171. Iter:=FMap.Entries;
  1172. Repeat
  1173. IVal:=Iter.next;
  1174. if not ival.Done then
  1175. begin
  1176. A:=TJSValueDynArray(IVal.Value);
  1177. K:=TKey(A[0]);
  1178. V:=TValue(A[1]);
  1179. FMap.delete(k);
  1180. PairNotify(K,V,cnRemoved);
  1181. end;
  1182. Until Ival.Done;
  1183. end;
  1184. end;
  1185. function TDictionary<TKey, TValue>.TryGetValue(const Key: TKey; out Value: TValue): Boolean;
  1186. Var
  1187. K : TKey;
  1188. begin
  1189. K:=GetEffectiveKey(Key);
  1190. Result:=FMap.Has(K);
  1191. If Result then
  1192. Value:=TValue(FMap.get(K));
  1193. end;
  1194. procedure TDictionary<TKey, TValue>.AddOrSetValue(const Key: TKey; const Value: TValue);
  1195. Var
  1196. k : TKey;
  1197. begin
  1198. K:=GetEffectiveKey(Key);
  1199. if Not FMap.Has(k) then
  1200. DoAdd(Key,Value)
  1201. else
  1202. SetItem(K,Value);
  1203. end;
  1204. function TDictionary<TKey, TValue>.ContainsKey(const Key: TKey): Boolean;
  1205. begin
  1206. Result:=FMap.Has(GetEffectiveKey(Key));
  1207. end;
  1208. function TDictionary<TKey, TValue>.ContainsValue(const Value: TValue): Boolean;
  1209. Var
  1210. It : TJSIterator;
  1211. Res : TJSIteratorValue;
  1212. begin
  1213. Result:=False;
  1214. It:=FMap.Values;
  1215. Repeat
  1216. Res:=It.next;
  1217. if not Res.done then
  1218. Result:=(Value=TValue(Res.value));
  1219. Until (Result or Res.done);
  1220. end;
  1221. function TDictionary<TKey, TValue>.ToArray: TArray<TMyPair>;
  1222. begin
  1223. Result:=inherited ToArray;
  1224. end;
  1225. function TDictionary<TKey, TValue>.GetKeys: TKeyCollection;
  1226. begin
  1227. if FKeyCollection=Nil then
  1228. FKeyCollection:=TKeyCollection.Create(Self);
  1229. Result:=FKeyCollection;
  1230. end;
  1231. function TDictionary<TKey, TValue>.GetValues: TValueCollection;
  1232. begin
  1233. if FValueCollection=Nil then
  1234. FValueCollection:=TValueCollection.Create(Self);
  1235. Result:=FValueCollection;
  1236. end;
  1237. function TDictionary<TKey, TValue>.GetEnumerator: TPairEnumerator;
  1238. begin
  1239. Result:=TPairEnumerator.Create(Self);
  1240. end;
  1241. { TDictionary.TPairEnumerator }
  1242. function TDictionary<TKey, TValue>.TPairEnumerator.GetCurrent: TMyPair;
  1243. begin
  1244. Result:=DoGetCurrent;
  1245. end;
  1246. function TDictionary<TKey, TValue>.TPairEnumerator.DoGetCurrent: TMyPair;
  1247. Var
  1248. A : TJSValueDynArray;
  1249. begin
  1250. A:=TJSValueDynArray(FVal.Value);
  1251. Result:=Default(TMyPair);
  1252. Result.Create(TKey(A[0]),TValue(A[1]));
  1253. end;
  1254. function TDictionary<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
  1255. begin
  1256. FVal:=FIter.Next;
  1257. Result:=Not FVal.Done;
  1258. end;
  1259. constructor TDictionary<TKey, TValue>.TPairEnumerator.Create(const ADictionary: TMyType);
  1260. begin
  1261. FIter:=ADictionary.FMap.Entries;
  1262. end;
  1263. function TDictionary<TKey, TValue>.TPairEnumerator.MoveNext: Boolean;
  1264. begin
  1265. Result:=DoMoveNext;
  1266. end;
  1267. { TDictionary.TKeyEnumerator }
  1268. function TDictionary<TKey, TValue>.TKeyEnumerator.GetCurrent: TKey;
  1269. begin
  1270. Result:=DoGetCurrent;
  1271. end;
  1272. function TDictionary<TKey, TValue>.TKeyEnumerator.DoGetCurrent: TKey;
  1273. begin
  1274. Result:=TKey(FVal.Value);
  1275. end;
  1276. function TDictionary<TKey, TValue>.TKeyEnumerator.DoMoveNext: Boolean;
  1277. begin
  1278. FVal:=FIter.Next;
  1279. Result:=Not FVal.Done;
  1280. end;
  1281. constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create(const ADictionary: TMyType);
  1282. begin
  1283. Create(ADictionary.FMap.Keys);
  1284. end;
  1285. constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create(const AIter : TJSIterator);
  1286. begin
  1287. FIter:=aIter;
  1288. end;
  1289. function TDictionary<TKey, TValue>.TKeyEnumerator.MoveNext: Boolean;
  1290. begin
  1291. Result:=DoMoveNext;
  1292. end;
  1293. { TDictionary.TValueEnumerator }
  1294. function TDictionary<TKey, TValue>.TValueEnumerator.GetCurrent: TValue;
  1295. begin
  1296. Result:=DoGetCurrent;
  1297. end;
  1298. function TDictionary<TKey, TValue>.TValueEnumerator.DoGetCurrent: TValue;
  1299. begin
  1300. Result:=TValue(FVal.Value);
  1301. end;
  1302. function TDictionary<TKey, TValue>.TValueEnumerator.DoMoveNext: Boolean;
  1303. begin
  1304. FVal:=FIter.Next;
  1305. Result:=Not FVal.Done;
  1306. end;
  1307. constructor TDictionary<TKey, TValue>.TValueEnumerator.Create(const ADictionary: TMyType);
  1308. begin
  1309. Create(aDictionary.FMap.Values);
  1310. end;
  1311. constructor TDictionary<TKey, TValue>.TValueEnumerator.Create(const AIter: TJSIterator);
  1312. begin
  1313. FIter:=AIter;
  1314. end;
  1315. function TDictionary<TKey, TValue>.TValueEnumerator.MoveNext: Boolean;
  1316. begin
  1317. Result:=DoMoveNext;
  1318. end;
  1319. { TDictionary.TValueCollection }
  1320. function TDictionary<TKey, TValue>.TValueCollection.GetCount: Integer;
  1321. begin
  1322. Result:=FMap.Size;
  1323. end;
  1324. function TDictionary<TKey, TValue>.TValueCollection.DoGetEnumerator: TEnumerator<TValue>;
  1325. begin
  1326. Result:=TValueEnumerator.Create(FMap.Values);
  1327. end;
  1328. constructor TDictionary<TKey, TValue>.TValueCollection.Create(const ADictionary: TMyType);
  1329. begin
  1330. FMap:=ADictionary.FMap;
  1331. end;
  1332. function TDictionary<TKey, TValue>.TValueCollection.GetEnumerator: TValueEnumerator;
  1333. begin
  1334. Result:=TValueEnumerator(DoGetEnumerator);
  1335. end;
  1336. function TDictionary<TKey, TValue>.TValueCollection.ToArray: TArray<TValue>;
  1337. Var
  1338. I : Integer;
  1339. P : TValue;
  1340. begin
  1341. SetLength(Result,FMap.Size);
  1342. For P in Self do
  1343. begin
  1344. Result[i]:=P;
  1345. Inc(I);
  1346. End;
  1347. end;
  1348. { TDictionary.TKeyCollection }
  1349. function TDictionary<TKey, TValue>.TKeyCollection.GetCount: Integer;
  1350. begin
  1351. Result:=FMap.Size;
  1352. end;
  1353. function TDictionary<TKey, TValue>.TKeyCollection.DoGetEnumerator: TEnumerator<TKey>;
  1354. begin
  1355. Result:=GetEnumerator;
  1356. end;
  1357. constructor TDictionary<TKey, TValue>.TKeyCollection.Create(const ADictionary: TMyType);
  1358. begin
  1359. FMap:=aDictionary.FMap;
  1360. end;
  1361. function TDictionary<TKey, TValue>.TKeyCollection.GetEnumerator: TKeyEnumerator;
  1362. begin
  1363. Result:=TKeyEnumerator.Create(FMap.Keys);
  1364. end;
  1365. function TDictionary<TKey, TValue>.TKeyCollection.ToArray: TArray<TKey>;
  1366. begin
  1367. Result:=inherited ToArray;
  1368. end;
  1369. { TObjectList<T> }
  1370. procedure TObjectList<T>.Notify(const aValue: T; Action: TCollectionNotification);
  1371. Var
  1372. A : TObject absolute aValue; // needed to fool compiler
  1373. begin
  1374. inherited Notify(aValue, Action);
  1375. if FObjectsOwner and (action = cnRemoved) then
  1376. a.Free;
  1377. end;
  1378. constructor TObjectList<T>.Create(AOwnsObjects: Boolean);
  1379. begin
  1380. inherited Create;
  1381. FObjectsOwner := AOwnsObjects;
  1382. end;
  1383. constructor TObjectList<T>.Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean);
  1384. begin
  1385. inherited Create(AComparer);
  1386. FObjectsOwner := AOwnsObjects;
  1387. end;
  1388. constructor TObjectList<T>.Create(const ACollection: TEnumerable<T>; aOwnsObjects: Boolean);
  1389. begin
  1390. inherited Create(ACollection);
  1391. FObjectsOwner := AOwnsObjects;
  1392. end;
  1393. { TThreadList }
  1394. constructor TThreadList<T>.Create;
  1395. begin
  1396. inherited Create;
  1397. FLock:=0;
  1398. FList := TList<T>.Create;
  1399. FDuplicates := dupIgnore;
  1400. end;
  1401. destructor TThreadList<T>.Destroy;
  1402. begin
  1403. // No need to unlock.
  1404. FList.Free;
  1405. inherited Destroy;
  1406. end;
  1407. procedure TThreadList<T>.Add(const Item: T);
  1408. begin
  1409. LockList;
  1410. try
  1411. if (Duplicates = dupAccept) or (FList.IndexOf(Item) = -1) then
  1412. FList.Add(Item)
  1413. else if Duplicates = dupError then
  1414. raise EListError.Create(SDuplicateItem);
  1415. finally
  1416. UnlockList;
  1417. end;
  1418. end;
  1419. procedure TThreadList<T>.Clear;
  1420. begin
  1421. LockList;
  1422. try
  1423. FList.Clear;
  1424. finally
  1425. UnlockList;
  1426. end;
  1427. end;
  1428. function TThreadList<T>.LockList: TList<T>;
  1429. begin
  1430. Inc(FLock);
  1431. if (FLock>1) then
  1432. Writeln('Locking already locked list, lockcount : ',FLock);
  1433. Result:=FList;
  1434. end;
  1435. procedure TThreadList<T>.Remove(const Item: T);
  1436. begin
  1437. RemoveItem(T,TDirection.FromBeginning);
  1438. end;
  1439. procedure TThreadList<T>.RemoveItem(const Item: T; Direction: TDirection);
  1440. begin
  1441. LockList;
  1442. try
  1443. FList.RemoveItem(T,Direction);
  1444. finally
  1445. UnlockList;
  1446. end;
  1447. end;
  1448. procedure TThreadList<T>.UnlockList;
  1449. begin
  1450. Dec(FLock);
  1451. if (FLock<0) then
  1452. Writeln('Unlocking already unlocked list, lockcount : ',FLock);
  1453. end;
  1454. { TObjectDictionary }
  1455. function TObjectDictionary<TKey, TValue>.CanClearMap: Boolean;
  1456. begin
  1457. Result:=(Inherited CanClearMap) and (FOwnerships=[]);
  1458. end;
  1459. procedure TObjectDictionary<TKey, TValue>.KeyNotify(const Key: TKey; Action: TCollectionNotification);
  1460. Var
  1461. A : TObject absolute key; // Avoid typecast, refused by compiler
  1462. begin
  1463. inherited KeyNotify(Key, Action);
  1464. if (doOwnsKeys in FOwnerships) and (Action = cnRemoved) then
  1465. A.Free;
  1466. end;
  1467. procedure TObjectDictionary<TKey, TValue>.ValueNotify(const Value: TValue; Action: TCollectionNotification);
  1468. Var
  1469. A : TObject absolute Value; // Avoid typecast, refused by compiler
  1470. begin
  1471. inherited ValueNotify(Value, Action);
  1472. if (doOwnsValues in FOwnerships) and (Action = cnRemoved) then
  1473. A.Free;
  1474. end;
  1475. constructor TObjectDictionary<TKey, TValue>.Create(aOwnerships: TDictionaryOwnerships; ACapacity: Integer);
  1476. begin
  1477. Create(aOwnerShips);
  1478. end;
  1479. constructor TObjectDictionary<TKey, TValue>.Create(aOwnerships: TDictionaryOwnerships);
  1480. begin
  1481. Inherited Create;
  1482. FOwnerShips:=aOwnerships;
  1483. end;
  1484. { TQueue }
  1485. function TQueue<T>.DoGetEnumerator: TEnumerator<T>;
  1486. begin
  1487. Result:=GetEnumerator;
  1488. end;
  1489. function TQueue<T>.GetEnumerator: TEnumerator;
  1490. begin
  1491. Result := TEnumerator.Create(Self);
  1492. end;
  1493. procedure TQueue<T>.SetCapacity(AValue: SizeInt);
  1494. begin
  1495. if AValue < Count then
  1496. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1497. if FLow>0 then
  1498. Rebase;
  1499. SetLength(FItems,aValue);
  1500. end;
  1501. function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
  1502. begin
  1503. if (FLow>=FLength) then
  1504. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1505. Result := FItems[AIndex];
  1506. FItems[AIndex] := Default(T);
  1507. Inc(FLow);
  1508. if FLow >= FLength then
  1509. begin
  1510. FLow:=0;
  1511. FLength:=0;
  1512. end;
  1513. Notify(Result, ACollectionNotification);
  1514. end;
  1515. function TQueue<T>.GetCount: SizeInt;
  1516. begin
  1517. Result:=FLength-FLow;
  1518. end;
  1519. constructor TQueue<T>.Create;
  1520. begin
  1521. FMaxGapLength:=10;
  1522. end;
  1523. constructor TQueue<T>.Create(ACollection: TEnumerable<T>);
  1524. var
  1525. Itm: T;
  1526. begin
  1527. Create;
  1528. for Itm in ACollection do
  1529. Enqueue(Itm);
  1530. end;
  1531. destructor TQueue<T>.Destroy;
  1532. begin
  1533. Clear;
  1534. inherited Destroy;
  1535. end;
  1536. procedure TQueue<T>.Enqueue(const AValue: T);
  1537. begin
  1538. if Capacity<=FLength then
  1539. SetCapacity(FLength+10);
  1540. FItems[FLength]:=aValue;
  1541. Inc(FLength);
  1542. Notify(aValue,cnAdded);
  1543. end;
  1544. function TQueue<T>.Dequeue: T;
  1545. begin
  1546. Result := DoRemove(FLow, cnRemoved);
  1547. if FLow>FMaxGapLength then
  1548. Rebase;
  1549. end;
  1550. function TQueue<T>.Extract: T;
  1551. begin
  1552. Result := DoRemove(FLow, cnExtracted);
  1553. if FLow>FMaxGapLength then
  1554. Rebase;
  1555. end;
  1556. function TQueue<T>.Peek: T;
  1557. begin
  1558. if (Count=0) then
  1559. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1560. Result:=FItems[FLow];
  1561. end;
  1562. procedure TQueue<T>.Clear;
  1563. begin
  1564. while Count <> 0 do
  1565. Dequeue;
  1566. end;
  1567. procedure TQueue<T>.Rebase;
  1568. Var
  1569. I,Spare : integer;
  1570. begin
  1571. Spare:=Capacity-Count;
  1572. if FLow>0 then
  1573. begin
  1574. For I:=Flow to FLength do
  1575. FItems[I-FLow]:=FItems[I];
  1576. SetLength(FItems,FLength+Spare);
  1577. FLength:=FLength-Flow+1;
  1578. Flow:=0;
  1579. end;
  1580. end;
  1581. procedure TQueue<T>.TrimExcess;
  1582. begin
  1583. Rebase;
  1584. SetCapacity(Count);
  1585. end;
  1586. { TQueue.TEnumerator }
  1587. constructor TQueue<T>.TEnumerator.Create(AQueue: TMyType);
  1588. begin
  1589. aQueue.Rebase;
  1590. Inherited Create(aQueue);
  1591. end;
  1592. { TObjectQueue }
  1593. procedure TObjectQueue<T>.Notify(const Value: T; Action: TCollectionNotification);
  1594. Var
  1595. A : TObject absolute Value;
  1596. begin
  1597. inherited Notify(Value, Action);
  1598. if OwnsObjects and (Action = cnRemoved) then
  1599. A.Free;
  1600. end;
  1601. constructor TObjectQueue<T>.Create(AOwnsObjects: Boolean);
  1602. begin
  1603. Inherited create;
  1604. FOwnsObjects:=aOwnsObjects;
  1605. end;
  1606. constructor TObjectQueue<T>.Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
  1607. Var
  1608. A : T;
  1609. begin
  1610. Create(aOwnsObjects);
  1611. For A in Collection do
  1612. EnQueue(A);
  1613. end;
  1614. procedure TObjectQueue<T>.Dequeue;
  1615. begin
  1616. Inherited DeQueue;
  1617. end;
  1618. { TStack }
  1619. function TStack<T>.DoRemove(aIndex : SizeInt; ACollectionNotification: TCollectionNotification): T;
  1620. begin
  1621. if (FLength=0) or (aIndex<>FLength-1) then
  1622. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1623. Result:=FItems[AIndex];
  1624. FItems[AIndex] := Default(T);
  1625. Dec(FLength);
  1626. Notify(Result, ACollectionNotification);
  1627. end;
  1628. procedure TStack<T>.SetCapacity(aValue: SizeInt);
  1629. begin
  1630. if AValue < Count then
  1631. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1632. SetLength(FItems,aValue);
  1633. end;
  1634. function TStack<T>.DoGetEnumerator: TEnumerator<T>;
  1635. begin
  1636. Result:=GetEnumerator;
  1637. end;
  1638. function TStack<T>.GetEnumerator: TEnumerator;
  1639. begin
  1640. Result:=TEnumerator.Create(Self);
  1641. end;
  1642. destructor TStack<T>.Destroy;
  1643. begin
  1644. Clear;
  1645. inherited Destroy;
  1646. end;
  1647. procedure TStack<T>.Clear;
  1648. begin
  1649. While Count>0 do Pop;
  1650. end;
  1651. procedure TStack<T>.Push(const aValue: T);
  1652. begin
  1653. if Capacity<=FLength then
  1654. SetCapacity(FLength+10);
  1655. FItems[FLength]:=aValue;
  1656. Inc(FLength);
  1657. Notify(aValue,cnAdded);
  1658. end;
  1659. function TStack<T>.Pop: T;
  1660. begin
  1661. Result:=DoRemove(FLength-1,cnRemoved);
  1662. end;
  1663. function TStack<T>.Peek: T;
  1664. begin
  1665. if Count<1 then
  1666. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1667. Result:=FItems[FLength-1];
  1668. end;
  1669. function TStack<T>.Extract: T;
  1670. begin
  1671. Result:=DoRemove(FLength-1,cnExtracted);
  1672. end;
  1673. procedure TStack<T>.TrimExcess;
  1674. begin
  1675. SetCapacity(FLength);
  1676. end;
  1677. { TCustomInvertedListEnumerator }
  1678. function TCustomInvertedListEnumerator<T>.DoMoveNext: boolean;
  1679. begin
  1680. Result:=FIndex>0;
  1681. If Result then
  1682. Dec(FIndex);
  1683. end;
  1684. function TCustomInvertedListEnumerator<T>.DoGetCurrent: T;
  1685. begin
  1686. Result:=FList.FItems[FIndex];
  1687. end;
  1688. function TCustomInvertedListEnumerator<T>.GetCurrent: T;
  1689. begin
  1690. Result:=DoGetCurrent;
  1691. end;
  1692. constructor TCustomInvertedListEnumerator<T>.Create(AList: TCustomList<T>);
  1693. begin
  1694. inherited Create;
  1695. FList:=AList;
  1696. FIndex:=AList.FLength;
  1697. end;
  1698. { TStack.TEnumerator }
  1699. constructor TStack<T>.TEnumerator.Create(AStack: TMyType);
  1700. begin
  1701. Inherited Create(aStack);
  1702. end;
  1703. { TObjectStack }
  1704. procedure TObjectStack<T>.Notify(const aValue: T; Action: TCollectionNotification);
  1705. Var
  1706. A : T absolute aValue;
  1707. begin
  1708. inherited Notify(aValue, Action);
  1709. if (Action=cnRemoved) and FOwnsObjects then
  1710. a.Free;
  1711. end;
  1712. constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
  1713. begin
  1714. Inherited Create;
  1715. FOwnsObjects:=aOwnsObjects;
  1716. end;
  1717. constructor TObjectStack<T>.Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
  1718. Var
  1719. A : T;
  1720. begin
  1721. Create(aOwnsObjects);
  1722. For A in Collection do
  1723. Push(A);
  1724. end;
  1725. procedure TObjectStack<T>.Pop;
  1726. begin
  1727. Inherited Pop;
  1728. end;
  1729. end.