將Ada閉包轉換爲C回調（function + void *）

Question

大多數乾淨的C API將回調聲明爲回調函數和用戶數據的組合。用戶數據通常是void *。 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; 

closure_executor.c：

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

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

Answer 1

我想你在找什麼可以用通用的滿足（順便說一下，我不知道怎樣使用任務可以確保數據類型匹配？）

也許像

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)，提供給Create的Proc被稱爲與供給則And_Parameter。

（該type Closure (<>) is private;確保THT用戶只能使用提供的Create創建Closure對象。）

這樣做的主要麻煩，你傳遞給一個C庫的情況下被稱爲回當事件發生，是由C庫實際維護的對象是Closure。

除了你並不真的需要這個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。

Answer 2

作爲替代方案，您可以查看GtkAda如何處理來自GTK+的回調。如該GtkAda tutorial所示，

一組To_Marshaller功能在每個通用包在Gtk.Handlers找到。它們採用一個參數，即要調用的函數的名稱，並返回一個可直接在Connect中使用的處理函數。

Interaction是實例化幾個這樣的處理程序，並使用接入到子程序參數連接相應的回調的例子。