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
89
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
module type Elt =
sig
type t
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
end
module Make(E : Elt) =
struct
module Lset = Listset.Make(E)
type elt = E.t
type t = E.t list Intmap.t
let _nonempty = function [] -> None | l -> Some l
let is_empty es =
try
Intmap.iteri (fun _ s -> if s <> [] then raise Exit) es ;
true
with Exit -> false
let empty = Intmap.empty
let add e m =
let h = E.hash e in
let w = try Lset.add e (Intmap.find h m) with Not_found -> [e] in
Intmap.add h w m
let singleton e =
let h = E.hash e in
Intmap.add h [e] Intmap.empty
let mem e m =
try Lset.mem e (Intmap.find (E.hash e) m)
with Not_found -> false
let elements m =
Intmap.fold (fun w xs -> List.merge E.compare w xs) m []
let iter_sorted f m =
List.iter f (elements m)
let fold_sorted f m a =
List.fold_left (fun acc x -> f x acc) a (elements m)
let filter f m =
Intmap.mapq (fun _ l -> _nonempty (Lset.filter f l)) m
let remove k m =
let h = E.hash k in
Intmap.change (fun _h k -> function
| None -> None
| Some old -> _nonempty (Lset.remove k old)) h k m
let partition f =
Intmap.partition_split (fun _k w ->
let u,v = Lset.partition f w in
(_nonempty u), (_nonempty v))
exception BREAK
let iter f = Intmap.iter (Lset.iter f)
let fold f = Intmap.fold (Lset.fold f)
let for_all f m =
try iter (fun x -> if not (f x) then raise BREAK) m ; true
with BREAK -> false
let exists f m =
try iter (fun x -> if f x then raise BREAK) m ; false
with BREAK -> true
let diff = Intmap.diffq (fun _h a b ->
match Lset.diff a b with
| [] -> None
| l -> Some l
)
let union = Intmap.union (fun _h -> Lset.union)
let inter = Intmap.inter (fun _h -> Lset.inter)
let subset = Intmap.subset (fun _h -> Lset.subset)
let intersect m1 m2 =
try
Intmap.iter2
(fun _h xs ys ->
match xs , ys with
| None , _ | _ , None -> ()
| Some w1 , Some w2 -> if Lset.intersect w1 w2 then raise Exit
) m1 m2 ; false
with Exit -> true
let equal = Intmap.equal Lset.equal
let compare = Intmap.compare Lset.compare
let of_list l = List.fold_left (fun acc e -> add e acc) empty l
end