Source file utils.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
(*
 * Copyright (c) 2018-2022 Tarides <contact@tarides.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open! Import

module Object_counter : sig
  type t

  val start :
    Format.formatter -> t * ((unit -> unit) * (unit -> unit) * (unit -> unit))

  val finalise : t -> unit
  val finalise_with_stats : t -> int * int * int
end = struct
  type t =
    | Object_counter : {
        display : (_, _) Progress.Display.t;
        nb_commits : int ref;
        nb_nodes : int ref;
        nb_contents : int ref;
      }
        -> t

  let start ppf =
    let config = Progress.Config.v ~ppf () in
    let nb_commits = ref 0 in
    let nb_nodes = ref 0 in
    let nb_contents = ref 0 in
    let bar =
      let open Progress.Line in
      let count_to_string (contents, nodes, commits) =
        Fmt.str "%dk contents / %dk nodes / %d commits" (contents / 1000)
          (nodes / 1000) commits
      in
      using count_to_string string
    in
    let display = Progress.Display.start ~config (Progress.Multi.line bar) in
    let [ reporter ] = Progress.Display.reporters display in
    let update_fn count () =
      incr count;
      reporter (!nb_contents, !nb_nodes, !nb_commits)
    in
    let contents = update_fn nb_contents
    and nodes = update_fn nb_nodes
    and commits = update_fn nb_commits in
    ( Object_counter { display; nb_contents; nb_nodes; nb_commits },
      (contents, nodes, commits) )

  let finalise (Object_counter t) = Progress.Display.finalise t.display

  let finalise_with_stats (Object_counter t as t_outer) =
    finalise t_outer;
    (!(t.nb_contents), !(t.nb_nodes), !(t.nb_commits))
end

(** [nearest_geq ~arr ~get ~lo ~hi ~key] returns the index of the nearest entry
    in the sorted [arr] that is [>=] the given key. Routine is based on binary
    search. *)
let nearest_geq ~arr ~get ~lo ~hi ~key =
  if lo > hi then None
  else
    match Stdlib.compare key (get arr hi) with
    | 0 -> Some hi
    | c when c > 0 -> None
    | _ when get arr lo >= key -> Some lo
    | _ ->
        let rec search lo hi =
          assert (lo < hi);
          assert (get arr lo < key && key < get arr hi);
          if lo + 1 = hi then Some hi
          else
            let mid = (lo + hi) / 2 in
            match Stdlib.compare key (get arr mid) with
            | 0 -> Some mid
            | c when c < 0 -> search lo mid
            | _ -> search mid hi
        in
        search lo hi