On Mon, Apr 09, 2018 at 04:06:32PM +0200, Pino Toscano wrote:
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 7fb7052a0..03b191ac8 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -490,6 +490,91 @@ let generate_daemon_caml_callbacks_ml () =
else
pr "let init_callbacks () = ()\n"
+let rec generate_daemon_caml_interface modname () =
+ generate_header OCamlStyle GPLv2plus;
+
+ let is_ocaml_module_function = function
+ | { impl = OCaml m } when String.is_prefix m (modname ^ ".") -> true
+ | { impl = OCaml _ } -> false
+ | { impl = C } -> false
+ in
+
+ let ocaml_actions = actions |> (List.filter is_ocaml_module_function) in
+ if ocaml_actions == [] then
+ failwithf "no OCaml implementations for module %s" modname;
+
+ let prefix_length = String.length modname + 1 in
+ List.iter (
+ fun ({ name; style } as f) ->
+ let ocaml_function =
+ match f.impl with
+ | OCaml f -> String.sub f prefix_length (String.length f - prefix_length)
+ | C -> assert false in
+
+ generate_ocaml_daemon_prototype ocaml_function style
+ ) ocaml_actions
+
+and generate_ocaml_daemon_prototype name style =
+ pr "val %s : " name;
+ generate_ocaml_daemon_function_type style;
+ pr "\n"
+
+and generate_ocaml_daemon_function_type (ret, args, optargs) =
+ let type_for_stringt = function
+ | Mountable
+ | Mountable_or_Path -> "Mountable.t"
+ | PlainString
+ | Device
+ | Pathname
+ | FileIn
+ | FileOut
+ | Key
+ | GUID
+ | Filename
+ | Dev_or_Path -> "string"
+ in
+ let type_for_rstringt = function
+ | RMountable -> "Mountable.t"
+ | RPlainString
+ | RDevice -> "string"
+ in
+ List.iter (
+ function
+ | OBool n -> pr "?%s:bool -> " n
+ | OInt n -> pr "?%s:int -> " n
+ | OInt64 n -> pr "?%s:int64 -> " n
+ | OString n -> pr "?%s:string -> " n
+ | OStringList n -> pr "?%s:string array -> " n
+ ) optargs;
+ if args <> [] then
+ List.iter (
+ function
+ | String (typ, _)-> pr "%s -> " (type_for_stringt typ)
+ | BufferIn _ -> pr "string -> "
+ | OptString _ -> pr "string option -> "
+ | StringList (typ, _)-> pr "%s array -> " (type_for_stringt typ)
+ | Bool _ -> pr "bool -> "
+ | Int _ -> pr "int -> "
+ | Int64 _ | Pointer _ -> pr "int64 -> "
+ ) args
+ else
+ pr "unit -> ";
+ (match ret with
+ | RErr -> pr "unit" (* all errors are turned into exceptions *)
+ | RInt _ -> pr "int"
+ | RInt64 _ -> pr "int64"
+ | RBool _ -> pr "bool"
+ | RConstString _ -> pr "string"
+ | RConstOptString _ -> pr "string option"
+ | RString (typ, _) -> pr "%s" (type_for_rstringt typ)
+ | RBufferOut _ -> pr "string"
+ | RStringList (typ, _) -> pr "%s list" (type_for_rstringt typ)
+ | RStruct (_, typ) -> pr "Structs.%s" typ
+ | RStructList (_, typ) -> pr "Structs.%s list" typ
+ | RHashtable (typea, typeb, _) ->
+ pr "(%s * %s) list" (type_for_rstringt typea) (type_for_rstringt
typeb)
+ )
+
(* Generate stubs for the functions implemented in OCaml.
* Basically we implement the do_<name> function here, and
* have it call out to OCaml code.
diff --git a/generator/main.ml b/generator/main.ml
index 34bca68d9..ed75d1005 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -46,6 +46,11 @@ let output_to_subset fs f =
for i = 0 to nr_actions_files-1 do
ksprintf (fun filename -> output_to filename (f actions_subsets.(i))) fs i
done
+let output_to_ocaml_daemon modname =
+ let fn = Char.escaped (Char.lowercase_ascii (String.unsafe_get modname 0)) ^
+ String.sub modname 1 (String.length modname - 1) in
+ output_to (sprintf "daemon/%s.mli" fn)
+ (Daemon.generate_daemon_caml_interface modname)
(* Main program. *)
let () =
@@ -155,6 +160,11 @@ Run it from the top source directory using the command
Daemon.generate_daemon_structs_cleanups_c;
output_to "daemon/structs-cleanups.h"
Daemon.generate_daemon_structs_cleanups_h;
+ let daemon_ocaml_interfaces = [
+ "Blkid"; "Btrfs"; "Devsparts"; "File";
"Filearch"; "Findfs"; "Inspect";
+ "Is"; "Ldm"; "Link"; "Listfs";
"Md"; "Parted"; "Realpath"; "Statvfs";
+ ] in
This list should be generated from the list of APIs, splitting the
OCaml "module.function" fields to get module name.
Also "Mount" is not included in this list (and possibly others, I
didn't check). Mount has a non-generated interface (umount_all) which
I guess is the reason, but unfortunately this reduces the value of
generating these interfaces.
+ List.iter output_to_ocaml_daemon daemon_ocaml_interfaces;
Is there a reason this isn't inlined? It seems a bit awkward
to have the actual body elsewhere in the file.
Rich.
output_to "fish/cmds-gperf.gperf"
Fish.generate_fish_cmds_gperf;
--
2.14.3
_______________________________________________
Libguestfs mailing list
Libguestfs(a)redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs
--
Richard Jones, Virtualization Group, Red Hat
http://people.redhat.com/~rjones
Read my programming and virtualization blog:
http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines. Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v