如何实施 Unchecked_Access
How to implement Unchecked_Access
我正在尝试，again，设计一个自动扩展的二维数组。
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' 在块范围之外无法清楚地访问；
- 我应该使用 Unchecked_Access 来避免这种行为吗？如果是这样，它会是什么样子？
- 如果不是，正确的成语是什么？
- 我应该如何释放 Rectangular.adb 中的 'Item'？
几天来我一直试图让它工作但没有成功，如果能提供工作代码示例方面的帮助，我们将不胜感激。
在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.
也是如此
您可以考虑使用以下包装规范中显示的模式制作可扩展矩阵：
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;
这是动态自调整二维阵列的可能解决方案。用法：
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 毫秒：
这是 运行 在 AMD 3960X:
上的输出
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符合预期，我有32Gb的内存。
这是我在 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;
我正在尝试，again，设计一个自动扩展的二维数组。
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' 在块范围之外无法清楚地访问；
- 我应该使用 Unchecked_Access 来避免这种行为吗？如果是这样，它会是什么样子？
- 如果不是，正确的成语是什么？
- 我应该如何释放 Rectangular.adb 中的 'Item'？
几天来我一直试图让它工作但没有成功，如果能提供工作代码示例方面的帮助，我们将不胜感激。
在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.
您可以考虑使用以下包装规范中显示的模式制作可扩展矩阵：
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;
这是动态自调整二维阵列的可能解决方案。用法：
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 毫秒：
这是 运行 在 AMD 3960X:
上的输出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符合预期，我有32Gb的内存。
这是我在 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;