Re: Active Iteration (was: How to use abstract data types)

[matthew_heaney@acm.org (Matthew Heaney)]

In article <6ivjdn$k0m$1@nnrp1.dejanews.com>, adam@irvine.com wrote:

(start of quote)
So if, say, the program asks the user to select a type of library from
a menu, and then contains code like

      if Menu_Option = 1 then
          declare
              Lib : aliased Libraries.Test.Library :=
                        Libraries.Test.The_Library;
          begin
              Let_The_User_Play_With_The_Library (Lib'access);
          end;
      elsif Menu_Option = 2 then
          declare
              Lib : aliased Libraries.Another_Test.Library :=
                        Libraries.Another_Test.The_Library;
          begin
              Let_The_User_Play_With_The_Library (Lib'access);
          end;
      elsif Menu_Option = 3 then
          declare
              Lib : aliased Libraries.Amazon_Dot_Com.Library :=
                        Libraries.Amazon_Dot_Com.The_Library;
          begin
              .... some stuff to set up an FTP connection ....
              Let_The_User_Play_With_The_Library (Lib'access);
          end;
      . . .

where Let_The_User_Play_With_The_Library's parameter is "access
Root_Library'class", and Let_The_User_Play_With_The_Library somewhere
down the road calls List_Books, it doesn't seem to me that the generic
version you used in your previous example:

    procedure Library_Package.Test.List_Books is
      new Library_Package.List.List_Books
      (Source_Library  => Test_Library'Class,
       Source_Iterator => Test_Iterator);


    with Library_Package.Test.List_Books;
    use Library_Package.Test.List_Books;

    procedure Libtest2 is
        The_Lib : Library_Package.Test.Test_Library;
    begin
        List_Books (The_Lib, "m");
    end Libtest2;

will work.  However, the example code you included in your more recent
example should work fine in a case like this.  Am I understanding
what's going on correctly?
(end of quote)

The dynamic approach is a bit more flexible, but it could be made to work
(but see below).  Notice that you've already made a static commitment in
your case statement (which is by definition static).  The
Let_Client_Play_With_Library could have been made into a generic, and
instantiated once per library (ie once per brach of the case statement). 
Something like:

procedure Let_Client_Play_With_Test_Lib is
   new Let_Client_Play (Test_Library...);

procedure Let_Client_Play_With_Another_Test_Lib is
   new Let_Client_Play (Another_Test_Library...);
...

case Menu_Item is
    when 1 =>
        declare
           Lib : Test_Library renames Libraries.Test.Library.all;
        begin
          Let_Client_Play_With_Test_Library (Lib);
       end;

   when 2 =>
      declare
         Lib : Another_Test_Library renames Librarys.Another_Test.Library.all
      begin
         Let_Client_Play_With_Another_Test_Lib (Lib);
      end;
...

Contrast this static approach with the one below.  As a matter of fact,
this solution is so static that you don't need a type at all.  If the only
purpose a package is to export an ADT, and declare a well-known instance of
that type in the package body (which clients get access to by calling a
package selector function), then you can just ditch the type and declare
the object attributes as state data in the package body.  This is the sort
of classic Ada program architecture:

package Libraries is
   pragma Pure;

   ... no type Root_Library ...
end;

package Libraries.Test is
 
   <ops for a Test library, but that don't take an ADT as a parameter>
end;

package body Libraries.Test is

   Books : array (...) of Book := ...;

end;

This is kinda sorta what you had in your original example - the state for
the Test library "object" just lived in the package body (I moved it back
into the type itself).  Maybe you were doing that just to get a tag that
you could dispatch on?  But it's not necessary if you go the static route
(especially since in your file problem, you probably know up front all the
possible file formats you need to handle).

If you want a utility operation that you can use on any library, then you
can use "static polymorphism" to do it: what I had in my original reponse,
but minus the formal library type.  Something like

generic
   function Get_Books return Book_Array;
...
procedure Let_Clients_Play;  -- note that you don't even need an object to
pass in

procedure Let_Clients_Play_With_Test_Library is
   new Let_Clients_Play (Libraries.Test.Get_Books,...);

procedure Let_Clients_Play_With_Another_Test_Library is
   new Let_Clients_Play (Libraries.Another_Test.Get_Books,...);
...

Yes, it makes maintenance a bit of a pain, because you have to create a new
instantiation every time you create a new kind of library (by creating
another library state machine package), but it can be done.

This is why it makes no sense to denigrate Ada 83 "because it's not object
oriented."  It's not because it doesn't need to be, and you can do quite a
lot with its generic facility.

And this is why [putting my prognosticator hat on] those same people will
overuse the tagged type facility, because they don't understand that a
simple package-as-state-machine will do the trick just nicely.  This is the
simplest way to handle the "well-known" object idiom.  Don't declare an
ADT, then declare a global object of the ADT type.  Just declare the
package itself as the instance (or collection of instances).  

See my description of the Singleton pattern, in the Feb 97 link at the
SIGAda pattern archives.

<http://www.acm.org/sigada/wg/patterns/>


(start of quote)
> 8) Don't have a primitive operation of a tagged type return a
> specific type, ie
>
>    function The_Library return Root_Library is abstract;

That was my mistake.  I should have had it return Root_Library'Class.
(end of quote)

There's an idiom for this sort of thing.  I think your problem is like this:

package P is 

   type T is abstract tagged ...;
   type T_Access is access all T'Class;
...;
end P;

package P.C1 is

   type NT1 is new T with ...;

   <declare an object of type NT1>
...
end P.C1;

package P.C2 is

   type NT2 is new T with ...;

   <declare an object of type NT2>
...
end P.C2;

The "object of type NTx" lives in the associated package body, and you want
clients to be able to manipulate it (say, to iterate over it).  Is this
correct?  

You suggest exporting a function to return essentially a copy of the data
in the body, as in

   function O1 return NT1'Class;

   function O2 return NT2'Class;

Here are a couple of ideas that I like better, because they don't create a copy:

1) Declare the object as aliased in the body, and return a pointer to it, as in

package P.C1 is

   type NT1 is new T1 with ...;
   
   function O1 return T_Access;
...
end;

package body P.C1 is

   O1_Rep : aliased NT1;

   function O1 return T_Access is
   begin
      return O1_Rep'Access;  -- need 'Unchecked_Access?
   end;

end;

You could even declare the object in the private part of the spec, after
the declaration of the full view of the type.

Now you can pass the object (access object) to the iterator as required. 
If you just want to manipulate the object, rename it:

declare
   O1 : NT1 renames P.C1.O1.all;
begin
   Op (O1);
end;

This prevents you from having to constantly dereference the access object. 
(I use this technique a lot - renaming the object designated by an access
object.  I did that to clean up the iteration in the search procedures in
the example.)

In case I forget, also realize that you can rename the return value of a
function (functions return "constant objects" these days):

declare
   F : File_Type renames Standard_Output;
begin
...

Pretty cool, huh?  You could do that with you library function:

declare
   Lib : Test_Library'Class renames Libraries.Test.The_Library;
begin
...

(But I'm recommending you don't use The_Library anymore as is.)

You could use it for the iterator object too:

declare
   Iter_A : Iterator_Access := New_Iterator (Lib);
   Iter : Root_Iterator'Class renames Iter_A.all;
begin
   <now just refer to Iter>

(The primitive ops for Iterator would have to be changed to non-access
parameters - but that is how it should be done anyway, because many clients
will use the iterator directly, without going through a dispatching
constructor.)


2) If you know up front that clients are going to iterate over your global
library, then why not just export a global iterator too?  You already have
a Root_Iterator type and an access type, so use them, and now (the best
part) we can get rid of that nasty unfortunate heap allocation:

package Libraries.Amazon is

   type Amazon_Library is new Root_Library with private;

   type Amazon_Iterator is new Root_Iterator with private;
...
   function Library return Library_Access;

   function Iterator return Iterator_Access;

end;

package body Libraries.Amazon is

   The_Library : aliased Amazon_Library;

   The_Iteator : aliased Amazon_Iterator (The_Library'Access);

   function Library return Library_Access is
   begin
      return The_Library'Access;  -- 'Unchecked_Access req'd?
   end;

   function Iterator return Iterator_Access is
   begin
      return The_Iterator'Access;
   end;
...
end;


Now that we have this infrastructure, we can really simplify the menu
processing:

   type Library_Access_Array is
      array (Menu_Item_Range) of Library_Access;

   The_Libraries : Library_Access_Array :=
     (1 => Libraries.Test.Library,  
      2 => Libraries.Another_Test.Library,
      3 => Libraries.Amazon.Library);

procedure Process_Menu (Item : Menu_Item_Range) is
   Lib : Root_Library'Class renames
      The_Libraries (Item);
begin
   Let_User_Play_With_Library (Lib);
end;

Sure beats a case statement, huh?

If Let_User_Play_With_Library needs an iterator, the The_Libraries array
can be just an array of iterator access objects.

If the user need both an iterator and a library, then add this primitive op
to the iterator class:

   type Root_Iterator is abstract tagged limited null record;

   function Library 
      (Iter : Root_Iterator) return Library_Access is abstract;
...
   type Test_Iterator (Lib : access Test_Library'Class) is
      new Root_Iterator with private;

   function Get_Library (Iter : Test_Iterator) return Library_Access is
   begin
      return Library_Access (Iter.Lib);  
-- return Iter.Lib.all'Access;  
   end;


Now, given an iterator, the client can get the associated library:

procedure Let_Client_Play_With_Lib
   (Iterator : Root_Iterator'Class) is

   Library : Root_Library'Class renames Get_Library (Iterator).all;
begin

(I like to name my selectors Get_xxx, so that the client can rename the
return value as just xxx.  This is the approach I've done throughout the
ACL.)

Hope this helps,
Matt