viewcvs.cgi/types/sortedList.ml

module type ARG = sig
  type 'a t
  val equal: 'a t -> 'a t -> bool
  val hash: 'a t -> int
  val compare: 'a t -> 'a t -> int
end

module type ARG0 =
sig
    type t
    val equal: t -> t -> bool
    val hash: t -> int
    val compare: t -> t -> int
end

module Lift(X : ARG0) =
struct
  type 'a t = X.t
  let equal = X.equal
  let hash = X.hash
  let compare = X.compare
end

module type S =
sig
  type 'a elem
  type 'a t
  val equal: 'a t -> 'a t -> bool
  val hash: 'a t -> int
  val compare: 'a t -> 'a t -> int

  external get: 'a t -> 'a elem list = "%identity"

  val singleton: 'a elem -> 'a t
  val iter: ('a elem -> unit) -> 'a t -> unit
  val filter: ('a elem -> bool) -> 'a t -> 'a t
  val exists: ('a elem -> bool) -> 'a t -> bool
  val fold: ('b -> 'a elem -> 'b) -> 'b -> 'a t -> 'b
  val pick: 'a t -> 'a elem option
  val length: 'a t -> int

  val empty: 'a t
  val is_empty: 'a t -> bool
  val from_list : 'a elem list -> 'a t
  val add: 'a elem -> 'a t -> 'a t
  val remove:  'a elem -> 'a t -> 'a t
  val disjoint: 'a t -> 'a t -> bool
  val cup: 'a t -> 'a t -> 'a t
  val split: 'a t -> 'a t -> 'a t * 'a t * 'a t
    (* split l1 l2 = (l1 \ l2, l1 & l2, l2 \ l1) *)
  val cap:  'a t -> 'a t -> 'a t
  val diff: 'a t -> 'a t -> 'a t
  val subset: 'a t -> 'a t -> bool
  val map: ('a elem-> 'b elem) -> 'a t -> 'b t
  val mem: 'a t -> 'a elem -> bool

  val check: 'a elem list -> unit

  module Map: sig
    type ('a,'b) map
    external get: ('a,'b) map -> ('a elem * 'b) list = "%identity"
    val empty: ('a,'b) map
    val iter: ('b -> unit) -> ('a,'b) map -> unit
    val is_empty: ('a,'b) map -> bool
    val singleton: 'a elem -> 'b -> ('a,'b) map
    val assoc_remove: 'a elem -> ('a,'b) map -> 'b * ('a,'b) map
    val remove:  'a elem -> ('a,'b) map -> ('a,'b) map
    val merge: ('b -> 'b -> 'b ) -> ('a,'b) map -> ('a,'b) map -> ('a,'b) map
    val merge_elem: 'b -> ('a,'b) map -> ('a,'b) map -> ('a,'b) map
    val union_disj: ('a,'b) map -> ('a,'b) map -> ('a,'b) map
    val diff: ('a,'b) map -> 'a t -> ('a,'b) map
    val from_list: ('b -> 'b -> 'b ) -> ('a elem * 'b) list -> ('a,'b) map
    val from_list_disj: ('a elem * 'b) list -> ('a,'b) map
    val map_from_slist: ('a elem -> 'b) -> 'a t -> ('a,'b) map
    val collide: ('b -> 'c -> unit) -> ('a,'b) map -> ('a,'c) map -> unit
    val map: ('b -> 'c) -> ('a,'b) map -> ('a,'c) map
    val mapi: ('a elem -> 'b -> 'c) -> ('a,'b) map -> ('a,'c) map
    val constant: 'b -> 'a t -> ('a,'b) map
    val num: int -> 'a t -> ('a,int) map
    val map_to_list: ('b -> 'c) -> ('a,'b) map -> 'c list
    val mapi_to_list: ('a elem -> 'b -> 'c) -> ('a,'b) map -> 'c list
    val assoc: 'a elem -> ('a,'b) map -> 'b
    val assoc_present:  'a elem -> ('a,'b) map -> 'b

    val compare: ('b -> 'b -> int) -> ('a,'b) map -> ('a,'b) map -> int
    val hash: ('b -> int) -> ('a,'b) map -> int
    val equal: ('b -> 'b -> bool) -> ('a,'b) map -> ('a,'b) map -> bool
  end
end

module Make_transp(X : ARG) = struct

  type 'a t = 'a X.t list
  type 'a elem = 'a X.t

  let rec equal l1 l2 =
    (l1 == l2) ||
    match (l1,l2) with
      | x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
      | _ -> false

  let rec hash accu = function
    | [] -> 1 + accu
    | x::l -> hash (17 * accu + X.hash x) l

  let hash l = hash 1 l

  let rec compare l1 l2 =
    if l1 == l2 then 0 
    else match (l1,l2) with
      | x1::l1, x2::l2 -> 
          let c = X.compare x1 x2 in if c <> 0 then c 
          else compare l1 l2
      | [],_ -> -1
      | _ -> 1


  let iter = List.iter

  let filter = List.filter
  let exists = List.exists
  let fold = List.fold_left


  external get: 'a t -> 'a elem list = "%identity"
  let singleton x = [ x ]

  let pick = function x::_ -> Some x | _ -> None 
  let length = List.length

  let empty = []
  let is_empty l = l = []

let rec disjoint l1 l2 =
  if l1 == l2 then l1 == [] else
  match (l1,l2) with
    | (t1::q1, t2::q2) -> 
        let c = X.compare t1 t2 in
        if c < 0 then disjoint q1 l2
        else if c > 0 then disjoint l1 q2
        else false
    | _ -> true
        
let rec cup l1 l2 =
  if l1 == l2 then l1 else
  match (l1,l2) with
    | (t1::q1, t2::q2) ->
        let c = X.compare t1 t2 in
        if c = 0 then t1::(cup q1 q2)
        else if c < 0 then t1::(cup q1 l2)
        else t2::(cup l1 q2)
    | ([],l2) -> l2
    | (l1,[]) -> l1

let add x l = cup [x] l
        
let rec split l1 l2 =
  match (l1,l2) with
    | (t1::q1, t2::q2) ->
        let c = X.compare t1 t2 in
        if c = 0 then       let (l1,i,l2) = split q1 q2 in (l1,t1::i,l2)
        else if c < 0 then  let (l1,i,l2) = split q1 l2 in (t1::l1,i,l2)
        else                let (l1,i,l2) = split l1 q2 in (l1,i,t2::l2)
    | _ -> (l1,[],l2)
        
        
let rec diff l1 l2 =
  if l1 == l2 then [] else
  match (l1,l2) with
    | (t1::q1, t2::q2) ->
        let c = X.compare t1 t2 in
        if c = 0 then diff q1 q2
        else if c < 0 then t1::(diff q1 l2)
        else diff l1 q2
    | _ -> l1

let remove x l = diff l [x]

let rec cap l1 l2 =
  if l1 == l2 then l1 else
  match (l1,l2) with
    | (t1::q1, t2::q2) ->
        let c = X.compare t1 t2 in
        if c = 0 then t1::(cap q1 q2)
        else if c < 0 then cap q1 l2
        else cap l1 q2
    | _ -> []

        
let rec subset l1 l2 =
  (l1 == l2) ||
  match (l1,l2) with
    | (t1::q1, t2::q2) ->
        let c = X.compare t1 t2 in
        if c = 0 then (
(* inlined: subset q1 q2 *)
          (q1 == q2) || match (q1,q2) with
            | (t1::qq1, t2::qq2) ->
                let c = X.compare t1 t2 in
                if c = 0 then subset qq1 qq2
                else if c < 0 then false
                else subset q1 qq2
            | [],_ -> true | _ -> false
        )
        else if c < 0 then false
        else subset l1 q2
    | [],_ -> true | _ -> false
        
        
let from_list l = 
  let rec initlist = function
    | [] -> []
    | e::rest -> [e] :: initlist rest in
  let rec merge2 = function
    | l1::l2::rest -> cup l1 l2 :: merge2 rest
    | x -> x in
  let rec mergeall = function
    | [] -> []
    | [l] -> l
    | llist -> mergeall (merge2 llist) in
  mergeall (initlist l)
    
let map f l =
  from_list (List.map f l)

let rec mem l x =
  match l with
    | [] -> false
    | t::q -> 
        let c = X.compare x t in
        (c = 0) || ((c > 0) && (mem q x))

let rec check = function
  | a::(b::_ as t) -> assert (X.compare a b < 0); check t
  | _ -> ()

module Map = struct
  type ('a,'b) map = ('a X.t * 'b) list
  external get: ('a,'b) map -> ('a elem * 'b) list = "%identity"
  let empty = []
  let is_empty l = l = []
  let singleton x y = [ (x,y) ]

  let rec iter f = function
    | (_,y)::l -> f y; iter f l
    | [] -> ()

  let rec assoc_remove_aux v r = function
    | ((x,y) as a)::l ->
        let c = X.compare x v in
        if c = 0 then (r := y; l) 
        else if c < 0 then a :: (assoc_remove_aux v r l)
        else raise Not_found
    | [] -> raise Not_found

  let assoc_remove v l =
    let r = ref (Obj.magic 0) in
    let l = assoc_remove_aux v r l in
    (!r, l)

(* TODO: is is faster to raise exception Not_found and return
   original list ? *)
  let rec remove v = function
    | (((x,y) as a)::rem) as l->
        let c = X.compare x v in
        if c = 0 then rem
        else if c < 0 then a :: (remove v rem)
        else l
    | [] -> []

  let rec merge f l1 l2 =
    match (l1,l2) with
      | ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
          let c = X.compare x1 x2 in
          if c = 0 then (x1,(f y1 y2))::(merge f q1 q2)
          else if c < 0 then t1::(merge f q1 l2)
          else t2::(merge f l1 q2)
      | ([],l2) -> l2
      | (l1,[]) -> l1

  let merge_elem x l1 l2 = merge (fun _ _ -> x) l1 l2
                             (* TODO: optimize this ? *)

  let rec union_disj l1 l2 =
    match (l1,l2) with
      | ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
          let c = X.compare x1 x2 in
          if c = 0 then failwith "SortedList.Map.union_disj"
          else if c < 0 then t1::(union_disj q1 l2)
          else t2::(union_disj l1 q2)
      | ([],l2) -> l2
      | (l1,[]) -> l1

  let rec diff l1 l2 =
    match (l1,l2) with
      | (((x1,y1) as t1)::q1, x2::q2) ->
          let c = X.compare x1 x2 in
          if c = 0 then diff q1 q2
          else if c < 0 then t1::(diff q1 l2)
          else diff l1 q2
      | _ -> l1

  let from_list f l = 
    let rec initlist = function
      | [] -> []
      | e::rest -> [e] :: initlist rest in
    let rec merge2 = function
      | l1::l2::rest -> merge f l1 l2 :: merge2 rest
      | x -> x in
    let rec mergeall = function
      | [] -> []
      | [l] -> l
      | llist -> mergeall (merge2 llist) in
    mergeall (initlist l)

  let from_list_disj l = 
    let rec initlist = function
      | [] -> []
      | e::rest -> [e] :: initlist rest in
    let rec merge2 = function
      | l1::l2::rest -> union_disj l1 l2 :: merge2 rest
      | x -> x in
    let rec mergeall = function
      | [] -> []
      | [l] -> l
      | llist -> mergeall (merge2 llist) in
    mergeall (initlist l)

  let rec map_from_slist f = function
    | x::l -> (x,f x)::(map_from_slist f l)
    | [] -> []
    
  let rec collide f l1 l2 =
    match (l1,l2) with
      | (_,y1)::l1, (_,y2)::l2 -> f y1 y2; collide f l1 l2
      | [],[] -> ()
      | _ -> assert false

  let rec map f = function
    | (x,y)::l -> (x, f y)::(map f l)
    | [] -> []

  let rec mapi f = function
    | (x,y)::l -> (x, f x y)::(mapi f l)
    | [] -> []

  let rec mapi_to_list f = function
    | (x,y)::l -> (f x y) ::(mapi_to_list f l)
    | [] -> []

  let rec constant y = function
    | x::l -> (x,y)::(constant y l)
    | [] -> []

  let rec num i = function [] -> [] | h::t -> (h,i)::(num (i+1) t)

  let rec map_to_list f = function
    | (x,y)::l -> (f y)::(map_to_list f l)
    | [] -> []

  let rec assoc v = function
    | (x,y)::l ->
        let c = X.compare x v in
        if c = 0 then y 
        else if c < 0 then assoc v l
        else raise Not_found
    | [] -> raise Not_found

  let rec assoc_present v = function
    | [(_,y)] -> y
    | (x,y)::l ->
        let c = X.compare x v in
        if c = 0 then y else assoc_present v l
    | [] -> assert false

  let rec compare f l1 l2 =
    if l1 == l2 then 0 
    else match (l1,l2) with
      | (x1,y1)::l1, (x2,y2)::l2 ->
          let c = X.compare x1 x2 in if c <> 0 then c
          else let c = f y1 y2 in if c <> 0 then c
          else compare f l1 l2
      | [],_ -> -1
      | _,[] -> 1

  let rec hash f = function
    | [] -> 1
    | (x,y)::l -> X.hash x + 17 * (f y) + 257 * (hash f l)

  let rec equal f l1 l2  =
    (l1 == l2) ||
    match (l1,l2) with
      | (x1,y1)::l1, (x2,y2)::l2 ->
          (X.equal x1 x2) && (f y1 y2) && (equal f l1 l2)
      | _ -> false

end

end

module Make = Make_transp

module String = 
struct 
  type t = string 
  let hash = Hashtbl.hash
  let equal (x:t) (y:t) = x = y
  let compare (x:t) (y:t) = compare x y
end
1	module type ARG = sig
2	type 'a t
3	val equal: 'a t -> 'a t -> bool
4	val hash: 'a t -> int
5	val compare: 'a t -> 'a t -> int
6	end
7
8	module type ARG0 =
9	sig
10	type t
11	val equal: t -> t -> bool
12	val hash: t -> int
13	val compare: t -> t -> int
14	end
15
16	module Lift(X : ARG0) =
17	struct
18	type 'a t = X.t
19	let equal = X.equal
20	let hash = X.hash
21	let compare = X.compare
22	end
23
24	module type S =
25	sig
26	type 'a elem
27	type 'a t
28	val equal: 'a t -> 'a t -> bool
29	val hash: 'a t -> int
30	val compare: 'a t -> 'a t -> int
31
32	external get: 'a t -> 'a elem list = "%identity"
33
34	val singleton: 'a elem -> 'a t
35	val iter: ('a elem -> unit) -> 'a t -> unit
36	val filter: ('a elem -> bool) -> 'a t -> 'a t
37	val exists: ('a elem -> bool) -> 'a t -> bool
38	val fold: ('b -> 'a elem -> 'b) -> 'b -> 'a t -> 'b
39	val pick: 'a t -> 'a elem option
40	val length: 'a t -> int
41
42	val empty: 'a t
43	val is_empty: 'a t -> bool
44	val from_list : 'a elem list -> 'a t
45	val add: 'a elem -> 'a t -> 'a t
46	val remove: 'a elem -> 'a t -> 'a t
47	val disjoint: 'a t -> 'a t -> bool
48	val cup: 'a t -> 'a t -> 'a t
49	val split: 'a t -> 'a t -> 'a t * 'a t * 'a t
50	(* split l1 l2 = (l1 \ l2, l1 & l2, l2 \ l1) *)
51	val cap: 'a t -> 'a t -> 'a t
52	val diff: 'a t -> 'a t -> 'a t
53	val subset: 'a t -> 'a t -> bool
54	val map: ('a elem-> 'b elem) -> 'a t -> 'b t
55	val mem: 'a t -> 'a elem -> bool
56
57	val check: 'a elem list -> unit
58
59	module Map: sig
60	type ('a,'b) map
61	external get: ('a,'b) map -> ('a elem * 'b) list = "%identity"
62	val empty: ('a,'b) map
63	val iter: ('b -> unit) -> ('a,'b) map -> unit
64	val is_empty: ('a,'b) map -> bool
65	val singleton: 'a elem -> 'b -> ('a,'b) map
66	val assoc_remove: 'a elem -> ('a,'b) map -> 'b * ('a,'b) map
67	val remove: 'a elem -> ('a,'b) map -> ('a,'b) map
68	val merge: ('b -> 'b -> 'b ) -> ('a,'b) map -> ('a,'b) map -> ('a,'b) map
69	val merge_elem: 'b -> ('a,'b) map -> ('a,'b) map -> ('a,'b) map
70	val union_disj: ('a,'b) map -> ('a,'b) map -> ('a,'b) map
71	val diff: ('a,'b) map -> 'a t -> ('a,'b) map
72	val from_list: ('b -> 'b -> 'b ) -> ('a elem * 'b) list -> ('a,'b) map
73	val from_list_disj: ('a elem * 'b) list -> ('a,'b) map
74	val map_from_slist: ('a elem -> 'b) -> 'a t -> ('a,'b) map
75	val collide: ('b -> 'c -> unit) -> ('a,'b) map -> ('a,'c) map -> unit
76	val map: ('b -> 'c) -> ('a,'b) map -> ('a,'c) map
77	val mapi: ('a elem -> 'b -> 'c) -> ('a,'b) map -> ('a,'c) map
78	val constant: 'b -> 'a t -> ('a,'b) map
79	val num: int -> 'a t -> ('a,int) map
80	val map_to_list: ('b -> 'c) -> ('a,'b) map -> 'c list
81	val mapi_to_list: ('a elem -> 'b -> 'c) -> ('a,'b) map -> 'c list
82	val assoc: 'a elem -> ('a,'b) map -> 'b
83	val assoc_present: 'a elem -> ('a,'b) map -> 'b
84
85	val compare: ('b -> 'b -> int) -> ('a,'b) map -> ('a,'b) map -> int
86	val hash: ('b -> int) -> ('a,'b) map -> int
87	val equal: ('b -> 'b -> bool) -> ('a,'b) map -> ('a,'b) map -> bool
88	end
89	end
90
91	module Make_transp(X : ARG) = struct
92
93	type 'a t = 'a X.t list
94	type 'a elem = 'a X.t
95
96	let rec equal l1 l2 =
97	(l1 == l2) \|\|
98	match (l1,l2) with
99	\| x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
100	\| _ -> false
101
102	let rec hash accu = function
103	\| [] -> 1 + accu
104	\| x::l -> hash (17 * accu + X.hash x) l
105
106	let hash l = hash 1 l
107
108	let rec compare l1 l2 =
109	if l1 == l2 then 0
110	else match (l1,l2) with
111	\| x1::l1, x2::l2 ->
112	let c = X.compare x1 x2 in if c <> 0 then c
113	else compare l1 l2
114	\| [],_ -> -1
115	\| _ -> 1
116
117
118	let iter = List.iter
119
120	let filter = List.filter
121	let exists = List.exists
122	let fold = List.fold_left
123
124
125	external get: 'a t -> 'a elem list = "%identity"
126	let singleton x = [ x ]
127
128	let pick = function x::_ -> Some x \| _ -> None
129	let length = List.length
130
131	let empty = []
132	let is_empty l = l = []
133
134	let rec disjoint l1 l2 =
135	if l1 == l2 then l1 == [] else
136	match (l1,l2) with
137	\| (t1::q1, t2::q2) ->
138	let c = X.compare t1 t2 in
139	if c < 0 then disjoint q1 l2
140	else if c > 0 then disjoint l1 q2
141	else false
142	\| _ -> true
143
144	let rec cup l1 l2 =
145	if l1 == l2 then l1 else
146	match (l1,l2) with
147	\| (t1::q1, t2::q2) ->
148	let c = X.compare t1 t2 in
149	if c = 0 then t1::(cup q1 q2)
150	else if c < 0 then t1::(cup q1 l2)
151	else t2::(cup l1 q2)
152	\| ([],l2) -> l2
153	\| (l1,[]) -> l1
154
155	let add x l = cup [x] l
156
157	let rec split l1 l2 =
158	match (l1,l2) with
159	\| (t1::q1, t2::q2) ->
160	let c = X.compare t1 t2 in
161	if c = 0 then let (l1,i,l2) = split q1 q2 in (l1,t1::i,l2)
162	else if c < 0 then let (l1,i,l2) = split q1 l2 in (t1::l1,i,l2)
163	else let (l1,i,l2) = split l1 q2 in (l1,i,t2::l2)
164	\| _ -> (l1,[],l2)
165
166
167	let rec diff l1 l2 =
168	if l1 == l2 then [] else
169	match (l1,l2) with
170	\| (t1::q1, t2::q2) ->
171	let c = X.compare t1 t2 in
172	if c = 0 then diff q1 q2
173	else if c < 0 then t1::(diff q1 l2)
174	else diff l1 q2
175	\| _ -> l1
176
177	let remove x l = diff l [x]
178
179	let rec cap l1 l2 =
180	if l1 == l2 then l1 else
181	match (l1,l2) with
182	\| (t1::q1, t2::q2) ->
183	let c = X.compare t1 t2 in
184	if c = 0 then t1::(cap q1 q2)
185	else if c < 0 then cap q1 l2
186	else cap l1 q2
187	\| _ -> []
188
189
190	let rec subset l1 l2 =
191	(l1 == l2) \|\|
192	match (l1,l2) with
193	\| (t1::q1, t2::q2) ->
194	let c = X.compare t1 t2 in
195	if c = 0 then (
196	(* inlined: subset q1 q2 *)
197	(q1 == q2) \|\| match (q1,q2) with
198	\| (t1::qq1, t2::qq2) ->
199	let c = X.compare t1 t2 in
200	if c = 0 then subset qq1 qq2
201	else if c < 0 then false
202	else subset q1 qq2
203	\| [],_ -> true \| _ -> false
204	)
205	else if c < 0 then false
206	else subset l1 q2
207	\| [],_ -> true \| _ -> false
208
209
210
211	let from_list l =
212	let rec initlist = function
213	\| [] -> []
214	\| e::rest -> [e] :: initlist rest in
215	let rec merge2 = function
216	\| l1::l2::rest -> cup l1 l2 :: merge2 rest
217	\| x -> x in
218	let rec mergeall = function
219	\| [] -> []
220	\| [l] -> l
221	\| llist -> mergeall (merge2 llist) in
222	mergeall (initlist l)
223
224	let map f l =
225	from_list (List.map f l)
226
227	let rec mem l x =
228	match l with
229	\| [] -> false
230	\| t::q ->
231	let c = X.compare x t in
232	(c = 0) \|\| ((c > 0) && (mem q x))
233
234	let rec check = function
235	\| a::(b::_ as t) -> assert (X.compare a b < 0); check t
236	\| _ -> ()
237
238	module Map = struct
239	type ('a,'b) map = ('a X.t * 'b) list
240	external get: ('a,'b) map -> ('a elem * 'b) list = "%identity"
241	let empty = []
242	let is_empty l = l = []
243	let singleton x y = [ (x,y) ]
244
245	let rec iter f = function
246	\| (_,y)::l -> f y; iter f l
247	\| [] -> ()
248
249	let rec assoc_remove_aux v r = function
250	\| ((x,y) as a)::l ->
251	let c = X.compare x v in
252	if c = 0 then (r := y; l)
253	else if c < 0 then a :: (assoc_remove_aux v r l)
254	else raise Not_found
255	\| [] -> raise Not_found
256
257	let assoc_remove v l =
258	let r = ref (Obj.magic 0) in
259	let l = assoc_remove_aux v r l in
260	(!r, l)
261
262	(* TODO: is is faster to raise exception Not_found and return
263	original list ? *)
264	let rec remove v = function
265	\| (((x,y) as a)::rem) as l->
266	let c = X.compare x v in
267	if c = 0 then rem
268	else if c < 0 then a :: (remove v rem)
269	else l
270	\| [] -> []
271
272	let rec merge f l1 l2 =
273	match (l1,l2) with
274	\| ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
275	let c = X.compare x1 x2 in
276	if c = 0 then (x1,(f y1 y2))::(merge f q1 q2)
277	else if c < 0 then t1::(merge f q1 l2)
278	else t2::(merge f l1 q2)
279	\| ([],l2) -> l2
280	\| (l1,[]) -> l1
281
282	let merge_elem x l1 l2 = merge (fun _ _ -> x) l1 l2
283	(* TODO: optimize this ? *)
284
285	let rec union_disj l1 l2 =
286	match (l1,l2) with
287	\| ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
288	let c = X.compare x1 x2 in
289	if c = 0 then failwith "SortedList.Map.union_disj"
290	else if c < 0 then t1::(union_disj q1 l2)
291	else t2::(union_disj l1 q2)
292	\| ([],l2) -> l2
293	\| (l1,[]) -> l1
294
295	let rec diff l1 l2 =
296	match (l1,l2) with
297	\| (((x1,y1) as t1)::q1, x2::q2) ->
298	let c = X.compare x1 x2 in
299	if c = 0 then diff q1 q2
300	else if c < 0 then t1::(diff q1 l2)
301	else diff l1 q2
302	\| _ -> l1
303
304	let from_list f l =
305	let rec initlist = function
306	\| [] -> []
307	\| e::rest -> [e] :: initlist rest in
308	let rec merge2 = function
309	\| l1::l2::rest -> merge f l1 l2 :: merge2 rest
310	\| x -> x in
311	let rec mergeall = function
312	\| [] -> []
313	\| [l] -> l
314	\| llist -> mergeall (merge2 llist) in
315	mergeall (initlist l)
316
317	let from_list_disj l =
318	let rec initlist = function
319	\| [] -> []
320	\| e::rest -> [e] :: initlist rest in
321	let rec merge2 = function
322	\| l1::l2::rest -> union_disj l1 l2 :: merge2 rest
323	\| x -> x in
324	let rec mergeall = function
325	\| [] -> []
326	\| [l] -> l
327	\| llist -> mergeall (merge2 llist) in
328	mergeall (initlist l)
329
330	let rec map_from_slist f = function
331	\| x::l -> (x,f x)::(map_from_slist f l)
332	\| [] -> []
333
334	let rec collide f l1 l2 =
335	match (l1,l2) with
336	\| (_,y1)::l1, (_,y2)::l2 -> f y1 y2; collide f l1 l2
337	\| [],[] -> ()
338	\| _ -> assert false
339
340	let rec map f = function
341	\| (x,y)::l -> (x, f y)::(map f l)
342	\| [] -> []
343
344	let rec mapi f = function
345	\| (x,y)::l -> (x, f x y)::(mapi f l)
346	\| [] -> []
347
348	let rec mapi_to_list f = function
349	\| (x,y)::l -> (f x y) ::(mapi_to_list f l)
350	\| [] -> []
351
352	let rec constant y = function
353	\| x::l -> (x,y)::(constant y l)
354	\| [] -> []
355
356	let rec num i = function [] -> [] \| h::t -> (h,i)::(num (i+1) t)
357
358	let rec map_to_list f = function
359	\| (x,y)::l -> (f y)::(map_to_list f l)
360	\| [] -> []
361
362	let rec assoc v = function
363	\| (x,y)::l ->
364	let c = X.compare x v in
365	if c = 0 then y
366	else if c < 0 then assoc v l
367	else raise Not_found
368	\| [] -> raise Not_found
369
370	let rec assoc_present v = function
371	\| [(_,y)] -> y
372	\| (x,y)::l ->
373	let c = X.compare x v in
374	if c = 0 then y else assoc_present v l
375	\| [] -> assert false
376
377	let rec compare f l1 l2 =
378	if l1 == l2 then 0
379	else match (l1,l2) with
380	\| (x1,y1)::l1, (x2,y2)::l2 ->
381	let c = X.compare x1 x2 in if c <> 0 then c
382	else let c = f y1 y2 in if c <> 0 then c
383	else compare f l1 l2
384	\| [],_ -> -1
385	\| _,[] -> 1
386
387	let rec hash f = function
388	\| [] -> 1
389	\| (x,y)::l -> X.hash x + 17 * (f y) + 257 * (hash f l)
390
391	let rec equal f l1 l2 =
392	(l1 == l2) \|\|
393	match (l1,l2) with
394	\| (x1,y1)::l1, (x2,y2)::l2 ->
395	(X.equal x1 x2) && (f y1 y2) && (equal f l1 l2)
396	\| _ -> false
397
398	end
399
400	end
401
402	module Make = Make_transp
403
404	module String =
405	struct
406	type t = string
407	let hash = Hashtbl.hash
408	let equal (x:t) (y:t) = x = y
409	let compare (x:t) (y:t) = compare x y
410	end