b6449cae87
* `lib_stdlib`: basic extended OCaml stdlib and generic data structures
* `lib_data_encoding`: almost independant 'Data_encoding'
* `lib_error_monad`: almost independant 'Error_monad'
* `lib_stdlib_lwt`: extended Lwt library
* `lib_crypto`: all the crypto stuff (hashing, signing, cryptobox).
* `lib_base`:
- basic type definitions (Block_header, Operation, ...)
- a module `TzPervasives` to bind them all and to be the
single module opened everywhere.
In the process, I splitted `Tezos_data` and `Hash` in multiple
submodules, thus removing a lot of `-open`.
The following two modules may not have found their place yet:
- Base58 (currently in `lib_crypto`)
- Cli_entries (currently in `lib_stdlib_lwt`)
136 lines
3.9 KiB
OCaml
136 lines
3.9 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
let may_cons xs x = match x with None -> xs | Some x -> x :: xs
|
|
|
|
let filter_map f l =
|
|
List.rev @@ List.fold_left (fun acc x -> may_cons acc (f x)) [] l
|
|
|
|
let rev_sub l n =
|
|
if n < 0 then
|
|
invalid_arg "Utils.rev_sub: `n` must be non-negative.";
|
|
let rec append_rev_sub acc l = function
|
|
| 0 -> acc
|
|
| n ->
|
|
match l with
|
|
| [] -> acc
|
|
| hd :: tl -> append_rev_sub (hd :: acc) tl (n - 1) in
|
|
append_rev_sub [] l n
|
|
|
|
let sub l n = rev_sub l n |> List.rev
|
|
|
|
let hd_opt = function
|
|
| [] -> None
|
|
| h :: _ -> Some h
|
|
|
|
let rec last_exn = function
|
|
| [] -> raise Not_found
|
|
| [x] -> x
|
|
| _ :: xs -> last_exn xs
|
|
|
|
let merge_filter2
|
|
?(finalize = List.rev) ?(compare = compare)
|
|
?(f = Option.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 merge2 ?finalize ?compare ?(f = fun x1 _x1 -> x1) l1 l2 =
|
|
merge_filter2 ?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 rec remove nb = function
|
|
| [] -> []
|
|
| l when nb <= 0 -> l
|
|
| _ :: tl -> remove (nb - 1) tl
|
|
|
|
let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x
|
|
|
|
let take_n_unsorted n l =
|
|
let rec loop acc n = function
|
|
| [] -> l
|
|
| _ when n <= 0 -> List.rev acc
|
|
| x :: xs -> loop (x :: acc) (pred n) xs in
|
|
loop [] n l
|
|
|
|
module Bounded(E: Set.OrderedType) : sig
|
|
|
|
type t
|
|
val create: int -> t
|
|
val insert: E.t -> t -> unit
|
|
val get: t -> E.t list
|
|
|
|
end = struct
|
|
|
|
(* TODO one day replace the list by an heap array *)
|
|
|
|
type t = {
|
|
bound : int ;
|
|
mutable size : int ;
|
|
mutable data : E.t list ;
|
|
}
|
|
|
|
let create bound =
|
|
if bound <= 0 then invalid_arg "Utils.Bounded(_).create" ;
|
|
{ bound ; size = 0 ; data = [] }
|
|
|
|
let rec push x = function
|
|
| [] -> [x]
|
|
| (y :: xs) as ys ->
|
|
if E.compare x y <= 0
|
|
then x :: ys
|
|
else y :: push x xs
|
|
|
|
let insert x t =
|
|
if t.size < t.bound then begin
|
|
t.size <- t.size + 1 ;
|
|
t.data <- push x t.data
|
|
end else if E.compare (List.hd t.data) x < 0 then
|
|
t.data <- push x (List.tl t.data)
|
|
|
|
let get { data ; _ } = data
|
|
|
|
end
|
|
|
|
let take_n_sorted (type a) compare n l =
|
|
let module B = Bounded(struct type t = a let compare = compare end) in
|
|
let t = B.create n in
|
|
List.iter (fun x -> B.insert x t) l ;
|
|
B.get t
|
|
|
|
let take_n ?compare n l =
|
|
match compare with
|
|
| None -> take_n_unsorted n l
|
|
| Some compare -> take_n_sorted compare n l
|
|
|
|
let select n l =
|
|
let rec loop n acc = function
|
|
| [] -> invalid_arg "Utils.select"
|
|
| x :: xs when n <= 0 -> x, List.rev_append acc xs
|
|
| x :: xs -> loop (pred n) (x :: acc) xs
|
|
in
|
|
loop n [] l
|