generator/generator_ocaml.ml

   1 (* libguestfs
   2  * Copyright (C) 2009-2011 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17  *)
  18
  19 (* Please read generator/README first. *)
  20
  21 open Printf
  22
  23 open Generator_types
  24 open Generator_utils
  25 open Generator_pr
  26 open Generator_docstrings
  27 open Generator_optgroups
  28 open Generator_actions
  29 open Generator_structs
  30 open Generator_c
  31 open Generator_events
  32
  33 (* Generate the OCaml bindings interface. *)
  34 let rec generate_ocaml_mli () =
  35   generate_header OCamlStyle LGPLv2plus;
  36
  37   pr "\
  38 (** For API documentation you should refer to the C API
  39     in the guestfs(3) manual page.  The OCaml API uses almost
  40     exactly the same calls. *)
  41
  42 type t
  43 (** A [guestfs_h] handle. *)
  44
  45 exception Error of string
  46 (** This exception is raised when there is an error. *)
  47
  48 exception Handle_closed of string
  49 (** This exception is raised if you use a {!Guestfs.t} handle
  50     after calling {!close} on it.  The string is the name of
  51     the function. *)
  52
  53 val create : unit -> t
  54 (** Create a {!Guestfs.t} handle. *)
  55
  56 val close : t -> unit
  57 (** Close the {!Guestfs.t} handle and free up all resources used
  58     by it immediately.
  59
  60     Handles are closed by the garbage collector when they become
  61     unreferenced, but callers can call this in order to provide
  62     predictable cleanup. *)
  63
  64 type event =
  65 ";
  66   List.iter (
  67     fun (name, _) ->
  68       pr "  | EVENT_%s\n" (String.uppercase name)
  69   ) events;
  70   pr "\n";
  71
  72   pr "\
  73 val event_all : event list
  74 (** A list containing all event types. *)
  75
  76 type event_handle
  77 (** The opaque event handle which can be used to delete event callbacks. *)
  78
  79 type event_callback =
  80   t -> event -> event_handle -> string -> int64 array -> unit
  81 (** The event callback. *)
  82
  83 val set_event_callback : t -> event_callback -> event list -> event_handle
  84 (** [set_event_callback g f es] sets [f] as the event callback function
  85     for all events in the set [es].
  86
  87     Note that if the closure captures a reference to the handle,
  88     this reference will prevent the handle from being
  89     automatically closed by the garbage collector.  Since the
  90     handle is passed to the event callback, with careful programming
  91     it should be possible to avoid capturing the handle in the closure. *)
  92
  93 val delete_event_callback : t -> event_handle -> unit
  94 (** [delete_event_callback g eh] removes a previously registered
  95     event callback.  See {!set_event_callback}. *)
  96
  97 ";
  98   generate_ocaml_structure_decls ();
  99
 100   (* The actions. *)
 101   List.iter (
 102     fun (name, style, _, _, _, shortdesc, _) ->
 103       generate_ocaml_prototype name style;
 104       pr "(** %s *)\n" shortdesc;
 105       pr "\n"
 106   ) all_functions_sorted;
 107
 108   pr "\
 109 (** {2 Object-oriented API}
 110
 111     This is an alternate way of calling the API using an object-oriented
 112     style, so you can use [g#add_drive_opts filename] instead of
 113     [Guestfs.add_drive_opts g filename].  Apart from the different style,
 114     it offers exactly the same functionality.
 115
 116     Calling [new guestfs ()] creates both the object and the handle.
 117     The object and handle are closed either implicitly when the
 118     object is garbage collected, or explicitly by calling the [g#close ()]
 119     method.
 120
 121     You can get the {!Guestfs.t} handle by calling [g#ocaml_handle].
 122
 123     Note that methods that take no parameters (except the implicit handle)
 124     get an extra unit [()] parameter.  This is so you can create a
 125     closure from the method easily.  For example [g#get_verbose ()]
 126     calls the method, whereas [g#get_verbose] is a function. *)
 127
 128 class guestfs : unit -> object
 129   method close : unit -> unit
 130   method set_event_callback : event_callback -> event list -> event_handle
 131   method delete_event_callback : event_handle -> unit
 132   method ocaml_handle : t
 133 ";
 134
 135   List.iter (
 136     function
 137     | name, ((_, [], []) as style), _, _, _, _, _ ->
 138         pr "  method %s : unit -> " name;
 139         generate_ocaml_function_type style;
 140         pr "\n"
 141     | name, style, _, _, _, _, _ ->
 142         pr "  method %s : " name;
 143         generate_ocaml_function_type style;
 144         pr "\n"
 145   ) all_functions_sorted;
 146
 147   pr "end\n"
 148
 149 (* Generate the OCaml bindings implementation. *)
 150 and generate_ocaml_ml () =
 151   generate_header OCamlStyle LGPLv2plus;
 152
 153   pr "\
 154 type t
 155
 156 exception Error of string
 157 exception Handle_closed of string
 158
 159 external create : unit -> t = \"ocaml_guestfs_create\"
 160 external close : t -> unit = \"ocaml_guestfs_close\"
 161
 162 type event =
 163 ";
 164   List.iter (
 165     fun (name, _) ->
 166       pr "  | EVENT_%s\n" (String.uppercase name)
 167   ) events;
 168   pr "\n";
 169
 170   pr "\
 171 let event_all = [
 172 ";
 173   List.iter (
 174     fun (name, _) ->
 175       pr "  EVENT_%s;\n" (String.uppercase name)
 176   ) events;
 177
 178   pr "\
 179 ]
 180
 181 type event_handle = int
 182
 183 type event_callback =
 184   t -> event -> event_handle -> string -> int64 array -> unit
 185
 186 external set_event_callback : t -> event_callback -> event list -> event_handle
 187   = \"ocaml_guestfs_set_event_callback\"
 188 external delete_event_callback : t -> event_handle -> unit
 189   = \"ocaml_guestfs_delete_event_callback\"
 190
 191 (* Give the exceptions names, so they can be raised from the C code. *)
 192 let () =
 193   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
 194   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
 195
 196 ";
 197
 198   generate_ocaml_structure_decls ();
 199
 200   (* The actions. *)
 201   List.iter (
 202     fun (name, style, _, _, _, shortdesc, _) ->
 203       generate_ocaml_prototype ~is_external:true name style;
 204   ) all_functions_sorted;
 205
 206   (* OO API. *)
 207   pr "
 208 class guestfs () =
 209   let g = create () in
 210   object
 211     method close () = close g
 212     method set_event_callback = set_event_callback g
 213     method delete_event_callback = delete_event_callback g
 214     method ocaml_handle = g
 215 ";
 216
 217   List.iter (
 218     function
 219     | name, (_, [], []), _, _, _, _, _ -> (* no params?  add explicit unit *)
 220         pr "    method %s () = %s g\n" name name
 221     | name, _, _, _, _, _, _ ->
 222         pr "    method %s = %s g\n" name name
 223   ) all_functions_sorted;
 224
 225   pr "  end\n"
 226
 227 (* Generate the OCaml bindings C implementation. *)
 228 and generate_ocaml_c () =
 229   generate_header CStyle LGPLv2plus;
 230
 231   pr "\
 232 #include <stdio.h>
 233 #include <stdlib.h>
 234 #include <string.h>
 235 #include <stdint.h>
 236
 237 #include <caml/config.h>
 238 #include <caml/alloc.h>
 239 #include <caml/callback.h>
 240 #include <caml/fail.h>
 241 #include <caml/memory.h>
 242 #include <caml/mlvalues.h>
 243 #include <caml/signals.h>
 244
 245 #include \"guestfs.h\"
 246
 247 #include \"guestfs_c.h\"
 248
 249 /* Copy a hashtable of string pairs into an assoc-list.  We return
 250  * the list in reverse order, but hashtables aren't supposed to be
 251  * ordered anyway.
 252  */
 253 static CAMLprim value
 254 copy_table (char * const * argv)
 255 {
 256   CAMLparam0 ();
 257   CAMLlocal5 (rv, pairv, kv, vv, cons);
 258   size_t i;
 259
 260   rv = Val_int (0);
 261   for (i = 0; argv[i] != NULL; i += 2) {
 262     kv = caml_copy_string (argv[i]);
 263     vv = caml_copy_string (argv[i+1]);
 264     pairv = caml_alloc (2, 0);
 265     Store_field (pairv, 0, kv);
 266     Store_field (pairv, 1, vv);
 267     cons = caml_alloc (2, 0);
 268     Store_field (cons, 1, rv);
 269     rv = cons;
 270     Store_field (cons, 0, pairv);
 271   }
 272
 273   CAMLreturn (rv);
 274 }
 275
 276 ";
 277
 278   (* Struct copy functions. *)
 279
 280   let emit_ocaml_copy_list_function typ =
 281     pr "static CAMLprim value\n";
 282     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
 283     pr "{\n";
 284     pr "  CAMLparam0 ();\n";
 285     pr "  CAMLlocal2 (rv, v);\n";
 286     pr "  unsigned int i;\n";
 287     pr "\n";
 288     pr "  if (%ss->len == 0)\n" typ;
 289     pr "    CAMLreturn (Atom (0));\n";
 290     pr "  else {\n";
 291     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
 292     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
 293     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
 294     pr "      caml_modify (&Field (rv, i), v);\n";
 295     pr "    }\n";
 296     pr "    CAMLreturn (rv);\n";
 297     pr "  }\n";
 298     pr "}\n";
 299     pr "\n";
 300   in
 301
 302   List.iter (
 303     fun (typ, cols) ->
 304       let has_optpercent_col =
 305         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
 306
 307       pr "static CAMLprim value\n";
 308       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
 309       pr "{\n";
 310       pr "  CAMLparam0 ();\n";
 311       if has_optpercent_col then
 312         pr "  CAMLlocal3 (rv, v, v2);\n"
 313       else
 314         pr "  CAMLlocal2 (rv, v);\n";
 315       pr "\n";
 316       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
 317       iteri (
 318         fun i col ->
 319           (match col with
 320            | name, FString ->
 321                pr "  v = caml_copy_string (%s->%s);\n" typ name
 322            | name, FBuffer ->
 323                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
 324                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
 325                  typ name typ name
 326            | name, FUUID ->
 327                pr "  v = caml_alloc_string (32);\n";
 328                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
 329            | name, (FBytes|FInt64|FUInt64) ->
 330                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
 331            | name, (FInt32|FUInt32) ->
 332                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
 333            | name, FOptPercent ->
 334                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
 335                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
 336                pr "    v = caml_alloc (1, 0);\n";
 337                pr "    Store_field (v, 0, v2);\n";
 338                pr "  } else /* None */\n";
 339                pr "    v = Val_int (0);\n";
 340            | name, FChar ->
 341                pr "  v = Val_int (%s->%s);\n" typ name
 342           );
 343           pr "  Store_field (rv, %d, v);\n" i
 344       ) cols;
 345       pr "  CAMLreturn (rv);\n";
 346       pr "}\n";
 347       pr "\n";
 348   ) structs;
 349
 350   (* Emit a copy_TYPE_list function definition only if that function is used. *)
 351   List.iter (
 352     function
 353     | typ, (RStructListOnly | RStructAndList) ->
 354         (* generate the function for typ *)
 355         emit_ocaml_copy_list_function typ
 356     | typ, _ -> () (* empty *)
 357   ) (rstructs_used_by all_functions);
 358
 359   (* The wrappers. *)
 360   List.iter (
 361     fun (name, (ret, args, optargs as style), _, _, _, _, _) ->
 362       pr "/* Automatically generated wrapper for function\n";
 363       pr " * ";
 364       generate_ocaml_prototype name style;
 365       pr " */\n";
 366       pr "\n";
 367
 368       (* If we run into this situation, we'll need to change the
 369        * bindings a little.
 370        *)
 371       if args = [] && optargs <> [] then
 372         failwithf "ocaml bindings don't support args = [], optargs <> []";
 373
 374       let params =
 375         "gv" ::
 376           List.map (fun arg -> name_of_argt arg ^ "v") (optargs @ args) in
 377
 378       let needs_extra_vs =
 379         match ret with RConstOptString _ -> true | _ -> false in
 380
 381       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
 382       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
 383       List.iter (pr ", value %s") (List.tl params); pr ");\n";
 384       pr "\n";
 385
 386       pr "CAMLprim value\n";
 387       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
 388       List.iter (pr ", value %s") (List.tl params);
 389       pr ")\n";
 390       pr "{\n";
 391
 392       (match params with
 393        | [p1; p2; p3; p4; p5] ->
 394            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
 395        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
 396            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
 397            pr "  CAMLxparam%d (%s);\n"
 398              (List.length rest) (String.concat ", " rest)
 399        | ps ->
 400            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
 401       );
 402       if not needs_extra_vs then
 403         pr "  CAMLlocal1 (rv);\n"
 404       else
 405         pr "  CAMLlocal3 (rv, v, v2);\n";
 406       pr "\n";
 407
 408       pr "  guestfs_h *g = Guestfs_val (gv);\n";
 409       pr "  if (g == NULL)\n";
 410       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
 411       pr "\n";
 412
 413       List.iter (
 414         function
 415         | Pathname n
 416         | Device n | Dev_or_Path n
 417         | String n
 418         | FileIn n
 419         | FileOut n
 420         | Key n ->
 421             (* Copy strings in case the GC moves them: RHBZ#604691 *)
 422             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
 423         | OptString n ->
 424             pr "  char *%s =\n" n;
 425             pr "    %sv != Val_int (0) ?\n" n;
 426             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
 427         | BufferIn n ->
 428             pr "  size_t %s_size = caml_string_length (%sv);\n" n n;
 429             pr "  char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n
 430         | StringList n | DeviceList n ->
 431             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
 432         | Bool n ->
 433             pr "  int %s = Bool_val (%sv);\n" n n
 434         | Int n ->
 435             pr "  int %s = Int_val (%sv);\n" n n
 436         | Int64 n ->
 437             pr "  int64_t %s = Int64_val (%sv);\n" n n
 438         | Pointer (t, n) ->
 439             pr "  %s %s = (%s) (intptr_t) Int64_val (%sv);\n" t n t n
 440       ) args;
 441
 442       (* Optional arguments. *)
 443       if optargs <> [] then (
 444         pr "  struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
 445         pr "  struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
 446         let uc_name = String.uppercase name in
 447         List.iter (
 448           fun argt ->
 449             let n = name_of_argt argt in
 450             let uc_n = String.uppercase n in
 451             pr "  if (%sv != Val_int (0)) {\n" n;
 452             pr "    optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
 453             pr "    optargs_s.%s = " n;
 454             (match argt with
 455              | Bool _ -> pr "Bool_val (Field (%sv, 0))" n
 456              | Int _ -> pr "Int_val (Field (%sv, 0))" n
 457              | Int64 _ -> pr "Int64_val (Field (%sv, 0))" n
 458              | String _ ->
 459                  pr "guestfs_safe_strdup (g, String_val (Field (%sv, 0)))" n
 460              | _ -> assert false
 461             );
 462             pr ";\n";
 463             pr "  }\n";
 464         ) optargs
 465       );
 466
 467       (match ret with
 468        | RErr -> pr "  int r;\n"
 469        | RInt _ -> pr "  int r;\n"
 470        | RInt64 _ -> pr "  int64_t r;\n"
 471        | RBool _ -> pr "  int r;\n"
 472        | RConstString _ | RConstOptString _ ->
 473            pr "  const char *r;\n"
 474        | RString _ -> pr "  char *r;\n"
 475        | RStringList _ ->
 476            pr "  size_t i;\n";
 477            pr "  char **r;\n"
 478        | RStruct (_, typ) ->
 479            pr "  struct guestfs_%s *r;\n" typ
 480        | RStructList (_, typ) ->
 481            pr "  struct guestfs_%s_list *r;\n" typ
 482        | RHashtable _ ->
 483            pr "  size_t i;\n";
 484            pr "  char **r;\n"
 485        | RBufferOut _ ->
 486            pr "  char *r;\n";
 487            pr "  size_t size;\n"
 488       );
 489       pr "\n";
 490
 491       pr "  caml_enter_blocking_section ();\n";
 492       if optargs = [] then
 493         pr "  r = guestfs_%s " name
 494       else
 495         pr "  r = guestfs_%s_argv " name;
 496       generate_c_call_args ~handle:"g" style;
 497       pr ";\n";
 498       pr "  caml_leave_blocking_section ();\n";
 499
 500       (* Free strings if we copied them above. *)
 501       List.iter (
 502         function
 503         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
 504         | FileIn n | FileOut n | BufferIn n | Key n ->
 505             pr "  free (%s);\n" n
 506         | StringList n | DeviceList n ->
 507             pr "  ocaml_guestfs_free_strings (%s);\n" n;
 508         | Bool _ | Int _ | Int64 _ | Pointer _ -> ()
 509       ) args;
 510       List.iter (
 511         function
 512         | String n ->
 513             pr "  if (%sv != Val_int (0))\n" n;
 514             pr "    free ((char *) optargs_s.%s);\n" n
 515         | Bool _ | Int _ | Int64 _
 516         | Pathname _ | Device _ | Dev_or_Path _ | OptString _
 517         | FileIn _ | FileOut _ | BufferIn _ | Key _
 518         | StringList _ | DeviceList _ | Pointer _ -> ()
 519       ) optargs;
 520
 521       (match errcode_of_ret ret with
 522        | `CannotReturnError -> ()
 523        | `ErrorIsMinusOne ->
 524            pr "  if (r == -1)\n";
 525            pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
 526        | `ErrorIsNULL ->
 527            pr "  if (r == NULL)\n";
 528            pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
 529       );
 530       pr "\n";
 531
 532       (match ret with
 533        | RErr -> pr "  rv = Val_unit;\n"
 534        | RInt _ -> pr "  rv = Val_int (r);\n"
 535        | RInt64 _ ->
 536            pr "  rv = caml_copy_int64 (r);\n"
 537        | RBool _ -> pr "  rv = Val_bool (r);\n"
 538        | RConstString _ ->
 539            pr "  rv = caml_copy_string (r);\n"
 540        | RConstOptString _ ->
 541            pr "  if (r) { /* Some string */\n";
 542            pr "    v = caml_alloc (1, 0);\n";
 543            pr "    v2 = caml_copy_string (r);\n";
 544            pr "    Store_field (v, 0, v2);\n";
 545            pr "  } else /* None */\n";
 546            pr "    v = Val_int (0);\n";
 547        | RString _ ->
 548            pr "  rv = caml_copy_string (r);\n";
 549            pr "  free (r);\n"
 550        | RStringList _ ->
 551            pr "  rv = caml_copy_string_array ((const char **) r);\n";
 552            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
 553            pr "  free (r);\n"
 554        | RStruct (_, typ) ->
 555            pr "  rv = copy_%s (r);\n" typ;
 556            pr "  guestfs_free_%s (r);\n" typ;
 557        | RStructList (_, typ) ->
 558            pr "  rv = copy_%s_list (r);\n" typ;
 559            pr "  guestfs_free_%s_list (r);\n" typ;
 560        | RHashtable _ ->
 561            pr "  rv = copy_table (r);\n";
 562            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
 563            pr "  free (r);\n";
 564        | RBufferOut _ ->
 565            pr "  rv = caml_alloc_string (size);\n";
 566            pr "  memcpy (String_val (rv), r, size);\n";
 567       );
 568
 569       pr "  CAMLreturn (rv);\n";
 570       pr "}\n";
 571       pr "\n";
 572
 573       if List.length params > 5 then (
 574         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
 575         pr "CAMLprim value ";
 576         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
 577         pr "CAMLprim value\n";
 578         pr "ocaml_guestfs_%s_byte (value *argv, int argn ATTRIBUTE_UNUSED)\n"
 579           name;
 580         pr "{\n";
 581         pr "  return ocaml_guestfs_%s (argv[0]" name;
 582         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
 583         pr ");\n";
 584         pr "}\n";
 585         pr "\n"
 586       )
 587   ) all_functions_sorted
 588
 589 and generate_ocaml_structure_decls () =
 590   List.iter (
 591     fun (typ, cols) ->
 592       pr "type %s = {\n" typ;
 593       List.iter (
 594         function
 595         | name, FString -> pr "  %s : string;\n" name
 596         | name, FBuffer -> pr "  %s : string;\n" name
 597         | name, FUUID -> pr "  %s : string;\n" name
 598         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
 599         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
 600         | name, FChar -> pr "  %s : char;\n" name
 601         | name, FOptPercent -> pr "  %s : float option;\n" name
 602       ) cols;
 603       pr "}\n";
 604       pr "\n"
 605   ) structs
 606
 607 and generate_ocaml_prototype ?(is_external = false) name style =
 608   if is_external then pr "external " else pr "val ";
 609   pr "%s : t -> " name;
 610   generate_ocaml_function_type style;
 611   if is_external then (
 612     pr " = ";
 613     let _, args, optargs = style in
 614     if List.length args + List.length optargs + 1 > 5 then
 615       pr "\"ocaml_guestfs_%s_byte\" " name;
 616     pr "\"ocaml_guestfs_%s\"" name
 617   );
 618   pr "\n"
 619
 620 and generate_ocaml_function_type (ret, args, optargs) =
 621   List.iter (
 622     function
 623     | Bool n -> pr "?%s:bool -> " n
 624     | Int n -> pr "?%s:int -> " n
 625     | Int64 n -> pr "?%s:int64 -> " n
 626     | String n -> pr "?%s:string -> " n
 627     | _ -> assert false
 628   ) optargs;
 629   List.iter (
 630     function
 631     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
 632     | BufferIn _ | Key _ -> pr "string -> "
 633     | OptString _ -> pr "string option -> "
 634     | StringList _ | DeviceList _ -> pr "string array -> "
 635     | Bool _ -> pr "bool -> "
 636     | Int _ -> pr "int -> "
 637     | Int64 _ | Pointer _ -> pr "int64 -> "
 638   ) args;
 639   (match ret with
 640    | RErr -> pr "unit" (* all errors are turned into exceptions *)
 641    | RInt _ -> pr "int"
 642    | RInt64 _ -> pr "int64"
 643    | RBool _ -> pr "bool"
 644    | RConstString _ -> pr "string"
 645    | RConstOptString _ -> pr "string option"
 646    | RString _ | RBufferOut _ -> pr "string"
 647    | RStringList _ -> pr "string array"
 648    | RStruct (_, typ) -> pr "%s" typ
 649    | RStructList (_, typ) -> pr "%s array" typ
 650    | RHashtable _ -> pr "(string * string) list"
 651   )