Rationale for Ada 2005

John Barnes
Table of Contents   Index   References   Search   Previous   Next 

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 exitend 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!

Table of Contents   Index   References   Search   Previous   Next 
© 2005, 2006 John Barnes Informatics.
Sponsored in part by:
The Ada Resource Association and its member companies: ARA Members AdaCore Polyspace Technologies Praxis Critical Systems IBM Rational Sofcheck and   Ada-Europe:
Ada-Europe