./index.html ../index.html

Adaへの挑戦は続く…

これは、僕が、数年前に端っこだけかじって宙ぶらりんになっていたAdaへ再挑戦し、なんだかんだで使えるようになったりならなかったりした時の記録です。

もしプログラミング言語を分類するとしたら、何かの上に乗っかって動く事が前提な言語と、単独で動作可能な言語、という分類もできます。 ま、特定OS用コンパイラである時点で、OSの上でしか動かないのは当たり前で、あくまで言語の設計上の話になりますが、ランタイムが何一つ無くても動くぜ！(いや、最低メモリマネージャは必要か…)な設計の言語は、書いていてある種の爽快感があります。 (BASICやJavaで、結局際どい処理は.dllやJNIを使わざるを得ないのか、といった歯痒さを感じた事がある人ならわかると思います…逆に、C++しか使った事ないぜ！ってな人にはわからないかも)

Adaもそうなのです。

元が軍事目的だけあって、バリバリ厳密。 外から扱えるものと中身は完全に分断して書かれ、Access型(ポインタ)の取り扱いには迷惑なまでのチェックが入り、構文糖なんてものとはかけ離れた堅い堅い言語です。 それでいて、「可能な事」で言えばC言語を遥かに上回り、僕の知る限り最強の低レベル記述能力(構造体の内部構造や、浮動小数点型の精度を決定する機能すら、コンパイラ指令や#pragmaでは無く、構文として存在する！)に加え、generics装備！しかも、GC装備！のくせに、GCを当てにせずにコードを書け！という、徹底的に高機能＆高障壁な言語です。

…というのが、数年前にちょっと勉強したときに掴んだAdaの概観。 数年前に飽きた理由は、OOP機能が貧弱だったのと、手探りでやってたので、堅いチェックをくぐり抜けてコンパイルを通すまでがもう大変で、疲れてしまったのが原因です。

一言で言ってしまえば、強力だけどそれ以上にめんどくせえ。

そもそも、Windowsの上で動かす以上は、SDKが提供された言語=C/C++でできない事はできないわけで…。 また、Windows上の言語として使いやすくするための拡張が施されているわけでも無いため、文字列をC形式にしてAPIに渡すだけでも、C言語ならそのまま、DelphiならPCharでキャストするだけなのに、Adaですと、Nulを付加した後、先頭アドレスをどうにかして型チェックをくぐり抜けてAPIに渡せる型に持っていかないといけないわけです。 アドレス値としては同じはずなのですが、キャストすら簡単にはさせてくれないのですね…Adaが如何に強力でも、空回り感がするのですよ…。

• 環境設定
• リファレンスとチュートリアル
• Hello World
• Win32APIを呼ぶ
• コンパイラオプション
• 高階
• STLのようなもの
• アクセス型の理解
• リソース
• デバッグ！
• generic

環境設定

以前はgnat単体パッケージ(ここから辿れます)を使っていたのですが、この際mingwフルセットを用意してもいいでしょう。 ということでmingwのサイトへ行きました。
SourceForgeのダウンロードページから、MinGW-X.X.X-X.exeとgcc-X.X-Ada-XXXXXXXX-X.tar.gzを取って来ます。バージョンはよくわからないのでとりあえず最新のものを。
mingwインストール後にgcc-X.X-Ada-XXXXXXXX-X.tar.gzを重ねて解凍。 環境変数ADA_INCLUDE_PATH = ...\mingw\...\adaincludeとADA_OBJECTS_PATH = ...\mingw\...\adalibを設定します。

インストーラを走らせたくない人は、 binutils-2.13.90-20030111-1.tar.gz, gcc-ada-3.3.1-20030804-1.tar.gz, gcc-core-3.3.1-20030804-1.tar.gz, mingw-runtime-3.2.tar.gz, mingw-utils-0.2.tar.gz, w32api-2.4.tar.gz をバラで入手、同じ位置に展開して、環境変数を自前で通せばおっけーです。 ファイル名は、これ記述時のものです。

環境変数は、スペースを含む場合は、8.3形式にしてやらないと通りません。

C:\Program Files\MinGWへ、バージョン3.3.1のファイル群を展開した例

PATH=(他のPATH);C:\Progra~1\MinGW\bin
ADA_INCLUDE_PATH=C:\Progra~1\MinGW\lib\gcc-lib\mingw32\3.3.1\adainclude
ADA_OBJECTS_PATH=C:\Progra~1\MinGW\lib\gcc-lib\mingw32\3.3.1\adalib

2003-12-04にMinGWのものに書き換え。

リファレンスとチュートリアル

昔「Ada95への招待」というページが存在し、これがものすごいやる気を起こさせる書き方をしてくれていたのですが、残念ながら今は消えてしまっています。

追記！ Webアーカイブ、偉い！ http://web.archive.org/web/20020605044428/http://www.tsujiken.ee.kogakuin.ac.jp/jada95.html

言語仕様はRM95が参照できます。 また、Windowsの*.hlp形式のものが、Aonix社のObjectAdaに付いてくるため、ヘルプ目当てに体験版をダウンロードするのも手です。

チュートリアルはLovelaceというのが良さげらしい、という風説ですが、僕はやってて飽きて来ました。

Hello World

とりあえず、インストール直後なので、動作確認をば…。

with Ada.Text_IO;
procedure Hello is
begin
  Ada.Text_IO.Put_line("Hello World !");
end Hello;

...\Ada\Hello>gnatmake Hello.adb
gcc -c hello.adb
gnatbind -x hello.ali
gnatlink hello.ali

...\Ada\Hello>hello
Hello World !

おー、動きました。

gnatmakeというメイクツールでコンパイルからビルドまでできるのですが…exeがでかい。 なんなんだこのでかさは…標準出力へ書き出すだけのexeが、VCLアプリよりでかくなる筈がない！

数年前は結局わからなかったんです…要するにスマートリングがなされてないのでした。 コマンドラインツールを空起動したときの説明は、一応読むべきですね。 ってわけで、次で解決です。

...\Ada\Hello> gnatmake Hello.adb -largs -s

-largs以降がリンカに渡されます。で、-sがスマートリンク、と。 一気にサイズ減です。

それでもDelphiコンソールアプリとは一桁違うなー。 stdio使用のCコンソールアプリよりもでかいけど、iostream使用のC++よりは小さい。 まあ、例外処理、GC兼備であることを考えれば、こんなものかも。 DelphiでSysUtilsをusesして例外処理を有効にした時のサイズから、数割増し程度です。

Win32APIを呼ぶ

いきなりですかぁ？と言われそうな気もしますが、これができなければWindows環境ではまるで使えないので、呼べるようにしておきます。

AdaのWin32 API Bindingは検索すれば割と出て来るのですが、gnat用で生き残っているのは少なく…とりあえずWin32Adaを発見。 Last Updateが1999年ですけど、Copyrightが1995年になってる…Windows95時代のAPIセットですかあ？

ダウンロードして、インストーラを走らせ(単に展開するだけのインストーラらしい)、展開後、必要なファイルを調達します。 htmlで付属しているインストール方法は、古いバージョンが対象なので、無視。

解凍先\src\gnat中で、gnatmake -O2 withall.adbで全てをコンパイル。バッチファイルではオプション無しでコンパイルしてますが、最適化オプションぐらい付けてもバチは当たりますまい。 この時、警告は無視すればいいのですが、win32-winnt.adsで、pragmaの位置が遅すぎる旨のエラーが数ヶ所出ます。仕方がないのでエラーが出ない位置へ試行錯誤で移動しました。

リンク時にdo_なんちゃらが見つからないと言われますが、grepをかけたところ、win32ada.aしか引っかからないので、解凍先\libの中のwin32ada.aをADA_OBJECTS_PATHで指定したところに放り込みます。 理由は不明だが必要なのだから仕方がありません。

更に、リンク時にecho_なんちゃらも見つかりません。 win32-winmain.adbが参照しているみたいなのですが、grepをかけても見つかりません。 バイナリエディタで探し回って、それらしいものをlibgnat.a中に発見。 書き換えてみたところ特に問題なさげなので、以下に示しておきます。

pragma Import (C, Retrieve_hInstance, "rts_get_hInstance");
pragma Import (C, Retrieve_hPrevInstance, "rts_get_hPrevInstance");
pragma Import (C, Retrieve_lpCmdline,  "rts_get_lpCommandLine");
pragma Import (C, Retrieve_nCmdShow, "rts_get_nShowCmd");

それでもwithallのビルドには失敗しますが、それは無視して、stdarg*.ads/adbと、win32*.ads/adbを、ADA_INCLUDE_PATHへ移動。stdarg*.ali/oと、win32*.ali/oを、ADA_OBJECTS_PATHへ移動。 コンパイル用のwithall/withcrtや、見た感じどこからも使われていないextensibleは放置。

gnat単体パッケージの場合、Win32 API Bindingが付属しているので、mingwの環境を真面目に整えた場合の無駄な努力でした。考えてみればパッケージの方からパチって来れば良かったな。

さて、サンプルのgdidemoでもコンパイルしてみますか…。

...\Win32Ada\samples\gdidemo>gnatmake gdidemo
gcc -c gdidemo.adb
gcc -c init.adb
gcc -c bounce.adb
gcc -c convert.adb
gcc -c draw.adb
gcc -c gdidemo_util.adb
gcc -c maze.adb
gcc -c poly.adb
gcc -c xform.adb
gcc -c wininfo.adb
gcc -c dialog.adb
dialog.adb:100:07: warning: "null_rect" is never assigned a value
dialog.adb:127:03: warning: "null_size" is never assigned a value
dialog.adb:128:03: warning: "null_point" is never assigned a value
gnatbind -x gdidemo.ali
gnatlink gdidemo.ali
...\MinGW\lib\gcc-lib\mingw32\3.2\adalib/win32-winuser.o(.text+0x1007):win32-win
user.adb: undefined reference to `do_varargs'
...\MinGW\lib\gcc-lib\mingw32\3.2\adalib/win32-winuser.o(.text+0x1977):win32-win
user.adb: undefined reference to `do_varargs'
./dialog.o(.text+0x16b):dialog.adb: undefined reference to `SetMapMode@8'
./dialog.o(.text+0x17e):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0x19b):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0x1ae):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0x1e5):dialog.adb: undefined reference to `SelectPalette@12'
./dialog.o(.text+0x1f6):dialog.adb: undefined reference to `RealizePalette@4'
./dialog.o(.text+0x20d):dialog.adb: undefined reference to `SetWindowExtEx@16'
./dialog.o(.text+0x231):dialog.adb: undefined reference to `SetViewportExtEx@16'

./dialog.o(.text+0x261):dialog.adb: undefined reference to `SetViewportOrgEx@16'

./dialog.o(.text+0x2b3):dialog.adb: undefined reference to `CreateSolidBrush@4'
./dialog.o(.text+0x30c):dialog.adb: undefined reference to `DeleteObject@4'
./dialog.o(.text+0x33b):dialog.adb: undefined reference to `SelectPalette@12'
./dialog.o(.text+0x344):dialog.adb: undefined reference to `DeleteObject@4'
./dialog.o(.text+0x357):dialog.adb: undefined reference to `RealizePalette@4'
./dialog.o(.text+0x377):dialog.adb: undefined reference to `SetWindowExtEx@16'
./dialog.o(.text+0x39b):dialog.adb: undefined reference to `SetViewportExtEx@16'

./dialog.o(.text+0x3cb):dialog.adb: undefined reference to `SetViewportOrgEx@16'

./dialog.o(.text+0x40d):dialog.adb: undefined reference to `CreateSolidBrush@4'
./dialog.o(.text+0x466):dialog.adb: undefined reference to `DeleteObject@4'
./dialog.o(.text+0x486):dialog.adb: undefined reference to `SetMapMode@8'
./dialog.o(.text+0x4c5):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0x4e2):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0x4f5):dialog.adb: undefined reference to `GetDeviceCaps@8'
./dialog.o(.text+0xc65):dialog.adb: undefined reference to `CreatePalette@4'
./poly.o(.text+0xaac):poly.adb: undefined reference to `BitBlt@36'
./poly.o(.text+0xb50):poly.adb: undefined reference to `PolyBezier@12'
./poly.o(.text+0xf81):poly.adb: undefined reference to `GetStockObject@4'
./poly.o(.text+0xf8d):poly.adb: undefined reference to `SelectObject@8'
./poly.o(.text+0xfe6):poly.adb: undefined reference to `PolyBezier@12'
./poly.o(.text+0xffc):poly.adb: undefined reference to `SelectObject@8'
./poly.o(.text+0x128e):poly.adb: undefined reference to `CreatePen@12'
./poly.o(.text+0x129a):poly.adb: undefined reference to `SelectObject@8'
./poly.o(.text+0x1308):poly.adb: undefined reference to `PolyBezier@12'
./poly.o(.text+0x1321):poly.adb: undefined reference to `SelectObject@8'
./poly.o(.text+0x132a):poly.adb: undefined reference to `DeleteObject@4'
./poly.o(.text+0x133f):poly.adb: undefined reference to `SetROP2@8'
./draw.o(.text+0x3ee):draw.adb: undefined reference to `CreateSolidBrush@4'
./draw.o(.text+0x3fa):draw.adb: undefined reference to `SelectObject@8'
./draw.o(.text+0x71f):draw.adb: undefined reference to `Rectangle@20'
./draw.o(.text+0x743):draw.adb: undefined reference to `Ellipse@20'
./draw.o(.text+0x76d):draw.adb: undefined reference to `RoundRect@28'
./draw.o(.text+0x79a):draw.adb: undefined reference to `Chord@36'
./draw.o(.text+0x7c7):draw.adb: undefined reference to `Pie@36'
./draw.o(.text+0x7e8):draw.adb: undefined reference to `Rectangle@20'
./draw.o(.text+0x801):draw.adb: undefined reference to `SelectObject@8'
./draw.o(.text+0x80a):draw.adb: undefined reference to `DeleteObject@4'
./bounce.o(.text+0x1329):bounce.adb: undefined reference to `CreateEllipticRgn@1
6'
./bounce.o(.text+0x1592):bounce.adb: undefined reference to `CreateEllipticRgn@1
6'
./bounce.o(.text+0x15db):bounce.adb: undefined reference to `CreateRectRgn@16'
./bounce.o(.text+0x15ee):bounce.adb: undefined reference to `CombineRgn@16'
./bounce.o(.text+0x162e):bounce.adb: undefined reference to `FillRgn@12'
./bounce.o(.text+0x1660):bounce.adb: undefined reference to `CreateSolidBrush@4'

./bounce.o(.text+0x1677):bounce.adb: undefined reference to `FillRgn@12'
./bounce.o(.text+0x168a):bounce.adb: undefined reference to `DeleteObject@4'
./bounce.o(.text+0x16d1):bounce.adb: undefined reference to `DeleteObject@4'
./bounce.o(.text+0x16e4):bounce.adb: undefined reference to `DeleteObject@4'
./bounce.o(.text+0x16f7):bounce.adb: undefined reference to `DeleteObject@4'
./xform.o(.text+0x682):xform.adb: undefined reference to `BitBlt@36'
./xform.o(.text+0x6bf):xform.adb: undefined reference to `SetViewportOrgEx@16'
./xform.o(.text+0x6eb):xform.adb: undefined reference to `SetWorldTransform@8'
./xform.o(.text+0x7b3):xform.adb: undefined reference to `Polyline@12'
./xform.o(.text+0x7e4):xform.adb: undefined reference to `ModifyWorldTransform@1
2'
./xform.o(.text+0x7fd):xform.adb: undefined reference to `SetViewportOrgEx@16'
./xform.o(.text+0x8c4):xform.adb: undefined reference to `SetViewportOrgEx@16'
./xform.o(.text+0x8f0):xform.adb: undefined reference to `SetWorldTransform@8'
./xform.o(.text+0x9b8):xform.adb: undefined reference to `Polyline@12'
./xform.o(.text+0x9e9):xform.adb: undefined reference to `ModifyWorldTransform@1
2'
./xform.o(.text+0xab1):xform.adb: undefined reference to `Polyline@12'
./xform.o(.text+0xac9):xform.adb: undefined reference to `GetWorldTransform@8'
./xform.o(.text+0xbe3):xform.adb: undefined reference to `ModifyWorldTransform@1
2'
./xform.o(.text+0xbfc):xform.adb: undefined reference to `SetViewportOrgEx@16'
./init.o(.text+0xba):init.adb: undefined reference to `GetStockObject@4'
./init.o(.text+0x130):init.adb: undefined reference to `GetStockObject@4'
./init.o(.text+0x1b2):init.adb: undefined reference to `GetStockObject@4'
./init.o(.text+0x243):init.adb: undefined reference to `GetStockObject@4'
./init.o(.text+0x2ed):init.adb: undefined reference to `GetStockObject@4'
./init.o(.text+0x3b0):init.adb: more undefined references to `GetStockObject@4'
follow
gnatlink: cannot call ...\MinGW\bin/gcc.exe
gnatmake: *** link failed.

gnatlinkがAPIのインポートライブラリを見てくれてません。 何故ですかぁ、gccで*.cとか、g++で*.cppとかコンパイルしたらリンクしてくれるじゃないですかぁ。

仕方がないので、libkernel32.a libuser32.a libgdi32.a そして win32ada.a をフルパス指定。

...\Win32Ada\samples\gdidemo>gnatlink gdidemo.ali "...\mingw\lib\gcc-lib\mingw32
\3.2\adalib\win32ada.a" "...\mingw\lib\libuser32.a" "...\mingw\lib\libkernel32.a
" "...\mingw\lib\libgdi32.a" -s

何もメッセージが出ないという事は、できてますgdidemo.exe。

動いてます…動いてますけど、毎回このコマンドラインは地獄です。
何か方法があるはずだ…。

怪しいファイルを発見。 ...\MinGW\lib\gcc-lib\mingw32\3.2\specsに、なんかリンカオプションが色々書き連ねられているっぽいです。

%{pg:-lgmon} %{mwindows:-lgdi32 -lcomdlg32} -luser32 -lkernel32 -ladvapi32 -lshell32

とりあえずリンカにライブラリを渡しているのはこの行だと見当をつけて、書き足す。

...-lgdi32 -lcomdlg32} -lwin32ada -luser32 -lkernel32...

ライブラリファイルは、名前がlib*.aの形式でなければならないみたいなので、win32ada.aをlibwin32ada.aにリネームして、...\mingw\lib直下に移動。

...\Win32Ada\samples\gdidemo>gnatmake gdidemo -largs -mwindows -s
gcc -c gdidemo.adb
gcc -c init.adb
gcc -c bounce.adb
gcc -c convert.adb
gcc -c draw.adb
gcc -c gdidemo_util.adb
gcc -c maze.adb
gcc -c poly.adb
gcc -c xform.adb
gcc -c wininfo.adb
gcc -c dialog.adb
dialog.adb:100:07: warning: "null_rect" is never assigned a value
dialog.adb:127:03: warning: "null_size" is never assigned a value
dialog.adb:128:03: warning: "null_point" is never assigned a value
gnatbind -x gdidemo.ali
gnatlink -mwindows -s gdidemo.ali

よっしゃぁ！

成功すると欲が出てくるもので、毎回 -largs -mwindows -s を書き足すのも手間に思えます。 この一行を、ソースコードに書き足しておけばOK。

pragma Linker_Options("-s -mwindows");

-mwindowsというのはspecsを見て当りをつけたのですが、正解の様です。 -mconsoleとか-mdllってのもあるみたい。

P.S. win32adaの宣言は、余りにも古い、かつ、使いにくいので、使う分だけ自前で書いてしまってたりする。

コンパイラオプション

"Switches for gcc"を、素人目で読んでみます。

• -O数値
  最適化レベル。0～3まで。
  デフォルトがO0で最適化無しです。この状態だと、インラインも無効の様です。
  -O3を選ぶと、pragma Inlineを書いて無くても、勝手にインライン展開してくれます。
  普通は -O2 -gnatn -gnatp でよいと思われます。

Output and Error Message Control

警告の抑制とかなので、GNATの挙動に詳しくなるまでは無視していいでしょ、多分。 ということで読み飛ばす。

Debugging and Assertion Control

• -gnata
  pragma Assert(式, メッセージ);や、pragma Debug(呼びだし);のような形でデバッグ用コードを埋めこめるのですが、デフォルトでは無視されるので、有効にします。

Run-Time Checks

• -gnatp
  全ての動的チェックを行なわない。pragma Suppress(all_checks);と等価。
• -gnato
  数値演算オーバーフローチェック。Constraint_Errorが投げられる。デフォルトはOff。
• -gnatE
  関数呼出し時に細かいチェックをするらしいが、詳細不祥。

Stack Overflow Checking

• -fstack-check
  スタックオーバーフローチェック。Storage_Errorが投げられる。

Run-Time Control

• -gnatT ミリ秒
  マルチスレッドのタイムスライスの値を(有効な環境では)設定できる…らしい。

Style Checking

インデント幅とかチェックされるらしい…余計なお世話。 ということで読み飛ばす。

Using gcc for Syntax Checking

• -gnats
  構文チェックだけでコンパイルしない。

Using gcc for Semantic Checking

• -gnatc
  RM(Adaの公式文法マニュアル)に準拠する…らしい。

Compiling Ada 83 Programs

• -gnat83
  Ada83のソースコードをコンパイルする…らしい。

Character Set Control

• -gnati[1234p8fnw]
  ラテン文字以外を識別子に使えるようにする…らしいが、日本語変数名が使えても嬉しく無いどころか逆に迷惑なので、無視していいと思う。
• -gnatW[huse8b]
  ソースコードのエンコーディング？sがSHIFT-JIS、eがEUC、8がUTF-8。

File Naming Control

• -gnatk 長さ
  ファイル名の最大長を指定。 多分、Long_Long_Name.adbが、ロングファイルネームが使えない環境で8.3形式とかで切れてLong_Lon.adbなんかになってしまった時用と思う。 Windowsを使っている分には気にしないことにしていい…と思います。

Subprogram Inlining Control

• -fno-inline
  インライン指定を無効化する。
• -gnatn
  デフォルトでは、現在のファイルで宣言された関数しかインライン展開しないが、このオプションを付けると他のファイルの関数もインライン展開できる。
• -gnatN
  インラインをさらにがんばる…らしい？

Auxiliary Output Control

gccの動作に関るらしいが、当面無視。ということで読み飛ばす。

Debugging Control

• -gnatd文字
  デバッグ用らしいが詳細不明。
• -gnatG
  -gnatD
  -gnatC
  上記三つはソースリスティングファイル用オプションらしいがよくわかりません。
• -gnatR数値
  宣言された型のサイズやアライメント情報を表示。 -gnatR1で構造化型、-gnatR2で全ての型。
• -gnatx
  *.aliファイルに詳細情報を含めず簡単に済ませるらしい。

高階

単に、関数ポインタを受けとってコールバックするだけの関数も、高階と言っていいと思いますが、ここで想定しているのは、関数型言語やRubyのような、呼びだし側のローカル変数をいじれる奴です。

Delphiではインラインアセンブラを併用して無理やり実現したのですが、Adaならひょっとして素でできるかも？と淡い期待を抱いて実験です。

with 
  Ada.Text_IO;
procedure Test_HO_Access is

  type T is access procedure;
  procedure Highly_Order_Function(Callback: in T) is
  begin
    for I in 0..1 loop
      Callback.all;
    end loop;
  end Highly_Order_Function;

  procedure A is

    x: String := "xxx";

    procedure I is
    begin
      Ada.Text_IO.Put(x);
    end I;

  begin
    Highly_Order_Function(I'Access);
  end A;
  
begin
  A;
end Test_HO_Access;

...>gnatmake Test_HO_Access.adb -largs -s
gcc -c test_ho_access.adb
test_ho_access.adb:23:39: subprogram must not be deeper than access type
gnatmake: "test_ho_access.adb" compilation error

…あらら。やっぱダメか？

しかし、エラーメッセージが、「関数内関数はアクセス型より深くてはいけない」であって、「関数内関数は渡せない」では無いのが気にかかります。 試しに、アクセス型の宣言を、関数内関数と同じ深さへ移動。

with 
  Ada.Text_IO;
procedure Test_HO_Access is

  procedure A is

    type T is access procedure;
    procedure Highly_Order_Function(Callback: in T) is
    begin
      for I in 0..1 loop
        Callback.all;
      end loop;
    end Highly_Order_Function;

    x: String := "xxx";

    procedure I is
    begin
      Ada.Text_IO.Put(x);
    end I;

  begin
    Highly_Order_Function(I'Access);
  end A;
  
begin
  A;
end Test_HO_Access;

...>gnatmake Test_HO_Access.adb -largs -s
gcc -c test_ho_access.adb
gnatbind -x test_ho_access.ali
gnatlink -s test_ho_access.ali

通った！？しかも動く！？

…これだけでも、関数内関数のポインタを扱えなかったPascal(というかDelphi実装)と比べ随分と凄いのですが、しかし、今やろうとしていることはこれでは実現できません。 Highly_Order_Functionは、外で定義したいのです。

要するに、外で書いて、中で書いたように動けば＝実体化すればいいのだから……そういう時はgenericだっ！

with 
  Ada.Text_IO;
procedure Test_HO_Generic is

  generic
    with procedure Callback;
  package Highly_Order_Function is
    procedure Execute;
  end Highly_Order_Function;

  package body Highly_Order_Function is
    procedure Execute is
    begin
      for I in 0..1 loop
        Callback;
      end loop;
    end Execute;
  end Highly_Order_Function;

  procedure A is

    x: String := "xxx";

    procedure I is
    begin
      Ada.Text_IO.Put(x);
    end I;

    package HO is new Highly_Order_Function(I);

  begin
    HO.Execute;
  end A;
  
begin
  A;
end Test_HO_Generic;

...>gnatmake Test_HO_Generic.adb -largs -s
gcc -c test_ho_generic.adb
gnatbind -x test_ho_generic.ali
gnatlink -s test_ho_generic.ali

...>Test_HO_Generic
xxxxxx

よーしよしよしよし。完璧だ。

考えてみれば、毎回使う場所毎に実体化が必要＝#defineによる埋めこみと変わらない＝コードサイズ増大なのですが、姑息な事をしなくても正規の文法の範囲内でできてしまうのはやっぱり凄いことなので、ひとまず、これにて無事解決といたします。

文法の範囲でできるという事は、コンパイラの実装を気にせず使ってOKということですし、ちゃんと型チェックもされますし。

…そういえば、冒頭で書いた通り、以前はAdaの型チェックはひどく厄介なものだった記憶があるのですが、改めてみるとそうでもありませんね。 むしろ、取り扱い方が見えてきたので、安心できるようになったと言うべきか。 Pascalの場合、素直に機械語に落とせないような機能は省かれているのですが、Adaの場合はそういうのも全てサポートされているので、賢いコンパイラ感が強まってます。 (逆に、これどうやって実現しているのだろう、と思うことも多く、コードが実際にどんな機械語になっているのかサッパリ想像付かないのですが)

STLのようなもの

• SGL
  C++のSTLを移植したもの。…はいいのですけど、XXX_Iteratorとか、細かな分類もそのまま持ってきているため、繁雑です。 おまけに、付属のテストが全部通らなかったりして…。 C++/STLをよく知っていて、尚且つ修正する自信があるなら、挑戦してもいいでしょう。 勿論僕はSTLもよく知らないし、修正する自信も無いので、あきらめました。
• Booch
  2002年の今でも更新があるのが一番のメリットかも。 ファイル数も多く、機能が豪華で、また、Adaの機能を使っていてスマートに見えます。 しかし、継承を用いているため、単一継承しかできないAda95では、適用範囲を広げることは難しそうです。 純粋にデータ構造とアルゴリズムとして用いるならいいのですが、TStringsみたいに、実体はTListBoxに保持される、なんてのがやりにくそう。

というわけで、これもまた自作していたのですが、Ada0Y(05)にいいのがついてくるらしいので、それをAda95に逆ポートしてくれたものを使いましょう。

アクセス型の理解

Adaのアクセス型(ポインタ)は、チェックが厳密な上、種類が多くてイマイチ把握できてません。
ようし、実験開始！コンパイルが通れば○。
一箇所書き換えてコンパイル、一箇所書き換えてコンパイル…。

ああ、無駄な努力だ…。 しかし、なんとなくわかってきましたよ。
他の実験も適時行ないつつ、結果レポート。

型

accessはヒープのみ

普通のアクセス型はnewで割り当てたメモリしか指せません。 安心してメモリを解放できる印みたいなものでしょうか。

access allは変数を指せる

グローバル/ローカル変数に限らず、コード上で宣言された変数を指すにはallが必要です。
それにしても、何行にallを追加しろ、とか、GNATのエラーメッセージはやたら親切な気がする…。

access constantは変数/定数を指せる

示す先を書き換えられないという点が異なりますが、access allと同じく変数を指せます。
また、X : aliased constant T := ... と宣言された定数も指せます。
アクセス型同士の代入(型変換が必要でしたけど)も試してみましたが、access constant ← access all ← access と、緩い方向のみ許可されてました。

変数

aliasedが必要

宣言時にaliasedを書かないと、'Access、'Unchecked_Accessが使えなくなります。 レコードや配列等構造化型の要素も同じ。

引数のアドレスは取れない

aliasedを書く場所が無いので、引数のアドレスは取れません。access渡しを使えという事でしょうね。
ただし、引数が構造化型の場合、aliasedを付けた要素のアドレスは取れました。 in引数の場合はconstant扱いになるようです。in out及びoutの時はローカル変数同様でした。
どうしてもの時は'Unrestricted_Accessという最後の武器もありますが…。

属性

'Accessは厳密

一番厳しいアドレスの取り方です。 アクセス型は、対象と同じかより内側で宣言されている必要が有ります。

'Unchecked_Accessはスコープをチェックしない

ローカル変数のアドレスを持ち出す時に使えます。
アクセス型を宣言する場所が重要なようです。 同じかより内側で型宣言した場合はローカル変数であっても'AccessでOKですが、アクセス型が外側で宣言されている時は'Unchecked_Accessが必要なようです。
思い出してみれば関数内関数のアドレスも同様でしたねー。 というわけで実験してみたところ、procedureに対しては'Unchecked_Accessが使えませんでした。
関数内関数には追加のコンテキストが必要、という要件と、ローカル変数のアドレスを持ち出すのはバグの元、というチェックを兼ねての仕組みかな。上手く考えられてると思います。
アクセス型同士の代入チェックも行なってみましたが、予想通り、外側 := 内側、は×で、内側 := 外側、は○でした。

'Unrestricted_Access(GNAT拡張)は常に使える

Pascalの@のセンスで、常に使えます。constantさえ無視できました。(つまりCの&より危険)
ただしこれはGNAT拡張。 使わずに済ませられるならその方がいいのですが、WindowsAPI等を、C言語から使うのと同等に使おうとすれば必須になるかも…。

リソース

後々必要になるであろうリソースリンクの方法。

Mingwのミラーサイトからres2coffというのを取ってきて、.resを.oに変換すればいいそうです。 (試して無い)

デバッグ！

まさか、まさか、このページにネタを追加できる日がやってこようとは…！！

C++BuilderX偉い！ Javaで作られてて、死ぬほど重くて、入力支援ができなくて…しかし、Borlandはgdbに素晴らしいユーザーインターフェースを与えてくれた！

デバッグするには-gが必要です。また、exeサイズを減らすために-sを付けているとデバッグできません。

generic

ふむ…こんな風に書かれると、サンプルコードや表のAda版を作ってみたくなるのですが…。

英語の専門用語がわかりません…。 それに、Table-1の○と●の違いって何でしょうね？

template<class Comparable>
const Comparable& pick(const Comparable &x, const Comparable &y)
{
  if(better(x, y)) 
    return x; 
  else 
    return y;
}

struct Apple
{
  Apple(int r): rating(r) { }
  int rating;
};

bool better(const Apple &a, const Apple &b)
{
  return b.rating < a.rating;
}

int main(int, char**)
{
  Apple a1(3), a2(5);
  Apple a3 = pick(a1, a2);
}

procedure Main is

  generic
    type Comparable is private;
    with function ">" (X, Y : in Comparable) return Boolean;
  function Pick(X, Y : in Comparable) return Comparable;
  
  function Pick(X, Y : in Comparable) return Comparable is
  begin
    if X > Y then
      return X;
    else
      return Y;
    end if;
  end Pick;

  type Apple is record
    Rating: Integer;
  end record;

  function Better(A, B : in Apple) return Boolean is
  begin
    return A.Rating > B.Rating;
  end Better;

  function Pick_Apple is new Pick(Apple, Better);

  A1: Apple := (Rating => 3);
  A2: Apple := (Rating => 5);
begin
  declare
    A3: Apple := Pick_Apple(A1, A2);
  begin
    null;
  end;
end Main;

Adaのgenericは、特殊化こそ不可ですが、関数をパラメータとして渡せたり、その際名前を一致させる必要はない事などから、結構高レベルで厳密さと柔軟性を同居させていると思います。 演算子や仮想関数と通常関数の区別が無いのも有利に働いてるかもです。

…と、元の論文を読まずに書いてみる。