generics.collections.pas 95 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2014 by Maciej Izak (hnb)
  4. member of the Free Sparta development team (http://freesparta.com)
  5. Copyright(c) 2004-2014 DaThoX
  6. It contains the Free Pascal generics library
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. Acknowledgment
  13. Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
  14. many new types and major refactoring of entire library
  15. Thanks to mORMot (http://synopse.info) project for the best implementations
  16. of hashing functions like crc32c and xxHash32 :)
  17. **********************************************************************}
  18. unit Generics.Collections;
  19. {$MODE DELPHI}{$H+}
  20. {$MACRO ON}
  21. {$COPERATORS ON}
  22. {$DEFINE CUSTOM_DICTIONARY_CONSTRAINTS := TKey, TValue, THashFactory}
  23. {$DEFINE OPEN_ADDRESSING_CONSTRAINTS := TKey, TValue, THashFactory, TProbeSequence}
  24. {$DEFINE CUCKOO_CONSTRAINTS := TKey, TValue, THashFactory, TCuckooCfg}
  25. {$DEFINE TREE_CONSTRAINTS := TKey, TValue, TInfo}
  26. {$WARNINGS OFF}
  27. {$HINTS OFF}
  28. {$OVERFLOWCHECKS OFF}
  29. {$RANGECHECKS OFF}
  30. interface
  31. uses
  32. RtlConsts, Classes, SysUtils, Generics.MemoryExpanders, Generics.Defaults,
  33. Generics.Helpers, Generics.Strings;
  34. { FPC BUGS related to Generics.* (54 bugs, 19 fixed)
  35. REGRESSION: 26483, 26481
  36. FIXED REGRESSION: 26480, 26482
  37. CRITICAL: 24848(!!!), 24872(!), 25607(!), 26030, 25917, 25918, 25620, 24283, 24254, 24287 (Related to? 24872)
  38. IMPORTANT: 23862(!), 24097, 24285, 24286 (Similar to? 24285), 24098, 24609 (RTL inconsistency), 24534,
  39. 25606, 25614, 26177, 26195
  40. OTHER: 26484, 24073, 24463, 25593, 25596, 25597, 25602, 26181 (or MYBAD?)
  41. CLOSED BUT IMO STILL TO FIX: 25601(!), 25594
  42. FIXED: 25610(!), 24064, 24071, 24282, 24458, 24867, 24871, 25604, 25600, 25605, 25598, 25603, 25929, 26176, 26180,
  43. 26193, 24072
  44. MYBAD: 24963, 25599
  45. }
  46. { LAZARUS BUGS related to Generics.* (7 bugs, 0 fixed)
  47. CRITICAL: 25613
  48. OTHER: 25595, 25612, 25615, 25617, 25618, 25619
  49. }
  50. {.$define EXTRA_WARNINGS}
  51. type
  52. EAVLTree = class(Exception);
  53. EIndexedAVLTree = class(EAVLTree);
  54. TDuplicates = Classes.TDuplicates;
  55. {$ifdef VER3_0_0}
  56. TArray<T> = array of T;
  57. {$endif}
  58. // bug #24254 workaround
  59. // should be TArray = record class procedure Sort<T>(...) etc.
  60. TBinarySearchResult = record
  61. FoundIndex, CandidateIndex: SizeInt;
  62. CompareResult: SizeInt;
  63. end;
  64. TCustomArrayHelper<T> = class abstract
  65. private
  66. type
  67. // bug #24282
  68. TComparerBugHack = TComparer<T>;
  69. protected
  70. // modified QuickSort from classes\lists.inc
  71. class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>);
  72. virtual; abstract;
  73. public
  74. class procedure Sort(var AValues: array of T); overload;
  75. class procedure Sort(var AValues: array of T;
  76. const AComparer: IComparer<T>); overload;
  77. class procedure Sort(var AValues: array of T;
  78. const AComparer: IComparer<T>; AIndex, ACount: SizeInt); overload;
  79. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  80. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
  81. AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
  82. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  83. out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  84. AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
  85. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  86. out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
  87. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  88. out AFoundIndex: SizeInt): Boolean; overload;
  89. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  90. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>): Boolean; overload;
  91. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  92. out ASearchResult: TBinarySearchResult): Boolean; overload;
  93. end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TCustomArray (bug #24254)
  94. TArrayHelper<T> = class(TCustomArrayHelper<T>)
  95. protected
  96. // modified QuickSort from classes\lists.inc
  97. class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>); override;
  98. public
  99. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  100. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
  101. AIndex, ACount: SizeInt): Boolean; override; overload;
  102. class function BinarySearch(constref AValues: array of T; constref AItem: T;
  103. out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  104. AIndex, ACount: SizeInt): Boolean; override; overload;
  105. end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TArray (bug #24254)
  106. TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
  107. TCollectionNotifyEvent<T> = procedure(ASender: TObject; constref AItem: T; AAction: TCollectionNotification)
  108. of object;
  109. { TEnumerator }
  110. TEnumerator<T> = class abstract
  111. protected
  112. function DoGetCurrent: T; virtual; abstract;
  113. function DoMoveNext: boolean; virtual; abstract;
  114. public
  115. property Current: T read DoGetCurrent;
  116. function MoveNext: boolean;
  117. end;
  118. { TEnumerable }
  119. TEnumerable<T> = class abstract
  120. public type
  121. PT = ^T;
  122. protected // no forward generics declarations (needed by TPointersCollection<T, PT>), this should be moved into TEnumerableWithPointers
  123. function GetPtrEnumerator: TEnumerator<PT>; virtual; abstract;
  124. protected
  125. function ToArrayImpl(ACount: SizeInt): TArray<T>; overload; // used by descendants
  126. protected
  127. function DoGetEnumerator: TEnumerator<T>; virtual; abstract;
  128. public
  129. function GetEnumerator: TEnumerator<T>; inline;
  130. function ToArray: TArray<T>; virtual; overload;
  131. end;
  132. // error: no memory left for TCustomPointersEnumerator<PT> version
  133. TCustomPointersEnumerator<T, PT> = class abstract(TEnumerator<PT>);
  134. TCustomPointersCollection<T, PT> = object
  135. strict private type
  136. TLocalEnumerable = TEnumerable<T>; // compiler has bug for directly usage of TEnumerable<T>
  137. protected
  138. function Enumerable: TLocalEnumerable; inline;
  139. public
  140. function GetEnumerator: TEnumerator<PT>;
  141. end;
  142. TEnumerableWithPointers<T> = class(TEnumerable<T>)
  143. strict private type
  144. TPointersCollection = TCustomPointersCollection<T, PT>;
  145. PPointersCollection = ^TPointersCollection;
  146. private
  147. function GetPtr: PPointersCollection; inline;
  148. public
  149. property Ptr: PPointersCollection read GetPtr;
  150. end;
  151. // More info: http://stackoverflow.com/questions/5232198/about-vectors-growth
  152. // TODO: custom memory managers (as constraints)
  153. {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result + Result div 2} // ~approximation to golden ratio: n = n * 1.5 }
  154. // {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result * 2} // standard inc
  155. TCustomList<T> = class abstract(TEnumerableWithPointers<T>)
  156. public type
  157. PT = ^T;
  158. protected
  159. type // bug #24282
  160. TArrayHelperBugHack = TArrayHelper<T>;
  161. private
  162. FOnNotify: TCollectionNotifyEvent<T>;
  163. function GetCapacity: SizeInt; inline;
  164. protected
  165. FLength: SizeInt;
  166. FItems: array of T;
  167. function PrepareAddingItem: SizeInt; virtual;
  168. function PrepareAddingRange(ACount: SizeInt): SizeInt; virtual;
  169. procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); virtual;
  170. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; virtual;
  171. procedure SetCapacity(AValue: SizeInt); virtual; abstract;
  172. function GetCount: SizeInt; virtual;
  173. public
  174. function ToArray: TArray<T>; override; final;
  175. property Count: SizeInt read GetCount;
  176. property Capacity: SizeInt read GetCapacity write SetCapacity;
  177. property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
  178. end;
  179. TCustomListEnumerator<T> = class abstract(TEnumerator<T>)
  180. private
  181. FList: TCustomList<T>;
  182. FIndex: SizeInt;
  183. protected
  184. function DoMoveNext: boolean; override;
  185. function DoGetCurrent: T; override;
  186. function GetCurrent: T; virtual;
  187. public
  188. constructor Create(AList: TCustomList<T>);
  189. end;
  190. TCustomListWithPointers<T> = class(TCustomList<T>)
  191. public type
  192. TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
  193. protected
  194. FList: TCustomListWithPointers<T>;
  195. FIndex: SizeInt;
  196. function DoMoveNext: boolean; override;
  197. function DoGetCurrent: PT; override;
  198. public
  199. constructor Create(AList: TCustomListWithPointers<T>);
  200. end;
  201. protected
  202. function GetPtrEnumerator: TEnumerator<PT>; override;
  203. end;
  204. TList<T> = class(TCustomListWithPointers<T>)
  205. private var
  206. FComparer: IComparer<T>;
  207. protected
  208. // bug #24287 - workaround for generics type name conflict (Identifier not found)
  209. // next bug workaround - for another error related to previous workaround
  210. // change order (method must be declared before TEnumerator declaration)
  211. function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
  212. public
  213. // with this type declaration i found #24285, #24285
  214. type
  215. // bug workaround
  216. TEnumerator = class(TCustomListEnumerator<T>);
  217. function GetEnumerator: TEnumerator; reintroduce;
  218. protected
  219. procedure SetCapacity(AValue: SizeInt); override;
  220. procedure SetCount(AValue: SizeInt);
  221. procedure InitializeList; virtual;
  222. procedure InternalInsert(AIndex: SizeInt; constref AValue: T);
  223. private
  224. function GetItem(AIndex: SizeInt): T;
  225. procedure SetItem(AIndex: SizeInt; const AValue: T);
  226. public
  227. constructor Create; overload;
  228. constructor Create(const AComparer: IComparer<T>); overload;
  229. constructor Create(ACollection: TEnumerable<T>); overload;
  230. destructor Destroy; override;
  231. function Add(constref AValue: T): SizeInt; virtual;
  232. procedure AddRange(constref AValues: array of T); virtual; overload;
  233. procedure AddRange(const AEnumerable: IEnumerable<T>); overload;
  234. procedure AddRange(AEnumerable: TEnumerable<T>); overload;
  235. procedure AddRange(AEnumerable: TEnumerableWithPointers<T>); overload;
  236. procedure Insert(AIndex: SizeInt; constref AValue: T); virtual;
  237. procedure InsertRange(AIndex: SizeInt; constref AValues: array of T); virtual; overload;
  238. procedure InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>); overload;
  239. procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>); overload;
  240. procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerableWithPointers<T>); overload;
  241. function Remove(constref AValue: T): SizeInt;
  242. procedure Delete(AIndex: SizeInt); inline;
  243. procedure DeleteRange(AIndex, ACount: SizeInt);
  244. function ExtractIndex(const AIndex: SizeInt): T; overload;
  245. function Extract(constref AValue: T): T; overload;
  246. procedure Exchange(AIndex1, AIndex2: SizeInt); virtual;
  247. procedure Move(AIndex, ANewIndex: SizeInt); virtual;
  248. function First: T; inline;
  249. function Last: T; inline;
  250. procedure Clear;
  251. function Contains(constref AValue: T): Boolean; inline;
  252. function IndexOf(constref AValue: T): SizeInt; virtual;
  253. function LastIndexOf(constref AValue: T): SizeInt; virtual;
  254. procedure Reverse;
  255. procedure TrimExcess;
  256. procedure Sort; overload;
  257. procedure Sort(const AComparer: IComparer<T>); overload;
  258. function BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean; overload;
  259. function BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
  260. property Count: SizeInt read FLength write SetCount;
  261. property Items[Index: SizeInt]: T read GetItem write SetItem; default;
  262. end;
  263. TCollectionSortStyle = (cssNone,cssUser,cssAuto);
  264. TCollectionSortStyles = Set of TCollectionSortStyle;
  265. TSortedList<T> = class(TList<T>)
  266. private
  267. FDuplicates: TDuplicates;
  268. FSortStyle: TCollectionSortStyle;
  269. function GetSorted: boolean;
  270. procedure SetSorted(AValue: boolean);
  271. procedure SetSortStyle(AValue: TCollectionSortStyle);
  272. protected
  273. procedure InitializeList; override;
  274. public
  275. function Add(constref AValue: T): SizeInt; override; overload;
  276. procedure AddRange(constref AValues: array of T); override; overload;
  277. procedure Insert(AIndex: SizeInt; constref AValue: T); override;
  278. procedure Exchange(AIndex1, AIndex2: SizeInt); override;
  279. procedure Move(AIndex, ANewIndex: SizeInt); override;
  280. procedure InsertRange(AIndex: SizeInt; constref AValues: array of T); override; overload;
  281. property Duplicates: TDuplicates read FDuplicates write FDuplicates;
  282. property Sorted: Boolean read GetSorted write SetSorted;
  283. property SortStyle: TCollectionSortStyle read FSortStyle write SetSortStyle;
  284. function ConsistencyCheck(ARaiseException: boolean = true): boolean; virtual;
  285. end;
  286. TThreadList<T> = class
  287. private
  288. FList: TList<T>;
  289. FDuplicates: TDuplicates;
  290. FLock: TRTLCriticalSection;
  291. public
  292. constructor Create;
  293. destructor Destroy; override;
  294. procedure Add(constref AValue: T);
  295. procedure Remove(constref AValue: T);
  296. procedure Clear;
  297. function LockList: TList<T>;
  298. procedure UnlockList; inline;
  299. property Duplicates: TDuplicates read FDuplicates write FDuplicates;
  300. end;
  301. TQueue<T> = class(TCustomList<T>)
  302. public type
  303. TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
  304. protected
  305. FQueue: TQueue<T>;
  306. FIndex: SizeInt;
  307. function DoMoveNext: boolean; override;
  308. function DoGetCurrent: PT; override;
  309. public
  310. constructor Create(AQueue: TQueue<T>);
  311. end;
  312. protected
  313. function GetPtrEnumerator: TEnumerator<PT>; override;
  314. protected
  315. // bug #24287 - workaround for generics type name conflict (Identifier not found)
  316. // next bug workaround - for another error related to previous workaround
  317. // change order (function must be declared before TEnumerator declaration}
  318. function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
  319. public
  320. type
  321. TEnumerator = class(TCustomListEnumerator<T>)
  322. public
  323. constructor Create(AQueue: TQueue<T>);
  324. end;
  325. function GetEnumerator: TEnumerator; reintroduce;
  326. private
  327. FLow: SizeInt;
  328. protected
  329. procedure SetCapacity(AValue: SizeInt); override;
  330. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
  331. function GetCount: SizeInt; override;
  332. public
  333. constructor Create(ACollection: TEnumerable<T>); overload;
  334. destructor Destroy; override;
  335. procedure Enqueue(constref AValue: T);
  336. function Dequeue: T;
  337. function Extract: T;
  338. function Peek: T;
  339. procedure Clear;
  340. procedure TrimExcess;
  341. end;
  342. TStack<T> = class(TCustomListWithPointers<T>)
  343. protected
  344. // bug #24287 - workaround for generics type name conflict (Identifier not found)
  345. // next bug workaround - for another error related to previous workaround
  346. // change order (function must be declared before TEnumerator declaration}
  347. function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
  348. public
  349. type
  350. TEnumerator = class(TCustomListEnumerator<T>);
  351. function GetEnumerator: TEnumerator; reintroduce;
  352. protected
  353. function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
  354. procedure SetCapacity(AValue: SizeInt); override;
  355. public
  356. constructor Create(ACollection: TEnumerable<T>); overload;
  357. constructor Create(ACollection: TEnumerableWithPointers<T>); overload;
  358. destructor Destroy; override;
  359. procedure Clear;
  360. procedure Push(constref AValue: T);
  361. function Pop: T; inline;
  362. function Peek: T;
  363. function Extract: T; inline;
  364. procedure TrimExcess;
  365. end;
  366. TObjectList<T: class> = class(TList<T>)
  367. private
  368. FObjectsOwner: Boolean;
  369. protected
  370. procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
  371. public
  372. constructor Create(AOwnsObjects: Boolean = True); overload;
  373. constructor Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean = True); overload;
  374. constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
  375. constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
  376. property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
  377. end;
  378. TObjectQueue<T: class> = class(TQueue<T>)
  379. private
  380. FObjectsOwner: Boolean;
  381. protected
  382. procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
  383. public
  384. constructor Create(AOwnsObjects: Boolean = True); overload;
  385. constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
  386. constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
  387. procedure Dequeue;
  388. property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
  389. end;
  390. TObjectStack<T: class> = class(TStack<T>)
  391. private
  392. FObjectsOwner: Boolean;
  393. protected
  394. procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
  395. public
  396. constructor Create(AOwnsObjects: Boolean = True); overload;
  397. constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
  398. constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
  399. function Pop: T;
  400. property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
  401. end;
  402. PObject = ^TObject;
  403. {$I generics.dictionariesh.inc}
  404. { TCustomHashSet<T> }
  405. TCustomSet<T> = class(TEnumerableWithPointers<T>)
  406. public type
  407. PT = ^T;
  408. protected type
  409. TCustomSetEnumerator = class(TEnumerator<T>)
  410. protected var
  411. FEnumerator: TEnumerator<T>;
  412. function DoMoveNext: boolean; override;
  413. function DoGetCurrent: T; override;
  414. function GetCurrent: T; virtual; abstract;
  415. public
  416. constructor Create(ASet: TCustomSet<T>); virtual; abstract;
  417. destructor Destroy; override;
  418. end;
  419. protected
  420. function DoGetEnumerator: TEnumerator<T>; override;
  421. function GetCount: SizeInt; virtual; abstract;
  422. public
  423. constructor Create; virtual; abstract; overload;
  424. constructor Create(ACollection: TEnumerable<T>); overload;
  425. constructor Create(ACollection: TEnumerableWithPointers<T>); overload;
  426. function GetEnumerator: TCustomSetEnumerator; reintroduce; virtual; abstract;
  427. function Add(constref AValue: T): Boolean; virtual; abstract;
  428. function Remove(constref AValue: T): Boolean; virtual; abstract;
  429. procedure Clear; virtual; abstract;
  430. function Contains(constref AValue: T): Boolean; virtual; abstract;
  431. function AddRange(constref AValues: array of T): Boolean; overload;
  432. function AddRange(const AEnumerable: IEnumerable<T>): Boolean; overload;
  433. function AddRange(AEnumerable: TEnumerable<T>): Boolean; overload;
  434. function AddRange(AEnumerable: TEnumerableWithPointers<T>): Boolean; overload;
  435. procedure UnionWith(AHashSet: TCustomSet<T>);
  436. procedure IntersectWith(AHashSet: TCustomSet<T>);
  437. procedure ExceptWith(AHashSet: TCustomSet<T>);
  438. procedure SymmetricExceptWith(AHashSet: TCustomSet<T>);
  439. property Count: SizeInt read GetCount;
  440. end;
  441. { THashSet<T> }
  442. THashSet<T> = class(TCustomSet<T>)
  443. protected
  444. FInternalDictionary: TOpenAddressingLP<T, TEmptyRecord>;
  445. public type
  446. THashSetEnumerator = class(TCustomSetEnumerator)
  447. protected type
  448. TDictionaryEnumerator = TDictionary<T, TEmptyRecord>.TKeyEnumerator;
  449. function GetCurrent: T; override;
  450. public
  451. constructor Create(ASet: TCustomSet<T>); override;
  452. end;
  453. TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
  454. protected
  455. FEnumerator: TEnumerator<PT>;
  456. function DoMoveNext: boolean; override;
  457. function DoGetCurrent: PT; override;
  458. public
  459. constructor Create(AHashSet: THashSet<T>);
  460. end;
  461. protected
  462. function GetPtrEnumerator: TEnumerator<PT>; override;
  463. function GetCount: SizeInt; override;
  464. public
  465. constructor Create; override; overload;
  466. constructor Create(const AComparer: IEqualityComparer<T>); virtual; overload;
  467. destructor Destroy; override;
  468. function GetEnumerator: TCustomSetEnumerator; override;
  469. function Add(constref AValue: T): Boolean; override;
  470. function Remove(constref AValue: T): Boolean; override;
  471. procedure Clear; override;
  472. function Contains(constref AValue: T): Boolean; override;
  473. end;
  474. TPair<TKey, TValue, TInfo> = record
  475. public
  476. Key: TKey;
  477. Value: TValue;
  478. private
  479. Info: TInfo;
  480. end;
  481. TAVLTreeNode<TREE_CONSTRAINTS, TTree> = record
  482. private type
  483. TNodePair = TPair<TREE_CONSTRAINTS>;
  484. public type
  485. PNode = ^TAVLTreeNode<TREE_CONSTRAINTS, TTree>;
  486. public
  487. Parent, Left, Right: PNode;
  488. Balance: Integer;
  489. Data: TNodePair;
  490. function Successor: PNode;
  491. function Precessor: PNode;
  492. function TreeDepth: integer;
  493. procedure ConsistencyCheck(ATree: TObject); // workaround for internal error 2012101001 (no generic forward declarations)
  494. function GetCount: SizeInt;
  495. property Key: TKey read Data.Key write Data.Key;
  496. property Value: TValue read Data.Value write Data.Value;
  497. property Info: TInfo read Data.Info write Data.Info;
  498. end;
  499. TCustomTreeEnumerator<T, PNode, TTree> = class abstract(TEnumerator<T>)
  500. protected
  501. FCurrent: PNode;
  502. FTree: TTree;
  503. function DoGetCurrent: T; override;
  504. function GetCurrent: T; virtual; abstract;
  505. public
  506. constructor Create(ATree: TObject);
  507. property Current: T read GetCurrent;
  508. end;
  509. TCustomTree<TREE_CONSTRAINTS> = class
  510. end;
  511. TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator,
  512. T, PT, PNode, TTree> = class abstract(TEnumerableWithPointers<T>)
  513. private
  514. FTree: TTree;
  515. function GetCount: SizeInt; inline;
  516. protected
  517. function GetPtrEnumerator: TEnumerator<PT>; override;
  518. function DoGetEnumerator: TTreeEnumerator; override;
  519. public
  520. constructor Create(ATree: TTree);
  521. function ToArray: TArray<T>; override; final;
  522. property Count: SizeInt read GetCount;
  523. end;
  524. TAVLTreeEnumerator<T, PNode, TTree> = class(TCustomTreeEnumerator<T, PNode, TTree>)
  525. protected
  526. FLowToHigh: boolean;
  527. function DoMoveNext: Boolean; override;
  528. public
  529. constructor Create(ATree: TObject; ALowToHigh: boolean = true);
  530. property LowToHigh: boolean read FLowToHigh;
  531. end;
  532. TCustomAVLTreeMap<TREE_CONSTRAINTS> = class
  533. private type
  534. TTree = class(TCustomAVLTreeMap<TREE_CONSTRAINTS>);
  535. public type
  536. TNode = TAVLTreeNode<TREE_CONSTRAINTS, TTree>;
  537. PNode = ^TNode;
  538. TTreePair = TPair<TKey, TValue>;
  539. PKey = ^TKey;
  540. PValue = ^TValue;
  541. private type
  542. PPNode = ^PNode;
  543. // type exist only for generic constraint in TNodeCollection (non functional - PPNode has no sense)
  544. TPNodeEnumerator = class(TAVLTreeEnumerator<PPNode, PNode, TTree>);
  545. private var
  546. FDuplicates: TDuplicates;
  547. FComparer: IComparer<TKey>;
  548. protected
  549. FCount: SizeInt;
  550. FRoot: PNode;
  551. FKeys: TEnumerable<TKey>;
  552. FValues: TEnumerable<TValue>;
  553. procedure NodeAdded(ANode: PNode); virtual;
  554. procedure DeletingNode(ANode: PNode; AOrigin: boolean); virtual;
  555. function AddNode: PNode; virtual; abstract;
  556. procedure DeleteNode(ANode: PNode; ADispose: boolean); overload; virtual; abstract;
  557. procedure DeleteNode(ANode: PNode); overload;
  558. function Compare(constref ALeft, ARight: TKey): Integer; inline;
  559. function FindPredecessor(ANode: PNode): PNode;
  560. function FindInsertNode(ANode: PNode; out AInsertNode: PNode): Integer;
  561. procedure RotateRightRight(ANode: PNode); virtual;
  562. procedure RotateLeftLeft(ANode: PNode); virtual;
  563. procedure RotateRightLeft(ANode: PNode); virtual;
  564. procedure RotateLeftRight(ANode: PNode); virtual;
  565. // for reporting
  566. procedure WriteStr(AStream: TStream; const AText: string);
  567. public type
  568. TPairEnumerator = class(TAVLTreeEnumerator<TTreePair, PNode, TTree>)
  569. protected
  570. function GetCurrent: TTreePair; override;
  571. end;
  572. TNodeEnumerator = class(TAVLTreeEnumerator<PNode, PNode, TTree>)
  573. protected
  574. function GetCurrent: PNode; override;
  575. end;
  576. TKeyEnumerator = class(TAVLTreeEnumerator<TKey, PNode, TTree>)
  577. protected
  578. function GetCurrent: TKey; override;
  579. end;
  580. TPKeyEnumerator = class(TAVLTreeEnumerator<PKey, PNode, TTree>)
  581. protected
  582. function GetCurrent: PKey; override;
  583. end;
  584. TValueEnumerator = class(TAVLTreeEnumerator<TValue, PNode, TTree>)
  585. protected
  586. function GetCurrent: TValue; override;
  587. end;
  588. TPValueEnumerator = class(TAVLTreeEnumerator<PValue, PNode, TTree>)
  589. protected
  590. function GetCurrent: PValue; override;
  591. end;
  592. TNodeCollection = class(TTreeEnumerable<TNodeEnumerator, TPNodeEnumerator, PNode, PPNode, PNode, TTree>)
  593. private
  594. property Ptr; // PPNode has no sense, so hide enumerator for PPNode
  595. end;
  596. TKeyCollection = class(TTreeEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, PKey, PNode, TTree>);
  597. TValueCollection = class(TTreeEnumerable<TValueEnumerator, TPValueEnumerator, TValue, PValue, PNode, TTree>);
  598. private
  599. FNodes: TNodeCollection;
  600. function GetNodeCollection: TNodeCollection;
  601. procedure InternalAdd(ANode, AParent: PNode);
  602. procedure InternalDelete(ANode: PNode);
  603. function GetKeys: TKeyCollection;
  604. function GetValues: TValueCollection;
  605. public
  606. constructor Create; virtual; overload;
  607. constructor Create(const AComparer: IComparer<TKey>); virtual; overload;
  608. destructor Destroy; override;
  609. function Add(constref AKey: TKey; constref AValue: TValue): PNode;
  610. function Remove(constref AKey: TKey): boolean;
  611. procedure Delete(ANode: PNode; ADispose: boolean = true);
  612. function GetEnumerator: TPairEnumerator;
  613. property Nodes: TNodeCollection read GetNodeCollection;
  614. procedure Clear(ADisposeNodes: Boolean = true); virtual;
  615. function FindLowest: PNode;
  616. function FindHighest: PNode;
  617. property Count: SizeInt read FCount;
  618. property Root: PNode read FRoot;
  619. function Find(constref AKey: TKey): PNode;
  620. function ContainsKey(constref AKey: TKey; out ANode: PNode): boolean; overload; inline;
  621. function ContainsKey(constref AKey: TKey): boolean; overload; inline;
  622. procedure ConsistencyCheck; virtual;
  623. procedure WriteTreeNode(AStream: TStream; ANode: PNode);
  624. procedure WriteReportToStream(AStream: TStream);
  625. function NodeToReportStr(ANode: PNode): string; virtual;
  626. function ReportAsString: string;
  627. property Keys: TKeyCollection read GetKeys;
  628. property Values: TValueCollection read GetValues;
  629. property Duplicates: TDuplicates read FDuplicates write FDuplicates;
  630. end;
  631. TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
  632. protected
  633. function AddNode: PNode; override;
  634. procedure DeleteNode(ANode: PNode; ADispose: boolean = true); override;
  635. end;
  636. TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
  637. protected
  638. FLastNode: PNode;
  639. FLastIndex: SizeInt;
  640. procedure RotateRightRight(ANode: PNode); override;
  641. procedure RotateLeftLeft(ANode: PNode); override;
  642. procedure RotateRightLeft(ANode: PNode); override;
  643. procedure RotateLeftRight(ANode: PNode); override;
  644. procedure NodeAdded(ANode: PNode); override;
  645. procedure DeletingNode(ANode: PNode; AOrigin: boolean); override;
  646. function AddNode: PNode; override;
  647. procedure DeleteNode(ANode: PNode; ADispose: boolean = true); override;
  648. public
  649. function GetNodeAtIndex(AIndex: SizeInt): PNode;
  650. function NodeToIndex(ANode: PNode): SizeInt;
  651. procedure ConsistencyCheck; override;
  652. function NodeToReportStr(ANode: PNode): string; override;
  653. end;
  654. TAVLTree<T> = class(TAVLTreeMap<T, TEmptyRecord>)
  655. public type
  656. TItemEnumerator = TKeyEnumerator;
  657. public
  658. function Add(constref AValue: T): PNode; reintroduce;
  659. end;
  660. TIndexedAVLTree<T> = class(TIndexedAVLTreeMap<T, TEmptyRecord>)
  661. public type
  662. TItemEnumerator = TKeyEnumerator;
  663. public
  664. function Add(constref AValue: T): PNode; reintroduce;
  665. end;
  666. TSortedSet<T> = class(TCustomSet<T>)
  667. protected
  668. FInternalTree: TAVLTree<T>;
  669. public type
  670. TSortedSetEnumerator = class(TCustomSetEnumerator)
  671. protected type
  672. TTreeEnumerator = TAVLTree<T>.TItemEnumerator;
  673. function GetCurrent: T; override;
  674. public
  675. constructor Create(ASet: TCustomSet<T>); override;
  676. end;
  677. TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
  678. protected
  679. FEnumerator: TEnumerator<PT>;
  680. function DoMoveNext: boolean; override;
  681. function DoGetCurrent: PT; override;
  682. public
  683. constructor Create(ASortedSet: TSortedSet<T>);
  684. end;
  685. protected
  686. function GetPtrEnumerator: TEnumerator<PT>; override;
  687. function GetCount: SizeInt; override;
  688. public
  689. constructor Create; override; overload;
  690. constructor Create(const AComparer: IComparer<T>); virtual; overload;
  691. destructor Destroy; override;
  692. function GetEnumerator: TCustomSetEnumerator; override;
  693. function Add(constref AValue: T): Boolean; override;
  694. function Remove(constref AValue: T): Boolean; override;
  695. procedure Clear; override;
  696. function Contains(constref AValue: T): Boolean; override;
  697. end;
  698. TSortedHashSet<T> = class(TCustomSet<T>)
  699. protected
  700. FInternalDictionary: TOpenAddressingLP<PT, TEmptyRecord>;
  701. FInternalTree: TAVLTree<T>;
  702. function DoGetEnumerator: TEnumerator<T>; override;
  703. function GetCount: SizeInt; override;
  704. protected type
  705. TSortedHashSetEqualityComparer = class(TInterfacedObject, IEqualityComparer<PT>)
  706. private
  707. FComparer: IComparer<T>;
  708. FEqualityComparer: IEqualityComparer<T>;
  709. function Equals(constref ALeft, ARight: PT): Boolean;
  710. function GetHashCode(constref AValue: PT): UInt32;
  711. public
  712. constructor Create(const AComparer: IComparer<T>); overload;
  713. constructor Create(const AEqualityComparer: IEqualityComparer<T>); overload;
  714. constructor Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>); overload;
  715. end;
  716. public type
  717. TSortedHashSetEnumerator = class(TCustomSetEnumerator)
  718. protected type
  719. TTreeEnumerator = TAVLTree<T>.TItemEnumerator;
  720. function GetCurrent: T; override;
  721. public
  722. constructor Create(ASet: TCustomSet<T>); override;
  723. end;
  724. TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
  725. protected
  726. FEnumerator: TEnumerator<PT>;
  727. function DoMoveNext: boolean; override;
  728. function DoGetCurrent: PT; override;
  729. public
  730. constructor Create(ASortedHashSet: TSortedHashSet<T>);
  731. end;
  732. protected
  733. function GetPtrEnumerator: TEnumerator<PT>; override;
  734. public
  735. constructor Create; override; overload;
  736. constructor Create(const AComparer: IEqualityComparer<T>); overload;
  737. constructor Create(const AComparer: IComparer<T>); overload;
  738. constructor Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>); overload;
  739. destructor Destroy; override;
  740. function GetEnumerator: TCustomSetEnumerator; override;
  741. function Add(constref AValue: T): Boolean; override;
  742. function Remove(constref AValue: T): Boolean; override;
  743. procedure Clear; override;
  744. function Contains(constref AValue: T): Boolean; override;
  745. end;
  746. function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
  747. var
  748. EmptyRecord: TEmptyRecord;
  749. implementation
  750. function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
  751. begin
  752. Result :=
  753. (ABottom < AItem) and (AItem <= ATop )
  754. or (ATop < ABottom) and (AItem > ABottom)
  755. or (ATop < ABottom ) and (AItem <= ATop );
  756. end;
  757. { TCustomArrayHelper<T> }
  758. class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  759. out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
  760. begin
  761. Result := BinarySearch(AValues, AItem, AFoundIndex, AComparer, Low(AValues), Length(AValues));
  762. end;
  763. class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  764. out AFoundIndex: SizeInt): Boolean;
  765. begin
  766. Result := BinarySearch(AValues, AItem, AFoundIndex, TComparerBugHack.Default, Low(AValues), Length(AValues));
  767. end;
  768. class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  769. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>): Boolean;
  770. begin
  771. Result := BinarySearch(AValues, AItem, ASearchResult, AComparer, Low(AValues), Length(AValues));
  772. end;
  773. class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  774. out ASearchResult: TBinarySearchResult): Boolean;
  775. begin
  776. Result := BinarySearch(AValues, AItem, ASearchResult, TComparerBugHack.Default, Low(AValues), Length(AValues));
  777. end;
  778. class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T);
  779. begin
  780. QuickSort(AValues, Low(AValues), High(AValues), TComparerBugHack.Default);
  781. end;
  782. class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
  783. const AComparer: IComparer<T>);
  784. begin
  785. QuickSort(AValues, Low(AValues), High(AValues), AComparer);
  786. end;
  787. class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
  788. const AComparer: IComparer<T>; AIndex, ACount: SizeInt);
  789. begin
  790. if ACount <= 1 then
  791. Exit;
  792. QuickSort(AValues, AIndex, Pred(AIndex + ACount), AComparer);
  793. end;
  794. { TArrayHelper<T> }
  795. class procedure TArrayHelper<T>.QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
  796. const AComparer: IComparer<T>);
  797. var
  798. I, J: SizeInt;
  799. P, Q: T;
  800. begin
  801. if ((ARight - ALeft) <= 0) or (Length(AValues) = 0) then
  802. Exit;
  803. repeat
  804. I := ALeft;
  805. J := ARight;
  806. P := AValues[ALeft + (ARight - ALeft) shr 1];
  807. repeat
  808. while AComparer.Compare(AValues[I], P) < 0 do
  809. I += 1;
  810. while AComparer.Compare(AValues[J], P) > 0 do
  811. J -= 1;
  812. if I <= J then
  813. begin
  814. if I <> J then
  815. begin
  816. Q := AValues[I];
  817. AValues[I] := AValues[J];
  818. AValues[J] := Q;
  819. end;
  820. I += 1;
  821. J -= 1;
  822. end;
  823. until I > J;
  824. // sort the smaller range recursively
  825. // sort the bigger range via the loop
  826. // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
  827. if J - ALeft < ARight - I then
  828. begin
  829. if ALeft < J then
  830. QuickSort(AValues, ALeft, J, AComparer);
  831. ALeft := I;
  832. end
  833. else
  834. begin
  835. if I < ARight then
  836. QuickSort(AValues, I, ARight, AComparer);
  837. ARight := J;
  838. end;
  839. until ALeft >= ARight;
  840. end;
  841. class function TArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  842. out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
  843. AIndex, ACount: SizeInt): Boolean;
  844. var
  845. imin, imax, imid: Int32;
  846. begin
  847. // continually narrow search until just one element remains
  848. imin := AIndex;
  849. imax := Pred(AIndex + ACount);
  850. // http://en.wikipedia.org/wiki/Binary_search_algorithm
  851. while (imin < imax) do
  852. begin
  853. imid := imin + ((imax - imin) shr 1);
  854. // code must guarantee the interval is reduced at each iteration
  855. // assert(imid < imax);
  856. // note: 0 <= imin < imax implies imid will always be less than imax
  857. ASearchResult.CompareResult := AComparer.Compare(AValues[imid], AItem);
  858. // reduce the search
  859. if (ASearchResult.CompareResult < 0) then
  860. imin := imid + 1
  861. else
  862. begin
  863. imax := imid;
  864. if ASearchResult.CompareResult = 0 then
  865. begin
  866. ASearchResult.FoundIndex := imid;
  867. ASearchResult.CandidateIndex := imid;
  868. Exit(True);
  869. end;
  870. end;
  871. end;
  872. // At exit of while:
  873. // if A[] is empty, then imax < imin
  874. // otherwise imax == imin
  875. // deferred test for equality
  876. if (imax = imin) then
  877. begin
  878. ASearchResult.CompareResult := AComparer.Compare(AValues[imin], AItem);
  879. ASearchResult.CandidateIndex := imin;
  880. if (ASearchResult.CompareResult = 0) then
  881. begin
  882. ASearchResult.FoundIndex := imin;
  883. Exit(True);
  884. end else
  885. begin
  886. ASearchResult.FoundIndex := -1;
  887. Exit(False);
  888. end;
  889. end
  890. else
  891. begin
  892. ASearchResult.CompareResult := 0;
  893. ASearchResult.FoundIndex := -1;
  894. ASearchResult.CandidateIndex := -1;
  895. Exit(False);
  896. end;
  897. end;
  898. class function TArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
  899. out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
  900. AIndex, ACount: SizeInt): Boolean;
  901. var
  902. imin, imax, imid: Int32;
  903. LCompare: SizeInt;
  904. begin
  905. // continually narrow search until just one element remains
  906. imin := AIndex;
  907. imax := Pred(AIndex + ACount);
  908. // http://en.wikipedia.org/wiki/Binary_search_algorithm
  909. while (imin < imax) do
  910. begin
  911. imid := imin + ((imax - imin) shr 1);
  912. // code must guarantee the interval is reduced at each iteration
  913. // assert(imid < imax);
  914. // note: 0 <= imin < imax implies imid will always be less than imax
  915. LCompare := AComparer.Compare(AValues[imid], AItem);
  916. // reduce the search
  917. if (LCompare < 0) then
  918. imin := imid + 1
  919. else
  920. begin
  921. imax := imid;
  922. if LCompare = 0 then
  923. begin
  924. AFoundIndex := imid;
  925. Exit(True);
  926. end;
  927. end;
  928. end;
  929. // At exit of while:
  930. // if A[] is empty, then imax < imin
  931. // otherwise imax == imin
  932. // deferred test for equality
  933. LCompare := AComparer.Compare(AValues[imin], AItem);
  934. if (imax = imin) and (LCompare = 0) then
  935. begin
  936. AFoundIndex := imin;
  937. Exit(True);
  938. end
  939. else
  940. begin
  941. AFoundIndex := -1;
  942. Exit(False);
  943. end;
  944. end;
  945. { TEnumerator<T> }
  946. function TEnumerator<T>.MoveNext: boolean;
  947. begin
  948. Exit(DoMoveNext);
  949. end;
  950. { TEnumerable<T> }
  951. function TEnumerable<T>.ToArrayImpl(ACount: SizeInt): TArray<T>;
  952. var
  953. i: SizeInt;
  954. LEnumerator: TEnumerator<T>;
  955. begin
  956. SetLength(Result, ACount);
  957. try
  958. LEnumerator := GetEnumerator;
  959. i := 0;
  960. while LEnumerator.MoveNext do
  961. begin
  962. Result[i] := LEnumerator.Current;
  963. Inc(i);
  964. end;
  965. finally
  966. LEnumerator.Free;
  967. end;
  968. end;
  969. function TEnumerable<T>.GetEnumerator: TEnumerator<T>;
  970. begin
  971. Exit(DoGetEnumerator);
  972. end;
  973. function TEnumerable<T>.ToArray: TArray<T>;
  974. var
  975. LEnumerator: TEnumerator<T>;
  976. LBuffer: TList<T>;
  977. begin
  978. LBuffer := TList<T>.Create;
  979. try
  980. LEnumerator := GetEnumerator;
  981. while LEnumerator.MoveNext do
  982. LBuffer.Add(LEnumerator.Current);
  983. Result := LBuffer.ToArray;
  984. finally
  985. LBuffer.Free;
  986. LEnumerator.Free;
  987. end;
  988. end;
  989. { TCustomPointersCollection<T, PT> }
  990. function TCustomPointersCollection<T, PT>.Enumerable: TLocalEnumerable;
  991. begin
  992. Result := TLocalEnumerable(@Self);
  993. end;
  994. function TCustomPointersCollection<T, PT>.GetEnumerator: TEnumerator<PT>;
  995. begin
  996. Result := Enumerable.GetPtrEnumerator;
  997. end;
  998. { TEnumerableWithPointers<T> }
  999. function TEnumerableWithPointers<T>.GetPtr: PPointersCollection;
  1000. begin
  1001. Result := PPointersCollection(Self);
  1002. end;
  1003. { TCustomList<T> }
  1004. function TCustomList<T>.PrepareAddingItem: SizeInt;
  1005. begin
  1006. Result := Length(FItems);
  1007. if (FLength < 4) and (Result < 4) then
  1008. SetLength(FItems, 4)
  1009. else if FLength = High(FLength) then
  1010. OutOfMemoryError
  1011. else if FLength = Result then
  1012. SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
  1013. Result := FLength;
  1014. Inc(FLength);
  1015. end;
  1016. function TCustomList<T>.PrepareAddingRange(ACount: SizeInt): SizeInt;
  1017. begin
  1018. if ACount < 0 then
  1019. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1020. if ACount = 0 then
  1021. Exit(FLength - 1);
  1022. if (FLength = 0) and (Length(FItems) = 0) then
  1023. SetLength(FItems, 4)
  1024. else if FLength = High(FLength) then
  1025. OutOfMemoryError;
  1026. Result := Length(FItems);
  1027. while Pred(FLength + ACount) >= Result do
  1028. begin
  1029. SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
  1030. Result := Length(FItems);
  1031. end;
  1032. Result := FLength;
  1033. Inc(FLength, ACount);
  1034. end;
  1035. function TCustomList<T>.ToArray: TArray<T>;
  1036. begin
  1037. Result := ToArrayImpl(Count);
  1038. end;
  1039. function TCustomList<T>.GetCount: SizeInt;
  1040. begin
  1041. Result := FLength;
  1042. end;
  1043. procedure TCustomList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
  1044. begin
  1045. if Assigned(FOnNotify) then
  1046. FOnNotify(Self, AValue, ACollectionNotification);
  1047. end;
  1048. function TCustomList<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
  1049. begin
  1050. if (AIndex < 0) or (AIndex >= FLength) then
  1051. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1052. Result := FItems[AIndex];
  1053. Dec(FLength);
  1054. FItems[AIndex] := Default(T);
  1055. if AIndex <> FLength then
  1056. begin
  1057. System.Move(FItems[AIndex + 1], FItems[AIndex], (FLength - AIndex) * SizeOf(T));
  1058. FillChar(FItems[FLength], SizeOf(T), 0);
  1059. end;
  1060. Notify(Result, ACollectionNotification);
  1061. end;
  1062. function TCustomList<T>.GetCapacity: SizeInt;
  1063. begin
  1064. Result := Length(FItems);
  1065. end;
  1066. { TCustomListEnumerator<T> }
  1067. function TCustomListEnumerator<T>.DoMoveNext: boolean;
  1068. begin
  1069. Inc(FIndex);
  1070. Result := (FList.FLength <> 0) and (FIndex < FList.FLength)
  1071. end;
  1072. function TCustomListEnumerator<T>.DoGetCurrent: T;
  1073. begin
  1074. Result := GetCurrent;
  1075. end;
  1076. function TCustomListEnumerator<T>.GetCurrent: T;
  1077. begin
  1078. Result := FList.FItems[FIndex];
  1079. end;
  1080. constructor TCustomListEnumerator<T>.Create(AList: TCustomList<T>);
  1081. begin
  1082. inherited Create;
  1083. FIndex := -1;
  1084. FList := AList;
  1085. end;
  1086. { TCustomListWithPointers<T>.TPointersEnumerator }
  1087. function TCustomListWithPointers<T>.TPointersEnumerator.DoMoveNext: boolean;
  1088. begin
  1089. Inc(FIndex);
  1090. Result := (FList.FLength <> 0) and (FIndex < FList.FLength)
  1091. end;
  1092. function TCustomListWithPointers<T>.TPointersEnumerator.DoGetCurrent: PT;
  1093. begin
  1094. Result := @FList.FItems[FIndex];;
  1095. end;
  1096. constructor TCustomListWithPointers<T>.TPointersEnumerator.Create(AList: TCustomListWithPointers<T>);
  1097. begin
  1098. inherited Create;
  1099. FIndex := -1;
  1100. FList := AList;
  1101. end;
  1102. { TCustomListWithPointers<T> }
  1103. function TCustomListWithPointers<T>.GetPtrEnumerator: TEnumerator<PT>;
  1104. begin
  1105. Result := TPointersEnumerator.Create(Self);
  1106. end;
  1107. { TList<T> }
  1108. procedure TList<T>.InitializeList;
  1109. begin
  1110. end;
  1111. constructor TList<T>.Create;
  1112. begin
  1113. InitializeList;
  1114. FComparer := TComparer<T>.Default;
  1115. end;
  1116. constructor TList<T>.Create(const AComparer: IComparer<T>);
  1117. begin
  1118. InitializeList;
  1119. FComparer := AComparer;
  1120. end;
  1121. constructor TList<T>.Create(ACollection: TEnumerable<T>);
  1122. var
  1123. LItem: T;
  1124. begin
  1125. Create;
  1126. for LItem in ACollection do
  1127. Add(LItem);
  1128. end;
  1129. destructor TList<T>.Destroy;
  1130. begin
  1131. SetCapacity(0);
  1132. end;
  1133. procedure TList<T>.SetCapacity(AValue: SizeInt);
  1134. begin
  1135. if AValue < Count then
  1136. Count := AValue;
  1137. SetLength(FItems, AValue);
  1138. end;
  1139. procedure TList<T>.SetCount(AValue: SizeInt);
  1140. begin
  1141. if AValue < 0 then
  1142. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1143. if AValue > Capacity then
  1144. Capacity := AValue;
  1145. if AValue < Count then
  1146. DeleteRange(AValue, Count - AValue);
  1147. FLength := AValue;
  1148. end;
  1149. function TList<T>.GetItem(AIndex: SizeInt): T;
  1150. begin
  1151. if (AIndex < 0) or (AIndex >= Count) then
  1152. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1153. Result := FItems[AIndex];
  1154. end;
  1155. procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
  1156. begin
  1157. if (AIndex < 0) or (AIndex >= Count) then
  1158. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1159. Notify(FItems[AIndex], cnRemoved);
  1160. FItems[AIndex] := AValue;
  1161. Notify(AValue, cnAdded);
  1162. end;
  1163. function TList<T>.GetEnumerator: TEnumerator;
  1164. begin
  1165. Result := TEnumerator.Create(Self);
  1166. end;
  1167. function TList<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
  1168. begin
  1169. Result := GetEnumerator;
  1170. end;
  1171. function TList<T>.Add(constref AValue: T): SizeInt;
  1172. begin
  1173. Result := PrepareAddingItem;
  1174. FItems[Result] := AValue;
  1175. Notify(AValue, cnAdded);
  1176. end;
  1177. procedure TList<T>.AddRange(constref AValues: array of T);
  1178. begin
  1179. InsertRange(Count, AValues);
  1180. end;
  1181. procedure TList<T>.AddRange(const AEnumerable: IEnumerable<T>);
  1182. var
  1183. LValue: T;
  1184. begin
  1185. for LValue in AEnumerable do
  1186. Add(LValue);
  1187. end;
  1188. procedure TList<T>.AddRange(AEnumerable: TEnumerable<T>);
  1189. var
  1190. LValue: T;
  1191. begin
  1192. for LValue in AEnumerable do
  1193. Add(LValue);
  1194. end;
  1195. procedure TList<T>.AddRange(AEnumerable: TEnumerableWithPointers<T>);
  1196. var
  1197. LValue: PT;
  1198. begin
  1199. for LValue in AEnumerable.Ptr^ do
  1200. Add(LValue^);
  1201. end;
  1202. procedure TList<T>.InternalInsert(AIndex: SizeInt; constref AValue: T);
  1203. begin
  1204. if AIndex <> PrepareAddingItem then
  1205. begin
  1206. System.Move(FItems[AIndex], FItems[AIndex + 1], ((Count - AIndex) - 1) * SizeOf(T));
  1207. FillChar(FItems[AIndex], SizeOf(T), 0);
  1208. end;
  1209. FItems[AIndex] := AValue;
  1210. Notify(AValue, cnAdded);
  1211. end;
  1212. procedure TList<T>.Insert(AIndex: SizeInt; constref AValue: T);
  1213. begin
  1214. if (AIndex < 0) or (AIndex > Count) then
  1215. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1216. InternalInsert(AIndex, AValue);
  1217. end;
  1218. procedure TList<T>.InsertRange(AIndex: SizeInt; constref AValues: array of T);
  1219. var
  1220. i: SizeInt;
  1221. LLength: SizeInt;
  1222. LValue: ^T;
  1223. begin
  1224. if (AIndex < 0) or (AIndex > Count) then
  1225. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1226. LLength := Length(AValues);
  1227. if LLength = 0 then
  1228. Exit;
  1229. if AIndex <> PrepareAddingRange(LLength) then
  1230. begin
  1231. System.Move(FItems[AIndex], FItems[AIndex + LLength], ((Count - AIndex) - LLength) * SizeOf(T));
  1232. FillChar(FItems[AIndex], SizeOf(T) * LLength, 0);
  1233. end;
  1234. LValue := @AValues[0];
  1235. for i := AIndex to Pred(AIndex + LLength) do
  1236. begin
  1237. FItems[i] := LValue^;
  1238. Notify(LValue^, cnAdded);
  1239. Inc(LValue);
  1240. end;
  1241. end;
  1242. procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>);
  1243. var
  1244. LValue: T;
  1245. i: SizeInt;
  1246. begin
  1247. if (AIndex < 0) or (AIndex > Count) then
  1248. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1249. i := 0;
  1250. for LValue in AEnumerable do
  1251. begin
  1252. InternalInsert(Aindex + i, LValue);
  1253. Inc(i);
  1254. end;
  1255. end;
  1256. procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>);
  1257. var
  1258. LValue: T;
  1259. i: SizeInt;
  1260. begin
  1261. if (AIndex < 0) or (AIndex > Count) then
  1262. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1263. i := 0;
  1264. for LValue in AEnumerable do
  1265. begin
  1266. InternalInsert(Aindex + i, LValue);
  1267. Inc(i);
  1268. end;
  1269. end;
  1270. procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerableWithPointers<T>);
  1271. var
  1272. LValue: PT;
  1273. i: SizeInt;
  1274. begin
  1275. if (AIndex < 0) or (AIndex > Count) then
  1276. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1277. i := 0;
  1278. for LValue in AEnumerable.Ptr^ do
  1279. begin
  1280. InternalInsert(Aindex + i, LValue^);
  1281. Inc(i);
  1282. end;
  1283. end;
  1284. function TList<T>.Remove(constref AValue: T): SizeInt;
  1285. begin
  1286. Result := IndexOf(AValue);
  1287. if Result >= 0 then
  1288. DoRemove(Result, cnRemoved);
  1289. end;
  1290. procedure TList<T>.Delete(AIndex: SizeInt);
  1291. begin
  1292. DoRemove(AIndex, cnRemoved);
  1293. end;
  1294. procedure TList<T>.DeleteRange(AIndex, ACount: SizeInt);
  1295. var
  1296. LDeleted: array of T;
  1297. i: SizeInt;
  1298. LMoveDelta: SizeInt;
  1299. begin
  1300. if ACount = 0 then
  1301. Exit;
  1302. if (ACount < 0) or (AIndex < 0) or (AIndex + ACount > Count) then
  1303. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1304. SetLength(LDeleted, Count);
  1305. System.Move(FItems[AIndex], LDeleted[0], ACount * SizeOf(T));
  1306. LMoveDelta := Count - (AIndex + ACount);
  1307. if LMoveDelta = 0 then
  1308. FillChar(FItems[AIndex], ACount * SizeOf(T), #0)
  1309. else
  1310. begin
  1311. System.Move(FItems[AIndex + ACount], FItems[AIndex], LMoveDelta * SizeOf(T));
  1312. FillChar(FItems[Count - ACount], ACount * SizeOf(T), #0);
  1313. end;
  1314. Dec(FLength, ACount);
  1315. for i := 0 to High(LDeleted) do
  1316. Notify(LDeleted[i], cnRemoved);
  1317. end;
  1318. function TList<T>.ExtractIndex(const AIndex: SizeInt): T;
  1319. begin
  1320. Result := DoRemove(AIndex, cnExtracted);
  1321. end;
  1322. function TList<T>.Extract(constref AValue: T): T;
  1323. var
  1324. LIndex: SizeInt;
  1325. begin
  1326. LIndex := IndexOf(AValue);
  1327. if LIndex < 0 then
  1328. Exit(Default(T));
  1329. Result := DoRemove(LIndex, cnExtracted);
  1330. end;
  1331. procedure TList<T>.Exchange(AIndex1, AIndex2: SizeInt);
  1332. var
  1333. LTemp: T;
  1334. begin
  1335. LTemp := FItems[AIndex1];
  1336. FItems[AIndex1] := FItems[AIndex2];
  1337. FItems[AIndex2] := LTemp;
  1338. end;
  1339. procedure TList<T>.Move(AIndex, ANewIndex: SizeInt);
  1340. var
  1341. LTemp: T;
  1342. begin
  1343. if ANewIndex = AIndex then
  1344. Exit;
  1345. if (ANewIndex < 0) or (ANewIndex >= Count) then
  1346. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1347. LTemp := FItems[AIndex];
  1348. FItems[AIndex] := Default(T);
  1349. if AIndex < ANewIndex then
  1350. System.Move(FItems[Succ(AIndex)], FItems[AIndex], (ANewIndex - AIndex) * SizeOf(T))
  1351. else
  1352. System.Move(FItems[ANewIndex], FItems[Succ(ANewIndex)], (AIndex - ANewIndex) * SizeOf(T));
  1353. FillChar(FItems[ANewIndex], SizeOf(T), #0);
  1354. FItems[ANewIndex] := LTemp;
  1355. end;
  1356. function TList<T>.First: T;
  1357. begin
  1358. Result := Items[0];
  1359. end;
  1360. function TList<T>.Last: T;
  1361. begin
  1362. Result := Items[Pred(Count)];
  1363. end;
  1364. procedure TList<T>.Clear;
  1365. begin
  1366. SetCount(0);
  1367. SetCapacity(0);
  1368. end;
  1369. procedure TList<T>.TrimExcess;
  1370. begin
  1371. SetCapacity(Count);
  1372. end;
  1373. function TList<T>.Contains(constref AValue: T): Boolean;
  1374. begin
  1375. Result := IndexOf(AValue) >= 0;
  1376. end;
  1377. function TList<T>.IndexOf(constref AValue: T): SizeInt;
  1378. var
  1379. i: SizeInt;
  1380. begin
  1381. for i := 0 to Count - 1 do
  1382. if FComparer.Compare(AValue, FItems[i]) = 0 then
  1383. Exit(i);
  1384. Result := -1;
  1385. end;
  1386. function TList<T>.LastIndexOf(constref AValue: T): SizeInt;
  1387. var
  1388. i: SizeInt;
  1389. begin
  1390. for i := Count - 1 downto 0 do
  1391. if FComparer.Compare(AValue, FItems[i]) = 0 then
  1392. Exit(i);
  1393. Result := -1;
  1394. end;
  1395. procedure TList<T>.Reverse;
  1396. var
  1397. a, b: SizeInt;
  1398. LTemp: T;
  1399. begin
  1400. a := 0;
  1401. b := Count - 1;
  1402. while a < b do
  1403. begin
  1404. LTemp := FItems[a];
  1405. FItems[a] := FItems[b];
  1406. FItems[b] := LTemp;
  1407. Inc(a);
  1408. Dec(b);
  1409. end;
  1410. end;
  1411. procedure TList<T>.Sort;
  1412. begin
  1413. TArrayHelperBugHack.Sort(FItems, FComparer, 0, Count);
  1414. end;
  1415. procedure TList<T>.Sort(const AComparer: IComparer<T>);
  1416. begin
  1417. TArrayHelperBugHack.Sort(FItems, AComparer, 0, Count);
  1418. end;
  1419. function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean;
  1420. begin
  1421. Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex, FComparer, 0, Count);
  1422. end;
  1423. function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
  1424. begin
  1425. Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex, AComparer, 0, Count);
  1426. end;
  1427. { TSortedList<T> }
  1428. procedure TSortedList<T>.InitializeList;
  1429. begin
  1430. FSortStyle := cssAuto;
  1431. end;
  1432. function TSortedList<T>.Add(constref AValue: T): SizeInt;
  1433. var
  1434. LSearchResult: TBinarySearchResult;
  1435. begin
  1436. if SortStyle <> cssAuto then
  1437. Exit(inherited Add(AValue));
  1438. if TArrayHelperBugHack.BinarySearch(FItems, AValue, LSearchResult, FComparer, 0, Count) then
  1439. case FDuplicates of
  1440. dupAccept: Result := LSearchResult.FoundIndex;
  1441. dupIgnore: Exit(LSearchResult.FoundIndex);
  1442. dupError: raise EListError.Create(SCollectionDuplicate);
  1443. end
  1444. else
  1445. begin
  1446. if LSearchResult.CandidateIndex = -1 then
  1447. Result := 0
  1448. else
  1449. if LSearchResult.CompareResult > 0 then
  1450. Result := LSearchResult.CandidateIndex
  1451. else
  1452. Result := LSearchResult.CandidateIndex + 1;
  1453. end;
  1454. InternalInsert(Result, AValue);
  1455. end;
  1456. procedure TSortedList<T>.Insert(AIndex: SizeInt; constref AValue: T);
  1457. begin
  1458. if FSortStyle = cssAuto then
  1459. raise EListError.Create(SSortedListError)
  1460. else
  1461. inherited;
  1462. end;
  1463. procedure TSortedList<T>.Exchange(AIndex1, AIndex2: SizeInt);
  1464. begin
  1465. if FSortStyle = cssAuto then
  1466. raise EListError.Create(SSortedListError)
  1467. else
  1468. inherited;
  1469. end;
  1470. procedure TSortedList<T>.Move(AIndex, ANewIndex: SizeInt);
  1471. begin
  1472. if FSortStyle = cssAuto then
  1473. raise EListError.Create(SSortedListError)
  1474. else
  1475. inherited;
  1476. end;
  1477. procedure TSortedList<T>.AddRange(constref AValues: array of T);
  1478. var
  1479. i: T;
  1480. begin
  1481. for i in AValues do
  1482. Add(i);
  1483. end;
  1484. procedure TSortedList<T>.InsertRange(AIndex: SizeInt; constref AValues: array of T);
  1485. var
  1486. LValue: T;
  1487. i: SizeInt;
  1488. begin
  1489. if (AIndex < 0) or (AIndex > Count) then
  1490. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1491. i := 0;
  1492. for LValue in AValues do
  1493. begin
  1494. InternalInsert(AIndex + i, LValue);
  1495. Inc(i);
  1496. end;
  1497. end;
  1498. function TSortedList<T>.GetSorted: boolean;
  1499. begin
  1500. Result := FSortStyle in [cssAuto, cssUser];
  1501. end;
  1502. procedure TSortedList<T>.SetSorted(AValue: boolean);
  1503. begin
  1504. if AValue then
  1505. SortStyle := cssAuto
  1506. else
  1507. SortStyle := cssNone;
  1508. end;
  1509. procedure TSortedList<T>.SetSortStyle(AValue: TCollectionSortStyle);
  1510. begin
  1511. if FSortStyle = AValue then
  1512. Exit;
  1513. if AValue = cssAuto then
  1514. Sort;
  1515. FSortStyle := AValue;
  1516. end;
  1517. function TSortedList<T>.ConsistencyCheck(ARaiseException: boolean = true): boolean;
  1518. var
  1519. i: Integer;
  1520. LCompare: SizeInt;
  1521. begin
  1522. if Sorted then
  1523. for i := 0 to Count-2 do
  1524. begin
  1525. LCompare := FComparer.Compare(FItems[i], FItems[i+1]);
  1526. if LCompare = 0 then
  1527. begin
  1528. if Duplicates <> dupAccept then
  1529. if ARaiseException then
  1530. raise EListError.Create(SCollectionDuplicate)
  1531. else
  1532. Exit(False)
  1533. end
  1534. else
  1535. if LCompare > 0 then
  1536. if ARaiseException then
  1537. raise EListError.Create(SCollectionInconsistency)
  1538. else
  1539. Exit(False)
  1540. end;
  1541. Result := True;
  1542. end;
  1543. { TThreadList<T> }
  1544. constructor TThreadList<T>.Create;
  1545. begin
  1546. inherited Create;
  1547. FDuplicates:=dupIgnore;
  1548. {$ifdef FPC_HAS_FEATURE_THREADING}
  1549. InitCriticalSection(FLock);
  1550. {$endif}
  1551. FList := TList<T>.Create;
  1552. end;
  1553. destructor TThreadList<T>.Destroy;
  1554. begin
  1555. LockList;
  1556. try
  1557. FList.Free;
  1558. inherited Destroy;
  1559. finally
  1560. UnlockList;
  1561. {$ifdef FPC_HAS_FEATURE_THREADING}
  1562. DoneCriticalSection(FLock);
  1563. {$endif}
  1564. end;
  1565. end;
  1566. procedure TThreadList<T>.Add(constref AValue: T);
  1567. begin
  1568. LockList;
  1569. try
  1570. if (Duplicates = dupAccept) or (FList.IndexOf(AValue) = -1) then
  1571. FList.Add(AValue)
  1572. else if Duplicates = dupError then
  1573. raise EArgumentException.CreateRes(@SDuplicatesNotAllowed);
  1574. finally
  1575. UnlockList;
  1576. end;
  1577. end;
  1578. procedure TThreadList<T>.Remove(constref AValue: T);
  1579. begin
  1580. LockList;
  1581. try
  1582. FList.Remove(AValue);
  1583. finally
  1584. UnlockList;
  1585. end;
  1586. end;
  1587. procedure TThreadList<T>.Clear;
  1588. begin
  1589. LockList;
  1590. try
  1591. FList.Clear;
  1592. finally
  1593. UnlockList;
  1594. end;
  1595. end;
  1596. function TThreadList<T>.LockList: TList<T>;
  1597. begin
  1598. Result:=FList;
  1599. {$ifdef FPC_HAS_FEATURE_THREADING}
  1600. System.EnterCriticalSection(FLock);
  1601. {$endif}
  1602. end;
  1603. procedure TThreadList<T>.UnlockList;
  1604. begin
  1605. {$ifdef FPC_HAS_FEATURE_THREADING}
  1606. System.LeaveCriticalSection(FLock);
  1607. {$endif}
  1608. end;
  1609. { TQueue<T>.TPointersEnumerator }
  1610. function TQueue<T>.TPointersEnumerator.DoMoveNext: boolean;
  1611. begin
  1612. Inc(FIndex);
  1613. Result := (FQueue.FLength <> 0) and (FIndex < FQueue.FLength)
  1614. end;
  1615. function TQueue<T>.TPointersEnumerator.DoGetCurrent: PT;
  1616. begin
  1617. Result := @FQueue.FItems[FIndex];
  1618. end;
  1619. constructor TQueue<T>.TPointersEnumerator.Create(AQueue: TQueue<T>);
  1620. begin
  1621. inherited Create;
  1622. FIndex := Pred(AQueue.FLow);
  1623. FQueue := AQueue;
  1624. end;
  1625. { TQueue<T>.TEnumerator }
  1626. constructor TQueue<T>.TEnumerator.Create(AQueue: TQueue<T>);
  1627. begin
  1628. inherited Create(AQueue);
  1629. FIndex := Pred(AQueue.FLow);
  1630. end;
  1631. { TQueue<T> }
  1632. function TQueue<T>.GetPtrEnumerator: TEnumerator<PT>;
  1633. begin
  1634. Result := TPointersenumerator.Create(Self);
  1635. end;
  1636. function TQueue<T>.GetEnumerator: TEnumerator;
  1637. begin
  1638. Result := TEnumerator.Create(Self);
  1639. end;
  1640. function TQueue<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
  1641. begin
  1642. Result := GetEnumerator;
  1643. end;
  1644. function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
  1645. begin
  1646. Result := FItems[AIndex];
  1647. FItems[AIndex] := Default(T);
  1648. Notify(Result, ACollectionNotification);
  1649. FLow += 1;
  1650. if FLow = FLength then
  1651. begin
  1652. FLow := 0;
  1653. FLength := 0;
  1654. end;
  1655. end;
  1656. procedure TQueue<T>.SetCapacity(AValue: SizeInt);
  1657. begin
  1658. if AValue < Count then
  1659. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1660. if AValue = FLength then
  1661. Exit;
  1662. if (Count > 0) and (FLow > 0) then
  1663. begin
  1664. Move(FItems[FLow], FItems[0], Count * SizeOf(T));
  1665. FillChar(FItems[Count], (FLength - Count) * SizeOf(T), #0);
  1666. end;
  1667. SetLength(FItems, AValue);
  1668. FLength := Count;
  1669. FLow := 0;
  1670. end;
  1671. function TQueue<T>.GetCount: SizeInt;
  1672. begin
  1673. Result := FLength - FLow;
  1674. end;
  1675. constructor TQueue<T>.Create(ACollection: TEnumerable<T>);
  1676. var
  1677. LItem: T;
  1678. begin
  1679. for LItem in ACollection do
  1680. Enqueue(LItem);
  1681. end;
  1682. destructor TQueue<T>.Destroy;
  1683. begin
  1684. Clear;
  1685. end;
  1686. procedure TQueue<T>.Enqueue(constref AValue: T);
  1687. var
  1688. LIndex: SizeInt;
  1689. begin
  1690. LIndex := PrepareAddingItem;
  1691. FItems[LIndex] := AValue;
  1692. Notify(AValue, cnAdded);
  1693. end;
  1694. function TQueue<T>.Dequeue: T;
  1695. begin
  1696. Result := DoRemove(FLow, cnRemoved);
  1697. end;
  1698. function TQueue<T>.Extract: T;
  1699. begin
  1700. Result := DoRemove(FLow, cnExtracted);
  1701. end;
  1702. function TQueue<T>.Peek: T;
  1703. begin
  1704. if (Count = 0) then
  1705. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1706. Result := FItems[FLow];
  1707. end;
  1708. procedure TQueue<T>.Clear;
  1709. begin
  1710. while Count <> 0 do
  1711. Dequeue;
  1712. FLow := 0;
  1713. FLength := 0;
  1714. end;
  1715. procedure TQueue<T>.TrimExcess;
  1716. begin
  1717. SetCapacity(Count);
  1718. end;
  1719. { TStack<T> }
  1720. function TStack<T>.GetEnumerator: TEnumerator;
  1721. begin
  1722. Result := TEnumerator.Create(Self);
  1723. end;
  1724. function TStack<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
  1725. begin
  1726. Result := GetEnumerator;
  1727. end;
  1728. constructor TStack<T>.Create(ACollection: TEnumerable<T>);
  1729. var
  1730. LItem: T;
  1731. begin
  1732. for LItem in ACollection do
  1733. Push(LItem);
  1734. end;
  1735. constructor TStack<T>.Create(ACollection: TEnumerableWithPointers<T>);
  1736. var
  1737. LItem: PT;
  1738. begin
  1739. for LItem in ACollection.Ptr^ do
  1740. Push(LItem^);
  1741. end;
  1742. function TStack<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
  1743. begin
  1744. if AIndex < 0 then
  1745. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1746. Result := FItems[AIndex];
  1747. FItems[AIndex] := Default(T);
  1748. Dec(FLength);
  1749. Notify(Result, ACollectionNotification);
  1750. end;
  1751. destructor TStack<T>.Destroy;
  1752. begin
  1753. Clear;
  1754. end;
  1755. procedure TStack<T>.Clear;
  1756. begin
  1757. while Count <> 0 do
  1758. Pop;
  1759. end;
  1760. procedure TStack<T>.SetCapacity(AValue: SizeInt);
  1761. begin
  1762. if AValue < Count then
  1763. AValue := Count;
  1764. SetLength(FItems, AValue);
  1765. end;
  1766. procedure TStack<T>.Push(constref AValue: T);
  1767. var
  1768. LIndex: SizeInt;
  1769. begin
  1770. LIndex := PrepareAddingItem;
  1771. FItems[LIndex] := AValue;
  1772. Notify(AValue, cnAdded);
  1773. end;
  1774. function TStack<T>.Pop: T;
  1775. begin
  1776. Result := DoRemove(FLength - 1, cnRemoved);
  1777. end;
  1778. function TStack<T>.Peek: T;
  1779. begin
  1780. if (Count = 0) then
  1781. raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
  1782. Result := FItems[FLength - 1];
  1783. end;
  1784. function TStack<T>.Extract: T;
  1785. begin
  1786. Result := DoRemove(FLength - 1, cnExtracted);
  1787. end;
  1788. procedure TStack<T>.TrimExcess;
  1789. begin
  1790. SetCapacity(Count);
  1791. end;
  1792. { TObjectList<T> }
  1793. procedure TObjectList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
  1794. begin
  1795. inherited Notify(AValue, ACollectionNotification);
  1796. if FObjectsOwner and (ACollectionNotification = cnRemoved) then
  1797. TObject(AValue).Free;
  1798. end;
  1799. constructor TObjectList<T>.Create(AOwnsObjects: Boolean);
  1800. begin
  1801. inherited Create;
  1802. FObjectsOwner := AOwnsObjects;
  1803. end;
  1804. constructor TObjectList<T>.Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean);
  1805. begin
  1806. inherited Create(AComparer);
  1807. FObjectsOwner := AOwnsObjects;
  1808. end;
  1809. constructor TObjectList<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
  1810. begin
  1811. inherited Create(ACollection);
  1812. FObjectsOwner := AOwnsObjects;
  1813. end;
  1814. constructor TObjectList<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
  1815. begin
  1816. inherited Create(ACollection);
  1817. FObjectsOwner := AOwnsObjects;
  1818. end;
  1819. { TObjectQueue<T> }
  1820. procedure TObjectQueue<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
  1821. begin
  1822. inherited Notify(AValue, ACollectionNotification);
  1823. if FObjectsOwner and (ACollectionNotification = cnRemoved) then
  1824. TObject(AValue).Free;
  1825. end;
  1826. constructor TObjectQueue<T>.Create(AOwnsObjects: Boolean);
  1827. begin
  1828. inherited Create;
  1829. FObjectsOwner := AOwnsObjects;
  1830. end;
  1831. constructor TObjectQueue<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
  1832. begin
  1833. inherited Create(ACollection);
  1834. FObjectsOwner := AOwnsObjects;
  1835. end;
  1836. constructor TObjectQueue<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
  1837. begin
  1838. inherited Create(ACollection);
  1839. FObjectsOwner := AOwnsObjects;
  1840. end;
  1841. procedure TObjectQueue<T>.Dequeue;
  1842. begin
  1843. inherited Dequeue;
  1844. end;
  1845. { TObjectStack<T> }
  1846. procedure TObjectStack<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
  1847. begin
  1848. inherited Notify(AValue, ACollectionNotification);
  1849. if FObjectsOwner and (ACollectionNotification = cnRemoved) then
  1850. TObject(AValue).Free;
  1851. end;
  1852. constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
  1853. begin
  1854. inherited Create;
  1855. FObjectsOwner := AOwnsObjects;
  1856. end;
  1857. constructor TObjectStack<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
  1858. begin
  1859. inherited Create(ACollection);
  1860. FObjectsOwner := AOwnsObjects;
  1861. end;
  1862. constructor TObjectStack<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
  1863. begin
  1864. inherited Create(ACollection);
  1865. FObjectsOwner := AOwnsObjects;
  1866. end;
  1867. function TObjectStack<T>.Pop: T;
  1868. begin
  1869. Result := inherited Pop;
  1870. end;
  1871. {$I generics.dictionaries.inc}
  1872. { TCustomSet<T>.TCustomSetEnumerator }
  1873. function TCustomSet<T>.TCustomSetEnumerator.DoMoveNext: boolean;
  1874. begin
  1875. Result := FEnumerator.DoMoveNext;
  1876. end;
  1877. function TCustomSet<T>.TCustomSetEnumerator.DoGetCurrent: T;
  1878. begin
  1879. Result := FEnumerator.DoGetCurrent;
  1880. end;
  1881. destructor TCustomSet<T>.TCustomSetEnumerator.Destroy;
  1882. begin
  1883. FEnumerator.Free;
  1884. end;
  1885. { TCustomSet<T> }
  1886. function TCustomSet<T>.DoGetEnumerator: Generics.Collections.TEnumerator<T>;
  1887. begin
  1888. Result := GetEnumerator;
  1889. end;
  1890. constructor TCustomSet<T>.Create(ACollection: TEnumerable<T>);
  1891. var
  1892. i: T;
  1893. begin
  1894. Create;
  1895. for i in ACollection do
  1896. Add(i);
  1897. end;
  1898. constructor TCustomSet<T>.Create(ACollection: TEnumerableWithPointers<T>);
  1899. var
  1900. i: PT;
  1901. begin
  1902. Create;
  1903. for i in ACollection.Ptr^ do
  1904. Add(i^);
  1905. end;
  1906. function TCustomSet<T>.AddRange(constref AValues: array of T): Boolean;
  1907. var
  1908. i: T;
  1909. begin
  1910. Result := True;
  1911. for i in AValues do
  1912. Result := Add(i) and Result;
  1913. end;
  1914. function TCustomSet<T>.AddRange(const AEnumerable: IEnumerable<T>): Boolean;
  1915. var
  1916. i: T;
  1917. begin
  1918. Result := True;
  1919. for i in AEnumerable do
  1920. Result := Add(i) and Result;
  1921. end;
  1922. function TCustomSet<T>.AddRange(AEnumerable: TEnumerable<T>): Boolean;
  1923. var
  1924. i: T;
  1925. begin
  1926. Result := True;
  1927. for i in AEnumerable do
  1928. Result := Add(i) and Result;
  1929. end;
  1930. function TCustomSet<T>.AddRange(AEnumerable: TEnumerableWithPointers<T>): Boolean;
  1931. var
  1932. i: PT;
  1933. begin
  1934. Result := True;
  1935. for i in AEnumerable.Ptr^ do
  1936. Result := Add(i^) and Result;
  1937. end;
  1938. procedure TCustomSet<T>.UnionWith(AHashSet: TCustomSet<T>);
  1939. var
  1940. i: PT;
  1941. begin
  1942. for i in AHashSet.Ptr^ do
  1943. Add(i^);
  1944. end;
  1945. procedure TCustomSet<T>.IntersectWith(AHashSet: TCustomSet<T>);
  1946. var
  1947. LList: TList<PT>;
  1948. i: PT;
  1949. begin
  1950. LList := TList<PT>.Create;
  1951. for i in Ptr^ do
  1952. if not AHashSet.Contains(i^) then
  1953. LList.Add(i);
  1954. for i in LList do
  1955. Remove(i^);
  1956. LList.Free;
  1957. end;
  1958. procedure TCustomSet<T>.ExceptWith(AHashSet: TCustomSet<T>);
  1959. var
  1960. i: PT;
  1961. begin
  1962. for i in AHashSet.Ptr^ do
  1963. Remove(i^);
  1964. end;
  1965. procedure TCustomSet<T>.SymmetricExceptWith(AHashSet: TCustomSet<T>);
  1966. var
  1967. LList: TList<PT>;
  1968. i: PT;
  1969. begin
  1970. LList := TList<PT>.Create;
  1971. for i in AHashSet.Ptr^ do
  1972. if Contains(i^) then
  1973. LList.Add(i)
  1974. else
  1975. Add(i^);
  1976. for i in LList do
  1977. Remove(i^);
  1978. LList.Free;
  1979. end;
  1980. { THashSet<T>.THashSetEnumerator }
  1981. function THashSet<T>.THashSetEnumerator.GetCurrent: T;
  1982. begin
  1983. Result := TDictionaryEnumerator(FEnumerator).GetCurrent;
  1984. end;
  1985. constructor THashSet<T>.THashSetEnumerator.Create(ASet: TCustomSet<T>);
  1986. begin
  1987. TDictionaryEnumerator(FEnumerator) := THashSet<T>(ASet).FInternalDictionary.Keys.DoGetEnumerator;
  1988. end;
  1989. { THashSet<T>.TPointersEnumerator }
  1990. function THashSet<T>.TPointersEnumerator.DoMoveNext: boolean;
  1991. begin
  1992. Result := FEnumerator.MoveNext;
  1993. end;
  1994. function THashSet<T>.TPointersEnumerator.DoGetCurrent: PT;
  1995. begin
  1996. Result := FEnumerator.Current;
  1997. end;
  1998. constructor THashSet<T>.TPointersEnumerator.Create(AHashSet: THashSet<T>);
  1999. begin
  2000. FEnumerator := AHashSet.FInternalDictionary.Keys.Ptr^.GetEnumerator;
  2001. end;
  2002. { THashSet<T> }
  2003. function THashSet<T>.GetPtrEnumerator: TEnumerator<PT>;
  2004. begin
  2005. Result := TPointersEnumerator.Create(Self);
  2006. end;
  2007. function THashSet<T>.GetCount: SizeInt;
  2008. begin
  2009. Result := FInternalDictionary.Count;
  2010. end;
  2011. function THashSet<T>.GetEnumerator: TCustomSetEnumerator;
  2012. begin
  2013. Result := THashSetEnumerator.Create(Self);
  2014. end;
  2015. constructor THashSet<T>.Create;
  2016. begin
  2017. FInternalDictionary := TOpenAddressingLP<T, TEmptyRecord>.Create;
  2018. end;
  2019. constructor THashSet<T>.Create(const AComparer: IEqualityComparer<T>);
  2020. begin
  2021. FInternalDictionary := TOpenAddressingLP<T, TEmptyRecord>.Create(AComparer);
  2022. end;
  2023. destructor THashSet<T>.Destroy;
  2024. begin
  2025. FInternalDictionary.Free;
  2026. end;
  2027. function THashSet<T>.Add(constref AValue: T): Boolean;
  2028. begin
  2029. Result := not FInternalDictionary.ContainsKey(AValue);
  2030. if Result then
  2031. FInternalDictionary.Add(AValue, EmptyRecord);
  2032. end;
  2033. function THashSet<T>.Remove(constref AValue: T): Boolean;
  2034. var
  2035. LIndex: SizeInt;
  2036. begin
  2037. LIndex := FInternalDictionary.FindBucketIndex(AValue);
  2038. Result := LIndex >= 0;
  2039. if Result then
  2040. FInternalDictionary.DoRemove(LIndex, cnRemoved);
  2041. end;
  2042. procedure THashSet<T>.Clear;
  2043. begin
  2044. FInternalDictionary.Clear;
  2045. end;
  2046. function THashSet<T>.Contains(constref AValue: T): Boolean;
  2047. begin
  2048. Result := FInternalDictionary.ContainsKey(AValue);
  2049. end;
  2050. { TAVLTreeNode<TREE_CONSTRAINTS, TTree> }
  2051. function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.Successor: PNode;
  2052. begin
  2053. Result:=Right;
  2054. if Result<>nil then begin
  2055. while (Result.Left<>nil) do Result:=Result.Left;
  2056. end else begin
  2057. Result:=@Self;
  2058. while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
  2059. Result:=Result.Parent;
  2060. Result:=Result.Parent;
  2061. end;
  2062. end;
  2063. function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.Precessor: PNode;
  2064. begin
  2065. Result:=Left;
  2066. if Result<>nil then begin
  2067. while (Result.Right<>nil) do Result:=Result.Right;
  2068. end else begin
  2069. Result:=@Self;
  2070. while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
  2071. Result:=Result.Parent;
  2072. Result:=Result.Parent;
  2073. end;
  2074. end;
  2075. function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.TreeDepth: integer;
  2076. // longest WAY down. e.g. only one node => 0 !
  2077. var LeftDepth, RightDepth: integer;
  2078. begin
  2079. if Left<>nil then
  2080. LeftDepth:=Left.TreeDepth+1
  2081. else
  2082. LeftDepth:=0;
  2083. if Right<>nil then
  2084. RightDepth:=Right.TreeDepth+1
  2085. else
  2086. RightDepth:=0;
  2087. if LeftDepth>RightDepth then
  2088. Result:=LeftDepth
  2089. else
  2090. Result:=RightDepth;
  2091. end;
  2092. procedure TAVLTreeNode<TREE_CONSTRAINTS, TTree>.ConsistencyCheck(ATree: TObject);
  2093. var
  2094. LTree: TTree absolute ATree;
  2095. LeftDepth: SizeInt;
  2096. RightDepth: SizeInt;
  2097. begin
  2098. // test left child
  2099. if Left<>nil then begin
  2100. if Left.Parent<>@Self then
  2101. raise EAVLTree.Create('Left.Parent<>Self');
  2102. if LTree.Compare(Left.Data.Key,Data.Key)>0 then
  2103. raise EAVLTree.Create('Compare(Left.Data,Data)>0');
  2104. Left.ConsistencyCheck(LTree);
  2105. end;
  2106. // test right child
  2107. if Right<>nil then begin
  2108. if Right.Parent<>@Self then
  2109. raise EAVLTree.Create('Right.Parent<>Self');
  2110. if LTree.Compare(Data.Key,Right.Data.Key)>0 then
  2111. raise EAVLTree.Create('Compare(Data,Right.Data)>0');
  2112. Right.ConsistencyCheck(LTree);
  2113. end;
  2114. // test balance
  2115. if Left<>nil then
  2116. LeftDepth:=Left.TreeDepth+1
  2117. else
  2118. LeftDepth:=0;
  2119. if Right<>nil then
  2120. RightDepth:=Right.TreeDepth+1
  2121. else
  2122. RightDepth:=0;
  2123. if Balance<>(LeftDepth-RightDepth) then
  2124. raise EAVLTree.CreateFmt('Balance[%d]<>(RightDepth[%d]-LeftDepth[%d])', [Balance, RightDepth, LeftDepth]);
  2125. end;
  2126. function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.GetCount: SizeInt;
  2127. begin
  2128. Result:=1;
  2129. if Assigned(Left) then Inc(Result,Left.GetCount);
  2130. if Assigned(Right) then Inc(Result,Right.GetCount);
  2131. end;
  2132. { TCustomTreeEnumerator<T, PNode, TTree> }
  2133. function TCustomTreeEnumerator<T, PNode, TTree>.DoGetCurrent: T;
  2134. begin
  2135. Result := GetCurrent;
  2136. end;
  2137. constructor TCustomTreeEnumerator<T, PNode, TTree>.Create(ATree: TObject);
  2138. begin
  2139. TObject(FTree) := ATree;
  2140. end;
  2141. { TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, TREE_CONSTRAINTS> }
  2142. function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.GetCount: SizeInt;
  2143. begin
  2144. Result := FTree.Count;
  2145. end;
  2146. function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.GetPtrEnumerator: TEnumerator<PT>;
  2147. begin
  2148. Result := TTreePointersEnumerator.Create(FTree);
  2149. end;
  2150. constructor TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.Create(
  2151. ATree: TTree);
  2152. begin
  2153. FTree := ATree;
  2154. end;
  2155. function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.
  2156. DoGetEnumerator: TTreeEnumerator;
  2157. begin
  2158. Result := TTreeEnumerator.Create(FTree);
  2159. end;
  2160. function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.ToArray: TArray<T>;
  2161. begin
  2162. Result := ToArrayImpl(FTree.Count);
  2163. end;
  2164. { TAVLTreeEnumerator<T, PNode, TTree> }
  2165. function TAVLTreeEnumerator<T, PNode, TTree>.DoMoveNext: Boolean;
  2166. begin
  2167. if FLowToHigh then begin
  2168. if FCurrent<>nil then
  2169. FCurrent:=FCurrent.Successor
  2170. else
  2171. FCurrent:=FTree.FindLowest;
  2172. end else begin
  2173. if FCurrent<>nil then
  2174. FCurrent:=FCurrent.Precessor
  2175. else
  2176. FCurrent:=FTree.FindHighest;
  2177. end;
  2178. Result:=FCurrent<>nil;
  2179. end;
  2180. constructor TAVLTreeEnumerator<T, PNode, TTree>.Create(ATree: TObject; ALowToHigh: boolean);
  2181. begin
  2182. inherited Create(ATree);
  2183. FLowToHigh:=aLowToHigh;
  2184. end;
  2185. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPairEnumerator }
  2186. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPairEnumerator.GetCurrent: TTreePair;
  2187. begin
  2188. Result := TTreePair((@FCurrent.Data)^);
  2189. end;
  2190. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TNodeEnumerator }
  2191. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TNodeEnumerator.GetCurrent: PNode;
  2192. begin
  2193. Result := FCurrent;
  2194. end;
  2195. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TKeyEnumerator }
  2196. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
  2197. begin
  2198. Result := FCurrent.Key;
  2199. end;
  2200. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPKeyEnumerator }
  2201. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPKeyEnumerator.GetCurrent: PKey;
  2202. begin
  2203. Result := @FCurrent.Data.Key;
  2204. end;
  2205. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator }
  2206. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator.GetCurrent: TValue;
  2207. begin
  2208. Result := FCurrent.Value;
  2209. end;
  2210. { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator }
  2211. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPValueEnumerator.GetCurrent: PValue;
  2212. begin
  2213. Result := @FCurrent.Data.Value;
  2214. end;
  2215. { TCustomAVLTreeMap<TREE_CONSTRAINTS> }
  2216. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.NodeAdded(ANode: PNode);
  2217. begin
  2218. end;
  2219. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.DeletingNode(ANode: PNode; AOrigin: boolean);
  2220. begin
  2221. end;
  2222. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.DeleteNode(ANode: PNode);
  2223. begin
  2224. if ANode.Left<>nil then
  2225. DeleteNode(ANode.Left, true);
  2226. if ANode.Right<>nil then
  2227. DeleteNode(ANode.Right, true);
  2228. Dispose(ANode);
  2229. end;
  2230. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Compare(constref ALeft, ARight: TKey): Integer; inline;
  2231. begin
  2232. Result := FComparer.Compare(ALeft, ARight);
  2233. end;
  2234. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindPredecessor(ANode: PNode): PNode;
  2235. begin
  2236. if ANode <> nil then
  2237. begin
  2238. if ANode.Left <> nil then
  2239. begin
  2240. ANode := ANode.Left;
  2241. while ANode.Right <> nil do ANode := ANode.Right;
  2242. end
  2243. else
  2244. repeat
  2245. Result := ANode;
  2246. ANode := ANode.Parent;
  2247. until (ANode = nil) or (ANode.Right = Result);
  2248. end;
  2249. Result := ANode;
  2250. end;
  2251. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindInsertNode(ANode: PNode; out AInsertNode: PNode): Integer;
  2252. begin
  2253. AInsertNode := FRoot;
  2254. if AInsertNode = nil then // first item in tree
  2255. Exit(0);
  2256. repeat
  2257. Result := Compare(ANode.Key,AInsertNode.Key);
  2258. if Result < 0 then
  2259. begin
  2260. if AInsertNode.Left = nil then
  2261. Exit;
  2262. AInsertNode := AInsertNode.Left;
  2263. end
  2264. else
  2265. begin
  2266. if AInsertNode.Right = nil then
  2267. Exit;
  2268. AInsertNode := AInsertNode.Right;
  2269. if Result = 0 then
  2270. Break;
  2271. end;
  2272. until false;
  2273. // for equal items (when item already exist) we need to keep 0 result
  2274. while true do
  2275. if Compare(ANode.Key,AInsertNode.Key) < 0 then
  2276. begin
  2277. if AInsertNode.Left = nil then
  2278. Exit;
  2279. AInsertNode := AInsertNode.Left;
  2280. end
  2281. else
  2282. begin
  2283. if AInsertNode.Right = nil then
  2284. Exit;
  2285. AInsertNode := AInsertNode.Right;
  2286. end;
  2287. end;
  2288. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateRightRight(ANode: PNode);
  2289. var
  2290. LNode, LParent: PNode;
  2291. begin
  2292. LNode := ANode.Right;
  2293. LParent := ANode.Parent;
  2294. ANode.Right := LNode.Left;
  2295. if ANode.Right <> nil then
  2296. ANode.Right.Parent := ANode;
  2297. LNode.Left := ANode;
  2298. LNode.Parent := LParent;
  2299. ANode.Parent := LNode;
  2300. if LParent <> nil then
  2301. begin
  2302. if LParent.Left = ANode then
  2303. LParent.Left := LNode
  2304. else
  2305. LParent.Right := LNode;
  2306. end
  2307. else
  2308. FRoot := LNode;
  2309. if LNode.Balance = -1 then
  2310. begin
  2311. ANode.Balance := 0;
  2312. LNode.Balance := 0;
  2313. end
  2314. else
  2315. begin
  2316. ANode.Balance := -1;
  2317. LNode.Balance := 1;
  2318. end
  2319. end;
  2320. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateLeftLeft(ANode: PNode);
  2321. var
  2322. LNode, LParent: PNode;
  2323. begin
  2324. LNode := ANode.Left;
  2325. LParent := ANode.Parent;
  2326. ANode.Left := LNode.Right;
  2327. if ANode.Left <> nil then
  2328. ANode.Left.Parent := ANode;
  2329. LNode.Right := ANode;
  2330. LNode.Parent := LParent;
  2331. ANode.Parent := LNode;
  2332. if LParent <> nil then
  2333. begin
  2334. if LParent.Left = ANode then
  2335. LParent.Left := LNode
  2336. else
  2337. LParent.Right := LNode;
  2338. end
  2339. else
  2340. FRoot := LNode;
  2341. if LNode.Balance = 1 then
  2342. begin
  2343. ANode.Balance := 0;
  2344. LNode.Balance := 0;
  2345. end
  2346. else
  2347. begin
  2348. ANode.Balance := 1;
  2349. LNode.Balance := -1;
  2350. end
  2351. end;
  2352. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateRightLeft(ANode: PNode);
  2353. var
  2354. LRight, LLeft, LParent: PNode;
  2355. begin
  2356. LRight := ANode.Right;
  2357. LLeft := LRight.Left;
  2358. LParent := ANode.Parent;
  2359. LRight.Left := LLeft.Right;
  2360. if LRight.Left <> nil then
  2361. LRight.Left.Parent := LRight;
  2362. ANode.Right := LLeft.Left;
  2363. if ANode.Right <> nil then
  2364. ANode.Right.Parent := ANode;
  2365. LLeft.Left := ANode;
  2366. LLeft.Right := LRight;
  2367. ANode.Parent := LLeft;
  2368. LRight.Parent := LLeft;
  2369. LLeft.Parent := LParent;
  2370. if LParent <> nil then
  2371. begin
  2372. if LParent.Left = ANode then
  2373. LParent.Left := LLeft
  2374. else
  2375. LParent.Right := LLeft;
  2376. end
  2377. else
  2378. FRoot := LLeft;
  2379. if LLeft.Balance = -1 then
  2380. ANode.Balance := 1
  2381. else
  2382. ANode.Balance := 0;
  2383. if LLeft.Balance = 1 then
  2384. LRight.Balance := -1
  2385. else
  2386. LRight.Balance := 0;
  2387. LLeft.Balance := 0;
  2388. end;
  2389. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateLeftRight(ANode: PNode);
  2390. var
  2391. LLeft, LRight, LParent: PNode;
  2392. begin
  2393. LLeft := ANode.Left;
  2394. LRight := LLeft.Right;
  2395. LParent := ANode.Parent;
  2396. LLeft.Right := LRight.Left;
  2397. if LLeft.Right <> nil then
  2398. LLeft.Right.Parent := LLeft;
  2399. ANode.Left := LRight.Right;
  2400. if ANode.Left <> nil then
  2401. ANode.Left.Parent := ANode;
  2402. LRight.Right := ANode;
  2403. LRight.Left := LLeft;
  2404. ANode.Parent := LRight;
  2405. LLeft.Parent := LRight;
  2406. LRight.Parent := LParent;
  2407. if LParent <> nil then
  2408. begin
  2409. if LParent.Left = ANode then
  2410. LParent.Left := LRight
  2411. else
  2412. LParent.Right := LRight;
  2413. end
  2414. else
  2415. FRoot := LRight;
  2416. if LRight.Balance = 1 then
  2417. ANode.Balance := -1
  2418. else
  2419. ANode.Balance := 0;
  2420. if LRight.Balance = -1 then
  2421. LLeft.Balance := 1
  2422. else
  2423. LLeft.Balance := 0;
  2424. LRight.Balance := 0;
  2425. end;
  2426. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteStr(AStream: TStream; const AText: string);
  2427. begin
  2428. if AText='' then exit;
  2429. AStream.Write(AText[1],Length(AText));
  2430. end;
  2431. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetNodeCollection: TNodeCollection;
  2432. begin
  2433. if not Assigned(FNodes) then
  2434. FNodes := TNodeCollection.Create(TTree(Self));
  2435. Result := FNodes;
  2436. end;
  2437. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.InternalAdd(ANode, AParent: PNode);
  2438. begin
  2439. Inc(FCount);
  2440. ANode.Parent := AParent;
  2441. NodeAdded(ANode);
  2442. if AParent=nil then
  2443. begin
  2444. FRoot := ANode;
  2445. Exit;
  2446. end;
  2447. // balance after insert
  2448. if AParent.Balance<>0 then
  2449. AParent.Balance := 0
  2450. else
  2451. begin
  2452. if AParent.Left = ANode then
  2453. AParent.Balance := 1
  2454. else
  2455. AParent.Balance := -1;
  2456. ANode := AParent.Parent;
  2457. while ANode <> nil do
  2458. begin
  2459. if ANode.Balance<>0 then
  2460. begin
  2461. if ANode.Balance = 1 then
  2462. begin
  2463. if ANode.Right = AParent then
  2464. ANode.Balance := 0
  2465. else if AParent.Balance = -1 then
  2466. RotateLeftRight(ANode)
  2467. else
  2468. RotateLeftLeft(ANode);
  2469. end
  2470. else
  2471. begin
  2472. if ANode.Left = AParent then
  2473. ANode.Balance := 0
  2474. else if AParent^.Balance = 1 then
  2475. RotateRightLeft(ANode)
  2476. else
  2477. RotateRightRight(ANode);
  2478. end;
  2479. Break;
  2480. end;
  2481. if ANode.Left = AParent then
  2482. ANode.Balance := 1
  2483. else
  2484. ANode.Balance := -1;
  2485. AParent := ANode;
  2486. ANode := ANode.Parent;
  2487. end;
  2488. end;
  2489. end;
  2490. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.InternalDelete(ANode: PNode);
  2491. var
  2492. t, y, z: PNode;
  2493. LNest: boolean;
  2494. begin
  2495. if (ANode.Left <> nil) and (ANode.Right <> nil) then
  2496. begin
  2497. y := FindPredecessor(ANode);
  2498. y.Info := ANode.Info;
  2499. DeletingNode(y, false);
  2500. InternalDelete(y);
  2501. LNest := false;
  2502. end
  2503. else
  2504. begin
  2505. if ANode.Left <> nil then
  2506. begin
  2507. y := ANode.Left;
  2508. ANode.Left := nil;
  2509. end
  2510. else
  2511. begin
  2512. y := ANode.Right;
  2513. ANode.Right := nil;
  2514. end;
  2515. ANode.Balance := 0;
  2516. LNest := true;
  2517. end;
  2518. if y <> nil then
  2519. begin
  2520. y.Parent := ANode.Parent;
  2521. y.Left := ANode.Left;
  2522. if y.Left <> nil then
  2523. y.Left.Parent := y;
  2524. y.Right := ANode.Right;
  2525. if y.Right <> nil then
  2526. y.Right.Parent := y;
  2527. y.Balance := ANode.Balance;
  2528. end;
  2529. if ANode.Parent <> nil then
  2530. begin
  2531. if ANode.Parent.Left = ANode then
  2532. ANode.Parent.Left := y
  2533. else
  2534. ANode.Parent.Right := y;
  2535. end
  2536. else
  2537. FRoot := y;
  2538. if LNest then
  2539. begin
  2540. z := y;
  2541. y := ANode.Parent;
  2542. while y <> nil do
  2543. begin
  2544. if y.Balance = 0 then
  2545. begin
  2546. if y.Left = z then
  2547. y.Balance := -1
  2548. else
  2549. y.Balance := 1;
  2550. break;
  2551. end
  2552. else
  2553. begin
  2554. if ((y.Balance = 1) and (y.Left = z)) or ((y.Balance = -1) and (y.Right = z)) then
  2555. begin
  2556. y.Balance := 0;
  2557. z := y;
  2558. y := y.Parent;
  2559. end
  2560. else
  2561. begin
  2562. if y.Left = z then
  2563. t := y.Right
  2564. else
  2565. t := y.Left;
  2566. if t.Balance = 0 then
  2567. begin
  2568. if y.Balance = 1 then
  2569. RotateLeftLeft(y)
  2570. else
  2571. RotateRightRight(y);
  2572. break;
  2573. end
  2574. else if y.Balance = t.Balance then
  2575. begin
  2576. if y.Balance = 1 then
  2577. RotateLeftLeft(y)
  2578. else
  2579. RotateRightRight(y);
  2580. z := t;
  2581. y := t.Parent;
  2582. end
  2583. else
  2584. begin
  2585. if y.Balance = 1 then
  2586. RotateLeftRight(y)
  2587. else
  2588. RotateRightLeft(y);
  2589. z := y.Parent;
  2590. y := z.Parent;
  2591. end
  2592. end
  2593. end
  2594. end
  2595. end;
  2596. end;
  2597. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetKeys: TKeyCollection;
  2598. begin
  2599. if not Assigned(FKeys) then
  2600. FKeys := TKeyCollection.Create(TTree(Self));
  2601. Result := TKeyCollection(FKeys);
  2602. end;
  2603. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetValues: TValueCollection;
  2604. begin
  2605. if not Assigned(FValues) then
  2606. FValues := TValueCollection.Create(TTree(Self));
  2607. Result := TValueCollection(FValues);
  2608. end;
  2609. constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create;
  2610. begin
  2611. FComparer := TComparer<TKey>.Default;
  2612. end;
  2613. constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create(const AComparer: IComparer<TKey>);
  2614. begin
  2615. FComparer := AComparer;
  2616. end;
  2617. destructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Destroy;
  2618. begin
  2619. FNodes.Free;
  2620. Clear;
  2621. end;
  2622. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue): PNode;
  2623. var
  2624. LParent: PNode;
  2625. begin
  2626. Result := AddNode;
  2627. Result.Data.Key := AKey;
  2628. Result.Data.Value := AValue;
  2629. // insert new node
  2630. case FindInsertNode(Result, LParent) of
  2631. -1: LParent.Left := Result;
  2632. 0:
  2633. if Assigned(LParent) then
  2634. case FDuplicates of
  2635. dupAccept: LParent.Right := Result;
  2636. dupIgnore:
  2637. begin
  2638. LParent.Right := nil;
  2639. DeleteNode(Result, true);
  2640. Exit(LParent);
  2641. end;
  2642. dupError:
  2643. begin
  2644. LParent.Right := nil;
  2645. DeleteNode(Result, true);
  2646. Result := nil;
  2647. raise EListError.Create(SCollectionDuplicate);
  2648. end;
  2649. end;
  2650. 1: LParent.Right := Result;
  2651. end;
  2652. InternalAdd(Result, LParent);
  2653. end;
  2654. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Remove(constref AKey: TKey): boolean;
  2655. var
  2656. LNode: PNode;
  2657. begin
  2658. LNode:=Find(AKey);
  2659. if LNode<>nil then begin
  2660. Delete(LNode);
  2661. Result:=true;
  2662. end else
  2663. Result:=false;
  2664. end;
  2665. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Delete(ANode: PNode; ADispose: boolean);
  2666. begin
  2667. if (ANode.Left = nil) or (ANode.Right = nil) then
  2668. DeletingNode(ANode, true);
  2669. InternalDelete(ANode);
  2670. DeleteNode(ANode, ADispose);
  2671. Dec(FCount);
  2672. end;
  2673. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Clear(ADisposeNodes: Boolean);
  2674. begin
  2675. if (FRoot<>nil) and ADisposeNodes then
  2676. DeleteNode(FRoot);
  2677. fRoot:=nil;
  2678. FCount:=0;
  2679. end;
  2680. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetEnumerator: TPairEnumerator;
  2681. begin
  2682. Result := TPairEnumerator.Create(Self, true);
  2683. end;
  2684. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindLowest: PNode;
  2685. begin
  2686. Result:=FRoot;
  2687. if Result<>nil then
  2688. while Result.Left<>nil do Result:=Result.Left;
  2689. end;
  2690. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindHighest: PNode;
  2691. begin
  2692. Result:=FRoot;
  2693. if Result<>nil then
  2694. while Result.Right<>nil do Result:=Result.Right;
  2695. end;
  2696. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Find(constref AKey: TKey): PNode;
  2697. var
  2698. LComp: SizeInt;
  2699. begin
  2700. Result:=FRoot;
  2701. while (Result<>nil) do
  2702. begin
  2703. LComp:=Compare(AKey,Result.Key);
  2704. if LComp=0 then
  2705. Exit;
  2706. if LComp<0 then
  2707. Result:=Result.Left
  2708. else
  2709. Result:=Result.Right
  2710. end;
  2711. end;
  2712. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ContainsKey(constref AKey: TKey; out ANode: PNode): boolean;
  2713. begin
  2714. ANode := Find(AKey);
  2715. Result := Assigned(ANode);
  2716. end;
  2717. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ContainsKey(constref AKey: TKey): boolean; overload; inline;
  2718. begin
  2719. Result := Assigned(Find(AKey));
  2720. end;
  2721. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.ConsistencyCheck;
  2722. var
  2723. RealCount: SizeInt;
  2724. begin
  2725. RealCount:=0;
  2726. if FRoot<>nil then begin
  2727. FRoot.ConsistencyCheck(Self);
  2728. RealCount:=FRoot.GetCount;
  2729. end;
  2730. if Count<>RealCount then
  2731. raise EAVLTree.Create('Count<>RealCount');
  2732. end;
  2733. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteTreeNode(AStream: TStream; ANode: PNode);
  2734. var
  2735. b: String;
  2736. IsLeft: boolean;
  2737. LParent: PNode;
  2738. WasLeft: Boolean;
  2739. begin
  2740. if ANode=nil then exit;
  2741. WriteTreeNode(AStream, ANode.Right);
  2742. LParent:=ANode;
  2743. WasLeft:=false;
  2744. b:='';
  2745. while LParent<>nil do begin
  2746. if LParent.Parent=nil then begin
  2747. if LParent=ANode then
  2748. b:='--'+b
  2749. else
  2750. b:=' '+b;
  2751. break;
  2752. end;
  2753. IsLeft:=LParent.Parent.Left=LParent;
  2754. if LParent=ANode then begin
  2755. if IsLeft then
  2756. b:='\-'
  2757. else
  2758. b:='/-';
  2759. end else begin
  2760. if WasLeft=IsLeft then
  2761. b:=' '+b
  2762. else
  2763. b:='| '+b;
  2764. end;
  2765. WasLeft:=IsLeft;
  2766. LParent:=LParent.Parent;
  2767. end;
  2768. b:=b+NodeToReportStr(ANode)+LineEnding;
  2769. WriteStr(AStream, b);
  2770. WriteTreeNode(AStream, ANode.Left);
  2771. end;
  2772. procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteReportToStream(AStream: TStream);
  2773. begin
  2774. WriteStr(AStream, '-Start-of-AVL-Tree-------------------'+LineEnding);
  2775. WriteTreeNode(AStream, fRoot);
  2776. WriteStr(AStream, '-End-Of-AVL-Tree---------------------'+LineEnding);
  2777. end;
  2778. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.NodeToReportStr(ANode: PNode): string;
  2779. begin
  2780. Result:=Format(' Self=%p Parent=%p Balance=%d', [ANode, ANode.Parent, ANode.Balance]);
  2781. end;
  2782. function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ReportAsString: string;
  2783. var ms: TMemoryStream;
  2784. begin
  2785. Result:='';
  2786. ms:=TMemoryStream.Create;
  2787. try
  2788. WriteReportToStream(ms);
  2789. ms.Position:=0;
  2790. SetLength(Result,ms.Size);
  2791. if Result<>'' then
  2792. ms.Read(Result[1],length(Result));
  2793. finally
  2794. ms.Free;
  2795. end;
  2796. end;
  2797. { TAVLTreeMap<TKey, TValue> }
  2798. function TAVLTreeMap<TKey, TValue>.AddNode: PNode;
  2799. begin
  2800. Result := New(PNode);
  2801. Result^ := Default(TNode);
  2802. end;
  2803. procedure TAVLTreeMap<TKey, TValue>.DeleteNode(ANode: PNode; ADispose: boolean = true);
  2804. begin
  2805. if ADispose then
  2806. Dispose(ANode);
  2807. end;
  2808. { TIndexedAVLTreeMap<TKey, TValue> }
  2809. procedure TIndexedAVLTreeMap<TKey, TValue>.RotateRightRight(ANode: PNode);
  2810. var
  2811. LOldRight: PNode;
  2812. begin
  2813. LOldRight:=ANode.Right;
  2814. inherited;
  2815. Inc(LOldRight.Data.Info, (1 + ANode.Data.Info));
  2816. end;
  2817. procedure TIndexedAVLTreeMap<TKey, TValue>.RotateLeftLeft(ANode: PNode);
  2818. var
  2819. LOldLeft: PNode;
  2820. begin
  2821. LOldLeft:=ANode.Left;
  2822. inherited;
  2823. Dec(ANode.Data.Info, (1 + LOldLeft.Data.Info));
  2824. end;
  2825. procedure TIndexedAVLTreeMap<TKey, TValue>.RotateRightLeft(ANode: PNode);
  2826. var
  2827. LB, LC: PNode;
  2828. begin
  2829. LB := ANode.Right;
  2830. LC := LB.Left;
  2831. inherited;
  2832. Dec(LB.Data.Info, 1+LC.Info);
  2833. Inc(LC.Data.Info, 1+ANode.Info);
  2834. end;
  2835. procedure TIndexedAVLTreeMap<TKey, TValue>.RotateLeftRight(ANode: PNode);
  2836. var
  2837. LB, LC: PNode;
  2838. begin
  2839. LB := ANode.Left;
  2840. LC := LB.Right;
  2841. inherited;
  2842. Inc(LC.Data.Info, 1+LB.Info);
  2843. Dec(ANode.Data.Info, 1+LC.Info);
  2844. end;
  2845. procedure TIndexedAVLTreeMap<TKey, TValue>.NodeAdded(ANode: PNode);
  2846. var
  2847. LParent, LNode: PNode;
  2848. begin
  2849. FLastNode := nil;
  2850. LNode := ANode;
  2851. repeat
  2852. LParent:=LNode.Parent;
  2853. if (LParent=nil) then break;
  2854. if LParent.Left=LNode then
  2855. Inc(LParent.Data.Info);
  2856. LNode:=LParent;
  2857. until false;
  2858. end;
  2859. procedure TIndexedAVLTreeMap<TKey, TValue>.DeletingNode(ANode: PNode; AOrigin: boolean);
  2860. var
  2861. LParent: PNode;
  2862. begin
  2863. if not AOrigin then
  2864. Dec(ANode.Data.Info);
  2865. FLastNode := nil;
  2866. repeat
  2867. LParent:=ANode.Parent;
  2868. if (LParent=nil) then exit;
  2869. if LParent.Left=ANode then
  2870. Dec(LParent.Data.Info);
  2871. ANode:=LParent;
  2872. until false;
  2873. end;
  2874. function TIndexedAVLTreeMap<TKey, TValue>.AddNode: PNode;
  2875. begin
  2876. Result := PNode(New(PNode));
  2877. Result^ := Default(TNode);
  2878. end;
  2879. procedure TIndexedAVLTreeMap<TKey, TValue>.DeleteNode(ANode: PNode; ADispose: boolean = true);
  2880. begin
  2881. if ADispose then
  2882. Dispose(ANode);
  2883. end;
  2884. function TIndexedAVLTreeMap<TKey, TValue>.GetNodeAtIndex(AIndex: SizeInt): PNode;
  2885. begin
  2886. if (AIndex<0) or (AIndex>=Count) then
  2887. raise EIndexedAVLTree.CreateFmt('TIndexedAVLTree: AIndex %d out of bounds 0..%d', [AIndex, Count]);
  2888. if FLastNode<>nil then begin
  2889. if AIndex=FLastIndex then
  2890. Exit(FLastNode)
  2891. else if AIndex=FLastIndex+1 then begin
  2892. FLastIndex:=AIndex;
  2893. FLastNode:=FLastNode.Successor;
  2894. Exit(FLastNode);
  2895. end else if AIndex=FLastIndex-1 then begin
  2896. FLastIndex:=AIndex;
  2897. FLastNode:=FLastNode.Precessor;
  2898. Exit(FLastNode);
  2899. end;
  2900. end;
  2901. FLastIndex:=AIndex;
  2902. Result:=FRoot;
  2903. repeat
  2904. if Result.Info>AIndex then
  2905. Result:=Result.Left
  2906. else if Result.Info=AIndex then begin
  2907. FLastNode:=Result;
  2908. Exit;
  2909. end
  2910. else begin
  2911. Dec(AIndex, Result.Info+1);
  2912. Result:=Result.Right;
  2913. end;
  2914. until false;
  2915. end;
  2916. function TIndexedAVLTreeMap<TKey, TValue>.NodeToIndex(ANode: PNode): SizeInt;
  2917. var
  2918. LNode: PNode;
  2919. LParent: PNode;
  2920. begin
  2921. if ANode=nil then
  2922. Exit(-1);
  2923. if FLastNode=ANode then
  2924. Exit(FLastIndex);
  2925. LNode:=ANode;
  2926. Result:=LNode.Info;
  2927. repeat
  2928. LParent:=LNode.Parent;
  2929. if LParent=nil then break;
  2930. if LParent.Right=LNode then
  2931. inc(Result,LParent.Info+1);
  2932. LNode:=LParent;
  2933. until false;
  2934. FLastNode:=ANode;
  2935. FLastIndex:=Result;
  2936. end;
  2937. procedure TIndexedAVLTreeMap<TKey, TValue>.ConsistencyCheck;
  2938. var
  2939. LNode: PNode;
  2940. i: SizeInt;
  2941. LeftCount: SizeInt = 0;
  2942. begin
  2943. inherited ConsistencyCheck;
  2944. i:=0;
  2945. for LNode in Self.Nodes do
  2946. begin
  2947. if LNode.Left<>nil then
  2948. LeftCount:=LNode.Left.GetCount
  2949. else
  2950. LeftCount:=0;
  2951. if LNode.Info<>LeftCount then
  2952. raise EIndexedAVLTree.CreateFmt('LNode.LeftCount=%d<>%d',[LNode.Info,LeftCount]);
  2953. if GetNodeAtIndex(i)<>LNode then
  2954. raise EIndexedAVLTree.CreateFmt('GetNodeAtIndex(%d)<>%P',[i,LNode]);
  2955. FLastNode:=nil;
  2956. if GetNodeAtIndex(i)<>LNode then
  2957. raise EIndexedAVLTree.CreateFmt('GetNodeAtIndex(%d)<>%P',[i,LNode]);
  2958. if NodeToIndex(LNode)<>i then
  2959. raise EIndexedAVLTree.CreateFmt('NodeToIndex(%P)<>%d',[LNode,i]);
  2960. FLastNode:=nil;
  2961. if NodeToIndex(LNode)<>i then
  2962. raise EIndexedAVLTree.CreateFmt('NodeToIndex(%P)<>%d',[LNode,i]);
  2963. inc(i);
  2964. end;
  2965. end;
  2966. function TIndexedAVLTreeMap<TKey, TValue>.NodeToReportStr(ANode: PNode): string;
  2967. begin
  2968. Result:=Format(' Self=%p Parent=%p Balance=%d Idx=%d Info=%d',
  2969. [ANode,ANode.Parent, ANode.Balance, NodeToIndex(ANode), ANode.Info]);
  2970. end;
  2971. { TAVLTree<T> }
  2972. function TAVLTree<T>.Add(constref AValue: T): PNode;
  2973. begin
  2974. Result := inherited Add(AValue, EmptyRecord);
  2975. end;
  2976. { TIndexedAVLTree<T> }
  2977. function TIndexedAVLTree<T>.Add(constref AValue: T): PNode;
  2978. begin
  2979. Result := inherited Add(AValue, EmptyRecord);
  2980. end;
  2981. { TSortedSet<T>.TSortedSetEnumerator }
  2982. function TSortedSet<T>.TSortedSetEnumerator.GetCurrent: T;
  2983. begin
  2984. Result := TTreeEnumerator(FEnumerator).GetCurrent;
  2985. end;
  2986. constructor TSortedSet<T>.TSortedSetEnumerator.Create(ASet: TCustomSet<T>);
  2987. begin
  2988. TTreeEnumerator(FEnumerator) := TSortedSet<T>(ASet).FInternalTree.Keys.DoGetEnumerator;
  2989. end;
  2990. { TSortedSet<T>.TPointersEnumerator }
  2991. function TSortedSet<T>.TPointersEnumerator.DoMoveNext: boolean;
  2992. begin
  2993. Result := FEnumerator.MoveNext;
  2994. end;
  2995. function TSortedSet<T>.TPointersEnumerator.DoGetCurrent: PT;
  2996. begin
  2997. Result := FEnumerator.Current;
  2998. end;
  2999. constructor TSortedSet<T>.TPointersEnumerator.Create(ASortedSet: TSortedSet<T>);
  3000. begin
  3001. FEnumerator := ASortedSet.FInternalTree.Keys.Ptr^.GetEnumerator;
  3002. end;
  3003. { TSortedSet<T> }
  3004. function TSortedSet<T>.GetPtrEnumerator: TEnumerator<PT>;
  3005. begin
  3006. Result := TPointersEnumerator.Create(Self);
  3007. end;
  3008. function TSortedSet<T>.GetCount: SizeInt;
  3009. begin
  3010. Result := FInternalTree.Count;
  3011. end;
  3012. function TSortedSet<T>.GetEnumerator: TCustomSetEnumerator;
  3013. begin
  3014. Result := TSortedSetEnumerator.Create(Self);
  3015. end;
  3016. constructor TSortedSet<T>.Create;
  3017. begin
  3018. FInternalTree := TAVLTree<T>.Create;
  3019. end;
  3020. constructor TSortedSet<T>.Create(const AComparer: IComparer<T>);
  3021. begin
  3022. FInternalTree := TAVLTree<T>.Create(AComparer);
  3023. end;
  3024. destructor TSortedSet<T>.Destroy;
  3025. begin
  3026. FInternalTree.Free;
  3027. end;
  3028. function TSortedSet<T>.Add(constref AValue: T): Boolean;
  3029. var
  3030. LNodePtr, LParent: TAVLTree<T>.PNode;
  3031. LNode: TAVLTree<T>.TNode;
  3032. LCompare: Integer;
  3033. begin
  3034. LNode.Data.Key := AValue;
  3035. LCompare := FInternalTree.FindInsertNode(@LNode, LParent);
  3036. Result := not((LCompare=0) and Assigned(LParent));
  3037. if not Result then
  3038. Exit;
  3039. LNodePtr := FInternalTree.AddNode;
  3040. LNodePtr^.Data.Key := AValue;
  3041. case LCompare of
  3042. -1: LParent.Left := LNodePtr;
  3043. 1: LParent.Right := LNodePtr;
  3044. end;
  3045. FInternalTree.InternalAdd(LNodePtr, LParent);
  3046. end;
  3047. function TSortedSet<T>.Remove(constref AValue: T): Boolean;
  3048. var
  3049. LNode: TAVLTree<T>.PNode;
  3050. begin
  3051. LNode := FInternalTree.Find(AValue);
  3052. Result := Assigned(LNode);
  3053. if Result then
  3054. FInternalTree.Delete(LNode);
  3055. end;
  3056. procedure TSortedSet<T>.Clear;
  3057. begin
  3058. FInternalTree.Clear;
  3059. end;
  3060. function TSortedSet<T>.Contains(constref AValue: T): Boolean;
  3061. begin
  3062. Result := FInternalTree.ContainsKey(AValue);
  3063. end;
  3064. { TSortedHashSet<T>.TSortedHashSetEqualityComparer }
  3065. function TSortedHashSet<T>.TSortedHashSetEqualityComparer.Equals(constref ALeft, ARight: PT): Boolean;
  3066. begin
  3067. if Assigned(FComparer) then
  3068. Result := FComparer.Compare(ALeft^, ARight^) = 0
  3069. else
  3070. Result := FEqualityComparer.Equals(ALeft^, ARight^);
  3071. end;
  3072. function TSortedHashSet<T>.TSortedHashSetEqualityComparer.GetHashCode(constref AValue: PT): UInt32;
  3073. begin
  3074. Result := FEqualityComparer.GetHashCode(AValue^);
  3075. end;
  3076. constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AComparer: IComparer<T>);
  3077. begin
  3078. FComparer := AComparer;
  3079. FEqualityComparer := TEqualityComparer<T>.Default;
  3080. end;
  3081. constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AEqualityComparer: IEqualityComparer<T>);
  3082. begin
  3083. FEqualityComparer := AEqualityComparer;
  3084. end;
  3085. constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>);
  3086. begin
  3087. FComparer := AComparer;
  3088. FEqualityComparer := AEqualityComparer;
  3089. end;
  3090. { TSortedHashSet<T>.TSortedHashSetEnumerator }
  3091. function TSortedHashSet<T>.TSortedHashSetEnumerator.GetCurrent: T;
  3092. begin
  3093. Result := TTreeEnumerator(FEnumerator).Current;
  3094. end;
  3095. constructor TSortedHashSet<T>.TSortedHashSetEnumerator.Create(ASet: TCustomSet<T>);
  3096. begin
  3097. FEnumerator := TSortedHashSet<T>(ASet).FInternalTree.Keys.GetEnumerator;
  3098. end;
  3099. { TSortedHashSet<T>.TPointersEnumerator }
  3100. function TSortedHashSet<T>.TPointersEnumerator.DoMoveNext: boolean;
  3101. begin
  3102. Result := FEnumerator.MoveNext;
  3103. end;
  3104. function TSortedHashSet<T>.TPointersEnumerator.DoGetCurrent: PT;
  3105. begin
  3106. Result := FEnumerator.Current;
  3107. end;
  3108. constructor TSortedHashSet<T>.TPointersEnumerator.Create(ASortedHashSet: TSortedHashSet<T>);
  3109. begin
  3110. FEnumerator := ASortedHashSet.FInternalTree.Keys.Ptr^.GetEnumerator;
  3111. end;
  3112. { TSortedHashSet<T> }
  3113. function TSortedHashSet<T>.GetPtrEnumerator: TEnumerator<PT>;
  3114. begin
  3115. Result := TPointersEnumerator.Create(Self);
  3116. end;
  3117. function TSortedHashSet<T>.DoGetEnumerator: TEnumerator<T>;
  3118. begin
  3119. Result := GetEnumerator;
  3120. end;
  3121. function TSortedHashSet<T>.GetCount: SizeInt;
  3122. begin
  3123. Result := FInternalDictionary.Count;
  3124. end;
  3125. function TSortedHashSet<T>.GetEnumerator: TCustomSetEnumerator;
  3126. begin
  3127. Result := TSortedHashSetEnumerator.Create(Self);
  3128. end;
  3129. function TSortedHashSet<T>.Add(constref AValue: T): Boolean;
  3130. var
  3131. LNode: TAVLTree<T>.PNode;
  3132. begin
  3133. Result := not FInternalDictionary.ContainsKey(@AValue);
  3134. if Result then
  3135. begin
  3136. LNode := FInternalTree.Add(AValue);
  3137. FInternalDictionary.Add(@LNode.Data.Key, EmptyRecord);
  3138. end;
  3139. end;
  3140. function TSortedHashSet<T>.Remove(constref AValue: T): Boolean;
  3141. var
  3142. LIndex: SizeInt;
  3143. begin
  3144. LIndex := FInternalDictionary.FindBucketIndex(@AValue);
  3145. Result := LIndex >= 0;
  3146. if Result then
  3147. begin
  3148. FInternalDictionary.DoRemove(LIndex, cnRemoved);
  3149. FInternalTree.Remove(AValue);
  3150. end;
  3151. end;
  3152. procedure TSortedHashSet<T>.Clear;
  3153. begin
  3154. FInternalDictionary.Clear;
  3155. FInternalTree.Clear;
  3156. end;
  3157. function TSortedHashSet<T>.Contains(constref AValue: T): Boolean;
  3158. begin
  3159. Result := FInternalDictionary.ContainsKey(@AValue);
  3160. end;
  3161. constructor TSortedHashSet<T>.Create;
  3162. begin
  3163. FInternalTree := TAVLTree<T>.Create;
  3164. FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(TEqualityComparer<T>.Default));
  3165. end;
  3166. constructor TSortedHashSet<T>.Create(const AComparer: IEqualityComparer<T>);
  3167. begin
  3168. Create(TComparer<T>.Default, AComparer);
  3169. end;
  3170. constructor TSortedHashSet<T>.Create(const AComparer: IComparer<T>);
  3171. begin
  3172. FInternalTree := TAVLTree<T>.Create(AComparer);
  3173. FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(AComparer));
  3174. end;
  3175. constructor TSortedHashSet<T>.Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>);
  3176. begin
  3177. FInternalTree := TAVLTree<T>.Create(AComparer);
  3178. FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(AComparer,AEqualityComparer));
  3179. end;
  3180. destructor TSortedHashSet<T>.Destroy;
  3181. begin
  3182. FInternalDictionary.Free;
  3183. FInternalTree.Free;
  3184. inherited;
  3185. end;
  3186. end.