Rationale for Ada 2005
2.6 Object factory functions
The Ada 95 Rationale (
Section
4.4.1)
[7] says "We also note
that object oriented programming requires thought especially if variant
programming is to be avoided. There is a general difficulty in finding
out what is coming which is particularly obvious with input–output;
it is easy to write dispatching output operations but generally impossible
for input." In this context, variant programming means messing about
with case statements and so on.
The point about input–output
is that it is easy to write a heterogeneous file but not so easy to read
it. In the simple case of a text file we can just do a series of calls
of Put thus
Put ("John is "); Put(21, 0); Put(" years old.");
But text input is not so easy unless we know the
order of the items in the file. If we don't know the order then we really
have to read the wretched thing a line at a time and then analyse the
lines.
Ada 95 includes a mechanism for doing this relatively
easily in the case of tagged types and stream input–output. Suppose
we have a class of tagged types rooted at Root
with various derived specific types T1, T2
and so on. We can then output a sequence of values X1,
X2, X3 of a variety
of these types to a file identified by the stream access value S
by writing
Root'Class'Output(S, X1);
Root'Class'Output(S, X2);
Root'Class'Output(S, X3);
...
The various calls first write the tag of the specific
type and then the value of the type. The tag corresponding to the type T1 is the string External_Tag(T1'Tag).
Remember that External_Tag is a function in
the predefined package Ada.Tags.
On input we can reverse
the process by writing something like
declare
X: Root'Class := Root'Class'Input(S);
begin
Process(X); -- now process the object in X
The call of Root'Class'Input
first reads the external tag and then dispatches to the appropriate function
Tn'Input according to the value of the tag.
The function reads the value and this is now assigned as the initial
value to the class wide variable X. We can
then do whatever we want with X by perhaps
dispatching to a procedure Process which deals
with it according to its specific type.
This works in Ada 95 but it is all magic and done
by smoke and mirrors inside the implementation. The underlying techniques
are unfortunately not available to the user.
This means that if
we want to devise our own stream protocol or maybe just process some
values in circumstances where we cannot directly use dispatching then
we have to do it all ourselves with if statements or case statements.
Thus we might be given a tag value and separately some information from
which we can create the values of the particular type. In Ada 95 we typically
have to do something like
The_Tag: Ada.Tags.Tag;
A_T1: T1; -- series of objects of each
A_T2: T2; -- specific type
A_T3: T3;
...
The_Tag := Get_Tag( ... ); -- get the tag value
if The_Tag = T1'Tag then
A_T1 := Get_T( ... ); -- get value of specific type
Process(A_T1); -- process the object
elsif The_Tag = T2'Tag then
A_T2 := Get_T( ... ); -- get value of specific type
Process(A_T2); -- process the object
elsif
...
end if;
We assume that Get_T is
a primitive function of the class rooted at Root.
There is therefore a function for each specific type and the selection
in the if statements is made at compile time by the normal overload rules.
Similarly Process is also a primitive subprogram
of the class of types.
This is all very tedious and needs careful maintenance
if we add further types to the class.
Ada 2005 overcomes
this problem by providing a generic constructor function. The objective
of this is to create an object given the value of its tag. Such functions
are often called object factory functions for obvious reasons (the word
factory is derived from the Latin facere, to make). The specification
of the function is
generic
type T (<>) is abstract tagged limited private;
type Parameters (<>) is limited private;
with function Constructor(Params: not null access Parameters)
return T is abstract;
function Ada.Tags.Generic_Dispatching_Constructor
(The_Tag: Tag; Params: not null access Parameters) return T'Class;
pragma Preelaborate(Generic_Dispatching_Constructor);
pragma Convention(Intrinsic, Generic_Dispatching_Constructor);
This generic function works for both limited and
nonlimited types. Remember that a nonlimited type is allowed as an actual
generic parameter corresponding to a limited formal generic type. The
generic function Generic_Dispatching_Constructor
is preelaborable and has convention Intrinsic.
Note carefully the formal function Constructor.
This is an example of a new kind of formal generic parameter introduced
in Ada 2005. The distinctive feature is the use of is abstract
in its specification. The interpretation is that the actual function
must be a dispatching operation of a tagged type uniquely identified
by the profile of the formal function. The actual operation can be concrete
or abstract. Remember that the overriding rules ensure that the specific
operation for any concrete type will always have a concrete body. Note
also that since the operation is abstract it can only be called through
dispatching.
In this example, it therefore has to be a dispatching
operation of the type T since that is the
only tagged type involved in the profile of Constructor.
We say that T is the controlling type. In
the general case, the controlling type does not itself have to be a formal
parameter of the generic unit but usually will be as here. Moreover,
note that although the operation has to be a dispatching operation, it
is not primitive and so if we derive from the type T,
it will not be inherited.
Formal abstract subprograms
can of course be procedures as well as functions. It is important that
there is exactly one controlling type in the profile. Thus given that
TT1 and TT2 are
tagged types then the following would both be illegal
with procedure Do_This(X1: TT1; X2: TT2) is abstract; -- illegal
with function Fn(X: Float) return Float is abstract; -- illegal
The procedure Do_This
is illegal because it has two controlling types TT1
and TT2. Remember that we can declare a subprogram
with parameters of more than one tagged type but it can only be a dispatching
operation of one tagged type. The function Fn
is illegal because it doesn't have any controlling types at all (and
so could never be called in a dispatching call anyway).
The formal function Constructor
is legal because only T is tagged; the type
Parameters which also occurs in its profile
is not tagged.
And now to return to the dispatching constructor.
The idea is that we instantiate the generic function with a (root) tagged
type T, some type Parameters
and the dispatching function Constructor.
The type Parameters provides a means whereby
auxiliary information can be passed to the function Constructor.
The generic function
Generic_Dispatching_Constructor
takes two parameters, one is the tag of the type of the object to be
created and the other is the auxiliary information to be passed to the
dispatching function
Constructor.
Note that the type
Parameters is used as an access parameter
in both the generic function and the formal function Constructor.
This is so that it can be matched by the profile of the attribute Input
whose specification is
function T'Input(Stream: access Root_Stream_Type'Class) return T;
Suppose we instantiate Generic_Dispatching_Constructor
to give a function Make_T. A call of Make_T
takes a tag value, dispatches to the appropriate Constructor
which creates a value of the specific tagged type corresponding to the
tag and this is finally returned as the value of the class wide type
T'Class as the result of Make_T.
It's still magic but anyone can use the magic and not just the magician
implementing stream input–output.
We can now do our abstract
problem as follows
function Make_T is
new Generic_Dispatching_Constructor(Root, Params, Get_T);
...
declare
Aux: aliased Params := ... ;
A_T: Root'Class:= Make_T(Get_Tag( ... ), Aux'Access);
begin
Process(A_T); -- dispatch to process the object
end;
We no longer have the tedious sequence of if statements
and the calls of Get_T and Process
are dispatching calls.
The previously magic
function T'Class'Input can now be implemented
in a very natural way by something like
function Dispatching_Input is
new Generic_Dispatching_Constructor(T, Root_Stream_Type'Class, T'Input);
function T_Class_Input(S: access Root_Stream_Type'Class) return T'Class is
The_String: String := String'Input(S); -- read tag as string from stream
The_Tag: Tag := Descendant_Tag(The_String, T'Tag); -- convert to a tag
begin
-- now dispatch to the appropriate function Input
return Dispatching_Input(The_Tag, S);
end T_Class_Input;
for T'Class'Input use T_Class_Input;
The body could of course
be written as one giant statement
return Dispatching_Input(Descendant_Tag(String'Input(S), T'Tag), S);
but breaking it down hopefully clarifies what is
happening.
Note the use of
Descendant_Tag
rather than
Internal_Tag.
Descendant_Tag
is one of a few new functions introduced into the package
Ada.Tags
in Ada 2005. Streams did not work very well for nested tagged types in
Ada 95 because of the possibility of multiple elaboration of declarations
(as a result of tasking and recursion); this meant that two descendant
types could have the same external tag value and
Internal_Tag
could not distinguish them. This is not an important problem in Ada 95
as nested tagged types are rarely used. In Ada 2005 the situation is
potentially made worse because of the possibility of nested type extension.
The goal in Ada 2005 is simply to ensure that streams
do work with types declared at the same level and to prevent erroneous
behaviour otherwise. The goal is not to permit streams to work with the
nested extensions introduced in Ada 2005. Any attempt to do so will result
in Tag_Error being raised.
Note that we cannot actually declare an attribute
function such as T'Class'Input by directly
using the attribute name. We have to use some other identifier such as
T_Class_Input and then use an attribute definition
clause as shown above.
Observe that T'Class'Output
can be implemented as
procedure T_Class_Output(S: access Root_Stream_Type'Class; X: in T'Class) is
begin
if not Is_Descendant_At_Same_Level (X'Tag, T'Tag) then
raise Tag_Error;
end if;
String'Output(S, External_Tag(X'Tag));
T'Output(S, X);
end T_Class_Output;
for T'Class'Output use T_Class_Output;
Remember that streams are designed to work only with
types declared at the same accessibility level as the parent type T.
The call of Is_Descendant_At_Same_Level, which
is another new function in Ada 2005, ensures this.
We can use the generic constructor to create our
own stream protocol. We could in fact replace T'Class'Input
and T'Class'Output or just create our own
distinct subsystem. One reason why we might want to use a different protocol
is when the external protocol is already given such as in the case of
XML.
Note that it will sometimes
be the case that there is no need to pass any auxiliary parameters to
the constructor function in which case we can declare
type Params is null record;
Aux: aliased Params := (null record);
Another example can
be based on part of the program Magic Moments in
[6].
This reads in the values necessary to create various geometrical objects
such as a
Circle,
Triangle,
or
Square which are derived from an abstract
type
Object. The values are preceded by a
letter C, T or S as appropriate. The essence of the code is
Get(Code_Letter);
case Code_Letter is
when 'C' => Object_Ptr := Get_Circle;
when 'T' => Object_Ptr := Get_Triangle;
when 'S' => Object_Ptr := Get_Square;
...
end case;
The types Circle, Triangle,
and Square are derived from the root type
Object and Object_Ptr
is of the type access Object'Class.
The function Get_Circle reads the value of
the radius from the keyboard, the function Get_Triangle
reads the values of the lengths of the three sides from the keyboard
and so on.
The first thing to do is to change the various constructor
functions such as Get_Circle into various
specific overridings of a primitive operation Get_Object
so that we can dispatch on it.
Rather than just read
the code letter we could make the user type the external tag string and
then we might have
function Make_Object is
new Generic_Dispatching_Constructor(Object, Params, Get_Object);
...
S: String := Get_String;
...
Object_Ptr := new Object'(Make_Object(Internal_Tag(S), Aux'Access));
but this is very tedious
because the user now has to type the external tag which will be an implementation
defined mess of characters. Observe that the string produced by a call
of Expanded_Name such as
OBJECTS.CIRCLE
cannot be used because it will not in general be
unique and so there is no reverse function. (It is not generally unique
because of tasking and recursion.) But Expanded_Name
is useful for debugging purposes.
In these circumstances the best way to proceed is
to invent some sort of registration system to make a map to convert the
simple code letters into the tag. We might have a package
with Ada.Tags; use Ada.Tags;
package Tag_Registration is
procedure Register(The_Tag: Tag; Code: Character);
function Decode(Code: Character) return Tag;
end;
and then we can write
Register(Circle'Tag, 'C');
Register(Triangle'Tag, 'T');
Register(Square'Tag, 'S');
And now the program
to read the code and then make the object becomes simply
Get(Code_Letter);
Object_Ptr := new Object'(Make_Object(Decode(Code_Letter), Aux'Access));
and there are no case statements to maintain.
The really important
point about this example is that if we decide at a later date to add
more types such as 'P' for Pentagon
and 'H' for Hexagon
then all we have to do is register the new code letters thus
Register(Pentagon'Tag, 'P');
Register(Hexagon'Tag, 'H');
and nothing else needs changing. This registration
can conveniently be done when the types are declared.
The package Tag_Registration
could be implemented trivially as follows by
package body Tag_Registration is
Table: array (Character range 'A' .. 'Z') of Tag := (others => No_Tag);
procedure Register(The_Tag: Tag; Code: Character) is
begin
Table(Code) := The_Tag;
end Register;
function Decode(Code: Character) return Tag is
begin
return Table(Code);
end Decode;
end Tag_Registration;
The constant No_Tag is
a value of the type Tag which does not represent
an actual tag. If we forget to register a type then No_Tag
will be returned by Decode and this will cause
Make_Object to raise Tag_Error.
A more elegant registration system could be easily
implemented using the container library which will be described in a
later chapter (see
8).
Note that any instance of Generic_Dispatching_Constructor
checks that the tag passed as parameter is indeed that of a type descended
from the root type T and raises Tag_Error
if it is not.
In simple cases we could in fact perform that check
for ourselves by writing something like
Trial_Tag: Tag := The_Tag;
loop
if Trial_Tag = T'Tag then exit; end if;
Trial_Tag := Parent_Tag(Trial_Tag);
if Trial_Tag = No_Tag then raise Tag_Error; end if;
end loop;
The function Parent_Tag
and the constant No_Tag are further items
in the package Ada.Tags whose specification
in Ada 2005 is
package Ada.Tags is
pragma Preelaborate(Tags);
type Tag is private;
pragma Preelaborable_Initialization(Tag);
No_Tag: constant Tag;
function Expanded_Name(T: Tag) return String;
... -- also Wide and Wide_Wide versions
function External_Tag(T: Tag) return String;
function Internal_Tag(External: String) return Tag;
function Descendant_Tag(External: String; Ancestor: Tag)
return Tag;
function Is_Descendant_At_Same_Level(Descendant, Ancestor: Tag) return Boolean;
function Parent_Tag(T: Tag) return Tag;
type Tag_Array is (Positive range <>) of Tag;
function Interface_Ancestor_Tags(T: Tag) return Tag_Array;
Tag_Error: exception;
private
...
end Ada.Tags;
The function Parent_Tag
returns No_Tag if the parameter T
of type Tag has no parent which will be the
case if it is the ultimate root type of the class. As mentioned earlier,
two other new functions Descendant_Tag and
Is_Descendant_At_Same_Level are necessary
to prevent the misuse of streams with types not all declared at the same
level.
There is also a function Interface_Ancestor_Tags
which returns the tags of all those interfaces which are ancestors of
T as an array. This includes the parent if
it is an interface, any progenitors and all their ancestors which are
interfaces as well – but it excludes the type T
itself.
Finally note that the introduction of 16- and 32-bit
characters in identifiers means that functions also have to be provided
to return the images of identifiers as a Wide_String
or Wide_Wide_String. So we have functions
Wide_Expanded_Name and Wide_Wide_Expanded_Name
as well as Expanded_Name. The lower bound
of the strings returned by these functions and by External_Tag is 1 – Ada 95 forgot
to state this for External_Tag and Expanded_Name!
© 2005, 2006 John Barnes Informatics.
Sponsored in part by: