1unit Antlr.Runtime.Collections;
2(*
3[The "BSD licence"]
4Copyright (c) 2008 Erik van Bilsen
5Copyright (c) 2005-2007 Kunle Odutola
6All rights reserved.
7
8Redistribution and use in source and binary forms, with or without
9modification, are permitted provided that the following conditions
10are met:
111. Redistributions of source code MUST RETAIN the above copyright
12   notice, this list of conditions and the following disclaimer.
132. 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.
173. The name of the author may not be used to endorse or promote products
18   derived from this software without specific prior WRITTEN permission.
194. 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
24THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
25IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
26OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
27IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
28INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
29NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
31THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
32(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
33THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34*)
35
36interface
37
38{$IF CompilerVersion < 20}
39{$MESSAGE ERROR 'You need Delphi 2009 or higher to use the Antlr runtime'}
40{$IFEND}
41
42uses
43  Generics.Collections,
44  Antlr.Runtime.Tools;
45
46type
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>
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>
75    function Peek: T;
76  end;
77
78type
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>;
89        function GetCurrent: TPair<TKey, TValue>;
90      protected
91        function DoGetCurrent: TPair<TKey, TValue>; override;
92        function DoMoveNext: Boolean; override;
93      public
94        constructor Create(const AHashList: THashList<TKey, TValue>);
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> }
104    function GetItem(const Key: TKey): TValue;
105    procedure SetItem(const Key: TKey; const Value: TValue);
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;
112    function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
113    procedure AddOrSetValue(const Key: TKey; const Value: TValue);
114    function ContainsKey(const Key: TKey): Boolean;
115    function ContainsValue(const Value: TValue): Boolean;
116  public
117    constructor Create; overload;
118    constructor Create(const ACapacity: Integer); overload;
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);
128    function Pop: T;
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>
156    class function ListToString(const Coll: IList<IANTLRInterface>): String; overload; static;
157    class function ListToString(const Coll: IList<String>): String; overload; static;
158  end;
159
160implementation
161
162uses
163  Classes,
164  SysUtils;
165
166{ THashList<TKey, TValue> }
167
168procedure THashList<TKey, TValue>.Add(const Key: TKey; const Value: TValue);
169begin
170  FDictionary.Add(Key, Value);
171  FInsertionOrderList.Add(Key);
172  Inc(FVersion);
173end;
174
175procedure THashList<TKey, TValue>.AddOrSetValue(const Key: TKey;
176  const Value: TValue);
177begin
178  if FDictionary.ContainsKey(Key) then
179    SetItem(Key, Value)
180  else
181    Add(Key, Value);
182end;
183
184procedure THashList<TKey, TValue>.Clear;
185begin
186  FDictionary.Clear;
187  FInsertionOrderList.Clear;
188  Inc(FVersion);
189end;
190
191function THashList<TKey, TValue>.ContainsKey(const Key: TKey): Boolean;
192begin
193  Result := FDictionary.ContainsKey(Key);
194end;
195
196function THashList<TKey, TValue>.ContainsValue(const Value: TValue): Boolean;
197begin
198  Result := FDictionary.ContainsValue(Value);
199end;
200
201constructor THashList<TKey, TValue>.Create;
202begin
203  Create(-1);
204end;
205
206constructor THashList<TKey, TValue>.Create(const ACapacity: Integer);
207begin
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;
220end;
221
222function THashList<TKey, TValue>.GetCount: Integer;
223begin
224  Result := FDictionary.Count;
225end;
226
227function THashList<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
228begin
229  Result := TPairEnumerator.Create(Self);
230end;
231
232function THashList<TKey, TValue>.GetItem(const Key: TKey): TValue;
233begin
234  Result := FDictionary[Key];
235end;
236
237procedure THashList<TKey, TValue>.Remove(const Key: TKey);
238begin
239  FDictionary.Remove(Key);
240  FInsertionOrderList.Remove(Key);
241  Inc(FVersion);
242end;
243
244procedure THashList<TKey, TValue>.SetItem(const Key: TKey; const Value: TValue);
245var
246  IsNewEntry: Boolean;
247begin
248  IsNewEntry := (not FDictionary.ContainsKey(Key));
249  FDictionary[Key] := Value;
250  if (IsNewEntry) then
251    FInsertionOrderList.Add(Key);
252  Inc(FVersion);
253end;
254
255procedure THashList<TKey, TValue>.TrimExcess;
256begin
257  FDictionary.TrimExcess;
258  FInsertionOrderList.Capacity := FDictionary.Count;
259end;
260
261function THashList<TKey, TValue>.TryGetValue(const Key: TKey;
262  out Value: TValue): Boolean;
263begin
264  Result := FDictionary.TryGetValue(Key,Value);
265end;
266
267{ THashList<TKey, TValue>.TPairEnumerator }
268
269constructor THashList<TKey, TValue>.TPairEnumerator.Create(
270  const AHashList: THashList<TKey, TValue>);
271begin
272  inherited Create;
273  FHashList := AHashList;
274  FVersion := FHashList.FVersion;
275  FOrderList := FHashList.FInsertionOrderList;
276end;
277
278function THashList<TKey, TValue>.TPairEnumerator.DoGetCurrent: TPair<TKey, TValue>;
279begin
280  Result := GetCurrent;
281end;
282
283function THashList<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
284begin
285  Result := MoveNext;
286end;
287
288function THashList<TKey, TValue>.TPairEnumerator.GetCurrent: TPair<TKey, TValue>;
289begin
290  Result := FPair;
291end;
292
293function THashList<TKey, TValue>.TPairEnumerator.MoveNext: Boolean;
294begin
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;
310end;
311
312{ TStackList<T> }
313
314function TStackList<T>.Peek: T;
315begin
316  Result := GetItem(GetCount - 1);
317end;
318
319function TStackList<T>.Pop: T;
320var
321  I: Integer;
322begin
323  I := GetCount - 1;
324  Result := GetItem(I);
325  Delete(I);
326end;
327
328procedure TStackList<T>.Push(const Item: T);
329begin
330  Add(Item);
331end;
332
333{ TCollectionUtils }
334
335class function TCollectionUtils.DictionaryToString(
336  const Dict: IDictionary<Integer, IList<IANTLRInterface>>): String;
337var
338  SB: TStringBuilder;
339  I: Integer;
340  E: TPair<Integer, IList<IANTLRInterface>>;
341begin
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;
363end;
364
365class function TCollectionUtils.ListToString(
366  const Coll: IList<IANTLRInterface>): String;
367var
368  SB: TStringBuilder;
369  I: Integer;
370  Element: IANTLRInterface;
371  Dict: IDictionary<Integer, IList<IANTLRInterface>>;
372  List: IList<IANTLRInterface>;
373begin
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;
403end;
404
405class function TCollectionUtils.ListToString(const Coll: IList<String>): String;
406var
407  SB: TStringBuilder;
408  I: Integer;
409begin
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;
429end;
430
431end.
432