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