generics.collections.pas 50 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083
  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. if ACapacity>0 then ; // ToDo
  1110. end;
  1111. constructor TDictionary<TKey, TValue>.Create(const Collection: TEnumerable<TMyPair>);
  1112. Var
  1113. aPair : TMyPair;
  1114. begin
  1115. Create(0);
  1116. For aPair in Collection do
  1117. Add(aPair.Key,aPair.Value);
  1118. end;
  1119. constructor TDictionary<TKey, TValue>.Create(const AComparer: IComparer<TKey>);
  1120. begin
  1121. Create(0);
  1122. FComparer:=aComparer;
  1123. end;
  1124. destructor TDictionary<TKey, TValue>.Destroy;
  1125. begin
  1126. FreeAndNil(FKeyCollection);
  1127. FreeAndNil(FValueCollection);
  1128. Clear;
  1129. FMap:=Nil;
  1130. inherited Destroy;
  1131. end;
  1132. procedure TDictionary<TKey, TValue>.Add(const Key: TKey; const Value: TValue);
  1133. begin
  1134. if FMap.Has(GetEffectiveKey(Key)) then
  1135. Raise EDictionary.Create(SErrDictDuplicateKey);
  1136. DoAdd(Key,Value);
  1137. end;
  1138. procedure TDictionary<TKey, TValue>.Remove(const Key: TKey);
  1139. begin
  1140. doRemove(Key,cnRemoved);
  1141. end;
  1142. function TDictionary<TKey, TValue>.ExtractPair(const Key: TKey): TMyPair;
  1143. Var
  1144. K : TKey;
  1145. begin
  1146. Result:=Default(TMyPair);
  1147. K:=GetEffectiveKey(Key);
  1148. if FMap.Has(K) then
  1149. begin
  1150. Result.Create(Key,TValue(FMap.get(K)));
  1151. FMap.Delete(k);
  1152. end
  1153. else
  1154. Result.Create(Key,Default(TValue));
  1155. end;
  1156. function TDictionary<TKey, TValue>.CanClearMap: Boolean;
  1157. begin
  1158. Result:=(FOnKeyNotify=Nil) and (FOnValueNotify=Nil);
  1159. end;
  1160. procedure TDictionary<TKey, TValue>.Clear;
  1161. Var
  1162. Iter : TJSIterator;
  1163. IVal : TJSIteratorValue;
  1164. A : TJSValueDynArray;
  1165. K : TKey;
  1166. V : TValue;
  1167. begin
  1168. if CanClearMap then
  1169. Fmap.Clear
  1170. else
  1171. begin
  1172. Iter:=FMap.Entries;
  1173. Repeat
  1174. IVal:=Iter.next;
  1175. if not ival.Done then
  1176. begin
  1177. A:=TJSValueDynArray(IVal.Value);
  1178. K:=TKey(A[0]);
  1179. V:=TValue(A[1]);
  1180. FMap.delete(k);
  1181. PairNotify(K,V,cnRemoved);
  1182. end;
  1183. Until Ival.Done;
  1184. end;
  1185. end;
  1186. function TDictionary<TKey, TValue>.TryGetValue(const Key: TKey; out Value: TValue): Boolean;
  1187. Var
  1188. K : TKey;
  1189. begin
  1190. K:=GetEffectiveKey(Key);
  1191. Result:=FMap.Has(K);
  1192. If Result then
  1193. Value:=TValue(FMap.get(K));
  1194. end;
  1195. procedure TDictionary<TKey, TValue>.AddOrSetValue(const Key: TKey; const Value: TValue);
  1196. Var
  1197. k : TKey;
  1198. begin
  1199. K:=GetEffectiveKey(Key);
  1200. if Not FMap.Has(k) then
  1201. DoAdd(Key,Value)
  1202. else
  1203. SetItem(K,Value);
  1204. end;
  1205. function TDictionary<TKey, TValue>.ContainsKey(const Key: TKey): Boolean;
  1206. begin
  1207. Result:=FMap.Has(GetEffectiveKey(Key));
  1208. end;
  1209. function TDictionary<TKey, TValue>.ContainsValue(const Value: TValue): Boolean;
  1210. Var
  1211. It : TJSIterator;
  1212. Res : TJSIteratorValue;
  1213. begin
  1214. Result:=False;
  1215. It:=FMap.Values;
  1216. Repeat
  1217. Res:=It.next;
  1218. if not Res.done then
  1219. Result:=(Value=TValue(Res.value));
  1220. Until (Result or Res.done);
  1221. end;
  1222. function TDictionary<TKey, TValue>.ToArray: TArray<TMyPair>;
  1223. begin
  1224. Result:=inherited ToArray;
  1225. end;
  1226. function TDictionary<TKey, TValue>.GetKeys: TKeyCollection;
  1227. begin
  1228. if FKeyCollection=Nil then
  1229. FKeyCollection:=TKeyCollection.Create(Self);
  1230. Result:=FKeyCollection;
  1231. end;
  1232. function TDictionary<TKey, TValue>.GetValues: TValueCollection;
  1233. begin
  1234. if FValueCollection=Nil then
  1235. FValueCollection:=TValueCollection.Create(Self);
  1236. Result:=FValueCollection;
  1237. end;
  1238. function TDictionary<TKey, TValue>.GetEnumerator: TPairEnumerator;
  1239. begin
  1240. Result:=TPairEnumerator.Create(Self);
  1241. end;
  1242. { TDictionary.TPairEnumerator }
  1243. function TDictionary<TKey, TValue>.TPairEnumerator.GetCurrent: TMyPair;
  1244. begin
  1245. Result:=DoGetCurrent();
  1246. end;
  1247. function TDictionary<TKey, TValue>.TPairEnumerator.DoGetCurrent: TMyPair;
  1248. Var
  1249. A : TJSValueDynArray;
  1250. begin
  1251. A:=TJSValueDynArray(FVal.Value);
  1252. Result:=Default(TMyPair);
  1253. Result.Create(TKey(A[0]),TValue(A[1]));
  1254. end;
  1255. function TDictionary<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
  1256. begin
  1257. FVal:=FIter.Next;
  1258. Result:=Not FVal.Done;
  1259. end;
  1260. constructor TDictionary<TKey, TValue>.TPairEnumerator.Create(const ADictionary: TMyType);
  1261. begin
  1262. FIter:=ADictionary.FMap.Entries;
  1263. end;
  1264. function TDictionary<TKey, TValue>.TPairEnumerator.MoveNext: Boolean;
  1265. begin
  1266. Result:=DoMoveNext;
  1267. end;
  1268. { TDictionary.TKeyEnumerator }
  1269. function TDictionary<TKey, TValue>.TKeyEnumerator.GetCurrent: TKey;
  1270. begin
  1271. Result:=DoGetCurrent();
  1272. end;
  1273. function TDictionary<TKey, TValue>.TKeyEnumerator.DoGetCurrent: TKey;
  1274. begin
  1275. Result:=TKey(FVal.Value);
  1276. end;
  1277. function TDictionary<TKey, TValue>.TKeyEnumerator.DoMoveNext: Boolean;
  1278. begin
  1279. FVal:=FIter.Next;
  1280. Result:=Not FVal.Done;
  1281. end;
  1282. constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create(const ADictionary: TMyType);
  1283. begin
  1284. Create(ADictionary.FMap.Keys);
  1285. end;
  1286. constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create(const AIter : TJSIterator);
  1287. begin
  1288. FIter:=aIter;
  1289. end;
  1290. function TDictionary<TKey, TValue>.TKeyEnumerator.MoveNext: Boolean;
  1291. begin
  1292. Result:=DoMoveNext;
  1293. end;
  1294. { TDictionary.TValueEnumerator }
  1295. function TDictionary<TKey, TValue>.TValueEnumerator.GetCurrent: TValue;
  1296. begin
  1297. Result:=DoGetCurrent();
  1298. end;
  1299. function TDictionary<TKey, TValue>.TValueEnumerator.DoGetCurrent: TValue;
  1300. begin
  1301. Result:=TValue(FVal.Value);
  1302. end;
  1303. function TDictionary<TKey, TValue>.TValueEnumerator.DoMoveNext: Boolean;
  1304. begin
  1305. FVal:=FIter.Next;
  1306. Result:=Not FVal.Done;
  1307. end;
  1308. constructor TDictionary<TKey, TValue>.TValueEnumerator.Create(const ADictionary: TMyType);
  1309. begin
  1310. Create(aDictionary.FMap.Values);
  1311. end;
  1312. constructor TDictionary<TKey, TValue>.TValueEnumerator.Create(const AIter: TJSIterator);
  1313. begin
  1314. FIter:=AIter;
  1315. end;
  1316. function TDictionary<TKey, TValue>.TValueEnumerator.MoveNext: Boolean;
  1317. begin
  1318. Result:=DoMoveNext;
  1319. end;
  1320. { TDictionary.TValueCollection }
  1321. function TDictionary<TKey, TValue>.TValueCollection.GetCount: Integer;
  1322. begin
  1323. Result:=FMap.Size;
  1324. end;
  1325. function TDictionary<TKey, TValue>.TValueCollection.DoGetEnumerator: TEnumerator<TValue>;
  1326. begin
  1327. Result:=TValueEnumerator.Create(FMap.Values);
  1328. end;
  1329. constructor TDictionary<TKey, TValue>.TValueCollection.Create(const ADictionary: TMyType);
  1330. begin
  1331. FMap:=ADictionary.FMap;
  1332. end;
  1333. function TDictionary<TKey, TValue>.TValueCollection.GetEnumerator: TValueEnumerator;
  1334. begin
  1335. Result:=TValueEnumerator(DoGetEnumerator);
  1336. end;
  1337. function TDictionary<TKey, TValue>.TValueCollection.ToArray: TArray<TValue>;
  1338. Var
  1339. I : Integer;
  1340. P : TValue;
  1341. begin
  1342. SetLength(Result,FMap.Size);
  1343. For P in Self do
  1344. begin
  1345. Result[i]:=P;
  1346. Inc(I);
  1347. End;
  1348. end;
  1349. { TDictionary.TKeyCollection }
  1350. function TDictionary<TKey, TValue>.TKeyCollection.GetCount: Integer;
  1351. begin
  1352. Result:=FMap.Size;
  1353. end;
  1354. function TDictionary<TKey, TValue>.TKeyCollection.DoGetEnumerator: TEnumerator<TKey>;
  1355. begin
  1356. Result:=GetEnumerator;
  1357. end;
  1358. constructor TDictionary<TKey, TValue>.TKeyCollection.Create(const ADictionary: TMyType);
  1359. begin
  1360. FMap:=aDictionary.FMap;
  1361. end;
  1362. function TDictionary<TKey, TValue>.TKeyCollection.GetEnumerator: TKeyEnumerator;
  1363. begin
  1364. Result:=TKeyEnumerator.Create(FMap.Keys);
  1365. end;
  1366. function TDictionary<TKey, TValue>.TKeyCollection.ToArray: TArray<TKey>;
  1367. begin
  1368. Result:=inherited ToArray;
  1369. end;
  1370. { TObjectList<T> }
  1371. procedure TObjectList<T>.Notify(const aValue: T; Action: TCollectionNotification);
  1372. Var
  1373. A : TObject absolute aValue; // needed to fool compiler
  1374. begin
  1375. inherited Notify(aValue, Action);
  1376. if FObjectsOwner and (action = cnRemoved) then
  1377. a.Free;
  1378. end;
  1379. constructor TObjectList<T>.Create(AOwnsObjects: Boolean);
  1380. begin
  1381. inherited Create;
  1382. FObjectsOwner := AOwnsObjects;
  1383. end;
  1384. constructor TObjectList<T>.Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean);
  1385. begin
  1386. inherited Create(AComparer);
  1387. FObjectsOwner := AOwnsObjects;
  1388. end;
  1389. constructor TObjectList<T>.Create(const ACollection: TEnumerable<T>; aOwnsObjects: Boolean);
  1390. begin
  1391. inherited Create(ACollection);
  1392. FObjectsOwner := AOwnsObjects;
  1393. end;
  1394. { TThreadList }
  1395. constructor TThreadList<T>.Create;
  1396. begin
  1397. inherited Create;
  1398. FLock:=0;
  1399. FList := TList<T>.Create;
  1400. FDuplicates := dupIgnore;
  1401. end;
  1402. destructor TThreadList<T>.Destroy;
  1403. begin
  1404. // No need to unlock.
  1405. FList.Free;
  1406. inherited Destroy;
  1407. end;
  1408. procedure TThreadList<T>.Add(const Item: T);
  1409. begin
  1410. LockList;
  1411. try
  1412. if (Duplicates = dupAccept) or (FList.IndexOf(Item) = -1) then
  1413. FList.Add(Item)
  1414. else if Duplicates = dupError then
  1415. raise EListError.Create(SDuplicateItem);
  1416. finally
  1417. UnlockList;
  1418. end;
  1419. end;
  1420. procedure TThreadList<T>.Clear;
  1421. begin
  1422. LockList;
  1423. try
  1424. FList.Clear;
  1425. finally
  1426. UnlockList;
  1427. end;
  1428. end;
  1429. function TThreadList<T>.LockList: TList<T>;
  1430. begin
  1431. Inc(FLock);
  1432. if (FLock>1) then
  1433. Writeln('Locking already locked list, lockcount : ',FLock);
  1434. Result:=FList;
  1435. end;
  1436. procedure TThreadList<T>.Remove(const Item: T);
  1437. begin
  1438. RemoveItem(Item,TDirection.FromBeginning);
  1439. end;
  1440. procedure TThreadList<T>.RemoveItem(const Item: T; Direction: TDirection);
  1441. begin
  1442. LockList;
  1443. try
  1444. FList.RemoveItem(Item,Direction);
  1445. finally
  1446. UnlockList;
  1447. end;
  1448. end;
  1449. procedure TThreadList<T>.UnlockList;
  1450. begin
  1451. Dec(FLock);
  1452. if (FLock<0) then
  1453. Writeln('Unlocking already unlocked list, lockcount : ',FLock);
  1454. end;
  1455. { TObjectDictionary }
  1456. function TObjectDictionary<TKey, TValue>.CanClearMap: Boolean;
  1457. begin
  1458. Result:=(Inherited CanClearMap) and (FOwnerships=[]);
  1459. end;
  1460. procedure TObjectDictionary<TKey, TValue>.KeyNotify(const Key: TKey; Action: TCollectionNotification);
  1461. Var
  1462. A : TObject absolute key; // Avoid typecast, refused by compiler
  1463. begin
  1464. inherited KeyNotify(Key, Action);
  1465. if (doOwnsKeys in FOwnerships) and (Action = cnRemoved) then
  1466. A.Free;
  1467. end;
  1468. procedure TObjectDictionary<TKey, TValue>.ValueNotify(const Value: TValue; Action: TCollectionNotification);
  1469. Var
  1470. A : TObject absolute Value; // Avoid typecast, refused by compiler
  1471. begin
  1472. inherited ValueNotify(Value, Action);
  1473. if (doOwnsValues in FOwnerships) and (Action = cnRemoved) then
  1474. A.Free;
  1475. end;
  1476. constructor TObjectDictionary<TKey, TValue>.Create(aOwnerships: TDictionaryOwnerships; ACapacity: Integer);
  1477. begin
  1478. FOwnerShips:=aOwnerships;
  1479. inherited Create(ACapacity);
  1480. end;
  1481. constructor TObjectDictionary<TKey, TValue>.Create(aOwnerships: TDictionaryOwnerships);
  1482. begin
  1483. Inherited Create;
  1484. FOwnerShips:=aOwnerships;
  1485. end;
  1486. { TQueue }
  1487. function TQueue<T>.DoGetEnumerator: TEnumerator<T>;
  1488. begin
  1489. Result:=GetEnumerator;
  1490. end;
  1491. function TQueue<T>.GetEnumerator: TEnumerator;
  1492. begin
  1493. Result := TEnumerator.Create(Self);
  1494. end;
  1495. procedure TQueue<T>.SetCapacity(AValue: SizeInt);
  1496. begin
  1497. if AValue < Count then
  1498. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1499. if FLow>0 then
  1500. Rebase;
  1501. SetLength(FItems,aValue);
  1502. end;
  1503. function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
  1504. begin
  1505. if (FLow>=FLength) then
  1506. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1507. Result := FItems[AIndex];
  1508. FItems[AIndex] := Default(T);
  1509. Inc(FLow);
  1510. if FLow >= FLength then
  1511. begin
  1512. FLow:=0;
  1513. FLength:=0;
  1514. end;
  1515. Notify(Result, ACollectionNotification);
  1516. end;
  1517. function TQueue<T>.GetCount: SizeInt;
  1518. begin
  1519. Result:=FLength-FLow;
  1520. end;
  1521. constructor TQueue<T>.Create;
  1522. begin
  1523. FMaxGapLength:=10;
  1524. end;
  1525. constructor TQueue<T>.Create(ACollection: TEnumerable<T>);
  1526. var
  1527. Itm: T;
  1528. begin
  1529. Create;
  1530. for Itm in ACollection do
  1531. Enqueue(Itm);
  1532. end;
  1533. destructor TQueue<T>.Destroy;
  1534. begin
  1535. Clear;
  1536. inherited Destroy;
  1537. end;
  1538. procedure TQueue<T>.Enqueue(const AValue: T);
  1539. begin
  1540. if Capacity<=FLength then
  1541. SetCapacity(FLength+10);
  1542. FItems[FLength]:=aValue;
  1543. Inc(FLength);
  1544. Notify(aValue,cnAdded);
  1545. end;
  1546. function TQueue<T>.Dequeue: T;
  1547. begin
  1548. Result := DoRemove(FLow, cnRemoved);
  1549. if FLow>FMaxGapLength then
  1550. Rebase;
  1551. end;
  1552. function TQueue<T>.Extract: T;
  1553. begin
  1554. Result := DoRemove(FLow, cnExtracted);
  1555. if FLow>FMaxGapLength then
  1556. Rebase;
  1557. end;
  1558. function TQueue<T>.Peek: T;
  1559. begin
  1560. if (Count=0) then
  1561. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1562. Result:=FItems[FLow];
  1563. end;
  1564. procedure TQueue<T>.Clear;
  1565. begin
  1566. while Count <> 0 do
  1567. Dequeue;
  1568. end;
  1569. procedure TQueue<T>.Rebase;
  1570. Var
  1571. I,Spare : integer;
  1572. begin
  1573. Spare:=Capacity-Count;
  1574. if FLow>0 then
  1575. begin
  1576. For I:=Flow to FLength do
  1577. FItems[I-FLow]:=FItems[I];
  1578. SetLength(FItems,FLength+Spare);
  1579. FLength:=FLength-Flow+1;
  1580. Flow:=0;
  1581. end;
  1582. end;
  1583. procedure TQueue<T>.TrimExcess;
  1584. begin
  1585. Rebase;
  1586. SetCapacity(Count);
  1587. end;
  1588. { TQueue.TEnumerator }
  1589. constructor TQueue<T>.TEnumerator.Create(AQueue: TMyType);
  1590. begin
  1591. aQueue.Rebase;
  1592. Inherited Create(aQueue);
  1593. end;
  1594. { TObjectQueue }
  1595. procedure TObjectQueue<T>.Notify(const Value: T; Action: TCollectionNotification);
  1596. Var
  1597. A : TObject absolute Value;
  1598. begin
  1599. inherited Notify(Value, Action);
  1600. if OwnsObjects and (Action = cnRemoved) then
  1601. A.Free;
  1602. end;
  1603. constructor TObjectQueue<T>.Create(AOwnsObjects: Boolean);
  1604. begin
  1605. Inherited create;
  1606. FOwnsObjects:=aOwnsObjects;
  1607. end;
  1608. constructor TObjectQueue<T>.Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
  1609. Var
  1610. A : T;
  1611. begin
  1612. Create(aOwnsObjects);
  1613. For A in Collection do
  1614. EnQueue(A);
  1615. end;
  1616. procedure TObjectQueue<T>.Dequeue;
  1617. begin
  1618. Inherited DeQueue;
  1619. end;
  1620. { TStack }
  1621. function TStack<T>.DoRemove(aIndex : SizeInt; ACollectionNotification: TCollectionNotification): T;
  1622. begin
  1623. if (FLength=0) or (aIndex<>FLength-1) then
  1624. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1625. Result:=FItems[AIndex];
  1626. FItems[AIndex] := Default(T);
  1627. Dec(FLength);
  1628. Notify(Result, ACollectionNotification);
  1629. end;
  1630. procedure TStack<T>.SetCapacity(aValue: SizeInt);
  1631. begin
  1632. if AValue < Count then
  1633. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1634. SetLength(FItems,aValue);
  1635. end;
  1636. function TStack<T>.DoGetEnumerator: TEnumerator<T>;
  1637. begin
  1638. Result:=GetEnumerator;
  1639. end;
  1640. function TStack<T>.GetEnumerator: TEnumerator;
  1641. begin
  1642. Result:=TEnumerator.Create(Self);
  1643. end;
  1644. destructor TStack<T>.Destroy;
  1645. begin
  1646. Clear;
  1647. inherited Destroy;
  1648. end;
  1649. procedure TStack<T>.Clear;
  1650. begin
  1651. While Count>0 do Pop;
  1652. end;
  1653. procedure TStack<T>.Push(const aValue: T);
  1654. begin
  1655. if Capacity<=FLength then
  1656. SetCapacity(FLength+10);
  1657. FItems[FLength]:=aValue;
  1658. Inc(FLength);
  1659. Notify(aValue,cnAdded);
  1660. end;
  1661. function TStack<T>.Pop: T;
  1662. begin
  1663. Result:=DoRemove(FLength-1,cnRemoved);
  1664. end;
  1665. function TStack<T>.Peek: T;
  1666. begin
  1667. if Count<1 then
  1668. raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
  1669. Result:=FItems[FLength-1];
  1670. end;
  1671. function TStack<T>.Extract: T;
  1672. begin
  1673. Result:=DoRemove(FLength-1,cnExtracted);
  1674. end;
  1675. procedure TStack<T>.TrimExcess;
  1676. begin
  1677. SetCapacity(FLength);
  1678. end;
  1679. { TCustomInvertedListEnumerator }
  1680. function TCustomInvertedListEnumerator<T>.DoMoveNext: boolean;
  1681. begin
  1682. Result:=FIndex>0;
  1683. If Result then
  1684. Dec(FIndex);
  1685. end;
  1686. function TCustomInvertedListEnumerator<T>.DoGetCurrent: T;
  1687. begin
  1688. Result:=FList.FItems[FIndex];
  1689. end;
  1690. function TCustomInvertedListEnumerator<T>.GetCurrent: T;
  1691. begin
  1692. Result:=DoGetCurrent();
  1693. end;
  1694. constructor TCustomInvertedListEnumerator<T>.Create(AList: TCustomList<T>);
  1695. begin
  1696. inherited Create;
  1697. FList:=AList;
  1698. FIndex:=AList.FLength;
  1699. end;
  1700. { TStack.TEnumerator }
  1701. constructor TStack<T>.TEnumerator.Create(AStack: TMyType);
  1702. begin
  1703. Inherited Create(aStack);
  1704. end;
  1705. { TObjectStack }
  1706. procedure TObjectStack<T>.Notify(const aValue: T; Action: TCollectionNotification);
  1707. Var
  1708. A : T absolute aValue;
  1709. begin
  1710. inherited Notify(aValue, Action);
  1711. if (Action=cnRemoved) and FOwnsObjects then
  1712. a.Free;
  1713. end;
  1714. constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
  1715. begin
  1716. Inherited Create;
  1717. FOwnsObjects:=aOwnsObjects;
  1718. end;
  1719. constructor TObjectStack<T>.Create(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
  1720. Var
  1721. A : T;
  1722. begin
  1723. Create(aOwnsObjects);
  1724. For A in Collection do
  1725. Push(A);
  1726. end;
  1727. procedure TObjectStack<T>.Pop;
  1728. begin
  1729. Inherited Pop;
  1730. end;
  1731. end.