------------------------------------------------------------------------------
type Int_Ptr is access all Integer;
ref : Int_Ptr;
num : aliased Integer := 5;
ref := num'Access;
Put(Item => ref.all); -- Print the value ref refers to
ref.all := 3; -- Assign to ref's referant
-------------------------------
type Flt_Ptr is access all Float;
ref : Flt_Ptr;
pi : Float := 3.14159;
pi'Access := 4; -- Compile time error. The Access attribute cannot be used
-- on the left hand side of an assignment.
-- Also, "pi" is not defined as "aliased". This will also
-- generate a compiler error
-------------------------------
-- There is no direct relationship between arrays and references in Ada.
-- An array is a collection of like objects. An array name is NOT an
-- access or reference to the first element of the array as in C.
-------------------------------
-- Ada provides two kinds of access types, general access types and
-- pool-specific acess types. Referants for pool-specific access types
-- must always be dynamically allocated. Referants for general access
-- types may be dynamically allocated, or may refer to aliased objects
-- generated on the stack.
type Pool_Ptr is access Float; -- Pool specific access type
type Gen_Ptr is access all Float; -- General access type
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
type Sales is array (Integer range 1..7) of Float;
type Sales_Access is access Sales; -- Pool specific example
Weekly_Sales : Sales_Access := new Sales; -- dynamically allocate
-- the Sales array
-- and assign its reference to
-- Weekly_Sales
-------------------------------
last_index : Integer := Sales'Last;
first_index : Integer := Sales'First;
num_items : Integer := Sales'Length;
-------------------------------
-- Ada arrays are all fixed size. They cannot be enlarged after creation
-- Ada array types may be unconstrained in size, allowing the size of a
-- particular instance to be specified upon creation.
type String is array(Positive range <>) of Character;
s1 : String(1..10); -- s1 is a 10 element string
s2 : String(1..34); -- s2 is a 34 element string
s3 : String(11..20); -- s3 is a 10 element string with a
-- a starting index of 11
-------------------------------
type String_Ref is access String;
r1 : String_Ref;
r1 := new String(1..20); -- Dynamically allocate an array
Put(r1(N)); -- Print the character at index N
-------------------------------
r1(3..5) -- Array slice
-------------------------------
r1(3..5) := r1(9..11);
-------------------------------
-- Ada provides no way to make a reference to a slice
-------------------------------
for index in r1'Range loop
-- iterate through all elements in the array
-- referenced by r1
end loop;
-------------------------------
for index in s1'Range loop
-- iterate through all elements in array s1
end loop;
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------ -- Ada provides no standard implementation of hashes ------------------------------------------------------------------------------ |
------------------------------------------------------------------------------ -- Ada provides no standard implemenation of hashes ------------------------------------------------------------------------------ |
------------------------------------------------------------------------------
-- Define an access type to a function taking two integer parameters and
-- returning a boolean
type func_ref is access function (A, B : Integer) return Boolean;
-- Define an access type to a procedure taking no parameters
type proc_ref is access procedure;
-- Define a function taking two integers and returning a boolean
function Less_Than(X, Y : Integer) return Boolean;
-- Define an instance of the func_ref access type
compare : func_ref;
compare := Less_Than'Access; -- Less than matches the signature defined in
-- the func_ref type declaration
-- Calling the function through the referenc
if compare(num1, num2) then
... -- act on the comparison
end if;
-- Define a procedure taking no parameters
procedure Print_Header;
-- Define an instance of proc_ref access type
action : proc_ref := Print_Header'Access;
-- Call the parameter-less procedure
action.all;
-------------------------------
-- Ada does not provide closures, or functions with static data
-- The same effect can be produced using Ada tasks.
package counters is
task type Counter_Maker is
entry Get_Count(Num : out Integer);
end Counter_Maker
type Counter_Ref is access Counter_Maker;
end counters;
package body counters is
task body Counter_Maker is
start : Integer := 0;
begin
loop
accept Get_Count(Num : out Integer)
do
Num := start;
end Get_Count;
start := start + 1;
end loop;
end Counter_Maker;
end counters;
counter1 : Counter_Ref := new Counter;
the_count : Integer;
for iter in 0..4 loop
counter1.Get_Count(the_count);
Put_Line(Integer'Image(the_count));
end loop;
-------------------------------
counter1 : Counter_Ref := new Counter;
counter2 : Counter_Ref := new Counter;
count1, count2 : Integer;
for iter in 0..4 loop
counter1.Get_Count(count1);
Put_Line(Integer'Image(count1));
end loop;
counter1.Get_Count(count1);
counter2.Get_Count(count2);
Put_Line(Integer'Image(count1) & " " &
Integer'Image(count2));
0
1
2
3
4
5 0
-------------------------------
function Time_Diff(Base_Time : Time) return Duration is
Now : Time := Clock;
begin
return Now - Base_Time;
end Time_Diff;
early : Time;
later : Time;
early := Clock;
delay 20.0;
later := Clock;
delay 10.0;
Put_Line("It's been " & Duration'Image(Time_Diff(early)) &
" seconds since early.");
Put_Line("It's been " & Duration'Image(Time_Diff(later)) &
" seconds since later");
-- It's been 30.007172430 seconds since early.
-- It's been 10.003749644 seconds since later.
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------ -- Ada does not provide special syntax for obtaining reference to scalars -- compared to vectors. ------------------------------------------------------------------------------ |
------------------------------------------------------------------------------ type Num_Ref is access all Integer; type Ref_Array is array (1..10) of Num_Ref; ------------------------------- array_of_refs : Ref_Array; array_of_refs := (Others => null); -- Set all values to null references for index in Ref_Array'Range loop array_of_refs(index) := new Integer'(index); end loop ------------------------------- for index in Ref_Array'Range loop Put_Line(Integer'Image(array_of_refs(index).all)); end loop; ------------------------------- for index in Ref_Array'Range loop array_of_refs(index).all := index * 10; end loop; ------------------------------------------------------------------------------ |
------------------------------------------------------------------------------ |
------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Binary Tree Example
-------------------------------------------------------------------------------
package Binary_Trees is
type Tree is private;
procedure insert(Item : in Integer; Into : in out Tree);
procedure in_order(Item : in Tree);
procedure pre_order(Item : in Tree);
procedure post_order(Item : in Tree);
function search(Item : in Integer; From : in Tree) return boolean;
private
type node;
type Tree is access Node;
type Node is record
Value : Integer;
Left : Tree := Null;
Right : Tree := Null;
end record;
end Binary_Trees;
with Ada.Text_IO;
use Ada.Text_Io;
package body Binary_Trees is
procedure insert(Item : in Integer; Into : in out Tree) is
begin
if Into /= null then
if Into.Value > Item then
insert(Item, Into.Left);
elsif Into.Value < Item then
insert(Item, Into.Right);
end if; -- Do nothing if duplicate
else
Into := new Node;
Into.Value := Item;
end if;
end insert;
procedure in_order(Item : in Tree) is
begin
if Item = null then
return;
end if;
in_order(Item.Left);
Put(Integer'Image(Item.Value) & " ");
in_order(Item.Right);
end in_order;
procedure pre_order(Item : in Tree) is
begin
if Item = null then
return;
end if;
Put(Integer'Image(Item.Value) & " ");
pre_order(Item.Left);
pre_order(Item.Right);
end pre_order;
procedure post_order(Item : in Tree) is
begin
if Item = null then
return;
end if;
post_order(Item.Left);
post_order(Item.Right);
Put(Integer'Image(Item.Value) & " ");
end post_order;
function search(Item : Integer; From : Tree) return Boolean is
Result : Boolean;
begin
if From /= null then
if From.Value = Item then
Result := True;
elsif From.Value > Item then
Result := search(Item, From.Left);
else
Result := search(Item, From.Right);
end if;
else
Result := False;
end if;
return Result;
end search;
end Binary_Trees;
with Binary_Trees; use Binary_Trees;
with Ada.Numerics.Discrete_Random;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
procedure Tree_Test is
package Rand_Num is new Ada.Numerics.Discrete_Random(Integer);
use Rand_Num;
Seed : Generator;
Val : Integer;
The_Tree : Tree;
begin
Reset(Seed);
for num in 1..20 loop
Val := Random(Seed);
insert(Item => Val, Into => The_Tree);
end loop;
-- now dump out the tree all three ways
Put("Pre Order: ");
pre_order(The_Tree);
New_Line;
Put("In order: ");
in_order(The_Tree);
New_Line;
Put("Post_Order: ");
post_order(The_Tree);
New_Line;
-- prompt until EOF
loop
Put("Search? ");
exit when Ada.Text_IO.End_Of_File;
Get(Val); -- read input as an integer
if search(Item => Val, From => The_Tree) then
Put_Line("Found " & Integer'Image(Val));
else
Put_Line("No " & Integer'Image(Val) & " in tree");
end if;
end loop;
end Tree_Test; |