Reviewed By: ngorogiannis Differential Revision: D20482771 fbshipit-source-id: aa523e90amaster
Josh Berdine
5 years ago
committed by
Facebook GitHub Bot
parent
24a26c8a23
commit
04df3ca460
@ -0,0 +1,117 @@
|
|||||||
|
(*
|
||||||
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||||
|
*
|
||||||
|
* This source code is licensed under the MIT license found in the
|
||||||
|
* LICENSE file in the root directory of this source tree.
|
||||||
|
*)
|
||||||
|
|
||||||
|
open (
|
||||||
|
Base :
|
||||||
|
(module type of Base with module Format := Base.Format [@warning "-3"]) )
|
||||||
|
|
||||||
|
(* undeprecate *)
|
||||||
|
external ( == ) : 'a -> 'a -> bool = "%eq"
|
||||||
|
|
||||||
|
exception Not_found = Caml.Not_found
|
||||||
|
|
||||||
|
include Base.List
|
||||||
|
|
||||||
|
let rec pp ?pre ?suf sep pp_elt fs = function
|
||||||
|
| [] -> ()
|
||||||
|
| x :: xs ->
|
||||||
|
Option.iter pre ~f:(Format.fprintf fs) ;
|
||||||
|
pp_elt fs x ;
|
||||||
|
( match xs with
|
||||||
|
| [] -> ()
|
||||||
|
| xs -> Format.fprintf fs "%( %)%a" sep (pp sep pp_elt) xs ) ;
|
||||||
|
Option.iter suf ~f:(Format.fprintf fs)
|
||||||
|
|
||||||
|
let pop_exn = function x :: xs -> (x, xs) | [] -> raise Not_found
|
||||||
|
|
||||||
|
let find_map_remove xs ~f =
|
||||||
|
let rec find_map_remove_ ys = function
|
||||||
|
| [] -> None
|
||||||
|
| x :: xs -> (
|
||||||
|
match f x with
|
||||||
|
| Some x' -> Some (x', rev_append ys xs)
|
||||||
|
| None -> find_map_remove_ (x :: ys) xs )
|
||||||
|
in
|
||||||
|
find_map_remove_ [] xs
|
||||||
|
|
||||||
|
let fold_option xs ~init ~f =
|
||||||
|
With_return.with_return
|
||||||
|
@@ fun {return} ->
|
||||||
|
Some
|
||||||
|
(fold xs ~init ~f:(fun acc elt ->
|
||||||
|
match f acc elt with Some res -> res | None -> return None ))
|
||||||
|
|
||||||
|
let map_preserving_phys_equal map t ~f =
|
||||||
|
let change = ref false in
|
||||||
|
let t' =
|
||||||
|
map t ~f:(fun x ->
|
||||||
|
let x' = f x in
|
||||||
|
if not (x' == x) then change := true ;
|
||||||
|
x' )
|
||||||
|
in
|
||||||
|
if !change then t' else t
|
||||||
|
|
||||||
|
let filter_map_preserving_phys_equal filter_map t ~f =
|
||||||
|
let change = ref false in
|
||||||
|
let t' =
|
||||||
|
filter_map t ~f:(fun x ->
|
||||||
|
let x'_opt = f x in
|
||||||
|
( match x'_opt with
|
||||||
|
| Some x' when x' == x -> ()
|
||||||
|
| _ -> change := true ) ;
|
||||||
|
x'_opt )
|
||||||
|
in
|
||||||
|
if !change then t' else t
|
||||||
|
|
||||||
|
let filter_map_preserving_phys_equal t ~f =
|
||||||
|
filter_map_preserving_phys_equal filter_map t ~f
|
||||||
|
|
||||||
|
let map_preserving_phys_equal t ~f = map_preserving_phys_equal map t ~f
|
||||||
|
|
||||||
|
let rev_map_unzip xs ~f =
|
||||||
|
fold xs ~init:([], []) ~f:(fun (ys, zs) x ->
|
||||||
|
let y, z = f x in
|
||||||
|
(y :: ys, z :: zs) )
|
||||||
|
|
||||||
|
let remove_exn ?(equal = phys_equal) xs x =
|
||||||
|
let rec remove_ ys = function
|
||||||
|
| [] -> raise Not_found
|
||||||
|
| z :: xs ->
|
||||||
|
if equal x z then rev_append ys xs else remove_ (z :: ys) xs
|
||||||
|
in
|
||||||
|
remove_ [] xs
|
||||||
|
|
||||||
|
let remove ?equal xs x =
|
||||||
|
try Some (remove_exn ?equal xs x) with Not_found -> None
|
||||||
|
|
||||||
|
let rec rev_init n ~f =
|
||||||
|
if n = 0 then []
|
||||||
|
else
|
||||||
|
let n = n - 1 in
|
||||||
|
let xs = rev_init n ~f in
|
||||||
|
f n :: xs
|
||||||
|
|
||||||
|
let symmetric_diff ~compare xs ys =
|
||||||
|
let rec symmetric_diff_ xxs yys =
|
||||||
|
match (xxs, yys) with
|
||||||
|
| x :: xs, y :: ys ->
|
||||||
|
let ord = compare x y in
|
||||||
|
if ord = 0 then symmetric_diff_ xs ys
|
||||||
|
else if ord < 0 then Either.First x :: symmetric_diff_ xs yys
|
||||||
|
else Either.Second y :: symmetric_diff_ xxs ys
|
||||||
|
| xs, [] -> map ~f:Either.first xs
|
||||||
|
| [], ys -> map ~f:Either.second ys
|
||||||
|
in
|
||||||
|
symmetric_diff_ (sort ~compare xs) (sort ~compare ys)
|
||||||
|
|
||||||
|
let pp_diff ~compare sep pp_elt fs (xs, ys) =
|
||||||
|
let pp_diff_elt fs elt =
|
||||||
|
match (elt : _ Either.t) with
|
||||||
|
| First x -> Format.fprintf fs "-- %a" pp_elt x
|
||||||
|
| Second y -> Format.fprintf fs "++ %a" pp_elt y
|
||||||
|
in
|
||||||
|
pp sep pp_diff_elt fs (symmetric_diff ~compare xs ys)
|
||||||
@ -0,0 +1,57 @@
|
|||||||
|
(*
|
||||||
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||||
|
*
|
||||||
|
* This source code is licensed under the MIT license found in the
|
||||||
|
* LICENSE file in the root directory of this source tree.
|
||||||
|
*)
|
||||||
|
|
||||||
|
open Base
|
||||||
|
include module type of Base.List
|
||||||
|
open Import0
|
||||||
|
|
||||||
|
val pp :
|
||||||
|
?pre:(unit, unit) fmt
|
||||||
|
-> ?suf:(unit, unit) fmt
|
||||||
|
-> (unit, unit) fmt
|
||||||
|
-> 'a pp
|
||||||
|
-> 'a list pp
|
||||||
|
(** Pretty-print a list. *)
|
||||||
|
|
||||||
|
val pp_diff :
|
||||||
|
compare:('a -> 'a -> int)
|
||||||
|
-> (unit, unit) fmt
|
||||||
|
-> 'a pp
|
||||||
|
-> ('a list * 'a list) pp
|
||||||
|
|
||||||
|
val pop_exn : 'a list -> 'a * 'a list
|
||||||
|
|
||||||
|
val find_map_remove :
|
||||||
|
'a list -> f:('a -> 'b option) -> ('b * 'a list) option
|
||||||
|
|
||||||
|
val fold_option :
|
||||||
|
'a t -> init:'accum -> f:('accum -> 'a -> 'accum option) -> 'accum option
|
||||||
|
(** [fold_option t ~init ~f] is a short-circuiting version of [fold] that
|
||||||
|
runs in the [Option] monad. If [f] returns [None], that value is
|
||||||
|
returned without any additional invocations of [f]. *)
|
||||||
|
|
||||||
|
val map_preserving_phys_equal : 'a t -> f:('a -> 'a) -> 'a t
|
||||||
|
(** Like map, but preserves [phys_equal] if [f] preserves [phys_equal] of
|
||||||
|
every element. *)
|
||||||
|
|
||||||
|
val filter_map_preserving_phys_equal : 'a t -> f:('a -> 'a option) -> 'a t
|
||||||
|
(** Like filter_map, but preserves [phys_equal] if [f] preserves
|
||||||
|
[phys_equal] of every element. *)
|
||||||
|
|
||||||
|
val rev_map_unzip : 'a t -> f:('a -> 'b * 'c) -> 'b list * 'c list
|
||||||
|
(** [rev_map_unzip ~f xs] is [unzip (rev_map ~f xs)] but more efficient. *)
|
||||||
|
|
||||||
|
val remove_exn : ?equal:('a -> 'a -> bool) -> 'a list -> 'a -> 'a list
|
||||||
|
(** Returns the input list without the first element [equal] to the
|
||||||
|
argument, or raise [Not_found] if no such element exists. [equal]
|
||||||
|
defaults to physical equality. *)
|
||||||
|
|
||||||
|
val remove : ?equal:('a -> 'a -> bool) -> 'a list -> 'a -> 'a list option
|
||||||
|
val rev_init : int -> f:(int -> 'a) -> 'a list
|
||||||
|
|
||||||
|
val symmetric_diff :
|
||||||
|
compare:('a -> 'a -> int) -> 'a t -> 'a t -> ('a, 'a) Either.t t
|
||||||
Loading…
Reference in new issue