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@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 _______________________________________________ Libguestfs mailing list Libguestfs@redhat.com https://www.redhat.com/mailman/listinfo/libguestfs