カテゴリ

先にGNUランタイムのままカテゴリやります。
カテゴリは既存のクラスに後からメソッドを追加する機能です。
Objectクラスにputを足してみます。

with Interfaces.ObjC;
use Interfaces.ObjC;
procedure gnu_step4_cat is
   function Object_put (self : id; op : SEL) return id;
   pragma Convention (C, Object_put);
   My_Category_Name : constant String := "My_Category" & ASCII.NUL;
   Target_Class_Name : constant String := "Object" & ASCII.NUL;
   put_Name : constant String := "put" & ASCII.NUL;
   Method_Type : constant String := "@8@0:4\0" & ASCII.NUL;
   My_Category_Methods : aliased objc_method_list := (
      method_next => null,
      method_count => 1,
      method_list => (1 => (
         Address_To_SEL (put_Name'Address),
         Method_Type (1)'Unrestricted_Access,
         Object_put'Unrestricted_Access)));
   My_Category : aliased objc_category := (
      category_name => My_Category_Name (1)'Unrestricted_Access,
      class_name => Target_Class_Name (1)'Unrestricted_Access,
      instance_methods => My_Category_Methods'Unchecked_Access,
      class_methods => null,
      protocols => null);
   My_Symbol_Table : aliased constant Symtab_With_defs := (
      cls_def_cnt => 0,
      cat_def_cnt => 1,
      symtab => (0, null, 0, 1),
      cls_defs => (1 .. 0 => <>),
      cat_defs => (1 => My_Category'Unchecked_Access),
      end_defs => null);
   My_Module : aliased constant Module := (
      symtab => My_Symbol_Table.symtab'Unchecked_Access,
      others => <>);
   function Object_put (self : id; op : SEL) return id is
      procedure puts (s : not null access constant Character);
      pragma Import (C, puts);
   begin
      puts (objc_msgSend (self, selector ("name")));
      return self;
   end Object_put;
begin
   objc_exec_class (My_Module'Access);
   declare
      Object : id := objc_msgSend (objc_msgSend (
         Class_To_Object (objc_get_class ("Object" & ASCII.NUL)),
         selector ("alloc")), selector ("init"));
   begin
      objc_msgSend (Object, selector ("put"));
      objc_msgSend (Object, selector ("free"));
   end;
end gnu_step4_cat;

堪え切れなくなってラッパー書きました。selectorとobjc_msgSendがそうです。objc_msgSendはAppleランタイムの同名の関数と同じ仕様。
実行結果。

Object

あとposeAs:というメッセージを使えば、既存クラスを丸ごと差し替えることもできるみたいです。誰かNSTextViewの派生クラスでスクロールを画面の半分ではなく1行単位にしたやつ作って無いでしょうか。poseAs:して全部置き換えたいです。 プロトコルはプロセス境界越えて通信しない限り関係ないので割愛したいと思います。 あとobjc_msgSendvの使い方がわからん。float型の受け渡し周りでポータビリティに難があるような話もありますので、こんなもん使うぐらいならインラインアセンブラでスタック弄った方がいいんじゃないかと思えてしまうのが。