Source file hashtbl.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
module type S = Hashtbl_intf.S

module Make (H : sig
  include Hashable.S

  val to_dyn : t -> Dyn.t
end) =
struct
  include MoreLabels.Hashtbl.Make (H)

  let[@ocaml.warning "-32"] add = `Use_set

  let find = find_opt

  let find_exn t key =
    match find_opt t key with
    | Some v -> v
    | None -> Code_error.raise "Hashtbl.find_exn" [ ("key", H.to_dyn key) ]

  let set t key data = replace t ~key ~data

  let find_or_add t key ~f =
    match find t key with
    | Some x -> x
    | None ->
      let x = f key in
      set t key x;
      x

  let foldi t ~init ~f = fold t ~init ~f:(fun ~key ~data acc -> f key data acc)

  let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)

  let of_list l =
    let h = create (List.length l) in
    let rec loop = function
      | [] -> Result.Ok h
      | (k, v) :: xs -> (
        match find h k with
        | None ->
          set h k v;
          loop xs
        | Some v' -> Error (k, v', v))
    in
    loop l

  let of_list_exn l =
    match of_list l with
    | Result.Ok h -> h
    | Error (key, _, _) ->
      Code_error.raise "Hashtbl.of_list_exn duplicate keys"
        [ ("key", H.to_dyn key) ]

  let add_exn t key data =
    match find t key with
    | None -> set t key data
    | Some _ ->
      Code_error.raise "Hashtbl.add_exn: key already exists"
        [ ("key", H.to_dyn key) ]

  let add t key data =
    match find t key with
    | None ->
      set t key data;
      Result.Ok ()
    | Some p -> Result.Error p

  let keys t = foldi t ~init:[] ~f:(fun key _ acc -> key :: acc)

  let to_dyn f t =
    Dyn.Map
      (foldi t ~init:[] ~f:(fun key data acc -> (H.to_dyn key, f data) :: acc)
      |> List.sort ~compare:(fun (k, _) (k', _) -> Dyn.compare k k'))

  let filteri_inplace t ~f =
    (* Surely there's a more performant way of writing this. (e.g. using
       filter_map_inplace), but starting with a simple thing for now, in part
       because [filter_map_inplace] is not available in 4.02. *)
    let to_delete = ref [] in
    iter t ~f:(fun ~key ~data ->
        match f ~key ~data with
        | false -> to_delete := key :: !to_delete
        | true -> ());
    List.iter !to_delete ~f:(fun k -> remove t k)

  let iter t ~f = iter t ~f:(fun ~key:_ ~data -> f data)
end