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 面向流的屬性 (註釋)