Object factory functions

Rationale for Ada 2005: Object oriented model

ENG

6. Object factory functions

@ The Ada 95 Rationale (Section 4.4.1) [2] 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

  1        Root'Class'Output (S, X1);
  2        Root'Class'Output (S, X2);
  3        Root'Class'Output (S, X3);
  4        ...

@ 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

  1        declare
  2                X : Root'Class := Root'Class'Input (S);
  3        begin
  4                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

  1        The_Tag : Ada.Tags.Tag;
  2        A_T1    : T1; -- series of objects of each
  3        A_T2    : T2; -- specific type
  4        A_T3    : T3;
  5        ...
  6        The_Tag := Get_Tag ( ... );    -- get the tag value
  7        if The_Tag = T1'Tag then
  8                A_T1 := Get_T ( ... ); -- get value of specific type
  9                Process (A_T1);        -- process the object
 10        elsif The_Tag = T2'Tag then
 11                A_T2 := Get_T ( ... ); -- get value of specific type
 12                Process (A_T2);        -- process the object
 13        elsif
 14                ...
 15        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 object constructor function. Its specification is

  1        generic
  2                type T (<>) is abstract tagged limited private;
  3                type Parameters (<>) is limited private;
  4                with function Constructor (Params : access Parameters) return T is abstract;
  5        function Ada.Tags.Generic_Dispatching_Constructor
  6                (The_Tag : Tag; Params : access Parameters) return T'Class;
  7        pragma Preelaborate (Generic_Dispatching_Constructor);
  8        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 Pure 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

  1        with procedure Do_This (X1 : TT1; X2 : TT2) is abstract;  -- illegal
  2        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

  1        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

  1        function Make_T is
  2                new Generic_Dispatching_Constructor (Root, Params, Get_T);
  3                ...
  4                declare
  5                        Aux : aliased Params := ... ;
  6                        A_T : Root'Class:= Make_T (Get_Tag ( ... ), Aux'Access);
  7                begin
  8                        Process (A_T); -- dispatch to process the object
  9                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

  1        function Dispatching_Input is
  2                new Generic_Dispatching_Constructor (T, Root_Stream_Type'Class, T'Input);
  3        function T_Class_Input (S : access Root_Stream_Type'Class) return T'Class is
  4                The_String : String := String'Input(S);    -- read tag as string from stream
  5                The_Tag : Tag := Descendant_Tag (The_String, T'Tag);  -- convert to a tag
  6        begin
  7                -- now dispatch to the appropriate function Input
  8                return Dispatching_Input (The_Tag, S);
  9        end T_Class_Input;
 10        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

  1        procedure T_Class_Output (S : access Root_Stream_Type'Class; X : in T'Class) is
  2        begin
  3                if not Is_Descendant_At_Same_Level (X'Tag, T'Tag) then
  4                        raise Tag_Error;
  5                end if;
  6                String'Output (S, External_Tag (X'Tag));
  7                T'Output (S, X);
  8        end T_Class_Output;
  9        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

  1        type Params is null record;
  2        Aux : aliased Params := (null record);

@ Another example can be based on part of the program Magic Moments in [3]. 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

  1        Get (Code_Letter);
  2        case Code_Letter is
  3                when 'C' => Object_Ptr := Get_Circle;
  4                when 'T' => Object_Ptr := Get_Triangle;
  5                when 'S' => Object_Ptr := Get_Square;
  6                ...
  7        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

  1        function Make_Object is
  2                new Generic_Dispatching_Constructor (Object, Params, Get_Object);
  3                ...
  4                S : String := Get_String;
  5                ...
  6                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

  1        with Ada.Tags; use Ada.Tags;
  2        package Tag_Registration is
  3                procedure Register (The_Tag : Tag; Code : Character);
  4                function Decode (Code : Character) return Tag;
  5        end;

@ and then we can write

  1        Register (Circle'Tag, 'C');
  2        Register (Triangle'Tag, 'T');
  3        Register (Square'Tag, 'S');

@ And now the program to read the code and then make the object becomes simply

  1        Get (Code_Letter);
  2        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

  1        Register (Pentagon'Tag, 'P');
  2        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

  1        package body Tag_Registration is
  2                Table: array (Character range 'A' .. 'Z') of Tag := (others => No_Tag);
  3                procedure Register (The_Tag : Tag; Code : Character) is
  4                begin
  5                        Table(Code) := The_Tag;
  6                end Register;
  7                function Decode(Code : Character) return Tag is
  8                begin
  9                        return Table (Code);
 10                end Decode;
 11        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 paper.

@ 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

  1                Trial_Tag : Tag := The_Tag;
  2        loop
  3                if Trial_Tag = T'Tag then exit; end if;
  4                Trial_Tag := Parent_Tag (Trial_Tag);
  5                if Trial_Tag = No_Tag then raise Tag_Error; end if;
  6        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

  1        package Ada.Tags is
  2                pragma Preelaborate (Tags);
  3                type Tag is private;
  4                No_Tag : constant Tag;
  5                function Expanded_Name (T : Tag) return String;
  6                ...  -- also Wide and Wide_Wide versions
  7                function External_Tag (T : Tag) return String;
  8                function Internal_Tag (External : String) return Tag;
  9                function Descendant_Tag (External : String; Ancestor : Tag) return Tag;
 10                function Is_Descendant_At_Same_Level (Descendant, Ancestor : Tag) return Boolean;
 11                function Parent_Tag (T : Tag) return Tag;
 12                type Tag_Array is (Positive range <>) of Tag;
 13                function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
 14                Tag_Error : exception;
 15        private
 16                ...
 17        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!

Rationale for Ada 2005: Object oriented model

@ENGRUSTOPBACKNEXT

6. Функции фабрики объектов

@ Разъяснение для ada (Раздел 4.4.1) [2] говорит "Объектно-ориентированное программирование требует избегать вариантного программирования. Здесь имеется большая трудность в обнаружении, которая особенно очевидна в случае с вводом - выводом; весьма просто написать операцию диспетчеризации вывода, но вообще невозможно это для ввода." В этом контексте вариантное программирование означает иметь дело с неудобными и потенциально опасными операторами выбора и так далее.

@ Проблема ввода-вывода состоит в том, что весьма просто написать гетерогенный файл, но не так просто читать его.

@ В простом случае текстового файла мы легко можем сделать серию операторов Put ("John is "); Put(21, 0); Put(" years old."); Но ввод текста не так прост если мы не знаем порядок элементов в файле. В этом случае, мы должны при чтении каждой строки анализировать её содержимое.

@ Ада 95 включает механизм для того чтобы делать это относительно легко в случае потокового ввода - вывода теговых типов. Предположим что у нас есть класс теговых типов внедренных в Root с различными унаследованными определенными типами T1, T2, и так далее. Тогда мы можем вывести последовательность значений X1, X2, X3 соответствующих типов в файл, идентифицированный ссылкой S:

  1        Root'Class'Output (S, X1);
  2        Root'Class'Output (S, X2);
  3        Root'Class'Output (S, X3);
  4        ...

@ При этом каждый вызов Output сначала пишет тэг определенного типа а затем значение этого типа. Тэг соответствующий типу T1 является строкой External_Tag (T1'Tag). Напомним, что External_Tag - функция в предопределенная в пакете Ada.Tags.

@ При вводе мы делаем следующее:

  1        declare
  2                X : Root'Class := Root'Class'Input (S);
  3        begin
  4                Process (X); -- now process the object in X

@ Вызов Root'Class'Input сначала читает внешний тэг, а затем обращается к соответствующей функции Tn'Input согласно значению тэга. Функция читает значение, которое устанавливается как начальное значение для надклассовой переменной X. Тогда мы можем сделать всё что захотим с X, например, послать в процедуру Process в соответствии с установленным типом.

@ Это нормально работает в Аде 95, но всё это скрыто в реализации. Основные методики к сожалению не доступны для пользователя.

@ Это означает, что если мы хотим разработать наш собственный потоковый протокол или, возможно, только обработать несколько значений при обстоятельствах где мы не можем непосредственно использовать диспетчеризацию, тогда мы должны сделать все это непосредственно условными операторами или операторами выбора. Таким образом, нам надо задать значение тэга и фактическое значение которое будет назначаться переменной соответствующего типа. На Аде 95 мы бы делали это как:

  1        The_Tag : Ada.Tags.Tag;
  2        A_T1    : T1; -- series of objects of each
  3        A_T2    : T2; -- specific type
  4        A_T3    : T3;
  5        ...
  6        The_Tag := Get_Tag ( ... );    -- get the tag value
  7        if The_Tag = T1'Tag then
  8                A_T1 := Get_T ( ... ); -- get value of specific type
  9                Process (A_T1);        -- process the object
 10        elsif The_Tag = T2'Tag then
 11                A_T2 := Get_T ( ... ); -- get value of specific type
 12                Process (A_T2);        -- process the object
 13        elsif
 14                ...
 15        end if;

@ Мы предполагаем, что Get_T - примитивная функция класса, внедренного в Root. Т.е. для каждого определенного типа имеется своя функция Get_T, выбор которой в условных операторах осуществляется во время компиляции по нормальным правилам перегрузки. Здесь процедура Process - примитивная подпрограмма типа класса.

@ Это все очень утомительно и нуждается в постоянном внимании если мы добавляем дальнейшие типы к классу.

@ Ада 2005 преодолевает эту проблему, обеспечивая настраиваемую объектную функцию конструктор со следующей спецификацией:

  1        generic
  2                type T (<>) is abstract tagged limited private;
  3                type Parameters (<>) is limited private;
  4                with function Constructor (Params : access Parameters) return T is abstract;
  5        function Ada.Tags.Generic_Dispatching_Constructor
  6                (The_Tag : Tag; Params : access Parameters) return T'Class;
  7        pragma Preelaborate (Generic_Dispatching_Constructor);
  8        pragma Convention (Intrinsic, Generic_Dispatching_Constructor);

@ Эта настраиваемая функция работает и с ограниченными и неограниченными типами. Напомним, что неограниченный тип разрешается как фактический настраиваемый параметр, соответствующий ограниченному формальному настраиваемому типу. Настраиваемая функция Generic_Dispatching_Constructor есть Pure и имеет соглашение Intrinsic.

@ Обратите внимание на формальную функцию Constructor. Это пример нового вида формального настраиваемого параметра, введенного в Аде 2005. Его отличительная особенность - использование ключегового слова abstract в спецификации. Его интерпретация состоит в том, что фактическая функция должна быть операцией диспетчеризации тегового типа, однозначно определенного конфигурацией формальной функции. Фактическая операция может быть конкретной или абстрактной. Напомним, что правила замены гарантируют, что у определенной операции для любого конкретного типа всегда будет конкретное тело. Отметим, что так как операция абстрактна, её можно вызвать только через диспетчеризацию.

@ В этом примере это должна быть операция диспетчеризации типа T, так как это - единственный теговый тип, вовлеченный в конфигурацию Constructor. Мы говорим, что T - управляемый тип. В общем случае управляемый тип не должен самостоятельно быть формальным параметром универсального модуля, но обычно будет столь здесь. Кроме того, отметим, что хотя операция должна быть операцией диспетчеризации, это не примитив и так, если мы произойдем из типа T то это не будет наследовано.

@ Формальные абстрактные подпрограммы конечно могут быть процедурами так же как и функциями. Важно, что есть точно один управляемый тип в конфигурации. Таким образом, учитывая что TT1 и TT2 теговые типы, тогда следующее было бы незаконно:

  1        with procedure Do_This (X1 : TT1; X2 : TT2) is abstract;  -- illegal
  2        with function Fn (X : Float) return Float is abstract;  -- illegal

@ Процедура Do_This незаконна, потому что у нее есть два управляемых типа TT1 и TT2. Напомним, что мы можем объявить подпрограмму с параметрами больше чем одного тегового типа, но это может быть только операция диспетчеризации одного тегового типа. Функция Fn незаконна, потому что у нее нет никаких управляемых типов вообще (так как она никогда не может быть вызывана в запросе диспетчеризации так или иначе).

@ Формальная функция Constructor правильна, потому что только тип T теговый; Тип Parameters, который также входит в его профиль, не теговый.

@ И теперь возвратимся к конструктору диспетчеризации. Его идея состоитв том, что мы проиллюстрировали настраиваемую функцию с (коревым) теговым типом T и некоторым типом Parameters и функцией Constructor диспетчеризации. Тип Parameters обеспечивает средство, посредством которого вспомогательную информацию можно передать функции Constructor.

@ Настраиваемая функция Generic_Dispatching_Constructor имеет два параметра, первый - тэг типа объекта, который будет создан, а другой вспомогательную информацию, которая передаётся диспетчерской функции Constructor.

@ Отметим, что тип Parameters используется как ссылочный параметр и в настраиваемой функции и в формальной функции Constructor. Это потому для того чтобы это могло быть согласовано конфигурации атрибута Input со спецификацией:

  1        function T'Input (Stream : access Root_Stream_Type'Class) return T;

@ Предположим, что мы проиллюстрировали Generic_Dispatching_Constructor, чтобы дать функцию Make_T. Запрос Make_T берет значение тэга, определённого к соответствующим Constructor, который передаёт значение определенного тегового типа соответствующемуо тэгу и это наконец возвращается как значение надклассового типа T'Class как результат Make_T. Это все еще волшебство, но любой может использовать это волшебство а не только фокусник осуществляющий потоковый ввод - вывод.

@ Мы можем теперь решить свою абстрактную проблему следующим образом:

  1        function Make_T is
  2                new Generic_Dispatching_Constructor (Root, Params, Get_T);
  3                ...
  4                declare
  5                        Aux : aliased Params := ... ;
  6                        A_T : Root'Class:= Make_T (Get_Tag ( ... ), Aux'Access);
  7                begin
  8                        Process (A_T); -- dispatch to process the object
  9                end;

@ У нас больше нет утомительной последовательности условных операторов, и запросы Get_T и Process посылают запросы.

@ Теперь волшебная функция T'Class'Input может быть осуществлена весьма естественным способом:

  1        function Dispatching_Input is
  2                new Generic_Dispatching_Constructor (T, Root_Stream_Type'Class, T'Input);
  3        function T_Class_Input (S : access Root_Stream_Type'Class) return T'Class is
  4                The_String : String := String'Input(S);    -- read tag as string from stream
  5                The_Tag : Tag := Descendant_Tag (The_String, T'Tag);  -- convert to a tag
  6        begin
  7                -- now dispatch to the appropriate function Input
  8                return Dispatching_Input (The_Tag, S);
  9        end T_Class_Input;
 10        for T'Class'Input use T_Class_Input;

@ Тело могло конечно быть написано как один гигантский оператор return Dispatching_Input (Descendant_Tag (String'Input (S), T'Tag), S), но краткая форма здесь более наглядна.

@ Отметим использование Descendant_Tag, а не Internal_Tag.Descendant_Tag - одна из нескольких новых функций, введенных в пакет Ada.Tags в Аде 2005. Потоки не работали идеально с вложенными теговыми типами в Аде 95 из-за возможности множественной элаборации объявлений (в результате управления задачами и рекурсии); это означало, что у двух настраиваемых типов могло быть одно и то же внешнее значение тэга, и Internal_Tag не мог отличить их. Это не самая важная проблема в Аде 95 т.к. вложенные теговые типы там редко используются. В Аде 2005 ситуация потенциально хуже из-за возможности вложенного расширения типа.

@ Цель Ады 2005 проста - гарантировать что потоки действительно работают с типами, объявленными на том же самом уровне и предотвратить ошибочное поведение. Цель не состоит в том, чтобы разрешить потокам работать с вложенными расширениями введенными в Аде 2005. Любая попытка сделать так приведет к возбуждению исключения Tag_Error.

@ Отметим, что мы не можем фактически объявить функцию атрибута, такую как T'Class'Input непосредственно используя название атрибута. Мы должны использовать некоторый другой идентификатор, такой как T_Class_Input и затем использовать выражение определения атрибута как показано выше.

@ Заметим, что T'Class'Output может быть осуществлен как:

  1        procedure T_Class_Output (S : access Root_Stream_Type'Class; X : in T'Class) is
  2        begin
  3                if not Is_Descendant_At_Same_Level (X'Tag, T'Tag) then
  4                        raise Tag_Error;
  5                end if;
  6                String'Output (S, External_Tag (X'Tag));
  7                T'Output (S, X);
  8        end T_Class_Output;
  9        for T'Class'Output use T_Class_Output;

@ Напомним, что потоки спроектированы чтобы работать только с типами, объявленными на том же самом уровне доступности что и родительский тип T. Вызов Is_Descendant_At_Same_Level, который является другой новой функцией в Аде 2005, гарантирует это.

@ Мы можем использовать настраиваемый конструктор для создания нашего собственного потокового протокола. Мы можем фактически заменить T'Class'Input и T'Class'Output или только создать нашу собственную отличную подсистему. Одна причина, почему мы могли бы захотеть использовать другой протокол - это то что у нас имелся бы уже один, например - XML.

@ Отметим, что иногда не будет необходимости передавать какие-либо вспомогательные параметры для функции конструктора, когда мы можем объявить:

  1        type Params is null record;
  2        Aux : aliased Params := (null record);

@ Другой пример может базироваться на программе Magic Moments из [3] в которой читаются значения, необходимые для создания различных геометрических объектов, таких как Круг, Треугольник, или Квадрат, которые получены из абстрактного типа Object. Значениям предшествуют символы 'C', 'T' или 'S' соответственно.

  1        Get (Code_Letter);
  2        case Code_Letter is
  3                when 'C' => Object_Ptr := Get_Circle;
  4                when 'T' => Object_Ptr := Get_Triangle;
  5                when 'S' => Object_Ptr := Get_Square;
  6                ...
  7        end case;

@ Типы Circle, Triangle и Square получены из корневого типа Object, а Object_Ptr ссылочного типа Object'Class. Функция Get_Circle читает значение радиуса с клавиатуры, функция Get_Triangle читает значения длин этих трех сторон с клавиатуры и так далее.

@ Первое необходимое действие состоит в том чтобы изменить различные функции конструктора, такие как Get_Circle в различные определенные замены (overridings) примитивной операции Get_Object так чтобы мы могли послать на этом.

@ Вместо непосредственного чтения кодового знака мы могли бы заставить пользователя печатать внешнюю строку тэга, и затем мы могли бы иметь

  1        function Make_Object is
  2                new Generic_Dispatching_Constructor (Object, Params, Get_Object);
  3                ...
  4                S : String := Get_String;
  5                ...
  6                Object_Ptr := new Object'(Make_Object (Internal_Tag (S), Aux'Access));

@ но это очень утомительно, потому что пользователь теперь должен напечатать внешний тэг, который будет определенной реализацией комбинации символов. Заметим, что строка, произведенная запросом Expanded_Name, такая как OBJECTS.CIRCLE, не может использоваться, потому что она вообще не будет уникальной и, таким образом, нет никакой обратной функции. (Это вообще не уникально из-за управления задачами и рекурсии). Но Expanded_Name полезен для отладочных целей.

@ При этих обстоятельствах лучший способ состоит в том, чтобы изобрести своего рода регистрационную систему, чтобы сделать карту, чтобы преобразовать простые кодовые знаки в тэг. У нас мог бы быть пакет

  1        with Ada.Tags; use Ada.Tags;
  2        package Tag_Registration is
  3                procedure Register (The_Tag : Tag; Code : Character);
  4                function Decode (Code : Character) return Tag;
  5        end;

@ и мы можем написать:

  1        Register (Circle'Tag, 'C');
  2        Register (Triangle'Tag, 'T');
  3        Register (Square'Tag, 'S');

@ И теперь программа упрощается, она сначала читает код а затем создаёт объект

  1        Get (Code_Letter);
  2        Object_Ptr := new Object'(Make_Object (Decode (Code_Letter), Aux'Access));

@ и не нужно городить огород из операторов выбора.

@ Действительно важный пункт об этом примере - то, что, если мы решим позднее добавить ещё типов, таких как 'P' для Pentagon и 'H' для Hexagon тогда всё что мы должны сделать, это зрегистрировать новые кодовые знаки следующим образом:

  1        Register (Pentagon'Tag, 'P');
  2        Register (Hexagon'Tag, 'H');

@ и ничего больше не нужно менять. Эта регистрация может быть удобно сделана, когда типы объявлены.

@ Пакет Tag_Registration мог быть осуществлен тривиально так:

  1        package body Tag_Registration is
  2                Table: array (Character range 'A' .. 'Z') of Tag := (others => No_Tag);
  3                procedure Register (The_Tag : Tag; Code : Character) is
  4                begin
  5                        Table(Code) := The_Tag;
  6                end Register;
  7                function Decode(Code : Character) return Tag is
  8                begin
  9                        return Table (Code);
 10                end Decode;
 11        end Tag_Registration;

@ Константа No_Tag - значение типа Tag, которая не представляет фактический тэг. Если мы забудем регистрировать тип тогда значение No_Tag будет возвращено функцией Decode, и это заставит Make_Object возбуждать исключение Tag_Error.

@ Более изящная регистрационная система могла быть легко осуществлена использованием контейнерной библиотеки, которая будет описана в более поздней статье.

@ Отметим, что любой экземпляр Generic_Dispatching_Constructor проверяет что тэг переданый как параметр действительно является экземпляром типа класса, унаследованного из корневого типа T и возбуждает исключение Tag_Error, если это не так.

@ В простых случаях мы могли фактически представить это как проверку орфографии при написании:

  1                Trial_Tag : Tag := The_Tag;
  2        loop
  3                if Trial_Tag = T'Tag then exit; end if;
  4                Trial_Tag := Parent_Tag (Trial_Tag);
  5                if Trial_Tag = No_Tag then raise Tag_Error; end if;
  6        end loop;

@ Функция Parent_Tag и константа No_Tag - дальнейшие элементы пакета Ada.Tags, спецификация которых в Аде 2005 следущая:

  1        package Ada.Tags is
  2                pragma Preelaborate (Tags);
  3                type Tag is private;
  4                No_Tag : constant Tag;
  5                function Expanded_Name (T : Tag) return String;
  6                ...  -- also Wide and Wide_Wide versions
  7                function External_Tag (T : Tag) return String;
  8                function Internal_Tag (External : String) return Tag;
  9                function Descendant_Tag (External : String; Ancestor : Tag) return Tag;
 10                function Is_Descendant_At_Same_Level (Descendant, Ancestor : Tag) return Boolean;
 11                function Parent_Tag (T : Tag) return Tag;
 12                type Tag_Array is (Positive range <>) of Tag;
 13                function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
 14                Tag_Error : exception;
 15        private
 16                ...
 17        end Ada.Tags;

@ Функция Parent_Tag возвращает No_Tag, если у параметра T типа Tag нет никакого родителя, который будет является окончательным корневым типом класса. Как было упомянуто ранее, две других новых функции Descendant_Tag и Is_Descendant_At_Same_Level необходимы для предотвращения неправильного употребление потоков с типами не объявленными на этом же уровне.

@ Есть также функция Interface_Ancestor_Tags, которая возвращает тэги из всех тех интерфейсов, которые являются предками T как массив. Он включает родителя, если это - интерфейс, прародители и все их предки, которые являются интерфейсами также - но оно исключает тип T непосредственно.

@ Наконец отметим, что введение 16-и 32-разрядных символов в идентификаторах означает, что также должны быть предоставлены функции, чтобы возвратить изображения идентификаторов в формате Wide_String или Wide_Wide_String. Таким образом, у нас есть функции Wide_Expanded_Name и Wide_Wide_Expanded_Name такие же как и Expanded_Name. Нижняя граница строк, возвращаемая этими функциями и External_Tag - 1 (еденица) (в Аде 95 забыли заявить это для External_Tag и Expanded_Name!)

@ ENG RUS

TOP BACK NEXT

2010-10-31 17:15:52

. .