!standard 12.05 (06) 04-12-09 AI95-00158/05 !standard 12.05.01 (21) !class binding interpretation 04-11-13 !comment This is in the Amendment (AARM), but not yet approved. !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. Special considerations apply to functions with a controlling result but no controlling parameters. A rename of one of these raises Program_Error when called. !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 [abstract] tagged ... procedure P(R : Root) [is abstract]; function Empty return Root [is abstract]; 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 raise Program_Error.) !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 would 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). For this reason, such renamings are defined to raise Program_Error. Similarly, if such a primitive is called in a context where the call would not be dispatching (that is, the tag is statically determined to be that of the actual type), Program_Error is raised. This is necessary in the case that the specific type associated with actual type is abstract, and considered safer in the case where the specific type is not abstract, but dispatching semantics is being lost. !wording Add after 12.5.1(21): Dynamic semantics In the case where a formal type is tagged with unknown discriminants, and the actual type is a class-wide type T'Class, each of the primitive operations of the actual type is considered to be a subprogram (with an intrinsic calling convention -- see 6.3) whose body consists of a dispatching call upon the corresponding operation of T, with its formal parameters as the actual parameters. If it is a function, the result of the dispatching call is returned. If the corresponding operation of T has no controlling formal parameters, then the controlling tag value is determined by the context of the call, according to the rules for tag-indeterminate calls (see 3.9.2 and 5.2). In the case where the tag would be statically determined to be that of the actual type, the call raises Program_Error. If such a function is renamed, any call on the renaming raises Program_Error. AARM NOTE: As it states in 6.3(8), the convention of an inherited subprogram of a generic formal tagged type with unknown discriminants is intrinsic. In the case of a corresponding primitive of T with no controlling formal parameters, the context of the call provides the controlling tag value for the dispatch. If no tag is provided by context, Program_Error is raised rather than resorting to a non-dispatching call. For example: generic type NT(<>) is new T with private; -- Assume T has operation "function Empty return T;" package G is procedure Test(X : in out NT); end G; package body G is procedure Test(X : in out NT) is begin X := Empty; -- dispatching takes place, based -- on X'Tag if actual is class-wide declare Y : NT := Empty; -- If actual is class-wide, this -- raises Program_Error as there -- is no tag provided by context. begin X := Y; -- we never get this far end; end Test; end G; type T1 is new T with null record; package I is new G(T1'Class); -- Inside I.Test, no dispatching takes place TBD: See the end of the discussion below. Because the convention is defined to be intrinsic, we could require that the controlling tag be provided by context for the function with no controlling parameters. Not clear whether it is worth it. It seems reasonable that a call of a renaming of such an operation of T'Class should lose its ability to take the controlling tag from context, since a renaming loses the dispatching-ness in general. End AARM NOTE. !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 [abstract] tagged ... procedure P(R : Root) [is abstract]; function Empty return Root [is abstract]; 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 : Pkg.Root'Class) renames P; function Equals(L, R : Pkg.Root'Class) return Boolean renames "="; function My_Empty return Pkg.Root'Class renames Empty; But it would be a challenge 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 "normal" primitive 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). Conclusion 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. We recognize the problem with functions with no controlling parameters, and conclude that when called directly in a context where a controlling tag value is available, they will dispatch. In all other contexts, and in particular when renamed, they will raise Program_Error. This is necessary in the case when a non-dispatching call would go to an abstract function (which is possible if the specific type associated with the actual class-wide type is abstract). We chose to always raise Program_Error, even if the specific type is non-abstract, as this seems to catch a likely error rather than potentially producing misleading or confusing results. Note that because the calling convention is defined as intrinsic, we can require that when called directly as opposed to via a rename, the normal tag-indeterminate rules apply. Shared Generics Implementation Note For implementations that share generics, a natural implementation for formal type extensions is to simply pass in a reference to the type descriptor, i.e. the run-time tag, and use that to make calls on primitive operations inside the (shared) generic body. If the actual is class-wide, it will be necessary to pass in a reference to a pseudo-type descriptor, where the operations identified in the dispatching table are each wrappers, as described above. However, if there are any functions with controlling results but no controlling parameters, the above implementation approach is inadequate, presuming that such functions do not normally take an implicit parameter identifying the controlling tag. The simplest solution is probably to have a flag that indicates that the actual is class-wide, in which case any direct call on such a function with no controlling parameters would first check this flag. If the flag is set, the call would raise Program_Error when there is no controlling tag value provided by context, or would perform a dispatching call using this controlling tag value rather than the (pseudo) type descriptor provided at the point of instantiation. The wrappers provided for such functions in the pseudo type descriptor should always raise Program_Error, as they would only be called in contexts where there is no controlling tag value, such as via a renaming. Expanding the example given in the question section into pseudo-code, assuming a dispatch table is an array of references to executable code, indexed by a "slot" number associated with each primitive operation: package body G is procedure Test(X : in out NT) is begin if Actual_Is_Classwide then X := X'Tag.Dispatch_Table[Empty__Slot_Num].all(); -- dispatching takes place, based -- on X'Tag if actual is class-wide else X := Actual_Dispatch_Table[Empty__Slot_Num].all(); -- Call operation in actual type's dispatch table end if; declare Y : NT := Actual_Dispatch_Table[Empty__Slot_Num].all(); -- If actual is class-wide, the wrapper for Empty -- in the Actual_Dispatch_Table always -- raises Program_Error, as there -- is no tag provided by context. begin Actual_Dispatch_Table[__Assign_Slot_Num](X, Y); -- we never get this far end; end Test; end G; Note that the Actual_Dispatch_Table when the actual is class-wide contains references to the wrappers. A separate "real" Tag must be provided to support uses of NT'Tag, as these are permitted inside such a generic, and are defined to return the tag of the specific type associated with the class-wide type (see 3.9(16)). !ACATS Test An ACATS C-test to insure that a generic can be instantiated with T'Class should be created. The handling of functions with controlled results, and the handling of T'Class where T is abstract should be checked (for whatever resolution we decide). Renaming of such things is thought to be a pathology, so testing that is not intended. !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. **************************************************************** From: Randy Brukardt Sent: Tuesday, September 21, 2004 11:53 AM Thinking about this a bit this morning, I have to wonder if it is worth the effort to define the intended model. It doesn't seem very useful, given new capabilities. In particular, it could be used to define an interface-like generic: but you can use real interfaces for that. It also can be used to get dispatching formal subprograms, but now you can do that explicitly. So it doesn't seem to buy much other than complexity. So I believe that we should at least consider making the problem instantiations illegal. In particular, banning class-wide types as the actual for generic formal derived tagged types seems OK, as the implementation effort and definitional problems seem to outweigh any benefits. As long as class-wide types still can be used to match generic formal private types, a workaround is available. Note that no operations are imported with a generic formal limited private type, and only "=" for the generic formal private type. Any attempt to derive from the formal is either already illegal (because its in the body) or rechecked on instantiation (and thus the instantiation would be illegal if the actual is class-wide, as derivation from class-wide is illegal). The only issue that may need to be addressed is the "=" operator for a generic formal private type, as there is no function "=" (Left, Right : T'Class) return Boolean defined. (That presumes that we didn't address it previously.) **************************************************************** From: Randy Brukardt Sent: Tuesday, September 21, 2004 12:05 PM Although it wasn't my motivation for sending the previous message, I should point out that the dispatching wrapper model is significantly harder to implement in a shared generic, because you have to calculate the tag based on both the formal and the operands (as opposed to just dispatching to the routine identified by the formal's tag). It's certainly possible to do, but hardly seems worth the complication. **************************************************************** From: Tucker Taft Sent: Tuesday, September 21, 2004 3:13 PM I'm not sure I understand what you are proposing. It seems clearly incompatible to disallow instantiation with a class-wide type. I know that works in our compiler, which means it presumably works in Green Hills and Aonix, and I would suspect that some users make use of it. I think the issue is whether the "rename" of the "primitives" of the classwide type is supposed to work. I think we agreed to consider that a pathology. It would still be nice to define what they "should" do in a correct implementation, and even you agreed, I believe, that it should always dispatch. -Tuck P.S. I have attached a simple test case that illustrates the problem. It should print out: Inside Call_Doit Inside Doit for T2 Inside Doit for T2 For what it is worth, our front end prints out: Inside Call_Doit Inside Doit for T2 Inside Doit for T --- package classwide_inst is type T is tagged record X, Y : Integer; end record; procedure Doit(A : T); generic type NT(<>) is new T with private; package gen is procedure Call_Doit(B : NT); procedure Doit_Rename(C : NT) renames Doit; end gen; type T2 is new T with record Z : Integer := 7; end record; procedure Doit(A : T2); -- override end classwide_inst; with Text_IO; use Text_IO; package body classwide_inst is procedure Doit(A : T) is begin Put_Line("Inside Doit for T"); end Doit; procedure Doit(A : T2) is begin Put_Line("Inside Doit for T2"); end Doit; package body gen is procedure Call_Doit(B : NT) is begin Put_Line("Inside Call_Doit"); Doit(B); end call_doit; end gen; end; procedure classwide_inst.test is package Inst is new gen(T'Class); M : T2; begin Inst.Call_Doit(M); Inst.Doit_Rename(M); end; **************************************************************** From: Randy Brukardt Sent: Tuesday, September 21, 2004 3:38 PM > I'm not sure I understand what you are proposing. > It seems clearly incompatible to disallow instantiation > with a class-wide type. I know that works in our compiler, > which means it presumably works in Green Hills and Aonix, > and I would suspect that some users make use of it. Yes, it is incompatible, but since there is no idea of what these routines are supposed to do, it's hard to imagine what the users expect or the compilers do. And there is a workaround when it matters. > I think the issue is whether the "rename" of the "primitives" > of the classwide type is supposed to work. I think we agreed > to consider that a pathology. It would still be nice to > define what they "should" do in a correct implementation, and > even you agreed, I believe, that it should always dispatch. No, that's not the question at all. At least it wasn't my understanding of the result of the discussion. The reason that this AI was not voted No Action and classified as a pathology was because we realized that there we had no idea (based on the standard) of what these (the inherited routine that you're renaming) do. The renames only show the problem. It was felt that the problem was too wide spread to ignore, and once the language explains what the inherited routines do, what the renames do follows naturally and there wouldn't need to be classify anything as a pathology. Now, I realize that you have a strong model in mind for these inherited routines (that they're some sort of dispatching wrapper), and certainly you've been very consistent about that. But there is not a shred of evidence in the RM as to how these are supposed to work - the Standard says that the corresponding subprogram is called, but of course there is no such thing for a class-wide type. My meeting notes say: Tucker would like to clean up this AI, and have a new one to discuss whether this capability should be allowed at all, and what the model would be. 12.5.1(21/1) would need to have a wrapper model that the calls would be dispatching for *all* of the inherited functions. ...which certainly matches what I wrote above. (The part where we decided that this is the same AI seems to be missing; I'll add that to the minutes.) You have to fix the standard to define what these inherited routines do. I'm merely questioning if this capability (passing a class-wide type to a generic formal derived type) is important enough to spend this effort on. I certainly would like to see an example of how it is used before we decided to make Ada harder to implement and probably slower as well. **************************************************************** From: Tucker Taft Sent: Tuesday, September 21, 2004 3:14 PM For historical purposes, I went back to the February 12, 1993 version of the Annotated ARM (version 1.7), and found footnote 991 in section 12.5 on the line: If the formal type is in a class, the actual type must be in that class. [991] The footnote said: 991 -- It is legal to pass a class-wide subtype as the actual if it is in the right class, so long as the formal has unknown discriminants. For what that's worth... **************************************************************** From: Pascal Leroy Sent: Wednesday, September 22, 2004 11:45 AM My favorite compiler rejects the call to Doit_Rename with the message: *** M is not a value/variable of T [RM_95 6.4.1(3)] If I comment out this call, it prints: Inside Call_Doit Inside Doit for T2 **************************************************************** From: Gary Dismukes Sent: Wednesday, September 22, 2004 12:12 PM FWIW, that's also the output of GNAT. **************************************************************** From: Tucker Taft Sent: Wednesday, September 22, 2004 2:21 PM With Apex, GNAT, and AdaMagic all doing the "right" thing with the instantiation, but the "wrong" thing with the rename, it seems like we can safely: 1) continue to allow the instantiation 2) declare the renaming to be pathological We could also disallow the renaming, or make it non-pathological, both of which would require some work on somebody's part. Apparently not many users are relying on "correct" behavior for the renaming. An AARM note, at a minimum, would seem worthwhile. **************************************************************** From: Randy Brukardt Sent: Wednesday, September 22, 2004 5:15 PM I object strongly. It's fair to say that they all do the *same* thing, but there is not justification in the Standard for calling it the *right* thing. At the very least, we need words in the Standard to make it the rule. And we need to vote on that interpretation. Only then could it be the *right* thing. It should be noted that the supposedly right thing is likely to be an accident of implementation with these compilers. A "macro" substitution would probably give a dispatching call. (I do not understand why this doesn't apply to the rename as well.) In our code sharing implementation, it certainly would have given a non-dispatching call had Isaac finished the front-end implementation of this feature. (There were no known problems for the code generation of shared units in this case.) > but the "wrong" thing > with the rename, it seems like we can safely: > 1) continue to allow the instantiation > 2) declare the renaming to be pathological > We could also disallow the renaming, or make it > non-pathological, both of which would require some > work on somebody's part. Apparently not many users are > relying on "correct" behavior for the renaming. > An AARM note, at a minimum, would seem worthwhile. I'm not very comfortable with declaring the renaming to be pathological, and I can see no reason to disallow it. Once we've made the change to the language which requires us to use expensive calls that have to decide at run-time whether they are dispatching or not (which will be a big headache for us, and for virtually no user benefit), I don't see any reason to let the rest of you off the hook vis-a-vis the renaming (which user could use, even though it is unlikely). The net effect of this ruling for us would be to lower the implementation priority of formal tagged derived types from 2nd to about 20th, because of adding a giant new cost that didn't exist in the past. (Other than in Tucker's head.) If we're going to declare anything pathological, it should be the class-wide instantiation. (But I wouldn't be in favor of that, either.) **************************************************************** From: Tucker Taft Sent: Wednesday, September 22, 2004 6:28 PM To support this in a shared-generic implementation, I would think you would need to generate an additional "dispatch" table for T'Class, containing wrappers for each primitive which would "redispatch" to the appropriate overriding. You can then make "nondispatching" calls to these primitives and I believe you would get the right behavior. If such instantiations are in fact rare, then generating such a table at the point of instantiation seems acceptable. This is admittedly some work, but the result would seem to be reasonably efficient, without any distributed overhead if no such instantiations exist. **************************************************************** From: Randy Brukardt Sent: Wednesday, September 22, 2004 6:49 PM Tucker said: > To support this in a shared-generic implementation, > I would think you would need to generate an additional > "dispatch" table for T'Class, containing wrappers > for each primitive which would "redispatch" to the > appropriate overriding. You can then make "nondispatching" > calls to these primitives and I believe you would get > the right behavior. Now I'm even more confused. I've never understood the "wrapper" description; I've always presumed it was needed to explain the existence of routines that don't otherwise exist. But all of the wrapper does is dispatch in the normal way. Why shouldn't the call just be dispatching in place? Perhaps you missed my explanation of the existing code to implement this feature. (It's untested, because Isaac never wrote the derivation code for the operations, but it's fully implemented in my part of the compiler. We did fully implement generic private tagged types, and there is little difference other than these inherited operations.) Essentially, a call to one of those operations inherited from the formal part is implemented as a dispatching call through the tag of the actual type. I would think that the best approach to implementing these would be to simply make a normal dispatching call vis-a-vis calculating the tag, and then replacing the tag with the tag of the actual if the actual is a specific type. Then the call is just a normal dispatching call if the actual is class-wide. But I'd have to know the *real* model of these inherited routines before I can be sure whether that is right or not. The main reason that I'm frustated here is that I'll have to completely replace the existing code, and it doesn't seem to be for a case of much value in Ada 2005 (given interfaces and "is abstract" formals). This of course isn't the first such place in Ada 2005, so I'll try to shut up on this topic. :-) > If such instantiations are in fact rare, then generating > such a table at the point of instantiation seems acceptable. > > This is admittedly some work, but the result would seem > to be reasonably efficient, without any distributed overhead > if no such instantiations exist. Well, I suppose that generating a "tag" of wrappers would work, but I worry that that would cause trouble in some other place where the tag is used (such as the result of 'Tag, where it would be incorrect.) **************************************************************** From: Gary Dismukes Sent: Thursday, September 23, 2004 12:45 AM > But all of the wrapper does is dispatch in the normal way. Why shouldn't the > call just be dispatching in place? Because there's a difference in treatment between the specific and class-wide cases in that the class-wide case requires dispatching based on the controlling operands. > Essentially, a call to > one of those operations inherited from the formal part is implemented as a > dispatching call through the tag of the actual type. > > I would think that the best approach to implementing these would be to > simply make a normal dispatching call vis-a-vis calculating the tag, and > then replacing the tag with the tag of the actual if the actual is a > specific type. Then the call is just a normal dispatching call if the actual > is class-wide. But I'd have to know the *real* model of these inherited > routines before I can be sure whether that is right or not. The question is where you get the tag from in the two cases. If the actual type is specific, then you want to use the tag of that actual type, whereas if the actual type is class-wide, then you want to use the tag of the dynamically tagged operand(s) of the call. As I understand it, Tucker's suggestion is to create a dispatching table for the class-wide case consisting of the addresses of wrappers, and then to use the actual type's dispatching table in all cases for calls within the instance. It's not entirely clear to me how your approach is intended to work, but it sounds like you'd have to have conditional code to determine which tag to use, whereas the idea of the wrapper model is to make the code for the call uniform and transparent, with no need for any conditional code in the shared generic (just index the table and pass the actuals). But perhaps I'm misunderstanding your model without wrappers. Be that as it may, I believe there are problems with the wrapper model, both in terms of a semantic description and for an implementation (at least for shared generics). The basic difficulty I see is for tag-indeterminate calls. Consider a call such as: P (F, X); where P is a primitive procedure with two controlling operands, F is a primitive function with controlling result, and X is an object of the formal type. Ostensibly this appears to be a case where the function call is a tag-indeterminate call that should get its tag from X (in the case where the actual type is class-wide). In the model with wrappers that simply dispatch based on their class-wide formals (if any), this seems to create a problem. In general, how does a function wrapper get knowledge of the tag to use for dispatching? If a call is simply made to the function F in the actual's dispatch table, then it will return a result of the class-wide actual's corresponding specific type, which will lead to an exception on the tag check if X has a different tag, contrary to normal dispatching behavior on such calls. As it happens, that's exactly the behavior that happens with GNAT on a call such as that (that is, when the actual type is class-wide). Offhand I don't see how to cleanly address this issue in the context of wrapper-based semantics. (This can probably be managed without that much difficulty in inlined implementations, but it seems more of a problem for shared generics.) It could get it via an extra parameter, but that extra parameter is not normally present for the nonwrapper function primitives, so the signatures wouldn't match between wrappers and the corresponding normal primitive functions. I'm also not clear on how a semantic model based on wrappers would be described, since a wrapper (a la renaming-as-body semantics) wouldn't seem to have any way of knowing what the controlling tag is in general. Perhaps there's a way out of this by clever wording of the rules, but it seems tricky to make this work right. This is the concern I've had with respect to alternative 4 in the AI, and is the main reason I have misgivings about the wrapper approach for the semantics of calls to renamings (and the same concern applies to calls to the ancestor primitives). On the other hand, I suppose that tag-indeterminate cases like the above could be declared pathological. Maybe that wouldn't be a big loss since such calls tend to be uncommon, but that doesn't seem very satisfying. > Well, I suppose that generating a "tag" of wrappers would work, but I worry > that that would cause trouble in some other place where the tag is used > (such as the result of 'Tag, where it would be incorrect.) It doesn't seem that implementing 'Tag would be much of an issue, since the tag of the actual type can simply be passed through to the shared generic as a separate parameter (being the specific root's tag in the case of a class-wide type). But the tag-indeterminate call case does appear to be a context with potential tag-related difficulties. **************************************************************** From: Tucker Taft Sent: Thursday, September 23, 2004 7:31 AM Thanks for explaining my suggestion more clearly ;-). Functions with only a controlling result are definitely painful. A similar problem shows up in our Ada => Java-byte-code compiler (AppletMagic). We had to add a "hidden" parameter to such functions. We ended up creating a "default" instance of each tagged type, and passing that in when there wasn't any other object available. I believe this may require something similar. That is, if there is another object in the context of the call which determines the tag, then pass that one in. If not, then pass in the "default" instance. The default instance could be an additional (hidden) parameter to the shared generic, or it could be located at a fixed offset within a dispatch table. **************************************************************** From: Randy Brukardt Sent: Thursday, September 23, 2004 12:02 PM Gary wrote: > It's not entirely clear to me how your approach is intended to work, > but it sounds like you'd have to have conditional code to determine > which tag to use, whereas the idea of the wrapper model is to make the > code for the call uniform and transparent, with no need for any conditional > code in the shared generic (just index the table and pass the actuals). > But perhaps I'm misunderstanding your model without wrappers. No, that's the idea. Having a short conditional in each call tree (which would compile to three instructions) seems preferable to using wrappers that don't quite work right. That's especially true since the existing (incomplete) implementation is to always dispatch thru the statically determined tag (no thunks passed in). It's a natural extension to that. Using wrappers seems like it would lead to code bloat; I think the small distributed overhead is preferable. (And, it is much more amenable to elimination by partial evaluation than the thunks would be.) ... > On the other hand, I suppose that tag-indeterminate cases like the above > could be declared pathological. Maybe that wouldn't be a big loss since > such calls tend to be uncommon, but that doesn't seem very satisfying. Yes, dispatching in Ada is always of a (sub)tree of calls, not necessarily a single call. But that feature seems to be rarely used (although that is how the Dispatching_Constructor will work, and how T'Class'Input does work). That's why I've generally avoiding using wrappers for tagged types (except as part of defining the tag). **************************************************************** From: Robert Dewar Sent: Wednesday, September 22, 2004 5:50 PM I have a general question. I still see Randy making frequent references to the fully shared generic model. I am dubious that this is a valid concern. Are there any full featured Ada 95 compilers using this approach? I think not. I would propose that this is no longer an overriding criterion. We paid quite a price in the Ada 95 design for specific vendors making specific special pleading (help, I use displays, I can't deal with funargs properly, for example). And in retrospect some of the compilers on which these pleas were based never even materialized. I am all in favor of considering current implementations, but I think this needs to be tempered! **************************************************************** From: Tucker Taft Sent: Wednesday, September 22, 2004 5:50 PM > I have a general question. I still see Randy making frequent > references to the fully shared generic model. I am dubious > that this is a valid concern. Are there any full featured > Ada 95 compilers using this approach? I think not. I believe Irvine has a "full featured" Ada 95 compiler that uses full generic sharing. I know they were looking around for some way to get validated without paying a fee to the ACAA. ... > I am all in favor of considering current implementations, > but I think this needs to be tempered! I think with Irvine and RR still using full generic sharing, we should continue to consider it. And it often identifies issues that turn out to be problems with non-generic sharing implementations. **************************************************************** From: Dan Eilers Sent: Wednesday, September 22, 2004 6:41 PM Our Ada95 compiler is fully featured, and supports both macro-expanded and shared-body generic models (determined by a pragma). We pass all the ACATS 2.5 tests in the macro mode, and pass all the Ada83 ACVC tests in the shared mode, but have restrictions on use of shared mode with most Ada95-specific features. Our shared mode uses a single body for all instantiations, but works somewhat differently than Randy's, so his concerns don't necessarily apply to our compiler. **************************************************************** From: Randy Brukardt Sent: Wednesday, September 22, 2004 7:12 PM There are a number of answers to this as there really are several separate issues posed. First of all, I try only to bring up generic sharing in cases where most or all sharing is at risk from a change, not specifically "universal sharing". I believe that we've agreed that we want to continue to allow compilers to support some form of generic sharing, and its important that that is considered whenever we change the rules. In this particular case, the generic sharing issue is only secondary, and not a major impediment. I brought it up mainly because it ought to be one of the points considered in decided what the "correct" behavior is. I fully expect that it will be ignored in this particular context. My tone probably was more strident than it needed to be, because of the frustration I feel with Tucker essentially ignoring what I see as the primary issue -- that there is no model for these operations that is written anywhere. We need to fix that first before it pays to worry about any corner cases. In general, we haven't had to put in many rules specifically for generic sharing. Most of the rules I've lobbied for have turned out to be necessary in order that the legality rules of the language are enforced. (For instance, static accessibility checks for access-to-subprograms in generic bodies, abstract routine checks for derivation from formal types in generic bodies, etc.) We've changed several rules over my (mild) objections, which is fine -- that's the process. And I certainly agree that we shouldn't base too much on "special pleadings" -- and that applies to *every* implementer. There also have been several cases where my concerns have helped us to look deeper for a better solution. And it often has been the case that we've found a better solution that everyone has been happier with. AI-359 is just the most recent example of that result. But the point of e-mail discussion (and meeting discussion, for that matter) is to insure that all of the facts are considered. That certainly includes generic sharing issues, and I'm the most likely person to mention these issues. Of course I'll put the discussion into the terms of the Janus/Ada compiler, but that's just a specific example of a general issue that usually applies to any generic sharing. > I still see Randy making frequent > references to the fully shared generic model. I am dubious > that this is a valid concern. Are there any full featured > Ada 95 compilers using this approach? I think not. The other question this raises is rather personal. This is essentially saying that you don't think that the implementation approaches of Janus/Ada are relevant. I realize I'm biased, but I think that that would set a dangerous precedent. It would be very easy to extend that to Dan Eiler's compiler (which I know supports some form of generic sharing), to OCS, and so on. Certainly, Janus/Ada is a "current implementation", given that we do sell and support it. Indeed, I sold a copy today and was working on that when your note came in. I would probably have put much more time into the compiler if I wasn't so busy working on ARG tasks. And that seems to be true of the other implementations I named as well. In any case, the number of Ada implementations is small enough that we shouldn't be ignoring any one of them. At the very least, we need to consider all of the implementation concerns and make informed decisions. Blindly ignoring an implementation could easily lead us into blindly ignoring real problems with the rules. I would find it difficult to do my job as editor of the Standard if I wasn't allowed to draw on my personal knowledge of implementation issues. Of course, those aren't the same as any other implementation, but we've proven that no two implementations are much alike in their approach. Janus/Ada may be a bit more different than others, but it isn't *that* different. I don't think we want to be forcing people out of the ARG process just because some don't like their implementation approaches. And I certainly think that we don't want to be adopting new rules which are guaranteed to reduce the number of implementations available. **************************************************************** From: Robert Dewar Sent: Wednesday, September 22, 2004 7:25 PM Randy Brukardt wrote: > First of all, I try only to bring up generic sharing in cases where most or > all sharing is at risk from a change, not specifically "universal sharing". > I believe that we've agreed that we want to continue to allow compilers to > support some form of generic sharing, and its important that that is > considered whenever we change the rules. Yes, I agree with this approach certainly > > In this particular case, the generic sharing issue is only secondary, and > not a major impediment. I brought it up mainly because it ought to be one of > the points considered in decided what the "correct" behavior is. I fully > expect that it will be ignored in this particular context. OK, but that's not exactly consistent with paragraph one! > I don't think we want to be forcing people out of the ARG process just > because some don't like their implementation approaches. And I certainly > think that we don't want to be adopting new rules which are guaranteed to > reduce the number of implementations available. Well now I am puzzled, I thought Janus Ada relied on universal sharing, but if so, then that appears to be inconsistent with the philosophy of paragraph one, which I agree with above. If we make a change in Ada 2005 that forbids generic sharing in a particular case, that would mean that Janus/Ada would have to implement non-shared generics for some cases. OK, that may be a big job, but there are many big jobs in implementing the Ada 2005 stuff. For example, in GNAT, we had a heck of a time implementing all the junk (pardon the language) features in the fancy Unchecked_Union, features which we remain convinced are close to 100% useless :-), and Interfaces are likely to require substantial work in all compilers **************************************************************** From: Robert A. Duff Sent: Wednesday, September 22, 2004 7:31 PM Robert Dewar says: > I have a general question. I still see Randy making frequent > references to the fully shared generic model. I am dubious > that this is a valid concern. I support the idea that Ada should be friendly toward shared-generic-bodies implementations as a matter of principle. The language has always supported that (to some extent), and we shouldn't make it worse in that regard (IMHO). **************************************************************** From: Randy Brukardt Sent: Wednesday, September 22, 2004 9:25 PM Robert Dewar wrote: > > I don't think we want to be forcing people out of the ARG process just > > because some don't like their implementation approaches. And I certainly > > think that we don't want to be adopting new rules which are guaranteed to > > reduce the number of implementations available. > > Well now I am puzzled, I thought Janus Ada relied on universal sharing, > but if so, then that appears to be inconsistent with the philosophy of > paragraph one, which I agree with above. > > If we make a change in Ada 2005 that forbids generic sharing in a > particular case, that would mean that Janus/Ada would have to > implement non-shared generics for some cases. OK, that may be > a big job, but there are many big jobs in implementing the > Ada 2005 stuff. ... Certainly, I understand this. I expect interfaces and limited with to be very large jobs, and I'm sure that there are others. But the standard forbidding generic sharing in a particular case hasn't happened yet, and I don't think that it is very likely - what is *impossible* for universal sharing is *impossible* for any generic sharing. What is *hard* for universal sharing is a different issue, and people have not been shy in showing a work-around and telling me to shut up. :-) To make sure that we are talking about the same thing, I define "generic sharing" as "sharing the body of a generic between more than one instantiation based on (at most) the actual parameters and the contents of the specification". If you have to examine the body in order to determine if sharing is possible, then you have an "as-if" optimization that does not require any language support (much like inline). With the above definition, the needs of "partial sharing" and "universal sharing" are pretty much the same. Impossible or near-impossible things are generally restricted to the generic body. Anything in the actuals or spec can be modeled with variable values, thunks, or (worst case) an enumeration controlling multiple code paths. The only issue is that "universal sharing" requires a bit more work/code since we don't have the option of separate bodies in the uglier cases. But at worst the issue is one of performance, not of impossibility. Note that having behavior that differs markedly based on the actual is also a usability issue. Such behavior can make it much harder to reason about the behavior of a piece of generic code, and thus can make it harder to write and debug generic code. So those sorts of issues need to be considered carefully, irrespective of their impact on sharing. **************************************************************** From: Robert Dewar Sent: Wednesday, September 22, 2004 10:20 PM > Certainly, I understand this. I expect interfaces and limited with to be > very large jobs, and I'm sure that there are others. But the standard > forbidding generic sharing in a particular case hasn't happened yet, and I > don't think that it is very likely - what is *impossible* for universal > sharing is *impossible* for any generic sharing. What is *hard* for > universal sharing is a different issue, and people have not been shy in > showing a work-around and telling me to shut up. :-) Sure, we are not talking about impossible ever. After all, one implementation of shared generics is to create a shared generic that works by building the instantiation on the fly by macro insertion and compiling it on the fly. Yes, that's absurd, but it's just one end of a very long spectrum. > To make sure that we are talking about the same thing, I define "generic > sharing" as "sharing the body of a generic between more than one > instantiation based on (at most) the actual parameters and the contents of > the specification". If you have to examine the body in order to determine if > sharing is possible, then you have an "as-if" optimization that does not > require any language support (much like inline). You could perfectly well defer the compilation of generic bodies till link time. That's a perfectly valid implementation approach, and actually for generic sharing, not a bad one. **************************************************************** From: Tucker Taft Sent: Wednesday, September 22, 2004 8:26 AM There was no need to delve into ancient history for this. The current AARM includes at least two annotations that mention this: 3.9(16.a): Reason: S'Class'Tag equals S'Tag, to avoid generic contract model problems when S'Class is the actual type associated with a generic formal derived type. 12.5(7.d): It is legal to pass a class-wide subtype as the actual if it is in the right class, so long as the formal has unknown discriminants. S'Class'Class is also permitted for a reason analogous to that given in 3.9(16.a). It is unfortunate that 12.5.1(21/1, 21.a) didn't spell out more precisely what was to happen when the actual was class-wide. **************************************************************** From: Randy Brukardt Sent: Wednesday, September 22, 2004 11:55 AM This is the crux of the matter. There is no indication from the wording as to what these routines mean, as there is no "corresponding primitive subprogram" for a class-wide actual (class-wide types have no primitive subprograms). Moreover, although I see an intent that class-wide actuals are intended (and, indeed, I remember that from the Ada 9x process), there seems to be nothing explaining what they mean. So one could debate that. Presuming there is nothing wrong with the implementation I described, I'd suggest that we simply describe these as dispatching calls (without trying to lean on wrappers that don't work, as Gary has pointed out). That seems to be less confusing to the user (the semantics are as a macro-substitution would be, which is generally the intent). And, from the sound of things, it would spread the pain enough that I wouldn't have to feel picked upon! :-) :-) ****************************************************************