generics.collections.pas 107 KB

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