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 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,1116ece181be1aea
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-09-23 19:26:34 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!headwall.stanford.edu!newshub.sdsu.edu!elnk-nf2-pas!elnk-pas-nf1!newsfeed.earthlink.net!stamper.news.pas.earthlink.net!stamper.news.atl.earthlink.net!newsread1.news.atl.earthlink.net.POSTED!not-for-mail
Sender: mheaney@MHEANEYX200
Newsgroups: comp.lang.ada
Subject: Re: Is the Writing on the Wall for Ada?
References: <mailman.20.1062997816.295.comp.lang.ada@ada.eu.org>
 <q697b.8261$w41.4773@nwrdny02.gnilink.net> <3F5F7FDC.30500@attbi.com>
 <XSR7b.13955$w41.12275@nwrdny02.gnilink.net> <3F6079A9.6080108@attbi.com>
 <uisnz1kw6.fsf@nasa.gov> <3F60E380.4020307@attbi.com>
 <wvbrekyilaxg.fsf@sun.com> <3F694186.5060709@crs4.it>
 <wvbrk786pkkh.fsf@sun.com> <3F702545.6080704@crs4.it>
 <uu173vtv5.fsf@earthlink.net> <wX6cb.207$kD3.90@nwrdny03.gnilink.net>
From: Matthew Heaney <matthewjheaney@earthlink.net>
Message-ID: <ufzimx6mr.fsf@earthlink.net>
User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Date: Wed, 24 Sep 2003 02:26:34 GMT
NNTP-Posting-Host: 65.110.133.134
X-Complaints-To: abuse@earthlink.net
X-Trace: newsread1.news.atl.earthlink.net 1064370394 65.110.133.134 (Tue,
 23 Sep 2003 19:26:34 PDT)
NNTP-Posting-Date: Tue, 23 Sep 2003 19:26:34 PDT
Organization: EarthLink Inc. -- http://www.EarthLink.net
Xref: archiver1.google.com comp.lang.ada:42838
Date: 2003-09-24T02:26:34+00:00
List-Id: <comp.lang.ada>

"Stephane Richard" <stephane.richard@verizon.net> writes:

> I have a question about this idiom.
> 
> Taking your example here I'd like to have a classic example of the following
> using that idiom:
> 
> I have  Bird class that can fly, chirp, eat, hear and build a nest.
> I have a Horse class that can eat, run, walk, hear and sleep
> 
> How, using your idiom, would I go about creating a Pegasus class ?
> 
> From reading your example it seems to me you're create an aggregation
> of type A and B from type C.  Perhaps the example I state here might
> make it clearer on how the idiom works?

Here you go:

package Birds is

   type Root_Bird_Type is
     abstract tagged limited null record;

   type Bird_Class_Access is
     access all Root_Bird_Type'Class;

   procedure Fly (Bird : access Root_Bird_Type) is abstract;

   procedure Eat (Bird : access Root_Bird_Type) is abstract;

end Birds;


package Horses is

   type Root_Horse_Type is
     abstract tagged limited null record;

   type Horse_Class_Access is
     access all Root_Horse_Type'Class;

   procedure Eat (Horse : access Root_Horse_Type) is abstract;

   procedure Run (Horse : access Root_Horse_Type) is abstract;

end Horses;


package Pegasus_Types is

   type Pegasus_Type is limited private;

   function Bird (Pegasus : access Pegasus_Type)
      return Bird_Class_Access;

   function Horse (Pegasus : access Pegasus_Type)
      return Horse_Class_Access;

private

   type Bird_View (Pegasus : access Pegasus_Type) is
      new Root_Bird_Type with null record;

   procedure Fly (Bird : access Bird_View);
   procedure Eat (Bird : access Bird_View);

   type Horse_View (Pegasus : access Pegasus_Type) is
      new Root_Horse_Type with null record;

   procedure Eat (Horse : access Horse_View);
   procedure Run (Horse : access Horse_View);

   type Pegasus_Type is limited record
      Bird : aliased Bird_View (Pegasus_Type'Access);
      Horse : aliased Horse_View (Pegasus_Type'Access);
      ...
   end record;

end Pegasus_Types;


Now I can say:

declare
   Pegasus : aliased Pegasus_Type;
begin
   Fly (Bird (Pegasus'Access));
   Eat (Bird (Pegasus'Access));

   Eat (Horse (Pegasus'Access));
   Run (Horse (Pegasus'Access));
end;


There's no conflict between the Eat operation for Bird and the Eat
operation for Horse, because you can pick the view you need.