|
|
@ -6,91 +6,81 @@
|
|
|
|
*)
|
|
|
|
*)
|
|
|
|
|
|
|
|
|
|
|
|
open! NS0
|
|
|
|
open! NS0
|
|
|
|
include Base.List
|
|
|
|
include ContainersLabels.List
|
|
|
|
|
|
|
|
|
|
|
|
exception Not_found_s = Base.Sexp.Not_found_s
|
|
|
|
type 'a t = 'a list [@@deriving compare, equal, hash, sexp]
|
|
|
|
|
|
|
|
|
|
|
|
let rec pp ?pre ?suf sep pp_elt fs = function
|
|
|
|
let hd_exn = hd
|
|
|
|
| [] -> ()
|
|
|
|
let hd = function [] -> None | hd :: _ -> Some hd
|
|
|
|
| x :: xs ->
|
|
|
|
let tl_exn = tl
|
|
|
|
Option.iter ~f:(Format.fprintf fs) pre ;
|
|
|
|
let tl = function [] -> None | _ :: tl -> Some tl
|
|
|
|
pp_elt fs x ;
|
|
|
|
let pop_exn = function x :: xs -> (x, xs) | [] -> raise Not_found
|
|
|
|
( match xs with
|
|
|
|
let exists xs ~f = exists ~f xs
|
|
|
|
| [] -> ()
|
|
|
|
let for_all xs ~f = for_all ~f xs
|
|
|
|
| xs -> Format.fprintf fs "%( %)%a" sep (pp sep pp_elt) xs ) ;
|
|
|
|
let find_exn xs ~f = find ~f xs
|
|
|
|
Option.iter ~f:(Format.fprintf fs) suf
|
|
|
|
let find xs ~f = find_opt ~f xs
|
|
|
|
|
|
|
|
let find_map xs ~f = find_map ~f xs
|
|
|
|
let findi x xs =
|
|
|
|
let find_map_exn xs ~f = Option.get_exn (find_map xs ~f)
|
|
|
|
let rec findi_ i xs =
|
|
|
|
|
|
|
|
match xs with
|
|
|
|
|
|
|
|
| [] -> None
|
|
|
|
|
|
|
|
| x' :: _ when x == x' -> Some i
|
|
|
|
|
|
|
|
| _ :: xs -> findi_ (i + 1) xs
|
|
|
|
|
|
|
|
in
|
|
|
|
|
|
|
|
findi_ 0 xs
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let pop_exn = function
|
|
|
|
|
|
|
|
| x :: xs -> (x, xs)
|
|
|
|
|
|
|
|
| [] -> raise (Not_found_s (Atom __LOC__))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let find_map_remove xs ~f =
|
|
|
|
let remove_one_exn ~eq x xs =
|
|
|
|
let rec find_map_remove_ ys = function
|
|
|
|
let rec remove_ ys = function
|
|
|
|
| [] -> None
|
|
|
|
| [] -> raise Not_found
|
|
|
|
| x :: xs -> (
|
|
|
|
| z :: xs -> if eq x z then rev_append ys xs else remove_ (z :: ys) xs
|
|
|
|
match f x with
|
|
|
|
|
|
|
|
| Some x' -> Some (x', rev_append ys xs)
|
|
|
|
|
|
|
|
| None -> find_map_remove_ (x :: ys) xs )
|
|
|
|
|
|
|
|
in
|
|
|
|
in
|
|
|
|
find_map_remove_ [] xs
|
|
|
|
remove_ [] xs
|
|
|
|
|
|
|
|
|
|
|
|
let fold_option xs ~init ~f =
|
|
|
|
let remove_one ~eq x xs =
|
|
|
|
let@ {return} = With_return.with_return in
|
|
|
|
try Some (remove_one_exn ~eq x xs) with Not_found -> None
|
|
|
|
Some
|
|
|
|
|
|
|
|
(fold xs ~init ~f:(fun acc elt ->
|
|
|
|
|
|
|
|
match f acc elt with Some res -> res | None -> return None ))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let remove ~eq x xs = remove ~eq ~key:x xs
|
|
|
|
|
|
|
|
let map xs ~f = map ~f xs
|
|
|
|
let map_endo t ~f = map_endo map t ~f
|
|
|
|
let map_endo t ~f = map_endo map t ~f
|
|
|
|
|
|
|
|
|
|
|
|
let rev_map_unzip xs ~f =
|
|
|
|
let rev_map_split xs ~f =
|
|
|
|
fold xs ~init:([], []) ~f:(fun (ys, zs) x ->
|
|
|
|
fold_left xs ~init:([], []) ~f:(fun (ys, zs) x ->
|
|
|
|
let y, z = f x in
|
|
|
|
let y, z = f x in
|
|
|
|
(y :: ys, z :: zs) )
|
|
|
|
(y :: ys, z :: zs) )
|
|
|
|
|
|
|
|
|
|
|
|
let remove_exn ?(equal = ( == )) xs x =
|
|
|
|
let combine_exn = combine
|
|
|
|
let rec remove_ ys = function
|
|
|
|
|
|
|
|
| [] -> raise (Not_found_s (Atom __LOC__))
|
|
|
|
let combine xs ys =
|
|
|
|
| z :: xs ->
|
|
|
|
try Some (combine_exn xs ys) with Invalid_argument _ -> None
|
|
|
|
if equal x z then rev_append ys xs else remove_ (z :: ys) xs
|
|
|
|
|
|
|
|
in
|
|
|
|
let fold xs ~init ~f = fold_left ~f ~init xs
|
|
|
|
remove_ [] xs
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let remove ?equal xs x =
|
|
|
|
let reduce xs ~f =
|
|
|
|
try Some (remove_exn ?equal xs x) with Not_found_s _ -> None
|
|
|
|
match xs with [] -> None | x :: xs -> Some (fold xs ~init:x ~f)
|
|
|
|
|
|
|
|
|
|
|
|
let rec rev_init n ~f =
|
|
|
|
let fold2_exn xs ys ~init ~f = fold_left2 ~f ~init xs ys
|
|
|
|
if n = 0 then []
|
|
|
|
let group_succ ~eq xs = group_succ ~eq:(fun y x -> eq x y) xs
|
|
|
|
else
|
|
|
|
|
|
|
|
let n = n - 1 in
|
|
|
|
|
|
|
|
let xs = rev_init n ~f in
|
|
|
|
|
|
|
|
f n :: xs
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let symmetric_diff ~compare xs ys =
|
|
|
|
let symmetric_diff ~cmp xs ys =
|
|
|
|
let rec symmetric_diff_ xxs yys : _ Either.t list =
|
|
|
|
let rec symmetric_diff_ xxs yys : _ Either.t list =
|
|
|
|
match (xxs, yys) with
|
|
|
|
match (xxs, yys) with
|
|
|
|
| x :: xs, y :: ys ->
|
|
|
|
| x :: xs, y :: ys ->
|
|
|
|
let ord = compare x y in
|
|
|
|
let ord = cmp x y in
|
|
|
|
if ord = 0 then symmetric_diff_ xs ys
|
|
|
|
if ord = 0 then symmetric_diff_ xs ys
|
|
|
|
else if ord < 0 then Left x :: symmetric_diff_ xs yys
|
|
|
|
else if ord < 0 then Left x :: symmetric_diff_ xs yys
|
|
|
|
else Right y :: symmetric_diff_ xxs ys
|
|
|
|
else Right y :: symmetric_diff_ xxs ys
|
|
|
|
| xs, [] -> map ~f:Either.left xs
|
|
|
|
| xs, [] -> map ~f:Either.left xs
|
|
|
|
| [], ys -> map ~f:Either.right ys
|
|
|
|
| [], ys -> map ~f:Either.right ys
|
|
|
|
in
|
|
|
|
in
|
|
|
|
symmetric_diff_ (sort ~compare xs) (sort ~compare ys)
|
|
|
|
symmetric_diff_ (sort ~cmp xs) (sort ~cmp ys)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let rec pp ?pre ?suf sep pp_elt fs = function
|
|
|
|
|
|
|
|
| [] -> ()
|
|
|
|
|
|
|
|
| x :: xs ->
|
|
|
|
|
|
|
|
Option.iter ~f:(Format.fprintf fs) pre ;
|
|
|
|
|
|
|
|
pp_elt fs x ;
|
|
|
|
|
|
|
|
( match xs with
|
|
|
|
|
|
|
|
| [] -> ()
|
|
|
|
|
|
|
|
| xs -> Format.fprintf fs "%( %)%a" sep (pp sep pp_elt) xs ) ;
|
|
|
|
|
|
|
|
Option.iter ~f:(Format.fprintf fs) suf
|
|
|
|
|
|
|
|
|
|
|
|
let pp_diff ~compare sep pp_elt fs (xs, ys) =
|
|
|
|
let pp_diff ~cmp sep pp_elt fs (xs, ys) =
|
|
|
|
let pp_diff_elt fs (elt : _ Either.t) =
|
|
|
|
let pp_diff_elt fs (elt : _ Either.t) =
|
|
|
|
match elt with
|
|
|
|
match elt with
|
|
|
|
| Left x -> Format.fprintf fs "-- %a" pp_elt x
|
|
|
|
| Left x -> Format.fprintf fs "-- %a" pp_elt x
|
|
|
|
| Right y -> Format.fprintf fs "++ %a" pp_elt y
|
|
|
|
| Right y -> Format.fprintf fs "++ %a" pp_elt y
|
|
|
|
in
|
|
|
|
in
|
|
|
|
pp sep pp_diff_elt fs (symmetric_diff ~compare xs ys)
|
|
|
|
pp sep pp_diff_elt fs (symmetric_diff ~cmp xs ys)
|
|
|
|