如何实现Unchecked_Access

Question

我正在尝试，再一次，设计一个二维数组，自动扩展。

Rectangular.ads

generic
    type Value_Type is private;

package Rectangular is
    
    function Get ( Row, Col : Integer) return Value_Type;
    procedure Set ( Row, Col : Integer; Value : Value_Type);
    
private
    type Matrix is array (Integer range <>, Integer range <>) of aliased Value_Type;
    
    Item : access Matrix;
    
end Rectangular;

Rectangular.adb

package body Rectangular is

    function Create (Rowmin, Rowmax, Colmin, Colmax : Integer) return access Matrix is
    begin
        return Answer :  constant access Matrix :=
          new Matrix (Rowmin .. Rowmax, Colmin .. Colmax)
        do
            null; -- maybe something later...
        end return;
    end Create;
    
    procedure Adjust_Bounds (Row, Col : Integer) is
        
        Rowmin, Rowmax, Colmin, Colmax : Integer;
        Newitem :  access Matrix;
        
    begin
        
        if Row >= Item'First (1) and Row <= Item'Last (1) and
          Col >= Item'First (2) and Col <= Item'Last (2) then
            return;
        end if;

        -- Matrix needs expanding, establish new bounds
        Rowmin := Integer'Min (Item'First (1), Row);
        Rowmax := Integer'Min (Item'Last (1), Row);
        Colmin := Integer'Min (Item'First (2), Col);
        Colmax := Integer'Min (Item'Last (2), Col);
    
        Newitem := Create (Rowmin, Rowmax, Colmin, Colmax);
        
        -- Copy old to new
        for R in Item'Range (1) loop
            for C in Item'Range (2) loop
                Newitem (R, C) := Item (R, C);
            end loop;
        end loop;
        
        -- How to free Item here?
        Item := Newitem;
        
    end Adjust_Bounds;
    
    function Get (Row, Col : Integer) return Value_Type is
        Result : Value_Type;
    begin
        Adjust_Bounds (Row, Col);
        Result := Item (Row, Col);
        return Result;
    end Get;
    
    procedure Set ( Row, Col : Integer; Value : Value_Type) is
    begin
        Adjust_Bounds (Row, Col);
        Item (Row, Col) := Value;
    end Set;
    
begin
    Item := Create (0, 0, 0, 0);

end Rectangular;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Rectangular;
procedure Main is
begin
    declare
        package Rect is new Rectangular (Value_Type => Integer);
        X : Integer;
    begin
        -- Only 0,0 exists initially
        Rect.Set (0, 0, 2);
        X := Rect.Get (0, 0);
        Put_Line (X'Image);
        
        -- Make the matrix expand
        Rect.Set (1, 1, 42);
        X := Rect.Get (1, 1);
        Put_Line (X'Image);
    end;
end Main;

这会编译，但是

   6:17 warning: "Program_Error" will be raised at run time
   6:17 warning: accessibility check failure
   6:17 warning: in instantiation at rectangular.adb:29

当然，当我尝试运行它时，我会得到“PROGRAM_ERROR : rectangular.adb:59可访问性检查失败”。

我不明白为什么，因为'Rect‘是不清楚的范围以外的区块；

1. 我应该使用Unchecked_Access来避免这种行为吗？如果是的话，它会是什么样的呢？
2. 如果没有，正确的成语是什么？
3. 如何在Rectangular.adb中释放“项目”？

几天来，我一直试图让它工作，但没有成功，如果能帮助编写代码示例，我们将不胜感激。

Answer 1

在type Matrix之后添加

type Matrix_P is access Matrix;

(使用自己的约定命名访问类型)。

然后，全局地将access Matrix替换为Matrix_P。

然后，在Adjust_Bounds中，您似乎需要替换

      Rowmax := Integer'Min (Item'Last (1), Row);

通过

      Rowmax := Integer'Max (Item'Last (1), Row);

Colmax也是如此。

Answer 2

您可以考虑使用以下包规范中所示的模式来生成可扩展的矩阵：

with Ada.Containers.Vectors;
generic
   type Index_Type is range <>;
   with package inner_vector is new Ada.Containers.Vectors(<>);
package Vector_Of_Vectors is
   package V_Matrix is new Ada.Containers.Vectors(Index_Type   => Index_Type,
                                                  Element_Type => Inner_Vector.Vector,
                                                  "="          => Inner_Vector."=");
   use Inner_Vector;
end Vector_Of_Vectors;

此模式将在概念上模拟数组的数组。

type foo is array (Positive range 1..10) of Integer;
type bar is array (Natural range 0..9) of foo;

您现在可以修改V_Matrix类型的每个向量元素的长度，并向V_Matrix添加更多的向量元素。

下面是实例化Vector_Of_Vectors包的一个小示例：

with Ada.Containers.Vectors;
with Vector_Of_Vectors;
with Ada.Text_IO; use Ada.Text_IO;
use Ada.Containers;

procedure Main is
   package Int_Vector is new Ada.Containers.Vectors(Index_Type => Natural,
                                                    Element_Type => Integer);
   use Int_Vector;
   
   package Int_Matrix is new Vector_Of_Vectors(Index_Type   => Natural,
                                               inner_vector => Int_Vector);
   use Int_Matrix;
   
   Temp_Vect : Int_Vector.Vector;
   Temp_Mat  : V_Matrix.Vector;
begin

   Temp_Vect := Int_Vector.Empty_Vector;
   for I in 1..5 loop
      Temp_Vect.append(I);
   end loop;
   
   Temp_Mat.Append(Temp_Vect);
    
   temp_Vect := Int_Vector.Empty_Vector;
    
   for I in 15..25 loop
      Temp_Vect.append(I);
   end loop;
   Temp_Mat.Append(Temp_Vect);
     
   for V of Temp_Mat loop
      for I of V loop
         Put(I'Image);
      end loop;
      New_Line;
   end loop;
end Main;

Answer 3

以下是一个动态自调整二维数组的可能解决方案。用法：

package Rect is new Rectangular (Element => Float, Default => 0.0);
use Rect;
Map : Rect.Matrix;
...
Map(-25, 97) := 42.0;

如果每增加一次大小，重新分配基础数组的代价将是不可接受的，因此包分配的比减少再分配所必需的稍多一些。

示例Main不断扩展数组，直到堆耗尽为止，记录每次重新分配的时间。我对编译代码的速度感到惊喜，重新分配1_000 X 1_000数组(1_000_000元素)只需要~5 mS：

​

这是在AMD 3960 X上运行的输出

Resized to  0..10, 0..10 =  1 entries in  0.000002100 s
Resized to  0..24, 0..24 =  121 entries in  0.000001500 s
Resized to  0..54, 0..54 =  625 entries in  0.000011800 s
Resized to  0..118, 0..118 =  3025 entries in  0.000033200 s
Resized to  0..254, 0..254 =  14161 entries in  0.000116400 s
Resized to  0..541, 0..541 =  65025 entries in  0.000204300 s
Resized to  0..1143, 0..1143 =  293764 entries in  0.000889200 s
Resized to  0..2400, 0..2400 =  1308736 entries in  0.004220100 s
Resized to  0..5015, 0..5015 =  5764801 entries in  0.017126300 s
Resized to  0..10439, 0..10439 =  25160256 entries in  0.072370300 s
 10000 X  10000 is  381Mb
Resized to  0..21661, 0..21661 =  108993600 entries in  0.328238800 s
 20000 X  20000 is  1525Mb
Resized to  0..44827, 0..44827 =  469242244 entries in  1.432776000 s
 30000 X  30000 is  3433Mb
 40000 X  40000 is  6103Mb
Resized to  0..92556, 0..92556 =  2009549584 entries in  56.372428000 s
 50000 X  50000 is  9536Mb
 60000 X  60000 is  13732Mb
 70000 X  70000 is  18692Mb
 80000 X  80000 is  24414Mb
 90000 X  90000 is  30899Mb

raised STORAGE_ERROR : System.Memory.Alloc: heap exhausted

STORAGE_ERROR和预期的一样，我有32 of的内存。

--这是我在Ada的第一次努力之一，批评将是非常受欢迎的。

main.ads

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Assertions; use Ada.Assertions;
with Rectangular;

procedure Main is
    
    subtype Element is Float;
    
    Default_Value : Element := 42.0;
    
    package Rect is new Rectangular (Element => Element, Default => Default_Value);
    use Rect;
    Map : Rect.Matrix;
    
begin
    declare -- warmup, ensure values get set and defaults are applied
    begin
        Map (0, 0) := 2.3;
        Map (10, 10) := Map (0, 0) + 1.0;
        Assert (Map (0, 0) = 2.3);
        Assert (Map (10, 10) = 3.3);
        Assert (Map (5, 5) = Default_Value);
    end;
    
    declare -- Exercise hard to get reallocation timings
        Bytes           : Long_Long_Integer;
        MBytes          : Long_Long_Integer;
        ILong           : Long_Long_Integer;
        Current, Should : Element;
    begin
        for I in 0 .. 100_000 loop

            Map (I, I) := Element (I * 3);
            
            if I mod 10_000 = 0 then -- occasionally
                
                -- Check every value. On diagonal=3*, Off diagonal=Default_Value
                for Row in 0 .. I loop
                    for Col in 0 .. I loop
                        Current := Map (Row, Col );
                        if Row = Col then
                            Should := Element (Row * 3);
                        else
                            Should := Default_Value;
                        end if;
                        Assert (Current = Should);
                    end loop;
                end loop;
                
                -- Show progress
                ILong := Long_Long_Integer (I);
                Bytes := Ilong * Ilong * Long_Long_Integer (Element'Size) / 8;
                MBytes := Bytes / 2 ** 20;
                Put_Line (I'Image & " X " & I'Image & " is " & MBytes'Image & "Mb");
            end if;
        end loop;
    end;
end Main;

Rectangular.ads

generic
    type Element is private;
    Default : Element;

package Rectangular is
-- Provides an X..Y matrix of Element, which can be used just like a 2D Array.
-- The bounds of the array adjust themselves to accomodate requested indexes.
-- Rule-of-thumb: ~5 millseconds to re-allocate an array of 1'000'000 (1'000 x 1'000) entries. YMMV.
-- Usage:
--    package Rect is new Rectangular (Element => Float, Default => 0.0);
--    use Rect;
--    Map : Rect.Matrix;
--    ...
--    Map(-25, 97) := 42.0;
-- The bounds are now -25..0, 0..97, 2'548 elements, all 0.0 except -25,97 = 42.0
    
    type Matrix is tagged limited private
      with 
         Constant_Indexing => Get_Element,
         Variable_Indexing => Get_Reference;

    type Element_Access is access all Element;

    function Get_Element (M : in out Matrix; E : in Element_Access) return Element;

    function Get_Element (M : in out Matrix; Row, Col : in Integer) return Element;

    type Reference (R : access Element) is limited null record
      with Implicit_Dereference => R;

    function Get_Reference (M : in out Matrix; E : in Element_Access) return Reference;

    function Get_Reference (M : in out Matrix; Row, Col : in Integer) return Reference;

private
    type Backing is array (Integer range <>, Integer range <>) of Element;
    type Backing_Access is access Backing;
    type Matrix is tagged limited record
        Items : Backing_Access;
    end record;
end Rectangular;

Rectangular.adb：

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;
with Ada.Numerics.Generic_Elementary_Functions;

package body Rectangular is

    Demo : constant Boolean := True; -- Set to False once you've watched the demo
    
    function Create (Row_First, Row_Last, Col_First, Col_Last : Integer) return Backing_Access is
    -- Create a Backing array of Element'Access with (possibly negative) bounds
    begin
        return Answer :  Backing_Access :=
          new Backing (Row_First .. Row_Last, Col_First .. Col_Last)
        do
            for I in Row_First .. Row_Last loop
                for J in Col_First .. Col_Last loop
                    Answer (I, J) := Default;
                end loop;
            end loop;
        end return;
    end Create;
    
    function Multiplier (Bounds : Integer) return Float is
    -- From the bounds of an array, calculate a suitable, gentle increase
    -- Bounds | Log/(1+bounds,2) | 1/That | Increase
    --       1         1.0          1.000         1 
    --      10         3.5          0.289         3 
    --     100         6.7          0.150        15 
    --   1,000        10.0          0.100       100 
    --   5,000        12.3          0.081       407 
    --  10,000        13.3          0.075       753 
    --  25,000        14.6          0.068     1,711 
    -- 100,000        16.6          0.060     6,021 
    --
    -- So, for a matrix bound (row or column) that is 25'000, 
    -- the matrix will be resized to 25'000+1'711=26'711
    
        package Floats is new Ada.Numerics.Generic_Elementary_Functions (Float);
        Factor, Result : Float;
    begin
        Factor := Floats.Log (Float (1 + Bounds), 2.0);
        Result := 1.0 + 1.0 / Factor;
        -- Put_Line (Bounds'Image & ' ' & Factor'Image & ' ' & Result'Image);
        return Result;
    end Multiplier;
    
    procedure Free is new Ada.Unchecked_Deallocation (Backing, Backing_Access);
    -- Release a Backing.
    -- We know that this is safe, as they are private and only *we* can allocate them
    
    procedure Adjust_Bounds (M : in out Matrix; Row, Col : in Integer) is
    -- Check to see if Row-Col is within the current bounds.
    -- If not, enlarge the Backing to accomodate said Row-Col
    begin
        if M.Items = null then -- auto-initialise
            M.Items := Create (Row, Row, Col, Col);
        end if;
            
        if Row >= M.Items'First (1) and Row <= M.Items'Last (1) and
          Col >= M.Items'First (2) and Col <= M.Items'Last (2) then
            return; -- In bounds, all is well
        end if;
        
        declare
            Enlarged                       : Backing_Access;
            Row_First, Row_Last            : Integer;
            Col_First, Col_Last            : Integer;
            Row_Range, Col_Range           : Integer;
            Row_Multiplier, Col_Multiplier : Float;
            Start_Time, End_Time           : Time;
        
        begin
            if Demo then
                Start_Time := Clock;
            end if;
            Row_First := M.Items'First (1);
            Row_Last := M.Items'Last (1);
            Row_Range := Row_Last - Row_First + 1;
            Row_Multiplier := Multiplier (Row_Range);
        
            Col_First := M.Items'First (2);
            Col_Last := M.Items'Last (2);
            Col_Range := Col_Last - Col_First + 1;
            Col_Multiplier := Multiplier (Col_Range); 

            -- Integer'Min because the requested index may be further out than our conservative expansion multiplier
            if Row < Row_First then
                Row_First := Integer'Min (Row, Row_First - Integer (Float (Row_Range) * Row_Multiplier));
            elsif Row > Row_Last then
                Row_Last := Integer'Max (Row, Row_Last + Integer (Float (Row_Range) * Row_Multiplier));
            end if;
        
        
            if Col < Col_First then
                Col_First := Integer'Min (Col, Col_First - Integer (Float (Col_Range) * Col_Multiplier));
            elsif Col > Col_Last then
                Col_Last := Integer'Max (Col, Col_Last + Integer (Float (Col_Range) * Col_Multiplier));
            end if;

            Enlarged := Create (Row_First, Row_Last, Col_First, Col_Last);

            -- Copy old to new
            for R in M.Items'Range (1) loop
                for C in M.Items'Range (2) loop
                    Enlarged (R, C) := M.Items (R, C);
                end loop;
            end loop;
        
            Free (M.Items);
            M.Items := Enlarged;
            
            -- just for demonstration
            if Demo then
                declare
                    Seconds : Duration;
                    Size    : Long_Long_Integer := Long_Long_Integer (Row_Range) * Long_Long_Integer (Col_Range);
                begin
                    End_Time := Clock;
                    Seconds := End_Time - Start_Time;
                    Row_Range := Row_Last - Row_First + 1;
                    Col_Range := Col_Last - Col_First + 1;
                    Put_Line ("Resized to " & Row_First'Image & ".." & Trim (Row_Last'Image, Left) & ',' & 
                      Col_First'Image & ".." & Trim (Col_Last'Image, Left) & 
                      " = " & Size'Image & " entries in " & Duration'Image (Seconds) & " s");
                end;
            end if;
        end;
        
    end Adjust_Bounds;
    
    function Get_Reference (M : in out Matrix; E : in Element_Access) return Reference is
      (Reference'(R => E));

    function Get_Element (M : in out Matrix; E : in Element_Access) return Element is
      (M (E));

    function Get_Element (M : in out Matrix; Row, Col : in Integer) return Element is
        Result : Element;
    begin
        Adjust_Bounds (M, Row, Col);
        Result := M.Items (Row, Col);
        return Result;
    end Get_Element;

    function Get_Reference (M : in out Matrix; Row, Col : in Integer) return Reference is
    begin
        Adjust_Bounds (M, Row, Col);
        -- Unrestricted_Access is wicked, but we know what we're doing and it's the only way
        return Answer : Reference :=
          Reference'(R => M.Items ( Row, Col)'Unrestricted_Access);
    end Get_Reference;
    
end Rectangular;