!standard 12.05 (06) 04-09-13 AI95-00158/03 !class pathology 04-09-13 !status work item 03-06-23 !status received 96-09-04 !priority Medium !difficulty Hard !subject Renamings of primitives of a class-wide generic actual type !summary A renaming of a primitive subprogram of a generic formal type is allowed when the actual type is class-wide, even though formal parameters of the renaming are class-wide in the instance while the corresponding formals of the renamed primitive are of the specific type. A call to such a renaming is equivalent to a call to a subprogram with class-wide parameters and result types in place of any controlling formals and result of the renamed subprogram, where the body of the subprogram invokes the renamed subprogram as a dispatching call, passing its class-wide formal parameters as the corresponding actuals to the renamed subprogram. !question Although it is not explicitly stated, a class-wide type may be passed as a generic actual type, so long as the formal is indefinite, and either private, or a private extension of some ancestor of the root of the class-wide type. Inside the generic, you get a set of primitive operations determined by the formal type declaration, which in the case of a nonlimited private, consists of "=" and "/=", and for a formal private extension, a full set of user-defined primitive operations. The question is -- what happens if we rename one of these implicitly declared operations? For example: package Pkg is type Root is tagged ... procedure P(R : Root); function Empty return Root; end Pkg; with Pkg; generic type T(<>) is new Pkg.Root with private; -- primitives are implicitly declared here: -- function "="(Left, Right : T) return Boolean; -- procedure P(R : T); -- function Empty return T; package Gen is -- Now what happens if we rename these ops? procedure My_P(R : T) renames P; function Equals(L, R : T) return Boolean renames "="; function My_Empty return T renames Empty; end Gen; with Pkg, Gen; package Inst is new Gen(Pkg.Root'Class); What exactly are the semantics of Inst.My_P, Inst.Equals, and Inst.My_Empty? Are calls to them dispatching? (Calls to Inst.My_P and Inst.Equals with class-wide operands are dispatching. Calls to the function Inst.My_Empty are nondispatching.) !recommendation A generic unit with a generic formal type parameter can be instantiated with a class-wide actual type when the formal type is an indefinite formal private type or an indefinite formal private extension. The primitive subprograms of such a formal type can be renamed within the generic unit. In the instance, the copies of any such renamings will have the class-wide type as the nominal subtype of each controlling formal or result subtype of the renamed primitive subprogram. Such renamings are legal, notwithstanding the type conformance requirements for subprogram renaming declarations (8.5.4(4,5/1)). Within the generic instance, a call to such a subprogram renaming is allowed to have class-wide actual parameters. Such a call is defined to be equivalent to a call to a wrapper subprogram with the profile given in the instance copy of the renaming declaration, that in turn calls the renamed subprogram, passing its formals to the corresponding actuals of the renamed subprogram (and returning the renamed subprogram's result as the wrapper's result in the case of a function). Note that this is comparable to the dynamic semantics for renaming-as-body calls as defined in 8.5.4(7.1/1). This semantics implies that a call to one of these renamings will behave as a dispatching call when it has class-wide actuals. However, in the case of calls to such a renaming where there are no controlling actuals, but only a controlling result, the resulting function call will have nondispatching semantics, because the wrapper has no controlling tag to provide on the call to the renamed primitive function (other than the root type's tag). !wording Given the classification of this AI as Pathology, no wording has been developed for it. If wording is needed, then rules should probably be added in 8.5.4 to address the relaxed conformance checking needed for these anomalous renamings (allowing class-wide formals to match corresponding controlling formals of the renamed subprogram). The semantics of calls to these renamings can be modeled on renaming-as-body calls (8.5.4(7.1/1)). !discussion The basic issue raised by AI is the renaming anomaly pointed out by Tucker Taft (see !appendix). This arises from being able to pass a class-wide type as an actual type that matches what ostensibly looks like a specific type from the point of view of the generic unit. The primitive subprograms associated with formal private types (just "=") and formal derived types have normal specific types for their formals. However, if the actual type passed in is a class-wide type, then a subprogram renaming for a primitive of the formal type will end up having formal subtypes (and result subtype) that are mapped to the class-wide type in an instance. A strict reading of the reference manual leads to the conclusion that such renamings must be illegal, because the renaming's specification is not type-conformant with the renamed primitive. For example, considering the type and generic package given in the !question section: package Pkg is type Root is tagged ... procedure P(R : Root); function Empty return Root; end Pkg; with Pkg; generic type T(<>) is new Pkg.Root with private; package Gen is procedure My_P(R : T) renames P; function Equals(L, R : T) return Boolean renames "="; function My_Empty return T renames Empty; end Gen; For an instantiation passing Root'Class: with Pkg, Gen; package Inst is new Gen(Pkg.Root'Class); The instance logically contains renamings as follows: procedure My_P(R : T'Class) renames P; function Equals(L, R : T'Class) return Boolean renames "="; function My_Empty return T'Class renames Empty; But it would be illegal to write such a renaming, since the controlling formals and result are class-wide, conflicting with the specific types of the formals and result of the renamed subprograms. Let's consider several possible ways to address this anomaly: Alternative 1: The first possibility for resolving this issue is to say that an instance containing such a renaming is illegal. The problem with this approach is that it would create a contract model violation for renamings in the generic body. This could be prevented by outlawing potentially problematic renamings in the body, but that seems overly restrictive and would clearly be incompatible (though such renamings are probably rare). Alternative 2: Treat calls to the renaming as statically tagged nondispatching calls to the renamed subprogram. That is, in the instance, the fact that a formal or result of the renaming logically has a class-wide type would be ignored, and the renaming would be effectively be equivalent to a normal renaming using the specific type for the formal and result types. Adopting this alternative would presumably require relaxing the conformance rules for subprogram renamings, at least for renamings of this particular kind within an instance. Another approach would be to define such renamings as using the class-wide type's specific root type for formals and result type. In any case, any approach that allows these renamings will need to make semantic changes along these lines. It's worth noting that if the conformance rules are relaxed in this way, this doesn't appear to cause additional anomalies, at least for a renaming-as-declaration, because 8.5.4(7) defines the profile of the view declared by a renaming-as-declaration as taking the subtypes of its formals and result from the renamed subprogram. The rules for a renaming-as-body require the stricter subtype conformance, but this could presumably be relaxed in a similar manner for the case of these special instance renamings. If these odd "class-wide" renaming declarations are defined to be equivalent to a normal "specific" renaming, then calls to these renamings would simply be treated as nondispatching calls, even when the actuals in a call within the instance are class-wide. This follows from the fact that these renamings will not be primitive subprograms of the formal type (more properly, in an instance, they aren't primitives of the actual type's root type). The normal conversion semantics of calls means that any class-wide actuals are simply converted to the specific root type. This alternative seems to be the simplest solution in terms of semantics and implementation. However, this approach means that no new functionality is gained by the availability of these special renamings (but that may be a good thing, since this keeps the semantics simple and avoids turning what is essentially an accidental artifact of the rules into an extension that was never intended). It could be argued that it's surprising that a call from within within the generic body with class-wide arguments would simply make a static call without regard to the tags of the actuals, but users are unlikely to expect special dispatching for such renamings (if they ever even think to try them in the first place). Alternative 3: Treat calls to the renaming as equivalent to calls to the renamed dispatching subprogram, allowing both dispatching and nondispatching forms of calls. This approach falls out of Tucker Taft's proposal involving 'Class_Only operations (see !appendix for details). However, that proposal appears to involve a significant change to the semantic model for the primitives of tagged types. To consider such a change to the description of dispatching semantics for the sake of solving this rather limited problem seems unjustifiable. When Tucker originally proposed this, it had the merit of leading to a significant semantic extension that would provide a Java interface-like capability. However, now that a customized design is has been proposed for adding interface types to the language (see AI-251), there would be no significant added benefit to revising the tagged type model to provide an interface-like feature via these odd renamings. Alternative 4: Treat calls to the renaming as functionally equivalent to calling a class-wide operation that in turn makes a call to the renamed subprogram, passing its arguments on to the corresponding parameters of the renamed subprogram. This is essentially the model proposed by Erhard Ploedereder (see !appendix), which defines calls to the renaming in terms of a wrapper subprogram that makes a call to the renamed subprogram, passing along the actuals (making it a dispatching call when the actuals of the renaming are class-wide). One problem with this approach is that it conflicts with the current treatment of subprogram renamings as having the profile of the renamed subprogram, not that of the specification given in the renaming. However, it should be feasible to address that with some suitable relaxation of the renaming conformance rules for these cases. Another problem is tag-indeterminate dispatching would not work with this model. This is a consequence of using a wrapper model for calling such renamings. There's no obvious way for the context of a call to the renaming wrapper to provide a controlling tag on the call to the renamed function (at least not without introducing new potentially complex semantic descriptions for how such a wrapper call could achieve this). This approach could be worth considering, if it added a significant enough functionality benefit. If the idea is to achieve a form of interface capability, then this has been superseded by the proposal for interface types being considered in AI-251. Simply gaining the ability to make dispatching calls when making calls via renamings of this specialized form seems too rarefied a need. Admittedly this could also be used to allow dispatching calls via formal subprograms, but that also seems a feature of somewhat dubious use, and is unaesthetic in that it takes advantage of an odd loophole rather than being a properly integrated language feature. Note also that it would merely be shorthand for what can already be done by passing in an explicit wrapper subprogram. Conclusion After ARG review of the alternatives, it was decided that this AI should be classified as a pathology. It is felt that this problem is not worth forcing implementers to do any work. The preferred approach for addressing this issue is to recommend alternative 4, and so the !summary and !recommendation sections have been written in terms of that approach. !ACATS Test As this is deemed a pathology, no conformance tests should be written to enforce this behavior. !appendix !section 12.5(6) !subject T'Class as generic actual type !reference RM95-12.5(6) !reference RM95-12.5.1(17,21) !from Tucker Taft 96-08-22 !reference 96-5640.a Tucker Taft 96-8-22>> !discussion Although it is not explicitly stated, a class-wide type may be passed as a generic actual type, so long as the formal is indefinite, and either private, or a private extension of some ancestor of the root of the class-wide type. Inside the generic, you get a set of primitive operations determined by the formal type declaration, which in the case of a nonlimited private, consists of "=" and "/=", and for a formal private extension, a full set of user-defined primitive operations. The question is -- what happens if we rename one of these implicitly declared ops? For example: package Pkg is type Root is tagged ... procedure P(R : Root); function Empty return Root; end Pkg; with Pkg; generic type T(<>) is new Pkg.Root with private; -- primitives are implicitly declared here: -- function "="(Left, Right : T) return Boolean; -- procedure P(R : T); -- function Empty return T; package Gen is -- Now what happens if we rename these ops? procedure My_P(R : T) renames P; function Equals(L, R : T) return Boolean renames "="; function My_Empty return T renames Empty; end Gen; with Pkg, Gen; package Inst is new Gen(Pkg.Root'Class); -- What exactly are the semantics of Inst.My_P, -- Inst.Equals, and Inst.My_Empty? -- Are all calls on them dispatching? -- Hmmmm.... Now this is not just an idle exercise, though it may seem so at first. Another thing you might want to do is: generic type T(<>) is tagged private; with function Empty return T is <>; package Another_Gen is ... Ideally the following instantiation would be legal: with Pkg, Another_Gen; package Another_Inst is new Another_Gen(Pkg.Root'Class); If this were to be legal, what "Empty" are we implicitly passing as a generic actual? During the 9X design process, Norm Cohen (NC1 ;-) (and others) periodically recommended that we "reify" the dispatching operations, by claiming that there are implicit declarations of operations on T'Class which automatically dispatch when you call them. We had originally had a model like this, but it grew overly complex, and seemed to introduce nasty ambiguities between the operations on T'Class and T. However, when you start instantiating a generic with T'Class, these operations seem to somehow magically reappear in the model. Furthermore, it would be very nice if an instantiation like Another_Inst would work, as this would provide a crucial piece in constructing a flexible Java "interface type"-like notion of a type implementing multiple generic "signatures". Hence, without further ado, I suggest the following *model* for defining the semantics of dispatching calls, as well as what you get when you instantiate a generic with a class-wide actual... IMPLICIT DECLARATION MODEL FOR DISPATCHING CALLS When a primitive operation is declared on a tagged type, a corresponding "dispatching-only" operation is declared on a type we will herein dub T'Class_Only, which is somewhat like T'Class, except that it only allows actual parameters of types T'Class and T'Class_Only, and is *not* implicitly convertible to T'Class (to avoid ambiguities). For example, going back to the "Pkg" above, we get the following: package Pkg is type Root is tagged ... procedure P(R : Root); function Empty return Root; -- The following implicit declarations occur: -- First the usual =, /= : -- function "="(Left, Right : Root) return Boolean; -- function "/="(Left, Right : Root) return Boolean; -- Now for the "dispatching-only" operations -- (these are all convention Intrinsic) -- function "="(Left, Right : Root'Class_Only) return Boolean; -- function "/="(Left, Right : Root'Class_Only) return Boolean; -- procedure P(R : Root'Class_Only); -- function Empty return Root'Class_Only; end Pkg; These Root'Class_Only operations are effectively the "primitive" operations of the type Root'Class. Root'Class_Only can be thought of as a subtype of Root'Class, but which lacks the implicit convertibility associated with Root'Class. Note that once we introduce these 'Class_Only operations, we can eliminate all the funny business about statically and dynamically tagged expressions, tag-indeterminate expressions, and the funny rule which allows T'Class to be passed when T is expected, but only as part of a dispatching call. All of these rules are subsumed by the normal overload resolution rules, where T'Class_Only is treated as a separate type which is *not* covered by T'Class, and covers only T'Class and T'Class_Only. The notion of a dynamically tagged expression reduces to simply something of type T'Class or T'Class-Only. The rules for dispatching assignment statements are also subsumed by simply presuming the existence of a T'Class_Only assignment operation. The special rule for class-wide "=" can also be explained by saying that the implicitly declared 'Class_Only "=" returns False if the tags don't match. There is no need for any mention of the explicit use of the "=" operator in the call, since it only the 'Class_Only "=" that has this property. The rule that renaming does not automatically "carry" over dispatching-ness also works naturally, since a rename is renaming the T, not the T'Class_Only operation. Finally, getting back to generic instantiation. It is the 'Class_Only operations that "come along" with an actual class-wide type in an instantiation. Given that, there then becomes no particular reason that such operations should not match explicit formal subprograms, like the "Empty" one in Another_Gen above. This leads to the general notion that T'Class_Only matches T'Class for the purposes of generic formal/actual subprogram matching, and presumably also subprogram renaming-as-spec. That is, T'Class_Only and T'Class are "type conformant" but not "subtype conformant". Note that on a subprogram renaming-as-spec, the original parameter subtypes "show through" the renaming, and so a renaming of an implicitly declared dispatching operation, as in: function My_Empty return Pkg.Root'Class renames Pkg.Empty; produces a function whose result subtype is still "Pkg.Root'Class_Only, and is hence a dispatching-only function. SUMMARY The above model simplifies the explanation of the semantics at one level, but introduces a bunch of implicit declarations at another level. Hence, one way to handle it is to use it simply as a model to derive the rules, without forcing all of the implicit declarations onto the users' conscience until they want them. In many ways, the above notion of a 'Class_Only type is analogous to the root_integer and root_real types. They make the underlying model cleaner, but most users don't want to think about them, and are willing to just live with the rules implied by the underlying model without having to understand the model itself. Hence, with that attitude, the net effect of the above proposal is that subprogram renaming and generic formal/actual subprogram matching is somewhat relaxed, to allow a dispatching operation to be renamed/matched by a subprogram that has T'Class instead of T at each of the controlling parameter/result places. What is produced is a subprogram that dispatches when called with class-wide (or dynamically-tagged) operands, even though it isn't declared immediately within the immediate scope of the controlling type. USING NEW RULE TO IMPLEMENT MULTIPLE INTERFACES The thing which interested me in this from the beginning was trying to come up with a good fit for the Java notion of an "Interface" type. In Java, a class only has one parent (i.e. single inheritance), but may claim to "implement" any number of "interface" types. What that means is that the class must implement each of the methods specified in the interface type declaration. However, no code is inherited from the interface type, only the specs for the methods. So this might be called single inheritance of implementation, and multiple inheritance of interface. Ada's generics provide a very nice, and potentially more flexible way, of defining multiple interfaces to be implemented by a type. For example: generic type Set(<>) is private type Element(<>) is private; with function Union(L, R: Set) return Set is <>; with function Intersection(L, R: Set) return Set is <>; with function Empty return Set is <>; with function Unit_Set(E : Element) return Set is <>; with procedure Take(S : in out Set; E : out Element) is <>; package Set_Interface is end; We can take any set-like type, and create an instantiation of this "Set_Interface" generic, and then use it in other generics which have a formal package parameter that is an instance of Set_Instance. We can make this usable outside of generics by coupling it with access discriminants: with Window_Interface; package Pkg is -- First declare a type of some sort type My_Type is tagged limited ... ... -- Now show how it implements the "Window" interface, possibly -- with different operation names package Implements is new Window_Interface.Implements(My_Type'Class, Display => Draw, Resize => Specify_Size); -- Now we can create a type that can "behave" as a Window by -- adding a "surrogate" component of the type Implements.Window. type My_Type_With_Window is new My_Type with record Window : aliased Implements.Window(My_Type_With_Window'Access); ... -- other "Implements" components. end record; -- Given X of type My_Type_With_Window, X.Window can be -- passed any place where an object implementing the interface -- defined in Window_Interface is required. end Pkg; The above all relies on the use of My_Type'Class as a generic actual, and the ability of formal subprograms to match actual dispatching operations. Here is a possible implementation of the generic used above: package Window_Interface is type Window is abstract tagged limited private; procedure Display(this : access Window) is abstract; procedure Resize(this : access Window; Height, Width : Dimension) is abstract; ... generic type Implementor(<>) is tagged limited private with procedure Display(this : access Implementor) is <>; with procedure Resize(this : access Implementor; Height, Width : Dimension) is <>; ... package Implements is type Window(Encloser : access Implementor) is new Window_Interface.Window with null record; procedure Display(this : access Window); procedure Resize(this : access Window; Height, Width : Dimension); ... end Implements; end Window_Interface; package body Window_Interface; package body Implements is procedure Display(this : access Window) is begin -- This dispatches if Implementor is a class-wide type. Display(this.Encloser); end; procedure Resize(this : access Window; Height, Width : Dimension) is begin -- This dispatches if Implementor is a class-wide type. Resize(this.Encloser, Height, Width); end; ... end Implements; end Window_Interface; Note how this approach takes advantage of the flexibilty in generic formal/actual subprogram parameter matching; it allows a type to implement an interface without having exactly matching names for operations. Although creating the generic is a bit tedious, using it, as illustrated above, is fairly clean. That's all for now! -Tuck **************************************************************** !section 12.05(06) !subject renaming semantics and dispatching !reference AI95-00158 !from Erhard Ploedereder 97-05-02 !reference 1997-15748.a Erhard Ploedere 1997-5-4>> !discussion At the Henley meeting, we discussed general changes to the renaming semantics in order to accommodate the desired semantics of the example in the AI. First, for recording reasons only, a train of thought that I started in Henley but that fails to lead to an acceptable solution: The semantics of renaming should be what its name promises, namely the introduction of a new name (and signature) for an existing subprogram, no more, no less. Among other things, this is easy to understand and it explains nicely why subtype constraints in the renaming signature are not enforced. However, this idea is not the way Ada treats renaming and it runs seriously afoul of several existing language rules: 1. renaming declarations are introducing new subprograms in their own right, which, as primitive operations, are inherited and are redefinable independently of the renamed subprogram. 2. Renaming subprograms do not inherit all properties of the renamed subprogram; in particular, unless they are primitive subprogram, calls on them do not dispatch, even if the renamed subprogram is a dispatching operation. (The RM makes that very explicit in 8.5.4(12)). Also, inlining properties are disjoint between renaming and renamed subprogram. .. and many other disjoint properties... The incompatibilities of changing these rules would be much too hard to swallow. End of historical discourse. A more consistent view of a renaming subprogram in Ada is that of a new subprogram whose implicit body performs a call on the renamed subprogram, with the language rules making sure that the "wrapper" body can be inlined away in the case of renaming-as-declarations. I believe that all the Ada semantics of renamed subprograms are consistent with this model. [although the words in 8.5.4 don't use this model, but rather appeal to a "view" model] Using this model, the execution semantics of procedure P(X: T'Class) renames Primitive(X: T); once allowed by the conformance rules for renaming declarations, come out as desired: Calls on P result in a dispatching call on Primitive by direct application of this model. Similarly, in this model procedure P(X: T) renames Primitive(X: T); naturally does not result in a dispatching call of Primitive (and that is the current semantics of renaming). So, by liberalizing the matching rules of renaming, we can accommodate the desired functionality without introducing any noticeable incompatibilites. Note that these rules would apply inside or outside of generics, so that non-generic repackaging of interfaces without losing dispatching properties of operations becomes easier. It appears that this model extends equally naturally to renaming-as-body (although I have problems reconciling the words below with the subtype conformance requirement on renaming-as-body). It remains to be answered, what the liberalized matching rules would actually state. Words of the following nature should suffice: .... mode conformant, except that, in the case of a renamed primitive subprogram of type T, all of the formal parameters of the renaming subprograms corresponding to formal parameters of type T (or of an access type designating T) of the renamed subprogram may also be of type T'Class (or of an access type designating T'Class, respectively). I wonder whether this addition could be absorbed into the definition of mode conformance, in general. I don't see an obvious reason, why this rule shouldn't work for generic formal subprogram association. It really should work and is pretty essential to Tuck's use of the feature. Note, however, that, in contrast to Tuck's examples, the generic formal subprograms would have to have class-wide signatures. I.e., you can't write generic type Implementor(<>) is tagged limited private with procedure Display(this : access Implementor) is <>; with procedure Resize(this : access Implementor; Height, Width : Dimension) is <>; ... package Implements is but must write: generic type Implementor(<>) is tagged limited private with procedure Display(this : access Implementor'Class) is <>; with procedure Resize(this : access Implementor'Class; Height, Width : Dimension) is <>; ... package Implements is and this implies that this works only for generics written specifically for tagged formal types. I.e., you can't make it work for both tagged and untagged types. But, in a way, this makes sense under the contract model. The body really ought to know whether Display is an operation callable with class-wide arguments, which is totally unknown based on the first spec, since the instantiation might send in non-primitive actuals. **************************************************************** From: Gary Dismukes Sent: Tuesday, June 17, 2003 3:36 AM Here's a draft write-up for the long-overdue AI-158. [Editor's note: This is version /02.] I've included the two appendix messages here, since these are referenced in the AI discussion and the details of those messages are important sources for understanding two of the considered alternatives. The AI write-up is rather tentative in its current form, and will need discussion in any case that may well result in a different decision that the proposal, so I didn't attempt to propose specific rule and wording changes in this draft. Pascal, feel free to include this in the agenda or not, as you feel appropriate. It's not a burning issue, but it's been hanging around for so long that we should make an effort to get it off the table in the near future... **************************************************************** From: Tucker Taft Sent: Tuesday, June 17, 2003 8:25 AM > Treat calls to the renaming as equivalent to calls to the > renamed dispatching subprogram, allowing both dispatching > and nondispatching forms of calls. > > This approach falls out of Tucker Taft's proposal involving > 'Class_Only operations (see !appendix for details). However, > that proposal involves a rather significant change to the semantic > model for the primitives of tagged types. To consider such a > fundamental change to the description of dispatching semantics > for the sake of solving this rather limited problem seems > unjustifiable... I didn't actually intend that we would make major changes in the RM to reflect this model. Instead, it would be more like our "design philosophy" annotations. It would help to explain the choices made, but we wouldn't have to "burden" the user with the model itself; only the language lawyers would be aware of it. With the current rules for renaming dispatching operations, they lose their dispatching-ness if they are no longer primitive. But if you call a subprogram and its renaming with exactly the same parameters, it will either be illegal, or do the same thing. What you have proposed here is that if you call a renaming with the same parameters (inside the generic), it is legal but it does something completely different; namely it doesn't dispatch. That seems inconsistent and confusing (or maybe I am confused about your proposal). I don't think we have to introduce the whole "'class-only" model to describe the semantics of these as always dispatching. We could require that they only be given dynamically tagged or tag-indeterminate operands, though that seems like a somewhat separate decision. In any case, it would help to have examples of all 4 alternatives, in particular show *calls* on these renamings, and what are the effects. I think that may make it more clear which alternatives are acceptable. My gut feel is that the one you have chosen will just look too weird when you start looking at calls, both inside and outside the generic. **************************************************************** From: Randy Brukardt Sent: Tuesday, June 17, 2003 4:03 PM > With the current rules for renaming dispatching operations, > they lose their dispatching-ness if they are no longer > primitive. But if you call a subprogram and its renaming > with exactly the same parameters, it will either be illegal, > or do the same thing. Huh? The first sentence says that the renamings may not do the same thing, then the second sentence says that they do. One of these must be wrong! If we have: package P is type T is tagged... procedure Prim (O : in T); -- (Prim1) end P; with P; package Q is type T2 is new P.T with ... procedure Prim (O : in T2); -- (Prim2) end Q; with P, Q; procedure Main is Obj : Q.T2; procedure Ren_Prim (O : in P.T) renames P.Prim; begin P.Prim (P.T'Class(Obj)); -- Dispatches, calls Prim2. Ren_Prim (P.T'Class(Obj)); -- Does not dispatch, calls Prim1. end Main; It's pretty clear that this renaming is legal, and we're calling the same subprogram with the same parameters, and we're getting a completely different result. So, how is Gary's suggestion going to cause things to get more confusing? Nobody has a clue about this as it is. :-) (BTW, this whole issue seems to be unnecessary. The existing blanket legality rules (12.3(11)) clearly covers this, with assume-the-best in the spec and assume-the-worst in the body. There doesn't seem to be any requirement to change the RM for this [there is no "hole"], unless we believe that there is substantial use of this 'feature' caused by buggy compilers. One would expect that some compilers already make this illegal. Thus, I vote for alternative 1 in the absence of some evidence that a change is actually needed.) **************************************************************** From: Gary Dismukes Sent: Tuesday, June 17, 2003 4:32 PM Randy wrote in reply to Tucker: > > > With the current rules for renaming dispatching operations, > > they lose their dispatching-ness if they are no longer > > primitive. But if you call a subprogram and its renaming > > with exactly the same parameters, it will either be illegal, > > or do the same thing. > > Huh? The first sentence says that the renamings may not do the same thing, > then the second sentence says that they do. One of these must be wrong! What Tucker said is correct. They will do the same thing if they're both called with statically tagged operands for example. I'm not sure how important this "do the same thing" property is for resolving this AI, but it's possibly a valid point. > If we have: > > ... > > procedure Main is > Obj : Q.T2; > procedure Ren_Prim (O : in P.T) renames P.Prim; > begin > P.Prim (P.T'Class(Obj)); -- Dispatches, calls Prim2. > Ren_Prim (P.T'Class(Obj)); -- Does not dispatch, calls Prim1. > end Main; > > It's pretty clear that this renaming is legal, and we're calling the same > subprogram with the same parameters, and we're getting a completely > different result. So, how is Gary's suggestion going to cause things to get > more confusing? Nobody has a clue about this as it is. :-) The call to the renaming is illegal in the above, because Ren_Prim isn't primitive, so you can't pass a class-wide argument. > (BTW, this whole issue seems to be unnecessary. The existing blanket > legality rules (12.3(11)) clearly covers this, with assume-the-best in the > spec and assume-the-worst in the body. There doesn't seem to be any > requirement to change the RM for this [there is no "hole"], unless we > believe that there is substantial use of this 'feature' caused by buggy > compilers. One would expect that some compilers already make this illegal. > Thus, I vote for alternative 1 in the absence of some evidence that a change > is actually needed.) I would guess there isn't substantial use of this kind of renaming, but it's currently allowed by GNAT for one. It's hard to guess about this sort of thing, but it wouldn't surprise me if there are users who declare such renamings within a generic (though probably not looking for special class-wide semantics). FWIW, in GNAT the calls to these funny class-wide renamings aren't dispatching. In any case, Tucker raises some points that need discussion, and I agree it would be useful to write out some examples for each of the approaches. Unfortunately, it doesn't look like I'm going to find the time to add more detail to the AI before the meeting. ****************************************************************