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 |
---|