src/utilities/bijection.ml

   1
   2 module type OrderedType = sig
   3   type t
   4   val compare : t -> t -> int
   5 end
   6
   7
   8 module type S = sig
   9
  10   type a
  11   type b
  12   type t
  13
  14   val empty : t
  15   val is_empty : t -> bool
  16
  17   val add1 : a -> b -> t -> t
  18   val add2 : b -> a -> t -> t
  19
  20   val find1 : a -> t -> b
  21   val find2 : b -> t -> a
  22
  23   val remove1 : a -> t -> t
  24   val remove2 : b -> t -> t
  25
  26   val mem1 : a -> t -> bool
  27   val mem2 : b -> t -> bool
  28
  29   val iter1 : (a -> b -> unit) -> t -> unit
  30   val iter2 : (b -> a -> unit) -> t -> unit
  31
  32   val fold1 : (a -> b -> 'c -> 'c) -> t -> 'c -> 'c
  33   val fold2 : (b -> a -> 'c -> 'c) -> t -> 'c -> 'c
  34
  35   val compare1 : (b -> b -> int) -> t -> t -> int
  36   val compare2 : (a -> a -> int) -> t -> t -> int
  37
  38   val equal1 : (b -> b -> bool) -> t -> t -> bool
  39   val equal2 : (a -> a -> bool) -> t -> t -> bool
  40
  41 end
  42
  43
  44 module Make (O1 : OrderedType) (O2 : OrderedType) : S
  45   with type a = O1.t and type b = O2.t = struct
  46
  47   module Map1 = Map.Make (O1)
  48   module Map2 = Map.Make (O2)
  49
  50   type a = O1.t
  51   type b = O2.t
  52   type t = O2.t Map1.t * O1.t Map2.t
  53
  54   let eq1 a1 a2 = O1.compare a1 a2 = 0
  55   let eq2 b1 b2 = O2.compare b1 b2 = 0
  56
  57   let empty = (Map1.empty, Map2.empty)
  58   let is_empty (a_b, _) = Map1.is_empty a_b
  59
  60   let add1 a b (a_b, b_a) = (Map1.add a b a_b, Map2.add b a b_a)
  61   let add2 b a (a_b, b_a) = (Map1.add a b a_b, Map2.add b a b_a)
  62
  63   let find1 a (a_b, _) = Map1.find a a_b
  64   let find2 b (_, b_a) = Map2.find b b_a
  65
  66   let remove1 a (a_b, b_a) =
  67     let f b' a' b_a' = if eq1 a' a then b_a' else Map2.add b' a' b_a' in
  68     (Map1.remove a a_b, Map2.fold f b_a Map2.empty)
  69
  70   let remove2 b (a_b, b_a) =
  71     let f a' b' a_b' = if eq2 b' b then a_b' else Map1.add a' b' a_b' in
  72     (Map1.fold f a_b Map1.empty, Map2.remove b b_a)
  73
  74   let mem1 a (a_b, _) = Map1.mem a a_b
  75   let mem2 b (_, b_a) = Map2.mem b b_a
  76
  77   let iter1 f (a_b, _) = Map1.iter f a_b
  78   let iter2 f (_, b_a) = Map2.iter f b_a
  79
  80   let fold1 f (a_b, _) c = Map1.fold f a_b c
  81   let fold2 f (_, b_a) c = Map2.fold f b_a c
  82
  83   let compare1 f (a_b1, _) (a_b2, _) = Map1.compare f a_b1 a_b2
  84   let compare2 f (_, b_a1) (_, b_a2) = Map2.compare f b_a1 b_a2
  85
  86   let equal1 f (a_b1, _) (a_b2, _) = Map1.equal f a_b1 a_b2
  87   let equal2 f (_, b_a1) (_, b_a2) = Map2.equal f b_a1 b_a2
  88
  89 end