Ada 编程/库/Ada.Streams/示例

计算 » 计算机科学 » 计算机编程 » Ada 编程

---

此页面提供了一个（相当复杂的）关于类级流相关属性的用法示例 Class'Read, Class'Write, Class'Input 和 Class'Output.

问题

我们要考虑的问题如下：假设两个主机通过 TCP 连接通信，交换有关车辆的信息。每辆车都以其类型（汽车、卡车、自行车等）、最高速度（以公里/小时计，用整数表示）和一组取决于车辆类型的其他参数为特征。例如，一辆汽车可以有一个参数“乘客数量”，而一辆卡车可以有一个参数“最大载重”（以千克计的整数）。为简单起见，我们假设每个参数都用整数表示。

用于通过网络通信车辆数据的协议是基于文本的，其格式如下

• 第一个字节是一个字符，表示车辆类型。例如，'c' 表示“汽车”，'t' 表示“卡车”，'b' 表示“自行车”。
• 接下来是车辆速度，以整数形式表示，编码为“<len> i <value>” 其中
  • <value> 是速度值，用十进制表示，包含 <len> 位数字
  • <len> 是 <value> 字段的长度，用十进制表示。此字段可以包含尾部空格
    例如，整数 256 将被编码为“3i256”。
• 速度值后面是车辆特定参数的列表，以与速度字段相同的格式进行编码。

我们希望使用 Ada 流的功能从任何“介质”（例如网络链路、文件、内存中的缓冲区）读取和写入车辆信息，并且我们希望使用 Ada 的面向对象特性来简化新类型的车辆引入。

解决方案

这是拟议解决方案的草图

• 我们将创建一个对象层次结构来表示车辆类型。更确切地说，我们将把每辆车表示为抽象类型（Abstract_Vehicle）的后代
• 从流中读取将通过函数 Abstract_Vehicle'Class'Input 完成，其工作原理如下
  1. 它读取第一个字节（通过使用 Character'Read）并使用它来确定车辆类型
  2. 它创建与所需车辆类型相对应的对象
  3. 它通过将新创建的对象传递给它来调用 Abstract_Vehicle'Class'Read，以便从流中读取它
• 写入流将通过过程 Abstract_Vehicle'Class'Output 完成，其工作原理如下
  1. 它检查对象标签并使用它来确定要写入流的第一个字符
  2. 它通过使用 Character'Write 将第一个字符写入流
  3. 它调用 Abstract_Vehicle'Class'Write 将对象描述写入流
• 我们将从 Integer 派生一个新的类型 Int，并将为它定义新的过程 Int'Read 和 Int'Write，它们将以上面描述的“<len> i <value>” 格式读取和写入类型 Int 的变量
• 为了允许引入新的车辆类型（也许是在运行时动态加载库），在 Abstract_Vehicle'Class'Input 函数描述的步骤 2 中，我们不能使用case 在读取的字符上，以确定要创建的对象的类型。相反，我们将使用 Ada 提供的泛型分派构造函数（请参阅 3.9 带标签的类型和类型扩展 (带注释的)）。
• 由于泛型分派构造函数需要要创建的对象的标签，因此我们必须能够确定与给定字符相对应的标签。我们将通过保留一个 Ada.Tags.Tag 数组，它以字符为索引。定义新车辆的包将在包的初始化部分（即紧随begin 之后的语句序列，请参阅 7.2 包体 (带注释的)）中“注册”自己，方法是在该数组的适当位置写入已定义车辆的标签。

实现

可流类型

我们要分析的第一个包是一个包，它定义了一个新的整数类型，以便为它分配属性 Read 和 Write，它们根据上面描述的格式序列化整数值。包规范非常简单

  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;

新的类型是 Int，分配给属性 Read 和 Write 的过程分别是 Parse 和 Read。主体也相当简单

  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;

Streamable_Types 的主体不应该需要任何特殊注释。请注意，对流的访问是如何通过原始过程 Read 和 Write 进行分派的，这使得上面的包能够与任何类型的流一起工作。

抽象车辆

我们将分析的第二个包是 Vehicles，它定义了一个抽象标记类型 Abstract_Vehicle，代表所有可能车辆的“最小公分母”。

  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;

该包定义了

• 函数 Input_Vehicle 和过程 Output_Vehicle 分别用作类级的输入和输出过程
• 抽象构造函数“Constructor”，每个从 Vehicle 派生的非抽象类型都必须重写。此构造函数将在主体中由 Generic_Dispatching_Constructor 调用。
• 过程 Register_Name 将车辆“名称”（在本简化情况下由一个字符表示）与相应的类型（由其标记表示）相关联。在典型情况下，此过程将在从 Abstract_Vehicle 派生的包的主体初始化部分中被调用。

包的主体是

  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;

注意 Input_Vehicle 的行为，这个函数将充当类级的输入。

1. 首先，它使用流相关函数 Character'Read 读取流中与下一个车辆关联的字符。
2. 然后，它使用读取的字符来查找要创建的对象的标记。
3. 它通过调用 Generic_Dispatching_Constructor 的专门版本来创建对象。
4. 它通过调用类级的 Read 来“填充”新创建的对象，该 Read 将负责调用与新创建对象关联的 Read。

过程 Output_Vehicle 比 Input_Vehicle 简单得多，因为它不需要使用 Generic_Dispatching_Constructor。只需要注意对 Abstract_Vehicle'Class'Write 的调用，该调用将反过来调用与 Item 的实际类型关联的 Write 函数。

最后，请注意 Abstract_Vehicle 没有定义 Read 和 Write 属性。因此，Ada 将使用它们的默认实现。例如，Abstract_Vehicle'Read 将通过两次调用过程 Streamable_Types.Int'Read 来读取两个 Streamable_Types.Int 值 Speed 和 Weight。类似的说明适用于 Abstract_Vehicle'Write。

非抽象车辆

汽车

我们考虑的第一个从 Abstract_Vehicle 派生的非抽象类型代表一辆汽车。为了使示例更加丰富，Car 将从表示发动机驱动的车辆的中间抽象类型派生。所有发动机驱动的车辆都将有一个字段表示发动机的功率（为了简单起见，仍然是一个整数值）。规格文件如下

  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;

注意，在这种情况下，我们也没有定义任何 Read 或 Write 过程。因此，例如，Abstract_Engine_Based'Read 将首先调用 Streamable_Types.Int 两次，以从流中读取 Speed 和 Weight（从 Abstract_Vehicle 继承），然后它将再次调用 Streamable_Types.Int 来读取 Power。

还要注意，Abstract_Engine_Based 没有重写 Abstract_Vehicle 的抽象函数 Constructor。这是不必要的，因为 Abstract_Engine_Based 是抽象的。

定义 Car 类型的包的规格文件如下

 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;

规格文件不需要特殊说明。只需要注意 Car 定义了一个特殊的 Read 过程，并且它重写了 Construct，因为 Car 不是抽象的。

  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;

Vehicles.Engine_Based.Auto 包的主体也很简单，只需要注意

• 过程 Parse（用作 Car'Read）首先调用 Abstract_Engine_Based'Read 来“填充”从 Abstract_Engine_Based 继承的部分，然后它调用 Streamable_Types.Int'Read 来读取气缸数。顺便说一下，请注意，这等同于默认行为，因此实际上没有必要定义 Parse。我们这样做只是为了举个例子。
• 注意在主体初始化部分对 Register_Name 的调用，它将名称 'c' 与 Car 类型的标记（通过 'Tag' 属性获得）相关联。此解决方案的一个有趣的特性是，有关 Car 类型对象“外部名称”'c' 的信息只在 Vehicles.Engine_Based.Auto 包中已知。

自行车

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;

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;

另请参阅

华夏公益教科书

• Ada 编程
• Ada 编程/面向对象
• Ada 编程/输入输出
• Ada 编程/库/Ada.Streams

Ada 2005 参考手册

• 3.9 标记类型和类型扩展 (注释)
• 7.2 包主体 (注释)
• 13.13.1 Streams 包 (注释)
• 13.13.2 面向流的属性 (注释)