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-15 21:32:47 PST Path: archiver1.google.com!postnews1.google.com!not-for-mail From: amir@iae.nsk.su (Amir Yantimirov) Newsgroups: comp.lang.ada Subject: Re: Is the Writing on the Wall for Ada? Date: 15 Sep 2003 21:32:45 -0700 Organization: http://groups.google.com/ Message-ID: <5115eb96.0309152032.5b858c37@posting.google.com> References: <3F615341.4000100@attbi.com> <568ede3c.0309121211.743a8da2@posting.google.com> <1ec946d1.0309150709.4a7daa12@posting.google.com> NNTP-Posting-Host: 193.125.41.101 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit X-Trace: posting.google.com 1063686766 2019 127.0.0.1 (16 Sep 2003 04:32:46 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: 16 Sep 2003 04:32:46 GMT Xref: archiver1.google.com comp.lang.ada:42558 Date: 2003-09-16T04:32:46+00:00 List-Id: mheaney@on2.com (Matthew Heaney) wrote in message news:<1ec946d1.0309150709.4a7daa12@posting.google.com>... > hyrosen@mail.com (Hyman Rosen) wrote in message news:<568ede3c.0309121211.743a8da2@posting.google.com>... > > Let me give a C++ example, and you can tell me why you don't believe it. > > Here's the Ada95 version of your example: > > package Colorable_Types is > > type Root_Colorable_Type is > abstract tagged limited null record; > > type Colorable_Class_Access is > access all Root_Colorable_Type'Class; > > procedure Set_Color > (Colorable : access Root_Colorable_Type; > Color : in Integer) is abstract; > > function Get_Color (Colorable : access Root_Colorable_Type) > return Integer is abstract; > > end Colorable_Types; > > > package Colorable_Types.Adapters is > > type Colorable_Adapter_Type is > new Root_Colorable_Type with private; > > procedure Set_Color > (Colorable : access Colorable_Adapter_Type; > Color : in Integer); > > function Get_Color (Colorable : access Colorable_Adapter_Type) > return Integer; > > private > > > type Colorable_Adapter_Type is > new Root_Colorable_Type with record > Color : Integer; > end record; > > end Colorable_Types.Adapters; > > > package Resizable_Types is > > type Root_Resizable_Type is > abstract tagged limited null record; > > type Resizable_Class_Access is > access all Root_Resizable_Type'Class; > > procedure Set_Size > (Resizable : access Root_Resizable_Type; > Size : in Float) is abstract; > > function Get_Size (Resizable : access Root_Resizable_Type) > return Float is abstract; > > end Resizable_Types; > > > package Resizable_Types.Adapters is > > type Resizable_Adapter_Type is > new Root_Resizable_Type with private; > > procedure Set_Size > (Resizable : access Resizable_Adapter_Type; > Size : in Float); > > function Get_Size (Resizable : access Resizable_Adapter_Type) > return Float; > > private > > type Resizable_Adapter_Type is > new Root_Resizable_Type with record > Size : Float; > end record; > > end Resizable_Types.Adapters; > > with Colorable_Types.Adapters; use Colorable_Types; > with Resizable_Types.Adapters; use Resizable_Types; > > package My_Objects is > > type My_Object is limited private; > > function Colorable (Object : access My_Object) > return Colorable_Class_Access; > > function Resizable (Object : access My_Object) > return Resizable_Class_Access; > > procedure Do_Something (Object : in out My_Object); > > private > > use Colorable_Types.Adapters; > use Resizable_Types.Adapters; > > type Colorable_View (Object : access My_Object) is > new Colorable_Adapter_Type with null record; > > type Resizable_View (Ojbect : access My_Object) is > new Resizable_Adapter_Type with null record; > > type My_Object is limited record > Colorable : aliased Colorable_View (My_Object'Access); > Resizable : aliased Resizable_View (My_Object'Access); > end record; > > end My_Objects; > > Now you can do this: > > procedure Test_MI is > > Obj : aliased My_Object; > > begin > > Set_Color (Colorable (Obj'Access), Color => 0); > Set_Size (Resizable (Obj'Access), Size => 1.0); > > Do_Something (Obj); > > end Test_MI; > > The type My_Object "inherits" from both Colorable and Resizable. > Anywhere you have subprogram that accepts a Colorable or Resizable, > you can use a My_Object. And here is how I wish it should be written (in hypotetical language). Types { type Color = Integer; type Size = Float; } type GradientBar { data { Color1,Color2: Types.Color; Size: Types.Size; } procedure Draw; } interface Colorable { property Color : Types.Color; } interface Sizeable { property Size : Types.Size; } procedure EditColor(string Title, interface Colorable)... procedure EditSize(string Title, interface Sizeable)... procedure EditGradientBar(ref Bar: GradientBar) { with GradientBar { interface Color1 : Colorable { get { Color := data.Color1; } set { data.Color1 := Color; Draw; } } interface Color2: Colorable { get { Color := data.Color2; } set { data.Color2 := Color; Draw; } } interface : Sizeable { get { Size := data.Size; } set { data.Size := Size; Draw; } } } EditColor("Color1", Bar.Color1); EditColor("Color2", Bar.Color2); EditSize("Size", Bar); } Note, what interfaces are added outside of type definition. I think that from Ada point of view its even more naturally than from other languages. http://www174.pair.com/yamir/programming/interfaces.htm Amir Yantimirov