| Introduction
This article describes what an active iterator is, and how to use a
factory method to create one.
There are also examples of using System.Address_To_Access_Conversions to
get around the limitation of not having in out parameter modes for
functions.
Iterators: Active vs Passive
Ordered data structures allow you to access a single item, for example
the top of a stack, or the front of a queue, or the head of a list. An
iterator effectively extends the behavior of the abstraction, by
allowing you to visit all the items in a data structure.
There are two kinds of iterators: passive and active. A passive
iterator controls the actual movement within the data structure, and all
a client has to do is supply a procedure to receive each item in turn.
There was an example of a passive iterator in my posts about the visitor
pattern:
generic
with procedure Process
(Item : access Root_Equipment'Class);
procedure For_Every_Item
(Composite : access Composite_Equipment'Class);
You can use this to visit each piece of equipment in the composite
object. The composite itself uses it to implement its destructor:
procedure Do_Free
(Composite : access Composite_Equipment) is
procedure Free_Item
(Item : access Root_Equipment'Class) is
begin
Do_Free (Item);
end;
procedure Free_Items is
new For_Every_Item (Free_Item);
begin
Free_Items (Composite);
end Do_Free;
An active iterator moves the resposibility for movement onto the client.
Unlike a passive iterator, which is essentially just a generic
subprogram, an active iterator is an actual type, with primitive
operations for retrieving the current item and for moving to the next
item in the sequence.
You often see active iterators implemented as a limited private type,
with an access discriminant:
type Stack_Iterator
(Stack : access Stack_Type) is limited private;
function Done
(Iterator : Stack_Iterator) return Boolean;
function Get_Item
(Iterator : Stack_Iterator)
return Item_Type;
procedure Advance
(Iterator : in out Stack_Iterator);
You would typically use this in a loop, to process each item:
Stack : aliased Stack_Type;
...
declare
Iter : Stack_Iterator (Stack'Access);
begin
while not Done (Iter) loop
... process Get_Item (Iter) ...
Advance (Iter);
end loop;
end;
Factory Methods
However, there is a potential problem with the formulation above. There
are times when you'd like to be able to invoke a constructor for the
iterator during its declaration, as in:
declare
Iter : Iterator_Type := Initialize (Stack);
begin
but this is not possible, because the type is limited.
Here's an example of a time when you'd need to do this. Each specific
type in a data structure hierarchy needs its own iterator, because the
iterator needs to have access to the representation of the type. But
suppose you want to iterate over a stack (say) whose type is class-wide,
something like:
procedure Print (Stack : in Root_Stack'Class) is
Iter : ...; <-- ???
begin
How to you get an iterator for the specific type, if you have only a
class-wide object?
The answer is that you ask the stack to give you an iterator that will
allow you to iterate over that stack. Here's where the factory method
comes in.
A "factory method" is just a fancy name for a dispatching constructor
that returns a class-wide object. A factory method for iterators would
look something like:
function Initialize
(Stack : Root_Stack)
return Root_Iterator'Class;
Note carefully the types in this declaration. Initialize is a primitive
operation of stack, and therefore takes the specific stack type as a
parameter, but its return type is a class-wide iterator.
We can implement the Print operation above using a factory method
constructor for iterators:
procedure Print (Stack : in Root_Stack'Class) is
Iter : Root_Iterator'Class := Initialize (Stack);
begin
We then call iterator operations (Get_Item, Advance) that dispatch
according to the tag of the iterator:
while not Done (Iter) loop
Put_Line (Get_Item (Iter));
Advance (Iter);
end loop;
end Print;
This is also an example of double dispatching: dispatch an interator
constructor according to the tag of Stack, and then dispatch iterator
operations according to the tag of the iterator returned by the
constructor.
The declaration of a class-wide object requires that the object be given
an initial value, because a class-wide type is indefinate. (In our case,
the initial value is supplied by the factory method constructor.) This
means we need assignment for the type, and therefore the iterator must
be declared as non-limited.
Discussion of Examples
I've chosen a stack as the data structure to illustrate iterators and
factory methods, because it presents an interesting problem: How do you
copy one stack into another, without the copy being in reverse order?
In a naive implementation, we would iterate over the source stack from
top to bottom, and push each item onto the target stack. But this is
wrong, because the target would be backwards (the top of the target
stack contains the bottom of the source stack).
There are two ways to solve this problem:
1) Iterate over the source stack in bottom-to-top order, and push each
item in turn onto the target.
2) Iterate over the source stack in top-to-bottom order, but populate
the target stack backwards (push the item on bottom of the stack).
There are implementation issues associated with each of these solutions:
1) The iterator for the source stack has to be able to traverse that
stack in bottom-to-top order. This will require that the source stack
be implemented using a doubly-linked list. If you only needed
top-to-bottom traversal, then a singly-linked list implementation would
suffice.
The benefit of this approach is that, if you do have a bottom-to-top
iterator, then you only have to implement the Copy operation once,
because it uses the standard Push operation of the target.
2) In order to populate the target stack backwards, you have to have
access to the representation of the stack, because you're doing a very
special kind of push. This will require that the populate operation
(here, Copy) be a primitive operation of the target stack.
For a stack hierarchy, this requires that each different stack type
implement its own version of Copy (because each target type has a
different representation). If your source stack doesn't have a
bottom-to-top iterator, this is your only choice.
For this example, I've implemented Copy using the first approach (see
the body of Stacks):
procedure Copy
(From : in Root_Stack'Class;
To : in out Root_Stack) is
Iter : Root_Iterator'Class :=
Start_At_Bottom (From);
begin
...
Like we saw earlier in the Print operation, this operation starts off by
declaring an class-wide iterator object, initialized by calling a
factory method, Start_At_Bottom.
Since this stack is implemented using a doubly-linked list, it permits
iteration in both top-to-bottom and bottom-to-top order. That means the
client needs to state where she wants to start, either at the top of the
stack or the bottom.
There are therefore two constructors for this iterator class:
function Start_At_Top
(Stack : Root_Stack)
return Root_Iterator'Class is abstract;
function Start_At_Bottom
(Stack : Root_Stack)
return Root_Iterator'Class is abstract;
(For subtle reasons, I decided not to implement one constructor that
takes an enumeration value indicating which end to start at.)
There are also two modifiers to move the iterator, either towards the
bottom (Advance) or towards the top (Backup):
procedure Advance
(Iter : in out Root_Iterator) is abstract;
procedure Backup
(Iter : in out Root_Iterator) is abstract;
The remainder of the Copy operation follows the same pattern as we've
seen before: call Get_Item to return the current item designated by the
iterator, do something with the item (here, push it on the target
stack), and then move the iterator (Backup) in order to designate the
next item:
begin
...
for I in 1 .. Get_Length (From) loop
Push (Get_Item (Iter), On => Root_Stack'Class (To));
Backup (Iter);
end loop;
end Copy;
The next example of iterator and factory method combined is in the
implementation of equality. Stacks are equal if they have the same
values in the same order, so we should be able to compare stacks just by
using iterators to compare items. Furthermore, we should only need to
write this operation once, so that we can compare any stack type to any
other stack type in the same class.
Equality starts out by using a constructor to create iterators for both
arguments:
function "="
(L : Root_Stack;
R : Root_Stack'Class)
return Boolean is
L_Iter : Root_Iterator'Class :=
Start_At_Top (Root_Stack'Class (L));
R_Iter : Root_Iterator'Class :=
Start_At_Top (R);
...
It doesn't really make any difference where we start, so here I decided
to just start at the top of the stacks, and advance towards the bottom.
The rest of the body of equality looks like this:
begin
if L_Len /= R_Len then
return False;
end if;
for I in 1 .. L_Len loop
if Get_Item (L_Iter) /= Get_Item (R_Iter) then
return False;
end if;
Advance (L_Iter);
Advance (R_Iter);
end loop;
return True;
end "=";
We use the iterators to compare the items of each stack in turn. As
soon as we get a mismatch, we know that stacks aren't equal, and so we
just return. Otherwise, we advance the iterators (move towards the
bottom), and then compare the next pair of items. This continues until
either a mismatch occurs, or we've compared all the items.
In Out Parameters For Functions
Although Ada doesn't officially have in out parameters for functions,
you can still give a function behavior that amounts to the same thing.
One useful thing to be able to do is to modify the item on top of the
stack, without actually copying a new item to the top. This doesn't
mean replacing the item on the top with another item that has a
different value -- it means modifying the actual item, in place.
What we do is to return a reference to the top item. Ada doesn't have
reference types like you have in C++, so we use access types instead,
which give you the same thing with only a small amount of additional
syntactic overhead.
The operation Set_Top is _function_ that allows the client to modify the
item on top of the stack, by returning a pointer to the item on top:
type Item_Access is
access all Item_Type;
function Set_Top
(Stack : Root_Stack)
return Item_Access is abstract;
You use it as follows:
Set_Top (Stack).all := ;
or, if the Item_Type is a record:
Set_Top (Stack). := ;
or, passing it to a modifier:
Do_Something (To_The_Object => Set_Top (Stack).all);
For example, suppose a stack of integers has the following value (top to
bottom):
3 2 1
If I say
Set_Top (Stack).all := 4;
then the stack now looks like
4 2 1
If we combine the ability to modify an item in place with iterators, it
becomes even more powerful, because we can then change any item in the
stack, not just the top item. The iterator modifier looks like:
function Set_Item
(Iter : Root_Iterator)
return Item_Access is abstract;
which allows us to change the current item designated by the iterator.
Let's say we want to change our stack above, by adding 1 to every value
in the stack. Here's the code:
declare
Iter : Root_Iterator'Class := Start_At_Top (S);
begin
while not Done (Iter) loop
Set_Item (Iter).all := Get_Item (Iter) + 1;
Advance (Iter);
end loop;
Print (S);
end;
So our stack went from the value
4 2 1
to the value
5 3 2
The package System.Address_To_Access_Conversions provides the magic that
makes this behavior possible.
The Stack argument of function Set_Top provides only a "constant view"
of that object, because its mode is in. However, by using
Address_To_Access_Conversions, we can get a "variable view," which will
allow us to modify the item. Here's how:
function Set_Top
(Stack : Bounded_Stack)
return Item_Access is
SA : constant Object_Pointer :=
To_Pointer (Stack'Address);
...
Address_To_Access_Conversions provides an operation, To_Pointer, which
converts an address into an access-to-variable type, Object_Pointer.
Now that we have an access-to-variable view of the stack, we can then
return a pointer to the top item:
return SA.Items (Top)'Access;
end Set_Top;
Taking the address of tagged type is more-or-less well-defined, per RM95
13.3 (16), because a tagged type passed as a subprogram argument
provides an "aliased view" of that object. Don't try to use this
technique if your type isn't a by-reference type.
The implementation of iterator operation Set_Item is similar, except
that you're converting an access-to-constant pointer to an
access-to-variable pointer:
function Set_Item
(Iter : Stack_Iterator)
return Item_Access is
SA : constant Object_Pointer :=
To_Pointer (Iter.Stack.all'Address);
begin
return SA.Items (Iter.Index)'Access;
end;
(These examples of Address_To_Access_Conversions are only needed for the
bounded version of the stack; see the file stacks-bounded_g.adb.)
Happy iterating,
Matt
P.S. Ada95 Tip O' The Day: Remember, tagged types passed as subprogram
arguments are implicitly aliased; that's why you can do this:
type T is tagged private;
type Iterator (O : access T) is limited private;
procedure Op (O : in out T) is
Iter : Iterator (O'Access);
begin
...
You can't officially do this for non-tagged types, although as we've
seen, if you have a pass-by-reference type, you can then safely use
System.Address_To_Access_Conversions. (In addition to all tagged types,
a limited type whose full view is limited is also passed by reference.)
The sources below are in a format suitable for use with gnatchop.
I recommend you enable assertion checks when building this code. If
you're using gnat, use this command:
gnatmake -gnata test_unbounded
gnatmake -gnata test_bounded
gnatmake -gnata test_stacks
I prefer to test for error conditions (such as trying to pop an empty
stack) by using pragma Assert. That way, I can turn off assertion
checks when I'm satisfied everything's working.
--STX
with Stacks.Bounded_G;
package Integer_Stacks.Bounded is
new Integer_Stacks.Bounded_G (Size => 5);
with Stacks.Stack_IO_G;
package Integer_Stacks.Stack_IO is
new Integer_Stacks.Stack_IO_G (Integer'Image);
with Stacks.Unbounded_G;
package Integer_Stacks.Unbounded is
new Integer_Stacks.Unbounded_G;
with Stacks;
package Integer_Stacks is
new Stacks (Integer);
with System.Address_To_Access_Conversions;
package body Stacks.Bounded_G is
package Access_Conversions is
new System.Address_To_Access_Conversions (Bounded_Stack);
use Access_Conversions;
procedure Clear
(Stack : in out Bounded_Stack) is
begin
Stack.Top := 0;
end Clear;
procedure Push
(Item : in Item_Type;
On : in out Bounded_Stack) is
Top : Natural renames On.Top;
begin
pragma Assert (Top < Size);
Top := Top + 1;
On.Items (Top) := Item;
end Push;
procedure Pop
(Stack : in out Bounded_Stack) is
Top : Natural renames Stack.Top;
begin
pragma Assert (Top /= 0);
Top := Top - 1;
end;
function Get_Top
(Stack : Bounded_Stack)
return Item_Type is
Top : Natural renames Stack.Top;
begin
pragma Assert (Top /= 0);
return Stack.Items (Top);
end;
function Set_Top
(Stack : Bounded_Stack)
return Item_Access is
Top : Natural renames Stack.Top;
SA : constant Object_Pointer :=
To_Pointer (Stack'Address);
begin
pragma Assert (Top /= 0);
return SA.Items (Top)'Access;
end;
function Get_Length
(Stack : Bounded_Stack)
return Natural is
begin
return Stack.Top;
end;
function Is_Full
(Stack : Bounded_Stack)
return Boolean is
begin
return Stack.Top = Size;
end;
function Start_At_Top
(Stack : Bounded_Stack)
return Root_Iterator'Class is
Iter : constant Stack_Iterator :=
(Stack => Stack'Unchecked_Access,
Index => Stack.Top);
begin
return Iter;
end;
function Start_At_Bottom
(Stack : Bounded_Stack)
return Root_Iterator'Class is
Iter : Stack_Iterator :=
(Stack => Stack'Unchecked_Access,
Index => 1);
begin
return Iter;
end;
function Done
(Iter : Stack_Iterator)
return Boolean is
begin
return
Iter.Index = 0 or
Iter.Index > Iter.Stack.Top;
end;
function Get_Item
(Iter : Stack_Iterator)
return Item_Type is
begin
pragma Assert (Iter.Index in 1 .. Iter.Stack.Top);
return Iter.Stack.Items (Iter.Index);
end;
function Set_Item
(Iter : Stack_Iterator)
return Item_Access is
SA : constant Object_Pointer :=
To_Pointer (Iter.Stack.all'Address);
begin
pragma Assert (Iter.Index in 1 .. Iter.Stack.Top);
return SA.Items (Iter.Index)'Access;
end;
procedure Advance
(Iter : in out Stack_Iterator) is
begin
pragma Assert (Iter.Index > 0);
Iter.Index := Iter.Index - 1;
end;
procedure Backup
(Iter : in out Stack_Iterator) is
begin
pragma Assert (Iter.Index <= Iter.Stack.Top);
Iter.Index := Iter.Index + 1;
end;
end Stacks.Bounded_G;
generic
Size : Positive;
package Stacks.Bounded_G is
pragma Preelaborate;
type Bounded_Stack is
new Root_Stack with private;
procedure Clear
(Stack : in out Bounded_Stack);
procedure Push
(Item : in Item_Type;
On : in out Bounded_Stack);
procedure Pop
(Stack : in out Bounded_Stack);
function Get_Top
(Stack : Bounded_Stack)
return Item_Type;
function Set_Top
(Stack : Bounded_Stack)
return Item_Access;
function Get_Length
(Stack : Bounded_Stack)
return Natural;
function Is_Full
(Stack : Bounded_Stack)
return Boolean;
function Start_At_Top
(Stack : Bounded_Stack)
return Root_Iterator'Class;
function Start_At_Bottom
(Stack : Bounded_Stack)
return Root_Iterator'Class;
private
type Item_Array is
array (Positive range 1 .. Size) of aliased Item_Type;
type Bounded_Stack is
new Root_Stack with record
Items : Item_Array;
Top : Natural := 0;
end record;
type Stack_Access is
access constant Bounded_Stack;
type Stack_Iterator is
new Root_Iterator with record
Stack : Stack_Access;
Index : Natural;
end record;
function Done
(Iter : Stack_Iterator)
return Boolean;
function Get_Item
(Iter : Stack_Iterator)
return Item_Type;
function Set_Item
(Iter : Stack_Iterator)
return Item_Access;
procedure Advance
(Iter : in out Stack_Iterator);
procedure Backup
(Iter : in out Stack_Iterator);
end Stacks.Bounded_G;
with Ada.Text_IO; use Ada.Text_IO;
package body Stacks.Stack_IO_G is
procedure Print (Stack : in Root_Stack'Class) is
Iter : Root_Iterator'Class :=
Start_At_Top (Stack);
begin
if Is_Empty (Stack) then
Put_Line ("");
return;
end if;
for I in 1 .. Get_Length (Stack) loop
Put (Image (Get_Item (Iter)));
Advance (Iter);
end loop;
New_Line;
end Print;
end Stacks.Stack_IO_G;
generic
with function Image
(Item : Item_Type) return String;
package Stacks.Stack_IO_G is
procedure Print (Stack : in Root_Stack'Class);
end Stacks.Stack_IO_G;
with Ada.Unchecked_Deallocation;
package body Stacks.Unbounded_G is
procedure Finalize
(Control : in out Stack_Control) is
begin
Clear (Control.Stack.all);
end Finalize;
procedure Free is
new Ada.Unchecked_Deallocation (Node, Node_Access);
procedure Clear
(Stack : in out Unbounded_Stack) is
Top : Node_Access renames Stack.Top;
Node : Node_Access;
begin
for I in 1 .. Get_Length (Stack) loop
Node := Top;
Top := Top.Next;
Free (Node);
end loop;
pragma Assert (Stack.Top = null);
Stack.Bottom := null;
Stack.Length := 0;
end Clear;
procedure Push
(Item : in Item_Type;
On : in out Unbounded_Stack) is
Stack : Unbounded_Stack renames On;
New_Node : constant Node_Access :=
new Node;
begin
New_Node.Item := Item;
if Stack.Length = 0 then
Stack.Top := New_Node;
Stack.Bottom := New_Node;
Stack.Length := 1;
else
New_Node.Next := Stack.Top;
Stack.Top.Prev := New_Node;
Stack.Top := New_Node;
Stack.Length := Stack.Length + 1;
end if;
end Push;
procedure Pop
(Stack : in out Unbounded_Stack) is
Node : Node_Access := Stack.Top;
begin
pragma Assert (Stack.Length /= 0);
if Stack.Length = 1 then
Stack.Top := null;
Stack.Bottom := null;
Stack.Length := 0;
else
Stack.Top := Stack.Top.Next;
Stack.Top.Prev := null;
Stack.Length := Stack.Length - 1;
end if;
Free (Node);
end Pop;
function Get_Top
(Stack : Unbounded_Stack)
return Item_Type is
begin
pragma Assert (Stack.Length /= 0);
return Stack.Top.Item;
end;
function Set_Top
(Stack : Unbounded_Stack)
return Item_Access is
begin
pragma Assert (Stack.Length /= 0);
return Stack.Top.Item'Access;
end;
function Get_Length
(Stack : Unbounded_Stack)
return Natural is
begin
return Stack.Length;
end;
function Start_At_Top
(Stack : Unbounded_Stack)
return Root_Iterator'Class is
Iter : constant Stack_Iterator :=
(Node => Stack.Top);
begin
return Iter;
end;
function Start_At_Bottom
(Stack : Unbounded_Stack)
return Root_Iterator'Class is
Iter : Stack_Iterator :=
(Node => Stack.Bottom);
begin
return Iter;
end;
function Done
(Iter : Stack_Iterator)
return Boolean is
begin
return Iter.Node = null;
end;
function Get_Item
(Iter : Stack_Iterator)
return Item_Type is
begin
return Iter.Node.Item;
end;
function Set_Item
(Iter : Stack_Iterator)
return Item_Access is
begin
return Iter.Node.Item'Access;
end;
procedure Advance
(Iter : in out Stack_Iterator) is
begin
Iter.Node := Iter.Node.Next;
end;
procedure Backup
(Iter : in out Stack_Iterator) is
begin
Iter.Node := Iter.Node.Prev;
end;
end Stacks.Unbounded_G;
with Ada.Finalization;
generic
package Stacks.Unbounded_G is
pragma Preelaborate;
type Unbounded_Stack is
new Root_Stack with private;
procedure Clear
(Stack : in out Unbounded_Stack);
procedure Push
(Item : in Item_Type;
On : in out Unbounded_Stack);
procedure Pop
(Stack : in out Unbounded_Stack);
function Get_Top
(Stack : Unbounded_Stack)
return Item_Type;
function Set_Top
(Stack : Unbounded_Stack)
return Item_Access;
function Get_Length
(Stack : Unbounded_Stack)
return Natural;
function Start_At_Top
(Stack : Unbounded_Stack)
return Root_Iterator'Class;
function Start_At_Bottom
(Stack : Unbounded_Stack)
return Root_Iterator'Class;
private
type Node;
type Node_Access is access Node;
type Node is
limited record
Item : aliased Item_Type;
Next : Node_Access;
Prev : Node_Access;
end record;
type Stack_Control (Stack : access Unbounded_Stack) is
new Ada.Finalization.Limited_Controlled with null record;
procedure Finalize
(Control : in out Stack_Control);
type Unbounded_Stack is
new Root_Stack with record
Top : Node_Access;
Bottom : Node_Access;
Length : Natural := 0;
Control : Stack_Control (Unbounded_Stack'Access);
end record;
type Stack_Iterator is
new Root_Iterator with record
Node : Node_Access;
end record;
function Done
(Iter : Stack_Iterator)
return Boolean;
function Get_Item
(Iter : Stack_Iterator)
return Item_Type;
function Set_Item
(Iter : Stack_Iterator)
return Item_Access;
procedure Advance
(Iter : in out Stack_Iterator);
procedure Backup
(Iter : in out Stack_Iterator);
end Stacks.Unbounded_G;
with System; use type System.Address;
package body Stacks is
procedure Copy
(From : in Root_Stack'Class;
To : in out Root_Stack) is
Iter : Root_Iterator'Class :=
Start_At_Bottom (From);
begin
if From'Address = To'Address then
return;
end if;
Clear (Root_Stack'Class (To));
for I in 1 .. Get_Length (From) loop
Push (Get_Item (Iter), On => Root_Stack'Class (To));
Backup (Iter);
end loop;
end Copy;
function "="
(L : Root_Stack;
R : Root_Stack'Class)
return Boolean is
L_Iter : Root_Iterator'Class :=
Start_At_Top (Root_Stack'Class (L));
R_Iter : Root_Iterator'Class :=
Start_At_Top (R);
L_Len : constant Natural :=
Get_Length (Root_Stack'Class (L));
R_Len : constant Natural :=
Get_Length (R);
begin
if L_Len /= R_Len then
return False;
end if;
for I in 1 .. L_Len loop
if Get_Item (L_Iter) /= Get_Item (R_Iter) then
return False;
end if;
Advance (L_Iter);
Advance (R_Iter);
end loop;
return True;
end "=";
function Is_Empty
(Stack : Root_Stack) return Boolean is
begin
return Get_Length (Root_Stack'Class (Stack)) = 0;
end;
end Stacks;
generic
type Item_Type is private;
with function "="
(L, R : Item_Type)
return Boolean is <>;
package Stacks is
pragma Preelaborate;
type Root_Stack is
abstract tagged limited null record;
procedure Copy
(From : in Root_Stack'Class;
To : in out Root_Stack);
procedure Clear
(Stack : in out Root_Stack) is abstract;
procedure Push
(Item : in Item_Type;
On : in out Root_Stack) is abstract;
procedure Pop
(Stack : in out Root_Stack) is abstract;
function "="
(L : Root_Stack;
R : Root_Stack'Class)
return Boolean;
function Get_Top
(Stack : Root_Stack)
return Item_Type is abstract;
type Item_Access is
access all Item_Type;
function Set_Top
(Stack : Root_Stack)
return Item_Access is abstract;
function Get_Length
(Stack : Root_Stack)
return Natural is abstract;
function Is_Empty
(Stack : Root_Stack)
return Boolean;
type Root_Iterator is
abstract tagged null record;
function Start_At_Top
(Stack : Root_Stack)
return Root_Iterator'Class is abstract;
function Start_At_Bottom
(Stack : Root_Stack)
return Root_Iterator'Class is abstract;
function Done
(Iter : Root_Iterator)
return Boolean is abstract;
function Get_Item
(Iter : Root_Iterator)
return Item_Type is abstract;
function Set_Item
(Iter : Root_Iterator)
return Item_Access is abstract;
procedure Advance
(Iter : in out Root_Iterator) is abstract;
procedure Backup
(Iter : in out Root_Iterator) is abstract;
end Stacks;
with Integer_Stacks.Bounded; use Integer_Stacks.Bounded;
with Integer_Stacks.Stack_IO; use Integer_Stacks.Stack_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Bounded is
S : Bounded_Stack;
S2 : Bounded_Stack;
use Integer_Stacks;
begin
Print (S);
Push (1, S);
Print (S);
Pop (S);
Print (S);
Put_Line
("Stacks are equal: " &
Boolean'Image (S = S2));
Push (1, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Push (2, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Push (3, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Put ("S:"); Print (S);
Copy (From => S, To => S2);
Put ("S2:"); Print (S2);
Put_Line
("Stacks are equal: " &
Boolean'Image (S = S2));
Set_Top (S).all := 4;
Put ("S:"); Print (S);
declare
Iter : Root_Iterator'Class := Start_At_Top (S);
begin
while not Done (Iter) loop
Set_Item (Iter).all := Get_Item (Iter) + 1;
Advance (Iter);
end loop;
Put ("S:"); Print (S);
end;
end Test_Bounded;
with Integer_Stacks.Bounded; use Integer_Stacks.Bounded;
with Integer_Stacks.Unbounded; use Integer_Stacks.Unbounded;
with Integer_Stacks.Stack_IO; use Integer_Stacks.Stack_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Stacks is
B : Bounded_Stack;
U : Unbounded_Stack;
begin
Print (B);
Push (1, B);
Print (B);
Pop (B);
Print (B);
Put_Line ("Compare empty B to empty U");
Put_Line
("Stacks are equal: " &
Boolean'Image (B = U));
Put_Line
("Stacks are equal: " &
Boolean'Image (U = B));
New_Line;
Put_Line ("Compare non-empty B to empty U");
Push (1, B);
Push (2, B);
Push (3, B);
Put ("B:"); Print (B);
Put ("U:"); Print (U);
Put_Line
("Stacks are equal: " &
Boolean'Image (B = U));
Put_Line
("Stacks are equal: " &
Boolean'Image (U = B));
New_Line;
Put_Line ("Copy B to U");
Copy (From => B, To => U);
Put ("U:"); Print (U);
Put_Line
("Stacks are equal: " &
Boolean'Image (B = U));
Put_Line
("Stacks are equal: " &
Boolean'Image (U = B));
New_Line;
Put_Line ("Copy U to itself");
Copy (From => U, To => U);
Put ("U:"); Print (U);
New_Line;
Put_Line ("Copy U to B");
Push (5, U);
Push (6, U);
Put ("U:"); Print (U);
Put ("B:"); Print (B);
Copy (From => U, To => B);
Put ("B:"); Print (B);
Put_Line
("Stacks are equal: " &
Boolean'Image (B = U));
Put_Line
("Stacks are equal: " &
Boolean'Image (U = B));
New_Line;
Put_Line ("Clear U, then copy to B");
Clear (U);
Put ("U:"); Print (U);
Put ("B:"); Print (B);
Copy (From => U, To => B);
Put ("B:"); Print (B);
Put_Line
("Stacks are equal: " &
Boolean'Image (B = U));
Put_Line
("Stacks are equal: " &
Boolean'Image (U = B));
end Test_Stacks;
with Integer_Stacks.Unbounded; use Integer_Stacks.Unbounded;
with Integer_Stacks.Stack_IO; use Integer_Stacks.Stack_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Unbounded is
S : Unbounded_Stack;
S2 : Unbounded_Stack;
use Integer_Stacks;
begin
Print (S);
Push (1, S);
Print (S);
Pop (S);
Print (S);
Put_Line
("Stacks are equal: " &
Boolean'Image (S = S2));
Push (1, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Push (2, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Push (3, S);
Put ("Len:" & Integer'Image (Get_Length (S)));
Put (" Top:" & Integer'Image (Get_Top (S)));
New_Line;
Put ("S:"); Print (S);
Copy (From => S, To => S2);
Put ("S2:"); Print (S2);
Put_Line
("Stacks are equal: " &
Boolean'Image (S = S2));
Set_Top (S).all := 4;
Put ("S:"); Print (S);
declare
Iter : Root_Iterator'Class := Start_At_Top (S);
begin
while not Done (Iter) loop
Set_Item (Iter).all := Get_Item (Iter) + 1;
Advance (Iter);
end loop;
Put ("S:"); Print (S);
end;
end Test_Unbounded;
| 
