Adaの引数って激ヤバだよねー。
プリミティブ型でも関数内で変数を書き換えられちゃう。
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
procedure Call is
procedure Sub (A : in Integer; B : out Integer) is
begin
Put_Line ("Sub:");
Put_Line ("A = " & Integer'Image (A) & " at " & Image (A'Address));
Put_Line ("B = " & Integer'Image (B) & " at " & Image (B'Address));
-- A := 11; Error because A is passed with "in".
B := 11;
end Sub;
A : Integer := 7;
B : Integer := 7;
begin Put_Line ("Parent:");
Put_Line ("A = " & Integer'Image (A) & " at " & Image (A'Address));
Put_Line ("B = " & Integer'Image (B) & " at " & Image (B'Address));
Sub (A, B);
Put_Line ("Changed:");
Put_Line ("A = " & Integer'Image (A) & " at " & Image (A'Address));
Put_Line ("B = " & Integer'Image (B) & " at " & Image (B'Address));
end Call;Parent: A = 7 at 16#BFFF_F514# B = 7 at 16#BFFF_F510# Sub: A = 7 at 16#BFFF_F3F0# B = 4 at 16#BFFF_F394# Changed: A = 7 at 16#BFFF_F514# B = 11 at 16#BFFF_F510#
Elementary型はBy CopyなのでSub内のBは別のアドレスなんだけど、そこでの書き換えがちゃんと親に反映されてる。親の変数のアドレスは一定なのにも注目。反映の仕方もBy Copyなのが分かる。
書き換えのタイミングが気になるけれど、これは副プログラム内で書き換えられた時にリアルタイムで親の変数も書き換わるのではなくて、returnと同時になる。Taskを使って検証してみるとこんな感じ。
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
procedure Out_Timing is V : Integer := 17;
task Checker is
entry Die;
end Checker;
task body Checker is
begin
loop
delay 1.0;
select
accept Die;
exit;
else
Put_Line("* Now V is " & Integer'Image (V));
end select;
end loop;
end Checker;
procedure Change (Inner_V : out Integer) is
begin
Put_Line ("Waiting for the timing checker for 2 seconds");
delay 2.0;
Put_Line ("Chainging the value of V.");
Inner_V := 11;
Put_Line ("V changed. Wating for the timing checker for 10 seconds.");
delay 2.0;
Put_Line ("Then returning.");
end Change;
begin
Put_Line ("Let's change V.");
Change (V);
Put_Line ("Change done.");
Put_Line ("Waiting for the timing checker for 2 seconds");
delay 2.0;
Checker.Die;
end Out_Timing;Let's change V. Waiting for the timing checker for 2 seconds * Now V is 17 Chainging the value of V. V changed. Wating for the timing checker for 10 seconds. * Now V is 17 * Now V is 17 Then returning. Change done. Waiting for the timing checker for 2 seconds * Now V is 11 * Now V is 11
強調してる部分では副プログラムのInner_Vは11になってるけれど、Vは17のまま。呼び出し元の変数に11が反映されるのはreturnと同時なのがわかる。アトミックな雰囲気で安心。
Composite型は状況によってはBy-Referenceで渡されるんだけど、Adaの場合参照渡しとかそういうレベルじゃない。まずは常識的な配列の要素の変更を。
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
with System;
procedure Call_Composition is
function I (I : Integer) return String renames Integer'Image;
function I (I : System.Address) return String renames Image;
type Three_Integers is array (1 .. 3) of Integer;
procedure Take_Array
-- (A : in Three_Integers) requries "out" to change the element of arrays
(A : out Three_Integers)
is begin
Put_Line ("A:" & I (A'Address));
A(2) := 17;
end Take_Array;
X : Three_Integers := (1, 3, 5);
begin Put_Line ("X:" & I (X'Address));
Take_Array (X);
Put_Line ("1 =>" & I (X (1)) & ", 2 =>" & I (X (2)) & ", 3 =>" & I (X (3)));
end Call_Composition;X:16#BFFF_F4FC# A:16#BFFF_F4FC# 1 => 1, 2 => 17, 3 => 5
XとYのアドレスが同じなのでBy-Referenceで渡されているのが分かる。outが指定されていれば渡されたComposite型の要素は書き換えが可能になる。逆にinだと要素の書き換えも禁止されるのでとても安心。
配列自体の置換も出来るというか、Adaの場合配列の代入はコピーだから当然か。
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
with System;
procedure Call_Composition_Replace is
function I (I : Integer) return String renames Integer'Image;
function I (I : System.Address) return String renames Image;
type Three_Integers is array (1 .. 3) of Integer;
procedure Replace_Array (A : out Three_Integers) is
B : Three_Integers := (7, 17, 13);
begin
Put_Line ("A:" & I (A'Address));
Put_Line ("B:" & I (B'Address));
A := B;
Put_Line ("A:" & I (A'Address));
end Replace_Array;
X : Three_Integers := (1, 3, 5);
begin Put_Line ("X:" & I (X'Address));
Replace_Array (X);
Put_Line ("1 =>" & I (X (1)) & ", 2 =>" & I (X (2)) & ", 3=>" & I (X (3)));
Put_Line ("X:" & I (X'Address));
end Call_Composition_Replace;X:16#BFFF_F4C0# A:16#BFFF_F4C0# B:16#BFFF_F3D4# A:16#BFFF_F4C0# 1 => 7, 2 => 17, 3=> 13 X:16#BFFF_F4C0#
これらの挙動はrecord型でも同じ。ところで、GNATの場合、おそらくレジスタに値が乗るぐらいオブジェクトが小さい場合はBy Copyで渡してくれるらしい。これは効率がいいんだけど、コピーされてると変更結果がちゃんと反映されるのか心配になる。
vwith Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
with System;
procedure Call_Record is
function I (I : Integer) return String renames Integer'Image;
function I (I : System.Address) return String renames Image;
-- enough small to pass by reference
type Something is
Record
Value : Integer;
end record;
-- bigger record
type Something_Big is
record
value : Integer;
Value_2 : Integer;
Value_3 : Integer;
end record;
procedure Change_Something (A : out Something) is
begin
Put_Line ("A:" & I (A'Address));
A.Value := 17;
end Change_Something;
procedure Change_Something_Big (B : out Something_Big) is
begin
Put_Line ("B:" & I (B'Address));
B.Value := 17;
end Change_Something_Big;
X : Something := (Value => 11);
Y : Something_Big := (Value => 11, Others => 0);
begin Put_Line ("X:" & I (X'Address));
Change_Something (X);
Put_Line (I (X.Value));
Put_Line ("X:" & I (X'Address));
New_Line;
Put_Line ("Y:" & I (Y'Address));
Change_Something_Big (Y);
Put_Line (I (Y.Value));
Put_Line ("Y:" & I (Y'Address));
end Call_Record;X:16#BFFF_F510# A:16#BFFF_F490# 17 X:16#BFFF_F510# Y:16#BFFF_F504# B:16#BFFF_F504# 17 XY:16#BFFF_F504#
XとAはメモリ上では違うオブジェクトなのに、きちんと変更されている。すごい。
こんな感じでそもそも値渡しなのか参照渡し（と言っていいのかな）なのかが一定しないのがAdaのヤバいところ。が、これはあくまでもコンパイラが考えることであって、プログラマは気にしなくても平気。とにかく、どんなタイプの変数でも投げられるし、投げた先で書き換えればそれがちゃんと親にも反映されるってことが確実ってだけ。
さて、ここまでは自動変数の話だったんど、accessだとどうだろう。accessには参照が入っていて、By Copyでそれを渡すことになる。これはJavaと同じ挙動だけれど、Adaの場合はひと味違う。具体的に言うと副プログラム内でオブジェクトの置き換えも出来てしまう。
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
with System;
procedure Call_Access is
function I (I : Integer) return String renames Integer'Image;
function I (I : System.Address) return String renames Image;
type Something is
Record
Value : Integer;
end record;
type Something_Access is access Something;
procedure Change_Something (A : in Something_Access) is
begin
-- allowed even if passed with "in" for access type
A.Value := 17;
-- following is not allowed because "A" is "in".
-- A := new Something'(Value => 11);
end Change_Something;
procedure Replace_Something (A : out not null Something_Access) is
B : Something_Access := new Something'(Value => 13);
begin
Put_Line ("Before:");
Put_Line ("A:" & I (A'Address));
Put_Line ("A.all:" & I (A.all'Address));
Put_Line ("B:" & I (B'Address));
Put_Line ("B.all:" & I (B.all'Address));
A := B;
Put_Line ("After:");
Put_Line ("A:" & I (A'Address));
Put_Line ("A.all:" & I (A.all'Address));
end Replace_Something;
X : Something_Access := new Something'(Value => 11);
begin
-- This is basic process, possible with Java.
Change_Something (X);
Put_Line (I (X.Value)); New_Line;
-- This shows you why you should Ada.
Put_Line ("X:" & I (X'Address));
Put_Line ("X.all:" & I (X.all'Address));
Replace_Something (X);
Put_Line ("X:" & I (X'Address));
Put_Line (I (X.Value));
Put_Line ("X.all:" & I (X.all'Address));
end Call_Access;17 X:16#BFFF_F510# X.all:16#0010_00F0# Before: A:16#BFFF_F4A0# A.all:16#0010_00F0# B:16#BFFF_F424# B.all:16#0010_0100# After: A:16#BFFF_F4A0# A.all:16#0010_0100# X:16#BFFF_F510# X.all:16#0010_0100# 13
これはやばい。
最初のChange_Somethingでなぜかinなのに要素の変更が出来てしまってるけれど、これは妥当。どうせ他の変数から同じオブジェクトを参照させれば引数部分の制限は関係ないし。ちなみに、Cだと->使う状況だけど、Adaは書き分けなくていいので楽ちんかな。もちろん、参照値自体の置き換えはinだと制限される。
そんな事より、Replace_Somethingがすごい。副プログラム内でオブジェクトの入れ替えが出来てる。Javaだとこれが出来ないんだなー。
そんな訳で、Adaの引数はとてもすごくて、外見は一貫して参照渡しっぽい雰囲気なのに、内部ではコピーしたり参照を渡してたりと勝手に最適化してくれちゃうのだ。プログラマは中で何が起きてるのか気にせずに、一環したコードが書けるのがとてもいい。プリミティブとかオブジェクトとかも気にしなくていい。
他の言語を見てみると、JavaとCは論外として、C#はrefとか使えば参照渡しが出来る。でもこれがプログラムとして一貫しているかと言われると微妙なところだと思う。その点、Adaの引数はとてもヤバいですね。
AdaのProtectedはイカれてる。便利すぎる。
まぁProtectedで出来ることは、Taskが有れば出来るんですけど、スレッドってコスト高いじゃないですか。普通の変数が同期処理してくれたらそっちのほうが便利ですよね。
Protectedの副プログラムはJavaでいうSynchronizedな雰囲気です。先に突入してるタスクが有る場合は、後続の人はキューに並ぶことになります。
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Protected_Test is
protected type Is_Synchronized is
procedure Write_And_Sleep (I : in Integer);
function Get_And_Sleep return Integer;
private
V : Integer := 0;
end Is_Synchronized;
protected body Is_Synchronized is
procedure Write_And_Sleep (I : in Integer) is
begin
Put_Line ("Write: " & Integer'Image(I));
V := I;
Put_Line ("Write Zzz...");
delay 3.0;
Put_Line ("Write Check: " & Integer'Image(V));
end Write_And_Sleep;
function Get_And_Sleep return Integer is
R : Integer;
begin Put_Line ("Get: " & Integer'Image(V));
R := V;
Put_Line ("Get Zzz...");
delay 3.0;
Put_Line ("Get Check" & Integer'Image(V));
return R;
end Get_And_Sleep;
end Is_Synchronized;
P : Is_Synchronized;
task Tester_17 is
entry Write;
entry Join;
entry Write_Again;
end Tester_17;
task body Tester_17 is
begin
accept Write;
Put_Line ("Tester 17 is writing!");
P.Write_And_Sleep (17);
accept Join;
accept Write_Again;
Put_Line ("Tester 17 is writing again!");
P.Write_And_Sleep (17);
end Tester_17;
task Tester_13 is
entry Write;
entry Join;
entry Get;
end Tester_13;
task body Tester_13 is
begin
accept Write;
Put_Line ("Tester 13 is writing!");
P.Write_And_Sleep (13);
accept Join;
accept Get;
Put_Line ("Tester 13 is getting!");
Put_Line ("Tester 13 received:" & Integer'Image(P.Get_And_Sleep));
end Tester_13;
begin
Tester_17.Write;
Tester_13.Write;
Tester_17.Join;
Tester_13.Join;
Tester_13.Get;
Tester_17.Write_Again;
end Protected_Test;Tester 17 is writing! Tester 13 is writing! Write: 17 Write Zzz... Write Check: 17 Write: 13 Write Zzz... Write Check: 13 Tester 13 is getting! Get: 13 Get Zzz... Tester 17 is writing again! Get Check 13 Tester 13 received: 13 Write: 17 Write Zzz... Write Check: 17
最初の書き込みで13は17が終わるまで待っているのが分かります。意図的に3秒間何もしていないのですが、律儀ですね。
次に、13が値の取得に3秒も掛けている間、17は別の副プログラムを呼ぼうとしているにも関わらず、きちんとキューで待っています。副プログラムごとのロックではなくて、オブジェクト全体で1つのロックを持っていることが分かります。なお、functionのロックはread-onlyなので、procedureが走っていない状態ならば複数のfunctionを同時に処理することも出来る事になっています。
Protectedではentryも使えますよ。entryを使うと、ガードのおかげでポーリングというか待機が楽です。
例えば他のTaskが1秒ごとにProtectedの値を1ずつ増やしていくとして、その値が17になるまで待ってから0に戻す処理を書きたい場合。
with Ada.Text_IO; use Ada.Text_IO;
procedure Protected_Entry is
protected type Syncronized is
entry Entry_If_Over_17;
procedure Procedure_If_Over_17;
procedure Procedure_If_Over_17 (Result : out Boolean);
procedure Count_Up;
private
V : Integer := 0;
end Syncronized;
protected body Syncronized is
entry Entry_If_Over_17 when V > 17 is
begin
V := 0;
end Entry_If_Over_17;
procedure Procedure_If_Over_17 is
begin
loop -- this cause a dead lock!
if V > 17 then
V := 0;
exit;
end if;
end loop;
end Procedure_If_Over_17;
procedure Procedure_If_Over_17 (Result : out Boolean) is
begin
if V > 17 then
V := 0;
Result := True;
else
Result := False;
end if;
end Procedure_If_Over_17;
procedure Count_Up is
begin
Put_Line ("Now: " & Integer'Image(V));
V := V + 1;
end Count_Up;
end Syncronized;
P : Syncronized;
task Count_Up is
end Count_Up;
task body Count_Up is
begin
loop
P.Count_Up;
delay 1.0;
end loop;
end Count_Up;
task Wait_Over_17 is
end Wait_Over_17;
task body Wait_Over_17 is
begin
-- smart way with entry
P.Entry_If_Over_17;
Put_Line ("Entry Sucsess.");
-- with procedure with polling
declare
Result : Boolean;
begin
loop
-- I'm at the end of the queue every time...
-- and this is a busy loop...
P.Procedure_If_Over_17 (Result);
if Result then
Put_Line ("Procedure Sucsess?");
exit;
end if;
end loop;
end;
-- and then, this will be never returned.
P.Procedure_If_Over_17;
Put_Line ("When you see this message...");
end Wait_Over_17;
begin
null;
end Protected_Entry;entryを使わない場合、ビジーループで待つか、デッドロックで死ぬかの2択になります。
いやー、便利ですね。