GNAT 2011, (с поддержкой многих фич стандарта А2012) Опции

[IUnknown]

Итак, 14 июня вышла наконец долгожданная версия GNAT GPL 2011.

Много улучшений, новая версия самой IDE (теперь это версия 5.0.1, вместо 4.3.1 из 2009-ой версии, и 4.4.1 из 2010), мне нравится больше, чем прежняя, одна возможность фильтрации результатов компиляции чего стОит (хотя это вроде было и в 2010, но мне сравнивать не с чем, я сразу перешел 2009 -> 2011, поэтому все нововведения будут относительно предпоследней версии).

Что говорит официальная страничка (комментарии - мои):

1. Улучшенная поддержка А2012 (да, это - главная причина, по которой я обновился. Теперь есть возможность использовать все те фичи, которые на настоящий момент утверждены для нового стандарта, а не просто наблюдать сообщение, что это будет доступно в 2012 году, как было в прежней версии GNAT. Это и "in out" параметры для функций, и условные выражения, и Case-выражения, работают Quantified expressions, дискриминанты для лимитированных тэговых типов, Pre/Post-условия, и многое другое из того, что уже внесено в окончательную редакцию стандарта)
2. Улучшенные версии (GPS 5.0 - расширенная поддержка С/С++, более мощный редактор, повышенное юзабилити, GtkAda - новые виджеты, интерфейс к граф. библиотеке Cairo). (От себя добавлю, что в редакторе наконец-то сделали выпадающий список Pragma, и список атрибутов типа:
   
   )
3. Более гибкий и эффективный менеджер проектов
4. Поддержка выгрузки плагинов
5. Улучшенная поддержка конструкций на .NET-платформе
6. Более детальные сообщения об исключениях (при использовании ключа -gnateE)
7. полная поддержка платформы Lego Mindstorms NXT, включая аудио и I2C-сенсоры (об этом есть ролик на youtube, англ.: вот он )

Как видно, много народу хочет попробовать новую среду/новый компилятор - я скачивал пакет размером 140Мб почти 12 часов, скорость иногда падала до 2-3Кб/сек. Но сейчас с этим вроде справились.

Сообщение отредактировано: IUnknown - 17.06.2011 18:40

[TarasBer]

Дизассемблер работает?
Кстати, где-то был полный список новых возможностей языка на русском, я потерял.
Правда JIT-компиляции там так и нет...

[IUnknown]

Дизассемблер работает?

Всегда работал, и в 2009 и в 2010 Pro, 2011 - в обоих версиях работает прекрасно, и в Pro и в GPL.

где-то был полный список новых возможностей языка на русском, я потерял.
Правда JIT-компиляции там так и нет...

Какое отношение JIT/AOT имеет к возможностям языка - непонятно... В лучшем случае - возможности компилятора.

[TarasBer]

> Всегда работал, и в 2009 и в 2010 Pro, 2011 - в обоих версиях работает прекрасно, и в Pro и в GPL.

Странно, что же у меня не то...
А про стандарт есть что почитать?

Спойлер (Показать/Скрыть)

> Какое отношение JIT/AOT имеет к возможностям языка - непонятно...

Я не про то, что в джаве, не про формат исполняемого файла.
Я про возможность на ходу составлять новые функции.
Я вот писал ту программу, что графики строит, у меня функция хранится в виде АСТ-дерева, и при каждом вычислении значения прогоняется АСТ-дерево, это не очень удобно. Если бы язык давал возможности для генерации кода, то не пришлось бы делать лишние вычисления для каждой точки.

Вот тут небольшой параграф есть: http://www.insidepro.com/kk/344/344r.shtml

В Фортране, Алголе, Паскале, Си/Си++ и прочих "хороших и разных" клонах (включая Бейсик) самомодификация возможна лишь теоретически - путем варварской правки машинного кода в оперативной памяти. Почему "варварской"? Да потому, что язык к этому не имеет никакого отношения, более того - самомодификация опирается на недокументированные возможности языка, закладываясь на логику конкретных трансляторов, что чревато развалом программы при переходе на другой компилятор, не говоря уже о том, что машинный код – штука, понятная лишь небольшому кругу избранных, но даже Великий Гуру не сможет написать самомодифицирующуюся программу, работающую более чем на одном процессоре.

И про Джаву (что это не то, что я сейчас имею в виду):

правда, если быть честными, 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 в удобном для оптимизации виде

[IUnknown]

Вот основное, что добавилось в Стандарт:

1. AI-0176 Quantified expressions (Показать/Скрыть)

Для примера возьмем известную всем функцию: двоичный поиск. Реализация ее тривиальна:

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;
   
   A : Some_Array(1 .. 10) := (1, 2, 3, 6, 7, 8, 9, 10, 11, 12);

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;

-- ...
R : aliased Rec;
Acc_R : Acc_Rec := R'access;

-- Теперь попробуем сделать вот такое присваивание:
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 (Показать/Скрыть)

declare
   VObj : access Designated := ...;
   CObj : access constant Designated := ...;
   Cnst : aliased constant Designated := ...;
begin
   VObj := Cnst'access; -- Ошибка
   VObj := CObj; -- ???
end;

В 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);

Если постусловие не выполнилось - значит, есть какая-то проблема в процедуре.

7. Conditional expressions/Case expressions (Показать/Скрыть)

Появилась возможность использовать 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]

По пункту 1 - фича интересная, правда пока её применение слишком узкое. Ну вот поиск какого-нибудь ненулевого элемента в массиве с её помощью организовать можно? Чтобы она не только сообщала о наличии такого элемента, но и возвращала индекс.

По пункту 7 - как-то конструкцию обрезали, не хватает end if и end case, единообразия нету. В качестве операторных скобок сделали круглые.

[IUnknown]

Ну вот поиск какого-нибудь ненулевого элемента в массиве с её помощью организовать можно?

Внимательно название фичи прочел? Quantified expressions - это вообще-то кванторы. То есть, предусловие для определения упорядоченности выглядит практически так:

(∀x ∈ Arr'Range) P(x)
, где P - предикат "Arr(i - 1) меньше Arr(i)"

Это высказывание может быть истинным или ложным. Можешь написать высказывание, которое будет определять, есть ли в массиве ненулевой элемент, и кроме этого возвращать его индекс?

[TarasBer]

> Внимательно название фичи прочел? 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 вернётся любой индекс нужного элемента.

[IUnknown]

https://ideone.com/xUM1j ?

Сразу скажу насчет зачем понадобилось описывать функции 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]

По пункту 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);

   Ada.Text_IO.Put_Line (Integer'Image (A (2, 3)));
   -- (2+3) + (2*3) = 11
   Ada.Text_IO.Put_Line (Integer'Image (C (7, 5)));
   -- (7+5) + (7*5) + (7+5) + (7/5) = 60
end Test;

Ограничений пока не вижу.
Если так, то надо попробовать рисовалку графиков с этой фичей переписать, сравнить, насколько будет быстрее.

Так вот, у меня вопрос. Что представляют собой объекты A,B,C? Простого указателя на функцию для их представления явно недостаточно, то есть в них также сидит и информация о параметрах, с которыми конструировали функцию. Каково, например, время жизни этих параметров?

[TarasBer]

В общем, решил я проверить скорость "лямбда-функций". Результаты оказались удручающие. По скорости они оказались ничуть не лучше, чем АСТ-дерево, а "байткоду", сделанному в формате массив данных вида "указатель на операцию, на левый аргумент, на правый аргумент, на результат", они сливают в два раза. Необходимость использовать в случаях, в которых важно время, такой массив очень неприятна - генерация этого массива из АСТ-дерева не так проста, как генерация лямбда-функции, а условные операторы очень геморны.

Самое плохое, на самом деле не это. Самое плохое тут то, что этот код работает только при полной оптимизации, иначе... переполнение стека (ОТКУДА):

Спойлер (Показать/Скрыть)

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;
   
   Data : array (1 .. 17) of aliased integer := (7, 8, 5, 6, 48, 2, 3, 6, 9, others => <>);
   
   -- 7+8-5*6+48*2-3*(6+9)
   -- Data:
   --  1   : 7
   --  2   : 8
   --  3   : 5
   --  4   : 6
   --  5   : 48
   --  6   : 2
   --  7   : 3
   --  8   : 6
   --  9   : 9
   
   -- 10   : 5*6
   -- 11   : 48*2
   -- 12   : 6+9
   -- 13   : 3*(6+9)
   -- 14   : 7+8
   -- 15   : 7+8-5*6
   -- 16   : 7+8-5*6+48*2
   -- 17   : 7+8-5*6+48*2-3*(6+9)   
  
   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))); 
   
   -- составляем байт-код
   -- 1.30 сек
   Commands(1) := (Mul'access, Data( 3)'access, Data( 4)'access, Data(10)'access);
   Commands(2) := (Mul'access, Data( 5)'access, Data( 6)'access, Data(11)'access);
   Commands(3) := (Add'access, Data( 8)'access, Data( 9)'access, Data(12)'access);
   Commands(4) := (Mul'access, Data( 7)'access, Data(12)'access, Data(13)'access);
   Commands(5) := (Add'access, Data( 1)'access, Data( 2)'access, Data(14)'access);
   Commands(6) := (Sub'access, Data(14)'access, Data(10)'access, Data(15)'access);
   Commands(7) := (Add'access, Data(15)'access, Data(11)'access, Data(16)'access);
   Commands(8) := (Sub'access, Data(16)'access, Data(13)'access, Data(17)'access);  
  
   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)));
   
   -- составляем сложную функцию
   -- 2.60 млс
   Funcs( 1) := Ret_Const( 7);
   Funcs( 2) := Ret_Const( 8);   
   Funcs( 3) := Ret_Const( 5);   
   Funcs( 4) := Ret_Const( 6);   
   Funcs( 5) := Ret_Const(48);   
   Funcs( 6) := Ret_Const( 2);   
   Funcs( 7) := Ret_Const( 3);   
   Funcs( 8) := Ret_Const( 6);   
   Funcs( 9) := Ret_Const( 9);
   Funcs(10) := Ret_Mul(Funcs( 3), Funcs( 4));
   Funcs(11) := Ret_Mul(Funcs( 5), Funcs( 6));
   Funcs(12) := Ret_Add(Funcs( 8), Funcs( 9));
   Funcs(13) := Ret_Mul(Funcs( 7), Funcs(12));
   Funcs(14) := Ret_Add(Funcs( 1), Funcs( 2));
   Funcs(15) := Ret_Sub(Funcs(14), Funcs(10));
   Funcs(16) := Ret_Add(Funcs(15), Funcs(11));
   Funcs(17) := Ret_Sub(Funcs(16), Funcs(13));   
   
   T := Clock;  
   for j in 1 .. Times loop
      Data(17) := Funcs(17).all;
   end loop;   
   Put_Line (Duration'Image (To_Duration (Clock - T)));
   
   -- составляем АСТ-дерево
   -- 2.50 сек
   Nodes( 1) := (nkConst,  7, null, null);
   Nodes( 2) := (nkConst,  8, null, null);
   Nodes( 3) := (nkConst,  5, null, null);   
   Nodes( 4) := (nkConst,  6, null, null);   
   Nodes( 5) := (nkConst, 48, null, null);     
   Nodes( 6) := (nkConst,  2, null, null);  
   Nodes( 7) := (nkConst,  3, null, null);  
   Nodes( 8) := (nkConst,  6, null, null);  
   Nodes( 9) := (nkConst,  9, null, null);  
   Nodes(10) := (nkMul,  0, Nodes( 3)'access, Nodes( 4)'access);  
   Nodes(11) := (nkMul,  0, Nodes( 5)'access, Nodes( 6)'access);  
   Nodes(12) := (nkAdd,  0, Nodes( 8)'access, Nodes( 9)'access);  
   Nodes(13) := (nkMul,  0, Nodes( 7)'access, Nodes(12)'access);  
   Nodes(14) := (nkAdd,  0, Nodes( 1)'access, Nodes( 2)'access);  
   Nodes(15) := (nkSub,  0, Nodes(14)'access, Nodes(10)'access);  
   Nodes(16) := (nkAdd,  0, Nodes(15)'access, Nodes(11)'access);  
   Nodes(17) := (nkSub,  0, Nodes(16)'access, Nodes(13)'access);  
      
   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]

Самое плохое, на самом деле не это. Самое плохое тут то, что этот код работает только при полной оптимизации, иначе... переполнение стека

Самое плохое - это то, что на некоторых ОСях это вообще работает, хотя не должно. Мне, скажем, под Debian-ом, не удалось заставить твою программу работать ни при каких настройках. Вообще, в Аде очень странное понятие "замыкания", откуда все эти проблемы и происходят. Как будет побольше времени - напишу подробнее о том, что делать можно, а чего нельзя, и как поступать в том случае, когда нельзя, но очень хочется...

Сообщение отредактировано: IUnknown - 26.07.2011 17:10

[IUnknown]

Ну, вот такой пример отрабатывает в любом режиме, не только при полной оптимизации, надо будет только подумать, как запихать инициализацию пакета и получение из него 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)));


   -- составляем АСТ-дерево
   -- 2.50 сек
   Nodes( 1) := (nkConst,  7, null, null);
   Nodes( 2) := (nkConst,  8, null, null);
   Nodes( 3) := (nkConst,  5, null, null);
   Nodes( 4) := (nkConst,  6, null, null);
   Nodes( 5) := (nkConst, 48, null, null);
   Nodes( 6) := (nkConst,  2, null, null);
   Nodes( 7) := (nkConst,  3, null, null);
   Nodes( 8) := (nkConst,  6, null, null);
   Nodes( 9) := (nkConst,  9, null, null);
   Nodes(10) := (nkMul,  0, Nodes( 3)'access, Nodes( 4)'access);
   Nodes(11) := (nkMul,  0, Nodes( 5)'access, Nodes( 6)'access);
   Nodes(12) := (nkAdd,  0, Nodes( 8)'access, Nodes( 9)'access);
   Nodes(13) := (nkMul,  0, Nodes( 7)'access, Nodes(12)'access);
   Nodes(14) := (nkAdd,  0, Nodes( 1)'access, Nodes( 2)'access);
   Nodes(15) := (nkSub,  0, Nodes(14)'access, Nodes(10)'access);
   Nodes(16) := (nkAdd,  0, Nodes(15)'access, Nodes(11)'access);
   Nodes(17) := (nkSub,  0, Nodes(16)'access, Nodes(13)'access);

   T := Clock;
   for j in 1 .. Times loop
      Data(17) := Get_Value(Nodes(17));
   end loop;
   Put_Line ("Nodes => " & Duration'Image (To_Duration (Clock - T)));

   -- составляем байт-код
   -- 1.30 сек
   Commands(1) := (Mul'access, Data( 3)'access, Data( 4)'access, Data(10)'access);
   Commands(2) := (Mul'access, Data( 5)'access, Data( 6)'access, Data(11)'access);
   Commands(3) := (Add'access, Data( 8)'access, Data( 9)'access, Data(12)'access);
   Commands(4) := (Mul'access, Data( 7)'access, Data(12)'access, Data(13)'access);
   Commands(5) := (Add'access, Data( 1)'access, Data( 2)'access, Data(14)'access);
   Commands(6) := (Sub'access, Data(14)'access, Data(10)'access, Data(15)'access);
   Commands(7) := (Add'access, Data(15)'access, Data(11)'access, Data(16)'access);
   Commands(8) := (Sub'access, Data(16)'access, Data(13)'access, Data(17)'access);

   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;

Доп. пакеты прикрепил в архиве:
 Closures.zip ( 965 байт ) Кол-во скачиваний: 595


У меня на машине в Debug-сборке способ "с лямбдой" рвёт все остальные, кроме прямого подсчета:

Plain =>  0.384574123
Fs =>  0.853194138
Nodes =>  2.288829872
Commands =>  2.034435707
[2011-07-27 01:43:00] process terminated successfully (elapsed time: 05.85s)

При сборке Optimize картина становится вот такой:

Plain =>  0.000000443
Fs =>  0.818582249
Nodes =>  1.320058477
Commands =>  0.520827938
[2011-07-27 01:45:24] process terminated successfully (elapsed time: 02.97s)

, но все равно скорость лямбд выше чем у ACT-дерева больше чем в полтора раза...

Теперь еще один вопрос: ты говорил, что у тебя сборка Optimize работала. А ты проверял, оно правильно считало (я про лямбды, разумеется)? Там точно получалось 36? Вообще, очень странно, если уж работать - то должно было как раз в дебаге, оптимизированная сборка наоборот не должна была отработать...

[TarasBer]

> А ты проверял, оно правильно считало (я про лямбды, разумеется)? Там точно получалось 36?

Да, точно. А при отладочной сборке облом наступал при первой же попытке вычислить значение первого же Ret_Const.

И я не могу точно назвать все комбинации галочек, которые дают выполняющийся код. Просто их в среде слишком много (перекинуть проект из отладочного в оптимизированный надо нажать 20 галочек на 3 вкладках, как вы работаете? Может у вас есть фирменная строка в gpr-файле, позволяющая перекидывать изменением одной директивы?).

Так что можно написать баг-репорт.

> package P1 is new IntPack(7);
> надо будет только подумать, как запихать инициализацию пакета и получение из него Ret_Const в отдельную функцию:

Я вот тоже не уверен насчёт того, что я смогу на пакетах, инициализируемых локально, создать экземпляр функции, который я смогу сохранить в глобальный объект.
К тому же предполагается, что порядок действий и значение констант должны как бы вводиться пользователем, то есть порядок инициализации пакетов не должен быть мёртво вшит в код. Например, для моего варианта хоть порядок создания функций и задан руками, но я могу спокойно запихать создание функций в условный оператор, сделать массив функций итд. А массив пакетов создать я не могу.

(И да, тему о всяких замыканиях, кажется, надо отделить).

[IUnknown]

К тому же предполагается, что порядок действий и значение констант должны как бы вводиться пользователем, то есть порядок инициализации пакетов не должен быть мёртво вшит в код. Например, для моего варианта хоть порядок создания функций и задан руками, но я могу спокойно запихать создание функций в условный оператор, сделать массив функций итд.

В таком случае - только вот это:

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

   Fs(1) := Create_Unary( 7);
   Fs(2) := Create_Unary( 8);
   Fs(3) := Create_Unary( 5);
   Fs(4) := Create_Unary( 6);
   Fs(5) := Create_Unary(48);
   Fs(6) := Create_Unary( 2);
   Fs(7) := Create_Unary( 3);
   Fs(8) := Create_Unary( 6);
   Fs(9) := Create_Unary( 9);
   Fs(10) := Create_Binary(mul_bfun'Access, Fs( 3), Fs( 4));
   Fs(11) := Create_Binary(mul_bfun'Access, Fs( 5), Fs( 6));
   Fs(12) := Create_Binary(add_bfun'Access, Fs( 8), Fs( 9));
   Fs(13) := Create_Binary(mul_bfun'Access, Fs( 7), Fs(12));
   Fs(14) := Create_Binary(add_bfun'Access, Fs( 1), Fs( 2));
   Fs(15) := Create_Binary(sub_bfun'Access, Fs(14), Fs(10));
   Fs(16) := Create_Binary(add_bfun'Access, Fs(15), Fs(11));
   Fs(17) := Create_Binary(sub_bfun'Access, Fs(16), Fs(13));

   IntValue := Fs(17).f(Fs(17).Self);
   Ada.Text_IO.Put_Line (Integer'Image (IntValue));
end Test;

Очень похоже на дерево, по скорости тоже почти одинаково, хотя все-таки этот способ чуть-чуть быстрее.