Utils: add [merge_list2] function

src/minutils/utils.ml

@@ -66,8 +66,9 @@ let unopt_map ~f ~default = function
   | None -> default
   | Some x -> f x
 
+let may_cons xs x = match x with None -> xs | Some x -> x :: xs
+
 let unopt_list l =
-  let may_cons xs x = match x with None -> xs | Some x -> x :: xs in
   List.rev @@ List.fold_left may_cons [] l
 
 let first_some a b = match a, b with
@@ -76,8 +77,7 @@ let first_some a b = match a, b with
   | Some v, _ -> Some v
 
 let filter_map f l =
-  let may_cons xs x = match f x with None -> xs | Some x -> x :: xs in
+  List.rev @@ List.fold_left (fun acc x -> may_cons acc (f x)) [] l
-  List.rev @@ List.fold_left may_cons [] l
 
 let list_rev_sub l n =
   ListLabels.fold_left l ~init:(n, []) ~f:begin fun (n, l) elt ->
@@ -90,6 +90,34 @@ let list_hd_opt = function
   | [] -> None
   | h :: _ -> Some h
 
+let merge_filter_list2
+    ?(finalize = List.rev) ?(compare = compare)
+    ?(f = first_some)
+    l1 l2 =
+  let sort = List.sort compare in
+  let rec merge_aux acc = function
+    | [], [] -> finalize acc
+    | r1, [] -> finalize acc @ (filter_map (fun x1 -> f (Some x1) None) r1)
+    | [], r2 -> finalize acc @ (filter_map (fun x2 -> f None (Some x2)) r2)
+    | ((h1 :: t1) as r1), ((h2 :: t2) as r2) ->
+      if compare h1 h2 > 0 then
+        merge_aux (may_cons acc (f None (Some h2))) (r1, t2)
+      else if compare h1 h2 < 0 then
+        merge_aux (may_cons acc (f (Some h1) None)) (t1, r2)
+      else (* m1 = m2 *)
+        merge_aux (may_cons acc (f (Some h1) (Some h2))) (t1, t2)
+  in
+  merge_aux [] (sort l1, sort l2)
+
+let merge_list2 ?finalize ?compare ?(f = fun x1 _x1 -> x1) l1 l2 =
+  merge_filter_list2 ?finalize ?compare
+    ~f:(fun x1 x2 -> match x1, x2 with
+        | None, None -> assert false
+        | Some x1, None -> Some x1
+        | None, Some x2 -> Some x2
+        | Some x1, Some x2 -> Some (f x1 x2))
+    l1 l2
+
 let display_paragraph ppf description =
   Format.fprintf ppf "@[%a@]"
     (Format.pp_print_list ~pp_sep:Format.pp_print_newline

src/minutils/utils.mli

@@ -45,6 +45,25 @@ val list_rev_sub : 'a list -> int -> 'a list
 val list_sub: 'a list -> int -> 'a list
 val list_hd_opt: 'a list -> 'a option
 
+(** [merge_filter_list2 ~compare ~f l1 l2] merges two lists ordered by [compare]
+    and whose items can be merged with [f]. Item is discarded or kept whether
+    [f] returns [Some] or [None] *)
+val merge_filter_list2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a option -> 'a option -> 'a option) ->
+  'a list -> 'a list ->
+  'a list
+
+(** [merge_list2 ~compare ~f l1 l2] merges two lists ordered by [compare] and
+    whose items can be merged with [f] *)
+val merge_list2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a -> 'a -> 'a) ->
+  'a list -> 'a list ->
+  'a list
+
 val finalize: (unit -> 'a) -> (unit -> unit) -> 'a
 
 val read_file: ?bin:bool -> string -> string