Ctypes inverted stubs with a struct of callbacks

README.md

Using (ocaml-)ctypes to build a shared library involving structs of function pointers. See the thread on the ctypes mailing list for background.

Contents:

• bindings.ml, the inverted bindings themselves
• gen.ml, the code generator
• load.ml, which links the bindings with the generated code
• build.sh, the build script
• client.c, a client to test the library.

You'll need an OCaml distribution compile to position-independent code and the ctypes library. OPAM users can install the prerequisites by issuing the following commands:

opam switch 4.01.0+PIC
eval `opam config env`
opam install ctypes

Once everything's installed you can build the library and run the test as follows:

chmod +x build.sh
./build.sh
LD_LIBRARY_PATH=. ./client

bindings.ml

open Ctypes

let callbacks : [`callback] structure typ = structure "callbacks" 
let arith = field callbacks "arith" (Foreign.funptr (int @-> int @-> returning int))
let print = field callbacks "print" (Foreign.funptr (string @-> returning void))
let () = seal callbacks

type state = { arith: int -> int -> int; print: string -> unit }
let cache : ([`callback] structure  * state) list ref = ref []

let build id =
  let state = { arith = (+);
                print = Printf.printf "id: %d; msg: %s\n%!" id } in
  let c = make callbacks in
  begin
    setf c arith state.arith;
    setf c print state.print;
    cache := (c, state) :: !cache;
    addr c
  end

module Bindings(I: Cstubs_inverted.INTERNAL) =
struct
  let _ = I.internal "build" (int @-> returning (ptr callbacks)) build
end

build.sh

#!/bin/bash -xe

# compile the bindings and the code generator
ocamlfind opt -c  -package ctypes.stubs,ctypes.foreign bindings.ml gen.ml

# link and run the code generator
ocamlfind opt -linkpkg -package ctypes.stubs,ctypes.foreign \
   bindings.cmx gen.cmx -o gen
./gen

# compile the generated code 
ocamlfind opt -c  -package ctypes.stubs,ctypes.foreign \
   -I $(ocamlfind query ctypes)/.. callbacks.ml load.ml callback_stubs.c

# build a shared library
ocamlfind opt -g -o libcallbacks.so -linkpkg -output-obj \
   -package ctypes.stubs,ctypes.foreign \
   bindings.cmx callbacks.cmx load.cmx callback_stubs.o

# build a test client
gcc -g -ansi -Wall -c -o client.o client.c
gcc -o client -g client.o -L. -lcallbacks

client.c

#include "callback_stubs.h"
#include <caml/callback.h>
#include <stdio.h>

int main(int argc, char **argv)
{
  /* Initialize the OCaml runtime before calling the library. */
  char *caml_argv[1] = { NULL };
  caml_startup(caml_argv);

  struct callbacks *c0 = build(0);
  struct callbacks *c1 = build(1);

  printf("c0->arith(10, 20) => %d\n", c0->arith(10, 20));
  printf("c1->arith(30, 40) => %d\n", c0->arith(30, 40));
  c0->print("printing via c0");
  c1->print("printing via c1");

  return 0;
}

gen.ml

open Format

let with_formatter filename f =
  let fd = open_out filename in
  let fmt = formatter_of_out_channel fd in
  f fmt;
  close_out fd

let prefix = "callback"

let () =
  begin
    with_formatter "callback_stubs.h"
      (fun fmt ->
       Ctypes.format_typ fmt Bindings.callbacks;
       fprintf fmt ";\n";
       Cstubs_inverted.write_c_header fmt ~prefix (module Bindings.Bindings)
      );

    with_formatter "callback_stubs.c"
      (fun fmt ->
       fprintf fmt "#include \"callback_stubs.h\"\n";
       Cstubs_inverted.write_c fmt ~prefix (module Bindings.Bindings)
      );
    
    with_formatter "callbacks.ml"
      (fun fmt ->
       Cstubs_inverted.write_ml fmt ~prefix (module Bindings.Bindings)
      );
  end

load.ml

module M = Bindings.Bindings(Callbacks)