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