OCaml Ada interoperability

adaside.ads *1

with System.Storage_Elements;
package adaside is
   subtype Value is System.Storage_Elements.Integer_Address;
   use type Value;
   function caml_string_length (S : Value) return System.Storage_Elements.Storage_Count;
   pragma Import (C, caml_string_length);
   function Val_long (X : Long_Integer) return Value is (Value (X) * 2 + 1);

   function The_Func (S : Value) return Value;
   pragma Export (C, The_Func, "ml_the_func");
end adaside;

adaside.adb

package body adaside is
   function The_Func (S : Value) return Value is
      Len : Natural := Natural (caml_string_length (S));
      Ada_S : String (1 .. Len);
      for Ada_S'Address use System.Storage_Elements.To_Address (S);
   begin
      return Val_long (Long_Integer'Value (Ada_S)); -- use 'Value attribute
   end The_Func;
end adaside;

ocamlside.ml

external the_func: string -> int = "ml_the_func";;

print_int (the_func "16#ff#");; (* hexadecimal form of Ada *)

コンパイルと実行

$ gcc -c -gnat2012 adaside.adb
$ ocamlopt ocamlside.ml adaside.o -ccopt /usr/local/lib/gcc/x86_64-apple-darwin10/4.7.2/adalib/libgnat.a
$ ./a.out
255

*1:ここではValue is Integer_Addressとしてますが、ビットフィールド風に定義することでVal_longやらLong_valを撤去できます。ていうかmlvalue.hでもそうなってて欲しい……。valueをそのまま演算するミスは誰でも一度はやらかしますよね！