Maps.ml 2.56 KB
Newer Older
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
(* 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
		        and type 'data t = 'data M.t ref
= struct

  type key =
      M.key
  
  type 'data t =
      'data M.t ref
      
  let create () =
    ref M.empty

  let clear t =
    t := M.empty
    
  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
		       and type data = D.data
= 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

89
module ArrayAsImperativeMaps
90 91 92 93 94 95 96 97 98 99 100 101 102 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 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
  (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 ->
	raise Not_found
    | Some data ->
	data

  let iter f m =
    Array.iteri (fun key data ->
      match data with
      | None ->
	  ()
      | Some data ->
	  f key data
    ) 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