Seal the representation of SortedList.Make(X).t (by making the type private)....

Seal the representation of SortedList.Make(X).t (by making the type private). Expose Var.Set as a SortedList.S

compile/compile.ml

@@ -76,13 +76,13 @@ let enter_global_cu cu env x =
 let rec domain = function 
   |Identity -> Var.Set.empty
   |List l -> Types.Tallying.domain l
-  |Comp (s1,s2) -> Var.Set.union (domain s1) (domain s2)
+  |Comp (s1,s2) -> Var.Set.cup (domain s1) (domain s2)
   |Sel(_,_,sigma) -> (domain sigma)
 
 let rec codomain = function
   | Identity -> Var.Set.empty
   | List(l) -> Types.Tallying.codomain l
-  | Comp(s1,s2) -> Var.Set.union (codomain s1) (codomain s2)
+  | Comp(s1,s2) -> Var.Set.cup (codomain s1) (codomain s2)
   | Sel(_,_,sigma) -> (codomain sigma)
 
 let fresharg =
@@ -111,7 +111,7 @@ let rec comp s1 s2 = match s1, s2 with
       | res -> comp s3 (comp res s6))
 
   (* If a variable in the image of s2 is in the domain of s1 we can't simplify *)
-  | _, _ when not (Var.Set.is_empty (Var.Set.inter (domain s1) (codomain s2)))
+  | _, _ when not (Var.Set.is_empty (Var.Set.cap (domain s1) (codomain s2)))
       -> Comp(s1, s2)
 
   | List(_), List(_) | Sel(_), List(_) ->
@@ -135,8 +135,8 @@ and compile_aux env te = function
       let is_mono x =
         if Var.Set.is_empty ts then true else
         let from_xi = try IdMap.assoc x env.xi with Not_found -> Var.Set.empty in
-        let d = Var.Set.inter from_xi (domain(env.sigma)) in
-        Var.Set.is_empty (Var.Set.inter ts d)
+        let d = Var.Set.cap from_xi (domain(env.sigma)) in
+        Var.Set.is_empty (Var.Set.cap ts d)
       in
       if is_mono x then Var (v) else TVar(v,env.sigma)
   | Typed.Subst(e,sl) -> 
@@ -193,15 +193,15 @@ and compile_abstr env a =
       List.fold_left(fun acc (t1,t2) ->
         let ts1 = Types.all_vars t1 in
         let ts2 = Types.all_vars t2 in
-        let tu = Var.Set.union ts1 ts2 in
-        Var.Set.union acc tu
+        let tu = Var.Set.cup ts1 ts2 in
+        Var.Set.cup acc tu
       ) Var.Set.empty a.Typed.fun_iface
     in
     if Var.Set.is_empty vars then true else
     if env.sigma = Identity then false
     else
       let d = domain(env.sigma) in
-      Var.Set.is_empty (Var.Set.inter d vars)
+      Var.Set.is_empty (Var.Set.cap d vars)
   in
   let (slots,nb_slots,fun_env) = 
     (* we add a nameless empty slot for the argument *)
@@ -258,7 +258,7 @@ and compile_branches env (brs : Typed.branches) =
 
 (* p_i / t_i -> br.Typed.br_pat / br.Typed.br_type *)
 and compile_branch env br =
-  let env = List.fold_left enter_local env (Patterns.fv br.Typed.br_pat) in
+  let env = List.fold_left enter_local env (IdSet.get (Patterns.fv br.Typed.br_pat)) in
   let env = 
     { env with 
       xi = IdMap.merge (fun _ v2 -> v2) env.xi br.Typed.br_vars_poly
@@ -278,7 +278,7 @@ let compile_expr env e =
 let compile_let_decl env decl =
   let pat = decl.Typed.let_pat in
   let e,lsize = compile_expr env decl.Typed.let_body in
-  let env = enter_globals env (Patterns.fv pat) in
+  let env = enter_globals env (IdSet.get (Patterns.fv pat)) in
 
   let te = decl.Typed.let_body.Typed.exp_typ in 
   let comp = Patterns.Compile.make_branches te [ pat, () ] in

depend

@@ -371,7 +371,7 @@ types/intervals.cmi : misc/custom.cmo
 types/chars.cmi : misc/custom.cmo
 types/atoms.cmi : misc/ns.cmi misc/encodings.cmi misc/custom.cmo
 types/normal.cmi :
-types/var.cmi : misc/custom.cmo
+types/var.cmi : types/sortedList.cmi misc/custom.cmo
 types/boolVar.cmi : types/var.cmi misc/custom.cmo
 types/types.cmi : types/var.cmi misc/ns.cmi types/intervals.cmi \
     types/ident.cmo misc/custom.cmo types/chars.cmi types/boolVar.cmi \

misc/custom.ml

@@ -108,20 +108,20 @@ module Array(X : T) = struct
 end
 
 module List(X : T) = struct
-  module Elem = X
-  type t = X.t list
-  let dump = dump_list X.dump
-  let check l = List.iter X.check l
+  module Elem : T with type t = X.t = X
+  type t = Elem.t list
+  let dump = dump_list Elem.dump
+  let check l = List.iter Elem.check l
 
   let rec equal l1 l2 =
     (l1 == l2) ||
     match (l1,l2) with
-      | x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
+      | x1::l1, x2::l2 -> (Elem.equal x1 x2) && (equal l1 l2)
       | _ -> false
 
   let rec hash accu = function
     | [] -> 1 + accu
-    | x::l -> hash (17 * accu + X.hash x) l
+    | x::l -> hash (17 * accu + Elem.hash x) l
 
   let hash l = hash 1 l
 
@@ -129,7 +129,7 @@ module List(X : T) = struct
     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 
+	  let c = Elem.compare x1 x2 in if c <> 0 then c
 	  else compare l1 l2
       | [],_ -> -1
       | _ -> 1

runtime/value.ml

@@ -27,13 +27,13 @@ and t =
 let rec domain = function
   | Identity | Mono -> Var.Set.empty
   | List(l) -> Types.Tallying.domain l
-  | Comp(s1,s2) -> Var.Set.union (domain s1) (domain s2)
+  | Comp(s1,s2) -> Var.Set.cup (domain s1) (domain s2)
   | Sel(_,_,sigma) -> (domain sigma)
 
 let rec codomain = function
   | Identity | Mono -> Var.Set.empty
   | List(l) -> Types.Tallying.codomain l
-  | Comp(s1,s2) -> Var.Set.union (codomain s1) (codomain s2)
+  | Comp(s1,s2) -> Var.Set.cup (codomain s1) (codomain s2)
   | Sel(_,_,sigma) -> (codomain sigma)
 
 (* Comp for Value.sigma but simplify if possible. *)
@@ -54,7 +54,7 @@ let rec comp s1 s2 = match s1, s2 with
       | res -> comp s3 (comp res s6))
 
   (* If a variable in the image of s2 is in the domain of s1 we can't simplify *)
-  | _, _ when not (Var.Set.is_empty (Var.Set.inter (domain s1) (codomain s2)))
+  | _, _ when not (Var.Set.is_empty (Var.Set.cap (domain s1) (codomain s2)))
       -> Comp(s1, s2)
 
   | List(_), List(_) | Sel(_), List(_) ->

types/patterns.ml

@@ -91,7 +91,7 @@ let pp_node ppf node =
     print node.descr
     (Types.id node.accept)
     Types.Print.pp_type (Types.descr node.accept)
-    pp_fv node.fv
+    pp_fv (node.fv :> Id.t list)
 
 let counter = ref 0
 
@@ -507,9 +507,9 @@ module Normal = struct
 
     type t = NodeSet.t * Types.t * IdSet.t (* pl,t;   t <= \accept{pl} *)
 	
-    let check (pl,t,xs) =
+    let check ((pl,t,xs) : t) =
       List.iter (fun p -> assert(Types.subtype t (Types.descr p.accept)))
-	(NodeSet.get pl)
+	(pl :> Node.t list)
     let print ppf (pl,t,xs) =
       Format.fprintf ppf "@[(pl=%a;t=%a;xs=%a)@]" 
 	NodeSet.dump pl Types.Print.pp_type t
@@ -523,11 +523,11 @@ module Normal = struct
     let equal x y = compare x y == 0
 
 
-    let first_label (pl,t,xs) = 
+    let first_label ((pl,t,xs) : t) =
       List.fold_left
 	(fun l p -> Label.min l (first_label (descr p)))
 	(Types.Record.first_label t)
-	pl
+	(pl :> Node.t list)
 
 
   end
@@ -706,9 +706,9 @@ module Normal = struct
 
   let factorize t0 (pl,t,xs) =
     let t0 = if Types.subtype t t0 then t else Types.cap t t0 in
-    let vs_var = facto Factorize.var t0 xs pl in
+    let vs_var = facto Factorize.var t0 xs (NodeSet.get pl) in
     let xs = IdSet.diff xs vs_var in
-    let vs_nil = facto Factorize.nil t0 xs pl in
+    let vs_nil = facto Factorize.nil t0 xs (NodeSet.get pl) in
     let xs = IdSet.diff xs vs_nil in
     (vs_var,vs_nil,(pl,t,xs))
 
@@ -748,7 +748,7 @@ module Normal = struct
       | (t,res,pl)::tl -> aux_check tl s accu (Types.diff t s) res pl
     in
     aux_check [] Types.empty ResultMap.empty (Types.cap t any_basic) 
-      IdMap.empty (List.map descr pl)
+      IdMap.empty (List.map descr (NodeSet.get pl))
 
 (*
   let prod_tests (pl,t,xs) =
@@ -943,7 +943,7 @@ module Compile = struct
 		 Format.fprintf ppf "  pat %a@." Normal.Nnf.print p;
 	      ) disp.pl
    
-  let first_lab t reqs =
+  let first_lab t (reqs : Normal.Nnf.t array) =
     let aux l req = Label.min l (Normal.Nnf.first_label req) in
     let lab = 
       Array.fold_left aux (Types.Record.first_label t) reqs in
@@ -953,7 +953,7 @@ module Compile = struct
 
   let compute_actions = ref (fun _ -> assert false)
 
-  let dispatcher t pl : dispatcher =
+  let dispatcher t (pl : Normal.Nnf.t array) : dispatcher =
     try DispMap.find (t,pl) !dispatchers
     with Not_found ->
       let lab = first_lab t pl in
@@ -1105,7 +1105,7 @@ module Compile = struct
     (* Collect all subrequests *)
     let aux reqs (req,_) = 
       let (_,_,((_,tr,xs) as r')) as req' =
-	if facto then Normal.factorize t req else [],[],req in
+	if facto then Normal.factorize t req else IdSet.empty,IdSet.empty,req in
       factorized := NfMap.add req req' !factorized;
       
       if IdSet.is_empty xs && Types.subtype t tr then reqs
@@ -1216,8 +1216,8 @@ module Compile = struct
               if IdSet.mem var x || IdSet.mem nil x 
               then has_facto := true
               else (assert (IdMap.assoc x res = !i); incr i)
-            ) xs;
-            Match (List.length xs, (var,nil,xs,e))
+            ) (IdSet.get xs);
+            Match (IdSet.length xs, (var,nil,xs,e))
         | [] -> r 
         | _ -> assert false 
       in

types/sortedList.ml

+module type S =
+sig
+  module Elem : Custom.T
+  include Custom.T with type t = private Elem.t list
+  external get: t -> Elem.t list = "%identity"
+
+  val singleton: Elem.t -> t
+  val iter: (Elem.t -> unit) -> t -> unit
+  val filter: (Elem.t -> bool) -> t -> t
+  val exists: (Elem.t -> bool) -> t -> bool
+  val fold: ('a -> Elem.t -> 'a) -> 'a -> t -> 'a
+  val pick: t -> Elem.t option
+  val choose: t -> Elem.t
+  val length: t -> int
+
+  val empty: t
+  val is_empty: t -> bool
+  val from_list : Elem.t list -> t
+  val add: Elem.t -> t -> t
+  val remove: Elem.t -> t -> t
+  val disjoint: t -> t -> bool
+  val cup: t -> t -> t
+  val split: t -> t -> t * t * t
+    (* split l1 l2 = (l1 \ l2, l1 & l2, l2 \ l1) *)
+  val cap:  t -> t -> t
+  val diff: t -> t -> t
+  val subset: t -> t -> bool
+  val map: (Elem.t -> Elem.t) -> t -> t
+  val mem: t -> Elem.t -> bool
+
+  module Map: sig
+    type 'a map
+    external get: 'a map -> (Elem.t * 'a) list = "%identity"
+    val add: Elem.t -> 'a -> 'a map -> 'a map
+    val mem: Elem.t -> 'a map -> bool
+    val length: 'a map -> int
+    val domain: 'a map -> t
+    val restrict: 'a map -> t -> 'a map
+    val empty: 'a map
+    val fold: (Elem.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
+    val iter: ('a -> unit) -> 'a map -> unit
+    val iteri: (Elem.t -> 'a -> unit) -> 'a map -> unit
+    val filter: (Elem.t -> 'a -> bool) -> 'a map -> 'a map
+    val is_empty: 'a map -> bool
+    val singleton: Elem.t -> 'a -> 'a map
+    val assoc_remove: Elem.t -> 'a map -> 'a * 'a map
+    val remove:  Elem.t -> 'a map -> 'a map
+    val merge: ('a -> 'a -> 'a ) -> 'a map -> 'a map -> 'a map
+    val combine: ('a -> 'c) -> ('b -> 'c) -> ('a -> 'b -> 'c) ->
+      'a map -> 'b map -> 'c map
+    val cap: ('a -> 'a -> 'a ) -> 'a map -> 'a map -> 'a map
+    val sub: ('a -> 'a -> 'a ) -> 'a map -> 'a map -> 'a map
+
+    val merge_elem: 'a -> 'a map -> 'a map -> 'a map
+    val union_disj: 'a map -> 'a map -> 'a map
+    val diff: 'a map -> t -> 'a map
+    val from_list: ('a -> 'a -> 'a ) -> (Elem.t * 'a) list -> 'a map
+    val from_list_disj: (Elem.t * 'a) list -> 'a map
+
+    val map_from_slist: (Elem.t -> 'a) -> t -> 'a map
+    val collide: ('a -> 'b -> unit) -> 'a map -> 'b map -> unit
+    val may_collide: ('a -> 'b -> unit) -> exn -> 'a map -> 'b map -> unit
+    val map: ('a -> 'b) -> 'a map -> 'b map
+    val mapi: (Elem.t -> 'a -> 'b) -> 'a map -> 'b map
+    val constant: 'a -> t -> 'a map
+    val num: int -> t -> int map
+    val map_to_list: ('a -> 'b) -> 'a map -> 'b list
+    val mapi_to_list: (Elem.t -> 'a -> 'b) -> 'a map -> 'b list
+    val assoc: Elem.t -> 'a map -> 'a
+    val assoc_present:  Elem.t -> 'a map -> 'a
+    val compare: ('a -> 'a -> int) -> 'a map -> 'a map -> int
+    val hash: ('a -> int) -> 'a map -> int
+    val equal: ('a -> 'a -> bool) -> 'a map -> 'a map -> bool
+  end
+  module MakeMap(Y : Custom.T) : sig
+    include Custom.T with type t = Y.t Map.map
+  end
+end
+
 module Make(X : Custom.T) = struct
   include Custom.List(X)
   let rec check = function
-    | x::(y::_ as tl) -> X.check x; assert (X.compare x y < 0); check tl
-    | [x] -> X.check x;
+    | x::(y::_ as tl) -> Elem.check x; assert (Elem.compare x y < 0); check tl
+    | [x] -> Elem.check x;
     | _ -> ()
 
-  type elem = X.t
-
   let rec equal l1 l2 =
     (l1 == l2) ||
     match (l1,l2) with
-      | x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
+      | x1::l1, x2::l2 -> (Elem.equal x1 x2) && (equal l1 l2)
       | _ -> false
 
   let rec hash accu = function
     | [] -> 1 + accu
-    | x::l -> hash (17 * accu + X.hash x) l
+    | x::l -> hash (17 * accu + Elem.hash x) l
 
   let hash l = hash 1 l
 
@@ -23,7 +100,7 @@ module Make(X : Custom.T) = struct
     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 
+	  let c = Elem.compare x1 x2 in if c <> 0 then c
 	  else compare l1 l2
       | [],_ -> -1
       | _ -> 1
@@ -35,7 +112,7 @@ module Make(X : Custom.T) = struct
   let exists = List.exists
   let fold = List.fold_left
 
-  external get: t -> elem list = "%identity"
+  external get: t -> Elem.t list = "%identity"
   let singleton x = [ x ]
 
   let pick = function x::_ -> Some x | _ -> None 
@@ -49,7 +126,7 @@ module Make(X : Custom.T) = struct
     if l1 == l2 then l1 == [] else
     match (l1,l2) with
       | (t1::q1, t2::q2) -> 
-        let c = X.compare t1 t2 in
+        let c = Elem.compare t1 t2 in
         if c < 0 then disjoint q1 l2
         else if c > 0 then disjoint l1 q2
         else false
@@ -59,7 +136,7 @@ module Make(X : Custom.T) = struct
     if l1 == l2 then l1 else
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = X.compare t1 t2 in
+        let c = Elem.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)
@@ -71,7 +148,7 @@ module Make(X : Custom.T) = struct
   let rec split l1 l2 =
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = X.compare t1 t2 in
+        let c = Elem.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)
@@ -82,7 +159,7 @@ module Make(X : Custom.T) = struct
     if l1 == l2 then [] else
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = X.compare t1 t2 in
+        let c = Elem.compare t1 t2 in
         if c = 0 then diff q1 q2
         else if c < 0 then t1::(diff q1 l2)
         else diff l1 q2
@@ -94,7 +171,7 @@ module Make(X : Custom.T) = struct
     if l1 == l2 then l1 else
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = X.compare t1 t2 in
+        let c = Elem.compare t1 t2 in
         if c = 0 then t1::(cap q1 q2)
         else if c < 0 then cap q1 l2
         else cap l1 q2
@@ -105,12 +182,12 @@ module Make(X : Custom.T) = struct
     (l1 == l2) ||
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = X.compare t1 t2 in
+        let c = Elem.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
+              let c = Elem.compare t1 t2 in
               if c = 0 then subset qq1 qq2
               else if c < 0 then false
               else subset q1 qq2
@@ -140,12 +217,12 @@ module Make(X : Custom.T) = struct
     match l with
       | [] -> false
       | t::q -> 
-          let c = X.compare x t in
+          let c = Elem.compare x t in
           (c = 0) || ((c > 0) && (mem q x))
 
   module Map = struct
-    type 'a map = (X.t * 'a) list
-    external get: 'a map -> (elem * 'a) list = "%identity"
+    type 'a map = (Elem.t * 'a) list
+    external get: 'a map -> (Elem.t * 'a) list = "%identity"
     let empty = []
     let is_empty l = l = []
     let singleton x y = [ (x,y) ]
@@ -169,7 +246,7 @@ module Make(X : Custom.T) = struct
 
     let rec assoc_remove_aux v r = function
       | ((x,y) as a)::l ->
-        let c = X.compare x v in
+        let c = Elem.compare x v in
         if c = 0 then (r := Some y; l) 
         else if c < 0 then a :: (assoc_remove_aux v r l)
         else raise Not_found
@@ -184,7 +261,7 @@ module Make(X : Custom.T) = struct
      original list ? *)
     let rec remove v = function
       | (((x,y) as a)::rem) as l->
-        let c = X.compare x v in
+        let c = Elem.compare x v in
         if c = 0 then rem
         else if c < 0 then a :: (remove v rem)
         else l
@@ -193,7 +270,7 @@ module Make(X : Custom.T) = struct
     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
+            let c = Elem.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)
@@ -203,7 +280,7 @@ module Make(X : Custom.T) = struct
     let rec combine f1 f2 f12 l1 l2 =
       match (l1,l2) with
         | (x1,y1)::q1, (x2,y2)::q2 ->
-            let c = X.compare x1 x2 in
+            let c = Elem.compare x1 x2 in
             if c = 0 then (x1,(f12 y1 y2))::(combine f1 f2 f12 q1 q2)
             else if c < 0 then (x1,f1 y1)::(combine f1 f2 f12 q1 l2)
             else (x2, f2 y2)::(combine f1 f2 f12 l1 q2)
@@ -213,7 +290,7 @@ module Make(X : Custom.T) = struct
     let rec cap f l1 l2 =
       match (l1,l2) with
         | (x1,y1)::q1, (x2,y2)::q2 ->
-            let c = X.compare x1 x2 in
+            let c = Elem.compare x1 x2 in
             if c = 0 then (x1,(f y1 y2))::(cap f q1 q2)
             else if c < 0 then cap f q1 l2
             else cap f l1 q2
@@ -222,7 +299,7 @@ module Make(X : Custom.T) = struct
     let rec sub f l1 l2 =
       match (l1,l2) with
         | ((x1,y1) as t1)::q1, (x2,y2)::q2 ->
-            let c = X.compare x1 x2 in
+            let c = Elem.compare x1 x2 in
             if c = 0 then (x1,(f y1 y2))::(sub f q1 q2)
             else if c < 0 then t1::(sub f q1 l2)
             else sub f l1 q2
@@ -234,7 +311,7 @@ module Make(X : Custom.T) = struct
     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
+            let c = Elem.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)
@@ -247,13 +324,13 @@ module Make(X : Custom.T) = struct
       match l with
         | [] -> false
         | (t,_)::q -> 
-            let c = X.compare x t in
+            let c = Elem.compare x t in
             (c = 0) || ((c > 0) && (mem x q))
 
     let rec diff l1 l2 =
       match (l1,l2) with
         | (((x1,y1) as t1)::q1, x2::q2) ->
-            let c = X.compare x1 x2 in
+            let c = Elem.compare x1 x2 in
             if c = 0 then diff q1 q2
             else if c < 0 then t1::(diff q1 l2)
             else diff l1 q2
@@ -262,7 +339,7 @@ module Make(X : Custom.T) = struct
     let rec restrict l1 l2 =
       match (l1,l2) with
         | (((x1,y1) as t1)::q1, x2::q2) ->
-            let c = X.compare x1 x2 in
+            let c = Elem.compare x1 x2 in
             if c = 0 then t1::(restrict q1 q2)
             else if c < 0 then restrict q1 l2
             else restrict l1 q2
@@ -306,7 +383,7 @@ module Make(X : Custom.T) = struct
 
     let rec may_collide f exn l1 l2 =
       match (l1,l2) with
-        | (x1,y1)::l1, (x2,y2)::l2 when X.compare x1 x2 = 0 ->
+        | (x1,y1)::l1, (x2,y2)::l2 when Elem.compare x1 x2 = 0 ->
           f y1 y2; may_collide f exn l1 l2
         | [], [] -> ()
         | _ -> raise exn
@@ -335,7 +412,7 @@ module Make(X : Custom.T) = struct
 
     let rec assoc v = function
       | (x,y)::l ->
-        let c = X.compare x v in
+        let c = Elem.compare x v in
         if c = 0 then y 
         else if c < 0 then assoc v l
         else raise Not_found
@@ -344,7 +421,7 @@ module Make(X : Custom.T) = struct
     let rec assoc_present v = function
       | [(_,y)] -> y
       | (x,y)::l ->
-        let c = X.compare x v in
+        let c = Elem.compare x v in
         if c = 0 then y else assoc_present v l
       | [] -> assert false
 
@@ -352,7 +429,7 @@ module Make(X : Custom.T) = struct
       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
+          let c = Elem.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
@@ -360,21 +437,21 @@ module Make(X : Custom.T) = struct
 
     let rec hash f = function
       | [] -> 1
-      | (x,y)::l -> X.hash x + 17 * (f y) + 257 * (hash f l)
+      | (x,y)::l -> Elem.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)
+          (Elem.equal x1 x2) && (f y1 y2) && (equal f l1 l2)
         | _ -> false
 
 
     let rec check f = function
       | (x,a)::((y,b)::_ as tl) -> 
-        X.check x; f a;
-        assert (X.compare x y < 0); check f tl
-      | [x,a] -> X.check x; f a
+        Elem.check x; f a;
+        assert (Elem.compare x y < 0); check f tl
+      | [x,a] -> Elem.check x; f a
       | _ -> ()
       
   end (* Map *) 
@@ -392,12 +469,14 @@ module Make(X : Custom.T) = struct
     let check l = Map.check Y.check l
     let dump ppf l = 
       List.iter (fun (x,y) ->
-		   Format.fprintf ppf "(%a->%a)" X.dump x Y.dump y) l
+		   Format.fprintf ppf "(%a->%a)" Elem.dump x Y.dump y) l
 
   end
 
 end (* Make(X : Custom.T) *)
 
+
+
 module type FiniteCofinite = sig
   type elem