"Matthew Heaney" <matthewjheaney@earthlink.net> wrote in message
news:ufzimx6mr.fsf@earthlink.net...
> "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.
>
>

Ahhh I see now, ok it's not quite what I thought it would be...(as per my
aggregation assumption)..it makes sense now :-)

-- 
St�phane Richard
"Ada World" Webmaster
http://www.adaworld.com