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

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

---

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

问题

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

用于通过网络传输车辆数据的协议是基于文本的，如下所示

• 第一个字节是一个字符，表示车辆类型。例如，'c' 表示“汽车”，'t' 表示“卡车”，'b' 表示“自行车”。
• 接下来是车辆速度，表示为一个整数，编码为“<len> i <value>”，其中
  • <value> 是速度值，以 10 为基数的数字表示
  • <len> 是 <value> 字段的长度，以 10 为基数的数字表示。此字段可以有尾随空格
    例如，整数 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 面向流的属性 (带注释的)