Commit 083edd02 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

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
parent f217bc26
......@@ -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
......
......@@ -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 \
......
......@@ -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
......
......@@ -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(_) ->
......
......@@ -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
......
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