* Active Iteration - Update
@ 1998-05-15 0:00 Matthew Heaney
1998-05-17 0:00 ` Steve Whalen
0 siblings, 1 reply; 3+ messages in thread
From: Matthew Heaney @ 1998-05-15 0:00 UTC (permalink / raw)
I figured out a way to do iteratoration using a dispatching iterator
(handle) constructor, and at the same time hide away the calls to
New_Iterator and Free.
I originally posed something like this:
function New_Iterator
(Stack : access Root_Stack) return Iterator_Access;
My issue with this solution is that the client has to remember to
explicitly Free the object returned by that constructor, as in:
procedure Do_Something (S : access Stack'Class) is
IA : Iterator_Access := New_Iterator (S);
Iter : Root_Iterator'Class renames IA.all;
begin
while not Is_Done (Iter) loop
... Get_Item (Iter) ...
<do something with item>
Advance (Iter);
end loop;
Free (IA);
end Do_Something;
There are two reasons why I don't like this:
1) The client has to call a function manually, to get an iterator
indirectly, ie through an access object.
2) The client has to remember to manually call Free, to reclaim storage
associated with the iterator object.
Item (2) is especially pernicious, because
a) the client can forget to call Free, thus creating a memory leak
b) there could be an unhandled exception raised prior to the call to Free,
thus creating a memory leak
We can do better.
The idea is to wrap the iterator access object inside a Controlled object,
which I've called Iterator_Handle. That way Finalize gets called
automatically, and thus no memory leak can occur.
The iterator handle is implemented as a Controlled record containing an
access object that designates an iterator. As before, the iterator is
constructed by calling a dispatching function that returns the iterator
access type. The iterator handle implements its operations in terms of the
corresponding operations of the actual iterator.
The iterator handle, during its (automatic) Finalization, calls a
dispatching Deallocate operation to reclaim the storage associated with the
iterator.
The improved version of the classwide operation above is:
procedure Do_Something (S : access Stack'Class) is
Handle : Iterator_Handle (S);
begin
while not Is_Done (Handle) loop
... Get_Item (Handle) ...
<do something with item>
Advance (Handle);
end loop;
end Do_Something;
Note that there is no call to New, nor is there a call to Free.
Hope that helps,
Matt
P.S. The sources below compile and run using GNAT 3.10p, and are in a
format suitable for use with gnatchop.
-- STX
with Ada.Finalization;
generic
type Stack_Item is private;
with function "=" (L, R : Stack_Item) return Boolean is <>;
package Stacks is
type Root_Stack is abstract tagged null record;
type Stack_Item_Access is access all Stack_Item;
for Stack_Item_Access'Storage_Size use 0;
procedure Push
(Item : in Stack_Item;
On : in out Root_Stack) is abstract;
function Get_Top
(Stack : Root_Stack) return Stack_Item is abstract;
function Get_Top
(Stack : access Root_Stack) return Stack_Item_Access is abstract;
type Iterator_Handle
(Stack : access Root_Stack'Class) is limited private;
function Is_Done
(Handle : Iterator_Handle) return Boolean;
function Get_Item
(Handle : Iterator_Handle) return Stack_Item_Access;
procedure Advance
(Handle : Iterator_Handle);
procedure Reset
(Handle : Iterator_Handle);
private
type Root_Iterator is
abstract tagged limited null record;
function Is_Done
(Iterator : Root_Iterator) return Boolean is abstract;
function Get_Item
(Iterator : Root_Iterator) return Stack_Item_Access is abstract;
procedure Advance
(Iterator : in out Root_Iterator) is abstract;
procedure Reset
(Iterator : in out Root_Iterator) is abstract;
procedure Deallocate
(Iterator : access Root_Iterator) is abstract;
type Iterator_Access is
access all Root_Iterator'Class;
function New_Iterator
(Stack : access Root_Stack) return Iterator_Access is abstract;
type Iterator_Handle (Stack : access Root_Stack'Class) is
new Ada.Finalization.Limited_Controlled with record
Iter : Iterator_Access := New_Iterator (Stack);
end record;
procedure Finalize
(Handle : in out Iterator_Handle);
end Stacks;
with Ada.Text_IO; use Ada.Text_IO;
package body Stacks is
function Is_Done
(Handle : Iterator_Handle) return Boolean is
begin
return Is_Done (Handle.Iter.all);
end;
function Get_Item
(Handle : Iterator_Handle) return Stack_Item_Access is
begin
return Get_Item (Handle.Iter.all);
end;
procedure Advance
(Handle : Iterator_Handle) is
begin
Advance (Handle.Iter.all);
end;
procedure Reset
(Handle : Iterator_Handle) is
begin
Reset (Handle.Iter.all);
end;
procedure Finalize
(Handle : in out Iterator_Handle) is
begin
Deallocate (Handle.Iter);
end;
end Stacks;
generic
Max_Depth : in Positive;
package Stacks.Bounded_G is
type Bounded_Stack is
new Root_Stack with private;
function "="
(L, R : Bounded_Stack) return Boolean;
procedure Push
(Item : in Stack_Item;
On : in out Bounded_Stack);
function Get_Top
(Stack : Bounded_Stack) return Stack_Item;
function Get_Top
(Stack : access Bounded_Stack) return Stack_Item_Access;
type Bounded_Iterator
(Stack : access Bounded_Stack'Class) is
limited private;
function Is_Done
(Iterator : Bounded_Iterator) return Boolean;
function Get_Item
(Iterator : Bounded_Iterator) return Stack_Item_Access;
procedure Advance (Iterator : in out Bounded_Iterator);
procedure Reset (Iterator : in out Bounded_Iterator);
private
type Stack_Item_Array is
array (Positive range <>) of aliased Stack_Item;
function "=" (L, R : Stack_Item_Array) return Boolean is abstract;
subtype Items_Range is Positive range 1 .. Max_Depth;
type Bounded_Stack is
new Root_Stack with record
Items : Stack_Item_Array (Items_Range);
Depth : Natural range 0 .. Max_Depth := 0;
end record;
type Bounded_Iterator
(Stack : access Bounded_Stack'Class) is
new Root_Iterator with record
Index : Natural := Stack.Depth;
end record;
function New_Iterator
(Stack : access Bounded_Stack) return Iterator_Access;
procedure Deallocate
(Iterator : access Bounded_Iterator);
end Stacks.Bounded_G;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO;
package body Stacks.Bounded_G is
function "="
(L, R : Bounded_Stack) return Boolean is
begin
if L.Depth /= R.Depth then
return False;
end if;
for I in 1 .. L.Depth loop
if L.Items (I) /= R.Items (I) then
return False;
end if;
end loop;
return True;
end "=";
procedure Push
(Item : in Stack_Item;
On : in out Bounded_Stack) is
Stack : Bounded_Stack renames On;
Depth : Natural renames Stack.Depth;
begin
Depth := Depth + 1;
Stack.Items (Depth) := Item;
end Push;
function Get_Top
(Stack : Bounded_Stack) return Stack_Item is
begin
return Stack.Items (Stack.Depth);
end Get_Top;
function Get_Top
(Stack : access Bounded_Stack) return Stack_Item_Access is
begin
return Stack.Items (Stack.Depth)'Access;
end Get_Top;
function Is_Done
(Iterator : Bounded_Iterator) return Boolean is
begin
return Iterator.Index = 0;
end;
function Get_Item
(Iterator : Bounded_Iterator) return Stack_Item_Access is
Stack : Bounded_Stack'Class renames Iterator.Stack.all;
begin
return Stack.Items (Iterator.Index)'Access;
end;
procedure Advance (Iterator : in out Bounded_Iterator) is
begin
Iterator.Index := Iterator.Index - 1;
end;
procedure Reset (Iterator : in out Bounded_Iterator) is
begin
Iterator.Index := Iterator.Stack.Depth;
end;
function New_Iterator
(Stack : access Bounded_Stack) return Iterator_Access is
begin
return new Bounded_Iterator (Stack);
end;
procedure Free is
new Ada.Unchecked_Deallocation
(Root_Iterator'Class, Iterator_Access);
procedure Deallocate (Iterator : access Bounded_Iterator) is
IA : Iterator_Access := Iterator_Access (Iterator);
begin
Free (IA);
Ada.Text_IO.Put_Line ("reclaimed memory for iterator handle");
end;
end Stacks.Bounded_G;
generic
with function Image (Item : Stack_Item) return String;
package Stacks.Stack_IO_G is
procedure Dump (Stack : access Root_Stack'Class);
end Stacks.Stack_IO_G;
with Ada.Text_IO; use Ada.Text_IO;
package body Stacks.Stack_IO_G is
procedure Dump (Stack : access Root_Stack'Class) is
Iterator : Iterator_Handle (Stack);
begin
while not Is_Done (Iterator) loop
Put (Image (Get_Item (Iterator).all));
Advance (Iterator);
end loop;
New_Line;
end Dump;
end Stacks.Stack_IO_G;
with Stacks;
pragma Elaborate_All (Stacks);
package Integer_Stacks is new Stacks (Integer);
with Stacks.Bounded_G;
pragma Elaborate_All (Stacks.Bounded_G);
package Integer_Stacks.Bounded is
new Integer_Stacks.Bounded_G (Max_Depth => 10);
with Stacks.Stack_IO_G;
pragma Elaborate_All (Stacks.Stack_IO_G);
package Integer_Stacks.Stack_IO is
new Integer_Stacks.Stack_IO_G (Integer'Image);
with Integer_Stacks.Bounded; use Integer_Stacks.Bounded;
with Integer_Stacks.Stack_IO; use Integer_Stacks.Stack_IO;
procedure Test_Stacks is
Stack : aliased Bounded_Stack;
begin
Push (9, On => Stack);
Push (8, On => Stack);
Push (7, On => Stack);
Push (6, On => Stack);
Push (5, On => Stack);
Dump (Stack'Access);
end;
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Active Iteration - Update
1998-05-17 0:00 ` Steve Whalen
@ 1998-05-17 0:00 ` Matthew Heaney
0 siblings, 0 replies; 3+ messages in thread
From: Matthew Heaney @ 1998-05-17 0:00 UTC (permalink / raw)
In article <swhalenEt361C.EAp@netcom.com>, swhalen@netcom.com (Steve
Whalen) wrote:
(start of quote)
Thanks for posting the updated and improved Iterator package.
(end of quote)
You're welcome - and I've enclosed another version that I think is even better.
There was one aspect of the previous version that bothered me. The
primitive operations for Iterator_Handle are the same as those of the
iterator type, and in fact are implemented by just calling through to the
iterator operations. Why duplicate code this way?
The whole point of the iterator handle is to take care of deallocating the
iterator for the convenience of the client, so we can eliminate memory
leaks. But it ended up mirroring the functionality of the iterator itself.
Can't we simplify the Iterator_Handle somehow, so it only has to worry
about memory reclaimation, instead of iteration too?
Here's what I did. By moving the Root_Iterator type up into the public
part of the spec, I can have the Iterator_Handle return an access object
that designates the actual iterator. The client can then use the iterator
directly, and there is thus no need to have an extra operations for the
handle type that merely call those of the iterator.
The new spec looks like this:
type Root_Iterator is
abstract tagged limited null record;
type Iterator_Access is
access all Root_Iterator'Class;
<...primitive ops for iterator...>
type Iterator_Handle
(Stack : access Root_Stack'Class) is limited private
function Get_Iterator
(Handle : Iterator_Handle) return Iterator_Access;
private
...
There's now one extra step for the client:
Handle : Iterator_Handle (Stack);
Iterator : Root_Iterator'Class renames
Get_Iterator (Handle).all;
begin
Note that here's the reason I name selector operations Get_XXX: so I can
rename the object returned by the selector XXX. Had the selector been
named just XXX, as in
function Iterator (Handle : Iterator_Handle) return Iterator_Access;
then the object couldn't be called Iterator, because within a declaration
that name can only be used once, ie
Iterator : Root_Iterator'Class renames Iterator (Handle).all;
is illegal.
(start of quote)
Studying it has encouraged me to once more go back over old code I've
written that works, but isn't "elegant". My experience is that if
code I write isn't clear and at least somewhat elegant, then I
probably have NOT taken enough time to match either the data or the
algorithms to my Ada95 implementation.
(end of quote)
Ahhh, the voice of reason in a chaotic world. I meet many programmers -
unlike you - who don't seem to understand software as a medium for the
construction of systems. Elegance isn't even on their radar screen,
because they spend all their time just getting the software to emit _some_
answer without crashing. Sigh.
Your sage observation brings me some measure of relief, knowing that
there's someone else who understands what I'm talking about. Thank you!
(start of quote)
I think your iterator package is a good example that if you keep
pushing to find a "clean" solution in Ada, the language will almost
always support it.
(end of quote)
Indeed, this is true. Funny, this idea came to me while driving to a
movie. Maybe I should go see more movies...
Matt
P.S. The sources for the improved version are below (only Stacks and
Stacks.Stack_IO changed). As before, the sources are in a format suitable
for input to gnatchop (you'll have to remove my signiture though).
--STX
with Stacks.Bounded_G;
pragma Elaborate_All (Stacks.Bounded_G);
package Integer_Stacks.Bounded is
new Integer_Stacks.Bounded_G (Max_Depth => 10);
with Stacks.Stack_IO_G;
pragma Elaborate_All (Stacks.Stack_IO_G);
package Integer_Stacks.Stack_IO is
new Integer_Stacks.Stack_IO_G (Integer'Image);
with Stacks;
pragma Elaborate_All (Stacks);
package Integer_Stacks is new Stacks (Integer);
with Ada.Unchecked_Deallocation;
with Ada.Text_IO;
package body Stacks.Bounded_G is
function "="
(L, R : Bounded_Stack) return Boolean is
begin
if L.Depth /= R.Depth then
return False;
end if;
for I in 1 .. L.Depth loop
if L.Items (I) /= R.Items (I) then
return False;
end if;
end loop;
return True;
end "=";
procedure Push
(Item : in Stack_Item;
On : in out Bounded_Stack) is
Stack : Bounded_Stack renames On;
Depth : Natural renames Stack.Depth;
begin
Depth := Depth + 1;
Stack.Items (Depth) := Item;
end Push;
function Get_Top
(Stack : Bounded_Stack) return Stack_Item is
begin
return Stack.Items (Stack.Depth);
end Get_Top;
function Get_Top
(Stack : access Bounded_Stack) return Stack_Item_Access is
begin
return Stack.Items (Stack.Depth)'Access;
end Get_Top;
function Is_Done
(Iterator : Bounded_Iterator) return Boolean is
begin
return Iterator.Index = 0;
end;
function Get_Item
(Iterator : Bounded_Iterator) return Stack_Item_Access is
Stack : Bounded_Stack'Class renames Iterator.Stack.all;
begin
return Stack.Items (Iterator.Index)'Access;
end;
procedure Advance (Iterator : in out Bounded_Iterator) is
begin
Iterator.Index := Iterator.Index - 1;
end;
procedure Reset (Iterator : in out Bounded_Iterator) is
begin
Iterator.Index := Iterator.Stack.Depth;
end;
function New_Iterator
(Stack : access Bounded_Stack) return Iterator_Access is
begin
return new Bounded_Iterator (Stack);
end;
procedure Free is
new Ada.Unchecked_Deallocation
(Root_Iterator'Class, Iterator_Access);
procedure Deallocate (Iterator : access Bounded_Iterator) is
IA : Iterator_Access := Iterator_Access (Iterator);
begin
Free (IA);
Ada.Text_IO.Put_Line ("reclaimed memory for iterator handle");
end;
end Stacks.Bounded_G;
generic
Max_Depth : in Positive;
package Stacks.Bounded_G is
type Bounded_Stack is
new Root_Stack with private;
function "="
(L, R : Bounded_Stack) return Boolean;
procedure Push
(Item : in Stack_Item;
On : in out Bounded_Stack);
function Get_Top
(Stack : Bounded_Stack) return Stack_Item;
function Get_Top
(Stack : access Bounded_Stack) return Stack_Item_Access;
type Bounded_Iterator
(Stack : access Bounded_Stack'Class) is
new Root_Iterator with private;
function Is_Done
(Iterator : Bounded_Iterator) return Boolean;
function Get_Item
(Iterator : Bounded_Iterator) return Stack_Item_Access;
procedure Advance (Iterator : in out Bounded_Iterator);
procedure Reset (Iterator : in out Bounded_Iterator);
private
type Stack_Item_Array is
array (Positive range <>) of aliased Stack_Item;
function "=" (L, R : Stack_Item_Array) return Boolean is abstract;
subtype Items_Range is Positive range 1 .. Max_Depth;
type Bounded_Stack is
new Root_Stack with record
Items : Stack_Item_Array (Items_Range);
Depth : Natural range 0 .. Max_Depth := 0;
end record;
type Bounded_Iterator
(Stack : access Bounded_Stack'Class) is
new Root_Iterator with record
Index : Natural := Stack.Depth;
end record;
function New_Iterator
(Stack : access Bounded_Stack) return Iterator_Access;
procedure Deallocate
(Iterator : access Bounded_Iterator);
end Stacks.Bounded_G;
with Ada.Text_IO; use Ada.Text_IO;
package body Stacks.Stack_IO_G is
procedure Dump (Stack : access Root_Stack'Class) is
Handle : Iterator_Handle (Stack);
Iterator : Root_Iterator'Class renames
Get_Iterator (Handle).all;
begin
while not Is_Done (Iterator) loop
Put (Image (Get_Item (Iterator).all));
Advance (Iterator);
end loop;
New_Line;
end Dump;
end Stacks.Stack_IO_G;
generic
with function Image (Item : Stack_Item) return String;
package Stacks.Stack_IO_G is
procedure Dump (Stack : access Root_Stack'Class);
end Stacks.Stack_IO_G;
package body Stacks is
procedure Finalize
(Handle : in out Iterator_Handle) is
begin
Deallocate (Handle.Iter);
end;
function Get_Iterator
(Handle : Iterator_Handle) return Iterator_Access is
begin
return Handle.Iter;
end;
end Stacks;
with Ada.Finalization;
generic
type Stack_Item is private;
with function "=" (L, R : Stack_Item) return Boolean is <>;
package Stacks is
type Root_Stack is abstract tagged null record;
type Stack_Item_Access is access all Stack_Item;
for Stack_Item_Access'Storage_Size use 0;
procedure Push
(Item : in Stack_Item;
On : in out Root_Stack) is abstract;
function Get_Top
(Stack : Root_Stack) return Stack_Item is abstract;
function Get_Top
(Stack : access Root_Stack) return Stack_Item_Access is abstract;
type Root_Iterator is
abstract tagged limited null record;
type Iterator_Access is
access all Root_Iterator'Class;
function Is_Done
(Iterator : Root_Iterator) return Boolean is abstract;
function Get_Item
(Iterator : Root_Iterator) return Stack_Item_Access is abstract;
procedure Advance
(Iterator : in out Root_Iterator) is abstract;
procedure Reset
(Iterator : in out Root_Iterator) is abstract;
type Iterator_Handle
(Stack : access Root_Stack'Class) is limited private;
function Get_Iterator
(Handle : Iterator_Handle) return Iterator_Access;
private
function New_Iterator
(Stack : access Root_Stack) return Iterator_Access is abstract;
procedure Deallocate
(Iterator : access Root_Iterator) is abstract;
type Iterator_Handle (Stack : access Root_Stack'Class) is
new Ada.Finalization.Limited_Controlled with record
Iter : Iterator_Access := New_Iterator (Stack);
end record;
procedure Finalize
(Handle : in out Iterator_Handle);
end Stacks;
with Integer_Stacks.Bounded; use Integer_Stacks.Bounded;
with Integer_Stacks.Stack_IO; use Integer_Stacks.Stack_IO;
procedure Test_Stacks is
Stack : aliased Bounded_Stack;
begin
Push (9, On => Stack);
Push (8, On => Stack);
Push (7, On => Stack);
Push (6, On => Stack);
Push (5, On => Stack);
Dump (Stack'Access);
end;
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Active Iteration - Update
1998-05-15 0:00 Active Iteration - Update Matthew Heaney
@ 1998-05-17 0:00 ` Steve Whalen
1998-05-17 0:00 ` Matthew Heaney
0 siblings, 1 reply; 3+ messages in thread
From: Steve Whalen @ 1998-05-17 0:00 UTC (permalink / raw)
Thanks for posting the updated and improved Iterator package.
Studying it has encouraged me to once more go back over old code I've
written that works, but isn't "elegant". My experience is that if
code I write isn't clear and at least somewhat elegant, then I
probably have NOT taken enough time to match either the data or the
algorithms to my Ada95 implementation.
I think your iterator package is a good example that if you keep
pushing to find a "clean" solution in Ada, the language will almost
always support it.
Steve
--
{===----------------------------------------------------------------------===}
Steve Whalen swhalen@netcom.com
{===----------------------------------------------------------------------===}
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~1998-05-17 0:00 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1998-05-15 0:00 Active Iteration - Update Matthew Heaney
1998-05-17 0:00 ` Steve Whalen
1998-05-17 0:00 ` Matthew Heaney
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox