1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2014 by Maciej Izak (hnb)
- member of the Free Sparta development team (http://freesparta.com)
- Copyright(c) 2004-2014 DaThoX
- It contains the Free Pascal generics library
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- Acknowledgment
- Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
- many new types and major refactoring of entire library
- Thanks to mORMot (http://synopse.info) project for the best implementations
- of hashing functions like crc32c and xxHash32 :)
- **********************************************************************}
- unit Generics.Collections;
- {$MODE DELPHI}{$H+}
- {$MACRO ON}
- {$COPERATORS ON}
- {$DEFINE CUSTOM_DICTIONARY_CONSTRAINTS := TKey, TValue, THashFactory}
- {$DEFINE OPEN_ADDRESSING_CONSTRAINTS := TKey, TValue, THashFactory, TProbeSequence}
- {$DEFINE CUCKOO_CONSTRAINTS := TKey, TValue, THashFactory, TCuckooCfg}
- {$DEFINE TREE_CONSTRAINTS := TKey, TValue, TInfo}
- {$WARNINGS OFF}
- {$HINTS OFF}
- {$OVERFLOWCHECKS OFF}
- {$RANGECHECKS OFF}
- interface
- uses
- RtlConsts, Classes, SysUtils, Generics.MemoryExpanders, Generics.Defaults,
- Generics.Helpers, Generics.Strings;
- { FPC BUGS related to Generics.* (54 bugs, 19 fixed)
- REGRESSION: 26483, 26481
- FIXED REGRESSION: 26480, 26482
- CRITICAL: 24848(!!!), 24872(!), 25607(!), 26030, 25917, 25918, 25620, 24283, 24254, 24287 (Related to? 24872)
- IMPORTANT: 23862(!), 24097, 24285, 24286 (Similar to? 24285), 24098, 24609 (RTL inconsistency), 24534,
- 25606, 25614, 26177, 26195
- OTHER: 26484, 24073, 24463, 25593, 25596, 25597, 25602, 26181 (or MYBAD?)
- CLOSED BUT IMO STILL TO FIX: 25601(!), 25594
- FIXED: 25610(!), 24064, 24071, 24282, 24458, 24867, 24871, 25604, 25600, 25605, 25598, 25603, 25929, 26176, 26180,
- 26193, 24072
- MYBAD: 24963, 25599
- }
- { LAZARUS BUGS related to Generics.* (7 bugs, 0 fixed)
- CRITICAL: 25613
- OTHER: 25595, 25612, 25615, 25617, 25618, 25619
- }
- {.$define EXTRA_WARNINGS}
- type
- EAVLTree = class(Exception);
- EIndexedAVLTree = class(EAVLTree);
- TDuplicates = Classes.TDuplicates;
- {$ifdef VER3_0_0}
- TArray<T> = array of T;
- {$endif}
- // bug #24254 workaround
- // should be TArray = record class procedure Sort<T>(...) etc.
- TBinarySearchResult = record
- FoundIndex, CandidateIndex: SizeInt;
- CompareResult: SizeInt;
- end;
- TCustomArrayHelper<T> = class abstract
- private
- type
- // bug #24282
- TComparerBugHack = TComparer<T>;
- protected
- // modified QuickSort from classes\lists.inc
- class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>);
- virtual; abstract;
- public
- class procedure Sort(var AValues: array of T); overload;
- class procedure Sort(var AValues: array of T;
- const AComparer: IComparer<T>); overload;
- class procedure Sort(var AValues: array of T;
- const AComparer: IComparer<T>; AIndex, ACount: SizeInt); overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt): Boolean; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>): Boolean; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult): Boolean; overload;
- end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TCustomArray (bug #24254)
- TArrayHelper<T> = class(TCustomArrayHelper<T>)
- protected
- // modified QuickSort from classes\lists.inc
- class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>); override;
- public
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean; override; overload;
- class function BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean; override; overload;
- end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TArray (bug #24254)
- TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
- TCollectionNotifyEvent<T> = procedure(ASender: TObject; constref AItem: T; AAction: TCollectionNotification)
- of object;
- { TEnumerator }
- TEnumerator<T> = class abstract
- protected
- function DoGetCurrent: T; virtual; abstract;
- function DoMoveNext: boolean; virtual; abstract;
- public
- property Current: T read DoGetCurrent;
- function MoveNext: boolean;
- end;
- { TEnumerable }
- TEnumerable<T> = class abstract
- public type
- PT = ^T;
- protected // no forward generics declarations (needed by TPointersCollection<T, PT>), this should be moved into TEnumerableWithPointers
- function GetPtrEnumerator: TEnumerator<PT>; virtual; abstract;
- protected
- function ToArrayImpl(ACount: SizeInt): TArray<T>; overload; // used by descendants
- protected
- function DoGetEnumerator: TEnumerator<T>; virtual; abstract;
- public
- function GetEnumerator: TEnumerator<T>; inline;
- function ToArray: TArray<T>; virtual; overload;
- end;
- // error: no memory left for TCustomPointersEnumerator<PT> version
- TCustomPointersEnumerator<T, PT> = class abstract(TEnumerator<PT>);
- TCustomPointersCollection<T, PT> = object
- strict private type
- TLocalEnumerable = TEnumerable<T>; // compiler has bug for directly usage of TEnumerable<T>
- protected
- function Enumerable: TLocalEnumerable; inline;
- public
- function GetEnumerator: TEnumerator<PT>;
- end;
- TEnumerableWithPointers<T> = class(TEnumerable<T>)
- strict private type
- TPointersCollection = TCustomPointersCollection<T, PT>;
- PPointersCollection = ^TPointersCollection;
- private
- function GetPtr: PPointersCollection; inline;
- public
- property Ptr: PPointersCollection read GetPtr;
- end;
- // More info: http://stackoverflow.com/questions/5232198/about-vectors-growth
- // TODO: custom memory managers (as constraints)
- {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result + Result div 2} // ~approximation to golden ratio: n = n * 1.5 }
- // {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result * 2} // standard inc
- TCustomList<T> = class abstract(TEnumerableWithPointers<T>)
- public type
- PT = ^T;
- protected
- type // bug #24282
- TArrayHelperBugHack = TArrayHelper<T>;
- private
- FOnNotify: TCollectionNotifyEvent<T>;
- function GetCapacity: SizeInt; inline;
- protected
- FLength: SizeInt;
- FItems: array of T;
- function PrepareAddingItem: SizeInt; virtual;
- function PrepareAddingRange(ACount: SizeInt): SizeInt; virtual;
- procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); virtual;
- function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; virtual;
- procedure SetCapacity(AValue: SizeInt); virtual; abstract;
- function GetCount: SizeInt; virtual;
- public
- function ToArray: TArray<T>; override; final;
- property Count: SizeInt read GetCount;
- property Capacity: SizeInt read GetCapacity write SetCapacity;
- property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
- end;
- TCustomListEnumerator<T> = class abstract(TEnumerator<T>)
- private
- FList: TCustomList<T>;
- FIndex: SizeInt;
- protected
- function DoMoveNext: boolean; override;
- function DoGetCurrent: T; override;
- function GetCurrent: T; virtual;
- public
- constructor Create(AList: TCustomList<T>);
- end;
- TCustomListWithPointers<T> = class(TCustomList<T>)
- public type
- TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
- protected
- FList: TCustomListWithPointers<T>;
- FIndex: SizeInt;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: PT; override;
- public
- constructor Create(AList: TCustomListWithPointers<T>);
- end;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- end;
- TList<T> = class(TCustomListWithPointers<T>)
- private var
- FComparer: IComparer<T>;
- protected
- // bug #24287 - workaround for generics type name conflict (Identifier not found)
- // next bug workaround - for another error related to previous workaround
- // change order (method must be declared before TEnumerator declaration)
- function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
- public
- // with this type declaration i found #24285, #24285
- type
- // bug workaround
- TEnumerator = class(TCustomListEnumerator<T>);
- function GetEnumerator: TEnumerator; reintroduce;
- protected
- procedure SetCapacity(AValue: SizeInt); override;
- procedure SetCount(AValue: SizeInt);
- procedure InitializeList; virtual;
- procedure InternalInsert(AIndex: SizeInt; constref AValue: T);
- private
- function GetItem(AIndex: SizeInt): T;
- procedure SetItem(AIndex: SizeInt; const AValue: T);
- public
- constructor Create; overload;
- constructor Create(const AComparer: IComparer<T>); overload;
- constructor Create(ACollection: TEnumerable<T>); overload;
- destructor Destroy; override;
- function Add(constref AValue: T): SizeInt; virtual;
- procedure AddRange(constref AValues: array of T); virtual; overload;
- procedure AddRange(const AEnumerable: IEnumerable<T>); overload;
- procedure AddRange(AEnumerable: TEnumerable<T>); overload;
- procedure AddRange(AEnumerable: TEnumerableWithPointers<T>); overload;
- procedure Insert(AIndex: SizeInt; constref AValue: T); virtual;
- procedure InsertRange(AIndex: SizeInt; constref AValues: array of T); virtual; overload;
- procedure InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>); overload;
- procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>); overload;
- procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerableWithPointers<T>); overload;
- function Remove(constref AValue: T): SizeInt;
- procedure Delete(AIndex: SizeInt); inline;
- procedure DeleteRange(AIndex, ACount: SizeInt);
- function ExtractIndex(const AIndex: SizeInt): T; overload;
- function Extract(constref AValue: T): T; overload;
- procedure Exchange(AIndex1, AIndex2: SizeInt); virtual;
- procedure Move(AIndex, ANewIndex: SizeInt); virtual;
- function First: T; inline;
- function Last: T; inline;
- procedure Clear;
- function Contains(constref AValue: T): Boolean; inline;
- function IndexOf(constref AValue: T): SizeInt; virtual;
- function LastIndexOf(constref AValue: T): SizeInt; virtual;
- procedure Reverse;
- procedure TrimExcess;
- procedure Sort; overload;
- procedure Sort(const AComparer: IComparer<T>); overload;
- function BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean; overload;
- function BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
- property Count: SizeInt read FLength write SetCount;
- property Items[Index: SizeInt]: T read GetItem write SetItem; default;
- end;
- TCollectionSortStyle = (cssNone,cssUser,cssAuto);
- TCollectionSortStyles = Set of TCollectionSortStyle;
- TSortedList<T> = class(TList<T>)
- private
- FDuplicates: TDuplicates;
- FSortStyle: TCollectionSortStyle;
- function GetSorted: boolean;
- procedure SetSorted(AValue: boolean);
- procedure SetSortStyle(AValue: TCollectionSortStyle);
- protected
- procedure InitializeList; override;
- public
- function Add(constref AValue: T): SizeInt; override; overload;
- procedure AddRange(constref AValues: array of T); override; overload;
- procedure Insert(AIndex: SizeInt; constref AValue: T); override;
- procedure Exchange(AIndex1, AIndex2: SizeInt); override;
- procedure Move(AIndex, ANewIndex: SizeInt); override;
- procedure InsertRange(AIndex: SizeInt; constref AValues: array of T); override; overload;
- property Duplicates: TDuplicates read FDuplicates write FDuplicates;
- property Sorted: Boolean read GetSorted write SetSorted;
- property SortStyle: TCollectionSortStyle read FSortStyle write SetSortStyle;
- function ConsistencyCheck(ARaiseException: boolean = true): boolean; virtual;
- end;
- TThreadList<T> = class
- private
- FList: TList<T>;
- FDuplicates: TDuplicates;
- FLock: TRTLCriticalSection;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Add(constref AValue: T);
- procedure Remove(constref AValue: T);
- procedure Clear;
- function LockList: TList<T>;
- procedure UnlockList; inline;
- property Duplicates: TDuplicates read FDuplicates write FDuplicates;
- end;
- TQueue<T> = class(TCustomList<T>)
- public type
- TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
- protected
- FQueue: TQueue<T>;
- FIndex: SizeInt;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: PT; override;
- public
- constructor Create(AQueue: TQueue<T>);
- end;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- protected
- // bug #24287 - workaround for generics type name conflict (Identifier not found)
- // next bug workaround - for another error related to previous workaround
- // change order (function must be declared before TEnumerator declaration}
- function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
- public
- type
- TEnumerator = class(TCustomListEnumerator<T>)
- public
- constructor Create(AQueue: TQueue<T>);
- end;
- function GetEnumerator: TEnumerator; reintroduce;
- private
- FLow: SizeInt;
- protected
- procedure SetCapacity(AValue: SizeInt); override;
- function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
- function GetCount: SizeInt; override;
- public
- constructor Create(ACollection: TEnumerable<T>); overload;
- destructor Destroy; override;
- procedure Enqueue(constref AValue: T);
- function Dequeue: T;
- function Extract: T;
- function Peek: T;
- procedure Clear;
- procedure TrimExcess;
- end;
- TStack<T> = class(TCustomListWithPointers<T>)
- protected
- // bug #24287 - workaround for generics type name conflict (Identifier not found)
- // next bug workaround - for another error related to previous workaround
- // change order (function must be declared before TEnumerator declaration}
- function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
- public
- type
- TEnumerator = class(TCustomListEnumerator<T>);
- function GetEnumerator: TEnumerator; reintroduce;
- protected
- function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
- procedure SetCapacity(AValue: SizeInt); override;
- public
- constructor Create(ACollection: TEnumerable<T>); overload;
- constructor Create(ACollection: TEnumerableWithPointers<T>); overload;
- destructor Destroy; override;
- procedure Clear;
- procedure Push(constref AValue: T);
- function Pop: T; inline;
- function Peek: T;
- function Extract: T; inline;
- procedure TrimExcess;
- end;
- TObjectList<T: class> = class(TList<T>)
- private
- FObjectsOwner: Boolean;
- protected
- procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
- public
- constructor Create(AOwnsObjects: Boolean = True); overload;
- constructor Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
- property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
- end;
- TObjectQueue<T: class> = class(TQueue<T>)
- private
- FObjectsOwner: Boolean;
- protected
- procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
- public
- constructor Create(AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
- procedure Dequeue;
- property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
- end;
- TObjectStack<T: class> = class(TStack<T>)
- private
- FObjectsOwner: Boolean;
- protected
- procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
- public
- constructor Create(AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
- constructor Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean = True); overload;
- function Pop: T;
- property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
- end;
- PObject = ^TObject;
- {$I generics.dictionariesh.inc}
- { TCustomHashSet<T> }
- TCustomSet<T> = class(TEnumerableWithPointers<T>)
- public type
- PT = ^T;
- protected type
- TCustomSetEnumerator = class(TEnumerator<T>)
- protected var
- FEnumerator: TEnumerator<T>;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: T; override;
- function GetCurrent: T; virtual; abstract;
- public
- constructor Create(ASet: TCustomSet<T>); virtual; abstract;
- destructor Destroy; override;
- end;
- protected
- function DoGetEnumerator: TEnumerator<T>; override;
- function GetCount: SizeInt; virtual; abstract;
- public
- constructor Create; virtual; abstract; overload;
- constructor Create(ACollection: TEnumerable<T>); overload;
- constructor Create(ACollection: TEnumerableWithPointers<T>); overload;
- function GetEnumerator: TCustomSetEnumerator; reintroduce; virtual; abstract;
- function Add(constref AValue: T): Boolean; virtual; abstract;
- function Remove(constref AValue: T): Boolean; virtual; abstract;
- procedure Clear; virtual; abstract;
- function Contains(constref AValue: T): Boolean; virtual; abstract;
- function AddRange(constref AValues: array of T): Boolean; overload;
- function AddRange(const AEnumerable: IEnumerable<T>): Boolean; overload;
- function AddRange(AEnumerable: TEnumerable<T>): Boolean; overload;
- function AddRange(AEnumerable: TEnumerableWithPointers<T>): Boolean; overload;
- procedure UnionWith(AHashSet: TCustomSet<T>);
- procedure IntersectWith(AHashSet: TCustomSet<T>);
- procedure ExceptWith(AHashSet: TCustomSet<T>);
- procedure SymmetricExceptWith(AHashSet: TCustomSet<T>);
- property Count: SizeInt read GetCount;
- end;
- { THashSet<T> }
- THashSet<T> = class(TCustomSet<T>)
- protected
- FInternalDictionary: TOpenAddressingLP<T, TEmptyRecord>;
- public type
- THashSetEnumerator = class(TCustomSetEnumerator)
- protected type
- TDictionaryEnumerator = TDictionary<T, TEmptyRecord>.TKeyEnumerator;
- function GetCurrent: T; override;
- public
- constructor Create(ASet: TCustomSet<T>); override;
- end;
- TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
- protected
- FEnumerator: TEnumerator<PT>;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: PT; override;
- public
- constructor Create(AHashSet: THashSet<T>);
- end;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- function GetCount: SizeInt; override;
- public
- constructor Create; override; overload;
- constructor Create(const AComparer: IEqualityComparer<T>); virtual; overload;
- destructor Destroy; override;
- function GetEnumerator: TCustomSetEnumerator; override;
- function Add(constref AValue: T): Boolean; override;
- function Remove(constref AValue: T): Boolean; override;
- procedure Clear; override;
- function Contains(constref AValue: T): Boolean; override;
- end;
- TPair<TKey, TValue, TInfo> = record
- public
- Key: TKey;
- Value: TValue;
- private
- Info: TInfo;
- end;
- TAVLTreeNode<TREE_CONSTRAINTS, TTree> = record
- private type
- TNodePair = TPair<TREE_CONSTRAINTS>;
- public type
- PNode = ^TAVLTreeNode<TREE_CONSTRAINTS, TTree>;
- public
- Parent, Left, Right: PNode;
- Balance: Integer;
- Data: TNodePair;
- function Successor: PNode;
- function Precessor: PNode;
- function TreeDepth: integer;
- procedure ConsistencyCheck(ATree: TObject); // workaround for internal error 2012101001 (no generic forward declarations)
- function GetCount: SizeInt;
- property Key: TKey read Data.Key write Data.Key;
- property Value: TValue read Data.Value write Data.Value;
- property Info: TInfo read Data.Info write Data.Info;
- end;
- TCustomTreeEnumerator<T, PNode, TTree> = class abstract(TEnumerator<T>)
- protected
- FCurrent: PNode;
- FTree: TTree;
- function DoGetCurrent: T; override;
- function GetCurrent: T; virtual; abstract;
- public
- constructor Create(ATree: TObject);
- property Current: T read GetCurrent;
- end;
- TCustomTree<TREE_CONSTRAINTS> = class
- end;
- TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator,
- T, PT, PNode, TTree> = class abstract(TEnumerableWithPointers<T>)
- private
- FTree: TTree;
- function GetCount: SizeInt; inline;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- function DoGetEnumerator: TTreeEnumerator; override;
- public
- constructor Create(ATree: TTree);
- function ToArray: TArray<T>; override; final;
- property Count: SizeInt read GetCount;
- end;
- TAVLTreeEnumerator<T, PNode, TTree> = class(TCustomTreeEnumerator<T, PNode, TTree>)
- protected
- FLowToHigh: boolean;
- function DoMoveNext: Boolean; override;
- public
- constructor Create(ATree: TObject; ALowToHigh: boolean = true);
- property LowToHigh: boolean read FLowToHigh;
- end;
- TCustomAVLTreeMap<TREE_CONSTRAINTS> = class
- private type
- TTree = class(TCustomAVLTreeMap<TREE_CONSTRAINTS>);
- public type
- TNode = TAVLTreeNode<TREE_CONSTRAINTS, TTree>;
- PNode = ^TNode;
- TTreePair = TPair<TKey, TValue>;
- PKey = ^TKey;
- PValue = ^TValue;
- private type
- PPNode = ^PNode;
- // type exist only for generic constraint in TNodeCollection (non functional - PPNode has no sense)
- TPNodeEnumerator = class(TAVLTreeEnumerator<PPNode, PNode, TTree>);
- private var
- FDuplicates: TDuplicates;
- FComparer: IComparer<TKey>;
- protected
- FCount: SizeInt;
- FRoot: PNode;
- FKeys: TEnumerable<TKey>;
- FValues: TEnumerable<TValue>;
- procedure NodeAdded(ANode: PNode); virtual;
- procedure DeletingNode(ANode: PNode; AOrigin: boolean); virtual;
- function AddNode: PNode; virtual; abstract;
- procedure DeleteNode(ANode: PNode; ADispose: boolean); overload; virtual; abstract;
- procedure DeleteNode(ANode: PNode); overload;
- function Compare(constref ALeft, ARight: TKey): Integer; inline;
- function FindPredecessor(ANode: PNode): PNode;
- function FindInsertNode(ANode: PNode; out AInsertNode: PNode): Integer;
- procedure RotateRightRight(ANode: PNode); virtual;
- procedure RotateLeftLeft(ANode: PNode); virtual;
- procedure RotateRightLeft(ANode: PNode); virtual;
- procedure RotateLeftRight(ANode: PNode); virtual;
- // for reporting
- procedure WriteStr(AStream: TStream; const AText: string);
- public type
- TPairEnumerator = class(TAVLTreeEnumerator<TTreePair, PNode, TTree>)
- protected
- function GetCurrent: TTreePair; override;
- end;
- TNodeEnumerator = class(TAVLTreeEnumerator<PNode, PNode, TTree>)
- protected
- function GetCurrent: PNode; override;
- end;
- TKeyEnumerator = class(TAVLTreeEnumerator<TKey, PNode, TTree>)
- protected
- function GetCurrent: TKey; override;
- end;
- TPKeyEnumerator = class(TAVLTreeEnumerator<PKey, PNode, TTree>)
- protected
- function GetCurrent: PKey; override;
- end;
- TValueEnumerator = class(TAVLTreeEnumerator<TValue, PNode, TTree>)
- protected
- function GetCurrent: TValue; override;
- end;
- TPValueEnumerator = class(TAVLTreeEnumerator<PValue, PNode, TTree>)
- protected
- function GetCurrent: PValue; override;
- end;
- TNodeCollection = class(TTreeEnumerable<TNodeEnumerator, TPNodeEnumerator, PNode, PPNode, PNode, TTree>)
- private
- property Ptr; // PPNode has no sense, so hide enumerator for PPNode
- end;
- TKeyCollection = class(TTreeEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, PKey, PNode, TTree>);
- TValueCollection = class(TTreeEnumerable<TValueEnumerator, TPValueEnumerator, TValue, PValue, PNode, TTree>);
- private
- FNodes: TNodeCollection;
- function GetNodeCollection: TNodeCollection;
- procedure InternalAdd(ANode, AParent: PNode);
- procedure InternalDelete(ANode: PNode);
- function GetKeys: TKeyCollection;
- function GetValues: TValueCollection;
- public
- constructor Create; virtual; overload;
- constructor Create(const AComparer: IComparer<TKey>); virtual; overload;
- destructor Destroy; override;
- function Add(constref AKey: TKey; constref AValue: TValue): PNode;
- function Remove(constref AKey: TKey): boolean;
- procedure Delete(ANode: PNode; ADispose: boolean = true);
- function GetEnumerator: TPairEnumerator;
- property Nodes: TNodeCollection read GetNodeCollection;
- procedure Clear(ADisposeNodes: Boolean = true); virtual;
- function FindLowest: PNode;
- function FindHighest: PNode;
- property Count: SizeInt read FCount;
- property Root: PNode read FRoot;
- function Find(constref AKey: TKey): PNode;
- function ContainsKey(constref AKey: TKey; out ANode: PNode): boolean; overload; inline;
- function ContainsKey(constref AKey: TKey): boolean; overload; inline;
- procedure ConsistencyCheck; virtual;
- procedure WriteTreeNode(AStream: TStream; ANode: PNode);
- procedure WriteReportToStream(AStream: TStream);
- function NodeToReportStr(ANode: PNode): string; virtual;
- function ReportAsString: string;
- property Keys: TKeyCollection read GetKeys;
- property Values: TValueCollection read GetValues;
- property Duplicates: TDuplicates read FDuplicates write FDuplicates;
- end;
- TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
- protected
- function AddNode: PNode; override;
- procedure DeleteNode(ANode: PNode; ADispose: boolean = true); override;
- end;
- TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
- protected
- FLastNode: PNode;
- FLastIndex: SizeInt;
- procedure RotateRightRight(ANode: PNode); override;
- procedure RotateLeftLeft(ANode: PNode); override;
- procedure RotateRightLeft(ANode: PNode); override;
- procedure RotateLeftRight(ANode: PNode); override;
- procedure NodeAdded(ANode: PNode); override;
- procedure DeletingNode(ANode: PNode; AOrigin: boolean); override;
- function AddNode: PNode; override;
- procedure DeleteNode(ANode: PNode; ADispose: boolean = true); override;
- public
- function GetNodeAtIndex(AIndex: SizeInt): PNode;
- function NodeToIndex(ANode: PNode): SizeInt;
- procedure ConsistencyCheck; override;
- function NodeToReportStr(ANode: PNode): string; override;
- end;
- TAVLTree<T> = class(TAVLTreeMap<T, TEmptyRecord>)
- public type
- TItemEnumerator = TKeyEnumerator;
- public
- function Add(constref AValue: T): PNode; reintroduce;
- end;
- TIndexedAVLTree<T> = class(TIndexedAVLTreeMap<T, TEmptyRecord>)
- public type
- TItemEnumerator = TKeyEnumerator;
- public
- function Add(constref AValue: T): PNode; reintroduce;
- end;
- TSortedSet<T> = class(TCustomSet<T>)
- protected
- FInternalTree: TAVLTree<T>;
- public type
- TSortedSetEnumerator = class(TCustomSetEnumerator)
- protected type
- TTreeEnumerator = TAVLTree<T>.TItemEnumerator;
- function GetCurrent: T; override;
- public
- constructor Create(ASet: TCustomSet<T>); override;
- end;
- TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
- protected
- FEnumerator: TEnumerator<PT>;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: PT; override;
- public
- constructor Create(ASortedSet: TSortedSet<T>);
- end;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- function GetCount: SizeInt; override;
- public
- constructor Create; override; overload;
- constructor Create(const AComparer: IComparer<T>); virtual; overload;
- destructor Destroy; override;
- function GetEnumerator: TCustomSetEnumerator; override;
- function Add(constref AValue: T): Boolean; override;
- function Remove(constref AValue: T): Boolean; override;
- procedure Clear; override;
- function Contains(constref AValue: T): Boolean; override;
- end;
- TSortedHashSet<T> = class(TCustomSet<T>)
- protected
- FInternalDictionary: TOpenAddressingLP<PT, TEmptyRecord>;
- FInternalTree: TAVLTree<T>;
- function DoGetEnumerator: TEnumerator<T>; override;
- function GetCount: SizeInt; override;
- protected type
- TSortedHashSetEqualityComparer = class(TInterfacedObject, IEqualityComparer<PT>)
- private
- FComparer: IComparer<T>;
- FEqualityComparer: IEqualityComparer<T>;
- function Equals(constref ALeft, ARight: PT): Boolean;
- function GetHashCode(constref AValue: PT): UInt32;
- public
- constructor Create(const AComparer: IComparer<T>); overload;
- constructor Create(const AEqualityComparer: IEqualityComparer<T>); overload;
- constructor Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>); overload;
- end;
- public type
- TSortedHashSetEnumerator = class(TCustomSetEnumerator)
- protected type
- TTreeEnumerator = TAVLTree<T>.TItemEnumerator;
- function GetCurrent: T; override;
- public
- constructor Create(ASet: TCustomSet<T>); override;
- end;
- TPointersEnumerator = class(TCustomPointersEnumerator<T, PT>)
- protected
- FEnumerator: TEnumerator<PT>;
- function DoMoveNext: boolean; override;
- function DoGetCurrent: PT; override;
- public
- constructor Create(ASortedHashSet: TSortedHashSet<T>);
- end;
- protected
- function GetPtrEnumerator: TEnumerator<PT>; override;
- public
- constructor Create; override; overload;
- constructor Create(const AComparer: IEqualityComparer<T>); overload;
- constructor Create(const AComparer: IComparer<T>); overload;
- constructor Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>); overload;
- destructor Destroy; override;
- function GetEnumerator: TCustomSetEnumerator; override;
- function Add(constref AValue: T): Boolean; override;
- function Remove(constref AValue: T): Boolean; override;
- procedure Clear; override;
- function Contains(constref AValue: T): Boolean; override;
- end;
- function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
- var
- EmptyRecord: TEmptyRecord;
- implementation
- function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
- begin
- Result :=
- (ABottom < AItem) and (AItem <= ATop )
- or (ATop < ABottom) and (AItem > ABottom)
- or (ATop < ABottom ) and (AItem <= ATop );
- end;
- { TCustomArrayHelper<T> }
- class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
- begin
- Result := BinarySearch(AValues, AItem, AFoundIndex, AComparer, Low(AValues), Length(AValues));
- end;
- class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt): Boolean;
- begin
- Result := BinarySearch(AValues, AItem, AFoundIndex, TComparerBugHack.Default, Low(AValues), Length(AValues));
- end;
- class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>): Boolean;
- begin
- Result := BinarySearch(AValues, AItem, ASearchResult, AComparer, Low(AValues), Length(AValues));
- end;
- class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult): Boolean;
- begin
- Result := BinarySearch(AValues, AItem, ASearchResult, TComparerBugHack.Default, Low(AValues), Length(AValues));
- end;
- class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T);
- begin
- QuickSort(AValues, Low(AValues), High(AValues), TComparerBugHack.Default);
- end;
- class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
- const AComparer: IComparer<T>);
- begin
- QuickSort(AValues, Low(AValues), High(AValues), AComparer);
- end;
- class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
- const AComparer: IComparer<T>; AIndex, ACount: SizeInt);
- begin
- if ACount <= 1 then
- Exit;
- QuickSort(AValues, AIndex, Pred(AIndex + ACount), AComparer);
- end;
- { TArrayHelper<T> }
- class procedure TArrayHelper<T>.QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
- const AComparer: IComparer<T>);
- var
- I, J: SizeInt;
- P, Q: T;
- begin
- if ((ARight - ALeft) <= 0) or (Length(AValues) = 0) then
- Exit;
- repeat
- I := ALeft;
- J := ARight;
- P := AValues[ALeft + (ARight - ALeft) shr 1];
- repeat
- while AComparer.Compare(AValues[I], P) < 0 do
- I += 1;
- while AComparer.Compare(AValues[J], P) > 0 do
- J -= 1;
- if I <= J then
- begin
- if I <> J then
- begin
- Q := AValues[I];
- AValues[I] := AValues[J];
- AValues[J] := Q;
- end;
- I += 1;
- J -= 1;
- end;
- until I > J;
- // sort the smaller range recursively
- // sort the bigger range via the loop
- // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
- if J - ALeft < ARight - I then
- begin
- if ALeft < J then
- QuickSort(AValues, ALeft, J, AComparer);
- ALeft := I;
- end
- else
- begin
- if I < ARight then
- QuickSort(AValues, I, ARight, AComparer);
- ARight := J;
- end;
- until ALeft >= ARight;
- end;
- class function TArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out ASearchResult: TBinarySearchResult; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean;
- var
- imin, imax, imid: Int32;
- begin
- // continually narrow search until just one element remains
- imin := AIndex;
- imax := Pred(AIndex + ACount);
- // http://en.wikipedia.org/wiki/Binary_search_algorithm
- while (imin < imax) do
- begin
- imid := imin + ((imax - imin) shr 1);
- // code must guarantee the interval is reduced at each iteration
- // assert(imid < imax);
- // note: 0 <= imin < imax implies imid will always be less than imax
- ASearchResult.CompareResult := AComparer.Compare(AValues[imid], AItem);
- // reduce the search
- if (ASearchResult.CompareResult < 0) then
- imin := imid + 1
- else
- begin
- imax := imid;
- if ASearchResult.CompareResult = 0 then
- begin
- ASearchResult.FoundIndex := imid;
- ASearchResult.CandidateIndex := imid;
- Exit(True);
- end;
- end;
- end;
- // At exit of while:
- // if A[] is empty, then imax < imin
- // otherwise imax == imin
- // deferred test for equality
- if (imax = imin) then
- begin
- ASearchResult.CompareResult := AComparer.Compare(AValues[imin], AItem);
- ASearchResult.CandidateIndex := imin;
- if (ASearchResult.CompareResult = 0) then
- begin
- ASearchResult.FoundIndex := imin;
- Exit(True);
- end else
- begin
- ASearchResult.FoundIndex := -1;
- Exit(False);
- end;
- end
- else
- begin
- ASearchResult.CompareResult := 0;
- ASearchResult.FoundIndex := -1;
- ASearchResult.CandidateIndex := -1;
- Exit(False);
- end;
- end;
- class function TArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
- out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
- AIndex, ACount: SizeInt): Boolean;
- var
- imin, imax, imid: Int32;
- LCompare: SizeInt;
- begin
- // continually narrow search until just one element remains
- imin := AIndex;
- imax := Pred(AIndex + ACount);
- // http://en.wikipedia.org/wiki/Binary_search_algorithm
- while (imin < imax) do
- begin
- imid := imin + ((imax - imin) shr 1);
- // code must guarantee the interval is reduced at each iteration
- // assert(imid < imax);
- // note: 0 <= imin < imax implies imid will always be less than imax
- LCompare := AComparer.Compare(AValues[imid], AItem);
- // reduce the search
- if (LCompare < 0) then
- imin := imid + 1
- else
- begin
- imax := imid;
- if LCompare = 0 then
- begin
- AFoundIndex := imid;
- Exit(True);
- end;
- end;
- end;
- // At exit of while:
- // if A[] is empty, then imax < imin
- // otherwise imax == imin
- // deferred test for equality
- LCompare := AComparer.Compare(AValues[imin], AItem);
- if (imax = imin) and (LCompare = 0) then
- begin
- AFoundIndex := imin;
- Exit(True);
- end
- else
- begin
- AFoundIndex := -1;
- Exit(False);
- end;
- end;
- { TEnumerator<T> }
- function TEnumerator<T>.MoveNext: boolean;
- begin
- Exit(DoMoveNext);
- end;
- { TEnumerable<T> }
- function TEnumerable<T>.ToArrayImpl(ACount: SizeInt): TArray<T>;
- var
- i: SizeInt;
- LEnumerator: TEnumerator<T>;
- begin
- SetLength(Result, ACount);
- try
- LEnumerator := GetEnumerator;
- i := 0;
- while LEnumerator.MoveNext do
- begin
- Result[i] := LEnumerator.Current;
- Inc(i);
- end;
- finally
- LEnumerator.Free;
- end;
- end;
- function TEnumerable<T>.GetEnumerator: TEnumerator<T>;
- begin
- Exit(DoGetEnumerator);
- end;
- function TEnumerable<T>.ToArray: TArray<T>;
- var
- LEnumerator: TEnumerator<T>;
- LBuffer: TList<T>;
- begin
- LBuffer := TList<T>.Create;
- try
- LEnumerator := GetEnumerator;
- while LEnumerator.MoveNext do
- LBuffer.Add(LEnumerator.Current);
- Result := LBuffer.ToArray;
- finally
- LBuffer.Free;
- LEnumerator.Free;
- end;
- end;
- { TCustomPointersCollection<T, PT> }
- function TCustomPointersCollection<T, PT>.Enumerable: TLocalEnumerable;
- begin
- Result := TLocalEnumerable(@Self);
- end;
- function TCustomPointersCollection<T, PT>.GetEnumerator: TEnumerator<PT>;
- begin
- Result := Enumerable.GetPtrEnumerator;
- end;
- { TEnumerableWithPointers<T> }
- function TEnumerableWithPointers<T>.GetPtr: PPointersCollection;
- begin
- Result := PPointersCollection(Self);
- end;
- { TCustomList<T> }
- function TCustomList<T>.PrepareAddingItem: SizeInt;
- begin
- Result := Length(FItems);
- if (FLength < 4) and (Result < 4) then
- SetLength(FItems, 4)
- else if FLength = High(FLength) then
- OutOfMemoryError
- else if FLength = Result then
- SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
- Result := FLength;
- Inc(FLength);
- end;
- function TCustomList<T>.PrepareAddingRange(ACount: SizeInt): SizeInt;
- begin
- if ACount < 0 then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- if ACount = 0 then
- Exit(FLength - 1);
- if (FLength = 0) and (Length(FItems) = 0) then
- SetLength(FItems, 4)
- else if FLength = High(FLength) then
- OutOfMemoryError;
- Result := Length(FItems);
- while Pred(FLength + ACount) >= Result do
- begin
- SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
- Result := Length(FItems);
- end;
- Result := FLength;
- Inc(FLength, ACount);
- end;
- function TCustomList<T>.ToArray: TArray<T>;
- begin
- Result := ToArrayImpl(Count);
- end;
- function TCustomList<T>.GetCount: SizeInt;
- begin
- Result := FLength;
- end;
- procedure TCustomList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
- begin
- if Assigned(FOnNotify) then
- FOnNotify(Self, AValue, ACollectionNotification);
- end;
- function TCustomList<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
- begin
- if (AIndex < 0) or (AIndex >= FLength) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Result := FItems[AIndex];
- Dec(FLength);
- FItems[AIndex] := Default(T);
- if AIndex <> FLength then
- begin
- System.Move(FItems[AIndex + 1], FItems[AIndex], (FLength - AIndex) * SizeOf(T));
- FillChar(FItems[FLength], SizeOf(T), 0);
- end;
- Notify(Result, ACollectionNotification);
- end;
- function TCustomList<T>.GetCapacity: SizeInt;
- begin
- Result := Length(FItems);
- end;
- { TCustomListEnumerator<T> }
- function TCustomListEnumerator<T>.DoMoveNext: boolean;
- begin
- Inc(FIndex);
- Result := (FList.FLength <> 0) and (FIndex < FList.FLength)
- end;
- function TCustomListEnumerator<T>.DoGetCurrent: T;
- begin
- Result := GetCurrent;
- end;
- function TCustomListEnumerator<T>.GetCurrent: T;
- begin
- Result := FList.FItems[FIndex];
- end;
- constructor TCustomListEnumerator<T>.Create(AList: TCustomList<T>);
- begin
- inherited Create;
- FIndex := -1;
- FList := AList;
- end;
- { TCustomListWithPointers<T>.TPointersEnumerator }
- function TCustomListWithPointers<T>.TPointersEnumerator.DoMoveNext: boolean;
- begin
- Inc(FIndex);
- Result := (FList.FLength <> 0) and (FIndex < FList.FLength)
- end;
- function TCustomListWithPointers<T>.TPointersEnumerator.DoGetCurrent: PT;
- begin
- Result := @FList.FItems[FIndex];;
- end;
- constructor TCustomListWithPointers<T>.TPointersEnumerator.Create(AList: TCustomListWithPointers<T>);
- begin
- inherited Create;
- FIndex := -1;
- FList := AList;
- end;
- { TCustomListWithPointers<T> }
- function TCustomListWithPointers<T>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TPointersEnumerator.Create(Self);
- end;
- { TList<T> }
- procedure TList<T>.InitializeList;
- begin
- end;
- constructor TList<T>.Create;
- begin
- InitializeList;
- FComparer := TComparer<T>.Default;
- end;
- constructor TList<T>.Create(const AComparer: IComparer<T>);
- begin
- InitializeList;
- FComparer := AComparer;
- end;
- constructor TList<T>.Create(ACollection: TEnumerable<T>);
- var
- LItem: T;
- begin
- Create;
- for LItem in ACollection do
- Add(LItem);
- end;
- destructor TList<T>.Destroy;
- begin
- SetCapacity(0);
- end;
- procedure TList<T>.SetCapacity(AValue: SizeInt);
- begin
- if AValue < Count then
- Count := AValue;
- SetLength(FItems, AValue);
- end;
- procedure TList<T>.SetCount(AValue: SizeInt);
- begin
- if AValue < 0 then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- if AValue > Capacity then
- Capacity := AValue;
- if AValue < Count then
- DeleteRange(AValue, Count - AValue);
- FLength := AValue;
- end;
- function TList<T>.GetItem(AIndex: SizeInt): T;
- begin
- if (AIndex < 0) or (AIndex >= Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Result := FItems[AIndex];
- end;
- procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
- begin
- if (AIndex < 0) or (AIndex >= Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Notify(FItems[AIndex], cnRemoved);
- FItems[AIndex] := AValue;
- Notify(AValue, cnAdded);
- end;
- function TList<T>.GetEnumerator: TEnumerator;
- begin
- Result := TEnumerator.Create(Self);
- end;
- function TList<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
- begin
- Result := GetEnumerator;
- end;
- function TList<T>.Add(constref AValue: T): SizeInt;
- begin
- Result := PrepareAddingItem;
- FItems[Result] := AValue;
- Notify(AValue, cnAdded);
- end;
- procedure TList<T>.AddRange(constref AValues: array of T);
- begin
- InsertRange(Count, AValues);
- end;
- procedure TList<T>.AddRange(const AEnumerable: IEnumerable<T>);
- var
- LValue: T;
- begin
- for LValue in AEnumerable do
- Add(LValue);
- end;
- procedure TList<T>.AddRange(AEnumerable: TEnumerable<T>);
- var
- LValue: T;
- begin
- for LValue in AEnumerable do
- Add(LValue);
- end;
- procedure TList<T>.AddRange(AEnumerable: TEnumerableWithPointers<T>);
- var
- LValue: PT;
- begin
- for LValue in AEnumerable.Ptr^ do
- Add(LValue^);
- end;
- procedure TList<T>.InternalInsert(AIndex: SizeInt; constref AValue: T);
- begin
- if AIndex <> PrepareAddingItem then
- begin
- System.Move(FItems[AIndex], FItems[AIndex + 1], ((Count - AIndex) - 1) * SizeOf(T));
- FillChar(FItems[AIndex], SizeOf(T), 0);
- end;
- FItems[AIndex] := AValue;
- Notify(AValue, cnAdded);
- end;
- procedure TList<T>.Insert(AIndex: SizeInt; constref AValue: T);
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- InternalInsert(AIndex, AValue);
- end;
- procedure TList<T>.InsertRange(AIndex: SizeInt; constref AValues: array of T);
- var
- i: SizeInt;
- LLength: SizeInt;
- LValue: ^T;
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- LLength := Length(AValues);
- if LLength = 0 then
- Exit;
- if AIndex <> PrepareAddingRange(LLength) then
- begin
- System.Move(FItems[AIndex], FItems[AIndex + LLength], ((Count - AIndex) - LLength) * SizeOf(T));
- FillChar(FItems[AIndex], SizeOf(T) * LLength, 0);
- end;
- LValue := @AValues[0];
- for i := AIndex to Pred(AIndex + LLength) do
- begin
- FItems[i] := LValue^;
- Notify(LValue^, cnAdded);
- Inc(LValue);
- end;
- end;
- procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>);
- var
- LValue: T;
- i: SizeInt;
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- i := 0;
- for LValue in AEnumerable do
- begin
- InternalInsert(Aindex + i, LValue);
- Inc(i);
- end;
- end;
- procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>);
- var
- LValue: T;
- i: SizeInt;
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- i := 0;
- for LValue in AEnumerable do
- begin
- InternalInsert(Aindex + i, LValue);
- Inc(i);
- end;
- end;
- procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerableWithPointers<T>);
- var
- LValue: PT;
- i: SizeInt;
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- i := 0;
- for LValue in AEnumerable.Ptr^ do
- begin
- InternalInsert(Aindex + i, LValue^);
- Inc(i);
- end;
- end;
- function TList<T>.Remove(constref AValue: T): SizeInt;
- begin
- Result := IndexOf(AValue);
- if Result >= 0 then
- DoRemove(Result, cnRemoved);
- end;
- procedure TList<T>.Delete(AIndex: SizeInt);
- begin
- DoRemove(AIndex, cnRemoved);
- end;
- procedure TList<T>.DeleteRange(AIndex, ACount: SizeInt);
- var
- LDeleted: array of T;
- i: SizeInt;
- LMoveDelta: SizeInt;
- begin
- if ACount = 0 then
- Exit;
- if (ACount < 0) or (AIndex < 0) or (AIndex + ACount > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- SetLength(LDeleted, Count);
- System.Move(FItems[AIndex], LDeleted[0], ACount * SizeOf(T));
- LMoveDelta := Count - (AIndex + ACount);
- if LMoveDelta = 0 then
- FillChar(FItems[AIndex], ACount * SizeOf(T), #0)
- else
- begin
- System.Move(FItems[AIndex + ACount], FItems[AIndex], LMoveDelta * SizeOf(T));
- FillChar(FItems[Count - ACount], ACount * SizeOf(T), #0);
- end;
- Dec(FLength, ACount);
- for i := 0 to High(LDeleted) do
- Notify(LDeleted[i], cnRemoved);
- end;
- function TList<T>.ExtractIndex(const AIndex: SizeInt): T;
- begin
- Result := DoRemove(AIndex, cnExtracted);
- end;
- function TList<T>.Extract(constref AValue: T): T;
- var
- LIndex: SizeInt;
- begin
- LIndex := IndexOf(AValue);
- if LIndex < 0 then
- Exit(Default(T));
- Result := DoRemove(LIndex, cnExtracted);
- end;
- procedure TList<T>.Exchange(AIndex1, AIndex2: SizeInt);
- var
- LTemp: T;
- begin
- LTemp := FItems[AIndex1];
- FItems[AIndex1] := FItems[AIndex2];
- FItems[AIndex2] := LTemp;
- end;
- procedure TList<T>.Move(AIndex, ANewIndex: SizeInt);
- var
- LTemp: T;
- begin
- if ANewIndex = AIndex then
- Exit;
- if (ANewIndex < 0) or (ANewIndex >= Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- LTemp := FItems[AIndex];
- FItems[AIndex] := Default(T);
- if AIndex < ANewIndex then
- System.Move(FItems[Succ(AIndex)], FItems[AIndex], (ANewIndex - AIndex) * SizeOf(T))
- else
- System.Move(FItems[ANewIndex], FItems[Succ(ANewIndex)], (AIndex - ANewIndex) * SizeOf(T));
- FillChar(FItems[ANewIndex], SizeOf(T), #0);
- FItems[ANewIndex] := LTemp;
- end;
- function TList<T>.First: T;
- begin
- Result := Items[0];
- end;
- function TList<T>.Last: T;
- begin
- Result := Items[Pred(Count)];
- end;
- procedure TList<T>.Clear;
- begin
- SetCount(0);
- SetCapacity(0);
- end;
- procedure TList<T>.TrimExcess;
- begin
- SetCapacity(Count);
- end;
- function TList<T>.Contains(constref AValue: T): Boolean;
- begin
- Result := IndexOf(AValue) >= 0;
- end;
- function TList<T>.IndexOf(constref AValue: T): SizeInt;
- var
- i: SizeInt;
- begin
- for i := 0 to Count - 1 do
- if FComparer.Compare(AValue, FItems[i]) = 0 then
- Exit(i);
- Result := -1;
- end;
- function TList<T>.LastIndexOf(constref AValue: T): SizeInt;
- var
- i: SizeInt;
- begin
- for i := Count - 1 downto 0 do
- if FComparer.Compare(AValue, FItems[i]) = 0 then
- Exit(i);
- Result := -1;
- end;
- procedure TList<T>.Reverse;
- var
- a, b: SizeInt;
- LTemp: T;
- begin
- a := 0;
- b := Count - 1;
- while a < b do
- begin
- LTemp := FItems[a];
- FItems[a] := FItems[b];
- FItems[b] := LTemp;
- Inc(a);
- Dec(b);
- end;
- end;
- procedure TList<T>.Sort;
- begin
- TArrayHelperBugHack.Sort(FItems, FComparer, 0, Count);
- end;
- procedure TList<T>.Sort(const AComparer: IComparer<T>);
- begin
- TArrayHelperBugHack.Sort(FItems, AComparer, 0, Count);
- end;
- function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean;
- begin
- Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex, FComparer, 0, Count);
- end;
- function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
- begin
- Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex, AComparer, 0, Count);
- end;
- { TSortedList<T> }
- procedure TSortedList<T>.InitializeList;
- begin
- FSortStyle := cssAuto;
- end;
- function TSortedList<T>.Add(constref AValue: T): SizeInt;
- var
- LSearchResult: TBinarySearchResult;
- begin
- if SortStyle <> cssAuto then
- Exit(inherited Add(AValue));
- if TArrayHelperBugHack.BinarySearch(FItems, AValue, LSearchResult, FComparer, 0, Count) then
- case FDuplicates of
- dupAccept: Result := LSearchResult.FoundIndex;
- dupIgnore: Exit(LSearchResult.FoundIndex);
- dupError: raise EListError.Create(SCollectionDuplicate);
- end
- else
- begin
- if LSearchResult.CandidateIndex = -1 then
- Result := 0
- else
- if LSearchResult.CompareResult > 0 then
- Result := LSearchResult.CandidateIndex
- else
- Result := LSearchResult.CandidateIndex + 1;
- end;
- InternalInsert(Result, AValue);
- end;
- procedure TSortedList<T>.Insert(AIndex: SizeInt; constref AValue: T);
- begin
- if FSortStyle = cssAuto then
- raise EListError.Create(SSortedListError)
- else
- inherited;
- end;
- procedure TSortedList<T>.Exchange(AIndex1, AIndex2: SizeInt);
- begin
- if FSortStyle = cssAuto then
- raise EListError.Create(SSortedListError)
- else
- inherited;
- end;
- procedure TSortedList<T>.Move(AIndex, ANewIndex: SizeInt);
- begin
- if FSortStyle = cssAuto then
- raise EListError.Create(SSortedListError)
- else
- inherited;
- end;
- procedure TSortedList<T>.AddRange(constref AValues: array of T);
- var
- i: T;
- begin
- for i in AValues do
- Add(i);
- end;
- procedure TSortedList<T>.InsertRange(AIndex: SizeInt; constref AValues: array of T);
- var
- LValue: T;
- i: SizeInt;
- begin
- if (AIndex < 0) or (AIndex > Count) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- i := 0;
- for LValue in AValues do
- begin
- InternalInsert(AIndex + i, LValue);
- Inc(i);
- end;
- end;
- function TSortedList<T>.GetSorted: boolean;
- begin
- Result := FSortStyle in [cssAuto, cssUser];
- end;
- procedure TSortedList<T>.SetSorted(AValue: boolean);
- begin
- if AValue then
- SortStyle := cssAuto
- else
- SortStyle := cssNone;
- end;
- procedure TSortedList<T>.SetSortStyle(AValue: TCollectionSortStyle);
- begin
- if FSortStyle = AValue then
- Exit;
- if AValue = cssAuto then
- Sort;
- FSortStyle := AValue;
- end;
- function TSortedList<T>.ConsistencyCheck(ARaiseException: boolean = true): boolean;
- var
- i: Integer;
- LCompare: SizeInt;
- begin
- if Sorted then
- for i := 0 to Count-2 do
- begin
- LCompare := FComparer.Compare(FItems[i], FItems[i+1]);
- if LCompare = 0 then
- begin
- if Duplicates <> dupAccept then
- if ARaiseException then
- raise EListError.Create(SCollectionDuplicate)
- else
- Exit(False)
- end
- else
- if LCompare > 0 then
- if ARaiseException then
- raise EListError.Create(SCollectionInconsistency)
- else
- Exit(False)
- end;
- Result := True;
- end;
- { TThreadList<T> }
- constructor TThreadList<T>.Create;
- begin
- inherited Create;
- FDuplicates:=dupIgnore;
- {$ifdef FPC_HAS_FEATURE_THREADING}
- InitCriticalSection(FLock);
- {$endif}
- FList := TList<T>.Create;
- end;
- destructor TThreadList<T>.Destroy;
- begin
- LockList;
- try
- FList.Free;
- inherited Destroy;
- finally
- UnlockList;
- {$ifdef FPC_HAS_FEATURE_THREADING}
- DoneCriticalSection(FLock);
- {$endif}
- end;
- end;
- procedure TThreadList<T>.Add(constref AValue: T);
- begin
- LockList;
- try
- if (Duplicates = dupAccept) or (FList.IndexOf(AValue) = -1) then
- FList.Add(AValue)
- else if Duplicates = dupError then
- raise EArgumentException.CreateRes(@SDuplicatesNotAllowed);
- finally
- UnlockList;
- end;
- end;
- procedure TThreadList<T>.Remove(constref AValue: T);
- begin
- LockList;
- try
- FList.Remove(AValue);
- finally
- UnlockList;
- end;
- end;
- procedure TThreadList<T>.Clear;
- begin
- LockList;
- try
- FList.Clear;
- finally
- UnlockList;
- end;
- end;
- function TThreadList<T>.LockList: TList<T>;
- begin
- Result:=FList;
- {$ifdef FPC_HAS_FEATURE_THREADING}
- System.EnterCriticalSection(FLock);
- {$endif}
- end;
- procedure TThreadList<T>.UnlockList;
- begin
- {$ifdef FPC_HAS_FEATURE_THREADING}
- System.LeaveCriticalSection(FLock);
- {$endif}
- end;
- { TQueue<T>.TPointersEnumerator }
- function TQueue<T>.TPointersEnumerator.DoMoveNext: boolean;
- begin
- Inc(FIndex);
- Result := (FQueue.FLength <> 0) and (FIndex < FQueue.FLength)
- end;
- function TQueue<T>.TPointersEnumerator.DoGetCurrent: PT;
- begin
- Result := @FQueue.FItems[FIndex];
- end;
- constructor TQueue<T>.TPointersEnumerator.Create(AQueue: TQueue<T>);
- begin
- inherited Create;
- FIndex := Pred(AQueue.FLow);
- FQueue := AQueue;
- end;
- { TQueue<T>.TEnumerator }
- constructor TQueue<T>.TEnumerator.Create(AQueue: TQueue<T>);
- begin
- inherited Create(AQueue);
- FIndex := Pred(AQueue.FLow);
- end;
- { TQueue<T> }
- function TQueue<T>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TPointersenumerator.Create(Self);
- end;
- function TQueue<T>.GetEnumerator: TEnumerator;
- begin
- Result := TEnumerator.Create(Self);
- end;
- function TQueue<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
- begin
- Result := GetEnumerator;
- end;
- function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
- begin
- Result := FItems[AIndex];
- FItems[AIndex] := Default(T);
- Notify(Result, ACollectionNotification);
- FLow += 1;
- if FLow = FLength then
- begin
- FLow := 0;
- FLength := 0;
- end;
- end;
- procedure TQueue<T>.SetCapacity(AValue: SizeInt);
- begin
- if AValue < Count then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- if AValue = FLength then
- Exit;
- if (Count > 0) and (FLow > 0) then
- begin
- Move(FItems[FLow], FItems[0], Count * SizeOf(T));
- FillChar(FItems[Count], (FLength - Count) * SizeOf(T), #0);
- end;
- SetLength(FItems, AValue);
- FLength := Count;
- FLow := 0;
- end;
- function TQueue<T>.GetCount: SizeInt;
- begin
- Result := FLength - FLow;
- end;
- constructor TQueue<T>.Create(ACollection: TEnumerable<T>);
- var
- LItem: T;
- begin
- for LItem in ACollection do
- Enqueue(LItem);
- end;
- destructor TQueue<T>.Destroy;
- begin
- Clear;
- end;
- procedure TQueue<T>.Enqueue(constref AValue: T);
- var
- LIndex: SizeInt;
- begin
- LIndex := PrepareAddingItem;
- FItems[LIndex] := AValue;
- Notify(AValue, cnAdded);
- end;
- function TQueue<T>.Dequeue: T;
- begin
- Result := DoRemove(FLow, cnRemoved);
- end;
- function TQueue<T>.Extract: T;
- begin
- Result := DoRemove(FLow, cnExtracted);
- end;
- function TQueue<T>.Peek: T;
- begin
- if (Count = 0) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Result := FItems[FLow];
- end;
- procedure TQueue<T>.Clear;
- begin
- while Count <> 0 do
- Dequeue;
- FLow := 0;
- FLength := 0;
- end;
- procedure TQueue<T>.TrimExcess;
- begin
- SetCapacity(Count);
- end;
- { TStack<T> }
- function TStack<T>.GetEnumerator: TEnumerator;
- begin
- Result := TEnumerator.Create(Self);
- end;
- function TStack<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
- begin
- Result := GetEnumerator;
- end;
- constructor TStack<T>.Create(ACollection: TEnumerable<T>);
- var
- LItem: T;
- begin
- for LItem in ACollection do
- Push(LItem);
- end;
- constructor TStack<T>.Create(ACollection: TEnumerableWithPointers<T>);
- var
- LItem: PT;
- begin
- for LItem in ACollection.Ptr^ do
- Push(LItem^);
- end;
- function TStack<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
- begin
- if AIndex < 0 then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Result := FItems[AIndex];
- FItems[AIndex] := Default(T);
- Dec(FLength);
- Notify(Result, ACollectionNotification);
- end;
- destructor TStack<T>.Destroy;
- begin
- Clear;
- end;
- procedure TStack<T>.Clear;
- begin
- while Count <> 0 do
- Pop;
- end;
- procedure TStack<T>.SetCapacity(AValue: SizeInt);
- begin
- if AValue < Count then
- AValue := Count;
- SetLength(FItems, AValue);
- end;
- procedure TStack<T>.Push(constref AValue: T);
- var
- LIndex: SizeInt;
- begin
- LIndex := PrepareAddingItem;
- FItems[LIndex] := AValue;
- Notify(AValue, cnAdded);
- end;
- function TStack<T>.Pop: T;
- begin
- Result := DoRemove(FLength - 1, cnRemoved);
- end;
- function TStack<T>.Peek: T;
- begin
- if (Count = 0) then
- raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
- Result := FItems[FLength - 1];
- end;
- function TStack<T>.Extract: T;
- begin
- Result := DoRemove(FLength - 1, cnExtracted);
- end;
- procedure TStack<T>.TrimExcess;
- begin
- SetCapacity(Count);
- end;
- { TObjectList<T> }
- procedure TObjectList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
- begin
- inherited Notify(AValue, ACollectionNotification);
- if FObjectsOwner and (ACollectionNotification = cnRemoved) then
- TObject(AValue).Free;
- end;
- constructor TObjectList<T>.Create(AOwnsObjects: Boolean);
- begin
- inherited Create;
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectList<T>.Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(AComparer);
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectList<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectList<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- { TObjectQueue<T> }
- procedure TObjectQueue<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
- begin
- inherited Notify(AValue, ACollectionNotification);
- if FObjectsOwner and (ACollectionNotification = cnRemoved) then
- TObject(AValue).Free;
- end;
- constructor TObjectQueue<T>.Create(AOwnsObjects: Boolean);
- begin
- inherited Create;
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectQueue<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectQueue<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- procedure TObjectQueue<T>.Dequeue;
- begin
- inherited Dequeue;
- end;
- { TObjectStack<T> }
- procedure TObjectStack<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
- begin
- inherited Notify(AValue, ACollectionNotification);
- if FObjectsOwner and (ACollectionNotification = cnRemoved) then
- TObject(AValue).Free;
- end;
- constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
- begin
- inherited Create;
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectStack<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- constructor TObjectStack<T>.Create(ACollection: TEnumerableWithPointers<T>; AOwnsObjects: Boolean);
- begin
- inherited Create(ACollection);
- FObjectsOwner := AOwnsObjects;
- end;
- function TObjectStack<T>.Pop: T;
- begin
- Result := inherited Pop;
- end;
- {$I generics.dictionaries.inc}
- { TCustomSet<T>.TCustomSetEnumerator }
- function TCustomSet<T>.TCustomSetEnumerator.DoMoveNext: boolean;
- begin
- Result := FEnumerator.DoMoveNext;
- end;
- function TCustomSet<T>.TCustomSetEnumerator.DoGetCurrent: T;
- begin
- Result := FEnumerator.DoGetCurrent;
- end;
- destructor TCustomSet<T>.TCustomSetEnumerator.Destroy;
- begin
- FEnumerator.Free;
- end;
- { TCustomSet<T> }
- function TCustomSet<T>.DoGetEnumerator: Generics.Collections.TEnumerator<T>;
- begin
- Result := GetEnumerator;
- end;
- constructor TCustomSet<T>.Create(ACollection: TEnumerable<T>);
- var
- i: T;
- begin
- Create;
- for i in ACollection do
- Add(i);
- end;
- constructor TCustomSet<T>.Create(ACollection: TEnumerableWithPointers<T>);
- var
- i: PT;
- begin
- Create;
- for i in ACollection.Ptr^ do
- Add(i^);
- end;
- function TCustomSet<T>.AddRange(constref AValues: array of T): Boolean;
- var
- i: T;
- begin
- Result := True;
- for i in AValues do
- Result := Add(i) and Result;
- end;
- function TCustomSet<T>.AddRange(const AEnumerable: IEnumerable<T>): Boolean;
- var
- i: T;
- begin
- Result := True;
- for i in AEnumerable do
- Result := Add(i) and Result;
- end;
- function TCustomSet<T>.AddRange(AEnumerable: TEnumerable<T>): Boolean;
- var
- i: T;
- begin
- Result := True;
- for i in AEnumerable do
- Result := Add(i) and Result;
- end;
- function TCustomSet<T>.AddRange(AEnumerable: TEnumerableWithPointers<T>): Boolean;
- var
- i: PT;
- begin
- Result := True;
- for i in AEnumerable.Ptr^ do
- Result := Add(i^) and Result;
- end;
- procedure TCustomSet<T>.UnionWith(AHashSet: TCustomSet<T>);
- var
- i: PT;
- begin
- for i in AHashSet.Ptr^ do
- Add(i^);
- end;
- procedure TCustomSet<T>.IntersectWith(AHashSet: TCustomSet<T>);
- var
- LList: TList<PT>;
- i: PT;
- begin
- LList := TList<PT>.Create;
- for i in Ptr^ do
- if not AHashSet.Contains(i^) then
- LList.Add(i);
- for i in LList do
- Remove(i^);
- LList.Free;
- end;
- procedure TCustomSet<T>.ExceptWith(AHashSet: TCustomSet<T>);
- var
- i: PT;
- begin
- for i in AHashSet.Ptr^ do
- Remove(i^);
- end;
- procedure TCustomSet<T>.SymmetricExceptWith(AHashSet: TCustomSet<T>);
- var
- LList: TList<PT>;
- i: PT;
- begin
- LList := TList<PT>.Create;
- for i in AHashSet.Ptr^ do
- if Contains(i^) then
- LList.Add(i)
- else
- Add(i^);
- for i in LList do
- Remove(i^);
- LList.Free;
- end;
- { THashSet<T>.THashSetEnumerator }
- function THashSet<T>.THashSetEnumerator.GetCurrent: T;
- begin
- Result := TDictionaryEnumerator(FEnumerator).GetCurrent;
- end;
- constructor THashSet<T>.THashSetEnumerator.Create(ASet: TCustomSet<T>);
- begin
- TDictionaryEnumerator(FEnumerator) := THashSet<T>(ASet).FInternalDictionary.Keys.DoGetEnumerator;
- end;
- { THashSet<T>.TPointersEnumerator }
- function THashSet<T>.TPointersEnumerator.DoMoveNext: boolean;
- begin
- Result := FEnumerator.MoveNext;
- end;
- function THashSet<T>.TPointersEnumerator.DoGetCurrent: PT;
- begin
- Result := FEnumerator.Current;
- end;
- constructor THashSet<T>.TPointersEnumerator.Create(AHashSet: THashSet<T>);
- begin
- FEnumerator := AHashSet.FInternalDictionary.Keys.Ptr^.GetEnumerator;
- end;
- { THashSet<T> }
- function THashSet<T>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TPointersEnumerator.Create(Self);
- end;
- function THashSet<T>.GetCount: SizeInt;
- begin
- Result := FInternalDictionary.Count;
- end;
- function THashSet<T>.GetEnumerator: TCustomSetEnumerator;
- begin
- Result := THashSetEnumerator.Create(Self);
- end;
- constructor THashSet<T>.Create;
- begin
- FInternalDictionary := TOpenAddressingLP<T, TEmptyRecord>.Create;
- end;
- constructor THashSet<T>.Create(const AComparer: IEqualityComparer<T>);
- begin
- FInternalDictionary := TOpenAddressingLP<T, TEmptyRecord>.Create(AComparer);
- end;
- destructor THashSet<T>.Destroy;
- begin
- FInternalDictionary.Free;
- end;
- function THashSet<T>.Add(constref AValue: T): Boolean;
- begin
- Result := not FInternalDictionary.ContainsKey(AValue);
- if Result then
- FInternalDictionary.Add(AValue, EmptyRecord);
- end;
- function THashSet<T>.Remove(constref AValue: T): Boolean;
- var
- LIndex: SizeInt;
- begin
- LIndex := FInternalDictionary.FindBucketIndex(AValue);
- Result := LIndex >= 0;
- if Result then
- FInternalDictionary.DoRemove(LIndex, cnRemoved);
- end;
- procedure THashSet<T>.Clear;
- begin
- FInternalDictionary.Clear;
- end;
- function THashSet<T>.Contains(constref AValue: T): Boolean;
- begin
- Result := FInternalDictionary.ContainsKey(AValue);
- end;
- { TAVLTreeNode<TREE_CONSTRAINTS, TTree> }
- function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.Successor: PNode;
- begin
- Result:=Right;
- if Result<>nil then begin
- while (Result.Left<>nil) do Result:=Result.Left;
- end else begin
- Result:=@Self;
- while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
- Result:=Result.Parent;
- Result:=Result.Parent;
- end;
- end;
- function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.Precessor: PNode;
- begin
- Result:=Left;
- if Result<>nil then begin
- while (Result.Right<>nil) do Result:=Result.Right;
- end else begin
- Result:=@Self;
- while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
- Result:=Result.Parent;
- Result:=Result.Parent;
- end;
- end;
- function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.TreeDepth: integer;
- // longest WAY down. e.g. only one node => 0 !
- var LeftDepth, RightDepth: integer;
- begin
- if Left<>nil then
- LeftDepth:=Left.TreeDepth+1
- else
- LeftDepth:=0;
- if Right<>nil then
- RightDepth:=Right.TreeDepth+1
- else
- RightDepth:=0;
- if LeftDepth>RightDepth then
- Result:=LeftDepth
- else
- Result:=RightDepth;
- end;
- procedure TAVLTreeNode<TREE_CONSTRAINTS, TTree>.ConsistencyCheck(ATree: TObject);
- var
- LTree: TTree absolute ATree;
- LeftDepth: SizeInt;
- RightDepth: SizeInt;
- begin
- // test left child
- if Left<>nil then begin
- if Left.Parent<>@Self then
- raise EAVLTree.Create('Left.Parent<>Self');
- if LTree.Compare(Left.Data.Key,Data.Key)>0 then
- raise EAVLTree.Create('Compare(Left.Data,Data)>0');
- Left.ConsistencyCheck(LTree);
- end;
- // test right child
- if Right<>nil then begin
- if Right.Parent<>@Self then
- raise EAVLTree.Create('Right.Parent<>Self');
- if LTree.Compare(Data.Key,Right.Data.Key)>0 then
- raise EAVLTree.Create('Compare(Data,Right.Data)>0');
- Right.ConsistencyCheck(LTree);
- end;
- // test balance
- if Left<>nil then
- LeftDepth:=Left.TreeDepth+1
- else
- LeftDepth:=0;
- if Right<>nil then
- RightDepth:=Right.TreeDepth+1
- else
- RightDepth:=0;
- if Balance<>(LeftDepth-RightDepth) then
- raise EAVLTree.CreateFmt('Balance[%d]<>(RightDepth[%d]-LeftDepth[%d])', [Balance, RightDepth, LeftDepth]);
- end;
- function TAVLTreeNode<TREE_CONSTRAINTS, TTree>.GetCount: SizeInt;
- begin
- Result:=1;
- if Assigned(Left) then Inc(Result,Left.GetCount);
- if Assigned(Right) then Inc(Result,Right.GetCount);
- end;
- { TCustomTreeEnumerator<T, PNode, TTree> }
- function TCustomTreeEnumerator<T, PNode, TTree>.DoGetCurrent: T;
- begin
- Result := GetCurrent;
- end;
- constructor TCustomTreeEnumerator<T, PNode, TTree>.Create(ATree: TObject);
- begin
- TObject(FTree) := ATree;
- end;
- { TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, TREE_CONSTRAINTS> }
- function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.GetCount: SizeInt;
- begin
- Result := FTree.Count;
- end;
- function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TTreePointersEnumerator.Create(FTree);
- end;
- constructor TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.Create(
- ATree: TTree);
- begin
- FTree := ATree;
- end;
- function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.
- DoGetEnumerator: TTreeEnumerator;
- begin
- Result := TTreeEnumerator.Create(FTree);
- end;
- function TTreeEnumerable<TTreeEnumerator, TTreePointersEnumerator, T, PT, PNode, TTree>.ToArray: TArray<T>;
- begin
- Result := ToArrayImpl(FTree.Count);
- end;
- { TAVLTreeEnumerator<T, PNode, TTree> }
- function TAVLTreeEnumerator<T, PNode, TTree>.DoMoveNext: Boolean;
- begin
- if FLowToHigh then begin
- if FCurrent<>nil then
- FCurrent:=FCurrent.Successor
- else
- FCurrent:=FTree.FindLowest;
- end else begin
- if FCurrent<>nil then
- FCurrent:=FCurrent.Precessor
- else
- FCurrent:=FTree.FindHighest;
- end;
- Result:=FCurrent<>nil;
- end;
- constructor TAVLTreeEnumerator<T, PNode, TTree>.Create(ATree: TObject; ALowToHigh: boolean);
- begin
- inherited Create(ATree);
- FLowToHigh:=aLowToHigh;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPairEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPairEnumerator.GetCurrent: TTreePair;
- begin
- Result := TTreePair((@FCurrent.Data)^);
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TNodeEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TNodeEnumerator.GetCurrent: PNode;
- begin
- Result := FCurrent;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TKeyEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
- begin
- Result := FCurrent.Key;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPKeyEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPKeyEnumerator.GetCurrent: PKey;
- begin
- Result := @FCurrent.Data.Key;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator.GetCurrent: TValue;
- begin
- Result := FCurrent.Value;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS>.TValueEnumerator }
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.TPValueEnumerator.GetCurrent: PValue;
- begin
- Result := @FCurrent.Data.Value;
- end;
- { TCustomAVLTreeMap<TREE_CONSTRAINTS> }
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.NodeAdded(ANode: PNode);
- begin
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.DeletingNode(ANode: PNode; AOrigin: boolean);
- begin
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.DeleteNode(ANode: PNode);
- begin
- if ANode.Left<>nil then
- DeleteNode(ANode.Left, true);
- if ANode.Right<>nil then
- DeleteNode(ANode.Right, true);
- Dispose(ANode);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Compare(constref ALeft, ARight: TKey): Integer; inline;
- begin
- Result := FComparer.Compare(ALeft, ARight);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindPredecessor(ANode: PNode): PNode;
- begin
- if ANode <> nil then
- begin
- if ANode.Left <> nil then
- begin
- ANode := ANode.Left;
- while ANode.Right <> nil do ANode := ANode.Right;
- end
- else
- repeat
- Result := ANode;
- ANode := ANode.Parent;
- until (ANode = nil) or (ANode.Right = Result);
- end;
- Result := ANode;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindInsertNode(ANode: PNode; out AInsertNode: PNode): Integer;
- begin
- AInsertNode := FRoot;
- if AInsertNode = nil then // first item in tree
- Exit(0);
- repeat
- Result := Compare(ANode.Key,AInsertNode.Key);
- if Result < 0 then
- begin
- if AInsertNode.Left = nil then
- Exit;
- AInsertNode := AInsertNode.Left;
- end
- else
- begin
- if AInsertNode.Right = nil then
- Exit;
- AInsertNode := AInsertNode.Right;
- if Result = 0 then
- Break;
- end;
- until false;
- // for equal items (when item already exist) we need to keep 0 result
- while true do
- if Compare(ANode.Key,AInsertNode.Key) < 0 then
- begin
- if AInsertNode.Left = nil then
- Exit;
- AInsertNode := AInsertNode.Left;
- end
- else
- begin
- if AInsertNode.Right = nil then
- Exit;
- AInsertNode := AInsertNode.Right;
- end;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateRightRight(ANode: PNode);
- var
- LNode, LParent: PNode;
- begin
- LNode := ANode.Right;
- LParent := ANode.Parent;
- ANode.Right := LNode.Left;
- if ANode.Right <> nil then
- ANode.Right.Parent := ANode;
- LNode.Left := ANode;
- LNode.Parent := LParent;
- ANode.Parent := LNode;
- if LParent <> nil then
- begin
- if LParent.Left = ANode then
- LParent.Left := LNode
- else
- LParent.Right := LNode;
- end
- else
- FRoot := LNode;
- if LNode.Balance = -1 then
- begin
- ANode.Balance := 0;
- LNode.Balance := 0;
- end
- else
- begin
- ANode.Balance := -1;
- LNode.Balance := 1;
- end
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateLeftLeft(ANode: PNode);
- var
- LNode, LParent: PNode;
- begin
- LNode := ANode.Left;
- LParent := ANode.Parent;
- ANode.Left := LNode.Right;
- if ANode.Left <> nil then
- ANode.Left.Parent := ANode;
- LNode.Right := ANode;
- LNode.Parent := LParent;
- ANode.Parent := LNode;
- if LParent <> nil then
- begin
- if LParent.Left = ANode then
- LParent.Left := LNode
- else
- LParent.Right := LNode;
- end
- else
- FRoot := LNode;
- if LNode.Balance = 1 then
- begin
- ANode.Balance := 0;
- LNode.Balance := 0;
- end
- else
- begin
- ANode.Balance := 1;
- LNode.Balance := -1;
- end
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateRightLeft(ANode: PNode);
- var
- LRight, LLeft, LParent: PNode;
- begin
- LRight := ANode.Right;
- LLeft := LRight.Left;
- LParent := ANode.Parent;
- LRight.Left := LLeft.Right;
- if LRight.Left <> nil then
- LRight.Left.Parent := LRight;
- ANode.Right := LLeft.Left;
- if ANode.Right <> nil then
- ANode.Right.Parent := ANode;
- LLeft.Left := ANode;
- LLeft.Right := LRight;
- ANode.Parent := LLeft;
- LRight.Parent := LLeft;
- LLeft.Parent := LParent;
- if LParent <> nil then
- begin
- if LParent.Left = ANode then
- LParent.Left := LLeft
- else
- LParent.Right := LLeft;
- end
- else
- FRoot := LLeft;
- if LLeft.Balance = -1 then
- ANode.Balance := 1
- else
- ANode.Balance := 0;
- if LLeft.Balance = 1 then
- LRight.Balance := -1
- else
- LRight.Balance := 0;
- LLeft.Balance := 0;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.RotateLeftRight(ANode: PNode);
- var
- LLeft, LRight, LParent: PNode;
- begin
- LLeft := ANode.Left;
- LRight := LLeft.Right;
- LParent := ANode.Parent;
- LLeft.Right := LRight.Left;
- if LLeft.Right <> nil then
- LLeft.Right.Parent := LLeft;
- ANode.Left := LRight.Right;
- if ANode.Left <> nil then
- ANode.Left.Parent := ANode;
- LRight.Right := ANode;
- LRight.Left := LLeft;
- ANode.Parent := LRight;
- LLeft.Parent := LRight;
- LRight.Parent := LParent;
- if LParent <> nil then
- begin
- if LParent.Left = ANode then
- LParent.Left := LRight
- else
- LParent.Right := LRight;
- end
- else
- FRoot := LRight;
- if LRight.Balance = 1 then
- ANode.Balance := -1
- else
- ANode.Balance := 0;
- if LRight.Balance = -1 then
- LLeft.Balance := 1
- else
- LLeft.Balance := 0;
- LRight.Balance := 0;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteStr(AStream: TStream; const AText: string);
- begin
- if AText='' then exit;
- AStream.Write(AText[1],Length(AText));
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetNodeCollection: TNodeCollection;
- begin
- if not Assigned(FNodes) then
- FNodes := TNodeCollection.Create(TTree(Self));
- Result := FNodes;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.InternalAdd(ANode, AParent: PNode);
- begin
- Inc(FCount);
- ANode.Parent := AParent;
- NodeAdded(ANode);
- if AParent=nil then
- begin
- FRoot := ANode;
- Exit;
- end;
- // balance after insert
- if AParent.Balance<>0 then
- AParent.Balance := 0
- else
- begin
- if AParent.Left = ANode then
- AParent.Balance := 1
- else
- AParent.Balance := -1;
- ANode := AParent.Parent;
- while ANode <> nil do
- begin
- if ANode.Balance<>0 then
- begin
- if ANode.Balance = 1 then
- begin
- if ANode.Right = AParent then
- ANode.Balance := 0
- else if AParent.Balance = -1 then
- RotateLeftRight(ANode)
- else
- RotateLeftLeft(ANode);
- end
- else
- begin
- if ANode.Left = AParent then
- ANode.Balance := 0
- else if AParent^.Balance = 1 then
- RotateRightLeft(ANode)
- else
- RotateRightRight(ANode);
- end;
- Break;
- end;
- if ANode.Left = AParent then
- ANode.Balance := 1
- else
- ANode.Balance := -1;
- AParent := ANode;
- ANode := ANode.Parent;
- end;
- end;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.InternalDelete(ANode: PNode);
- var
- t, y, z: PNode;
- LNest: boolean;
- begin
- if (ANode.Left <> nil) and (ANode.Right <> nil) then
- begin
- y := FindPredecessor(ANode);
- y.Info := ANode.Info;
- DeletingNode(y, false);
- InternalDelete(y);
- LNest := false;
- end
- else
- begin
- if ANode.Left <> nil then
- begin
- y := ANode.Left;
- ANode.Left := nil;
- end
- else
- begin
- y := ANode.Right;
- ANode.Right := nil;
- end;
- ANode.Balance := 0;
- LNest := true;
- end;
- if y <> nil then
- begin
- y.Parent := ANode.Parent;
- y.Left := ANode.Left;
- if y.Left <> nil then
- y.Left.Parent := y;
- y.Right := ANode.Right;
- if y.Right <> nil then
- y.Right.Parent := y;
- y.Balance := ANode.Balance;
- end;
- if ANode.Parent <> nil then
- begin
- if ANode.Parent.Left = ANode then
- ANode.Parent.Left := y
- else
- ANode.Parent.Right := y;
- end
- else
- FRoot := y;
- if LNest then
- begin
- z := y;
- y := ANode.Parent;
- while y <> nil do
- begin
- if y.Balance = 0 then
- begin
- if y.Left = z then
- y.Balance := -1
- else
- y.Balance := 1;
- break;
- end
- else
- begin
- if ((y.Balance = 1) and (y.Left = z)) or ((y.Balance = -1) and (y.Right = z)) then
- begin
- y.Balance := 0;
- z := y;
- y := y.Parent;
- end
- else
- begin
- if y.Left = z then
- t := y.Right
- else
- t := y.Left;
- if t.Balance = 0 then
- begin
- if y.Balance = 1 then
- RotateLeftLeft(y)
- else
- RotateRightRight(y);
- break;
- end
- else if y.Balance = t.Balance then
- begin
- if y.Balance = 1 then
- RotateLeftLeft(y)
- else
- RotateRightRight(y);
- z := t;
- y := t.Parent;
- end
- else
- begin
- if y.Balance = 1 then
- RotateLeftRight(y)
- else
- RotateRightLeft(y);
- z := y.Parent;
- y := z.Parent;
- end
- end
- end
- end
- end;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetKeys: TKeyCollection;
- begin
- if not Assigned(FKeys) then
- FKeys := TKeyCollection.Create(TTree(Self));
- Result := TKeyCollection(FKeys);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetValues: TValueCollection;
- begin
- if not Assigned(FValues) then
- FValues := TValueCollection.Create(TTree(Self));
- Result := TValueCollection(FValues);
- end;
- constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create;
- begin
- FComparer := TComparer<TKey>.Default;
- end;
- constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create(const AComparer: IComparer<TKey>);
- begin
- FComparer := AComparer;
- end;
- destructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Destroy;
- begin
- FNodes.Free;
- Clear;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue): PNode;
- var
- LParent: PNode;
- begin
- Result := AddNode;
- Result.Data.Key := AKey;
- Result.Data.Value := AValue;
- // insert new node
- case FindInsertNode(Result, LParent) of
- -1: LParent.Left := Result;
- 0:
- if Assigned(LParent) then
- case FDuplicates of
- dupAccept: LParent.Right := Result;
- dupIgnore:
- begin
- LParent.Right := nil;
- DeleteNode(Result, true);
- Exit(LParent);
- end;
- dupError:
- begin
- LParent.Right := nil;
- DeleteNode(Result, true);
- Result := nil;
- raise EListError.Create(SCollectionDuplicate);
- end;
- end;
- 1: LParent.Right := Result;
- end;
- InternalAdd(Result, LParent);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Remove(constref AKey: TKey): boolean;
- var
- LNode: PNode;
- begin
- LNode:=Find(AKey);
- if LNode<>nil then begin
- Delete(LNode);
- Result:=true;
- end else
- Result:=false;
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Delete(ANode: PNode; ADispose: boolean);
- begin
- if (ANode.Left = nil) or (ANode.Right = nil) then
- DeletingNode(ANode, true);
- InternalDelete(ANode);
- DeleteNode(ANode, ADispose);
- Dec(FCount);
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Clear(ADisposeNodes: Boolean);
- begin
- if (FRoot<>nil) and ADisposeNodes then
- DeleteNode(FRoot);
- fRoot:=nil;
- FCount:=0;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetEnumerator: TPairEnumerator;
- begin
- Result := TPairEnumerator.Create(Self, true);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindLowest: PNode;
- begin
- Result:=FRoot;
- if Result<>nil then
- while Result.Left<>nil do Result:=Result.Left;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.FindHighest: PNode;
- begin
- Result:=FRoot;
- if Result<>nil then
- while Result.Right<>nil do Result:=Result.Right;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Find(constref AKey: TKey): PNode;
- var
- LComp: SizeInt;
- begin
- Result:=FRoot;
- while (Result<>nil) do
- begin
- LComp:=Compare(AKey,Result.Key);
- if LComp=0 then
- Exit;
- if LComp<0 then
- Result:=Result.Left
- else
- Result:=Result.Right
- end;
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ContainsKey(constref AKey: TKey; out ANode: PNode): boolean;
- begin
- ANode := Find(AKey);
- Result := Assigned(ANode);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ContainsKey(constref AKey: TKey): boolean; overload; inline;
- begin
- Result := Assigned(Find(AKey));
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.ConsistencyCheck;
- var
- RealCount: SizeInt;
- begin
- RealCount:=0;
- if FRoot<>nil then begin
- FRoot.ConsistencyCheck(Self);
- RealCount:=FRoot.GetCount;
- end;
- if Count<>RealCount then
- raise EAVLTree.Create('Count<>RealCount');
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteTreeNode(AStream: TStream; ANode: PNode);
- var
- b: String;
- IsLeft: boolean;
- LParent: PNode;
- WasLeft: Boolean;
- begin
- if ANode=nil then exit;
- WriteTreeNode(AStream, ANode.Right);
- LParent:=ANode;
- WasLeft:=false;
- b:='';
- while LParent<>nil do begin
- if LParent.Parent=nil then begin
- if LParent=ANode then
- b:='--'+b
- else
- b:=' '+b;
- break;
- end;
- IsLeft:=LParent.Parent.Left=LParent;
- if LParent=ANode then begin
- if IsLeft then
- b:='\-'
- else
- b:='/-';
- end else begin
- if WasLeft=IsLeft then
- b:=' '+b
- else
- b:='| '+b;
- end;
- WasLeft:=IsLeft;
- LParent:=LParent.Parent;
- end;
- b:=b+NodeToReportStr(ANode)+LineEnding;
- WriteStr(AStream, b);
- WriteTreeNode(AStream, ANode.Left);
- end;
- procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.WriteReportToStream(AStream: TStream);
- begin
- WriteStr(AStream, '-Start-of-AVL-Tree-------------------'+LineEnding);
- WriteTreeNode(AStream, fRoot);
- WriteStr(AStream, '-End-Of-AVL-Tree---------------------'+LineEnding);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.NodeToReportStr(ANode: PNode): string;
- begin
- Result:=Format(' Self=%p Parent=%p Balance=%d', [ANode, ANode.Parent, ANode.Balance]);
- end;
- function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ReportAsString: string;
- var ms: TMemoryStream;
- begin
- Result:='';
- ms:=TMemoryStream.Create;
- try
- WriteReportToStream(ms);
- ms.Position:=0;
- SetLength(Result,ms.Size);
- if Result<>'' then
- ms.Read(Result[1],length(Result));
- finally
- ms.Free;
- end;
- end;
- { TAVLTreeMap<TKey, TValue> }
- function TAVLTreeMap<TKey, TValue>.AddNode: PNode;
- begin
- Result := New(PNode);
- Result^ := Default(TNode);
- end;
- procedure TAVLTreeMap<TKey, TValue>.DeleteNode(ANode: PNode; ADispose: boolean = true);
- begin
- if ADispose then
- Dispose(ANode);
- end;
- { TIndexedAVLTreeMap<TKey, TValue> }
- procedure TIndexedAVLTreeMap<TKey, TValue>.RotateRightRight(ANode: PNode);
- var
- LOldRight: PNode;
- begin
- LOldRight:=ANode.Right;
- inherited;
- Inc(LOldRight.Data.Info, (1 + ANode.Data.Info));
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.RotateLeftLeft(ANode: PNode);
- var
- LOldLeft: PNode;
- begin
- LOldLeft:=ANode.Left;
- inherited;
- Dec(ANode.Data.Info, (1 + LOldLeft.Data.Info));
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.RotateRightLeft(ANode: PNode);
- var
- LB, LC: PNode;
- begin
- LB := ANode.Right;
- LC := LB.Left;
- inherited;
- Dec(LB.Data.Info, 1+LC.Info);
- Inc(LC.Data.Info, 1+ANode.Info);
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.RotateLeftRight(ANode: PNode);
- var
- LB, LC: PNode;
- begin
- LB := ANode.Left;
- LC := LB.Right;
- inherited;
- Inc(LC.Data.Info, 1+LB.Info);
- Dec(ANode.Data.Info, 1+LC.Info);
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.NodeAdded(ANode: PNode);
- var
- LParent, LNode: PNode;
- begin
- FLastNode := nil;
- LNode := ANode;
- repeat
- LParent:=LNode.Parent;
- if (LParent=nil) then break;
- if LParent.Left=LNode then
- Inc(LParent.Data.Info);
- LNode:=LParent;
- until false;
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.DeletingNode(ANode: PNode; AOrigin: boolean);
- var
- LParent: PNode;
- begin
- if not AOrigin then
- Dec(ANode.Data.Info);
- FLastNode := nil;
- repeat
- LParent:=ANode.Parent;
- if (LParent=nil) then exit;
- if LParent.Left=ANode then
- Dec(LParent.Data.Info);
- ANode:=LParent;
- until false;
- end;
- function TIndexedAVLTreeMap<TKey, TValue>.AddNode: PNode;
- begin
- Result := PNode(New(PNode));
- Result^ := Default(TNode);
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.DeleteNode(ANode: PNode; ADispose: boolean = true);
- begin
- if ADispose then
- Dispose(ANode);
- end;
- function TIndexedAVLTreeMap<TKey, TValue>.GetNodeAtIndex(AIndex: SizeInt): PNode;
- begin
- if (AIndex<0) or (AIndex>=Count) then
- raise EIndexedAVLTree.CreateFmt('TIndexedAVLTree: AIndex %d out of bounds 0..%d', [AIndex, Count]);
- if FLastNode<>nil then begin
- if AIndex=FLastIndex then
- Exit(FLastNode)
- else if AIndex=FLastIndex+1 then begin
- FLastIndex:=AIndex;
- FLastNode:=FLastNode.Successor;
- Exit(FLastNode);
- end else if AIndex=FLastIndex-1 then begin
- FLastIndex:=AIndex;
- FLastNode:=FLastNode.Precessor;
- Exit(FLastNode);
- end;
- end;
- FLastIndex:=AIndex;
- Result:=FRoot;
- repeat
- if Result.Info>AIndex then
- Result:=Result.Left
- else if Result.Info=AIndex then begin
- FLastNode:=Result;
- Exit;
- end
- else begin
- Dec(AIndex, Result.Info+1);
- Result:=Result.Right;
- end;
- until false;
- end;
- function TIndexedAVLTreeMap<TKey, TValue>.NodeToIndex(ANode: PNode): SizeInt;
- var
- LNode: PNode;
- LParent: PNode;
- begin
- if ANode=nil then
- Exit(-1);
- if FLastNode=ANode then
- Exit(FLastIndex);
- LNode:=ANode;
- Result:=LNode.Info;
- repeat
- LParent:=LNode.Parent;
- if LParent=nil then break;
- if LParent.Right=LNode then
- inc(Result,LParent.Info+1);
- LNode:=LParent;
- until false;
- FLastNode:=ANode;
- FLastIndex:=Result;
- end;
- procedure TIndexedAVLTreeMap<TKey, TValue>.ConsistencyCheck;
- var
- LNode: PNode;
- i: SizeInt;
- LeftCount: SizeInt = 0;
- begin
- inherited ConsistencyCheck;
- i:=0;
- for LNode in Self.Nodes do
- begin
- if LNode.Left<>nil then
- LeftCount:=LNode.Left.GetCount
- else
- LeftCount:=0;
- if LNode.Info<>LeftCount then
- raise EIndexedAVLTree.CreateFmt('LNode.LeftCount=%d<>%d',[LNode.Info,LeftCount]);
- if GetNodeAtIndex(i)<>LNode then
- raise EIndexedAVLTree.CreateFmt('GetNodeAtIndex(%d)<>%P',[i,LNode]);
- FLastNode:=nil;
- if GetNodeAtIndex(i)<>LNode then
- raise EIndexedAVLTree.CreateFmt('GetNodeAtIndex(%d)<>%P',[i,LNode]);
- if NodeToIndex(LNode)<>i then
- raise EIndexedAVLTree.CreateFmt('NodeToIndex(%P)<>%d',[LNode,i]);
- FLastNode:=nil;
- if NodeToIndex(LNode)<>i then
- raise EIndexedAVLTree.CreateFmt('NodeToIndex(%P)<>%d',[LNode,i]);
- inc(i);
- end;
- end;
- function TIndexedAVLTreeMap<TKey, TValue>.NodeToReportStr(ANode: PNode): string;
- begin
- Result:=Format(' Self=%p Parent=%p Balance=%d Idx=%d Info=%d',
- [ANode,ANode.Parent, ANode.Balance, NodeToIndex(ANode), ANode.Info]);
- end;
- { TAVLTree<T> }
- function TAVLTree<T>.Add(constref AValue: T): PNode;
- begin
- Result := inherited Add(AValue, EmptyRecord);
- end;
- { TIndexedAVLTree<T> }
- function TIndexedAVLTree<T>.Add(constref AValue: T): PNode;
- begin
- Result := inherited Add(AValue, EmptyRecord);
- end;
- { TSortedSet<T>.TSortedSetEnumerator }
- function TSortedSet<T>.TSortedSetEnumerator.GetCurrent: T;
- begin
- Result := TTreeEnumerator(FEnumerator).GetCurrent;
- end;
- constructor TSortedSet<T>.TSortedSetEnumerator.Create(ASet: TCustomSet<T>);
- begin
- TTreeEnumerator(FEnumerator) := TSortedSet<T>(ASet).FInternalTree.Keys.DoGetEnumerator;
- end;
- { TSortedSet<T>.TPointersEnumerator }
- function TSortedSet<T>.TPointersEnumerator.DoMoveNext: boolean;
- begin
- Result := FEnumerator.MoveNext;
- end;
- function TSortedSet<T>.TPointersEnumerator.DoGetCurrent: PT;
- begin
- Result := FEnumerator.Current;
- end;
- constructor TSortedSet<T>.TPointersEnumerator.Create(ASortedSet: TSortedSet<T>);
- begin
- FEnumerator := ASortedSet.FInternalTree.Keys.Ptr^.GetEnumerator;
- end;
- { TSortedSet<T> }
- function TSortedSet<T>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TPointersEnumerator.Create(Self);
- end;
- function TSortedSet<T>.GetCount: SizeInt;
- begin
- Result := FInternalTree.Count;
- end;
- function TSortedSet<T>.GetEnumerator: TCustomSetEnumerator;
- begin
- Result := TSortedSetEnumerator.Create(Self);
- end;
- constructor TSortedSet<T>.Create;
- begin
- FInternalTree := TAVLTree<T>.Create;
- end;
- constructor TSortedSet<T>.Create(const AComparer: IComparer<T>);
- begin
- FInternalTree := TAVLTree<T>.Create(AComparer);
- end;
- destructor TSortedSet<T>.Destroy;
- begin
- FInternalTree.Free;
- end;
- function TSortedSet<T>.Add(constref AValue: T): Boolean;
- var
- LNodePtr, LParent: TAVLTree<T>.PNode;
- LNode: TAVLTree<T>.TNode;
- LCompare: Integer;
- begin
- LNode.Data.Key := AValue;
- LCompare := FInternalTree.FindInsertNode(@LNode, LParent);
- Result := not((LCompare=0) and Assigned(LParent));
- if not Result then
- Exit;
- LNodePtr := FInternalTree.AddNode;
- LNodePtr^.Data.Key := AValue;
- case LCompare of
- -1: LParent.Left := LNodePtr;
- 1: LParent.Right := LNodePtr;
- end;
- FInternalTree.InternalAdd(LNodePtr, LParent);
- end;
- function TSortedSet<T>.Remove(constref AValue: T): Boolean;
- var
- LNode: TAVLTree<T>.PNode;
- begin
- LNode := FInternalTree.Find(AValue);
- Result := Assigned(LNode);
- if Result then
- FInternalTree.Delete(LNode);
- end;
- procedure TSortedSet<T>.Clear;
- begin
- FInternalTree.Clear;
- end;
- function TSortedSet<T>.Contains(constref AValue: T): Boolean;
- begin
- Result := FInternalTree.ContainsKey(AValue);
- end;
- { TSortedHashSet<T>.TSortedHashSetEqualityComparer }
- function TSortedHashSet<T>.TSortedHashSetEqualityComparer.Equals(constref ALeft, ARight: PT): Boolean;
- begin
- if Assigned(FComparer) then
- Result := FComparer.Compare(ALeft^, ARight^) = 0
- else
- Result := FEqualityComparer.Equals(ALeft^, ARight^);
- end;
- function TSortedHashSet<T>.TSortedHashSetEqualityComparer.GetHashCode(constref AValue: PT): UInt32;
- begin
- Result := FEqualityComparer.GetHashCode(AValue^);
- end;
- constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AComparer: IComparer<T>);
- begin
- FComparer := AComparer;
- FEqualityComparer := TEqualityComparer<T>.Default;
- end;
- constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AEqualityComparer: IEqualityComparer<T>);
- begin
- FEqualityComparer := AEqualityComparer;
- end;
- constructor TSortedHashSet<T>.TSortedHashSetEqualityComparer.Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>);
- begin
- FComparer := AComparer;
- FEqualityComparer := AEqualityComparer;
- end;
- { TSortedHashSet<T>.TSortedHashSetEnumerator }
- function TSortedHashSet<T>.TSortedHashSetEnumerator.GetCurrent: T;
- begin
- Result := TTreeEnumerator(FEnumerator).Current;
- end;
- constructor TSortedHashSet<T>.TSortedHashSetEnumerator.Create(ASet: TCustomSet<T>);
- begin
- FEnumerator := TSortedHashSet<T>(ASet).FInternalTree.Keys.GetEnumerator;
- end;
- { TSortedHashSet<T>.TPointersEnumerator }
- function TSortedHashSet<T>.TPointersEnumerator.DoMoveNext: boolean;
- begin
- Result := FEnumerator.MoveNext;
- end;
- function TSortedHashSet<T>.TPointersEnumerator.DoGetCurrent: PT;
- begin
- Result := FEnumerator.Current;
- end;
- constructor TSortedHashSet<T>.TPointersEnumerator.Create(ASortedHashSet: TSortedHashSet<T>);
- begin
- FEnumerator := ASortedHashSet.FInternalTree.Keys.Ptr^.GetEnumerator;
- end;
- { TSortedHashSet<T> }
- function TSortedHashSet<T>.GetPtrEnumerator: TEnumerator<PT>;
- begin
- Result := TPointersEnumerator.Create(Self);
- end;
- function TSortedHashSet<T>.DoGetEnumerator: TEnumerator<T>;
- begin
- Result := GetEnumerator;
- end;
- function TSortedHashSet<T>.GetCount: SizeInt;
- begin
- Result := FInternalDictionary.Count;
- end;
- function TSortedHashSet<T>.GetEnumerator: TCustomSetEnumerator;
- begin
- Result := TSortedHashSetEnumerator.Create(Self);
- end;
- function TSortedHashSet<T>.Add(constref AValue: T): Boolean;
- var
- LNode: TAVLTree<T>.PNode;
- begin
- Result := not FInternalDictionary.ContainsKey(@AValue);
- if Result then
- begin
- LNode := FInternalTree.Add(AValue);
- FInternalDictionary.Add(@LNode.Data.Key, EmptyRecord);
- end;
- end;
- function TSortedHashSet<T>.Remove(constref AValue: T): Boolean;
- var
- LIndex: SizeInt;
- begin
- LIndex := FInternalDictionary.FindBucketIndex(@AValue);
- Result := LIndex >= 0;
- if Result then
- begin
- FInternalDictionary.DoRemove(LIndex, cnRemoved);
- FInternalTree.Remove(AValue);
- end;
- end;
- procedure TSortedHashSet<T>.Clear;
- begin
- FInternalDictionary.Clear;
- FInternalTree.Clear;
- end;
- function TSortedHashSet<T>.Contains(constref AValue: T): Boolean;
- begin
- Result := FInternalDictionary.ContainsKey(@AValue);
- end;
- constructor TSortedHashSet<T>.Create;
- begin
- FInternalTree := TAVLTree<T>.Create;
- FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(TEqualityComparer<T>.Default));
- end;
- constructor TSortedHashSet<T>.Create(const AComparer: IEqualityComparer<T>);
- begin
- Create(TComparer<T>.Default, AComparer);
- end;
- constructor TSortedHashSet<T>.Create(const AComparer: IComparer<T>);
- begin
- FInternalTree := TAVLTree<T>.Create(AComparer);
- FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(AComparer));
- end;
- constructor TSortedHashSet<T>.Create(const AComparer: IComparer<T>; const AEqualityComparer: IEqualityComparer<T>);
- begin
- FInternalTree := TAVLTree<T>.Create(AComparer);
- FInternalDictionary := TOpenAddressingLP<PT, TEmptyRecord>.Create(TSortedHashSetEqualityComparer.Create(AComparer,AEqualityComparer));
- end;
- destructor TSortedHashSet<T>.Destroy;
- begin
- FInternalDictionary.Free;
- FInternalTree.Free;
- inherited;
- end;
- end.
|