external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
include Printf
module List = struct
include ListLabels
let hd_exn = hd
let hd = function o :: _ -> Some o | [] -> None
let tl_exn = tl
let tl = function [] -> None | _ :: t -> Some t
let nth t n =
if n < 0 then None else
let rec nth_aux t n =
match t with
| [] -> None
| a :: t -> if n = 0 then Some a else nth_aux t (n-1)
in
nth_aux t n
let nth_exn t n =
match nth t n with
| None ->
ksprintf invalid_arg "List.nth_exn %d called on list of length %d"
n (length t)
| Some a -> a
let fold ~init ~f l = fold_left ~init ~f l
let rev_filter t ~f =
let rec find ~f accu = function
| [] -> accu
| x :: l -> if f x then find ~f (x :: accu) l else find ~f accu l
in
find ~f [] t
let filter t ~f = rev (rev_filter t ~f)
let find_map t ~f =
let rec loop = function
| [] -> None
| x :: l ->
match f x with
| None -> loop l
| Some _ as r -> r
in
loop t
let find t ~f =
let rec loop = function
| [] -> None
| x :: l -> if f x then Some x else loop l
in
loop t
let find_exn t ~f = ListLabels.find ~f t
let findi t ~f =
let rec loop i t =
match t with
| [] -> None
| x :: l -> if f i x then Some (i, x) else loop (i + 1) l
in
loop 0 t
let exists t ~f = exists t ~f
let for_all t ~f = for_all t ~f
let iter t ~f = iter t ~f
let fold t ~init ~f = fold_left t ~f ~init
let fold_left = fold
let to_array = Array.of_list
let to_list t = t
let slow_append l1 l2 = rev_append (rev l1) l2
let rec count_append l1 l2 count =
match l2 with
| [] -> l1
| _ ->
match l1 with
| [] -> l2
| [x1] -> x1 :: l2
| [x1; x2] -> x1 :: x2 :: l2
| [x1; x2; x3] -> x1 :: x2 :: x3 :: l2
| [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2
| x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
x1 :: x2 :: x3 :: x4 :: x5 ::
(if count > 1000
then slow_append tl l2
else count_append tl l2 (count + 1))
let append l1 l2 = count_append l1 l2 0
let map_slow l ~f = rev (rev_map ~f l)
let rec count_map ~f l ctr =
match l with
| [] -> []
| [x1] ->
let f1 = f x1 in
[f1]
| [x1; x2] ->
let f1 = f x1 in
let f2 = f x2 in
[f1; f2]
| [x1; x2; x3] ->
let f1 = f x1 in
let f2 = f x2 in
let f3 = f x3 in
[f1; f2; f3]
| [x1; x2; x3; x4] ->
let f1 = f x1 in
let f2 = f x2 in
let f3 = f x3 in
let f4 = f x4 in
[f1; f2; f3; f4]
| x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
let f1 = f x1 in
let f2 = f x2 in
let f3 = f x3 in
let f4 = f x4 in
let f5 = f x5 in
f1 :: f2 :: f3 :: f4 :: f5 ::
(if ctr > 1000
then map_slow ~f tl
else count_map ~f tl (ctr + 1))
let map l ~f = count_map ~f l 0
let fold_right l ~f ~init =
fold ~f:(fun a b -> f b a) ~init (List.rev l)
let rev_mapi l ~f ~i =
let rec loop i acc = function
| [] -> acc
| h :: t -> loop (i + 1) (f i h :: acc) t
in
loop i [] l
let rec count_mapi ~f l ctr =
match l with
| [] -> []
| [x1] ->
let f1 = f ctr x1 in
[f1]
| [x1; x2] ->
let f1 = f ctr x1 in
let f2 = f (ctr + 1) x2 in
[f1; f2]
| [x1; x2; x3] ->
let f1 = f ctr x1 in
let f2 = f (ctr + 1) x2 in
let f3 = f (ctr + 2) x3 in
[f1; f2; f3]
| [x1; x2; x3; x4] ->
let f1 = f ctr x1 in
let f2 = f (ctr + 1) x2 in
let f3 = f (ctr + 2) x3 in
let f4 = f (ctr + 3) x4 in
[f1; f2; f3; f4]
| x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
let f1 = f ctr x1 in
let f2 = f (ctr + 1) x2 in
let f3 = f (ctr + 2) x3 in
let f4 = f (ctr + 3) x4 in
let f5 = f (ctr + 4) x5 in
f1 :: f2 :: f3 :: f4 :: f5 ::
(if ctr > 5000
then rev_mapi ~f ~i:(ctr + 5) tl
else count_mapi ~f tl (ctr + 5))
let mapi l ~f = count_mapi ~f l 0
let map2_slow l1 l2 ~f = List.rev (rev_map2 ~f l1 l2)
let rec count_map2_exn ~f l1 l2 ctr =
match l1, l2 with
| [], [] -> []
| [x1], [y1] ->
let f1 = f x1 y1 in
[f1]
| [x1; x2], [y1; y2] ->
let f1 = f x1 y1 in
let f2 = f x2 y2 in
[f1; f2]
| [x1; x2; x3], [y1; y2; y3] ->
let f1 = f x1 y1 in
let f2 = f x2 y2 in
let f3 = f x3 y3 in
[f1; f2; f3]
| [x1; x2; x3; x4], [y1; y2; y3; y4] ->
let f1 = f x1 y1 in
let f2 = f x2 y2 in
let f3 = f x3 y3 in
let f4 = f x4 y4 in
[f1; f2; f3; f4]
| x1 :: x2 :: x3 :: x4 :: x5 :: tl1,
y1 :: y2 :: y3 :: y4 :: y5 :: tl2 ->
let f1 = f x1 y1 in
let f2 = f x2 y2 in
let f3 = f x3 y3 in
let f4 = f x4 y4 in
let f5 = f x5 y5 in
f1 :: f2 :: f3 :: f4 :: f5 ::
(if ctr > 1000
then map2_slow ~f tl1 tl2
else count_map2_exn ~f tl1 tl2 (ctr + 1))
| _, _ -> failwith "count_map2"
let map2_exn l1 l2 ~f = count_map2_exn ~f l1 l2 0
let iteri l ~f =
ignore (fold l ~init:0 ~f:(fun i x -> let () = f i x in i + 1))
let foldi t ~f ~init =
snd (fold t ~init:(0, init) ~f:(fun (i, acc) v -> (i + 1, f i acc v)))
let filteri l ~f =
List.rev (foldi l
~f:(fun pos acc x ->
if f pos x then x :: acc else acc)
~init:[])
let reduce l ~f = match l with
| [] -> None
| hd :: tl -> Some (fold ~init:hd ~f tl)
let concat_map l ~f =
let rec aux acc = function
| [] -> List.rev acc
| hd :: tl -> aux (rev_append (f hd) acc) tl
in
aux [] l
let concat_mapi l ~f =
let rec aux cont acc = function
| [] -> List.rev acc
| hd :: tl -> aux (cont + 1) (rev_append (f cont hd) acc) tl
in
aux 0 [] l
let merge l1 l2 ~cmp =
let rec loop acc l1 l2 =
match l1,l2 with
| [], l2 -> rev_append acc l2
| l1, [] -> rev_append acc l1
| h1 :: t1, h2 :: t2 ->
if cmp h1 h2 <= 0
then loop (h1 :: acc) t1 l2
else loop (h2 :: acc) l1 t2
in
loop [] l1 l2
let rec last list = match list with
| [x] -> Some x
| _ :: tl -> last tl
| [] -> None
let remove_consecutive_duplicates list ~equal =
let rec loop list accum = match list with
| [] -> accum
| hd :: [] -> hd :: accum
| hd1 :: hd2 :: tl ->
if equal hd1 hd2
then loop (hd2 :: tl) accum
else loop (hd2 :: tl) (hd1 :: accum)
in
rev (loop list [])
let dedup ?(compare=Pervasives.compare) list =
let equal x x' = compare x x' = 0 in
let sorted = sort ~cmp:compare list in
remove_consecutive_duplicates ~equal sorted
let contains_dup ?compare lst = length (dedup ?compare lst) <> length lst
let find_a_dup ?(compare=Pervasives.compare) l =
let sorted = sort ~cmp:compare l in
let rec loop l = match l with
[] | [_] -> None
| hd1 :: hd2 :: tl ->
if compare hd1 hd2 = 0 then Some (hd1) else loop (hd2 :: tl)
in
loop sorted
let init n ~f =
if n < 0 then []
else
let rec loop i accum =
assert (i >= 0);
if i = 0 then accum
else loop (i-1) (f (i-1) :: accum)
in
loop n []
let rev_filter_map l ~f =
let rec loop l accum =
match l with
| [] -> accum
| hd :: tl ->
match f hd with
| Some x -> loop tl (x :: accum)
| None -> loop tl accum
in
loop l []
let filter_map l ~f = List.rev (rev_filter_map l ~f)
let filter_opt l = filter_map l ~f:(fun x -> x)
let partition_map t ~f =
let rec loop t fst snd =
match t with
| [] -> (rev fst, rev snd)
| x :: t ->
match f x with
| `Fst y -> loop t (y :: fst) snd
| `Snd y -> loop t fst (y :: snd)
in
loop t [] []
let split_n t_orig n =
if n <= 0 then
([], t_orig)
else
let rec loop n t accum =
if n = 0 then
(List.rev accum, t)
else
match t with
| [] -> (t_orig, [])
| hd :: tl -> loop (n - 1) tl (hd :: accum)
in
loop n t_orig []
let take t n = fst (split_n t n)
let drop t n = snd (split_n t n)
let split_while xs ~f =
let rec loop acc = function
| hd :: tl when f hd -> loop (hd :: acc) tl
| t -> (rev acc, t)
in
loop [] xs
let take_while t ~f = fst (split_while t ~f)
let drop_while t ~f = snd (split_while t ~f)
module Assoc = struct
let get e l = try Some (assoc e l) with Not_found -> None
let getq e l = try Some (assq e l) with Not_found -> None
let mem = mem_assoc
let memq = mem_assq
let remove_assoc = remove_assoc
let remove_assq = remove_assq
let remove_and_get el list =
let rec loop acc = function
| [] -> None
| (e, v) :: t when e = el -> Some (v, (List.rev acc @ t))
| h :: t -> loop (h :: acc) t
in
loop [] list
let remove_and_getq el list =
let rec loop acc = function
| [] -> None
| (e, v) :: t when e == el -> Some (v, (List.rev acc @ t))
| h :: t -> loop (h :: acc) t
in
loop [] list
end
let assoc = `Use_sub_module
let assq = `Use_sub_module
let mem_assoc = `Use_sub_module
let mem_assq = `Use_sub_module
let remove_assoc = `Use_sub_module
let remove_assq = `Use_sub_module
end
module Array = ArrayLabels
module Option = struct
exception No_value of string
let value o ~default = match o with Some s -> s | None -> default
let value_exn o ~msg =
match o with
| Some o -> o
| None -> raise (No_value msg)
let map o ~f =
match o with
| None -> None
| Some s -> Some (f s)
let iter: 'a option -> f:('a -> unit) -> unit = fun o ~f ->
match o with
| None -> ()
| Some s -> f s
let value_map o ~default ~f =
match o with
| Some s -> f s
| None -> default
let return s = Some s
let bind o ~f =
match o with
| None -> None
| Some s -> f s
let (>>=) x f = bind x ~f
end
module Int = struct
type t = int
let compare (a: int) (b: int) = compare a b
let to_string i = string_of_int i
let of_string s = try Some (int_of_string s) with _ -> None
end
module Float = struct
type t = float
let compare (a: float) (b: float) = compare a b
let to_string i = string_of_float i
let of_string s = try Some (float_of_string s) with _ -> None
end