From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,
	T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,7a992ba0c2391839
X-Google-Attributes: gid103376,public
From: matthew_heaney@acm.org (Matthew Heaney)
Subject: Re: Active Iteration - Update
Date: 1998/05/17
Message-ID: <matthew_heaney-ya023680001705980103010001@news.ni.net>
X-Deja-AN: 353978363
Content-Transfer-Encoding: 8bit
References: <matthew_heaney-ya023680001505980600400001@news.ni.net>
 <swhalenEt361C.EAp@netcom.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=ISO-8859-1
Organization: Network Intensive
Newsgroups: comp.lang.ada
Date: 1998-05-17T00:00:00+00:00
List-Id: <comp.lang.ada>


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;