Ada Hackathon補足

ytqwerty2009-02-16

Agdaいいですね。(枕詞)
さて、当日までひとりHackathonを覚悟していたのですが、最終的に5人になりまして、皆様ありがとうございました。
石川さんはNACLの遥か先のステージへ。稲葉さんやh_sakuraiさんはきちんとAda「を」作っていて凄いと思いました。shinichiro.hさんは、Ada86の本のみでスレッドプールの実装……!私自身の作業は……NACLのビルドに即効挫折してgdgd。無線通信が使えないのも私ひとりという悲しい事態でした。後半は前々から作ってた.hのトランスレータ(使用言語はO'Caml)の作業をしてました。まだ見せられるレベルでは無いです……。
以下後付け補足です。
Adaを正しく色分けできるエディタの話
正確にはシングルクオーテーションを文字定数と他の意味で兼用している言語(O'CamlやHaskellも含む)を正しく色分けできるエディタの話。
画像を見ていただければわかるように、viでも無理でした。

bindの話
http://kmonos.net/wlog/94.html#_2208090214の実にどうでもいい補足。
variadic templateが無いのは大量にn引数の場合をそれぞれ書くからOKとか、C++erの発想は素晴らしいと思いました。実際Boostってそういう発想で作られているのですよね。

なぜrenamesは三人称なのにreturnは原型(命令型)なのか
稲葉さんに指摘されて目から鱗
Adaは予約語に活用形を使うくせに使いまわしも激しい言語ですとしか。
他のパッケージにあるものを一括で再公開する構文がWGで議論中なのですが、with renamesやらuse and declareやらuse allやら酷いことになっております。

他に主観で面白そうなAI。

石川さんが持ってこられた本にあったtaskのテクニック
そのまま転載はまずいと思いますので概要だけ。

with Text_IO;
procedure test1 is
   task type t (v : access Integer := new Integer) is
   end t;
   task body t is
   begin
      Text_IO.Put_Line (Integer'Image (v.all));
   end t;
   function c return t is
   begin
      return r : t do
         r.v.all := 10;
      end return;
   end c;
   z : t := c;
begin
   null;
end test1;

taskをbuild-in-placeする関数では、関数から抜けるまでtaskは起動されないため、拡張returnの中で追加の初期化してもOKというテクニックでした。
RMのどこに書いてあるのでしょう。その場では実装依存ではないかと口にしてしまいましたが、書いてあってもおかしくないですね。……真面目に探してないです。

with Text_IO;
procedure test2 is
   task type t is
      entry s;
   end t;
   task body t is
   begin
      accept s do
         Text_IO.Put_Line ("t.s accepted!");
      end s;
   end t;
   function c return t is
   begin
      return r : t do
         r.s; -- dead lock!!
      end return;
   end c;
   z : t := c;
begin
   null;
end test2;

ですもので拡張return中でランデブーしようとするとデッドロックします。いいのでしょうか。

スレッドプール
http://shinh.skr.jp/m/?date=20090215#p02
こんなのでいいのでしょうか。

generic
   Max : Positive;
package Task_Pools is
   type Job_Type is access procedure;
   procedure Start (Job : in not null Job_Type);
end Task_Pools;
with Ada.Containers.Doubly_Linked_Lists;
package body Task_Pools is
   task type The_Task is
      entry Execute (Job : Job_Type);
   end The_Task;
   Tasks : array (1 .. Max) of aliased The_Task;
   type The_Task_Access is access all The_Task;
   package The_Task_Lists is new Ada.Containers.Doubly_Linked_Lists (
      The_Task_Access);
   protected Free_Tasks is
      procedure Add (Item : in The_Task_Access);
      entry Take (Item : out The_Task_Access);
   private
      Tasks : The_Task_Lists.List;
   end Free_Tasks;
   task body The_Task is
      Next_Job : Job_Type;
   begin
      loop
         Free_Tasks.Add (The_Task'Unchecked_Access);
         select
            accept Execute (Job : Job_Type) do
               Next_Job := Job;
            end Execute;
            Next_Job.all;
         or
            terminate;
         end select;
      end loop;
   end The_Task;
   protected body Free_Tasks is
      procedure Add (Item : in The_Task_Access) is
      begin
         The_Task_Lists.Append (Tasks, Item);
      end Add;
      entry Take (Item : out The_Task_Access) when not Tasks.Is_Empty is
      begin
         Item := Tasks.First_Element;
         The_Task_Lists.Delete_First (Tasks);
      end Take;
   end Free_Tasks;
   procedure Start (Job : in not null Job_Type) is
      The_Task : The_Task_Access;
   begin
      Free_Tasks.Take (The_Task);
      The_Task.Execute (Job);
   end Start;
end Task_Pools;
with Ada.Command_Line;
with Ada.Numerics.Float_Random;
with Ada.Task_Identification;
with Ada.Text_IO;
with Task_Pools;
procedure Test_Task_Pool is
   protected Sync_IO is
      procedure Put_Line (S : in String);
   end Sync_IO;
   protected body Sync_IO is
      procedure Put_Line (S : in String) is
      begin
         Ada.Text_IO.Put_Line (S);
      end Put_Line;
   end Sync_IO;
   Max : constant Positive := Positive'Value (Ada.Command_Line.Argument (1));
   package Pool is new Task_Pools (Max);
   Gen : Ada.Numerics.Float_Random.Generator;
   procedure Job is
   begin
      Sync_IO.Put_Line
        (Ada.Task_Identification.Image
            (Ada.Task_Identification.Current_Task) &
         "... enter");
      declare
         Time : constant Duration :=
            Duration (0.5 + Ada.Numerics.Float_Random.Random (Gen) / 2.0);
      begin
         delay Time; -- 0.5 .. 1.0 sec
      end;
      Sync_IO.Put_Line
        (Ada.Task_Identification.Image
            (Ada.Task_Identification.Current_Task) &
         "... leave");
   end Job;
begin
   Ada.Numerics.Float_Random.Reset (Gen);
   for I in 1 .. 10 loop
      Sync_IO.Put_Line (Integer'Image (I));
      Pool.Start (Job'Access);
   end loop;
end Test_Task_Pool;

当日その場でさっと書けたら格好良かったのですが、実際には後日試行錯誤しながら2時間ぐらいかかりました……。更にshinichiro.hさんの読んでいた本の範囲に収まってないところが卑怯すぎる。
task関連では、当日の早押しクイズでも石川先生に全敗したような記憶が。

バックエンドの可変長返値サポートが必要な理由
次のコードをgcc -O2 -fno-inlineでコンパイルして、use_indefiniteとuse_definiteの生成コードを見比べていただければ。

with Text_IO;
procedure ss is
   function ret_indefinite return String is
   begin
      return "Piyo";
   end ret_indefinite;
   procedure use_indefinite is
   begin
      Text_IO.Put (ret_indefinite);
   end use_indefinite;
   subtype String_4 is String (1 .. 4);
   function ret_definite return String_4 is
   begin
      return "Piyo";
   end ret_definite;
   procedure use_definite is
   begin
      Text_IO.Put (ret_definite);
   end use_definite;
begin
   use_indefinite;
   use_definite;
end ss;

ところで、この間リンクを貼らせていただいたインドリさんは巷で大人気との噂です。