Objective-Cやってみよう
安楽OOPいいなあ、ということで、Objective-Cで遊んでみます。
1. Hello, world!
Objective-Cの文字列はNXConstantStringのインスタンスを静的に確保したものです。cSteingとlengthメッセージで中身を取り出せます。やってみよう。
with Interfaces.ObjC; use Interfaces.ObjC; use type Interfaces.ObjC.unsigned; with Text_IO; procedure gnu_step1_str is -- 文字列本体 Data : constant String := "Hello, world!" & ASCII.NUL; -- クラス名 Class_Name : constant String := "NXConstantString" & ASCII.NUL; -- NXConstantStringのインスタンスを静的に作る Instance : constant NXConstantString := ( super => (isa => objc_get_class (Class_Name)), c_string => Data (1)'Unrestricted_Access, len => Data'Length - 1); -- id Object = @"Hello, world!" Object : id := Instance.super.isa'Unchecked_Access; -- unsigned Returned_Length = [Object length]; length_Name : constant String := "length" & ASCII.NUL; length_Selector : SEL := sel_get_uid (length_Name); length_Body : length := objc_msg_lookup (Object, length_Selector); Returned_Length : unsigned := length_Body (Object, length_Selector); -- char const *Returned_Data = [Object cString]; cString_Name : constant String := "cString" & ASCII.NUL; cString_Selector : SEL := sel_get_uid (cString_Name); cString_Body : cString := objc_msg_lookup (Object, cString_Selector); Returned_Data : not null access constant Character := cString_Body (Object, cString_Selector); -- 得られた文字列にアクセス Data_As_String : String (1 .. Natural (Returned_Length)); for Data_As_String'Address use Returned_Data.all'Address; begin Text_IO.Put_Line (Data_As_String); end gnu_step1_str;
実行結果。
Hello, world!
2. Objectをインスタンス化
ううむ、どうもらしくない。静的に割り当てたオブジェクトではやっぱObjective感はしないですねー。
やっぱり[ [ClassName alloc] init]でインスタンス化しないと。とりあえずルートのObjectクラスをインスタンス化して、動作確認のためにクラス名を取得できるメッセージnameを呼んでみます。
with Interfaces.ObjC; use Interfaces.ObjC; use type Interfaces.ObjC.unsigned; procedure gnu_step2_obj is Object_Class : Class := objc_get_class ("Object" & ASCII.NUL); Object_Class_As_id : id := Object_Class.class_pointer'Access; alloc_Selector : SEL := sel_get_uid ("alloc" & ASCII.NUL); alloc_Body : alloc := objc_msg_lookup (Object_Class_As_id, alloc_Selector); Creating_Object : id := alloc_Body (Object_Class_As_id, alloc_Selector); init_Selector : SEL := sel_get_uid ("init" & ASCII.NUL); init_Body : alloc := objc_msg_lookup (Creating_Object, init_Selector); Object : id := init_Body (Creating_Object, init_Selector); begin declare name_Selector : SEL := sel_get_uid ("name" & ASCII.NUL); name_Body : name := objc_msg_lookup (Object, name_Selector); Name : not null access constant Character := name_Body (Object, name_Selector); procedure puts (s : not null access constant Character); pragma Import (C, puts); begin puts (Name); end; declare free_Selector : SEL := sel_get_uid ("free" & ASCII.NUL); free_Body : alloc := objc_msg_lookup (Object, free_Selector); Returned : id := free_Body (Object, free_Selector); begin null; end; end gnu_step2_obj;
ゼロ終端文字列の扱いが面倒でC関数のputs呼んでしまった時点で負けた気がします。ええい、Objectiveな入出力は無いのか！……といってもランタイムにはObjectとNXConstantStringとProtocolの3つしかクラスが定義されて無いのでした。なむさん。[stdout d:1 s:@"STR" f:2.0]なんて書けたらprintfより便利な気も。
とりあえず実行結果。
Object
3. 継承して自作クラス
オブジェクトがインスタンス化できたことで、ちょっとはObjectiveになりましたが、まだこれからです。クラスは自分で作ってこそですからね。なにしろランタイムには3つしか(ry
Objectから派生して、My_Classを作ってみます。整数型のデータメンバを増やして、initをオーバーライドして123を設定、またputに応答して値を出力するようにします。
with Interfaces.ObjC; use Interfaces.ObjC; use type Interfaces.ObjC.int; use type Interfaces.ObjC.long; with Ada.Text_IO; procedure gnu_step3_inh is type My_Class_Record is record super : aliased Object; Data : Integer; end record; function My_Class_init (self : id; op : SEL) return id; pragma Convention (C, My_Class_init); function My_Class_put (self : id; op : SEL) return id; pragma Convention (C, My_Class_put); My_Class_Name : constant String := "My_Class" & ASCII.NUL; Parent_Class_Name : constant String := "Object" & ASCII.NUL; Data_Name : constant String := "Data" & ASCII.NUL; Data_Type : constant String := "i" & ASCII.NUL; My_Class_Variables : aliased constant objc_ivar_list := ( ivar_count => 1, ivar_list => (1 => ( Data_Name (1)'Unrestricted_Access, Data_Type (1)'Unrestricted_Access, Object'Size / Standard'Storage_Unit))); init_Name : constant String := "init" & ASCII.NUL; put_Name : constant String := "put" & ASCII.NUL; Method_Type : constant String := "@8@0:4\0" & ASCII.NUL; My_Class_Methods : aliased constant objc_method_list := ( method_next => null, method_count => 2, method_list => ( 1 => ( Address_To_SEL (init_Name'Address), Method_Type (1)'Unrestricted_Access, My_Class_init'Unrestricted_Access), 2 => ( Address_To_SEL (put_Name'Address), Method_Type (1)'Unrestricted_Access, My_Class_put'Unrestricted_Access))); My_MetaClass : aliased constant objc_class := ( class_pointer => Address_To_Class (Parent_Class_Name'Address), super_class => Address_To_Class (Parent_Class_Name'Address), name => My_Class_Name (1)'Unrestricted_Access, version => 0, info => CLS_META, instance_size => objc_class'Size / Standard'Storage_Unit, ivars => null, methods => null, dtable => null, subclass_list => null, sibling_class => null, protocols => null, gc_object_type => null); My_Class : aliased constant objc_class := ( class_pointer => My_MetaClass'Unchecked_Access, super_class => Address_To_Class (Parent_Class_Name'Address), name => My_Class_Name (1)'Unrestricted_Access, version => 0, info => CLS_CLASS, instance_size => My_Class_Record'Size / Standard'Storage_Unit, ivars => My_Class_Variables'Unchecked_Access, methods => My_Class_Methods'Unchecked_Access, dtable => null, subclass_list => null, sibling_class => null, protocols => null, gc_object_type => null); My_Symbol_Table : aliased constant Symtab_With_defs := ( cls_def_cnt => 1, cat_def_cnt => 0, symtab => (0, null, 1, 0), cls_defs => (1 => My_Class'Unchecked_Access), cat_defs => (1 .. 0 => <>), end_defs => null); My_Module : aliased constant Module := ( symtab => My_Symbol_Table.symtab'Unchecked_Access, others => <>); function My_Class_init (self : id; op : SEL) return id is Object : My_Class_Record; pragma Import (Ada, Object); for Object'Address use self.all'Address; Super_init : IMP := objc_msg_lookup_super ( (self, My_Class.super_class), op); begin Ada.Text_IO.Put_Line ("init"); Object.Data := 123; return Super_init (self, op); end My_Class_init; function My_Class_put (self : id; op : SEL) return id is Object : My_Class_Record; pragma Import (Ada, Object); for Object'Address use self.all'Address; begin Ada.Text_IO.Put_Line ("put(" & Integer'Image (Object.Data) & ")"); return self; end My_Class_put; begin objc_exec_class (My_Module'Access); declare My_Class_As_id : id := My_Class.class_pointer'Unchecked_Access; alloc_Selector : SEL := sel_get_uid ("alloc" & ASCII.NUL); alloc_Body : alloc := objc_msg_lookup (My_Class_As_id, alloc_Selector); Creating_Object : id := alloc_Body (My_Class_As_id, alloc_Selector); init_Selector : SEL := sel_get_uid ("init" & ASCII.NUL); init_Body : alloc := objc_msg_lookup (Creating_Object, init_Selector); Object : id := init_Body (Creating_Object, init_Selector); begin declare name_Selector : SEL := sel_get_uid ("name" & ASCII.NUL); name_Body : name := objc_msg_lookup (Object, name_Selector); Name : not null access constant Character := name_Body (Object, name_Selector); procedure puts (s : not null access constant Character); pragma Import (C, puts); begin puts (Name); end; declare put_Selector : SEL := sel_get_uid ("put" & ASCII.NUL); put_Body : IMP := objc_msg_lookup (Object, put_Selector); Returned : id := put_Body (Object, put_Selector); begin null; end; declare free_Selector : SEL := sel_get_uid ("free" & ASCII.NUL); free_Body : alloc := objc_msg_lookup (Object, free_Selector); Returned : id := free_Body (Object, free_Selector); begin null; end; end; end gnu_step3_inh;
実行結果。
init My_Class put( 123)
この後も、カテゴリだのプロトコルだのObjectiveな機能はまだまだあります。
そして何よりも大きいのは、Objective-Cは、gccのランタイムとAppleのランタイムが全然違うという事実……。
次回は、今回のサンプルのAppleランタイムバージョンをやりたいと思います。安楽OOPのはずがひどく手間がかかったような感じですが、AppleランタイムならGCもあるので、きっとずっと楽なはず。乞うご期待。最終目標は勿論Cocoaです。
