Итак, 14 июня вышла наконец долгожданная версия GNAT GPL 2011.
Много улучшений, новая версия самой IDE (теперь это версия 5.0.1, вместо 4.3.1 из 2009-ой версии, и 4.4.1 из 2010), мне нравится больше, чем прежняя, одна возможность фильтрации результатов компиляции чего стОит (хотя это вроде было и в 2010, но мне сравнивать не с чем, я сразу перешел 2009 -> 2011, поэтому все нововведения будут относительно предпоследней версии).
Что говорит официальная страничка (комментарии - мои):
Улучшенная поддержка А2012 (да, это - главная причина, по которой я обновился. Теперь есть возможность использовать все те фичи, которые на настоящий момент утверждены для нового стандарта, а не просто наблюдать сообщение, что это будет доступно в 2012 году, как было в прежней версии GNAT. Это и "in out" параметры для функций, и условные выражения, и Case-выражения, работают Quantified expressions, дискриминанты для лимитированных тэговых типов, Pre/Post-условия, и многое другое из того, что уже внесено в окончательную редакцию стандарта)
Улучшенные версии (GPS 5.0 - расширенная поддержка С/С++, более мощный редактор, повышенное юзабилити, GtkAda - новые виджеты, интерфейс к граф. библиотеке Cairo). (От себя добавлю, что в редакторе наконец-то сделали выпадающий список Pragma, и список атрибутов типа: Нажмите для просмотра прикрепленного файлаНажмите для просмотра прикрепленного файла )
Более гибкий и эффективный менеджер проектов
Поддержка выгрузки плагинов
Улучшенная поддержка конструкций на .NET-платформе
Более детальные сообщения об исключениях (при использовании ключа -gnateE)
полная поддержка платформы Lego Mindstorms NXT, включая аудио и I2C-сенсоры (об этом есть ролик на youtube, англ.: вот он)
Как видно, много народу хочет попробовать новую среду/новый компилятор - я скачивал пакет размером 140Мб почти 12 часов, скорость иногда падала до 2-3Кб/сек. Но сейчас с этим вроде справились.
TarasBer
21.07.2011 19:22
Дизассемблер работает? Кстати, где-то был полный список новых возможностей языка на русском, я потерял. Правда JIT-компиляции там так и нет...
IUnknown
22.07.2011 0:19
Цитата
Дизассемблер работает?
Всегда работал, и в 2009 и в 2010 Pro, 2011 - в обоих версиях работает прекрасно, и в Pro и в GPL.
Цитата
где-то был полный список новых возможностей языка на русском, я потерял. Правда JIT-компиляции там так и нет...
Какое отношение JIT/AOT имеет к возможностям языка - непонятно... В лучшем случае - возможности компилятора.
TarasBer
22.07.2011 9:41
> Всегда работал, и в 2009 и в 2010 Pro, 2011 - в обоих версиях работает прекрасно, и в Pro и в GPL.
Странно, что же у меня не то... А про стандарт есть что почитать?
Спойлер(Показать/Скрыть)
> Какое отношение JIT/AOT имеет к возможностям языка - непонятно...
Я не про то, что в джаве, не про формат исполняемого файла. Я про возможность на ходу составлять новые функции. Я вот писал ту программу, что графики строит, у меня функция хранится в виде АСТ-дерева, и при каждом вычислении значения прогоняется АСТ-дерево, это не очень удобно. Если бы язык давал возможности для генерации кода, то не пришлось бы делать лишние вычисления для каждой точки.
В Фортране, Алголе, Паскале, Си/Си++ и прочих "хороших и разных" клонах (включая Бейсик) самомодификация возможна лишь теоретически - путем варварской правки машинного кода в оперативной памяти. Почему "варварской"? Да потому, что язык к этому не имеет никакого отношения, более того - самомодификация опирается на недокументированные возможности языка, закладываясь на логику конкретных трансляторов, что чревато развалом программы при переходе на другой компилятор, не говоря уже о том, что машинный код – штука, понятная лишь небольшому кругу избранных, но даже Великий Гуру не сможет написать самомодифицирующуюся программу, работающую более чем на одном процессоре.
И про Джаву (что это не то, что я сейчас имею в виду):
Цитата
правда, если быть честными, Java не предоставляет для самомодификации никаких языковых средств и программисту приходится работать с низкоуровневыми командами чтения/записи памяти
Как я это примерно вижу?
type IntFunc is access function (L,R: integer) return integer;
function AddIntFunc(L, R: IntFunc) return IntFunc is begin return new IntFunc'( function (x,y: integer) return integer is begin return L(x,y)+R(x,y); end; ); end;
e: IntFunc := AddIntFunc("/"'access, "*"'access); -- выделяется память в куче, помечается как запускаемая, там создаётся тело функции, возвращающей L/R+L*R. Если ты считаешь, что это решается шаблонами, то покажи, как АСТ-дерево из моей программы переделать в функцию (x:f80) return f80; У шаблонной функции, локально определённой в блоке, проблема примерно в том, что её нельзя передать вне этого блока.
Или:
function Smth(a,b,c,d,e: integer); -- какая она - неважно
e: IntFunc := new IntFunc'( Smth(1, <>, 3, x*y, <>); ); -- тут создаётся функция из 2 параметров, полученная подстановкой в неё 3 оставшихся, тело функции оптимизируется (по ходу выполнения, если подставляемые параметры - не константы). Ингда часто приходится вызывать ключевую функцию с почти одним и тем же набором параметров. Как реализовать - вшиванием в программу компилятора и кода Smth в удобном для оптимизации виде
Для примера возьмем известную всем функцию: двоичный поиск. Реализация ее тривиальна:
procedure Main is
subtype Item_Type is Integer; type Some_Array is array(Integer range <>) of Item_Type;
function Binary_Search(Arr : Some_Array; Value : Item_Type) return Integer is Right, Left : Integer; n : Integer; begin Left := Arr'First; Right := Arr'Last; while Right - Left > 1 loop n := (Right + Left) / 2; if Value <= Arr(n) then Right := n; else Left := n; end if; end loop;
if Value = Arr(Left) then return Left; elsif Value = Arr(Right) then return Right; else return -1; end if; end Binary_Search;
begin Ada.Text_IO.Put_Line(Integer'Image(Binary_Search(Arr => A, Value => 8))); end Main;
Все прекрасно и удивительно, правда? Но есть одно маленькое несоответствие: дело в том, что для корректной работы Binary_Search нужно, чтобы массив был упорядоченным, а у меня никак упорядоченность массива не проверяется. Что делать? Писать функцию проверки упорядоченности, и вызывать ее перед поиском? Можно и так. Но в новом Стандарте есть более интересный способ: предусловие + Quantified Expression. Итак, ставим предварительное условие: массив, переданный как параметр, должен быть упорядочен. Делается это так:
function Binary_Search(Arr : Some_Array; Value : Item_Type) return Integer is pragma Precondition(Arr'Length < 2 or else (for all i in Arr'First .. Integer'Pred(Arr'Last) => Arr (I) <= Arr (Integer'Succ (I))));
Right, Left : Integer; n : Integer; begin -- ...
И теперь, если передаваемый в функцию массив неупорядочен - будет выброшено исключение.
(for all i in Arr'First .. Integer'Pred(Arr'Last) => Arr (I) <= Arr (Integer'Succ (I)))
дословно означает следующее: проверить все значения i от Arr'First до Arr'Last - 1, и убедиться, что для всех этих значений выполняется заданное условие: предыдущий элемент массива не больше следующего.
Но не всегда надо проверять все значения в заданном интервале. Скажем, пишется функция/процедура, которая должна получать на вход составное число (не простое, а то, которое имеет делители). Тогда достаточно проверить наличие хотя бы одного делителя:
procedure P (N : Integer) is pragma Precondition(for some X in 2 .. N / 2 => N mod X = 0); i : Integer; begin -- Тут работаем с числом end P;
Теперь проверяются уже не все, а некоторые из значений. Как только одно из значений выдаст True - дальше проверять не нужно...
2. AI-0128 Inequality is a primitive operation(Показать/Скрыть)
Если для некоего типа описан оператор сравнения ("="), то неявно определенный оператор неравенства ("/=") будет являться примитивной операцией.
Пример:
package P1 is -- ... здесь описан какой-то тип R и оператор "=" для него end P1;
-- ...
package body P2 is procedure Proc(X, Y : P1.R) is B : Boolean; use type P1.R; begin B := (X = Y); -- Легальная операция B := (X /= Y); -- Проблема ... end Proc; end P2;
Проблема заключается в том, что "use type" делает видимыми только примитивные операции над типами. Согласно Стандарту, "=" - это примитивная подпрограмма, следовательно, операция тоже будет примитивной. Но ничего подобного не было сказано о неявно определяемом операторе "/=". Теперь неявный оператор "/=" тоже будет примитивным, следовательно проблемы, описанной выше, когда use type подключает "равенство", но не подключает "неравенство", не будет.
P.S. В принципе, GNAT всегда это делал, но теперь это будет прописано и в Стандарте.
3. AI-0008 General access to constrained objects(Показать/Скрыть)
Если у вас есть общий доступ к ограниченным объектам, это может быть использовано для изменения дискриминанты. Такое поведение недопустимо, должна быть выброшена ошибка Constraint_Error. Пример:
type Rec (D : Boolean := False) is record case D is when False => I : aliased Integer; when True => C : Character; end case; end record; type Acc_Rec is access all Rec;
-- Теперь попробуем сделать вот такое присваивание: Acc_R.all := (D => True, C => 'X');
Здесь изменяется дискриминант объекта с косвенным доступом, что недопустимо.
P.S. GNAT всегда отслеживал подобную ситуацию.
4. AI-0214 Defaulted discriminants for limited tagged(Показать/Скрыть)
В Ада 2005 лимитированные теговые типы (включая Задачи и защищенные типа, унаследованные от интерфейсов) не могут иметь значения по умолчанию для дискриминанта.
В Ада 2012 это ограничение будет снято, и limited tagged-типы смогут иметь дефолтное значение дискриминанта.
5. AI-0102 Some implicit conversions are illegal(Показать/Скрыть)
В A2012 подобное присваивание будет запрещаться явно, в Стандарте 2005 года не было пункта, запрещающего такое присваивание.
P.S. GNAT-компилятор всегда генерировал ошибку в подобных случаях.
6. Preconditions/Postconditions(Показать/Скрыть)
Что это такое? Это дополнительное средство отладки программ. Допустим, я пишу функцию, которая должна принимать положительное число, и возвращать отрицательное. Ну, размуеется это не просто смена знака, но факт остается фактом: я точно знаю, что моя функция не должна получать отрицательных чисел на вход, и что возвращать положительных результатов она тоже не должна. Что делаем?
function My_Func(A : Float) return Float; pragma Precondition (A >= 0.0); pragma Postcondition (My_Func'Result < 0.0);
Теперь если запустить программу на выполнение и передать ей на вход отрицательное число, то получим вылет по Precondition, с указанием места, где не выполнилось условие (то есть, работают эти фичи подобно Assert-у). Если же в моей подпрограмме что-то не так, и она даже на правильных входных значениях выдаст неверный результат, то я получу уже вылет по Postcondition. И тогда мне пора искать ошибку в своей функции.
Также вводится новый атрибут: 'Old - позволяющий обращаться к предыдущему (до выполнения процедуры/функции) значению параметра. Например:
procedure Write_Result (Total_Results : in out Integer); pragma Postcondition (Total_Results > Total_Results'Old);
Если постусловие не выполнилось - значит, есть какая-то проблема в процедуре.
Появилась возможность использовать if/then/else, а также case-селектор в выражениях:
procedure P (B : Boolean) is Int_Var : Integer := (if B then 1 else 2); begin -- ... end P;
function F (First, Second : String) return String is begin -- ... end F;
String_Var := F (if Bool_Var then "One" else "Two", if not Bool_Var then "Two" else "One");
В случае Case:
Days := (case Month is when 4 | 6 | 9 | 11 => 30, when 2 => 28, when others => 31);
Да, да, я знаю, что надо учитывать еще и високосность. Это просто пример...
8. In-out parameters for functions(Показать/Скрыть)
Снято ограничение на использование in out параметров в функциях (в предыдущих версиях компилятора in out параметры можно было использовать только в процедурах)
Насчет второй части вопроса - чуть позже...
TarasBer
22.07.2011 10:59
По пункту 1 - фича интересная, правда пока её применение слишком узкое. Ну вот поиск какого-нибудь ненулевого элемента в массиве с её помощью организовать можно? Чтобы она не только сообщала о наличии такого элемента, но и возвращала индекс.
По пункту 7 - как-то конструкцию обрезали, не хватает end if и end case, единообразия нету. В качестве операторных скобок сделали круглые.
IUnknown
22.07.2011 12:04
Цитата
Ну вот поиск какого-нибудь ненулевого элемента в массиве с её помощью организовать можно?
Внимательно название фичи прочел? Quantified expressions - это вообще-то кванторы. То есть, предусловие для определения упорядоченности выглядит практически так:
(∀x ∈ Arr'Range) P(x) , где P - предикат "Arr(i - 1) меньше Arr(i)"
Это высказывание может быть истинным или ложным. Можешь написать высказывание, которое будет определять, есть ли в массиве ненулевой элемент, и кроме этого возвращать его индекс?
TarasBer
22.07.2011 12:45
> Внимательно название фичи прочел? Quantified expressions - это вообще-то кванторы.
Ну мало ли. То есть нельзя, понятно.
> Можешь написать высказывание, которое будет определять, есть ли в массиве ненулевой элемент, и кроме этого возвращать его индекс?
Через костыли могу.
j: integer; b: boolean; pragma unreferenced(b);
function Set(Index: integer) return boolean is begin if Mas[Index].Valid then j := Index; end if; return Mas[Index].Valid; end;
b := for some i in Mas'Range => Set(integer(i));
Да, порядок обхода не гарантирован, но в j вернётся любой индекс нужного элемента.
Сразу скажу насчет зачем понадобилось описывать функции Plus и Mult, почему бы не сделать "+"'Access и "*"'Access - потому что prefix of "Access" attribute cannot be intrinsic. Вот такое ограничение в языке...
Цитата
Через костыли могу.
Костыли можно чуть-чуть выпрямить:
function Just_Test (arr : Vector; Index : in out Integer) return Boolean is
function Is_Valid (i : Integer) return Boolean is begin return b : Boolean := arr (i) /= 0 do if b then Index := i; end if; end return; end Is_Valid;
begin Index := -1; return (for some i in arr'Range => Is_Valid (i)); end Just_Test;
TarasBer
25.07.2011 9:46
По пункту 5 - то есть раньше стандарт разрешал через указатель менять константу?! Странно, что только сейчас исправили.
По поводу кода, я пытаюсь его осмыслить. Я решил поэкспериментировать, насколько большую свободу даёт эта возможность:
A,B,C: access function (L, R : Integer) return Integer;
begin A := Second_Order (Plus'Access, Mult'Access); B := Second_Order (Plus'Access, Div'Access); C := Second_Order (A, B);
Ограничений пока не вижу. Если так, то надо попробовать рисовалку графиков с этой фичей переписать, сравнить, насколько будет быстрее.
Так вот, у меня вопрос. Что представляют собой объекты A,B,C? Простого указателя на функцию для их представления явно недостаточно, то есть в них также сидит и информация о параметрах, с которыми конструировали функцию. Каково, например, время жизни этих параметров?
TarasBer
25.07.2011 13:34
В общем, решил я проверить скорость "лямбда-функций". Результаты оказались удручающие. По скорости они оказались ничуть не лучше, чем АСТ-дерево, а "байткоду", сделанному в формате массив данных вида "указатель на операцию, на левый аргумент, на правый аргумент, на результат", они сливают в два раза. Необходимость использовать в случаях, в которых важно время, такой массив очень неприятна - генерация этого массива из АСТ-дерева не так проста, как генерация лямбда-функции, а условные операторы очень геморны.
Самое плохое, на самом деле не это. Самое плохое тут то, что этот код работает только при полной оптимизации, иначе... переполнение стека (ОТКУДА):
Спойлер(Показать/Скрыть)
with Ada.Text_IO; use Ada.Text_IO; with Ada.Real_Time; use Ada.Real_Time;
procedure Test is
type TCommand is record proc: access function (l,r : integer) return integer; arg1, arg2, res: access integer; end record;
function Add (l,r : integer) return integer is begin return l+r; end; function Sub (l,r : integer) return integer is begin return l-r; end; function Mul (l,r : integer) return integer is begin return l*r; end;
Commands : array (1 .. 8) of TCommand;
function Ret_Const (c: integer) return access function return integer is function Inner_Func return integer is begin return c; end; begin return Inner_Func'Unrestricted_Access; end;
function Ret_Add ( l, r: access function return integer ) return access function return integer is function Inner_Func return integer is begin return Add(l.all, r.all); end; begin return Inner_Func'Unrestricted_Access; end;
function Ret_Sub ( l, r: access function return integer ) return access function return integer is function Inner_Func return integer is begin return Sub(l.all, r.all); end; begin return Inner_Func'Unrestricted_Access; end;
function Ret_Mul ( l, r: access function return integer ) return access function return integer is function Inner_Func return integer is begin return Mul(l.all, r.all); end; begin return Inner_Func'Unrestricted_Access; end;
Funcs : array (1 .. 17) of access function return Integer;
type TNodeKind is (nkConst, nkAdd, nkSub, nkMul);
type TNode is record Kind : TNodeKind; Value : integer; L, R : access TNode; end record;
Nodes : array (1 .. 17) of aliased TNode;
function Get_Value (T: TNode) return Integer is begin case T.Kind is when nkConst => return T.Value; when nkAdd => return Add (Get_Value (T.L.all), Get_Value (T.R.all)); when nkSub => return Sub (Get_Value (T.L.all), Get_Value (T.R.all)); when nkMul => return Mul (Get_Value (T.L.all), Get_Value (T.R.all)); end case; end;
T: Time; Times: constant integer := 10_000_000;
begin -- вычисляем непосредственно -- 0.00 сек T := Clock; for j in 1 .. Times loop Data(17) := Sub ( Add (Sub (Add (7, 8), Mul (5,6)), Mul (48,2)), Mul (3, Add (6, 9))); end loop; Put_Line (Duration'Image (To_Duration (Clock - T)));
T := Clock; for j in 1 .. Times loop for i in Commands'Range loop Commands(i).res.all := Commands(i).proc(Commands(i).arg1.all, Commands(i).arg2.all); end loop; end loop; Put_Line (Duration'Image (To_Duration (Clock - T)));
T := Clock; for j in 1 .. Times loop Data(17) := Get_Value(Nodes(17)); end loop; Put_Line (Duration'Image (To_Duration (Clock - T)));
end Test;
Сверху вниз выводится время выполнения простого вычисления (я как мог старался его писать так, чтобы компилятор не сделал замену), выполнения массива указателей на процедуры, выполнения лямбда-функции, выполнения прохода по АСТ-дереву. Выводится примерно так:
Код
0.00ещё нули 1.30 2.60 2.50
Жаль, что генерация таких функций не использует подстановку в на ходу генерирующийся код, скорость бы выросла в разы. Для выполнения пользовательских скриптов это очень важно.
Добавлено через 2 мин. Кстати, мне непонятно ограничение, запрещающее брать указатель от встроенных функций. Компилятор не может сам сделать то, что мы делаем руками - функцию-прокладку?
IUnknown
26.07.2011 13:10
Цитата
Самое плохое, на самом деле не это. Самое плохое тут то, что этот код работает только при полной оптимизации, иначе... переполнение стека
Самое плохое - это то, что на некоторых ОСях это вообще работает, хотя не должно. Мне, скажем, под Debian-ом, не удалось заставить твою программу работать ни при каких настройках. Вообще, в Аде очень странное понятие "замыкания", откуда все эти проблемы и происходят. Как будет побольше времени - напишу подробнее о том, что делать можно, а чего нельзя, и как поступать в том случае, когда нельзя, но очень хочется...
IUnknown
27.07.2011 2:05
Ну, вот такой пример отрабатывает в любом режиме, не только при полной оптимизации, надо будет только подумать, как запихать инициализацию пакета и получение из него Ret_Const в отдельную функцию:
Код(Показать/Скрыть)
with Ada.Text_IO; use Ada.Text_IO; with Ada.Real_Time; use Ada.Real_Time; with IntPack; with FuncPack;
procedure Test is
package P1 is new IntPack(7); Fs01 : access function return Integer := P1.Ret_Const; package P2 is new IntPack(8); Fs02 : access function return Integer := P2.Ret_Const; package P3 is new IntPack(5); Fs03 : access function return Integer := P3.Ret_Const; package P4 is new IntPack(6); Fs04 : access function return Integer := P4.Ret_Const; package P5 is new IntPack(48); Fs05 : access function return Integer := P5.Ret_Const; package P6 is new IntPack(2); Fs06 : access function return Integer := P6.Ret_Const; package P7 is new IntPack(3); Fs07 : access function return Integer := P7.Ret_Const; package P8 is new IntPack(6); Fs08 : access function return Integer := P8.Ret_Const; package P9 is new IntPack(9); Fs09 : access function return Integer := P9.Ret_Const;
package P10 is new FuncPack("*", Fs03, Fs04); Fs10 : access function return Integer := P10.Second_Order; package P11 is new FuncPack("*", Fs05, Fs06); Fs11 : access function return Integer := P11.Second_Order; package P12 is new FuncPack("+", Fs08, Fs09); Fs12 : access function return Integer := P12.Second_Order; package P13 is new FuncPack("*", Fs07, Fs12); Fs13 : access function return Integer := P13.Second_Order; package P14 is new FuncPack("+", Fs01, Fs02); Fs14 : access function return Integer := P14.Second_Order; package P15 is new FuncPack("-", Fs14, Fs10); Fs15 : access function return Integer := P15.Second_Order; package P16 is new FuncPack("+", Fs15, Fs11); Fs16 : access function return Integer := P16.Second_Order; package P17 is new FuncPack("-", Fs16, Fs13); Fs17 : access function return Integer := P17.Second_Order;
type TNodeKind is (nkConst, nkAdd, nkSub, nkMul);
type TNode is record Kind : TNodeKind; Value : integer; L, R : access TNode; end record;
Nodes : array (1 .. 17) of aliased TNode;
function Add (l,r : integer) return integer is begin return l+r; end; function Sub (l,r : integer) return integer is begin return l-r; end; function Mul (l,r : integer) return integer is begin return l*r; end;
function Get_Value (T: TNode) return Integer is begin case T.Kind is when nkConst => return T.Value; when nkAdd => return Add (Get_Value (T.L.all), Get_Value (T.R.all)); when nkSub => return Sub (Get_Value (T.L.all), Get_Value (T.R.all)); when nkMul => return Mul (Get_Value (T.L.all), Get_Value (T.R.all)); end case; end;
type TCommand is record proc: access function (l,r : integer) return integer; arg1, arg2, res: access integer; end record; Commands : array (1 .. 8) of TCommand; Data : array (1 .. 17) of aliased integer := (7, 8, 5, 6, 48, 2, 3, 6, 9, others => <>);
T: Time; Times: constant integer := 10_000_000;
begin -- вычисляем непосредственно -- 0.00 сек T := Clock; for j in 1 .. Times loop Data(17) := Sub ( Add (Sub (Add (7, 8), Mul (5,6)), Mul (48,2)), Mul (3, Add (6, 9))); end loop; Put_Line ("Plain => " & Duration'Image (To_Duration (Clock - T)));
T := Clock; for j in 1 .. Times loop Data(17) := Fs17.all; end loop; Put_Line ("Fs => " & Duration'Image (To_Duration (Clock - T)));
T := Clock; for j in 1 .. Times loop for i in Commands'Range loop Commands(i).res.all := Commands(i).proc(Commands(i).arg1.all, Commands(i).arg2.all); end loop; end loop; Put_Line ("Commands => " & Duration'Image (To_Duration (Clock - T))); end Test;
, но все равно скорость лямбд выше чем у ACT-дерева больше чем в полтора раза...
Теперь еще один вопрос: ты говорил, что у тебя сборка Optimize работала. А ты проверял, оно правильно считало (я про лямбды, разумеется)? Там точно получалось 36? Вообще, очень странно, если уж работать - то должно было как раз в дебаге, оптимизированная сборка наоборот не должна была отработать...
TarasBer
27.07.2011 9:40
> А ты проверял, оно правильно считало (я про лямбды, разумеется)? Там точно получалось 36?
Да, точно. А при отладочной сборке облом наступал при первой же попытке вычислить значение первого же Ret_Const.
И я не могу точно назвать все комбинации галочек, которые дают выполняющийся код. Просто их в среде слишком много (перекинуть проект из отладочного в оптимизированный надо нажать 20 галочек на 3 вкладках, как вы работаете? Может у вас есть фирменная строка в gpr-файле, позволяющая перекидывать изменением одной директивы?).
Так что можно написать баг-репорт.
> package P1 is new IntPack(7); > надо будет только подумать, как запихать инициализацию пакета и получение из него Ret_Const в отдельную функцию:
Я вот тоже не уверен насчёт того, что я смогу на пакетах, инициализируемых локально, создать экземпляр функции, который я смогу сохранить в глобальный объект. К тому же предполагается, что порядок действий и значение констант должны как бы вводиться пользователем, то есть порядок инициализации пакетов не должен быть мёртво вшит в код. Например, для моего варианта хоть порядок создания функций и задан руками, но я могу спокойно запихать создание функций в условный оператор, сделать массив функций итд. А массив пакетов создать я не могу.
(И да, тему о всяких замыканиях, кажется, надо отделить).
IUnknown
28.07.2011 19:17
Цитата
К тому же предполагается, что порядок действий и значение констант должны как бы вводиться пользователем, то есть порядок инициализации пакетов не должен быть мёртво вшит в код. Например, для моего варианта хоть порядок создания функций и задан руками, но я могу спокойно запихать создание функций в условный оператор, сделать массив функций итд.
В таком случае - только вот это:
with Ada.Text_IO; use Ada.Text_IO; with Ada.Real_Time; use Ada.Real_Time;
procedure Test is
type Arity is (Unary_Function, Binary_Function);
type Rec; type Rec_Ptr is access all Rec;
type Rec (R : Arity) is limited record Self : Rec_Ptr := Rec'Unchecked_Access; f : access function (This : Rec_Ptr) return Integer;
case R is when Unary_Function => Value : Integer; when Binary_Function => Left : Rec_Ptr; Right : Rec_Ptr; when others => null; end case;
end record;
-- Это будет та самая Ret_Const function fun (This : Rec_Ptr) return Integer is begin return This.Value; end fun;
-- А это - любая из "+", "-", "*" generic with function f (L, R : Integer) return Integer; function bfun (This : Rec_Ptr) return Integer;
function bfun (This : Rec_Ptr) return Integer is L : Rec_Ptr := This.Left; R : Rec_Ptr := This.Right; begin -- Это выполняется дольше -- return f(This.Left.f(This.Left.Self), This.Right.f(This.Right.Self));
-- Это - быстрее. return f(L.f(L.Self), R.f(R.Self)); end bfun;
function Create_Unary(Value : Integer) return Rec_Ptr is begin return Result : Rec_Ptr := new Rec'(R => Unary_Function, Self => <>, f => fun'Access, Value => Value) do null; end return; end Create_Unary;
type BinFunc is access function (This : Rec_Ptr) return Integer; function Create_Binary(bf : BinFunc; L, R : Rec_Ptr) return Rec_Ptr is begin return Result : Rec_Ptr := new Rec'(R => Binary_Function, Self => <>, f => bf, Left => L, Right => R) do null; end return; end Create_Binary;
function add_bfun is new bfun(f => "+"); function sub_bfun is new bfun(f => "-"); function mul_bfun is new bfun(f => "*");
Fs : array(1 .. 17) of Rec_Ptr; IntValue : Integer; begin