class - 我怎样才能让这个调度电话工作？

Question

我正在尝试熟悉 Ada 中的面向对象。几个月前，您的网站帮助我解决了另一个 OO 问题，我希望您愿意再次提供帮助。

情况：我有一个抽象类型“token”和两个派生类型“otoken”和“vtoken”。我想将 2 个派生类型放在同一个数组中并让它们正确调度。

我的教科书建议将数组声明为包含指向 token'class 的指针，这迫使我从头到尾处理点。下面是我的程序的精简版本，但它不会编译，因为编译器说我的调度调用是“模棱两可的”</p>

---------------------------------------------------------------------------------

--------------------------------------------
-- Tokensamp.ads
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
package tokensamp is
    type token is abstract tagged record
    x: integer;
    end record;
    type otoken is new token with record
    y: integer;
    end record;
    type vtoken is new token with record
    z: integer;
    end record;

    type potoken is access otoken;
    type pvtoken is access vtoken;

end tokensamp;
------------------------------------------------------------------------------------------------------
-- Parsesamp.ads:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with tokensamp; 
package parsesamp is
    function rootOfTree( t: tokensamp.pvtoken) return integer;
    function rootOfTree( t: tokensamp.potoken) return integer;  
end parsesamp; 
-------------------------------------------
-- parsesamp.adb:
package body parsesamp is 
    function rootOfTree( t: tokensamp.pvtoken) return integer  is
    begin
       return   t.z * 2;
    end rootOfTree;

    function rootOfTree( t: tokensamp.potoken) return integer is
    begin
        return  t.y * 2;
    end rootOfTree;
    result: integer;
    type tarray is array (1..2) of access tokensamp.token'class ;
    tl: tarray;
begin
    for i in 1..2 loop
    result := rootOfTree(  tl(i) );
    end loop;

end parsesamp;
-------------------------------------------------------------

---

当我用我的 GNAT Ada 95 编译器编译它时，我收到错误消息：

C:\GNAT\2018\bin\ceblang>gnatmake   parsesamp.adb
gcc -c parsesamp.adb
parsesamp.adb:25:27: ambiguous expression (cannot resolve "rootOfTree")
parsesamp.adb:25:27: possible interpretation at parsesamp.ads:9
parsesamp.adb:25:27: possible interpretation at parsesamp.ads:8
gnatmake: "parsesamp.adb" compilation error

换句话说，它无法将这两个函数识别为替代调度调用。如果你能建议我，我将不胜感激，因为我已经坚持了好几天了。

Answer 1

首先，您需要声明rootOfTree为 的抽象操作token：

type token is abstract tagged record
   x: integer;
end record;
function rootOfTree( t: tokensamp.token) return Integer is abstract;

（原始操作必须在token被 冻结之前声明，基本上在任何使用它之前，如声明派生类型）。

otoken然后声明and的原始操作vtoken；它们必须在与其对应类型相同的包中声明为原始类型，即可调度。

type otoken is new token with record
   y: integer;
end record;

type vtoken is new token with record
   z: integer;
end record;

function rootOfTree( t: tokensamp.vtoken) return integer;
function rootOfTree( t: tokensamp.otoken) return integer;

（在其参数类型之后立即声明每个会更正常，但由于两者都不会冻结另一个，这没关系）。

请注意，没有任何rootOfTree操作采用访问类型参数。

你不需要potoken, pvtoken，尽管你可以考虑在这里声明类范围的指针：

type ptoken is access token'class;

然后，您需要为 声明一个主体package tokensamp，其中包含两个具体rootOfTrees 的实现。

考虑到parsesamp，你不能在rootOfTree这里声明。

你可以写

result := tokensamp.rootOfTree (t1(i).all);

(t1(i)是一个指向类范围的指针，.all是一个类范围的值，并且 tokensamp.rootOfTree是一个可调度的操作，所以这是一个调度调用)

.. 或者你可以使用更漂亮的速记

result := t1(i).rootOfTree;

Answer 2

您的困惑似乎包括包的使用和 Ada 中定义调度操作的方式。调度操作必须在定义标记数据类型的同一包中定义，但在定义任何其他类型之前。

package Tokens is
   type token is tagged private;
   function Root_Of_Tree(T : Token) return Integer;
   type Token_Access is access all Token'Class;
   type Token_Array is array (Positive range <>) of Token_Access;
private
   type Token is tagged record
      X : Integer := 1;
   end record;
end Tokens;

包规范定义了标记类型 Token 及其调度操作 Root_Of_Tree。记录类型 Token 包含一个名为 X 的整数数据元素。包的主体是：

    package body Tokens is

       ------------------
       -- Root_Of_Tree --
       ------------------

       function Root_Of_Tree (T : Token) return Integer is
       begin
          return T.X;
       end Root_Of_Tree;

    end Tokens;

我使用子包来定义 Otoken 和 Vtoken 类型。

package Tokens.OTokens is
   type Otoken is new Token with private;
   function Root_Of_Tree(T : Otoken) return Integer;
private
   type Otoken is new Token with record
      Y : Integer := 2;
   end record;

end Tokens.OTokens;

Tokens.OTokens 的主体是：

package body Tokens.OTokens is

   ------------------
   -- Root_Of_Tree --
   ------------------

   function Root_Of_Tree (T : Otoken) return Integer is
   begin
      return T.Y * 2;
   end Root_Of_Tree;

end Tokens.OTokens;

Tokens.VTokens 的规范是：

package tokens.vtokens is
   type vtoken is new token with private;
   function Root_Of_Tree(T : vtoken) return Integer;
private
   type vtoken is new token with record
      Z : Integer := 3;
   end record;

end tokens.vtokens;

正文 Tokens.Vtokens 是：

package body tokens.vtokens is

   ------------------
   -- Root_Of_Tree --
   ------------------

   function Root_Of_Tree (T : vtoken) return Integer is
   begin
      return T.Z * 2;
   end Root_Of_Tree;

end tokens.vtokens;

创建包含一个 otoken 和一个 vtoken 的数组的主要过程是：

with Ada.Text_IO; use Ada.Text_Io;
with Tokens; use Tokens;
with Tokens.OTokens; use Tokens.OTokens;
with tokens.vtokens; use tokens.vtokens;

procedure Main is
   Ot : token_Access := new Otoken;
   Vt : token_access := new vtoken;
   Ta : Token_Array := (Ot, Vt);
begin
   for tk of Ta loop
      Put_Line(Integer'Image(Root_of_Tree(tk.all)));
   end loop;
end Main;

请记住，OToken 类型包含两个字段 X 和 Y。VToken 类型包含两个字段 X 和 Z。主过程的输出是：

4
6

Answer 3

作为 Jim Rogers 和 Simon Wright 给出的答案的附录，如果您将使用 Ada 2012，那么您可以考虑使用无限期的持有者来构建您的阵列（另请参阅RM A.18.18和Ada 2012 Rationale，第 8.5 节）

如基本原理所述，持有者是一个容器，可以持有（和管理）一个对象的单个实例。该对象在作为参数传递给To_Holder子程序（参见下面的示例）时，被复制到一个堆实例中，当不再需要时（例如，当它被替换或持有者超出范围时），该实例又被销毁. 因此，持有者容器使您无需像access直接使用类型时那样手动管理内存。

To_Holder（性能）成本是复制传递给程序的对象。您可以在持有人之间“移动”对象（使用Move持有人包中定义的子程序），但不能将对象“移动”到持有人中；您只能将其复制到持有人中。

token.ads（规范）

package Tokens is

   --  Abstract Root Type.

   type Token is abstract tagged private;   
   function Root_Of_Tree (T : Token) return Integer is abstract;

   --  First derived type.

   type OToken is new Token with private;         
   function Root_Of_Tree (T : OToken) return Integer;   
   function Create_OToken (X, Y : Integer) return OToken;

   --  Second derived type.

   type VToken is new Token with private;   
   function Root_Of_Tree (T : VToken) return Integer;   
   function Create_VToken (X, Z : Integer) return VToken;

private

   type Token is abstract tagged record
      X : Integer;
   end record;

   type OToken is new Token with record
      Y : Integer;
   end record;

   type VToken is new Token with record
      Z : Integer;
   end record;

end Tokens;

令牌.adb（正文）

package body Tokens is   

   function Root_Of_Tree (T : OToken) return Integer is
   begin
      return T.X + 2 * T.Y;
   end Root_Of_Tree;   

   function Create_OToken (X, Y : Integer) return OToken is
   begin
      return OToken'(X, Y);
   end Create_OToken;   

   function Root_Of_Tree (T : VToken) return Integer is
   begin
      return T.X + 3 * T.Z;
   end Root_Of_Tree;

   function Create_VToken (X, Z : Integer) return VToken is
   begin
      return VToken'(X, Z);
   end Create_VToken;

end Tokens;

主文件

with Ada.Text_IO; use Ada.Text_IO;
with Tokens;      use Tokens;

with Ada.Containers.Indefinite_Holders;

procedure Main is

   package Token_Holder is
     new Ada.Containers.Indefinite_Holders (Token'Class);
   use Token_Holder;

   type Token_Array is array (Integer range <>) of Holder;


   Tokens : Token_Array :=
     (To_Holder (Create_OToken (1, 2)),
      To_Holder (Create_OToken (5, 4)),
      To_Holder (Create_VToken (1, 2)),
      To_Holder (Create_VToken (5, 4)));

begin

   for T of Tokens loop
      Put_Line (Integer'Image (T.Element.Root_Of_Tree));
   end loop;

end Main;

运行valgrind显示程序终止时没有分配内存：

$ valgrind ./main
==1392== Memcheck, a memory error detector
==1392== Copyright (C) 2002-2015, and GNU GPL'd, by Julian Seward et al.
==1392== Using Valgrind-3.12.0.SVN and LibVEX; rerun with -h for copyright info
==1392== Command: ./main
==1392== 
 5
 13
 7
 17
==1392== 
==1392== HEAP SUMMARY:
==1392==     in use at exit: 0 bytes in 0 blocks
==1392==   total heap usage: 8 allocs, 8 frees, 160 bytes allocated
==1392== 
==1392== All heap blocks were freed -- no leaks are possible
==1392== 
==1392== For counts of detected and suppressed errors, rerun with: -v
==1392== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)

注意 [更新]：有 8 个分配，而数组仅包含 4 个元素/持有者。这是因为如何为支持原子增量/减量的平台（例如 Linux）实现持有者。对于这些平台，实现在内部创建了另一个“共享持有者”，以支持写时复制策略（参见源代码）。对于不支持原子递增/递减的平台，实现会更简单（参见源代码），并且只会显示 4 个分配。