Re: avl tree - booch components

["Jeffrey D. Cherry" <jdcherry@utech.net>]

I once created the following package and driver program for a colleague.
It was derived from a much larger project where we used an AVL tree as 
part of a symbol table for a FORTRAN parser.  It compiles with GNAT v3.13p
under Windows 2000 and the August 19, 2001 version of the Booch components.
Though comments are somewhat sparse, there is some explanation regarding
instantiating the AVL tree.  Hope this helps.
-- 
Regards,
Jeffrey D. Cherry
Senior IV&V Analyst
Logicon Operations and Services
Logicon Inc.
a Northrop Grumman company



-- This is a simple package to store "keywords" and an associated data
-- item as an abstract data object.  We'll refer to this abstract data
-- object simply as the keyword container.

package Keyword_Manager is

   -- This is a dummy type so we can associate some kind of data with
   -- a key field.  The dummy type can, of course, be very complex if
   -- it is appropriate for the problem.  It could also be a generic
   -- parameter.  For that matter, the "key" type (strings in this
   -- example) could be a generic parameter as well.  I won't do that
   -- here since too many levels of generic instantiations will detract
   -- from what I'm trying to show.
   type ID_Type is (Unknown_ID, Known_ID, Another_ID, Yet_Another_ID);

-- Clear the keyword container of all (keyword,ID) pairs so that we
-- have an empty keyword container.
procedure Clear_Keywords;

-- Return true if the keyword container is empty and return false
-- if there are one or more (keyword,ID) pairs in the keyword container.
function Is_Empty return boolean;

-- Return the number of (keyword,ID) pairs in the keyword container.
function Number return natural;

-- Insert a keyword and its associated data into the keyword container.
-- If the keyword already exists, then the ignore the data.  (Normally
-- we would want to signal some kind of fault - perhaps via an exception.
-- However, we don't want to focus on error processing in this example.)
procedure Insert(
   Keyword : in string;
   ID      : in ID_Type);

-- Return true if the given keyword exists in the keyword container and
-- return false if it does not exist in the keyword container.
function Exists(Keyword : in string) return boolean;

-- Return the ID associated with the given keyword.  If the keyword
-- doesn't exist in the keyword container, then Unknown_ID is returned.
-- (Again, this should probably raise an exception but we're not
-- focusing on error processing.)
function Identify(Keyword : in string) return ID_Type;

-- Write the contents of the keyword container to standard output.
-- Normally we would want to make this ability much more flexible,
-- but we make another concession for a simple example.
procedure Put_Keywords;

end Keyword_Manager;


with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded;
with Ada.Strings.Maps.Constants;

with BC.Containers.Trees.AVL.Print;
with BC.Support.Unmanaged_Storage;

package body Keyword_Manager is

   -- A node for the keyword table.  This is the information stored in
   -- the AVL tree.  We use unbounded strings since we don't know the
   -- length of our key strings.  If we did, we could use the bounded
   -- form from Ada.Strings.Bounded.
   type Keyword_Node is
      record
         Keyword : Unbounded_String := Null_Unbounded_String;
         ID      : ID_Type          := Unknown_ID;
      end record;

   -- Eventually, we'll need some kind of storage management for the
   -- Keyword_Node structures and the tree that stores the data.  For
   -- this example, we don't care too much about storage issues, so we'll
   -- use the default unmanaged storage provided by the Booch components.
   subtype Tree_Storage_Pool is BC.Support.Unmanaged_Storage.Pool;
   Tree_Storage : Tree_Storage_Pool;

-- Equality function used to identify equivalent nodes in the AVL tree.
-- Notice that the test is case insensative.
function Same_Keyword(Left, Right : in Keyword_Node) return boolean is
   use Ada.Strings.Maps.Constants;
begin -- Same_Keyword
   return Translate(Left.Keyword, Lower_Case_Map) =
         Translate(Right.Keyword, Lower_Case_Map);
end Same_Keyword;

-- Ordering function used to order nodes in the AVL tree.  Notice that
-- the nodes are in reverse alphabetical order and are case insensative.
function Is_Before(Left, Right : in Keyword_Node) return boolean is
   use Ada.Strings.Maps.Constants;
begin -- Is_Before
   return Translate(Left.Keyword, Lower_Case_Map) >
         Translate(Right.Keyword, Lower_Case_Map);
end Is_Before;


-- First create an abstract container that can hold our Keyword_Nodes and
-- can test for two identical Keyword_Nodes.
package Keyword_Containers is
   new BC.Containers(Item => Keyword_Node, "=" => Same_Keyword);

-- Since an abstract tree is just another form of an abstract container,
-- we create an abstract container that uses an abstract tree structure.
-- No new information is required to be given to the abstract tree
-- container and so this is just a simple instantiation built off our
-- previous container.
package Keyword_Container_Trees is new Keyword_Containers.Trees;

-- Now we must define a substantial form for the abstract tree container.
-- This is where we decide to use an AVL form of a tree rather than some
-- other form (e.g., binary or multiway).  Since a tree stores data in
-- an ordered fashion, we must tell the AVL tree how to order our data.
-- This is done with the ordering function we defined above (function
-- Is_Before).  This will also be our concrete package that must deal
-- with both allocation and deallocation of memory resources for the
-- tree nodes.
package Keyword_Trees is
   new Keyword_Container_Trees.AVL(
      "<"             => Is_Before,
      Storage_Manager => Tree_Storage_Pool,
      Storage         => Tree_Storage);

   -- Okay, we can now define an object that will contain our Keyword_Nodes.
   -- It is a container that uses an AVL tree structure to hold the data.
   Keyword_Table : Keyword_Trees.AVL_Tree;


procedure Clear_Keywords is
begin -- Clear_Keywords
   Keyword_Trees.Clear(Keyword_Table);
end Clear_Keywords;


function Is_Empty return boolean is
begin -- Is_Empty
   return Keyword_Trees.Is_Null(Keyword_Table);
end Is_Empty;


function Number return natural is
begin -- Number
   return Keyword_Trees.Extent(Keyword_Table);
end Number;


procedure Insert(
   Keyword : in string;
   ID      : in ID_Type) is

   Keyword_Added : boolean;

begin -- Insert
   Keyword_Trees.Insert(Keyword_Table,
         Keyword_Node'(To_Unbounded_String(Keyword), ID),
         Keyword_Added);
end Insert;


function Exists(Keyword : in string) return boolean is
begin -- Exists
   return Keyword_Trees.Is_Member(Keyword_Table,
         Keyword_Node'(To_Unbounded_String(Keyword), Unknown_ID));
end Exists;


function Identify(Keyword : in string) return ID_Type is

   ID    : ID_Type := Unknown_ID;
   Found : boolean;

procedure Get_ID(Item : in out Keyword_Node) is
begin -- Get_ID
   ID := Item.ID;
end Get_ID;

procedure Find_Node is new Keyword_Trees.Access_Actual_Item(Get_ID);

begin -- Identify
   Find_Node(Keyword_Table,
         Keyword_Node'(To_Unbounded_String(Keyword), Unknown_ID),
         Found);
   return ID;
end Identify;


procedure Put_Keywords is

function Keyword_Image(Item : in Keyword_Node) return string is
begin -- Keyword_Image
   return "(" & To_String(Item.Keyword) & "," & ID_Type'image(Item.ID) & ")";
end Keyword_Image;

procedure Put_Tree is new Keyword_Trees.Print(Keyword_Image);

begin -- Put_Keywords
   Put_Tree(Keyword_Table);
end Put_Keywords;

end Keyword_Manager;


with Ada.Command_Line;
with Ada.Text_IO;                       use Ada.Text_IO;
with Ada.Strings.Fixed;                 use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;        use Ada.Strings.Maps.Constants;

with Keyword_Manager;                   use Keyword_Manager;

procedure KM_Test is

   Keyword_File : File_Type;
   Buffer       : string(1..1024);
   Last         : natural;
   i, j         : natural;
   ID           : ID_Type := Known_ID;

begin -- KM_Test
   if Ada.Command_Line.Argument_Count = 1 then
      Open(Keyword_File, In_File, Ada.Command_Line.Argument(1));
      Clear_Keywords;

      while not End_Of_File(Keyword_File) loop
         Get_Line(Keyword_File, Buffer, Last);
         if Last in Buffer'range then
            i := Buffer'first;
            loop
               Find_Token(Buffer(i..Last), Letter_Set, Ada.Strings.Inside, i,
j);
               exit when j = 0;
               Insert(Buffer(i..j), ID);
               if ID = Yet_Another_ID then
                  ID := Known_ID;
               else
                  ID := ID_Type'succ(ID);
               end if;
               i := natural'succ(j);
               exit when i > Last;
            end loop;
         end if;
      end loop;
      Close(Keyword_File);

      if Is_Empty then
         Put_Line("Keyword container is empty.");

      else
         Put_Line("There are" & natural'image(Number) &
               " items in the keyword container.");
         New_Line(2);
         Put_Line("Contents of the keyword container are as follows:");
         Put_Keywords;
         New_Line(4);

         loop
            Put("Enter keyword to look up: ");
            Get_Line(Buffer, Last);
            exit when Last not in Buffer'range;
            if Exists(Buffer(1..Last)) then
               Put_Line("""" & Buffer(1..Last) &
                     """ is in the keyword container and its ID is " &
                     ID_Type'image(Identify(Buffer(1..Last))) & ".");
            else
               Put_Line("""" & Buffer(1..Last) &
                     """ does not exist in the keyword container!");
            end if;
         end loop;
      end if;
   end if;
end KM_Test;