4

大多数干净的 C API 将回调声明为回调函数和用户数据的组合。用户数据通常是无效的*。WinAPI 使用指针大小的整数 (lParam)。在进行厚绑定期间，自然希望允许使用 Ada 2005 闭包代替 C 回调。

我有一个代码。它在 GNAT 上就像一个魅力（GPL 2012，x86-windows 至少经过测试），但通常不能保证 Run_Closure_Adapter.X 变量和 Run_Closure.X 参数将具有相同的内部结构。

问题是：是否有适当的（符合标准的）方法来做到这一点？也许是一个涉及标记类型、接口或泛型的技巧。至少有一种方法可以做到这一点：在不同的任务中运行闭包执行器和闭包并使用集合点。但这太慢了。

Closure_Test.adb：

with Closure_Lib; use Closure_Lib;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;

procedure Closure_Test is

   procedure Closure_Tester is

      Local_String : String := "Hello, world!";

      procedure Closure is
      begin
         Put_Line (Local_String);
      end Closure;

   begin
      Run_Closure (Closure'Access);
   end Closure_Tester;

   procedure Ada_Run_Closure (X : access procedure) is
   begin
      X.all;
   end Ada_Run_Closure;

   -- Nested_Closure fills the execution stack with
   -- several activation records of Nested_Closure_Tester
   -- Having done so (local I = 0) we start a Fibonacci
   -- algorithm using Print_Closure access values of
   -- different dynamic nesting levels

   procedure Nested_Closure_Tester
     (I : Integer;
      Closure_Runner: access procedure (X : access procedure);
      Prev_Closure, Prev_Closure2: access procedure)
   is

      procedure Print_Closure is
      begin
         if Prev_Closure /= null and Prev_Closure2 /= null then
            Closure_Runner (Prev_Closure);
            Closure_Runner (Prev_Closure2);
         else
            Put (".");
         end if;
      end Print_Closure;

      procedure Nested_Closure is
      begin
         if I > 0 then
            Nested_Closure_Tester (I - 1, Closure_Runner,
                                   Print_Closure'Access, Prev_Closure);
         else
            Print_Closure;
         end if;
      end Nested_Closure;
   begin
      Closure_Runner (Nested_Closure'Access);
   end Nested_Closure_Tester;

begin
   -- Closure_Tester;
   -- I = 6 gives 13 dots
   Nested_Closure_Tester(6, Ada_Run_Closure'Access, null, null);
   New_Line;
   Nested_Closure_Tester(6, Run_Closure'Access, null, null);
end Closure_Test;

Closure_Lib.ads：

with Interfaces.C;
with System;

package Closure_Lib is

   procedure Run_Closure (X : access procedure);

private

   type Simple_Callback is access procedure(Data : in System.Address);
   pragma Convention (C, Simple_Callback);

   procedure Run_Callback (X : in Simple_Callback; Data : in System.Address);

   pragma Import (C, Run_Callback, "Run_Callback");

   procedure Sample_Callback (Data : in System.Address);
   pragma Convention (C, Sample_Callback);

end Closure_Lib;

Closure_Lib.adb：

with Interfaces.C;
with System;
with System.Storage_Elements; use System.Storage_Elements;
with Ada.Text_IO; use Ada.Text_IO;

package body Closure_Lib is

   procedure Sample_Callback (Data : in System.Address) is
   begin
      Ada.Text_IO.Put_Line ("Simple_Callback");
   end Sample_Callback;

   procedure Run_Closure_Adapter (Data : in System.Address);
   pragma Convention (C, Run_Closure_Adapter);

   procedure Run_Closure_Adapter (Data : in System.Address) is
      X : access procedure;
      for X'Address use Data;
      pragma Import (Ada, X);
      X_Size : constant Storage_Count := X'Size / System.Storage_Unit;
   begin
      -- Put_Line ("Variable access procedure size:" & Storage_Count'Image (X_Size));
      X.all;
   end Run_Closure_Adapter;

   procedure Run_Closure (X : access procedure) is
      X_Size : constant Storage_Count := X'Size / System.Storage_Unit;
      X_Address : constant System.Address := X'Address;
   begin
      -- Put_Line ("Anonymous access procedure size:" & Storage_Count'Image (X_Size));
      Run_Callback (Run_Closure_Adapter'Access, X_Address);
   end Run_Closure;

end Closure_Lib;

闭包执行器.c：

typedef void (*Simple_Callback)(void* Data);

void Run_Callback (Simple_Callback X, void* Data) {
    (*X)(Data);
}
4

2 回答 2

6

我认为使用泛型可能会满足您正在寻找的内容（顺便说一下，我不明白使用任务如何确保数据类型匹配？）

也许像

generic
   type Client_Data is private;
package Closure_G is
   type Closure (<>) is private;
   function Create (Proc : access procedure (Parameter : Client_Data);
                    And_Parameter : Client_Data) return Closure;
   procedure Execute (The_Closure : Closure);
private
   type Procedure_P is access procedure (Parameter : Client_Data);
   type Closure is record
      The_Procedure : Procedure_P;
      And_Parameter : Client_Data;
   end record;
end Closure_G;

当用户调用Execute (A_Closure)时，Proc提供的 toCreate会与And_Parameter当时提供的 that 一起调用。

（type Closure (<>) is private;确保用户只能Closure使用提供的创建对象Create。）

在您传递给 C 库以在事件发生时回调的场景中，主要问题是该Closure对象实际上是由 C 库维护的。

除了您实际上并不需要这个 Ada 之外Closure，还有一个由匿名访问子程序值引起的潜在问题，即子程序可以在本地声明并且在 C 库获取时已经超出范围轮到调用它。这将是坏消息。

在 Ada 世界中，编译器以两种方式处理这个问题。首先，您不允许存储匿名访问子程序的值（因此是type Procedure_P上述内容）。其次，即使你像这样解决这个问题

function Create (Proc : access procedure (Parameter : Client_Data);
                 And_Parameter : Client_Data) return Closure is
begin
   return (The_Procedure => Procedure_P'(Proc),
           And_Parameter => And_Parameter);
end Create;

在运行时检查实际的“可访问性级别”；如果你弄错了，你会得到一个Program_Error.

于 2012-08-01T19:41:26.070 回答
3

作为替代方案，您可以查看如何GtkAda处理来自GTK+. 如GtkAda User's Guide所示，并在§4.2.2 中讨论。通过Gtk.Handlers包连接，

该Gtk.Marshallers包提供了一组函数，可直接用作回调函数GtkAda......To_Marshaller在Gtk.Handlers. 它们接受一个参数，即您要调用的函数的名称，并返回一个可以直接在Connect.

Interaction是一个实例化几个这样的处理程序并使用访问子程序参数连接相应回调的示例。

于 2012-08-02T00:48:13.663 回答