如果一个不完整,有没有办法验证两个通用形式是否相同?

Is there a way to verify two generic formals are the same type if one is incomplete?

给定一个通用父包:

generic
    type T(<>) is tagged;
package Parent is
    type Instance is tagged private;
private
    type T_Access is access T;
    type Instance is tagged record
        Thing : T_Access := null;
    end record;
end Parent;

子包中是否有一种方法可以确保作为通用形式传递给子包的类型与 Parent.T 的类型相同(甚至是其后代)?例如,考虑通用子包:

generic
    type T(<>) is new Base with private;
package Parent.Child is
    type T_Access is access T;
    function Make(Ref : not null T_Access) return Parent.Instance;
end Parent.Child;

package body Parent.Child is

    function To_Parent(Source : T_Access) return Parent.T_Access is
    begin
        -- here is where I need to be able to safely convert 
        -- an access to the complete type to an access to the 
        -- incomplete type.  I can used Unchecked_Conversion,
        -- but that goes south if someone passes in a type to 
        -- Parent.Child that is not the same as Parent.  If
        -- I could know that Parent.Child.T is a descendant of
        -- Parent.T, I could just convert it (I think??).
    end To_Parent;

    function Make(Ref : not null T_Access) return Parent.Instance is
    begin
        return (Thing => To_Parent(Ref);
    end Make;

end Parent.Child;

其中 Base 是一些基本标记类型。您可以使用以下内容作为占位符:

type Base is tagged limited null record;

我正在寻找一种编译时或运行时的方法来验证 Parent.Child 内部 Parent.Child.T 与 Parent.T 相同(或者即使 Parent.Child.T 是 Parent.T.

的后代

注意:我正在尝试使用父子包关系,因为它允许子查看父的私有部分。

我天真地尝试了一些基于运行时的东西,比如:

package body Parent.Child is

    -- other stuff

begin
    if Child.T not in Parent.T then
        raise Storage_Error with "Invalid type passed to child package";
    end if;
end Parent.Child;

但这只会导致 GNAT 错误:

premature usage of incomplete type "T"

因为Parent.T不完整。这里的目的是创建一个可以与不完整类型一起使用的自动内存管理框架,因此父包提供大部分功能,而子包可以稍后实例化并添加需要完整类型信息的功能(如 construction/deallocation).然后你可以做这样的声明:

type Test is tagged;
package B is new Parent(Test);

type Test is new Base with record
    Thing : Parent.Instance;
end record;

package M is new B.Child(Test);

全套测试代码(请记住,这既是原始的又是裸露的,以使其尽可能简单):

------------------------ Base Package ----------------------------
package Base is
   type Instance is tagged limited null record;
end Base;

----------------------- Parent Package ---------------------------
generic
    type T(<>) is tagged;
package Parent is
    type Instance is tagged private;
private
    type T_Access is access T;
    type Instance is tagged record
        Thing : T_Access := null;
    end record;
end Parent;

------------------------ Child Package ---------------------------
with Base;

generic
   type T(<>) is new Base.Instance with private;
package Parent.Child is
   
   type T_Access is access T;

   function Make(Ref : not null T_Access) return Parent.Instance;
   
end Parent.Child;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

package body Parent.Child is

   -- Used later in code not shown, but needed
   -- and requires Child.T to be complete.
   procedure Finalize is new Ada.Unchecked_Deallocation
      (Object => T,
       Name   => T_Access);

   function To_Parent is new Ada.Unchecked_Conversion
      (Source => Child.T_Access,
       Target => Parent.T_Access);

   -- This is where things get IFFY.  I do unchecked conversions here.
   -- If Parent.T is not equal to Parent.Child.T, then this can go bad
   -- really fast.  If there was a way to verify the types were the same,
   -- then I could safely do this.  Or if there was a way for me to
   -- verify that Parent.Child.T was a descendant of Parent.T, then
   -- I could just convert them without unchecked_conversion.
   function Make(Ref : not null T_Access) return Parent.Instance is
      (Thing => To_Parent(Ref));

end Parent.Child;

---------------------------- Main -------------------------------
with Ada.Text_IO;
with Base;
with Parent;
with Parent.Child;

procedure Main is

   type Test is tagged;
   
   package P is new Parent(Test);

   type Test is new Base.Instance with record
      Thing :  P.Instance;
   end record;

   package PC is new P.Child(Test);

   Thing : P.Instance := PC.Make(new Test);

begin
   Ada.Text_IO.Put_Line("Hello");
end Main;

此答案的先前版本忽略了 Jere 需要它为 formal incomplete types, which were introduced with AI05-0213 工作的事实。

该 AI 的一个(主要?)用例是在某些情况下更容易创建签名包(参见 Ada 2012 Rationale, section 4.3)。所以,这是一个使用签名包的产品——不知道它是否满足所需的用例。

generic
   type T is tagged;
package Signature is
end Signature;

with Signature;
generic
   type T is tagged private;
   with package Sig is new Signature (T);
package Parent is
   subtype Parent_T is T;
   Instance : T;
end Parent;

generic
   type T is new Parent.Parent_T with private;
   with package Sig is new Signature (T);
package Parent.Child is
end Parent.Child;

with Signature;
with Parent.Child;
package User is
   type Base is tagged null record;
   procedure Proc (Param : Base);

   package Sig_For_Parent is new Signature (T => Base);
   package For_Parent is new Parent (T => Base, Sig => Sig_For_Parent);

   --  this is OK
   type Extension is new Base with null record;
   procedure Proc (Param : Extension);
   package Sig_For_Child is new Signature (T => Extension);
   package For_Child
   is new For_Parent.Child (T => Extension, Sig => Sig_For_Child);

   --  this fails
   type Wrong is tagged null record;  -- not in Base'Class
   package Sig_For_Wrong is new Signature (T => Wrong);
   package For_Wrong
   is new For_Parent.Child (T => Wrong, Sig => Sig_For_Wrong);

end User;

with Ada.Text_IO;
package body User is

   procedure Proc (Param : Base) is
   begin
      Ada.Text_IO.Put_Line ("Base_P's Proc called.");
   end Proc;

   procedure Proc (Param : Extension) is
   begin
      Ada.Text_IO.Put_Line ("Extension_P's Proc called.");
   end Proc;

end User;

with User;
procedure Test is
   Var : User.Extension;
begin
   Var.Proc;
end Test;

Rationale chapter 的末尾,行

(If this is all too confusing, do not worry, the compiler will moan at you if you make a mistake.)

确实如此。我在玩弄这段代码时发现,它并不能很好地告诉你 是什么错误 .

如果你不需要泛型的parent/child关系,你可以这样做:

foo.ads

generic
   type T(<>) is tagged;
package Foo is

end Foo;

bar.ads

with Foo;

generic
   type T(<>) is tagged private;
   with package Foo_Instance is new Foo(T); --package parameter
package Bar is
 
end Bar;

这样,完整类型必须与不完整类型完全匹配,即。它不能是类型扩展,因此:

with Foo;
with Bar;

package Baz is

   type Base is tagged;
   package Base_Foo is new Foo(Base);
   
   
   type Base is tagged null record;
   package Base_Bar is new Bar(Base, Base_Foo);
   
   
   type Extension is new Base with null record;
   package Extension_Bar is new Bar(Extension, Base_Foo); -- fails!

end Baz;

所以我从 Simon Wright 的回答中得到了一些灵​​感,其中包括一个签名包。这本身还不够,但它是最终解决方案的必要组成部分。基本上,由于 Ada 不提供验证两个通用形式类型是否相同的方法,我使用一个单独的包在 运行 时间通过为给定类型生成一个唯一 ID 来提供该功能,将该包传递给Parent 和 Parent.Child 包,并在 Parent.Child 主体内,验证包的两个实例是否具有相同的 ID(因此是相同的包)。下面提供了一个示例:

签名包的想法导致了以下ID包:

package Type_ID is

   type ID is limited private;
   function "="(L,R : ID) return Boolean;

   generic
      type Item_Type(<>);
   package Unique_ID is
      function Get_ID return ID;
   end Unique_ID;
   
private
   
   -- Implement ID however you wish, just needs to be a unique ID for
   -- each package instantiation

end Type_ID;

然后我将父规范更改为:

with Type_ID;

generic
   with package ID is new Type_ID.Unique_ID(<>);
package Parent is
   type Instance is tagged private;
private
    -- private stuff
end Parent;

并且 Parent.Child 包规范已更新为:

with Base;

generic
   type T(<>) is new Base.Instance with private;
   with package ID is new Type_ID.Unique_ID(T);
package Parent.Child is
   
   type T_Access is access T;

   function Make(Ref : not null T_Access) return Parent.Instance;
   
end Parent.Child;

最后是验证类型相同的部分。由于 Parent 和 Parent.Child 都采用 Type_ID.Unique_ID(<>) 的实例,我们只需要通过比较包内 Get_ID 函数的输出来确保它们是相同的实例Parent.Child 的正文:

package body Parent.Child is

   -- Other implementation stuff

   use all type Type_ID.ID;
begin
   if Parent.ID.Get_ID /= Parent.Child.ID.Get_ID then
      raise Program_Error with "Invalid type passed to child package";
   end if;
end Parent.Child;

基本上是加上自己的运行时间类型信息。

包的实例化变成:

with Ada.Text_IO;
with Type_ID;
with Base;
with Parent;
with Parent.Child;

procedure Main is

   type Test is tagged;

   package ID is new Type_ID.Unique_ID(Test);
   package P is new Parent(ID);

   type Test is new Base.Instance with record
      Thing :  P.Instance;
   end record;

   package PC is new P.Child(Test,ID);

   Thing : P.Instance := PC.Make(new Test);

begin
   Ada.Text_IO.Put_Line("Hello");
end Main;

is there a way in a child package to ensure a type passed into the child as a generic formal is the same type as (or even a descendant of) Parent.T?

Yes.

Generic
   Type Parent(<>) is tagged private;
Package Example is
End Example;

...和...

Generic
   Type Descendant(<>) is new Parent with private;
Package Example.Child is
End Example.Child;