You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

uutlListBase.pas 11 KiB

7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
7 years ago
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332
  1. unit uutlListBase;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils,
  6. uutlArrayContainer, uutlInterfaces, uutlEnumerator;
  7. type
  8. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  9. generic TutlListBase<T> = class(
  10. specialize TutlArrayContainer<T>
  11. , specialize IEnumerable<T>
  12. , specialize IutlEnumerable<T>)
  13. public type
  14. IEnumerator = specialize IEnumerator<T>;
  15. IutlEnumerator = specialize IutlEnumerator<T>;
  16. private type
  17. TEnumeratorAction = (
  18. eaAdded,
  19. eaRemoved,
  20. eaReallocated
  21. );
  22. TEnumerator = class(
  23. specialize TutlMemoryEnumerator<T>
  24. , IEnumerator
  25. , IutlEnumerator)
  26. private
  27. fOwner: TutlListBase;
  28. fCurrentIsInvalid: Boolean;
  29. fNext: TEnumerator;
  30. fPrev: TEnumerator;
  31. public { IEnumerator }
  32. function GetCurrent: T; override;
  33. function InternalMoveNext: Boolean; override;
  34. procedure InternalReset; override;
  35. {$IFDEF UTL_ENUMERATORS}
  36. public { IutlEnumerator }
  37. function Reverse: IutlEnumerator; override;
  38. {$ENDIF}
  39. public
  40. procedure Update(const aIndex: Integer; const aAction: TEnumeratorAction);
  41. constructor Create(const aOwner: TutlListBase; const aReversed: Boolean); reintroduce;
  42. destructor Destroy; override;
  43. end;
  44. strict private
  45. fCount: Integer;
  46. fFirstEnumerator: TEnumerator;
  47. fLastEnumerator: TEnumerator;
  48. procedure UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction);
  49. protected
  50. function GetCount: Integer; override;
  51. procedure SetCount(const aValue: Integer); override;
  52. function GetItem (const aIndex: Integer): T; virtual;
  53. procedure SetItem (const aIndex: Integer; aValue: T); virtual;
  54. procedure SetCapacity (const aValue: integer); override;
  55. procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
  56. procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;
  57. public { IEnumerable }
  58. function GetEnumerator: IEnumerator;
  59. public { IutlEnumerable }
  60. function GetUtlEnumerator: IutlEnumerator;
  61. public
  62. property Count;
  63. property IsEmpty;
  64. property Capacity;
  65. property CanShrink;
  66. property CanExpand;
  67. property OwnsItems;
  68. procedure Clear; virtual;
  69. procedure ShrinkToFit;
  70. constructor Create(const aOwnsItems: Boolean);
  71. destructor Destroy; override;
  72. end;
  73. implementation
  74. uses
  75. uutlCommon;
  76. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  77. //TutlListBase.TEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  78. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  79. function TutlListBase.TEnumerator.GetCurrent: T;
  80. begin
  81. if fCurrentIsInvalid then
  82. raise EInvalidOperation.Create('current item was deleted, move on with ''MoveNext'' before accessing ''Current''');
  83. result := inherited GetCurrent;
  84. end;
  85. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  86. function TutlListBase.TEnumerator.InternalMoveNext: Boolean;
  87. begin
  88. result := inherited InternalMoveNext;
  89. fCurrentIsInvalid := false;
  90. end;
  91. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  92. procedure TutlListBase.TEnumerator.InternalReset;
  93. begin
  94. First := 0;
  95. Last := fOwner.Count-1;
  96. if (Last >= First)
  97. then Memory := fOwner.GetInternalItem(0)
  98. else Memory := nil;
  99. inherited InternalReset;
  100. end;
  101. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  102. {$IFDEF UTL_ENUMERATORS}
  103. function TutlListBase.TEnumerator.Reverse: IutlEnumerator;
  104. begin
  105. result := TEnumerator.Create(fOwner, not Reversed);
  106. end;
  107. {$ENDIF}
  108. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  109. procedure TutlListBase.TEnumerator.Update(const aIndex: Integer; const aAction: TEnumeratorAction);
  110. begin
  111. case aAction of
  112. eaAdded: begin
  113. if (aIndex <= Current) then
  114. Current := Current + 1;
  115. Last := Last + 1;
  116. end;
  117. eaRemoved: begin
  118. fCurrentIsInvalid := (aIndex = Current);
  119. if (aIndex < Current)
  120. or ( (aIndex = Current)
  121. and not Reversed)
  122. then
  123. Current := Current - 1;
  124. Last := Last - 1;
  125. end;
  126. eaReallocated: begin
  127. if (fOwner.Count > 0)
  128. then Memory := fOwner.GetInternalItem(0)
  129. else Memory := nil;
  130. end;
  131. end;
  132. end;
  133. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  134. constructor TutlListBase.TEnumerator.Create(const aOwner: TutlListBase; const aReversed: Boolean);
  135. begin
  136. if not Assigned(aOwner) then
  137. raise EArgumentNilException.Create('aOwner');
  138. fOwner := aOwner;
  139. if not Assigned(fOwner.fLastEnumerator) then begin
  140. fPrev := nil;
  141. fNext := nil;
  142. fOwner.fFirstEnumerator := self;
  143. fOwner.fLastEnumerator := self;
  144. end else begin
  145. fPrev := fOwner.fLastEnumerator;
  146. fNext := nil;
  147. fOwner.fLastEnumerator.fNext := self;
  148. fOwner.fLastEnumerator := self;
  149. end;
  150. inherited Create(nil, aReversed, 0, -1);
  151. end;
  152. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  153. destructor TutlListBase.TEnumerator.Destroy;
  154. begin
  155. if (fOwner.fFirstEnumerator = self) then
  156. fOwner.fFirstEnumerator := fNext;
  157. if (fOwner.fLastEnumerator = self) then
  158. fOwner.fLastEnumerator := fPrev;
  159. if Assigned(fPrev) then
  160. fPrev.fNext := fNext;
  161. if Assigned(fNext) then
  162. fNext.fPrev := fPrev;
  163. inherited Destroy;
  164. end;
  165. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  166. //TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  167. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  168. procedure TutlListBase.UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction);
  169. var
  170. e: TEnumerator;
  171. begin
  172. e := fFirstEnumerator;
  173. while Assigned(e) do begin
  174. e.Update(aIndex, aAction);
  175. e := e.fNext;
  176. end;
  177. end;
  178. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  179. function TutlListBase.GetCount: Integer;
  180. begin
  181. result := fCount;
  182. end;
  183. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  184. procedure TutlListBase.SetCount(const aValue: Integer);
  185. begin
  186. if (aValue > Capacity) then
  187. Capacity := aValue;
  188. fCount := aValue;
  189. end;
  190. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  191. function TutlListBase.GetItem(const aIndex: Integer): T;
  192. begin
  193. if (aIndex < 0) or (aIndex >= Count) then
  194. raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  195. result := GetInternalItem(aIndex)^;
  196. end;
  197. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  198. procedure TutlListBase.SetItem(const aIndex: Integer; aValue: T);
  199. var
  200. p: PT;
  201. begin
  202. if (aIndex < 0) or (aIndex >= Count) then
  203. raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  204. p := GetInternalItem(aIndex);
  205. Release(p^, true);
  206. p^ := aValue;
  207. end;
  208. procedure TutlListBase.SetCapacity(const aValue: integer);
  209. begin
  210. inherited SetCapacity(aValue);
  211. UpdateEnumerator(0, eaReallocated);
  212. end;
  213. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  214. procedure TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
  215. var
  216. p: PT;
  217. begin
  218. if (aIndex < 0) or (aIndex > fCount) then
  219. raise EOutOfRangeException.Create(aIndex, 0, fCount);
  220. if (fCount = Capacity) then
  221. Expand;
  222. p := GetInternalItem(aIndex);
  223. if (aIndex < fCount) then
  224. System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
  225. FillByte(p^, SizeOf(T), 0); // zero new item (to suppress _release call if it's an interface)
  226. p^ := aValue;
  227. inc(fCount);
  228. UpdateEnumerator(aIndex, eaAdded);
  229. end;
  230. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  231. procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
  232. var
  233. p: PT;
  234. begin
  235. if (aIndex < 0) or (aIndex >= fCount) then
  236. raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  237. dec(fCount);
  238. p := GetInternalItem(aIndex);
  239. Release(p^, aFreeItem);
  240. System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
  241. if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used
  242. SetCapacity(Capacity shr 1); // set to 50% Capacity
  243. FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
  244. UpdateEnumerator(aIndex, eaRemoved);
  245. end;
  246. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  247. function TutlListBase.GetEnumerator: IEnumerator;
  248. begin
  249. result := TEnumerator.Create(self, false);
  250. end;
  251. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. function TutlListBase.GetUtlEnumerator: IutlEnumerator;
  253. begin
  254. result := TEnumerator.Create(self, false);
  255. end;
  256. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  257. procedure TutlListBase.Clear;
  258. begin
  259. while (Count > 0) do begin
  260. dec(fCount);
  261. Release(GetInternalItem(fCount)^, true);
  262. end;
  263. fCount := 0;
  264. if CanShrink then
  265. ShrinkToFit;
  266. end;
  267. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  268. procedure TutlListBase.ShrinkToFit;
  269. begin
  270. Shrink(true);
  271. end;
  272. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  273. constructor TutlListBase.Create(const aOwnsItems: Boolean);
  274. begin
  275. inherited Create(aOwnsItems);
  276. fCount := 0;
  277. end;
  278. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  279. destructor TutlListBase.Destroy;
  280. begin
  281. Clear;
  282. inherited Destroy;
  283. end;
  284. end.