Ada Programming/Libraries/Ada.Streams/Example

< Ada Programming < Libraries < Ada.Streams

Computing » Computer Science » Computer Programming » Ada Programming

This page gives a (fairly complex) example of usage of class-wide stream related attributes Class'Read, Class'Write, Class'Input, and Class'Output.

The problem

The problem we will consider is the following: suppose that two hosts communicate over a TCP connection, exchanging information about vehicles. Each vehicle is characterized by its type (a car, a truck, a bicycle, and so on), its maximum speed (in km/h, represented by an integer number) and a set of further parameters that depend on the vehicle type. For example, a car could have a parameter "number of passengers," while a truck could have a parameter "maximum load" (an integer number of kg). For the sake of simplicity we will suppose that every parameter is represented by an integer number.

The protocol used to communicate vehicle data over the wire is text-based and it is as follows

The first octet is a character that denotes the vehicle type. For example 'c' is for "car," 't' is for "truck," 'b' is for "bicycle."
Next it comes the vehicle speed, represented as an integer number encoded as "<len> i <value>" where
- <value> is the speed value, expressed as a number in base 10 with <len> digits
- <len> is the length of the <value> field, expressed as a number in base 10. This field can have trailing spaces
  For example, the integer 256 would be encoded as "3i256".
The speed value is followed by the list of vehicle-specific parameter, encoded with the same format of the speed field.

We would like to use the features of Ada streams to read and write vehicle information from and to any "medium" (e.g., a network link, a file, a buffer in memory) and we would like to use the object-oriented features of Ada in order to simplify the introduction of a new type of vehicle.

The solution

This is a sketch of the proposed solution

We will create a hierarchy of objects to represent the vehicle types. More precisely, we will represent each vehicle as a descendant of an abstract type (Abstract_Vehicle)
Reading from a stream will be done via function Abstract_Vehicle'Class'Input that will work as follows
1. it reads the first octet (by using Character'Read) and uses it to determine the type of vehicle
2. it creates the object corresponding to the required vehicle type
3. it calls Abstract_Vehicle'Class'Read by giving to it the newly created object in order to read it from the stream
Writing to a stream will be done via procedure Abstract_Vehicle'Class'Output that will work as follows
1. it checks the object tag and uses it to determine the first character to be written to the stream
2. it writes the first character to the stream by using Character'Write
3. it calls Abstract_Vehicle'Class'Write to write the object description to the stream
We will derive a new type Int from Integer and we will define for it new procedures Int'Read and Int'Write that will read and write variables of type Int encoded in the format "<len> i <value>" described above
In order to allow for the introduction of new vehicle types (maybe by dynamically loading a library at runtime), at the step 2 of the Abstract_Vehicle'Class'Input function described we cannot use a case on the character read in order to determine the type of the object to be created. We will instead use the generic dispatching constructor provided by Ada (see 3.9 Tagged Types and Type Extensions (Annotated)).
Since the generic dispatching constructor requires the tag of the object to be created, we must be able to determine the tag that corresponds to a given character. We will achieve this by keeping an array of Ada.Tags.Tag indexed by character. A package defining a new vehicle will "register" itself in the initialization part of the package (that is, the sequence of statements that follows the begin in the package body, see 7.2 Package Bodies (Annotated)) by writing the tag of the defined vehicle in the suitable position of that array.

Implementation

Streamable types

The first package that we are going to analyze is a package that defines a new integer type in order to assign to it attributes Read and Write that serialize integer values according to the format described above. The package specs are quite simple

  with Ada.Streams;          
  
  package Streamable_Types is
     use Ada;
  
     type Int is new  Integer;
     
     procedure Print (Stream : not null access Streams.Root_Stream_Type'Class;
                      Item   : Int);
     
     procedure Parse (Stream : not null access Streams.Root_Stream_Type'Class;
                      Item   : out Int);
     
     for Int'Read use Parse;
     for Int'Write use Print;
     
     Parsing_Error : exception;
  end Streamable_Types;

The new type is Int and the procedure assigned to attributes Read and Write are, respectively, Parse and Read. Also the body is quite simple

  with Ada.Strings.Fixed;  
   
  package body Streamable_Types is
     use Streams;
     
     -- ---------
     --  Print --
     -- ---------
     
     procedure Print (Stream : not null access Root_Stream_Type'Class;
                      Item   : Int)
     is 
        Value    : String := Strings.Fixed.Trim (Int'Image (Item), Strings.Left);
        Len      : String := Integer'Image (Value'Length);
        Complete : String := Len & 'i' & Value;
        Buffer   : Stream_Element_Array
           (Stream_Element_Offset (Complete'First) .. Stream_Element_Offset (Complete'Last));
     begin
        for I in Buffer'Range loop
           Buffer (I) := Stream_Element (Character'Pos (Complete (Integer (I))));
        end loop;
  
        Stream.Write (Buffer);
     end Print;
     
     -----------
     -- Parse --
     -----------
     
     procedure Parse (Stream : not null access Root_Stream_Type'Class;
                      Item   : out Int)
     is
        -- Variables needed to read from Stream.
        Buffer : Stream_Element_Array (1 .. 1);
        Last   : Stream_Element_Offset;
        
        -- Convenient constants
        Zero   : constant Stream_Element := Stream_Element (Character'Pos ('0'));
        Nine   : constant Stream_Element := Stream_Element (Character'Pos ('9'));
        Space  : constant Stream_Element := Stream_Element (Character'Pos (' '));
        
        procedure Skip_Spaces is
        begin
           loop
              Stream.Read (Buffer, Last);
              exit when Buffer (1) /= Space;
           end loop;
        end Skip_Spaces;
           
        procedure Read_Length (Len : out Integer) is
        begin
           if not (Buffer (1) in Zero .. Nine) then
              raise Parsing_Error;
           end if;
          
           Len := 0;
           loop
              Len := Len * 10 + Integer (Buffer (1) - Zero);
              Stream.Read (Buffer, Last);
     
              exit when not (Buffer (1) in Zero .. Nine);
           end loop;
        end Read_Length;
     
        procedure Read_Value (Item : out Int;
                              Len  : in  Integer) is
        begin
           Item := 0;
           for I in 1 .. Len loop
              Stream.Read (Buffer, Last);
              
              if not (Buffer (1) in Zero .. Nine) then
                 raise Parsing_Error;
              end if;
                 
              Item := 10 * Item + Int (Buffer (1) - Zero);
           end loop;
        end Read_Value;
        
        Len : Integer := 0;
     begin
        Skip_Spaces;
    
        Read_Length (Len);
     
        if Character'Val (Integer (Buffer (1))) /= 'i' then
           raise Parsing_Error;
        end if;
    
        Read_Value(Item, Len);
     end Parse;
  end Streamable_Types;

The body of Streamable_Types should not require any special comment. Note how the access to the stream is done by dispatching through the primitive procedures Read and Write, allowing the package above to work with any type of stream.

Abstract Vehicles

The second package we are going to analyze is Vehicles that define an abstract tagged type Abstract_Vehicle that represents the "least common denominator" of all the possible vehicles.

  with Ada.Streams;              
  with Ada.Tags;
  with Streamable_Types;
  
  package Vehicles is
     type Abstract_Vehicle is abstract tagged private;
     
     function Input_Vehicle
       (Stream : not null access Ada.Streams.Root_Stream_Type'Class)
        return Abstract_Vehicle'Class;
     
     procedure Output_Vehicle
       (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
        Item   : Abstract_Vehicle'Class);
     
     for Abstract_Vehicle'Class'Input use Input_Vehicle;
     for Abstract_Vehicle'Class'Output use Output_Vehicle;
     
     -- "Empty" type.  The Generic_Dispatching_Constructor expects
     -- as parameter the type of the parameter of the constructor.
     -- In this case no parameter is needed, so we define this
     -- "placeholder type"
     type Parameter_Record is null record;
     
     -- Abstract constructor to be overriden by non-abstract
     -- derived types.  It is needed by Generic_Dispatching_Constructor
     function Constructor
       (Name : not null access Parameter_Record)
        return Abstract_Vehicle
        is abstract;
     
  private
     -- This procedure must be called by the packages that derive
     -- non-abstract type from Abstract_Vehicle in order to associate
     -- the vehicle "name" with the tag of the corresponding object
     procedure Register_Name (Name        : Character;
                              Object_Tag  : Ada.Tags.Tag);
     
     type Kmh is new Streamable_Types.Int;
     type Kg  is new Streamable_Types.Int;
     
     -- Data shared by all the vehicles
     type Abstract_Vehicle is abstract tagged
        record
           Speed  : Kmh;
           Weight : Kg;
        end record;
  end Vehicles;

This package defines

Function Input_Vehicle and procedure Output_Vehicle to be used, respectively, as class-wide input and output procedures
Abstract constructor "Constructor" that every non-abstract type derived by Vehicle must override. This constructor will be called by Generic_Dispatching_Constructor in the body.
Procedure Register_Name that associates a vehicle "name" (represented by a character in this simplified case) to the corresponding type (represented by its Tag). In the typical case this procedure will be called by the package that derives from Abstract_Vehicle in the body initialization part

The body of the package is

  with Ada.Tags.Generic_Dispatching_Constructor;
  
  package body Vehicles is
  
     -- Array used to map vehicle "names" to Ada Tags 
     Name_To_Tag : array (Character) of Ada.Tags.Tag :=
       (others => Ada.Tags.No_Tag);
  
     -- Used as class-wide 'Input function
     function Input_Vehicle
       (Stream : not null access Ada.Streams.Root_Stream_Type'Class)
        return Abstract_Vehicle'Class
     is
        function Construct_Vehicle is
          new Ada.Tags.Generic_Dispatching_Constructor
            (T => Abstract_Vehicle,
             Parameters => Parameter_Record,
             Constructor => Constructor);
  
        Param : aliased Parameter_Record;
        Name : Character;
        use Ada.Tags;
     begin
        -- Read the vehicle "name" from the stream
        Character'Read (Stream, Name);
  
        -- Check if the name was associated with a tag
        if Name_To_Tag (Name) = Ada.Tags.No_Tag then
           raise Constraint_Error;
        end if;
  
        -- Use the specialization of Generic_Dispatching_Constructor
        -- defined above to create an object of the correct type
        declare
           Result : Abstract_Vehicle'Class :=
                      Construct_Vehicle (Name_To_Tag (Name), Param'Access);
        begin
           -- Now Result is an object of the type associated with
           -- Name. Call the class-wide Read to fill it with the data
           -- read from the stream.
           Abstract_Vehicle'Class'Read (Stream, Result);
           return Result;
        end;
     end Input_Vehicle;
  
  
  
     procedure Output_Vehicle
       (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
        Item   : Abstract_Vehicle'Class)
     is
        use Ada.Tags;
     begin
        -- The first thing to be written on Stream is the
        -- character that identifies the type of Item
        -- We determine it by simply looping over Name_To_Tag
        for Name in Name_To_Tag'Range loop
           if Name_To_Tag (Name) = Item'Tag then
              -- Found! Write the character to the stream, then
              -- use the class-wide Write to finish writing the
              -- description of Item to the stream
              Character'Write (Stream, Name);
              Abstract_Vehicle'Class'Write (Stream, Item);
             
              -- We did our duty, we can go back
              return;
           end if;
        end loop;
  
        -- Note: If we arrive here, we did not find the tag of
        -- Item in Name_To_Tag.
        raise Constraint_Error;
     end Output_Vehicle;
  
  
     procedure Register_Name (Name        : Character;
                              Object_Tag  : Ada.Tags.Tag)
     is
     begin
        Name_To_Tag (Name) := Object_Tag;
     end Register_Name;
  
  end Vehicles;

Note the behavior of Input_Vehicle, the function that will play the role of class-wide input.

First it reads the character associated to the next vehicle in the stream by using the stream-related function Character'Read.
Successively it uses the character read to find the tags of the object to be created
It creates the object by calling the specialized version of Generic_Dispatching_Constructor
It "fills" the newly created object by calling the class-wide Read that will take care of calling the Read associated to the newly created object

Procedure Output_Vehicle is much simpler than Input_Vehicle since it does not need to use the Generic_Dispatching_Constructor. Just note the call to Abstract_Vehicle'Class'Write that in turn will call the Write function associated to the actual type of Item.

Finally, note that Abstract_Vehicle does not define the Read and Write attributes. Therefore, Ada will use their default implementation. For example, Abstract_Vehicle'Read will read the two Streamable_Types.Int value Speed and Weight by calling twice the procedure Streamable_Types.Int'Read. A similar remark apply to Abstract_Vehicle'Write.

Non-Abstract Vehicles

Car

The first non-abstract type derived from Abstract_Vehicle that we consider represents a car. In order to make the example a bit more rich, Car will be derived from an intermediate abstract type representing an engine-based vehicle. All engine-based vehicles will have a field representing the power of the engine (still an integer value, for the sake of simplicity). The spec file is as follows

  package Vehicles.Engine_Based is
     type Abstract_Engine_Based is abstract new Abstract_Vehicle with private;
  private
     type Abstract_Engine_Based is abstract new Abstract_Vehicle with
        record
           Power : Streamable_Types.Int;
        end record;
  end Vehicles.Engine_Based;

Note that also in this case we did not define any Read or Write procedure. Therefore, for example, Abstract_Engine_Based'Read will first call Streamable_Types.Int twice to read Speed and Weight (inherited from Abstract_Vehicle) from the stream, then it will call Streamable_Types.Int another time to read Power.

Note also that Abstract_Engine_Based does not override the abstract function Constructor of Abstract_Vehicle. This is not necessary since Abstract_Engine_Based is abstract.

The spec file of the package that defines the Car type is as follows

 package Vehicles.Engine_Based.Auto is
    use Ada.Streams;
 
    type Car is new Abstract_Engine_Based with private;
 
    procedure Parse
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out Car);
 
    for Car'Read use Parse;
 private
    type Car is new Abstract_Engine_Based with
       record
          Cilinders : Streamable_Types.Int;
       end record;
 
    overriding
    function Constructor
      (Param : not null access Parameter_Record)
       return Car;
 end Vehicles.Engine_Based.Auto;

No special remarks are needed about the spec file. Just note that Car defines a special Read procedure and that it overrides Construct, as required since Car is not abstract.

  package body Vehicles.Engine_Based.Auto is
  
     
  
     procedure Parse
       (Stream : not null access Root_Stream_Type'Class;
        Item   : out Car)
     is
     begin
        Abstract_Engine_Based'Read (Stream, Abstract_Engine_Based (Item));
        Streamable_Types.Int'Read (Stream, Item.Cilinders);
     end Parse;
  
    
  
     overriding function Constructor
       (Param : not null access Parameter_Record)
        return Car
     is
        Result : Car;
        pragma Warnings(Off, Result);
     begin
        return Result;
     end Constructor;
  begin
     Register_Name('c', Car'Tag);
  end Vehicles.Engine_Based.Auto;

The body of Vehicles.Engine_Based.Auto is quite simple too, just note that

Procedure Parse (used as Car'Read) first calls Abstract_Engine_Based'Read to "fill" the part inherited from Abstract_Engine_Based, then it calls Streamable_Types.Int'Read to read the number of cylinders. Incidentally, note that this is equivalent to the default behavior, so it was not really necessary to define Parse. We did it just to make an example.
Note the call to Register_Name in the body initialization part that associates the name 'c' with the tag of type Car (obtained via the attribute 'Tag). An interesting property of this solution is that the information about the "external name" 'c' of objects of type Car is knew only inside the package Vehicles.Engine_Based.Auto.

Bicycle

The spec file of Vehicles.Bicycles

 with Ada.Streams;
 
 package Vehicles.Bicycles is
    use ada.Streams;
 
    type Bicycle is new Abstract_Vehicle with private;
 
    procedure Parse
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out Bicycle);
 
    for Bicycle'Read use Parse;
 private
    type Wheel_Count is new Streamable_Types.Int range 1 .. 3;
 
    type Bicycle is new Abstract_Vehicle with
       record
          Wheels : Wheel_Count;
       end record;
 
    overriding
    function Constructor
      (Name : not null access Parameter_Record)
       return Bicycle;
 
 end Vehicles.Bicycles;

The body of Vehicles.Bicycles

  package body Vehicles.Bicycles is
     use Ada.Streams;
  
     
  
     procedure Parse
       (Stream : not null access Root_Stream_Type'Class;
        Item   : out Bicycle)
     is
     begin
        Abstract_Vehicle'Read (Stream, Abstract_Vehicle (Item));
        Wheel_Count'Read (Stream, Item.Wheels);
     end Parse;
  
     
  
     overriding function Constructor
       (Name : not null access Parameter_Record)
        return Bicycle
     is
        Result : Bicycle;
        pragma Warnings(Off, Result);
     begin
        return Result;
     end Constructor;
  
   
  
  begin
     Register_Name ('b', Bicycle'Tag);
  end Vehicles.Bicycles;