home *** CD-ROM | disk | FTP | other *** search
- -- generic_dictionary.adb
- --
- -- Copyright (c) 1996 Cadre Technologies Inc, All Rights Reserved
- --
- -- This file contains the implementation of a simple, unoptimized, generic
- -- dictionary package that is provided without any express or implied
- -- warranties and is intended for interim use in order to allow the
- -- compilation and linking of the generated Ada code. This package should
- -- ultimately be replaced by a production quality version such as from the
- -- compiler vendor's program library.
-
- with Unchecked_Deallocation;
- package body Generic_Dictionary is
-
- procedure Free is new
- Unchecked_Deallocation(Dictionary_Item, Dictionary_Item_Acc);
-
- -- Add value V with key K to dictionary D
- procedure Add(D : in out Dictionary; K : Key; V : Value) is
- Item : Dictionary_Item_Acc := D.First;
- Last : Dictionary_Item_Acc := null;
- begin
- while Item /= null loop
- if Item.K = K then
- raise Already_Exists;
- end if;
- Last := Item;
- Item := Item.Next;
- end loop;
- Item := new Dictionary_Item;
- if Last = null then
- D.First := Item;
- else
- Last.Next := Item;
- end if;
- Item.K := K;
- Item.V := V;
- Item.Next := null;
- D.Count := D.Count + 1;
- end Add;
-
- -- Remove value with key K from dictionary D
- procedure Remove(D : in out Dictionary; K : Key) is
- Item : Dictionary_Item_Acc := D.First;
- Last : Dictionary_Item_Acc := null;
- begin
- while Item /= null loop
- if Item.K = K then
- if Last = null then
- D.First := Item.Next;
- else
- Last.Next := Item.Next;
- end if;
- D.Count := D.Count - 1;
- return;
- end if;
- Last := Item;
- Item := Item.Next;
- end loop;
- raise Does_Not_Exist;
- end Remove;
-
- -- Remove all values from dictionary D
- procedure Remove_All(D : in out Dictionary) is
- Item : Dictionary_Item_Acc := D.First;
- Next : Dictionary_Item_Acc;
- begin
- while Item /= null loop
- Next := Item.Next;
- Free(Item);
- Item := Next;
- end loop;
- D.First := null;
- D.Count := 0;
- end Remove_All;
-
- -- Return whether or not dictionary D contains value with key K
- function Has(D : Dictionary; K : Key) return Boolean is
- Item : Dictionary_Item_Acc := D.First;
- begin
- while Item /= null loop
- if Item.K = K then
- return True;
- end if;
- Item := Item.Next;
- end loop;
- return False;
- end Has;
-
- -- Return value for key K from dictionary D
- function Find_Value(D : Dictionary; K : Key) return Value is
- Item : Dictionary_Item_Acc := D.First;
- begin
- while Item /= null loop
- if Item.K = K then
- return Item.V;
- end if;
- Item := Item.Next;
- end loop;
- raise Does_Not_Exist;
- end Find_Value;
-
- -- Return the number of values in D
- function Count(D : Dictionary) return Natural is
- begin
- return D.Count;
- end Count;
-
- -- Iterator
- procedure Iterate(D : Dictionary) is
- Item : Dictionary_Item_Acc := D.First;
- begin
- while Item /= null loop
- Process(Item.K, Item.V);
- Item := Item.Next;
- end loop;
- end Iterate;
-
- end Generic_Dictionary;
-