[ocaml-ctypes] Spinning process on osx

[Jeremy Yallop]

On 29 January 2014 12:35, Daniel Bünzli <daniel.buenzli at erratique.ch> wrote:
> Le mercredi, 29 janvier 2014 à 12:22, Anil Madhavapeddy a écrit :
>> One immediate alternative is to experiment with the stub generation that's entered ctypes-trunk, as part of https://github.com/ocamllabs/ocaml-ctypes/pull/124
>
> Yes I thought about this and I will certainly do it eventually, but I'm kind on a tight schedule right now and I fear it may take me too much time.
>
> One question about that though: in the tgls library I have to lookup symbols dynamically and that `stub` argument in `Foreign.foreign` [1] is very handy for that. Do I still get that support "for free" ? Had no time to look into the details, prefer to wait for proper docs...

Looking up symbols dynamically will probably be trickier out of the
box, since stub generation tries to move as much as possible to
compile time.  If your goal is to have functions which look the same
whether the underlying symbol is available or not, and which raise an
exception when called then things are straightforward enough.  Here's
an example that checks function availability during stub generation
and generates either a working stub or a function that raises an
exception.

$ cat optstubgen.ml
let candidates =
  let open Ctypes in [
    "dirname", (string @-> returning string);
    "basename", (string @-> returning string);
    "getExtension", (string @-> returning string);
  ]

let exists symbol =
  try let _ = Dl.dlsym ?handle:None ~symbol in true
  with Dl.DL_error _ -> false

let with_formatter filename fn =
  let outch = open_out filename in
  let cleanup () = close_out outch in
  try let fmt = Format.formatter_of_out_channel outch in
      fn fmt;
      Format.pp_print_flush fmt ();
      cleanup ()
  with e ->
    cleanup (); raise e

let c_header = "
#include <libgen.h>
#include \"ctypes/cstubs_internals.h\"
"

let () =
  begin
    with_formatter "bindings.ml" (fun mlfmt ->
    with_formatter "bindings.mli" (fun mlifmt ->
    with_formatter "bindings_stubs.c" (fun cfmt ->
      Format.fprintf cfmt "%s@\n" c_header;
      ListLabels.iter candidates
        ~f:(fun (cname, fn) ->
         let open Cstubs in
         let stub_name = "test_stub_" ^ cname in
          write_signature cname mlifmt fn;
          if exists cname then begin
            write_c ~cname ~stub_name cfmt fn;
            write_ml ~stub_name ~external_name:cname mlfmt fn
          end else
            Format.fprintf mlfmt "let %s _ = failwith \"%s unavailable\""
              cname cname))))
  end
$ ocamlfind opt -package ctypes.stubs,ctypes.foreign -linkpkg
optstubgen.ml -o optstubgen
$ ./optstubgen
$ ocamlfind ocamlmktop -o bindings.top -custom  -linkpkg -package
ctypes.stubs -I `ocamlc -where`/.. bindings_stubs.c bindings.mli
bindings.ml
$ ./bindings.top
        OCaml version 4.01.0

# module Bindings = Bindings;;
module Bindings :
  sig
    val dirname : string -> string
    val basename : string -> string
    val getExtension : string -> string
  end
# Bindings.dirname "/tmp/blah.c";;
- : string = "/tmp"
# Bindings.basename "/tmp/blah.c";;
- : string = "blah.c"
# Bindings.getExtension "/tmp/blah.c";;
Exception: Failure "getExtension unavailable".
#