1 unit Antlr.Runtime.Collections;
2 (*
3 [The "BSD licence"]
4 Copyright (c) 2008 Erik van Bilsen
5 Copyright (c) 2005-2007 Kunle Odutola
6 All rights reserved.
7
8 Redistribution and use in source and binary forms, with or without
9 modification, are permitted provided that the following conditions
10 are met:
11 1. Redistributions of source code MUST RETAIN the above copyright
12 notice, this list of conditions and the following disclaimer.
13 2. Redistributions in binary form MUST REPRODUCE the above copyright
14 notice, this list of conditions and the following disclaimer in
15 the documentation and/or other materials provided with the
16 distribution.
17 3. The name of the author may not be used to endorse or promote products
18 derived from this software without specific prior WRITTEN permission.
19 4. Unless explicitly state otherwise, any contribution intentionally
20 submitted for inclusion in this work to the copyright owner or licensor
21 shall be under the terms and conditions of this license, without any
22 additional terms or conditions.
23
24 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
25 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
26 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
27 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
29 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
31 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
32 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
33 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34 *)
35
36 interface
37
38 {$IF CompilerVersion < 20}
39 {$MESSAGE ERROR 'You need Delphi 2009 or higher to use the Antlr runtime'}
40 {$IFEND}
41
42 uses
43 Generics.Collections,
44 Antlr.Runtime.Tools;
45
46 type
47 /// <summary>
48 /// An Hashtable-backed dictionary that enumerates Keys and Values in
49 /// insertion order.
50 /// </summary>
51 IHashList<TKey, TValue> = interface(IDictionary<TKey, TValue>)
52 end;
53
54 /// <summary>
55 /// Stack abstraction that also supports the IList interface
56 /// </summary>
57 IStackList<T> = interface(IList<T>)
58 { Methods }
59
60 /// <summary>
61 /// Adds an element to the top of the stack list.
62 /// </summary>
63 procedure Push(const Item: T);
64
65 /// <summary>
66 /// Removes the element at the top of the stack list and returns it.
67 /// </summary>
68 /// <returns>The element at the top of the stack.</returns>
Pop()69 function Pop: T;
70
71 /// <summary>
72 /// Removes the element at the top of the stack list without removing it.
73 /// </summary>
74 /// <returns>The element at the top of the stack.</returns>
Peek()75 function Peek: T;
76 end;
77
78 type
79 THashList<TKey, TValue> = class(TANTLRObject, IHashList<TKey, TValue>)
80 strict private
81 type
82 TPairEnumerator = class(TEnumerator<TPair<TKey, TValue>>)
83 private
84 FHashList: THashList<TKey, TValue>;
85 FOrderList: IList<TKey>;
86 FIndex: Integer;
87 FVersion: Integer;
88 FPair: TPair<TKey, TValue>;
GetCurrent()89 function GetCurrent: TPair<TKey, TValue>;
90 protected
DoGetCurrent()91 function DoGetCurrent: TPair<TKey, TValue>; override;
DoMoveNext()92 function DoMoveNext: Boolean; override;
93 public
94 constructor Create(const AHashList: THashList<TKey, TValue>);
MoveNext()95 function MoveNext: Boolean;
96 property Current: TPair<TKey, TValue> read GetCurrent;
97 end;
98 private
99 FDictionary: IDictionary<TKey, TValue>;
100 FInsertionOrderList: IList<TKey>;
101 FVersion: Integer;
102 protected
103 { IDictionary<TKey, TValue> }
GetItem(const Key: TKey)104 function GetItem(const Key: TKey): TValue;
105 procedure SetItem(const Key: TKey; const Value: TValue);
GetCount()106 function GetCount: Integer;
107
108 procedure Add(const Key: TKey; const Value: TValue);
109 procedure Remove(const Key: TKey);
110 procedure Clear;
111 procedure TrimExcess;
TryGetValue(const Key: TKey; out Value: TValue)112 function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
113 procedure AddOrSetValue(const Key: TKey; const Value: TValue);
ContainsKey(const Key: TKey)114 function ContainsKey(const Key: TKey): Boolean;
ContainsValue(const Value: TValue)115 function ContainsValue(const Value: TValue): Boolean;
116 public
117 constructor Create; overload;
118 constructor Create(const ACapacity: Integer); overload;
GetEnumerator()119 function GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
120
121 property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
122 end;
123
124 TStackList<T> = class(TList<T>, IStackList<T>)
125 protected
126 { IStackList<T> }
127 procedure Push(const Item: T);
Pop()128 function Pop: T;
Peek()129 function Peek: T;
130 end;
131
132 TCollectionUtils = class
133 public
134 /// <summary>
135 /// Returns a string representation of this IDictionary.
136 /// </summary>
137 /// <remarks>
138 /// The string representation is a list of the collection's elements in the order
139 /// they are returned by its enumerator, enclosed in curly brackets ("{}").
140 /// The separator is a comma followed by a space i.e. ", ".
141 /// </remarks>
142 /// <param name="dict">Dictionary whose string representation will be returned</param>
143 /// <returns>A string representation of the specified dictionary or "null"</returns>
144 class function DictionaryToString(const Dict: IDictionary<Integer, IList<IANTLRInterface>>): String; static;
145
146 /// <summary>
147 /// Returns a string representation of this IList.
148 /// </summary>
149 /// <remarks>
150 /// The string representation is a list of the collection's elements in the order
151 /// they are returned by its enumerator, enclosed in square brackets ("[]").
152 /// The separator is a comma followed by a space i.e. ", ".
153 /// </remarks>
154 /// <param name="coll">Collection whose string representation will be returned</param>
155 /// <returns>A string representation of the specified collection or "null"</returns>
ListToString(const Coll: IList<IANTLRInterface>)156 class function ListToString(const Coll: IList<IANTLRInterface>): String; overload; static;
ListToString(const Coll: IList<String>)157 class function ListToString(const Coll: IList<String>): String; overload; static;
158 end;
159
160 implementation
161
162 uses
163 Classes,
164 SysUtils;
165
166 { THashList<TKey, TValue> }
167
168 procedure THashList<TKey, TValue>.Add(const Key: TKey; const Value: TValue);
169 begin
170 FDictionary.Add(Key, Value);
171 FInsertionOrderList.Add(Key);
172 Inc(FVersion);
173 end;
174
175 procedure THashList<TKey, TValue>.AddOrSetValue(const Key: TKey;
176 const Value: TValue);
177 begin
178 if FDictionary.ContainsKey(Key) then
179 SetItem(Key, Value)
180 else
181 Add(Key, Value);
182 end;
183
184 procedure THashList<TKey, TValue>.Clear;
185 begin
186 FDictionary.Clear;
187 FInsertionOrderList.Clear;
188 Inc(FVersion);
189 end;
190
THashList(const Key: TKey)191 function THashList<TKey, TValue>.ContainsKey(const Key: TKey): Boolean;
192 begin
193 Result := FDictionary.ContainsKey(Key);
194 end;
195
THashList(const Value: TValue)196 function THashList<TKey, TValue>.ContainsValue(const Value: TValue): Boolean;
197 begin
198 Result := FDictionary.ContainsValue(Value);
199 end;
200
201 constructor THashList<TKey, TValue>.Create;
202 begin
203 Create(-1);
204 end;
205
206 constructor THashList<TKey, TValue>.Create(const ACapacity: Integer);
207 begin
208 inherited Create;
209 if (ACapacity < 0) then
210 begin
211 FDictionary := TDictionary<TKey, TValue>.Create;
212 FInsertionOrderList := TList<TKey>.Create;
213 end
214 else
215 begin
216 FDictionary := TDictionary<TKey, TValue>.Create(ACapacity);
217 FInsertionOrderList := TList<TKey>.Create;
218 FInsertionOrderList.Capacity := ACapacity;
219 end;
220 end;
221
THashList()222 function THashList<TKey, TValue>.GetCount: Integer;
223 begin
224 Result := FDictionary.Count;
225 end;
226
THashList()227 function THashList<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
228 begin
229 Result := TPairEnumerator.Create(Self);
230 end;
231
GetItemnull232 function THashList<TKey, TValue>.GetItem(const Key: TKey): TValue;
233 begin
234 Result := FDictionary[Key];
235 end;
236
237 procedure THashList<TKey, TValue>.Remove(const Key: TKey);
238 begin
239 FDictionary.Remove(Key);
240 FInsertionOrderList.Remove(Key);
241 Inc(FVersion);
242 end;
243
244 procedure THashList<TKey, TValue>.SetItem(const Key: TKey; const Value: TValue);
245 var
246 IsNewEntry: Boolean;
247 begin
248 IsNewEntry := (not FDictionary.ContainsKey(Key));
249 FDictionary[Key] := Value;
250 if (IsNewEntry) then
251 FInsertionOrderList.Add(Key);
252 Inc(FVersion);
253 end;
254
255 procedure THashList<TKey, TValue>.TrimExcess;
256 begin
257 FDictionary.TrimExcess;
258 FInsertionOrderList.Capacity := FDictionary.Count;
259 end;
260
THashList(const Key: TKey;261 function THashList<TKey, TValue>.TryGetValue(const Key: TKey;
262 out Value: TValue): Boolean;
263 begin
264 Result := FDictionary.TryGetValue(Key,Value);
265 end;
266
267 { THashList<TKey, TValue>.TPairEnumerator }
268
269 constructor THashList<TKey, TValue>.TPairEnumerator.Create(
270 const AHashList: THashList<TKey, TValue>);
271 begin
272 inherited Create;
273 FHashList := AHashList;
274 FVersion := FHashList.FVersion;
275 FOrderList := FHashList.FInsertionOrderList;
276 end;
277
THashList()278 function THashList<TKey, TValue>.TPairEnumerator.DoGetCurrent: TPair<TKey, TValue>;
279 begin
280 Result := GetCurrent;
281 end;
282
THashList()283 function THashList<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
284 begin
285 Result := MoveNext;
286 end;
287
THashList()288 function THashList<TKey, TValue>.TPairEnumerator.GetCurrent: TPair<TKey, TValue>;
289 begin
290 Result := FPair;
291 end;
292
THashList()293 function THashList<TKey, TValue>.TPairEnumerator.MoveNext: Boolean;
294 begin
295 if (FVersion <> FHashList.FVersion) then
296 raise EInvalidOperation.Create('Collection was modified; enumeration operation may not execute.');
297 if (FIndex < FOrderList.Count) then
298 begin
299 FPair.Key := FOrderList[FIndex];
300 FPair.Value := FHashList[FPair.Key];
301 Inc(FIndex);
302 Result := True;
303 end
304 else
305 begin
306 FPair.Key := Default(TKey);
307 FPair.Value := Default(TValue);
308 Result := False;
309 end;
310 end;
311
312 { TStackList<T> }
313
TStackList()314 function TStackList<T>.Peek: T;
315 begin
316 Result := GetItem(GetCount - 1);
317 end;
318
Popnull319 function TStackList<T>.Pop: T;
320 var
321 I: Integer;
322 begin
323 I := GetCount - 1;
324 Result := GetItem(I);
325 Delete(I);
326 end;
327
328 procedure TStackList<T>.Push(const Item: T);
329 begin
330 Add(Item);
331 end;
332
333 { TCollectionUtils }
334
TCollectionUtils.DictionaryToString(335 class function TCollectionUtils.DictionaryToString(
336 const Dict: IDictionary<Integer, IList<IANTLRInterface>>): String;
337 var
338 SB: TStringBuilder;
339 I: Integer;
340 E: TPair<Integer, IList<IANTLRInterface>>;
341 begin
342 SB := TStringBuilder.Create;
343 try
344 if Assigned(Dict) then
345 begin
346 SB.Append('{');
347 I := 0;
348 for E in Dict do
349 begin
350 if (I > 0) then
351 SB.Append(', ');
352 SB.AppendFormat('%d=%s', [E.Key, ListToString(E.Value)]);
353 Inc(I);
354 end;
355 SB.Append('}');
356 end
357 else
358 SB.Insert(0, 'null');
359 Result := SB.ToString;
360 finally
361 SB.Free;
362 end;
363 end;
364
TCollectionUtils.ListToString(365 class function TCollectionUtils.ListToString(
366 const Coll: IList<IANTLRInterface>): String;
367 var
368 SB: TStringBuilder;
369 I: Integer;
370 Element: IANTLRInterface;
371 Dict: IDictionary<Integer, IList<IANTLRInterface>>;
372 List: IList<IANTLRInterface>;
373 begin
374 SB := TStringBuilder.Create;
375 try
376 if (Coll <> nil) then
377 begin
378 SB.Append('[');
379 for I := 0 to Coll.Count - 1 do
380 begin
381 if (I > 0) then
382 SB.Append(', ');
383 Element := Coll[I];
384 if (Element = nil) then
385 SB.Append('null')
386 else
387 if Supports(Element, IDictionary<Integer, IList<IANTLRInterface>>, Dict) then
388 SB.Append(DictionaryToString(Dict))
389 else
390 if Supports(Element, IList<IANTLRInterface>, List) then
391 SB.Append(ListToString(List))
392 else
393 SB.Append(Element.ToString);
394 end;
395 SB.Append(']');
396 end
397 else
398 SB.Insert(0, 'null');
399 Result := SB.ToString;
400 finally
401 SB.Free;
402 end;
403 end;
404
TCollectionUtils.ListToString(const Coll: IList<String>)405 class function TCollectionUtils.ListToString(const Coll: IList<String>): String;
406 var
407 SB: TStringBuilder;
408 I: Integer;
409 begin
410 SB := TStringBuilder.Create;
411 try
412 if (Coll <> nil) then
413 begin
414 SB.Append('[');
415 for I := 0 to Coll.Count - 1 do
416 begin
417 if (I > 0) then
418 SB.Append(', ');
419 SB.Append(Coll[I]);
420 end;
421 SB.Append(']');
422 end
423 else
424 SB.Insert(0, 'null');
425 Result := SB.ToString;
426 finally
427 SB.Free;
428 end;
429 end;
430
431 end.
432