Maps.ml 3.55 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

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
(* BEGIN PERSISTENT_MAPS *)
module type PERSISTENT_MAPS = sig
  type key
  type 'data t
  val empty: 'data t
  val add: key -> 'data -> 'data t -> 'data t
  val find: key -> 'data t -> 'data
  val iter: (key -> 'data -> unit) -> 'data t -> unit
end
(* END PERSISTENT_MAPS *)

(* BEGIN IMPERATIVE_MAPS *)
module type IMPERATIVE_MAPS = sig
  type key
  type 'data t
  val create: unit -> 'data t
  val clear: 'data t -> unit
  val add: key -> 'data -> 'data t -> unit
  val find: key -> 'data t -> 'data
  val iter: (key -> 'data -> unit) -> 'data t -> unit
end
(* END IMPERATIVE_MAPS *)

(* BEGIN IMPERATIVE_MAP *)
module type IMPERATIVE_MAP = sig
  type key
  type data
  val set: key -> data -> unit
  val get: key -> data option
end
(* END IMPERATIVE_MAP *)

module PersistentMapsToImperativeMaps
  (M : PERSISTENT_MAPS)
     : IMPERATIVE_MAPS with type key = M.key
49
                        and type 'data t = 'data M.t ref
50 51 52 53
= struct

  type key =
      M.key
54

55 56
  type 'data t =
      'data M.t ref
57

58 59 60 61 62
  let create () =
    ref M.empty

  let clear t =
    t := M.empty
63

64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  let add k d t =
    t := M.add k d !t

  let find k t =
    M.find k !t

  let iter f t =
    M.iter f !t

end

module ImperativeMapsToImperativeMap
  (M : IMPERATIVE_MAPS)
  (D : sig type data end)
     : IMPERATIVE_MAP with type key = M.key
79
                       and type data = D.data
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
= struct

  type key =
      M.key

  type data =
      D.data

  let m =
    M.create()

  let set k d =
    M.add k d m

  let get k =
    try
      Some (M.find k m)
    with Not_found ->
      None

end

102
module ArrayAsImperativeMaps
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
  (K : sig val n: int end)
  : IMPERATIVE_MAPS with type key = int
                     and type 'data t = 'data option array

= struct

  open K

  type key =
      int

  type 'data t =
      'data option array

  let create () =
    Array.make n None

  let clear m =
    Array.fill m 0 n None

  let add key data m =
    m.(key) <- Some data

  let find key m =
    match m.(key) with
    | None ->
129
        raise Not_found
130
    | Some data ->
131
        data
132 133 134 135 136

  let iter f m =
    Array.iteri (fun key data ->
      match data with
      | None ->
137
          ()
138
      | Some data ->
139
          f key data
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
    ) m

end

module HashTableAsImperativeMaps
  (H : Hashtbl.HashedType)
     : IMPERATIVE_MAPS with type key = H.t
= struct

  include Hashtbl.Make(H)

  let create () =
    create 1023

  let add key data table =
    add table key data

  let find table key =
    find key table

end

module TrivialHashedType
  (T : sig type t end)
     : Hashtbl.HashedType with type t = T.t
= struct

  include T

  let equal =
    (=)

  let hash =
    Hashtbl.hash

end