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

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

[adam]

Matthew, thanks for all the information.  It helps to be exposed to a
number of different approaches, so once I understand them all, I can
pick which one seems best.

A question about one thing you wrote:

> 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...);

Regarding the example at LRM 3.9.3(15-16):

    package Sets is
        subtype Element_Type is Natural;
        type Set is abstract tagged null record;
        function Empty return Set is abstract;
        function Union(Left, Right : Set) return Set is abstract;
        function Intersection(Left, Right : Set) return Set is abstract;
        function Unit_Set(Element : Element_Type) return Set is abstract;
        procedure Take(Element : out Element_Type; From : in out Set)
             is abstract;
    end Sets;

    Notes on the example: Given the above abstract type, one could
    then derive various (nonabstract) extensions of the type,
    representing alternative implementations of a set.  One might use
    a bit vector, but impose an upper bound on the largest element
    representable, while another might use a hash table, trading off
    space for flexibility.

It seems to me that, if your two choices are a bit vector and a hash
table, it's likely that other modules in the program that use a Set
would make this choice statically, because they'd already have an idea
of the upper bound on elements in the set.  My question: Would you
therefore choose instead to use a generic to implement a "Set"?  If
not, but if you would choose to use a generic to implement a Library
in my example, what's is the difference between the two examples that
would cause you to use different language constructs to implement
them?

                                -- thanks, Adam

-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/   Now offering spam-free web-based newsreading

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

[Matthew Heaney]

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

(start of quote)
Regarding the example at LRM 3.9.3(15-16):

    package Sets is
        subtype Element_Type is Natural;
        type Set is abstract tagged null record;
        function Empty return Set is abstract;
        function Union(Left, Right : Set) return Set is abstract;
        function Intersection(Left, Right : Set) return Set is abstract;
        function Unit_Set(Element : Element_Type) return Set is abstract;
        procedure Take(Element : out Element_Type; From : in out Set)
             is abstract;
    end Sets;

    Notes on the example: Given the above abstract type, one could
    then derive various (nonabstract) extensions of the type,
    representing alternative implementations of a set.  One might use
    a bit vector, but impose an upper bound on the largest element
    representable, while another might use a hash table, trading off
    space for flexibility.

It seems to me that, if your two choices are a bit vector and a hash
table, it's likely that other modules in the program that use a Set
would make this choice statically, because they'd already have an idea
of the upper bound on elements in the set.  My question: Would you
therefore choose instead to use a generic to implement a "Set"?  If
not, but if you would choose to use a generic to implement a Library
in my example, what's is the difference between the two examples that
would cause you to use different language constructs to implement
them?
(end of quote)

I probably wouldn't have bothered with the abstract root tagged type.

In fact, this is the very thing I didn't like about David Weller's
implementation of the Ada 95 Booch components.  I feel that Root_Queue and
Root_Stack etc abstract tagged types are unnecessary, and complicate my
life as an instantiator of a component.

Let's fix up the example a bit.  Realistically, you're going to make the
unit generic no matter what, because your set should work for any kind of
type.  Here, though, it looks like they intend for the set to work with
discrete types only, so let's import a generic discrete type:

generic
   type Element_Type is (<>);
package Sets is
        
        type Set is abstract tagged null record;
        function Empty return Set is abstract;
        function Union(Left, Right : Set) return Set is abstract;
        function Intersection(Left, Right : Set) return Set is abstract;
        function Unit_Set(Element : Element_Type) return Set is abstract;
        procedure Take(Element : out Element_Type; From : in out Set)
             is abstract;
end Sets;

Let's create a derived type:

generic
package Sets.Bit_Vector_G is

   type Bit_Vector_Set is new Set with private;
   <primitive ops for Bit_Vector_Set>
...
end Sets.Bit_Vector_G;

My issue is that if I want a bit vector set, I have to do two instantiations:

type Device_Id is range 1 .. 10;

package Device_Id_Sets is 
   new Sets (Device_Id);

package Device_Id_Sets.Bit_Vector is
   new Device_Id_Sets.Bit_Vector_G;

Not that big of a deal, but if I want just a bit vector set, it'd be nice
to only have to create one instantiation.  The benefit of the tagged type
approach is that it allows you to copy between set representations, using
primitive operations of the type.

To the root set package, let's add another class-wide operation:

   procedure Copy 
      (From : in Set'Class;
        To      : in out Set'Class) is

        From_Copy : Set'Class := From;
        Element : Element_Type;
   begin
      To := Empty;

      while not Is_Empty (From_Copy) loop
         Take (Element, From_Copy);
          To := Union (To, Unit_Set (Element));
      end loop;
   end Copy;

You see that this works with any type that derives from type Set.  And
that's what the tagged type approach buys you: the ability to manipulate
objects of different types within the same type class.

But...it's not the only way. You can do a lot of the same things with a
generic using "static polymorphism."  It's just that you have to
instantiate the copy operation (or any class-wide utility operation) with
your type (because it's not in the same class anymore).  Let's write the
set so it's not derived:

package Sets is
   pragma Pure;
end;

generic
   type Element_Type is (<>);
package Sets.Bit_Vector is
   
   type Bit_Vector_Set is private;  -- doesn't really need to be tagged
   <primitive ops>
...
end Sets.Bit_Vector;

Now we can make a "class-wide" operation, implemented as a generic, to do a
copy:

generic
   type Element_Type is (<>);

   type Source_Set (<>) is private;
   procedure Take
      (Element :     out Element_Type; 
       From      : in out Source_Set) is <>;
...
   type Target_Set (<>) is private;
   function Empty return Target_Set is <>;
   function Union (L, R : Target_Set) return Target_Set is <>;
   function Unit_Set (Element : Element_Type) return Target_Set is <>;

procedure Sets.Generic_Copy 
   (From : in Source_Set;
     To     : in out Target_Set);

procedure Sets.Generic_Copy (...) is

   From_Copy : Source_Set := From;
   Element : Element_Type;
begin
   To := Empty;

   while not Is_Empty (From_Copy) loop
      Take (Element, From_Copy);
       To := Union (To, Unit_Set (Element));
   end loop;  
end Sets.Generic_Copy;

Pretty much the same as before.  Note that the instantiation penalty is
small, because all the operations for the type are imported as default ops.

(Another note: the examples above have a relatively inefficient
implementation, because you have to make a copy of the source set.  Why
bother?  If your type exports an active iterator, then no copy is required,
because you can non-destructively visit every item in the source set. 
Write me if you have questions about how to do it.)

So it's a bit of a tradeoff.  If you need just one kind of set most of the
time, then the non-derived technique is easier, because you only require
just the one instantiation.  But if you need a "class-wide" utility
operation that operates on different kinds of sets, then you do have to do
an "extra" instantiation, of the (generic) utility.

If you have different kinds of sets (bit vector vs hash table) in your
application, and you need to operate on different kinds, then maybe the
derived technique is better, because it will simplify the implementation
(and invokation) of class-wide operations.

A approximate analogy is the types in the children of Ada.Strings.  Here,
you have Bounded_String and Unbounded_String as different classes of type. 
The types aren't tagged, nor do they derive from a common root type.  So
there aren't any "class-wide" operations to convert between Bounded_String
and Unbounded_String.

But this "inconvenience" isn't much of an inconvenience, because you just
convert the source type to an intermediate representation, type
Standard.String, and then pass that to the constructor for the target type.

Just imagine that if you wanted an unbounded queue or stack.  This is
pretty common - you don't want to have to worry about how big you have to
declare the bounded version.  To go the derived type technique, you'd have
to create that root queue type every time for every different instantation,
and then create another instantiation (the child) to get the type you
"really" want.  All this because of that 1-in-100th time you need some
variation (say, a bounded queue).

I'm exaggerating a little, but it's to make a point.  You can get a ton of
mileage out of generics, especially nowadays with the ability to import a
package as a generic formal parameter.

I do use tagged types.  In some of the ACL stuff I've done, tagged-ness
shows up as an implementation technique (the memory management stuff comes
to mind).  But different types are usually different classes.  For example,
I wrote

ACL.Trees.B_Trees
ACL.Trees.BStar_Trees
ACL.Trees.BPlus_Trees

All three types are different classes; there is no "Root_B_Tree" type from
which all the others derive.  Although I made the types publically tagged,
it's only because I had to make the types tagged anyway, because it needs
to (privately) inherit from Finalization.Controlled.  So tagged-ness was
basically a freebee for the client (who I would never expect to actually
derive from it, but who knows?).

Hope that sheds some light,
Matt

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

[adam]

Matthew, thanks for all the information---this really does help me see
what's going on.

> Use static binding when you need static binding, and use dynamic binding
> when you need dynamic binding.  Don't think that importing a formal derived
> type is somehow "superior" to the traditional way.  It's its complement,
> not replacement.

FWIW, I believe I do need dynamic binding in the tool I'm working on.
Of course, I'm not actually working on a program to list book titles,
but I am working on a program that will have to deal with some
radically different types of files, and the program will either use a
command-line option or take a peek at a file's header to figure out
what kind of file it's dealing with.  Sorry that I didn't make that
clear when I came up with my "Libraries" example; I didn't see at the
time that it was necessary to mention this.

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?


> 4) Constructors are functions in Ada.  That means to create a new iterator
> object on the heap, you don't return it as a procedure out param.  It
> should be a function that returns the type, ie
>
>    function New_Iterator
>      (Lib : access Root_Library) return Iterator_Access is abstract;
>
>    function New_Iterator
>       (Lib : access Test_Library) return Iterator_Access;

In my original post, my procedure declaration looked like this:

    procedure Scan_By_Title (Lib            : in Library;
                             Reg_Expression : in String;
                             Scan           : out Scan_Info;
                             RE_Error       : out Boolean)
        is abstract;

where Scan_Info is the iterator.  This can't be made into a function
because it returns two things.

But I think I see what happened here.  I was assuming that the
function (or procedure) that constructed the iterator was also the one
that set it up for the specific purpose I needed it for.  (Which might
be right in some cases.)  Your example, though, has one function to
create the iterator, and a second procedure (Scan_For_Substring) to
actually start the scan process.

OK, that makes sense.  Actually, that's the kind of thing I was
looking for with my original post.  I presume that New_Iterator could
create the iterator with some sort of "Useless" flag so that if you
tried Get_Book or Is_Done or Advance on the iterator without one of
the other setup routines, the program would get upset.


> This is an example of an indefinate type - Root_Iterator'Class (remember,
> all classwide types are indefinate) - that is also limited.  For an
> indefinate type, I need to give it some initial value, so I need to invoke
> a constructor to do that.  But I can't for limited types.  Major league
> bummer.

Last time I saw a problem similar to this, it was in a little book by
Joseph Heller . . .


> 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.

                                -- Adam

-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/   Now offering spam-free web-based newsreading

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

[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

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

[Simon Wright]

matthew_heaney@acm.org (Matthew Heaney) writes:

>                            This is the approach I've done throughout the
> ACL.)

Matthew,

I must have missed this ACL of yours! is it visible publicly anywhere?

-Simon

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

[Matthew Heaney]

Here's the idea I had for the library iterator.  The Library_Package.Test
package exports an active iterator that I was hoping to use to iterate over
a Test_Library.  

However, I can't get this code to compile!  My compiler is telling me the
generic actual types don't match the formal discriminant types.

If your compiler can compile this, let me know and I'll report a bug to
ACT.  If this is simply an illegal Ada program, then maybe someone can
figure out an alternative solution.

The idea was to make the List_Books operation a generic procedure that
imports an iterator type as a generic formal type, to iterate over the
library object passed in.  I do it this way because importing an iterator
as derived from an abstract root iterator type won't work, because formal
derived types cannot have a known discriminant (see RM95 12.5.1 (11), a
bummer of a paragraph).  So I just import everything as a non-tagged type
(even though the actual type may in fact be tagged), and import the ops
formal subprogram parameters ("implementation inheritance").

But I can't get the instantiation of List_Books to compile.  Maybe you'll
have more luck.

Matt



package Library_Package is

    type Library is abstract tagged null record;
    type Book is abstract tagged null record;

    function Title (Bk : Book) return string is abstract;

end Library_Package;


package Library_Package.Test is

    type Test_Library is new Library with private;

    type Test_Book is new Book with private;

    type Test_Library_Acc is access all Test_Library;

    type Test_Iterator (Lib : access Test_Library'Class) is
        limited private;

    function Title (Bk : Test_Book) return string;
    procedure Scan_For_Substring (Iter   : in out Test_Iterator;
                                  Substr : in string);
    function Is_Done (Iter : Test_Iterator) return boolean;
    function Get_Book (Iter : Test_Iterator) return Book'Class;
    procedure Advance (Iter : in out Test_Iterator);

private
    type String_P is access string;
    type Book_Info is record
       Title : String_P;
    end record;

    type Test_Book is new Book with record
        Info : Book_Info;
    end record;

    type Book_Array is array (Natural range <>) of Test_Book;

    type Test_Library is
      new Library with record
         Books : Book_Array (1..6) :=
        ( (Info => (Title => new string' ("A Time To Kill"))),
          (Info => (Title => new string' ("The Firm"))),
          (Info => (Title => new string' ("The Pelican Brief"))),
          (Info => (Title => new string' ("The Client"))),
          (Info => (Title => new string' ("The Rainmaker"))),
          (Info => (Title => new string' ("The Runaway Jury"))) );
      end record;


    type Test_Iterator (Lib : access Test_Library'Class) is
       limited record
         Search_String : String_P;
         Index         : Natural;
       end record;

end Library_Package.Test;


with Ada.Strings.Fixed;
package body Library_Package.Test is

    function Title (Bk : Test_Book) return string is
    begin
        return Bk.Info.Title.all;
    end Title;

    procedure Search (Iter : in out Test_Iterator) is
       use Ada.Strings.Fixed;
       Books : Book_Array renames Iter.Lib.Books;
    begin
       while Iter.Index <= Iter.Lib.Books'last loop
          declare
             Book : Test_Book renames Books (Iter.Index);

             Title : String renames Book.Info.Title.all;

             Search_String : String renames Iter.Search_String.all;
          begin
             exit when Index (Title, Search_String) /= 0;
          end;

          Iter.Index := Iter.Index + 1;

        end loop;
    end Search;

    procedure Scan_For_Substring (Iter   : in out Test_Iterator;
                                  Substr : in string) is
    begin
        Iter.Search_String := new string' (Substr);
        Iter.Index := Iter.Lib.Books'first;
        Search (Iter);
    end Scan_For_Substring;

    function Is_Done (Iter : Test_Iterator) return boolean is
    begin
        return (Iter.Index > Iter.Lib.Books'last);
    end Is_Done;

    function Get_Book (Iter : Test_Iterator) return Book'Class is
    begin
        return Iter.Lib.Books (Iter.Index);
    end Get_Book;

    procedure Advance (Iter : in out Test_Iterator) is
    begin
        Iter.Index := Iter.Index + 1;
        Search (Iter);
    end Advance;

end Library_Package.Test;


package Library_Package.List is

   generic
      type Source_Library (<>) is limited private;

      type Source_Iterator
        (Lib : access Source_Library) is limited private;

      with function Is_Done
        (Iter : Source_Iterator) return Boolean is <>;

      with procedure Advance
        (Iter : in out Source_Iterator) is <>;

      with function Get_Book
        (Iter : Source_Iterator) return Book'Class is <>;

      with procedure Scan_For_Substring 
        (Iter  : in out Source_Iterator;
         Subst : in     String) is <>;
   procedure List_Books 
      (Lib : access Source_Library; Substr : in string);

end Library_Package.List;


with Text_IO;
package body Library_Package.List is

   procedure List_Books 
     (Lib    : access Source_Library; 
      Substr : in string) is

      Iter : Source_Iterator (Lib);
    begin
        Scan_For_Substring (Iter, Substr);

        while not Is_Done (Iter) loop

            declare
                Bk : Book'class := Get_Book (Iter);
            begin
                Text_IO.Put_Line (Title (Bk));
            end;

            Advance (Iter);

        end loop;
    end List_Books;

end Library_Package.List;



with Library_Package.List;

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;