Richard W.M. Jones
2017-Nov-21 10:22 UTC
[Libguestfs] [PATCH v3 0/2] common/mlstdutils: Extend the List module.
v2 -> v3: - Renamed List.assoc_ -> List.assoc_lbl. - Rebased on top of current master branch. Rich.
Richard W.M. Jones
2017-Nov-21 10:22 UTC
[Libguestfs] [PATCH v3 1/2] common/mlstdutils: Extend the List module.
We defined a number of functions on lists which are not provided by
the standard library. As with Char and String, let's extend List to
add these new functions to a List pseudo-module (really
Std_utils.List, but called List when you ‘open Std_utils’).
The initial exported functions are all List functions from OCaml 3.11
+ iteri + mapi. We can add other functions as needed.
---
common/mlstdutils/std_utils.ml | 4 ++++
common/mlstdutils/std_utils.mli | 47 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 51 insertions(+)
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 94e9ea1c1..64afa8bd8 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -271,6 +271,10 @@ module String = struct
loop 0
end
+module List = struct
+ include List
+end
+
module Option = struct
let may f = function
| None -> ()
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index c4b05b495..23146fed4 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -134,6 +134,53 @@ module String : sig
end
(** Override the String module from stdlib. *)
+module List : sig
+ val length : 'a list -> int
+ val hd : 'a list -> 'a
+ val tl : 'a list -> 'a list
+ val nth : 'a list -> int -> 'a
+ val rev : 'a list -> 'a list
+ val append : 'a list -> 'a list -> 'a list
+ val rev_append : 'a list -> 'a list -> 'a list
+ val concat : 'a list list -> 'a list
+ val flatten : 'a list list -> 'a list
+ val iter : ('a -> unit) -> 'a list -> unit
+ val iteri : (int -> 'a -> unit) -> 'a list -> unit
+ val map : ('a -> 'b) -> 'a list -> 'b list
+ val mapi : (int -> 'a -> 'b) -> 'a list -> 'b
list
+ val rev_map : ('a -> 'b) -> 'a list -> 'b list
+ val fold_left : ('a -> 'b -> 'a) -> 'a ->
'b list -> 'a
+ val fold_right : ('a -> 'b -> 'b) -> 'a list ->
'b -> 'b
+ val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b
list -> unit
+ val map2 : ('a -> 'b -> 'c) -> 'a list ->
'b list -> 'c list
+ val rev_map2 : ('a -> 'b -> 'c) -> 'a list ->
'b list -> 'c list
+ val fold_left2 : ('a -> 'b -> 'c -> 'a) ->
'a -> 'b list -> 'c list -> 'a
+ val fold_right2 : ('a -> 'b -> 'c -> 'c) ->
'a list -> 'b list -> 'c -> 'c
+ val for_all : ('a -> bool) -> 'a list -> bool
+ val exists : ('a -> bool) -> 'a list -> bool
+ val for_all2 : ('a -> 'b -> bool) -> 'a list ->
'b list -> bool
+ val exists2 : ('a -> 'b -> bool) -> 'a list ->
'b list -> bool
+ val mem : 'a -> 'a list -> bool
+ val memq : 'a -> 'a list -> bool
+ val find : ('a -> bool) -> 'a list -> 'a
+ val filter : ('a -> bool) -> 'a list -> 'a list
+ val find_all : ('a -> bool) -> 'a list -> 'a list
+ val partition : ('a -> bool) -> 'a list -> 'a list *
'a list
+ val assoc : 'a -> ('a * 'b) list -> 'b
+ val assq : 'a -> ('a * 'b) list -> 'b
+ val mem_assoc : 'a -> ('a * 'b) list -> bool
+ val mem_assq : 'a -> ('a * 'b) list -> bool
+ val remove_assoc : 'a -> ('a * 'b) list -> ('a *
'b) list
+ val remove_assq : 'a -> ('a * 'b) list -> ('a *
'b) list
+ val split : ('a * 'b) list -> 'a list * 'b list
+ val combine : 'a list -> 'b list -> ('a * 'b) list
+ val sort : ('a -> 'a -> int) -> 'a list -> 'a
list
+ val stable_sort : ('a -> 'a -> int) -> 'a list ->
'a list
+ val fast_sort : ('a -> 'a -> int) -> 'a list ->
'a list
+ val merge : ('a -> 'a -> int) -> 'a list -> 'a
list -> 'a list
+end
+(** Override the List module from stdlib. *)
+
module Option : sig
val may : ('a -> unit) -> 'a option -> unit
(** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
--
2.13.2
Richard W.M. Jones
2017-Nov-21 10:22 UTC
[Libguestfs] [PATCH v3 2/2] common/mlstdutils: Move list functions into extended List module.
However some existing functions had names which shadowed existing
functions in the List module, so I had to rename them:
assoc -> List.assoc_lbl
append -> List.push_back_list
prepend -> List.push_front_list
This is an extension of the previous commit.
---
builder/builder.ml | 2 +-
builder/cmdline.ml | 8 +-
builder/downloader.ml | 10 +--
builder/languages.ml | 6 +-
builder/osinfo.ml | 2 +-
builder/sigchecker.ml | 2 +-
builder/simplestreams_parser.ml | 6 +-
builder/yajl.ml | 2 +-
common/mlstdutils/std_utils.ml | 167 ++++++++++++++++++-----------------
common/mlstdutils/std_utils.mli | 149 +++++++++++++++----------------
common/mltools/getopt_tests.ml | 6 +-
common/mltools/tools_utils.ml | 2 +-
common/mltools/xpath_helpers.ml | 2 +-
customize/customize_main.ml | 4 +-
customize/customize_run.ml | 2 +-
daemon/inspect.ml | 6 +-
daemon/inspect_fs_unix_fstab.ml | 2 +-
daemon/inspect_fs_windows.ml | 4 +-
daemon/listfs.ml | 12 +--
daemon/lvm.ml | 2 +-
daemon/mount.ml | 22 ++---
daemon/parted.ml | 14 +--
dib/cmdline.ml | 14 +--
dib/dib.ml | 2 +-
dib/elements.ml | 2 +-
dib/output_format.ml | 4 +-
generator/UEFI.ml | 2 +-
generator/customize.ml | 20 ++---
generator/tests_c_api.ml | 2 +-
resize/resize.ml | 4 +-
sparsify/cmdline.ml | 4 +-
sparsify/utils.ml | 2 +-
sysprep/main.ml | 4 +-
sysprep/sysprep_operation.ml | 4 +-
sysprep/sysprep_operation_script.ml | 2 +-
v2v/DOM.ml | 2 +-
v2v/cmdline.ml | 6 +-
v2v/convert_linux.ml | 16 ++--
v2v/convert_windows.ml | 2 +-
v2v/copy_to_local.ml | 10 +--
v2v/create_libvirt_xml.ml | 42 ++++-----
v2v/create_ovf.ml | 24 ++---
v2v/input_libvirt_vddk.ml | 2 +-
v2v/input_ova.ml | 2 +-
v2v/input_vmx.ml | 6 +-
v2v/linux_bootloaders.ml | 2 +-
v2v/linux_kernels.ml | 6 +-
v2v/modules_list.ml | 6 +-
v2v/output_glance.ml | 20 ++---
v2v/output_qemu.ml | 8 +-
v2v/output_rhv.ml | 2 +-
v2v/output_vdsm.ml | 4 +-
v2v/parse_libvirt_xml.ml | 8 +-
v2v/parse_ovf_from_ova.ml | 6 +-
v2v/parse_vmx.ml | 2 +-
v2v/test-harness/v2v_test_harness.ml | 4 +-
v2v/v2v.ml | 6 +-
v2v/vCenter.ml | 6 +-
58 files changed, 347 insertions(+), 343 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 3f7c79bc9..9b907ac8e 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -462,7 +462,7 @@ let main () in
(* Add a transition to the returned list. *)
- let tr task otags = push_front (task, weight task otags, otags) ret in
+ let tr task otags = List.push_front (task, weight task otags, otags) ret in
(* Since the final plan won't run in parallel, we don't only need
* to choose unique tempfiles per transition, so this is OK:
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 8cbd4ca68..2b56bd9e6 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -73,7 +73,7 @@ let parse_cmdline () | "auto" ->
attach_format := None
| s -> attach_format := Some s
in
- let attach_disk s = push_front (!attach_format, s) attach in
+ let attach_disk s = List.push_front (!attach_format, s) attach in
let cache = ref Paths.xdg_cache_home in
let set_cache arg = cache := Some arg in
@@ -85,7 +85,7 @@ let parse_cmdline () let delete_on_failure = ref true in
let fingerprints = ref [] in
- let add_fingerprint arg = push_front arg fingerprints in
+ let add_fingerprint arg = List.push_front arg fingerprints in
let format = ref "" in
let gpg @@ -119,7 +119,7 @@ let parse_cmdline () let set_smp arg = smp :=
Some arg in
let sources = ref [] in
- let add_source arg = push_front arg sources in
+ let add_source arg = List.push_front arg sources in
let sync = ref true in
let warn_if_partition = ref true in
@@ -176,7 +176,7 @@ let parse_cmdline () let argspec = argspec @
customize_argspec in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: build virtual machine images quickly
diff --git a/builder/downloader.ml b/builder/downloader.ml
index b1119bae4..424c9cd34 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -103,8 +103,8 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename (* Get the status code first to ensure the file exists. *)
let curl_h let curl_args = ref common_args in
- if not (verbose ()) then append curl_args quiet_args;
- append curl_args [
+ if not (verbose ()) then List.push_back_list curl_args quiet_args;
+ List.push_back_list curl_args [
"output", Some "/dev/null"; (* Write output to
/dev/null. *)
"head", None; (* Request only HEAD. *)
"write-out", Some "%{http_code}" (* HTTP status
code to stdout. *)
@@ -128,11 +128,11 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename (* Now download the file. *)
let curl_h let curl_args = ref common_args in
- push_back curl_args ("output", Some filename_new);
+ List.push_back curl_args ("output", Some filename_new);
if not (verbose ()) then (
- if progress_bar then push_back curl_args ("progress-bar",
None)
- else append curl_args quiet_args
+ if progress_bar then List.push_back curl_args
("progress-bar", None)
+ else List.push_back_list curl_args quiet_args
);
Curl.create ~curl:t.curl ~tmpdir:t.tmpdir !curl_args in
diff --git a/builder/languages.ml b/builder/languages.ml
index e97b1e3da..18b9e1b41 100644
--- a/builder/languages.ml
+++ b/builder/languages.ml
@@ -30,10 +30,10 @@ let split_locale loc let territory = match_or_empty 3
in
(match territory with
| "" -> ()
- | territory -> push_front (lang ^ "_" ^ territory) l);
- push_front lang l;
+ | territory -> List.push_front (lang ^ "_" ^ territory) l);
+ List.push_front lang l;
);
- push_front "" l;
+ List.push_front "" l;
List.rev !l
let languages () diff --git a/builder/osinfo.ml b/builder/osinfo.ml
index 3727df82b..aff132742 100644
--- a/builder/osinfo.ml
+++ b/builder/osinfo.ml
@@ -45,7 +45,7 @@ let rec fold fn base
let files List.flatten (
- filter_map (
+ List.filter_map (
fun (path, f) ->
if is_directory path then Some (f path)
(* This is not an error: RHBZ#948324. *)
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml
index d7fba405b..088674d66 100644
--- a/builder/sigchecker.ml
+++ b/builder/sigchecker.ml
@@ -82,7 +82,7 @@ let import_keyfile ~gpg ~gpghome ~tmpdir ?(trust = true)
keyfile (match !current with
| None -> ()
| Some k ->
- if String.is_suffix id k then push_front id subkeys;
+ if String.is_suffix id k then List.push_front id subkeys;
current := None
)
| _ -> ()
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 75592e377..a37d5a8a3 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -60,7 +60,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
uri format;
let index = Array.to_list (object_get_object "index" tree) in
- filter_map (
+ List.filter_map (
fun (_, desc) ->
let format = object_get_string "format" desc in
let datatype = object_get_string "datatype" desc in
@@ -81,11 +81,11 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
let products_node = object_get_object "products" tree in
let products = Array.to_list products_node in
- filter_map (
+ List.filter_map (
fun (prod, prod_desc) ->
let arch = object_get_string "arch" prod_desc in
let prods = Array.to_list (object_get_object "versions"
prod_desc) in
- let prods = filter_map (
+ let prods = List.filter_map (
fun (rel, rel_desc) ->
let pubname = objects_get_string "pubname" [rel_desc;
prod_desc] in
let items = object_find_object "items" rel_desc in
diff --git a/builder/yajl.ml b/builder/yajl.ml
index a555baa22..d95f3932a 100644
--- a/builder/yajl.ml
+++ b/builder/yajl.ml
@@ -55,7 +55,7 @@ let object_find_object key yv | _ -> error (f_"the
value for the key ‘%s’ is not an object") key
let object_find_objects fn = function
- | Yajl_object o -> filter_map fn (Array.to_list o)
+ | Yajl_object o -> List.filter_map fn (Array.to_list o)
| _ -> error (f_"the value is not an object")
let object_get_object key yv diff --git a/common/mlstdutils/std_utils.ml
b/common/mlstdutils/std_utils.ml
index 64afa8bd8..fd5f04db5 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -273,6 +273,90 @@ end
module List = struct
include List
+
+ (* Drop elements from a list while a predicate is true. *)
+ let rec dropwhile f = function
+ | [] -> []
+ | x :: xs when f x -> dropwhile f xs
+ | xs -> xs
+
+ (* Take elements from a list while a predicate is true. *)
+ let rec takewhile f = function
+ | x :: xs when f x -> x :: takewhile f xs
+ | _ -> []
+
+ let rec filter_map f = function
+ | [] -> []
+ | x :: xs ->
+ match f x with
+ | Some y -> y :: filter_map f xs
+ | None -> filter_map f xs
+
+ let rec find_map f = function
+ | [] -> raise Not_found
+ | x :: xs ->
+ match f x with
+ | Some y -> y
+ | None -> find_map f xs
+
+ let rec combine3 xs ys zs + match xs, ys, zs with
+ | [], [], [] -> []
+ | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs
+ | _ -> invalid_arg "combine3"
+
+ let rec assoc_lbl ?(cmp = compare) ~default x = function
+ | [] -> default
+ | (y, y') :: _ when cmp x y = 0 -> y'
+ | _ :: ys -> assoc_lbl ~cmp ~default x ys
+
+ let uniq ?(cmp = Pervasives.compare) xs + let rec loop acc = function
+ | [] -> acc
+ | [x] -> x :: acc
+ | x :: (y :: _ as xs) when cmp x y = 0 ->
+ loop acc xs
+ | x :: (y :: _ as xs) ->
+ loop (x :: acc) xs
+ in
+ List.rev (loop [] xs)
+
+ (* This is present in OCaml 4.04, so we can remove it when
+ * we depend on OCaml >= 4.04.
+ *)
+ let sort_uniq ?(cmp = Pervasives.compare) xs + let xs = List.sort cmp
xs in
+ let xs = uniq ~cmp xs in
+ xs
+
+ let remove_duplicates xs + let h = Hashtbl.create (List.length xs) in
+ let rec loop = function
+ | [] -> []
+ | x :: xs when Hashtbl.mem h x -> xs
+ | x :: xs -> Hashtbl.add h x true; x :: loop xs
+ in
+ loop xs
+
+ let push_back xsp x = xsp := !xsp @ [x]
+ let push_front x xsp = xsp := x :: !xsp
+ let pop_back xsp + let x, xs + match List.rev !xsp with
+ | x :: xs -> x, xs
+ | [] -> failwith "pop" in
+ xsp := List.rev xs;
+ x
+ let pop_front xsp + let x, xs + match !xsp with
+ | x :: xs -> x, xs
+ | [] -> failwith "shift" in
+ xsp := xs;
+ x
+
+ let push_back_list xsp xs = xsp := !xsp @ xs
+ let push_front_list xs xsp = xsp := xs @ !xsp
end
module Option = struct
@@ -503,87 +587,6 @@ and _wrap_find_next_break i len str
and output_spaces chan n = for i = 0 to n-1 do output_char chan ' '
done
-(* Drop elements from a list while a predicate is true. *)
-let rec dropwhile f = function
- | [] -> []
- | x :: xs when f x -> dropwhile f xs
- | xs -> xs
-
-(* Take elements from a list while a predicate is true. *)
-let rec takewhile f = function
- | x :: xs when f x -> x :: takewhile f xs
- | _ -> []
-
-let rec filter_map f = function
- | [] -> []
- | x :: xs ->
- match f x with
- | Some y -> y :: filter_map f xs
- | None -> filter_map f xs
-
-let rec find_map f = function
- | [] -> raise Not_found
- | x :: xs ->
- match f x with
- | Some y -> y
- | None -> find_map f xs
-
-let rec combine3 xs ys zs - match xs, ys, zs with
- | [], [], [] -> []
- | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs
- | _ -> invalid_arg "combine3"
-
-let rec assoc ?(cmp = compare) ~default x = function
- | [] -> default
- | (y, y') :: _ when cmp x y = 0 -> y'
- | _ :: ys -> assoc ~cmp ~default x ys
-
-let uniq ?(cmp = Pervasives.compare) xs - let rec loop acc = function
- | [] -> acc
- | [x] -> x :: acc
- | x :: (y :: _ as xs) when cmp x y = 0 ->
- loop acc xs
- | x :: (y :: _ as xs) ->
- loop (x :: acc) xs
- in
- List.rev (loop [] xs)
-
-let sort_uniq ?(cmp = Pervasives.compare) xs - let xs = List.sort cmp xs in
- let xs = uniq ~cmp xs in
- xs
-
-let remove_duplicates xs - let h = Hashtbl.create (List.length xs) in
- let rec loop = function
- | [] -> []
- | x :: xs when Hashtbl.mem h x -> xs
- | x :: xs -> Hashtbl.add h x true; x :: loop xs
- in
- loop xs
-
-let push_back xsp x = xsp := !xsp @ [x]
-let push_front x xsp = xsp := x :: !xsp
-let pop_back xsp - let x, xs - match List.rev !xsp with
- | x :: xs -> x, xs
- | [] -> failwith "pop" in
- xsp := List.rev xs;
- x
-let pop_front xsp - let x, xs - match !xsp with
- | x :: xs -> x, xs
- | [] -> failwith "shift" in
- xsp := xs;
- x
-
-let append xsp xs = xsp := !xsp @ xs
-let prepend xs xsp = xsp := xs @ !xsp
-
let unique = let i = ref 0 in fun () -> incr i; !i
type ('a, 'b) maybe = Either of 'a | Or of 'b
@@ -603,7 +606,7 @@ let which executable let paths try String.nsplit
":" (Sys.getenv "PATH")
with Not_found -> [] in
- let paths = filter_map (
+ let paths = List.filter_map (
fun p ->
let path = p // executable in
try Unix.access path [Unix.X_OK]; Some path
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index 23146fed4..5f74db5d6 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -178,6 +178,81 @@ module List : sig
val stable_sort : ('a -> 'a -> int) -> 'a list ->
'a list
val fast_sort : ('a -> 'a -> int) -> 'a list ->
'a list
val merge : ('a -> 'a -> int) -> 'a list -> 'a
list -> 'a list
+
+ val dropwhile : ('a -> bool) -> 'a list -> 'a list
+ (** [dropwhile f xs] drops leading elements from [xs] until
+ [f] returns false. *)
+ val takewhile : ('a -> bool) -> 'a list -> 'a list
+ (** [takewhile f xs] takes leading elements from [xs] until
+ [f] returns false.
+
+ For any list [xs] and function [f],
+ [xs = takewhile f xs @ dropwhile f xs] *)
+ val filter_map : ('a -> 'b option) -> 'a list ->
'b list
+ (** [filter_map f xs] applies [f] to each element of [xs]. If
+ [f x] returns [Some y] then [y] is added to the returned list. *)
+ val find_map : ('a -> 'b option) -> 'a list -> 'b
+ (** [find_map f xs] applies [f] to each element of [xs] until
+ [f x] returns [Some y]. It returns [y]. If we exhaust the
+ list then this raises [Not_found]. *)
+
+ val combine3 : 'a list -> 'b list -> 'c list ->
('a * 'b * 'c) list
+ (** Like {!List.combine} but for triples.
+ All lists must be the same length. *)
+
+ val assoc_lbl : ?cmp:('a -> 'a -> int) -> default:'b
-> 'a -> ('a * 'b) list -> 'b
+ (** Like {!assoc} but with a user-defined comparison function, and
+ instead of raising [Not_found], it returns the [~default] value. *)
+
+ val uniq : ?cmp:('a -> 'a -> int) -> 'a list ->
'a list
+ (** Uniquify a list (the list must be sorted first). *)
+
+ val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list
-> 'a list
+ (** Sort and uniquify a list. *)
+
+ val remove_duplicates : 'a list -> 'a list
+ (** Remove duplicates from an unsorted list; useful when the order
+ of the elements matter.
+
+ Please use [sort_uniq] when the order does not matter. *)
+
+ val push_back : 'a list ref -> 'a -> unit
+ val push_front : 'a -> 'a list ref -> unit
+ val pop_back : 'a list ref -> 'a
+ val pop_front : 'a list ref -> 'a
+ (** Imperative list manipulation functions, similar to C++ STL
+ functions with the same names. (Although the names are similar,
+ the computational complexity of the functions is quite different.)
+
+ These operate on list references, and each function modifies the
+ list reference that is passed to it.
+
+ [push_back xsp x] appends the element [x] to the end of the list
+ [xsp]. This function is not tail-recursive.
+
+ [push_front x xsp] prepends the element [x] to the head of the
+ list [xsp]. (The arguments are reversed compared to the same Perl
+ function, but OCaml is type safe so that's OK.)
+
+ [pop_back xsp] removes the last element of the list [xsp] and
+ returns it. The list is modified to become the list minus the
+ final element. If a zero-length list is passed in, this raises
+ [Failure "pop_back"]. This function is not tail-recursive.
+
+ [pop_front xsp] removes the head element of the list [xsp] and
+ returns it. The list is modified to become the tail of the list.
+ If a zero-length list is passed in, this raises [Failure
+ "pop_front"]. *)
+
+ val push_back_list : 'a list ref -> 'a list -> unit
+ val push_front_list : 'a list -> 'a list ref -> unit
+ (** More imperative list manipulation functions.
+
+ [push_back_list] is like {!push_back} above, except it appends
+ a list to the list reference. This function is not tail-recursive.
+
+ [push_front_list] is like {!push_front} above, except it prepends
+ a list to the list reference. *)
end
(** Override the List module from stdlib. *)
@@ -254,80 +329,6 @@ val wrap : ?chan:out_channel -> ?indent:int -> string
-> unit
val output_spaces : out_channel -> int -> unit
(** Write [n] spaces to [out_channel]. *)
-val dropwhile : ('a -> bool) -> 'a list -> 'a list
-(** [dropwhile f xs] drops leading elements from [xs] until
- [f] returns false. *)
-val takewhile : ('a -> bool) -> 'a list -> 'a list
-(** [takewhile f xs] takes leading elements from [xs] until
- [f] returns false.
-
- For any list [xs] and function [f],
- [xs = takewhile f xs @ dropwhile f xs] *)
-val filter_map : ('a -> 'b option) -> 'a list -> 'b
list
-(** [filter_map f xs] applies [f] to each element of [xs]. If
- [f x] returns [Some y] then [y] is added to the returned list. *)
-val find_map : ('a -> 'b option) -> 'a list -> 'b
-(** [find_map f xs] applies [f] to each element of [xs] until
- [f x] returns [Some y]. It returns [y]. If we exhaust the
- list then this raises [Not_found]. *)
-
-val combine3 : 'a list -> 'b list -> 'c list -> ('a *
'b * 'c) list
-(** Like {!List.combine} but for triples. All lists must be the same length.
*)
-
-val assoc : ?cmp:('a -> 'a -> int) -> default:'b ->
'a -> ('a * 'b) list -> 'b
-(** Like {!List.assoc} but with a user-defined comparison function, and
- instead of raising [Not_found], it returns the [~default] value. *)
-
-val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a
list
-(** Uniquify a list (the list must be sorted first). *)
-
-val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list ->
'a list
-(** Sort and uniquify a list. *)
-
-val remove_duplicates : 'a list -> 'a list
-(** Remove duplicates from an unsorted list; useful when the order
- of the elements matter.
-
- Please use [sort_uniq] when the order does not matter. *)
-
-val push_back : 'a list ref -> 'a -> unit
-val push_front : 'a -> 'a list ref -> unit
-val pop_back : 'a list ref -> 'a
-val pop_front : 'a list ref -> 'a
-(** Imperative list manipulation functions, similar to C++ STL
- functions with the same names. (Although the names are similar,
- the computational complexity of the functions is quite different.)
-
- These operate on list references, and each function modifies the
- list reference that is passed to it.
-
- [push_back xsp x] appends the element [x] to the end of the list
- [xsp]. This function is not tail-recursive.
-
- [push_front x xsp] prepends the element [x] to the head of the
- list [xsp]. (The arguments are reversed compared to the same Perl
- function, but OCaml is type safe so that's OK.)
-
- [pop_back xsp] removes the last element of the list [xsp] and
- returns it. The list is modified to become the list minus the
- final element. If a zero-length list is passed in, this raises
- [Failure "pop_back"]. This function is not tail-recursive.
-
- [pop_front xsp] removes the head element of the list [xsp] and
- returns it. The list is modified to become the tail of the list.
- If a zero-length list is passed in, this raises [Failure
- "pop_front"]. *)
-
-val append : 'a list ref -> 'a list -> unit
-val prepend : 'a list -> 'a list ref -> unit
-(** More imperative list manipulation functions.
-
- [append] is like {!push_back} above, except it appends a list to
- the list reference. This function is not tail-recursive.
-
- [prepend] is like {!push_front} above, except it prepends a list
- to the list reference. *)
-
val unique : unit -> int
(** Returns a unique number each time called. *)
diff --git a/common/mltools/getopt_tests.ml b/common/mltools/getopt_tests.ml
index 1314d3bca..751bf1d5f 100644
--- a/common/mltools/getopt_tests.ml
+++ b/common/mltools/getopt_tests.ml
@@ -27,13 +27,13 @@ open Tools_utils
open Getopt.OptionName
let adds = ref []
-let add_string = push_back adds
+let add_string = List.push_back adds
let anons = ref []
-let anon_fun = push_back anons
+let anon_fun = List.push_back anons
let ints = ref []
-let add_int = push_back ints
+let add_int = List.push_back ints
let clear_flag = ref true
let set_flag = ref false
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index a6a0c7018..95658a75f 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -286,7 +286,7 @@ let rec run_commands ?(echo_cmd = true) cmds
res.(i) <- code;
None
) cmds in
- let pids = filter_map identity pids in
+ let pids = List.filter_map identity pids in
let pids = ref pids in
while !pids <> [] do
let pid, stat = Unix.waitpid [] 0 in
diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml
index d2bfd3fb9..b2afa03dd 100644
--- a/common/mltools/xpath_helpers.ml
+++ b/common/mltools/xpath_helpers.ml
@@ -46,6 +46,6 @@ let xpath_get_nodes xpathctx expr let nodes = ref [] in
for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
let node = Xml.xpathobj_node obj i in
- push_front node nodes
+ List.push_front node nodes
done;
List.rev !nodes
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index d2bdc0b08..8ba4f5ce7 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -39,7 +39,7 @@ let main () | "auto" -> attach_format :=
None
| s -> attach_format := Some s
in
- let attach_disk s = push_front (!attach_format, s) attach in
+ let attach_disk s = List.push_front (!attach_format, s) attach in
let domain = ref None in
let dryrun = ref false in
let files = ref [] in
@@ -63,7 +63,7 @@ let main () error (f_"error parsing URI
'%s'. Look for error messages printed above.")
arg in
let format = match !format with "auto" -> None | fmt ->
Some fmt in
- push_front (uri, format) files;
+ List.push_front (uri, format) files;
format_consumed := true
and set_domain dom if !domain <> None then
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index 3dbb68701..f92e9a199 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -66,7 +66,7 @@ let run (g : G.guestfs) root (ops : ops) * Also catch
errors and dump the log file completely on error.
*)
let env_vars - filter_map (
+ List.filter_map (
fun name ->
try Some (sprintf "export %s=%s" name (quote (Sys.getenv
name)))
with Not_found -> None
diff --git a/daemon/inspect.ml b/daemon/inspect.ml
index ecc45e7c7..11e977947 100644
--- a/daemon/inspect.ml
+++ b/daemon/inspect.ml
@@ -33,7 +33,7 @@ let rec inspect_os () let fses = Listfs.list_filesystems ()
in
let fses - filter_map (
+ List.filter_map (
fun (mountable, vfs_type) ->
Inspect_fs.check_for_filesystem_on mountable vfs_type
) fses in
@@ -228,7 +228,7 @@ and inspect_get_roots () let fses =
!Inspect_types.inspect_fses in
let roots - filter_map (
+ List.filter_map (
fun fs -> try Some (root_of_fs fs) with Invalid_argument _ -> None
) fses in
if verbose () then (
@@ -257,7 +257,7 @@ and inspect_get_mountpoints root_mountable if fstab = []
then
[ "/", root_mountable ]
else (
- filter_map (
+ List.filter_map (
fun (mountable, mp) ->
if String.length mp > 0 && mp.[0] = '/' then
Some (mp, mountable)
diff --git a/daemon/inspect_fs_unix_fstab.ml b/daemon/inspect_fs_unix_fstab.ml
index e3c7fd1cd..658e0cf10 100644
--- a/daemon/inspect_fs_unix_fstab.ml
+++ b/daemon/inspect_fs_unix_fstab.ml
@@ -52,7 +52,7 @@ and check_fstab_aug mdadm_conf root_mountable os_type aug
let path = "/files/etc/fstab/*[label() != '#comment']" in
let entries = aug_matches_noerrors aug path in
- filter_map (check_fstab_entry md_map root_mountable os_type aug) entries
+ List.filter_map (check_fstab_entry md_map root_mountable os_type aug) entries
and check_fstab_entry md_map root_mountable os_type aug entry if verbose ()
then
diff --git a/daemon/inspect_fs_windows.ml b/daemon/inspect_fs_windows.ml
index 50f743450..d4d045973 100644
--- a/daemon/inspect_fs_windows.ml
+++ b/daemon/inspect_fs_windows.ml
@@ -110,7 +110,7 @@ and get_windows_systemroot_from_boot_ini boot_ini_path
| Some oses ->
(* Rewrite multi|scsi lines, removing any which we cannot parse. *)
let oses - filter_map (
+ List.filter_map (
fun line ->
if PCRE.matches re_boot_ini_os line then (
let ctrlr_type = PCRE.sub 1
@@ -312,7 +312,7 @@ and get_drive_mappings h root data let values =
Hivex.node_values h node in
let values = Array.to_list values in
let values - filter_map (
+ List.filter_map (
fun value ->
let key = Hivex.value_key h value in
let keylen = String.length key in
diff --git a/daemon/listfs.ml b/daemon/listfs.ml
index 610a1ea78..1ccd3bead 100644
--- a/daemon/listfs.ml
+++ b/daemon/listfs.ml
@@ -44,14 +44,14 @@ let rec list_filesystems () ) devices in
(* Use vfs-type to check for filesystems on devices. *)
- let ret = filter_map check_with_vfs_type devices in
+ let ret = List.filter_map check_with_vfs_type devices in
(* Use vfs-type to check for filesystems on partitions, but
* ignore MBR partition type 42 used by LDM.
*)
let ret ret @
- filter_map (
+ List.filter_map (
fun part ->
if not has_ldm || not (is_mbr_partition_type_42 part) then
check_with_vfs_type part
@@ -60,14 +60,14 @@ let rec list_filesystems () ) partitions in
(* Use vfs-type to check for filesystems on md devices. *)
- let ret = ret @ filter_map check_with_vfs_type mds in
+ let ret = ret @ List.filter_map check_with_vfs_type mds in
(* LVM. *)
let ret if has_lvm2 then (
let lvs = Lvm.lvs () in
(* Use vfs-type to check for filesystems on LVs. *)
- ret @ filter_map check_with_vfs_type lvs
+ ret @ List.filter_map check_with_vfs_type lvs
)
else ret in
@@ -78,8 +78,8 @@ let rec list_filesystems () let ldmparts =
Ldm.list_ldm_partitions () in
(* Use vfs-type to check for filesystems on Windows dynamic disks. *)
ret @
- filter_map check_with_vfs_type ldmvols @
- filter_map check_with_vfs_type ldmparts
+ List.filter_map check_with_vfs_type ldmvols @
+ List.filter_map check_with_vfs_type ldmparts
)
else ret in
diff --git a/daemon/lvm.ml b/daemon/lvm.ml
index 4210c2fb3..39c6d365b 100644
--- a/daemon/lvm.ml
+++ b/daemon/lvm.ml
@@ -84,7 +84,7 @@ and filter_convert_old_lvs_output out let lines =
List.filter ((<>) "") lines in
let lines = List.filter ((<>) "unknown device") lines in
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
match String.nsplit ":" line with
| [ lv_attr; vg_name; lv_name ] ->
diff --git a/daemon/mount.ml b/daemon/mount.ml
index fbf4ddc39..db530b138 100644
--- a/daemon/mount.ml
+++ b/daemon/mount.ml
@@ -34,26 +34,26 @@ let mount_vfs options vfs mountable mountpoint (match
options, mountable.m_type with
| (None | Some ""), (MountableDevice | MountablePath) -> ()
| Some options, (MountableDevice | MountablePath) ->
- push_back args "-o";
- push_back args options
+ List.push_back args "-o";
+ List.push_back args options
| (None | Some ""), MountableBtrfsVol subvol ->
- push_back args "-o";
- push_back args ("subvol=" ^ subvol)
+ List.push_back args "-o";
+ List.push_back args ("subvol=" ^ subvol)
| Some options, MountableBtrfsVol subvol ->
- push_back args "-o";
- push_back args ("subvol=" ^ subvol ^ "," ^ options)
+ List.push_back args "-o";
+ List.push_back args ("subvol=" ^ subvol ^ "," ^
options)
);
(* -t vfs *)
(match vfs with
| None | Some "" -> ()
| Some t ->
- push_back args "-t";
- push_back args t
+ List.push_back args "-t";
+ List.push_back args t
);
- push_back args mountable.m_device;
- push_back args mp;
+ List.push_back args mountable.m_device;
+ List.push_back args mp;
ignore (command "mount" !args)
@@ -105,7 +105,7 @@ let rec umount_all () (String.is_prefix mp
sysroot &&
String.length mp > sysroot_len &&
mp.[sysroot_len] = '/') then
- push_front mp mps
+ List.push_front mp mps
)
) info;
diff --git a/daemon/parted.ml b/daemon/parted.ml
index 2e8e744d0..7721b64ca 100644
--- a/daemon/parted.ml
+++ b/daemon/parted.ml
@@ -65,13 +65,13 @@ let print_partition_table_machine_readable device
udev_settle ();
let args = ref [] in
- push_back args "-m";
- push_back args "-s";
- push_back args "--";
- push_back args device;
- push_back args "unit";
- push_back args "b";
- push_back args "print";
+ List.push_back args "-m";
+ List.push_back args "-s";
+ List.push_back args "--";
+ List.push_back args device;
+ List.push_back args "unit";
+ List.push_back args "b";
+ List.push_back args "print";
let out try command "parted" !args
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 9f0a70a72..d013a181e 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -71,16 +71,16 @@ read the man page virt-dib(1).
prog in
let elements = ref [] in
- let append_element element = push_front element elements in
+ let append_element element = List.push_front element elements in
let excluded_elements = ref [] in
- let append_excluded_element element = push_front element excluded_elements in
+ let append_excluded_element element = List.push_front element
excluded_elements in
let element_paths = ref [] in
- let append_element_path arg = push_front arg element_paths in
+ let append_element_path arg = List.push_front arg element_paths in
let excluded_scripts = ref [] in
- let append_excluded_script arg = push_front arg excluded_scripts in
+ let append_excluded_script arg = List.push_front arg excluded_scripts in
let debug = ref 0 in
let set_debug arg @@ -107,7 +107,7 @@ read the man page virt-dib(1).
let formats = ref None in
let set_format arg - let fmts = remove_duplicates (String.nsplit
"," arg) in
+ let fmts = List.remove_duplicates (String.nsplit "," arg) in
let fmtset List.fold_left (
fun fmtset fmt ->
@@ -118,7 +118,7 @@ read the man page virt-dib(1).
formats := Some fmtset in
let envvars = ref [] in
- let append_envvar arg = push_front arg envvars in
+ let append_envvar arg = List.push_front arg envvars in
let use_base = ref true in
@@ -149,7 +149,7 @@ read the man page virt-dib(1).
let extra_packages = ref [] in
let append_extra_packages arg - prepend (List.rev (String.nsplit
"," arg)) extra_packages in
+ List.push_front_list (List.rev (String.nsplit "," arg))
extra_packages in
let checksum = ref false in
diff --git a/dib/dib.ml b/dib/dib.ml
index bbe83eb39..94ad3003a 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -41,7 +41,7 @@ let exclude_elements elements = function
| excl -> StringSet.filter (not_in_list excl) elements
let read_envvars envvars - filter_map (
+ List.filter_map (
fun var ->
let i = String.find var "=" in
if i = -1 then (
diff --git a/dib/elements.ml b/dib/elements.ml
index d8eb6c145..5a904baef 100644
--- a/dib/elements.ml
+++ b/dib/elements.ml
@@ -82,7 +82,7 @@ let load_scripts (g : Guestfs.guestfs) path | _ ->
false
) listing in
let scripts = List.filter (fun x -> valid_script_name x.Guestfs.name)
scripts in
- filter_map (
+ List.filter_map (
fun x ->
let { Guestfs.st_mode = mode } = g#statns (path ^ "/" ^
x.Guestfs.name) in
if mode &^ 0o111_L > 0_L then Some x.Guestfs.name
diff --git a/dib/output_format.ml b/dib/output_format.ml
index 79a90ae35..a39e807fe 100644
--- a/dib/output_format.ml
+++ b/dib/output_format.ml
@@ -69,7 +69,7 @@ let set_cardinal set FormatSet.cardinal set
let register_format op - push_front op all_formats
+ List.push_front op all_formats
let baked = ref false
let rec bake () @@ -183,7 +183,7 @@ let get_filenames ~formats image_name (*
Run the formats in alphabetical, rather than random order. *)
let formats = List.sort compare_formats (FormatSet.elements formats) in
- filter_map (
+ List.filter_map (
function
| { output_to_file = true; name } ->
Some (output_filename image_name name)
diff --git a/generator/UEFI.ml b/generator/UEFI.ml
index 17418f473..5161e28ee 100644
--- a/generator/UEFI.ml
+++ b/generator/UEFI.ml
@@ -77,7 +77,7 @@ let firmware = [
[];
]
-let arches = sort_uniq (List.map (fun (arch, _, _, _, _) -> arch) firmware)
+let arches = List.sort_uniq (List.map (fun (arch, _, _, _, _) -> arch)
firmware)
let generate_uefi_c () generate_header CStyle LGPLv2plus;
diff --git a/generator/customize.ml b/generator/customize.ml
index 75984c9d5..c278347c1 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -688,7 +688,7 @@ let rec argspec () op_shortdesc = shortdesc;
op_pod_longdesc = longdesc } ->
pr " (\n";
pr " [ L\"%s\" ],\n" name;
- pr " Getopt.Unit (fun () -> push_front %s ops),\n"
discrim;
+ pr " Getopt.Unit (fun () -> List.push_front %s ops),\n"
discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
pr " None, %S;\n" longdesc
@@ -696,7 +696,7 @@ let rec argspec () op_shortdesc = shortdesc;
op_pod_longdesc = longdesc } ->
pr " (\n";
pr " [ L\"%s\" ],\n" name;
- pr " Getopt.String (s_\"%s\", fun s -> push_front
(%s s) ops),\n" v discrim;
+ pr " Getopt.String (s_\"%s\", fun s ->
List.push_front (%s s) ops),\n" v discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
pr " Some %S, %S;\n" v longdesc
@@ -708,7 +708,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let p = split_string_pair \"%s\" s
in\n" name;
- pr " push_front (%s p) ops\n" discrim;
+ pr " List.push_front (%s p) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -721,7 +721,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let ss = split_string_list s in\n";
- pr " push_front (%s ss) ops\n" discrim;
+ pr " List.push_front (%s ss) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -734,7 +734,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let ss = split_links_list \"%s\" s
in\n" name;
- pr " push_front (%s ss) ops\n" discrim;
+ pr " List.push_front (%s ss) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -747,7 +747,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let sel = Password.parse_selector s in\n";
- pr " push_front (%s sel) ops\n" discrim;
+ pr " List.push_front (%s sel) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -761,7 +761,7 @@ let rec argspec () pr " fun s
->\n";
pr " let user, sel = split_string_pair \"%s\" s
in\n" name;
pr " let sel = Password.parse_selector sel in\n";
- pr " push_front (%s (user, sel)) ops\n" discrim;
+ pr " List.push_front (%s (user, sel)) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -775,7 +775,7 @@ let rec argspec () pr " fun s
->\n";
pr " let user, selstr = String.split \":\" s
in\n";
pr " let sel = Ssh_key.parse_selector selstr in\n";
- pr " push_front (%s (user, sel)) ops\n" discrim;
+ pr " List.push_front (%s (user, sel)) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -788,7 +788,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " %s s;\n" fn;
- pr " push_front (%s s) ops\n" discrim;
+ pr " List.push_front (%s s) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -801,7 +801,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let sel = Subscription_manager.parse_pool_selector s
in\n";
- pr " push_front (%s sel) ops\n" discrim;
+ pr " List.push_front (%s sel) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml
index 33da61181..b569b9317 100644
--- a/generator/tests_c_api.ml
+++ b/generator/tests_c_api.ml
@@ -70,7 +70,7 @@ let rec generate_c_api_tests () let hash : (string, bool)
Hashtbl.t = Hashtbl.create 13 in
List.iter (
fun { tests } ->
- let seqs = filter_map (
+ let seqs = List.filter_map (
function
| (_, (Always|IfAvailable _|IfNotCrossAppliance), test, cleanup) ->
Some (seq_of_test test @ cleanup)
diff --git a/resize/resize.ml b/resize/resize.ml
index 384b77a9e..837c3ce9e 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -158,7 +158,7 @@ let main () lv_expands, machine_readable,
ntfsresize_force, output_format,
resizes, resizes_force, shrink, sparse, unknown_fs_mode
- let add xs s = push_front s xs in
+ let add xs s = List.push_front s xs in
let align_first = ref "auto" in
let alignment = ref 128 in
@@ -214,7 +214,7 @@ let main ()
s_"Behaviour on expand unknown filesystems (default: warn)";
] in
let disks = ref [] in
- let anon_fun s = push_front s disks in
+ let anon_fun s = List.push_front s disks in
let usage_msg sprintf (f_"\
%s: resize a virtual machine disk
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 521f6733d..f435bbf5e 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -43,7 +43,7 @@ and mode_t and check_t = [`Ignore|`Continue|`Warn|`Fail]
let parse_cmdline () - let add xs s = push_front s xs in
+ let add xs s = List.push_front s xs in
let check_tmpdir = ref `Warn in
let set_check_tmpdir = function
@@ -78,7 +78,7 @@ let parse_cmdline () [ L"zero" ],
Getopt.String (s_"fs", add zeroes), s_"Zero filesystem";
] in
let disks = ref [] in
- let anon_fun s = push_front s disks in
+ let anon_fun s = List.push_front s disks in
let usage_msg sprintf (f_"\
%s: sparsify a virtual machine disk
diff --git a/sparsify/utils.ml b/sparsify/utils.ml
index facf466a8..7f0c02cf6 100644
--- a/sparsify/utils.ml
+++ b/sparsify/utils.ml
@@ -27,7 +27,7 @@ module G = Guestfs
(* Return true if the filesystem is a read-only LV (RHBZ#1185561). *)
let is_read_only_lv (g : G.guestfs) let lvs = Array.to_list (g#lvs_full ())
in
- let ro_uuids = filter_map (
+ let ro_uuids = List.filter_map (
fun { G.lv_uuid; lv_attr } ->
if lv_attr.[1] = 'r' then Some lv_uuid else None
) lvs in
diff --git a/sysprep/main.ml b/sysprep/main.ml
index 3ba0c7b82..3522b7fab 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -58,7 +58,7 @@ let main () with URI.Parse_failed ->
error (f_"error parsing URI ‘%s’. Look for error messages
printed above.") arg in
let format = match !format with "auto" -> None | fmt ->
Some fmt in
- push_front (uri, format) files;
+ List.push_front (uri, format) files;
format_consumed := true
and set_domain dom if !domain <> None then
@@ -203,7 +203,7 @@ read the man page virt-sysprep(1).
let mount_opts = !mount_opts in
let mount_opts List.map (String.split ":") (String.nsplit
";" mount_opts) in
- let mount_opts mp = assoc ~default:"" mp mount_opts in
+ let mount_opts mp = List.assoc_lbl ~default:"" mp mount_opts in
message (f_"Examining the guest ...");
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index dfeaa5521..0013ff504 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -110,9 +110,9 @@ let remove_all_from_set set empty_set
let register_operation op - push_front op all_operations;
+ List.push_front op all_operations;
if op.enabled_by_default then
- push_front op enabled_by_default_operations
+ List.push_front op enabled_by_default_operations
let baked = ref false
let rec bake () diff --git a/sysprep/sysprep_operation_script.ml
b/sysprep/sysprep_operation_script.ml
index fd9e62aa0..bb105f57f 100644
--- a/sysprep/sysprep_operation_script.ml
+++ b/sysprep/sysprep_operation_script.ml
@@ -36,7 +36,7 @@ let set_scriptdir dir scriptdir := Some dir
let scripts = ref []
-let add_script script = push_front script scripts
+let add_script script = List.push_front script scripts
let rec script_perform (g : Guestfs.guestfs) root side_effects let scripts =
List.rev !scripts in
diff --git a/v2v/DOM.ml b/v2v/DOM.ml
index 3ba93b4f6..8fd40e6b4 100644
--- a/v2v/DOM.ml
+++ b/v2v/DOM.ml
@@ -123,7 +123,7 @@ let path_to_nodes (Doc doc) path ) nodes
| p :: ps ->
let children - filter_map (
+ List.filter_map (
function
| PCData _ -> None
| Comment _ -> None
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index d9b706c3e..ff9607ab4 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -164,10 +164,10 @@ let parse_cmdline () in
let vdsm_image_uuids = ref [] in
- let add_vdsm_image_uuid s = push_front s vdsm_image_uuids in
+ let add_vdsm_image_uuid s = List.push_front s vdsm_image_uuids in
let vdsm_vol_uuids = ref [] in
- let add_vdsm_vol_uuid s = push_front s vdsm_vol_uuids in
+ let add_vdsm_vol_uuid s = List.push_front s vdsm_vol_uuids in
let vmtype_warning _ warning (f_"the --vmtype option has been
removed and now does nothing")
@@ -238,7 +238,7 @@ let parse_cmdline ()
s_"Ignored for backwards compatibility";
] in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: convert a guest to use KVM
diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml
index a1c2d7b48..1c29d9485 100644
--- a/v2v/convert_linux.ml
+++ b/v2v/convert_linux.ml
@@ -143,7 +143,7 @@ let convert (g : G.guestfs) inspect source output rcaps
and unconfigure_xen () (* Remove kmod-xenpv-* (RHEL 3). *)
let xenmods - filter_map (
+ List.filter_map (
fun { G.app2_name = name } ->
if name = "kmod-xenpv" || String.is_prefix name
"kmod-xenpv-" then
Some name
@@ -239,7 +239,7 @@ let convert (g : G.guestfs) inspect source output rcaps
let lines = g#read_lines vboxconfig in
let lines = Array.to_list lines in
let rex = PCRE.compile "^INSTALL_DIR=(.*)$" in
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
if PCRE.matches rex line then (
let path = PCRE.sub 1 in
@@ -283,13 +283,13 @@ let convert (g : G.guestfs) inspect source output rcaps
List.iter (
fun { G.app2_name = name } ->
if String.is_prefix name "vmware-tools-libraries-" then
- push_front name libraries
+ List.push_front name libraries
else if String.is_prefix name "vmware-tools-" then
- push_front name remove
+ List.push_front name remove
else if name = "VMwareTools" then
- push_front name remove
+ List.push_front name remove
else if String.is_prefix name "kmod-vmware-tools" then
- push_front name remove
+ List.push_front name remove
) inspect.i_apps;
let libraries = !libraries in
@@ -337,13 +337,13 @@ let convert (g : G.guestfs) inspect source output rcaps
let cmd = Array.of_list cmd in
(try
ignore (g#command cmd);
- push_front library remove
+ List.push_front library remove
with G.Error msg ->
eprintf "%s: could not install replacement for %s. Error
was: %s. %s was not removed.\n"
prog library msg library
);
) else (
- push_front library remove;
+ List.push_front library remove;
);
) libraries
)
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index 247ffff3f..41e734b67 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -166,7 +166,7 @@ let convert (g : G.guestfs) inspect source output rcaps
* uninstaller still shows a no-way-out reboot dialog *)
" PREVENT_REBOOT=Yes LAUNCHED_BY_SETUP_EXE=Yes"
in
- push_front uninst uninsts
+ List.push_front uninst uninsts
with
Not_found -> ()
) uninstnodes
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index 26d2b4887..3e41016c5 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -50,7 +50,7 @@ let rec main ()
s_"Use password from file";
] in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: copy a remote guest to the local machine
@@ -206,12 +206,12 @@ read the man page virt-v2v-copy-to-local(1).
"url", Some remote_disk;
"output", Some local_disk;
] in
- if not sslverify then push_back curl_args ("insecure", None);
+ if not sslverify then List.push_back curl_args ("insecure",
None);
(match cookie with
| None -> ()
- | Some cookie -> push_back curl_args ("cookie", Some
cookie)
+ | Some cookie -> List.push_back curl_args ("cookie", Some
cookie)
);
- if quiet () then push_back curl_args ("silent", None);
+ if quiet () then List.push_back curl_args ("silent", None);
let curl_h = Curl.create !curl_args in
if verbose () then
@@ -256,7 +256,7 @@ and parse_libvirt_xml guest_name xml incr i;
let local_disk = sprintf "%s-disk%d" guest_name !i in
- push_front (remote_disk, local_disk) disks;
+ List.push_front (remote_disk, local_disk) disks;
local_disk
in
get_disks, add_disk
diff --git a/v2v/create_libvirt_xml.ml b/v2v/create_libvirt_xml.ml
index 70c04cc64..ecf0d14c5 100644
--- a/v2v/create_libvirt_xml.ml
+++ b/v2v/create_libvirt_xml.ml
@@ -35,13 +35,13 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(* The main body of the libvirt XML document. *)
let body = ref [] in
- append body [
+ List.push_back_list body [
Comment generated_by;
e "name" [] [PCData source.s_name];
];
let memory_k = source.s_memory /^ 1024L in
- append body [
+ List.push_back_list body [
e "memory" ["unit", "KiB"] [PCData
(Int64.to_string memory_k)];
e "currentMemory" ["unit", "KiB"] [PCData
(Int64.to_string memory_k)];
e "vcpu" [] [PCData (string_of_int source.s_vcpu)]
@@ -55,32 +55,32 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(match source.s_cpu_vendor with
| None -> ()
| Some vendor ->
- push_back cpu (e "vendor" [] [PCData vendor])
+ List.push_back cpu (e "vendor" [] [PCData vendor])
);
(match source.s_cpu_model with
| None -> ()
| Some model ->
- push_back cpu (e "model" ["fallback",
"allow"] [PCData model])
+ List.push_back cpu (e "model" ["fallback",
"allow"] [PCData model])
);
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
let topology_attrs = ref [] in
(match source.s_cpu_sockets with
| None -> ()
- | Some v -> push_back topology_attrs ("sockets",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("sockets",
string_of_int v)
);
(match source.s_cpu_cores with
| None -> ()
- | Some v -> push_back topology_attrs ("cores",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("cores",
string_of_int v)
);
(match source.s_cpu_threads with
| None -> ()
- | Some v -> push_back topology_attrs ("threads",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("threads",
string_of_int v)
);
- push_back cpu (e "topology" !topology_attrs [])
+ List.push_back cpu (e "topology" !topology_attrs [])
);
- append body [ e "cpu" [ "match", "minimum" ]
!cpu ]
+ List.push_back_list body [ e "cpu" [ "match",
"minimum" ] !cpu ]
);
let uefi_firmware @@ -140,7 +140,7 @@ let create_libvirt_xml ?pool source
target_buses guestcaps
let features = List.sort compare (StringSet.elements features) in
- append body [
+ List.push_back_list body [
e "features" [] (List.map (fun s -> e s [] []) features);
];
@@ -161,7 +161,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(e "type" (["arch", guestcaps.gcaps_arch] @ machine)
[PCData "hvm"])
:: loader in
- append body [
+ List.push_back_list body [
e "os" [] os_section;
e "on_poweroff" [] [PCData "destroy"];
@@ -236,7 +236,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(Array.mapi (make_disk "floppy" "fd")
target_buses.target_floppy_bus)
] in
- append devices disks;
+ List.push_back_list devices disks;
let nics let net_model @@ -269,7 +269,7 @@ let create_libvirt_xml ?pool
source target_buses guestcaps
nic
) source.s_nics in
- append devices nics;
+ List.push_back_list devices nics;
(* Same as old virt-v2v, we always add a display here even if it was
* missing from the old metadata.
@@ -281,7 +281,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
| Cirrus -> e "model" [ "type",
"cirrus"; "vram", "9216" ] [] in
append_attr ("heads", "1") video_model;
e "video" [] [ video_model ] in
- push_back devices video;
+ List.push_back devices video;
let graphics match source.s_display with
@@ -326,7 +326,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
| Some { s_port = None } | None ->
append_attr ("autoport", "yes") graphics;
append_attr ("port", "-1") graphics);
- push_back devices graphics;
+ List.push_back devices graphics;
let sound match source.s_sound with
@@ -336,11 +336,11 @@ let create_libvirt_xml ?pool source target_buses guestcaps
[ e "sound" [ "model",
string_of_source_sound_model model ] [] ]
else
[] in
- append devices sound;
+ List.push_back_list devices sound;
(* Miscellaneous KVM devices. *)
if guestcaps.gcaps_virtio_rng then
- push_back devices (
+ List.push_back devices (
e "rng" ["model", "virtio"] [
(* XXX Using /dev/urandom requires libvirt >= 1.3.4. Libvirt
* was broken before that.
@@ -351,27 +351,27 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(* For the balloon device, libvirt adds an implicit device
* unless we use model='none', hence this:
*)
- push_back devices (
+ List.push_back devices (
e "memballoon"
["model",
if guestcaps.gcaps_virtio_balloon then "virtio" else
"none"]
[]
);
if guestcaps.gcaps_isa_pvpanic then
- push_back devices (
+ List.push_back devices (
e "panic" ["model", "isa"] [
e "address" ["type", "isa";
"iobase", "0x505"] []
]
);
(* Standard devices added to every guest. *)
- append devices [
+ List.push_back_list devices [
e "input" ["type", "tablet"; "bus",
"usb"] [];
e "input" ["type", "mouse"; "bus",
"ps2"] [];
e "console" ["type", "pty"] [];
];
- append body [
+ List.push_back_list body [
e "devices" [] !devices;
];
diff --git a/v2v/create_ovf.ml b/v2v/create_ovf.ml
index 1b851b0e9..aebdf6230 100644
--- a/v2v/create_ovf.ml
+++ b/v2v/create_ovf.ml
@@ -314,18 +314,18 @@ let rec create_ovf source targets guestcaps inspect
(match source.s_cpu_model with
| None -> ()
| Some model ->
- push_back content_subnodes (e "CustomCpuName" [] [PCData
model])
+ List.push_back content_subnodes (e "CustomCpuName" []
[PCData model])
);
(* Add the <Origin/> element if we can. *)
(match origin_of_source_hypervisor source.s_hypervisor with
| None -> ()
| Some origin ->
- push_back content_subnodes
+ List.push_back content_subnodes
(e "Origin" [] [PCData (string_of_int origin)])
);
- push_back content_subnodes (
+ List.push_back content_subnodes (
e "Section" ["ovf:id", vm_uuid;
"ovf:required", "false";
"xsi:type",
"ovf:OperatingSystemSection_Type"] [
e "Info" [] [PCData inspect.i_product_name];
@@ -338,7 +338,7 @@ let rec create_ovf source targets guestcaps inspect
source.s_vcpu memsize_mb)]
] in
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] ([
e "rasd:Caption" [] [PCData (sprintf "%d virtual
cpu" source.s_vcpu)];
e "rasd:Description" [] [PCData "Number of virtual
CPU"];
@@ -370,7 +370,7 @@ let rec create_ovf source targets guestcaps inspect
)
);
- append virtual_hardware_section_items [
+ List.push_back_list virtual_hardware_section_items [
e "Item" [] [
e "rasd:Caption" [] [PCData (sprintf "%Ld MB of
memory" memsize_mb)];
e "rasd:Description" [] [PCData "Memory Size"];
@@ -403,7 +403,7 @@ let rec create_ovf source targets guestcaps inspect
(* Add the miscellaneous KVM devices. *)
if guestcaps.gcaps_virtio_rng then
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] [
e "rasd:Caption" [] [PCData "RNG Device"];
e "rasd:InstanceId" [] [PCData (uuidgen ())];
@@ -413,7 +413,7 @@ let rec create_ovf source targets guestcaps inspect
]
);
if guestcaps.gcaps_virtio_balloon then
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] [
e "rasd:Caption" [] [PCData "Memory Ballooning
Device"];
e "rasd:InstanceId" [] [PCData (uuidgen ())];
@@ -423,7 +423,7 @@ let rec create_ovf source targets guestcaps inspect
]
);
- push_back content_subnodes (
+ List.push_back content_subnodes (
e "Section" ["xsi:type",
"ovf:VirtualHardwareSection_Type"]
!virtual_hardware_section_items
);
@@ -554,7 +554,7 @@ and add_disks targets guestcaps output_alloc sd_uuid
image_uuids vol_uuids ovf (match actual_size_gb with
| None -> ()
| Some actual_size_gb ->
- push_back attrs ("ovf:actual_size", Int64.to_string
actual_size_gb)
+ List.push_back attrs ("ovf:actual_size", Int64.to_string
actual_size_gb)
);
e "Disk" !attrs [] in
if is_estimate then (
@@ -585,12 +585,12 @@ and add_disks targets guestcaps output_alloc sd_uuid
image_uuids vol_uuids ovf e "rasd:last_modified_date" []
[PCData iso_time];
] in
if is_bootable_drive then
- push_back item_subnodes
+ List.push_back item_subnodes
(e "BootOrder" [] [PCData (string_of_int
boot_order)]);
e "Item" [] !item_subnodes in
append_child item virtualhardware_section;
- ) (combine3 targets image_uuids vol_uuids)
+ ) (List.combine3 targets image_uuids vol_uuids)
(* This modifies the OVF DOM, adding a section for each NIC. *)
and add_networks nics guestcaps ovf @@ -641,7 +641,7 @@ and add_networks nics
guestcaps ovf (match mac with
| None -> ()
| Some mac ->
- push_back item_subnodes
+ List.push_back item_subnodes
(e "rasd:MACAddress" [] [PCData mac])
);
e "Item" [] !item_subnodes in
diff --git a/v2v/input_libvirt_vddk.ml b/v2v/input_libvirt_vddk.ml
index 3e68bc968..ab1ccfd5c 100644
--- a/v2v/input_libvirt_vddk.ml
+++ b/v2v/input_libvirt_vddk.ml
@@ -195,7 +195,7 @@ object
let args let add_arg, get_args let args = ref [] in
- let add_arg a = push_front a args in
+ let add_arg a = List.push_front a args in
let get_args () = List.rev !args in
add_arg, get_args in
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index 6ab8d1ee5..ff00118b3 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -76,7 +76,7 @@ let untar ?format ?(paths = []) file outdir let
untar_metadata file outdir let files = external_command (sprintf "tar
-tf %s" (Filename.quote file)) in
let files - filter_map (
+ List.filter_map (
fun f ->
if Filename.check_suffix f ".ovf" ||
Filename.check_suffix f ".mf" then Some f
diff --git a/v2v/input_vmx.ml b/v2v/input_vmx.ml
index edc8db682..c50217b9e 100644
--- a/v2v/input_vmx.ml
+++ b/v2v/input_vmx.ml
@@ -108,7 +108,7 @@ and find_hdds vmx vmx_filename
Some (c, t, s)
| _ -> None
) hdds in
- let hdds = filter_map identity hdds in
+ let hdds = List.filter_map identity hdds in
(* We don't have a way to return the controllers and targets, so
* just make sure the disks are sorted into order, since Parse_vmx
@@ -188,7 +188,7 @@ and find_removables vmx Some s
| _ -> None
) devs in
- let devs = filter_map identity devs in
+ let devs = List.filter_map identity devs in
(* Sort by slot. *)
let devs @@ -260,7 +260,7 @@ and find_nics vmx
s_vnet_type = vnet_type })
| _ -> None
) nics in
- let nics = filter_map identity nics in
+ let nics = List.filter_map identity nics in
(* Sort by port. *)
let nics = List.sort compare nics in
diff --git a/v2v/linux_bootloaders.ml b/v2v/linux_bootloaders.ml
index 8de3f0469..3b966a7b7 100644
--- a/v2v/linux_bootloaders.ml
+++ b/v2v/linux_bootloaders.ml
@@ -79,7 +79,7 @@ object
let paths = Array.to_list paths in
(* Remove duplicates. *)
- let paths = remove_duplicates paths in
+ let paths = List.remove_duplicates paths in
(* Get the default kernel from grub if it's set. *)
let default diff --git a/v2v/linux_kernels.ml b/v2v/linux_kernels.ml
index 59948cb61..438a00afa 100644
--- a/v2v/linux_kernels.ml
+++ b/v2v/linux_kernels.ml
@@ -89,7 +89,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
PCRE.compile "^initrd.img-.*$"
else
PCRE.compile "^initr(?:d|amfs)-.*(?:\\.img)?$" in
- filter_map (
+ List.filter_map (
function
| { G.app2_name = name } as app
when name = "kernel" || String.is_prefix name
"kernel-"
@@ -177,7 +177,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
g#file_architecture any_module in
(* Just return the module names, without path or extension. *)
- let modules = filter_map (
+ let modules = List.filter_map (
fun m ->
if PCRE.matches rex_ko_extract m then
Some (PCRE.sub 1)
@@ -259,7 +259,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
let vmlinuzes = bootloader#list_kernels in
(* Map these to installed kernels. *)
- filter_map (
+ List.filter_map (
fun vmlinuz ->
try
let statbuf = g#statns vmlinuz in
diff --git a/v2v/modules_list.ml b/v2v/modules_list.ml
index e3c6d5934..d5120b70b 100644
--- a/v2v/modules_list.ml
+++ b/v2v/modules_list.ml
@@ -21,8 +21,8 @@ open Std_utils
let input_modules = ref []
and output_modules = ref []
-let register_input_module name = push_front name input_modules
-and register_output_module name = push_front name output_modules
+let register_input_module name = List.push_front name input_modules
+and register_output_module name = List.push_front name output_modules
let input_modules () = List.sort compare !input_modules
and output_modules () = List.sort compare !output_modules
@@ -36,7 +36,7 @@ type conversion_fn let convert_modules = ref []
let register_convert_module inspect_fn name conversion_fn - push_front
(inspect_fn, (name, conversion_fn)) convert_modules
+ List.push_front (inspect_fn, (name, conversion_fn)) convert_modules
let find_convert_module inspect let rec loop = function
diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml
index db66ecdef..d00011eb5 100644
--- a/v2v/output_glance.ml
+++ b/v2v/output_glance.ml
@@ -100,42 +100,42 @@ object
] in
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
- push_back properties ("hw_cpu_sockets",
+ List.push_back properties ("hw_cpu_sockets",
match source.s_cpu_sockets with
| None -> "1"
| Some v -> string_of_int v);
- push_back properties ("hw_cpu_cores",
+ List.push_back properties ("hw_cpu_cores",
match source.s_cpu_cores with
| None -> "1"
| Some v -> string_of_int v);
- push_back properties ("hw_cpu_threads",
+ List.push_back properties ("hw_cpu_threads",
match source.s_cpu_threads with
| None -> "1"
| Some v -> string_of_int v);
)
else (
- push_back properties ("hw_cpu_sockets", "1");
- push_back properties ("hw_cpu_cores", string_of_int
source.s_vcpu);
+ List.push_back properties ("hw_cpu_sockets", "1");
+ List.push_back properties ("hw_cpu_cores", string_of_int
source.s_vcpu);
);
(match guestcaps.gcaps_block_bus with
| Virtio_SCSI ->
- push_back properties ("hw_scsi_model",
"virtio-scsi")
+ List.push_back properties ("hw_scsi_model",
"virtio-scsi")
| Virtio_blk | IDE -> ()
);
(match inspect.i_major_version, inspect.i_minor_version with
| 0, 0 -> ()
- | x, 0 -> push_back properties ("os_version", string_of_int
x)
- | x, y -> push_back properties ("os_version", sprintf
"%d.%d" x y)
+ | x, 0 -> List.push_back properties ("os_version",
string_of_int x)
+ | x, y -> List.push_back properties ("os_version", sprintf
"%d.%d" x y)
);
if guestcaps.gcaps_virtio_rng then
- push_back properties ("hw_rng_model", "virtio");
+ List.push_back properties ("hw_rng_model",
"virtio");
(* XXX Neither memory balloon nor pvpanic are supported by
* Glance at this time.
*)
(match target_firmware with
| TargetBIOS -> ()
| TargetUEFI ->
- push_back properties ("hw_firmware_type", "uefi")
+ List.push_back properties ("hw_firmware_type",
"uefi")
);
!properties in
diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml
index 5844f72b5..f61d698d6 100644
--- a/v2v/output_qemu.ml
+++ b/v2v/output_qemu.ml
@@ -99,16 +99,16 @@ object
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
let a = ref [] in
- push_back a (sprintf "cpus=%d" source.s_vcpu);
- push_back a (sprintf "sockets=%d"
+ List.push_back a (sprintf "cpus=%d" source.s_vcpu);
+ List.push_back a (sprintf "sockets=%d"
(match source.s_cpu_sockets with
| None -> 1
| Some v -> v));
- push_back a (sprintf "cores=%d"
+ List.push_back a (sprintf "cores=%d"
(match source.s_cpu_cores with
| None -> 1
| Some v -> v));
- push_back a (sprintf "threads=%d"
+ List.push_back a (sprintf "threads=%d"
(match source.s_cpu_threads with
| None -> 1
| Some v -> v));
diff --git a/v2v/output_rhv.ml b/v2v/output_rhv.ml
index ce2d75c1d..2bcd988c1 100644
--- a/v2v/output_rhv.ml
+++ b/v2v/output_rhv.ml
@@ -233,7 +233,7 @@ object
debug "RHV: will export %s to %s" ov_sd target_file;
{ t with target_file = target_file }
- ) (combine3 targets image_uuids vol_uuids) in
+ ) (List.combine3 targets image_uuids vol_uuids) in
(* Generate the .meta file associated with each volume. *)
let metas diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml
index 6bb2bc4f7..d5911e80e 100644
--- a/v2v/output_vdsm.ml
+++ b/v2v/output_vdsm.ml
@@ -85,7 +85,7 @@ object
let mp, uuid let fields = String.nsplit "/" os in (* ...
"data-center" "UUID" *)
let fields = List.rev fields in (* "UUID"
"data-center" ... *)
- let fields = dropwhile ((=) "") fields in
+ let fields = List.dropwhile ((=) "") fields in
match fields with
| uuid :: rest when String.length uuid = 36 ->
let mp = String.concat "/" (List.rev rest) in
@@ -135,7 +135,7 @@ object
debug "VDSM: will export %s to %s" ov_sd target_file;
{ t with target_file = target_file }
- ) (combine3 targets vdsm_params.image_uuids vdsm_params.vol_uuids) in
+ ) (List.combine3 targets vdsm_params.image_uuids vdsm_params.vol_uuids)
in
(* Generate the .meta files associated with each volume. *)
let metas diff --git a/v2v/parse_libvirt_xml.ml b/v2v/parse_libvirt_xml.ml
index cc680d961..ec5ea5578 100644
--- a/v2v/parse_libvirt_xml.ml
+++ b/v2v/parse_libvirt_xml.ml
@@ -121,7 +121,7 @@ let parse_libvirt_xml ?conn xml let nr_nodes =
Xml.xpathobj_nr_nodes obj in
for i = 0 to nr_nodes-1 do
let node = Xml.xpathobj_node obj i in
- push_front (Xml.node_name node) features
+ List.push_front (Xml.node_name node) features
done;
!features in
@@ -252,7 +252,7 @@ let parse_libvirt_xml ?conn xml
s_controller = controller };
p_source = p_source
} in
- push_front disk disks
+ List.push_front disk disks
in
get_disks, add_disk
in
@@ -403,7 +403,7 @@ let parse_libvirt_xml ?conn xml { s_removable_type
= typ;
s_removable_controller = controller;
s_removable_slot = slot } in
- push_front disk disks
+ List.push_front disk disks
done;
List.rev !disks in
@@ -447,7 +447,7 @@ let parse_libvirt_xml ?conn xml s_vnet_orig =
vnet;
s_vnet_type = vnet_type
} in
- push_front nic nics
+ List.push_front nic nics
in
match xpath_string "source/@network | source/@bridge" with
| None -> ()
diff --git a/v2v/parse_ovf_from_ova.ml b/v2v/parse_ovf_from_ova.ml
index 901489d22..7dd4cc5c2 100644
--- a/v2v/parse_ovf_from_ova.ml
+++ b/v2v/parse_ovf_from_ova.ml
@@ -174,7 +174,7 @@ let parse_ovf_from_ova ovf_filename href = href;
compressed = compressed
} in
- push_front disk disks;
+ List.push_front disk disks;
) else
error (f_"could not parse disk rasd:HostResource from OVF
document")
done;
@@ -217,7 +217,7 @@ let parse_ovf_from_ova ovf_filename
s_removable_controller = controller;
s_removable_slot = slot;
} in
- push_front disk removables;
+ List.push_front disk removables;
done;
List.rev !removables
@@ -241,7 +241,7 @@ let parse_ovf_from_ova ovf_filename s_vnet_orig =
vnet;
s_vnet_type = Network;
} in
- push_front nic nics
+ List.push_front nic nics
done;
List.rev !nics
in
diff --git a/v2v/parse_vmx.ml b/v2v/parse_vmx.ml
index 3c72527b9..65d5a0edd 100644
--- a/v2v/parse_vmx.ml
+++ b/v2v/parse_vmx.ml
@@ -290,7 +290,7 @@ and parse_string str ) lines in
(* Parse the lines into key = "value". *)
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
if PCRE.matches rex line then (
let key = PCRE.sub 1 and value = PCRE.sub 2 in
diff --git a/v2v/test-harness/v2v_test_harness.ml
b/v2v/test-harness/v2v_test_harness.ml
index 79e97a4b2..1c3e796bd 100644
--- a/v2v/test-harness/v2v_test_harness.ml
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -190,7 +190,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () printf "%s\n%!" cmd;
let chan = open_process_in cmd in
let lines = ref [] in
- (try while true do push_front (input_line chan) lines done
+ (try while true do List.push_front (input_line chan) lines done
with End_of_file -> ());
let lines = List.rev !lines in
let stat = close_process_in chan in
@@ -263,7 +263,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () printf "%s\n%!" cmd;
let chan = open_process_in cmd in
let lines = ref [] in
- (try while true do push_front (input_line chan) lines done
+ (try while true do List.push_front (input_line chan) lines done
with End_of_file -> ());
let lines = List.rev !lines in
let stat = close_process_in chan in
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 24b38458f..1671eadc3 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -451,7 +451,7 @@ and do_fstrim g inspect (* Get all filesystems. *)
let fses = g#list_filesystems () in
- let fses = filter_map (
+ let fses = List.filter_map (
function (_, ("unknown"|"swap")) -> None | (dev, _)
-> Some dev
) fses in
@@ -792,7 +792,7 @@ and rcaps_from_source source let source_block_types
List.map (fun sd -> sd.s_controller) source.s_disks in
let source_block_type - match sort_uniq source_block_types with
+ match List.sort_uniq source_block_types with
| [] -> error (f_"source has no hard disks!")
| [t] -> t
| _ -> error (f_"source has multiple hard disk types!") in
@@ -808,7 +808,7 @@ and rcaps_from_source source let source_net_types
List.map (fun nic -> nic.s_nic_model) source.s_nics in
let source_net_type - match sort_uniq source_net_types with
+ match List.sort_uniq source_net_types with
| [] -> None
| [t] -> t
| _ -> error (f_"source has multiple network adapter model!")
in
diff --git a/v2v/vCenter.ml b/v2v/vCenter.ml
index 9f3fd4c09..ecdd484d2 100644
--- a/v2v/vCenter.ml
+++ b/v2v/vCenter.ml
@@ -181,11 +181,11 @@ and fetch_headers_from_url password scheme uri sslverify
https_url | None, Some _ ->
warning (f_"--password-file parameter ignored because
'user@' was not given in the URL")
| Some user, None ->
- push_back curl_args ("user", Some user)
+ List.push_back curl_args ("user", Some user)
| Some user, Some password ->
- push_back curl_args ("user", Some (user ^ ":" ^
password))
+ List.push_back curl_args ("user", Some (user ^ ":" ^
password))
);
- if not sslverify then push_back curl_args ("insecure", None);
+ if not sslverify then List.push_back curl_args ("insecure", None);
let curl_h = Curl.create !curl_args in
let lines = Curl.run curl_h in
--
2.13.2
Seemingly Similar Threads
- [PATCH 0/3] common/mlstdutils: Add Std_utils List and Option modules.
- [[PATCH v2 0/4] common/mlstdutils: Add Std_utils List and Option modules.
- [PATCH v3 0/8] v2v: Move Curl wrapper to mllib and more.
- [PATCH v2 0/8] v2v: Move Curl wrapper to mllib and use it for virt-builder (and more).
- [PATCH v2v v2 0/3] Use host-model