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, T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,5c9ae6c7b4ac5676 X-Google-Attributes: gid103376,public From: "Robert I. Eachus" Subject: Re: Limiting inheritance Date: 2000/07/29 Message-ID: <39822FBB.1BF95E0B@earthlink.net> X-Deja-AN: 652020215 Content-Transfer-Encoding: 7bit References: <8lq7tj$5rt$1@nnrp1.deja.com> X-Accept-Language: en,pdf Content-Type: text/plain; charset=us-ascii X-Complaints-To: abuse@earthlink.net X-Trace: newsread2.prod.itd.earthlink.net 964833185 63.24.55.123 (Fri, 28 Jul 2000 18:13:05 PDT) Organization: The MITRE Corporation MIME-Version: 1.0 NNTP-Posting-Date: Fri, 28 Jul 2000 18:13:05 PDT Newsgroups: comp.lang.ada Date: 2000-07-29T00:00:00+00:00 List-Id: reason67@my-deja.com wrote: > > Let's day I have the types specified as follows: > > package Patch is > type Patch_Type is (red, orange, yellow, green, blue, violet); > subtype Base_Patch_Type is Patch_Type Red .. Green; > type Object is tagged private; > ... > procedure Set_Patch_Kind (To : in Base_Patch_Type; In_Object : in Object); > ... > private > type Object is tagged > record > ... > Kind : Patch_Type; > ... > end record; > > end Patch; > > package Patch.Fancy is > subtype Fancy_Patch_Kind is Patch_Kind Blue .. Violet; > type Object is new Patch.Object with tagged private; > ... > procedure Set_Patch_Kind (To : in Fancy_Patch_Type; In_Object : in > Object); > ... > private > type Object is new Patch.Object with > record > ... > end record; > end Patch.Fancy; > OK. What I am trying to do is enforce the Kind to the subtype that makes > sense in the parent or the child. I can not do what I show above because > it does not compile (Dispatching operation is not subtype conformant) > > I can make the procedres 2 different names but if I go that route, I > want to NOT inherit the procedure from the parent to the child. Is there > a way to do this? > --- > Jeffrey > > Sent via Deja.com http://www.deja.com/ > Before you buy. There are two orthogonal issues here that need to be separated in your thoughts as well. You have a class with subtyping based on Kind, and a subclass with subtyping also based on Kind. In Ada terms, the subclassing can be statically or dynamically dispatching, and which you choose can vary from place to place in the code. The subtype of an object can also be statically or dynamically determined, and some objects can be statically typed while others have their subtype determined at run-time. Whew! What does all this mean? Your Set_Patch_Kind in Patch.Fancy must have a subtype for the To parameter that matches that for the parent operation. However, you may dynamically limit the values accepted to a smaller set inside the operation: (I also made a lot of other changes to the package declarations, mostly for conciseness and consistancy. But Object is now an in out parameter.) package Patch is type Patch_Type is (red, orange, yellow, green, blue, violet); subtype Base_Patch_Type is Patch_Type Red .. Green; type Object_Type is tagged private; ... procedure Set_Patch_Kind (To : in Patch_Type; Object : in out Object_Type); ... private type Object_Type is tagged record ... Kind : Patch_Type; ... end record; end Patch; package Patch.Fancy is subtype Fancy_Patch_Kind is Patch_Kind range Blue .. Violet; type Object_Type is new Patch.Object with tagged private; ... procedure Set_Patch_Kind (To : in Patch_Type; Object : in out Object_Type); ... private type Object_Type is new Patch.Object with record ... end record; end Patch.Fancy; Now in the body of package Patch you can say: procedure Set_Patch_Kind (To: in Patch_Type; Object_Type: in out Object_Type) is begin if To in Base_Patch_Type then Object.Kind := To; else raise Constraint_Error; end if; end Set_Patch_Type; And in the body of Patch.Fancy: procedure Set_Patch_Kind (To: in Patch_Type; Object_Type: in out Object_Type) is begin if To in Fancy_Patch_Type then Object.Kind := To; else raise Constraint_Error; end if; end Set_Patch_Type; But in general, that IS NOT what you want to do. You usually want to have a constructor function that takes, potentially among other things, a Patch_Kind, and then creates an object of the appropriate type an then returns it. Here there is a different type of magic formula you often need: package Patch is type Patch_Type is (red, orange, yellow, green, blue, violet); subtype Base_Patch_Type is Patch_Type range Red .. Green; type Object_Type is tagged private; ... function Create_Object(Patch_Kind: Patch_Type) return Object_Type'Base; procedure Set_Patch_Kind (To : in Patch_Type; Object : in out Object_Type); ... private type Object_Type is tagged record ... Kind : Patch_Type; ... end record; function Create(Patch: Patch_Type) return Object; end Patch; package Patch.Fancy is subtype Fancy_Patch_Kind is Patch_Kind range Blue .. Violet; type Object_Type is new Patch.Object with tagged private; ... procedure Set_Patch_Kind (To : in Patch_Type; Object : in out Object_Type); ... private type Object_Type is new Patch.Object with record ... end record; function Create(Patch: Patch_Type) return Object; end Patch.Fancy; The body of Patch could simply contain: function Create_Object(Patch_Kind: in Patch_Type) return Object_Type'Base is begin return Create(Patch_Kind); end Create_Object; -- not recommended As well as the full declaration of Create. This way you have one visible creation function which is class wide, while any (child) package which creates a new subclass must provide a new, and presumably correct, version of Create. Note, however, that with that particular body, you can't call Create_Object in a class indeterminate context. So what you do is make the body of Patch depend on the declarations of all the children, and now you can do: function Create_Object(Patch: in Patch_Type) return Object_Type'Base is begin case Patch is when Base_Patch_Type => return Patch.Object'(Create(Patch)); when Fancy_Patch_Type => return Patch.Fancy.Object'(Create(Patch)); end case; end Create_Object; For this simple example, this is sufficient, although you may want to use generic packages and have one instance of some defining package for each value of the enumeration type above. However, in more complex environments you can have several different constructors type specific, some classwide with defaults for type specific fields and possibly defined over some subclass of the base class, etc. And while the type hierarchy is growing, you keep having to recompile everything since the definition of additional values of Patch_Kind requires changing the package spec of Patch. Ugh! It would be nice if Ada had a way of extending enumeration types. Maybe next version. There are two solutions for now. The first is to eliminate Patch_Type altogether and use Object'Tag to tell what kind an object is. In most cases you will find that the record component, Kind in the example above, just duplicates information that can be determined using the tag attribute (or in some cases 'External_Tag). If that is not sufficient, you can create a registration service for new subclasses of the base class. The registration package allows tags to be registered, then allows iterating over all types in the class, etc. I'm not going to provide all of the plumbing but: with Ada.Tags; package Patch.Registry is type Patch_Index is mod 2**32; Current_First_Index: constant Patch_Index := 1; -- really a statement to users. function Current_Last_Index return Patch_Index; function Tag_Of(Index: Patch_Index) return Ada.Tags.Tag; function Tag_Of(Patch.Object) return Ada.Tags.Tag; function Index_Of(Patch.Object) return Patch_Index; function Index_Of(Tag: Ada.Tags.Tag) return Index; function Register(Tag: in Ada.Tags.Tag) return Patch_Index; end Patch.Registry; The body of Registry needs to contain a protected object to avoid race conditions, and it should also Register the tag of Patch.Object_Type during elaboration. (Patch.Fancy and any other child type can register their own tags, usually in the private part of the package which is why Register is a function. However, the specification of the parent package can't make the needed call.