Active Iteration - Update

Active Iteration - Update

[Matthew Heaney]

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;

Re: Active Iteration - Update

[Steve Whalen]

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
{===----------------------------------------------------------------------===}

Re: Active Iteration - Update

[Matthew Heaney]

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;