plugin/emap.ml

   1
   2 module type OrderedType = sig
   3   include Map.OrderedType
   4 end
   5
   6 module type S = sig
   7   include Map.S
   8
   9   val merge_f : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
  10   val split_couple : ('a * 'b) t -> 'a t * 'b t
  11   val combine : 'a t -> 'b t -> ('a * 'b) t
  12   val error_find : key -> 'a t -> exn -> 'a
  13   val of_list : (key * 'a) list -> 'a t
  14   val to_list : 'a t -> (key * 'a) list
  15 end
  16
  17 module Make (Ord : OrderedType) : S with type key = Ord.t = struct
  18   include Map.Make (Ord)
  19
  20   let merge_f f map1 map2 =
  21     let f_merge _ e1 e2 = match e1, e2 with
  22       | None, None -> None
  23       | Some e, None | None, Some e -> Some e
  24       | Some e1, Some e2 -> Some (f e1 e2) in
  25     merge f_merge map1 map2
  26
  27   let split_couple map =
  28     let f key (a, b) (resa, resb) = (add key a resa, add key b resb) in
  29     fold f map (empty, empty)
  30
  31   let combine mapa mapb =
  32     let f key a res =
  33       if mem key mapb then add key (a, find key mapb) res
  34       else res in
  35     fold f mapa empty
  36
  37   let error_find x map error = if mem x map then find x map else raise error
  38
  39   let of_list l =
  40     let f map (key, binding) = add key binding map in
  41     List.fold_left f empty l
  42
  43   let to_list = bindings
  44 end
  45
  46
  47 module type S1 = sig
  48   type key
  49   type img
  50   type t
  51   val empty : t
  52   val is_empty : t -> bool
  53   val mem : key -> t -> bool
  54   val add : key -> img -> t -> t
  55   val singleton : key -> img -> t
  56   val remove : key -> t -> t
  57   val merge_f : (img -> img -> img) -> t -> t -> t
  58   val merge : (key -> img option -> img option -> img option) -> t -> t -> t
  59   val compare : t -> t -> int
  60   val equal : t -> t -> bool
  61   val iter : (key -> img -> unit) -> t -> unit
  62   val fold : (key -> img -> 'b -> 'b) -> t -> 'b -> 'b
  63   val for_all : (key -> img -> bool) -> t -> bool
  64   val exists : (key -> img -> bool) -> t -> bool
  65   val filter : (key -> img -> bool) -> t -> t
  66   val partition : (key -> img -> bool) -> t -> t * t
  67   val cardinal : t -> int
  68   val bindings : t -> (key * img) list
  69   val min_binding : t -> key * img
  70   val max_binding : t -> key * img
  71   val choose : t -> key * img
  72   val split : key -> t -> t * img option * t
  73   val find : key -> t -> img
  74   val map : (img -> img) -> t -> t
  75   val mapi : (key -> img -> img) -> t -> t
  76   val error_find : key -> t -> exn -> img
  77   val of_list : (key * img) list -> t
  78   val to_list : t -> (key * img) list
  79 end
  80
  81 module Make1 (Key : OrderedType) (Img : OrderedType)
  82   : S1 with type key = Key.t and type img = Img.t =
  83 struct
  84
  85   module M = Make (Key)
  86
  87   type key = M.key
  88   type img = Img.t
  89   type t = img M.t
  90
  91   let empty = M.empty
  92   let is_empty = M.is_empty
  93   let mem = M.mem
  94   let add = M.add
  95   let singleton = M.singleton
  96   let remove = M.remove
  97   let merge_f = M.merge_f
  98   let merge = M.merge
  99   let compare = M.compare Img.compare
 100   let equal = M.equal (fun img1 img2 -> Img.compare img1 img2 = 0)
 101   let iter = M.iter
 102   let fold = M.fold
 103   let for_all = M.for_all
 104   let exists = M.exists
 105   let filter = M.filter
 106   let partition = M.partition
 107   let cardinal = M.cardinal
 108   let bindings = M.bindings
 109   let min_binding = M.min_binding
 110   let max_binding = M.max_binding
 111   let choose = M.choose
 112   let split = M.split
 113   let find = M.find
 114   let map = M.map
 115   let mapi = M.mapi
 116   let error_find = M.error_find
 117   let of_list = M.of_list
 118   let to_list = M.to_list
 119
 120 end