forked from Sovos-Compliance/convey-public-libs
-
Notifications
You must be signed in to change notification settings - Fork 1
/
DeCAL.pas
12599 lines (10806 loc) · 358 KB
/
DeCAL.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{**
Copyright (c) 2000 Ross Judson<P>
DeCAL is licensed under the terms of the Mozilla Public License. <P>
The contents of this file are subject to the Mozilla Public License
Version 1.0 (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the
License at http://www.mozilla.org/MPL/ <P>
Use tab size 2. DeCAL code can be processed with DelphiDoc to yield
HTML documentation. <P>
<STRONG>
Delphi Container and Algorithm Library 1.0
</STRONG><P>
Author: Ross Judson <BR>
decal@soletta.com <P>
Stepanov's Standard Template Library for C++ demonstrated the power of
generic programming. I purchased ObjectSpace's implementation of STL and,
after climbing the learning curve, came to appreciate the leverage it
gave me when tackling tough problems. <P>
Java lacked the same capabilities until ObjectSpace released JGL, the
Java Generic Library, which is modelled on STL. The hierarchies and
methods that Stepanov designed were extended into Java, with the
peculiarities and powers of that language well taken into account. No
serious Java developer should be without JGL, and no serious C++ developer
should be without STL. <P>
Delphi programmers have lacked similar generic algorithms and containers.
The container classes provided with Delphi are, at best, primitive. They
are, though, easy to use, which is their saving grace. Serious Delphi
applications usually try to bend the existing data structures to their
needs, with varying degrees of success. <P>
There also exist one or two simple data structures libraries. One of these,
Julian Bucknall's EZStruct, implements a number of useful structures. I have
used EZStruct very successfully in the past, but had difficulty with its
inability to store atomic types and use generic algorithms. <P>
What previous solutions were lacking was the strong theoretical foundation
that the STL model provides for generic programming, and the large number
of generic algorithms that come along with it. <P>
DeCAL brings this power to Delphi developers. I hope you enjoy using it, and
I hope that it saves you time and effort. <P>
Learn the algorithms, and what they do! The secret to effectively using
STL, JGL, and DeCAL is developing an implementation vocabulary that
frequently makes use of the generic algorithms. <P>
DeCAL is packaged into a single unit to make it easy to include in your
programs. Some of the names are rather common -- just use DeCAL.xxxxxx to
call a function if there's a conflict. <P>
I wish to express my appreciation to the following authors, whose work has
helped me own. <P>
Martin Waldenburg <BR>
Julian Bucknall <BR>
Vladimir Merzlaikov <BR>
Kurt Westerfeld <P>
}
unit DeCAL;
{$i LibVer.inc}
{$IFDEF VER100}
{$DEFINE DELPHI3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE DELPHI3}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE DELPHI4}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE DELPHI5}
{$ENDIF}
// {$DEFINE DEBUG}
{DEFINE USEPOOLS} // Commented out, we use our own memory manager
{$IFDEF DELPHI3}
{$ELSE}
{$DEFINE USELONGWORD}
{$ENDIF}
// can't seem to ifopt these
//{$IFOPT WARNINGS+}
{$DEFINE WARNINGSON}
//{$ENDIF}
//{$IFOPT HINTS+}
{$DEFINE HINTSON}
//{$ENDIF}
interface
uses Windows, Classes, SysUtils
{$IFDEF GC}
, gc{$ENDIF};
const
DefaultArraySize = 16;
DefaultBucketCount = 128;
STR_MAP = 'MAP';
STR_SET = 'SET';
STR_LIST = 'LIST';
STR_ARRAY = 'ARRAY';
STR_TSTRINGS = 'TSTRINGS';
STR_MULTIMAP = 'MULTIMAP';
STR_MULTISET = 'MULTISET';
STR_HASHMAP = 'HASHMAP';
STR_HASHSET = 'HASHSET';
STR_MULTIHASHSET = 'MULTIHASHSET';
STR_MULTIHASHMAP = 'MULTIHASHMAP';
STR_STACK = 'STACK';
STR_QUEUE = 'QUEUE';
type
{** DeCALBase class is used as the ultimate base for all DeCAL objects. We do
this so we can potentially garbage collect them. }
{$IFDEF GC}
DBaseClass = TGcObject;
{$ELSE}
DBaseClass = TInterfacedObject;
{$ENDIF}
{$IFDEF USELONGWORD}
DeCALDWord = Longword;
{$ELSE}
DeCALDWORD = Integer;
{$ENDIF}
{** DObject are TVarRecs, and can store any kind of atomic value. }
DObject = TVarRec;
{** DArrays keep arrays of DObjects. We declare them using the MaxInt
notation so that they can be of any length. }
DObjectArray = array[0..MaxInt div SizeOf(DObject) - 1] of DObject;
{** A pointer to an arbitrarily sized array of DObjects. }
PDObjectArray = ^DObjectArray;
{** A pointer to an individual DObject. }
PDObject = ^DObject;
{$DEFINE FREEPOSSIBLE}
////////////////////////////////////////////////////////////////////
//
// Forward Declarations
//
////////////////////////////////////////////////////////////////////
DIterHandler = class;
DContainer = class;
DListNode = class;
DTreeNode = class;
DRedBlackTree = class;
IIterHandler = interface;
IContainer = interface;
////////////////////////////////////////////////////////////////////
//
// Iterators
//
////////////////////////////////////////////////////////////////////
{** Flags that can exist on iterators.
<DL>
<DT>
diSimple </DT><DD>
Indicates that the iterator is of the most basic type.</DD>
<DT>
diForward </DT><DD>
An iterator that can move forward only (like for single-
linked lists).</DD>
<DT>
diBidirectional </DT><DD>
An iterator that can move forward and backward.</DD>
<DT>
diRandom </DT><DD>An iterator that can move forward and backward, or to
a particular element quickly (indexed access).</DD>
</DL>}
DIteratorFlag = (diSimple, diForward, diBidirectional, diRandom, diMarkStart, diMarkFinish, diKey, diIteration);
DIteratorFlags = set of DIteratorFlag;
{** Different underlying containers for an iterator. }
DIteratorStucture = (dsArray, dsList, dsMap, dsSet, dsDeque, dsHash);
{** DIterators store positional information within a container.
I'm using a record structure here because records are assignable in Delphi.
We want to be able to pass these iterators around freely, and not have to worry
about continually constructing them and destroying them. That precludes using
the object model. }
PDIterator = ^DIterator;
DIterator = record
flags: DIteratorFlags;
Handler: Pointer;
// JSB: This used to be a IIterHandler, but to avoid interface calls to _Release with destroyed pointer we will case whenever necessary
case DIteratorStucture of
dsArray: (Position: Integer);
dsList: (dnode: DListNode);
dsMap, dsSet: (tree: DRedBlackTree;
treeNode: DTreeNode);
// bucketPosition is placed first so that we can pass this same iterator
// to a secondary sequential structure (like DArray or DList) and make
// use of the same iterator. The problem is that we need to iterate
// over two structures simultaneously.
dsDeque, dsHash: (bucketPosition, bucket: Integer);
end;
{** A DRange stores the beginning and ending to a range within a container. }
DRange = record
start, finish: DIterator;
end;
////////////////////////////////////////////////////////////////////
//
// General Structures
//
////////////////////////////////////////////////////////////////////
{** DPairs store two complete DObjects. They are frequently used by maps
to contain key, value pairs. }
DPair = record
First, second: DObject;
end;
{** Contains a pair of iterators. Not the same as a range -- ranges
will have two iterators that are from the same container. DIteratorPairs
usually have iterators from two different containers. }
DIteratorPair = record
First, second: DIterator;
end;
////////////////////////////////////////////////////////////////////
//
// Exceptions
//
////////////////////////////////////////////////////////////////////
{** DeCALException is the base of all exceptions thrown by DeCAL. All exceptions
thrown should descend from here. }
DException = class(Exception)
end;
{** An exception indicating that the function has not yet been implemented. }
DNotImplemented = class(DException)
constructor Create;
end;
{** Exception, upon needing a bidirectional iterator. The iterator supplied
is not bidirectional, or better. }
DNeedBidirectional = class(DException)
constructor Create;
end;
{** Exception upon needing a random access iterator. The container can't
support the operation being performed. }
DNeedRandom = class(DException)
constructor Create;
end;
{** Exception upon acting on an empty container. The operation being performed
requires that the container be non-empty. }
DEmpty = class(Exception)
constructor Create;
end;
////////////////////////////////////////////////////////////////////
//
// Comparison
//
////////////////////////////////////////////////////////////////////
{** A closure that can compare two objects and returns less than zero if
obj1 is less than obj2, 0 if obj1 equals obj2, and greater than zero if
obj1 is greater than obj2;
@param obj1 The first object (left hand side).
@param obj2 The second object (right hand side).}
DComparator = function(const obj1, obj2: DObject): Integer of object;
{** A procedural equivalent to the DComparator closure. Use these when you
want your comparator to be a procedure instead of a closure. They can be
converted to DComparator with the MakeComparator function. }
DComparatorProc = function(Ptr: Pointer; const obj1, obj2: DObject): Integer;
{** Test to see if the two objects are the same. }
DEquals = function(const obj1, obj2: DObject): Boolean of object;
{** Procedural equivalent to DEquals. }
DEqualsProc = function(Ptr: Pointer; const obj1, obj2: DObject): Boolean;
{** Apply a generic test to an object. Usually used to select objects from
a container. }
DTest = function(const obj: DObject): Boolean of object;
{** Procedural equivalent to DTest. }
DTestProc = function(Ptr: Pointer; const obj: DObject): Boolean;
{** Apply a test to two objects. }
DBinaryTest = function(const obj1, obj2: DObject): Boolean of object;
{** Procedural equivalent to DBinaryTest. }
DBinaryTestProc = function(Ptr: Pointer; const obj1, obj2: DObject): Boolean;
{** Apply a function to an object. Usually used in apply functions. }
DApply = procedure(const obj: DObject) of object;
{** Procedural equivalent to DApply. }
DApplyProc = procedure(Ptr: Pointer; const obj: DObject);
{** Apply a function to an object. Usually used in collect functions. }
DUnary = function(const obj: DObject): DObject of object;
{** Procedural equivalent to DUnary. }
DUnaryProc = function(Ptr: Pointer; const obj: DObject): DObject;
{** Apply a function to two objects. Usually used in transform functions. }
DBinary = function(const obj1, obj2: DObject): DObject of object;
{** Procedural equivalent to DBinary. }
DBinaryProc = function(Ptr: Pointer; const obj1, obj2: DObject): DObject;
{** A generator creates DObjects. }
DGenerator = function: DObject of object;
{** Procedural equivalent to DGenerator.}
DGeneratorProc = function(Ptr: Pointer): DObject;
// General interface for all containers
IIterHandler = interface
['{8B66BBC3-7194-47F0-958B-AE971787861D}']
procedure iadvance(var iterator: DIterator);
procedure iadvanceBy(var iterator: DIterator; Count: Integer);
function iatEnd(const iterator: DIterator): Boolean;
function iatStart(const iterator: DIterator): Boolean;
function idistance(const iter1, iter2: DIterator): Integer;
function iequals(const iter1, iter2: DIterator): Boolean;
procedure iflagChange(var iterator: DIterator; oldflags: DIteratorFlags);
function iget(const iterator: DIterator): PDObject;
function igetAt(const iterator: DIterator; offset: Integer): PDObject;
function igetContainer(const iterator: DIterator): IContainer;
function iindex(const iterator: DIterator): Integer;
function iless(const iter1, iter2: DIterator): Boolean;
procedure iput(const iterator: DIterator; const obj: DObject);
procedure iputAt(const iterator: DIterator; offset: Integer; const obj: DObject);
function iremove(const iterator: DIterator): DIterator;
procedure iretreat(var iterator: DIterator);
procedure iretreatBy(var iterator: DIterator; Count: Integer);
procedure _iput(const iterator: DIterator; objs: array of const);
function GetSelf: DIterHandler;
end;
IContainer = interface(IIterHandler)
['{F1FEA580-200A-484F-9466-93BAC99A4E81}']
procedure add(objs: array of const);
procedure addRef(const obj: DObject);
function binaryCompare(const obj1, obj2: DObject): Integer;
function binaryTest(const obj1, obj2: DObject): Boolean;
function CaselessStringComparator(const obj1, obj2: DObject): Integer;
procedure Clear;
function clone: IContainer;
function contains(objs: array of const): Boolean;
function Count(objs: array of const): Integer;
function DObjectComparator(const obj1, obj2: DObject): Integer;
procedure ensureCapacity(amount: Integer);
function finish: DIterator;
procedure getBinaryTest(var bt: DBinaryTest);
procedure getComparator(var compare: DComparator);
function hashComparator(const obj1, obj2: DObject): Integer;
function isEmpty: Boolean;
function maxSize: Integer;
procedure remove(objs: array of const);
function Size: Integer;
function start: DIterator;
procedure trimToSize;
function usesPairs: Boolean;
procedure _add(const obj: DObject);
function _contains(const obj: DObject): Boolean;
function _count(const obj: DObject): Integer;
procedure _remove(const obj: DObject);
{procedure iadvanceBy(var iterator : DIterator; count : Integer);
function iatEnd(const iterator : DIterator): Boolean;
function iatStart(const iterator : DIterator): Boolean;
function idistance(const iter1, iter2 : DIterator): Integer;
procedure iflagChange(var iterator : DIterator; oldflags : DIteratorFlags);
function igetAt(const iterator : DIterator; offset : Integer): PDObject;
function igetContainer(const iterator : DIterator): IContainer;
function iindex(const iterator : DIterator): Integer;
function iless(const iter1, iter2 : DIterator): Boolean;
procedure iputAt(const iterator : DIterator; offset : Integer; const obj :
DObject);
procedure iretreat(var iterator : DIterator);
procedure iretreatBy(var iterator : DIterator; count : Integer);}
procedure _clear(direct: Boolean);
//procedure _iput(const iterator : DIterator; objs : array of const);
procedure cloneTo(newContainer: IContainer);
end;
ISequence = interface(IContainer)
['{5D7E120B-D40C-412B-9B0F-AA82788E57DE}']
function at(Pos: Integer): DObject;
function atAsBoolean(Pos: Integer): Boolean;
function atAsChar(Pos: Integer): AnsiChar;
function atAsClass(Pos: Integer): TClass;
function atAsCurrency(Pos: Integer): Currency;
function atAsExtended(Pos: Integer): Extended;
function atAsInt64(Pos: Integer): Int64;
function atAsInteger(Pos: Integer): Integer;
function atAsInterface(Pos: Integer): Pointer;
function atAsObject(Pos: Integer): TObject;
function atAsPChar(Pos: Integer): PAnsiChar;
function atAsPointer(Pos: Integer): Pointer;
function atAsPWideChar(Pos: Integer): PWideChar;
function atAsShortString(Pos: Integer): ShortString;
function atAsString(Pos: Integer): string;
function atAsVariant(Pos: Integer): Variant;
function atAsWideChar(Pos: Integer): Widechar;
function atAsWideString(Pos: Integer): WideString;
function atRef(Pos: Integer): PDObject;
function back: DObject;
function backRef: PDObject;
function countWithin(_begin, _end: Integer; objs: array of const): Integer;
function front: DObject;
function frontRef: PDObject;
function IndexOf(objs: array of const): Integer;
function indexOfWithin(_begin, _end: Integer; objs: array of const): Integer;
function popBack: DObject;
function popFront: DObject;
procedure pushBack(objs: array of const);
procedure pushFront(objs: array of const);
procedure putAt(index: Integer; objs: array of const);
function removeAtIter(iter: DIterator; Count: Integer): DIterator;
procedure removeWithin(_begin, _end: Integer; objs: array of const);
procedure replace(sources, targets: array of const);
procedure replaceWithin(_begin, _end: Integer; sources, targets: array of const);
procedure _add(const obj: DObject);
function _countWithin(_begin, _end: Integer; const obj: DObject): Integer;
function _indexOf(const obj: DObject): Integer;
function _indexOfWithin(_begin, _end: Integer; const obj: DObject): Integer;
procedure _pushBack(const obj: DObject);
procedure _pushFront(const obj: DObject);
procedure _putAt(index: Integer; const obj: DObject);
procedure _remove(const obj: DObject);
procedure _removeWithin(_begin, _end: Integer; const obj: DObject);
procedure _replace(obj1, obj2: DObject);
procedure _replaceWithin(_begin, _end: Integer; obj1, obj2: DObject);
end;
IList = interface(ISequence)
['{9D0E684C-2DC3-41E3-88C8-4465D53EA6D8}']
procedure cut(_start, _finish: DIterator);
procedure insertAtIter(iterator: DIterator; objs: array of const);
procedure mergeSort;
procedure mergeSortWith(compare: DComparator);
end;
IVector = interface(ISequence)
['{EBD689AD-2D43-4D26-989C-9B9348F27429}']
function capacity: Integer;
procedure insertAt(index: Integer; objs: array of const);
procedure insertAtIter(iterator: DIterator; objs: array of const);
procedure insertMultipleAt(index: Integer; Count: Integer; obj: array of const);
procedure insertMultipleAtIter(iterator: DIterator; Count: Integer; obj: array of const);
procedure insertRangeAt(index: Integer; _start, _finish: DIterator);
procedure insertRangeAtIter(iterator: DIterator; _start, _finish: DIterator);
function legalIndex(index: Integer): Boolean;
procedure removeAt(index: Integer);
procedure removeBetween(_begin, _end: Integer);
procedure setCapacity(amount: Integer);
procedure _insertAt(index: Integer; const obj: DObject);
procedure _insertAtIter(iterator: DIterator; const obj: DObject);
procedure _insertMultipleAt(index: Integer; Count: Integer; const obj: DObject);
procedure _insertMultipleAtIter(iterator: DIterator; Count: Integer; const obj: DObject);
procedure _removeWithin(_begin, _end: Integer; const obj: DObject);
end;
IArray = interface(IVector)
['{9A6C1A8D-5779-4269-896A-7B0B7DBD343C}']
function blockFactor: Integer;
procedure Copy(another: IArray);
procedure copyTo(another: IArray);
procedure setBlockFactor(factor: Integer);
procedure SetSize(newSize: Integer);
end;
ITStrings = interface(IVector)
['{27800464-A83F-47E1-A83B-401210A11510}']
procedure SetSize(newSize: Integer);
end;
IAssociative = interface(IContainer)
['{252A1778-7EEB-44BD-AAF4-0FE3C374663D}']
function allowsDuplicates: Boolean;
function countValues(Value: array of const): Integer;
function getAt(key: array of const): DObject;
function locate(key: array of const): DIterator;
procedure putAt(key, Value: array of const);
procedure putPair(pair: array of const);
procedure removeAt(iterator: DIterator);
procedure removeIn(_start, _finish: DIterator);
procedure removeValue(Value: array of const);
procedure removeValueN(Value: array of const; Count: Integer);
function startKey: DIterator;
function _countValues(const Value: DObject): Integer;
function _getAt(const key: DObject): DObject;
function _locate(const key: DObject): DIterator;
procedure _putAt(const key, Value: DObject);
procedure _removeN(const key: DObject; Count: Integer);
procedure _removeValueN(const Value: DObject; Count: Integer);
end;
IMap = interface(IAssociative)
['{619D44AA-ABE0-4AD7-A4CB-A02AC272E1EE}']
function lower_bound(obj: array of const): DIterator;
function upper_bound(obj: array of const): DIterator;
function _lower_bound(const key: DObject): DIterator;
function _upper_bound(const key: DObject): DIterator;
end;
ISet = interface(IAssociative)
['{9936C24A-7BEB-4941-B385-EA50FB89B72F}']
function includes(obj: array of const): Boolean;
function _includes(const obj: DObject): Boolean;
end;
////////////////////////////////////////////////////////////////////
//
// IterHandler
//
////////////////////////////////////////////////////////////////////
{**
This class is defined separately so that we can create special types
of iterators that aren't actually containers. For example, we can
create an iterator that can put objects to an object stream, or an
iterator that filters another iterator.
}
DIterHandler = class(DBaseClass, IIterHandler)
protected
//
// Iterator manipulation.
//
{** Subclasses must advance the given iterator. Must be implemented.
@param iterator The iterator to be advanced.
}
procedure iadvance(var iterator: DIterator); virtual; abstract;
{** Subclasses must get the object at the given iterator. Must be implemented.
@param iterator The iterator at which to get the object.
}
function iget(const iterator: DIterator): PDObject; virtual; abstract;
{** Subclasses must determine if the two iterators are positioned at the
same element.
@param iter1 The first iterator
@param iter2 The second iterator
}
function iequals(const iter1, iter2: DIterator): Boolean; virtual; abstract;
{** Store an object at the given iterator. Must be implemented by subclasses.
@param iterator The position to store at.
@param obj The object to put there.
}
procedure iput(const iterator: DIterator; const obj: DObject); virtual; abstract;
{** Store an array of objects (or atomic values) in the container. IContainer
contains an implementation of this that will repeatedly call iput.
@param iterator Where to put the objects.
@param objs The objects to store.
}
procedure _iput(const iterator: DIterator; objs: array of const); virtual; abstract;
{** Move an iterator. count can be positive or negative. The default
implementation uses repeated advance or retreat functions. Containers that
support random access will be able to implement this more effectively.
@param iterator The iterator to move.
@param count How much to move it (positive or negative).}
procedure iadvanceBy(var iterator: DIterator; Count: Integer); virtual; abstract;
{** Determine if the given iterator is at the start of the container.
@param iterator The iterator to test. }
function iatStart(const iterator: DIterator): Boolean; virtual; abstract;
{** Determine if the given iterator is at the end of the container.
@param iterator The iterator to test. }
function iatEnd(const iterator: DIterator): Boolean; virtual; abstract;
{** Returns the container associated with the iterator. If there is no
container for this iterator, it returns nil.
@param iterator The iterator whose container should be returned. }
function igetContainer(const iterator: DIterator): IContainer; virtual;
abstract;
{** Removes the item the iterator is positioned at, and returns an iterator
positioned on the item that is next. Returns an atEnd iterator if there's
no following item. }
function iremove(const iterator: DIterator): DIterator; virtual; abstract;
{** Determines the number of positions between two iterators. For example,
if iter1 points at the second element in an array and iter2 points at the
fifth, the distance will be three.
@param iter1 The beginning iterator.
@param iter2 The ending iterator. }
function idistance(const iter1, iter2: DIterator): Integer; virtual; abstract;
// bidirectional
{** Moves an iterator backwards by one position. }
procedure iretreat(var iterator: DIterator); virtual; abstract;
{** Moves an iterator backwards by count positions. }
procedure iretreatBy(var iterator: DIterator; Count: Integer); virtual; abstract;
{** Retrieve the item at a given offset from the current iterator position. }
function igetAt(const iterator: DIterator; offset: Integer): PDObject; virtual; abstract;
{** Puts an item at a given offset from the current iterator position. }
procedure iputAt(const iterator: DIterator; offset: Integer; const obj: DObject); virtual; abstract;
{** Returns the integer index associated with an iterator. }
function iindex(const iterator: DIterator): Integer; virtual; abstract;
{** Determines if iter1 is "less" (positioned earlier in the container) than
iter2. }
function iless(const iter1, iter2: DIterator): Boolean; virtual; abstract;
// utility
procedure iflagChange(var iterator: DIterator; oldflags: DIteratorFlags); virtual; abstract;
// pointer to self as an object
function GetSelf: DIterHandler;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
////////////////////////////////////////////////////////////////////
//
// Iterator Adapters
//
////////////////////////////////////////////////////////////////////
{** DIterAdapter is an abstract base class for other classes that can
modify the iterator manipulation behavior of a container. }
DIterAdapter = class(DIterHandler)
protected
FTarget: IIterHandler;
//
// Iterator manipulation.
//
{** Subclasses must advance the given iterator. Must be implemented.
@param iterator The iterator to be advanced.
}
procedure iadvance(var iterator: DIterator); override;
{** Subclasses must get the object at the given iterator. Must be implemented.
@param iterator The iterator at which to get the object.
}
function iget(const iterator: DIterator): PDObject; override;
{** Subclasses must determine if the two iterators are positioned at the
same element.
@param iter1 The first iterator
@param iter2 The second iterator
}
function iequals(const iter1, iter2: DIterator): Boolean; override;
{** Store an object at the given iterator. Must be implemented by subclasses.
@param iterator The position to store at.
@param obj The object to put there.
}
procedure iput(const iterator: DIterator; const obj: DObject); override;
{** Store an array of objects (or atomic values) in the container. IContainer
contains an implementation of this that will repeatedly call iput.
@param iterator Where to put the objects.
@param objs The objects to store.
}
procedure _iput(const iterator: DIterator; objs: array of const); override;
{** Move an iterator. count can be positive or negative. The default
implementation uses repeated advance or retreat functions. Containers that
support random access will be able to implement this more effectively.
@param iterator The iterator to move.
@param count How much to move it (positive or negative).}
procedure iadvanceBy(var iterator: DIterator; Count: Integer); override;
function iremove(const iterator: DIterator): DIterator; override;
function iatStart(const iterator: DIterator): Boolean; override;
function iatEnd(const iterator: DIterator): Boolean; override;
function igetContainer(const iterator: DIterator): IContainer; override;
function idistance(const iter1, iter2: DIterator): Integer; override;
// bidirectional
procedure iretreat(var iterator: DIterator); override;
procedure iretreatBy(var iterator: DIterator; Count: Integer); override;
function igetAt(const iterator: DIterator; offset: Integer): PDObject; override;
procedure iputAt(const iterator: DIterator; offset: Integer; const obj: DObject); override;
// random
function iindex(const iterator: DIterator): Integer; override;
function iless(const iter1, iter2: DIterator): Boolean; override;
procedure iflagChange(var iterator: DIterator; oldflags: DIteratorFlags); override;
public
constructor Create(var target: DIterator);
end;
{** DIterFilter adapters apply a test to underlying objects to determine
if they should be part of the adapted container. Pass a test to the
constructor. Then, each time an iterator is advanced or retreated, items
that don't pass the test will be skipped over. }
DIterFilter = class(DIterAdapter)
protected
FTest: DTest;
procedure iadvance(var iterator: DIterator); override;
procedure iretreat(var iterator: DIterator); override;
public
{** Construct a DIterFilter, using test as the filter to determine if
a given item should be part of the filtered container.
@param target An iterator representing the container or range to be filtered.
@param test The test used to determine if an item is part of the sequence or
not. Only those items that pass the test will be part of the
filtered sequence. }
constructor Create(var target: DIterator; test: DTest);
end;
{** DIterSkipper adapters skip forward or backward by an integral number of
items each time the iterator is advanced or retreated. Pass the skip
value to the constructor. }
DIterSkipper = class(DIterAdapter)
protected
FSkipBy: Integer;
procedure iadvance(var iterator: DIterator); override;
procedure iretreat(var iterator: DIterator); override;
public
constructor Create(var target: DIterator; skipBy: Integer);
end;
////////////////////////////////////////////////////////////////////
//
// Container
//
////////////////////////////////////////////////////////////////////
{** DContainer is the base class of all containers. It provides a number of
generic facilities for container usage and management. The basic iterator
manipulation routines are made virtual and abstract, forcing subclasses to
implement them. }
DContainer = class(DIterHandler, IContainer)
protected
comparator: DComparator;
procedure cloneTo(newContainer: IContainer); virtual;
protected
//
// Iterator manipulation.
//
procedure _iput(const iterator: DIterator; objs: array of const); override;
{** Move an iterator. count can be positive or negative. The default
implementation uses repeated advance or retreat functions. Containers that
support random access will be able to implement this more effectively.
@param iterator The iterator to move.
@param count How much to move it (positive or negative).}
procedure iadvanceBy(var iterator: DIterator; Count: Integer); override;
function iatStart(const iterator: DIterator): Boolean; override;
function iatEnd(const iterator: DIterator): Boolean; override;
function igetContainer(const iterator: DIterator): IContainer; override;
function idistance(const iter1, iter2: DIterator): Integer; override;
// bidirectional
procedure iretreat(var iterator: DIterator); override;
procedure iretreatBy(var iterator: DIterator; Count: Integer); override;
function igetAt(const iterator: DIterator; offset: Integer): PDObject; override;
procedure iputAt(const iterator: DIterator; offset: Integer; const obj: DObject); override;
// random
function iindex(const iterator: DIterator): Integer; override;
function iless(const iter1, iter2: DIterator): Boolean; override;
procedure iflagChange(var iterator: DIterator; oldflags: DIteratorFlags); override;
procedure _clear(direct: Boolean); virtual; abstract;
public
{** Add a DObject to this container. The object is copied and added to
the container.
@param obj The object to add.
}
procedure _add(const obj: DObject); virtual; abstract;
{** Add a DObject to this container. The object is NOT copied -- it
is moved into the container. Do not clear the object afterwards. }
procedure addRef(const obj: DObject); virtual;
{** Add an array of objects to the container. This call makes use of
Delphi's open array system, and as such the array can contain any type
of object. Each object will be copied into the container. }
procedure add(objs: array of const); virtual;
{** Remove all instances of an object, by value, from the container. }
procedure _remove(const obj: DObject); virtual; abstract;
{** Remove all instances of each in an array of objects, by value, from the container. }
procedure remove(objs: array of const); virtual;
{** Clear this container of all contents. Note that this does not perform
any type of free or destructor operation. If you want to free all the
objects in a container before clearing if, use the ObjFree algorithm. }
procedure Clear; virtual;
{** Inform the container that "amount" items are going to be inserted.
Most containers don't have any concept of setting the capacity, but
for those that do, algorithms can call this to provide a hint to the
container about how many items are going to be inserted. }
procedure ensureCapacity(amount: Integer); virtual;
{** Request that the container use the minimum amount of memory possible
for its current contents. Note that this is only a hint to the container;
it may or may not have any effect. }
procedure trimToSize; virtual;
{** Return an iterator positioned after the last element in the container.
Note that the finish position is a valid insertion point for those containers
that can have the add operation performed. }
function finish: DIterator; virtual; abstract;
{** Return the absolute maximum number of objects that can be stored in
this container. The container does not necessarily have this space allocated;
it is just the maximum that <i>could</i> be allocated. }
function maxSize: Integer; virtual; abstract;
{** Return an iterator positioned on the first object in the container. }
function start: DIterator; virtual; abstract;
{** Return a complete copy of this container. This is a copy by value, as
all objects are stored in IContainers by value. }
function clone: IContainer; virtual;
{** Requests that this container compare two DObjects using its current
comparator. If obj1 is less than obj2, the result is negative. If they
are equal, the result is 0; otherwise it is positive. }
function binaryCompare(const obj1, obj2: DObject): Integer;
{** Determines if two objects are equal, using this container's current
comparator. }
function binaryTest(const obj1, obj2: DObject): Boolean;
{** Requests the comparator currently being used by this container. }
procedure getComparator(var compare: DComparator); virtual;
{** Retrives the current comparator of this container as a binary test,
which enables testing for equality only. }
procedure getBinaryTest(var bt: DBinaryTest); virtual;
{** Determines if this container is empty. }
function isEmpty: Boolean; virtual;
{** Determines the number of objects currently in this container. }
function Size: Integer; virtual;
{** Determine if this container has an object matching obj. }
function _contains(const obj: DObject): Boolean; virtual;
{** Determine if this container has an object matching any of objs. }
function contains(objs: array of const): Boolean; virtual;
{** Determine the number of items matching obj. }
function _count(const obj: DObject): Integer; virtual;
{** Determine the total number of items matching objs. }
function Count(objs: array of const): Integer; virtual;
{** Does this container use pairs?}
function usesPairs: Boolean; virtual;
{** A comparator that uses hashes to differentiate objects. }
function hashComparator(const obj1, obj2: DObject): Integer;
{** A comparator that compares strings without case sensitivity. }
function CaselessStringComparator(const obj1, obj2: DObject): Integer;
{** The standard comparator that can compare all atomic types. }
function DObjectComparator(const obj1, obj2: DObject): Integer;
constructor Create; virtual;
constructor CreateWith(compare: DComparator); virtual;
procedure setComparator(AComparator: DComparator); virtual;
end;
DContainerClass = class of DContainer;
////////////////////////////////////////////////////////////////////
//
// Container Adapters
//
////////////////////////////////////////////////////////////////////
{** A container adapter is used to give a container a certain kind of
interface. For example, by using the DStack adapter, any sequential
container can be made to have stack-like behavior. All adapter classes
should descend from DAdapter. }
DAdapter = class(DContainer)
protected
FContainer: IContainer; // the container we are wrapping.
public
// constructor CreateOn(cont : IContainer);
end;
DAdapterClass = class of DAdapter;
DStack = class(DAdapter)
public
{
procedure _Push(const obj : DObject); virtual;
procedure Push(obj : array of const); virtual;
function _Pop : DObject; virtual;
function PopXXX...
}
end;
DQueue = class(DAdapter)
end;
////////////////////////////////////////////////////////////////////
//
// Sequences
//
////////////////////////////////////////////////////////////////////
{** DSequence is an abstract base class for containers that hold their
items in a defined order. }
DSequence = class(DContainer, ISequence)
public
// Container overrides
{** Add a DObject to this container. The object is copied and added to
the container.
@param obj The object to add.
}
procedure _add(const obj: DObject); override;
{** Removes an object, by value, from this sequence. }
procedure _remove(const obj: DObject); override;
// DSequence stuff
{** Return the item at the given position. Note that returning this item
may or may not be an efficient implementation. DVector-based structures
will be more efficient. The returned object can be converted with a toXXX
function. }
function at(Pos: Integer): DObject; virtual;
{** Return a reference to the DObject at the given position. }
function atRef(Pos: Integer): PDObject; virtual;
{** Return a reference to the last item in the sequence. }
function backRef: PDObject; virtual;
{** Return the last item in the sequence. This returned item must be
correctly disposed of, or converted with a toXXX function. }
function back: DObject; virtual;
{** Count the number of times an item occurs in a given range. }
function _countWithin(_begin, _end: Integer; const obj: DObject): Integer; virtual;
{** Count the number of times an item occurs in a given range. }