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,34c2aa33b8bdb1a9
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2002-01-11 17:12:07 PST
Path: 
 archiver1.google.com!news1.google.com!sn-xit-03!supernews.com!logbridge.uoregon.edu!fu-berlin.de!uni-berlin.de!ppp-1-176.cvx1.telinco.NET!not-for-mail
From: "Nick Roberts" <nickroberts@adaos.worldonline.co.uk>
Newsgroups: comp.lang.ada
Subject: Re: Sugestion to Multiple Inheritance
Date: Sat, 12 Jan 2002 00:28:44 -0000
Message-ID: <a1o2gv$sfe3f$4@ID-25716.news.dfncis.de>
References: <slrna3tf3u.kg.lutz@taranis.iks-jena.de>
NNTP-Posting-Host: ppp-1-176.cvx1.telinco.net (212.1.136.176)
X-Trace: fu-berlin.de 1010797920 29866095 212.1.136.176 (16 [25716])
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.50.4133.2400
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4133.2400
Xref: archiver1.google.com comp.lang.ada:18806
Date: 2002-01-12T00:28:44+00:00
List-Id: <comp.lang.ada>

"Lutz Donnerhacke" <lutz@iks-jena.de> wrote in message
news:slrna3tf3u.kg.lutz@taranis.iks-jena.de...

> I'm looking for a design glue to build something like this:
>
>  I have an several (at least two) interfaces with must be implemented
>  by the end user (compiler should require implementation). All of them
>  build a free(!) depedency tree. The simplest one is:
>
>      A -> B     B is an extended A and C is an extended A.
>      |    |     D combines both extensions (requiring both).
>      v    v
>      C -> D
>
>  There are (generic) packages requiring special interfaces.
>
> I'd like to use abstract types and class wide programming, but this can't
be
> done in Ada naturally.


Taking the following example similar to your situation:


  type Respirant is abstract ...;
  procedure Breathe (Animal: in out Respirant; Air: ...);

  type Mammal is abstract new Respirant with ...;
  function Lactate (Animal: in Mammal) return Milk;

  type Arboreal is abstract new Respirant with ...;
  procedure Climb (Animal: in out Arboreal; Tree: ...);

  type Sloth is abstract new Arboreal, Mammal ...; --?


Maybe one solution is as follows:


  type Sloth is abstract new Respirant with ...;

  type Mammal_Aspect   is access all Mammal'Class;
  type Arboreal_Aspect is access all Arboreal'Class;

  function As_Mammal   (Animal: in Sloth) return Mammal_Aspect;
  function As_Arboreal (Animal: in Sloth) return Arboreal_Aspect;

  function Toes (Animal: in Sloth) return Two_Or_Three;


Thus, if you had:


  type Two_Toed_Sloth_As_Mammal is new Mammal with ...;
  -- implement Breathe and Lactate

  type Two_Toed_Sloth_As_Arboreal is new Arboreal with ...;
  -- implement Breathe (again!) and Climb

  type Two_Toed_Sloth is new Sloth with
    record
      Mammalianness: aliased Two_Toed_Sloth_As_Mammal;
      Arboreality:   aliased Two_Toed_Sloth_As_Arboreal;
    end record;

  -- implement Breathe (yet again!!)

  function As_Mammal (Animal: in Two_Toed_Sloth)
        return Mammal_Aspect is
  begin
    return Animal.Mammalianness'Access;
  end;

  function As_Arboreal (Animal: in Two_Toed_Sloth)
        return Arboreal_Aspect is
  begin
    return Animal.Arboreality'Access;
  end;

  function Toes (Animal: in Two_Toed_Sloth)
        return Two_Or_Three is
  begin
    return 2; -- ;-)
  end;


  Jenny: Two_Toed_Sloth;


You could then make Jenny climb to safety:


  Climb( As_Arboreal(Jenny).all, Nice_Tall_Tree );


Ugly, but it works, as they say. Hope this helps!

--
Best wishes,
Nick Roberts