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 = ...@@ -76,13 +76,13 @@ let enter_global_cu cu env x =
let rec domain = function let rec domain = function
|Identity -> Var.Set.empty |Identity -> Var.Set.empty
|List l -> Types.Tallying.domain l |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) |Sel(_,_,sigma) -> (domain sigma)
let rec codomain = function let rec codomain = function
| Identity -> Var.Set.empty | Identity -> Var.Set.empty
| List(l) -> Types.Tallying.codomain l | 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) | Sel(_,_,sigma) -> (codomain sigma)
let fresharg = let fresharg =
...@@ -111,7 +111,7 @@ let rec comp s1 s2 = match s1, s2 with ...@@ -111,7 +111,7 @@ let rec comp s1 s2 = match s1, s2 with
| res -> comp s3 (comp res s6)) | res -> comp s3 (comp res s6))
(* If a variable in the image of s2 is in the domain of s1 we can't simplify *) (* 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) -> Comp(s1, s2)
| List(_), List(_) | Sel(_), List(_) -> | List(_), List(_) | Sel(_), List(_) ->
...@@ -135,8 +135,8 @@ and compile_aux env te = function ...@@ -135,8 +135,8 @@ and compile_aux env te = function
let is_mono x = let is_mono x =
if Var.Set.is_empty ts then true else 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 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 let d = Var.Set.cap from_xi (domain(env.sigma)) in
Var.Set.is_empty (Var.Set.inter ts d) Var.Set.is_empty (Var.Set.cap ts d)
in in
if is_mono x then Var (v) else TVar(v,env.sigma) if is_mono x then Var (v) else TVar(v,env.sigma)
| Typed.Subst(e,sl) -> | Typed.Subst(e,sl) ->
...@@ -193,15 +193,15 @@ and compile_abstr env a = ...@@ -193,15 +193,15 @@ and compile_abstr env a =
List.fold_left(fun acc (t1,t2) -> List.fold_left(fun acc (t1,t2) ->
let ts1 = Types.all_vars t1 in let ts1 = Types.all_vars t1 in
let ts2 = Types.all_vars t2 in let ts2 = Types.all_vars t2 in
let tu = Var.Set.union ts1 ts2 in let tu = Var.Set.cup ts1 ts2 in
Var.Set.union acc tu Var.Set.cup acc tu
) Var.Set.empty a.Typed.fun_iface ) Var.Set.empty a.Typed.fun_iface
in in
if Var.Set.is_empty vars then true else if Var.Set.is_empty vars then true else
if env.sigma = Identity then false if env.sigma = Identity then false
else else
let d = domain(env.sigma) in 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 in
let (slots,nb_slots,fun_env) = let (slots,nb_slots,fun_env) =
(* we add a nameless empty slot for the argument *) (* we add a nameless empty slot for the argument *)
...@@ -258,7 +258,7 @@ and compile_branches env (brs : Typed.branches) = ...@@ -258,7 +258,7 @@ and compile_branches env (brs : Typed.branches) =
(* p_i / t_i -> br.Typed.br_pat / br.Typed.br_type *) (* p_i / t_i -> br.Typed.br_pat / br.Typed.br_type *)
and compile_branch env br = 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 = let env =
{ env with { env with
xi = IdMap.merge (fun _ v2 -> v2) env.xi br.Typed.br_vars_poly xi = IdMap.merge (fun _ v2 -> v2) env.xi br.Typed.br_vars_poly
...@@ -278,7 +278,7 @@ let compile_expr env e = ...@@ -278,7 +278,7 @@ let compile_expr env e =
let compile_let_decl env decl = let compile_let_decl env decl =
let pat = decl.Typed.let_pat in let pat = decl.Typed.let_pat in
let e,lsize = compile_expr env decl.Typed.let_body 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 te = decl.Typed.let_body.Typed.exp_typ in
let comp = Patterns.Compile.make_branches te [ pat, () ] in let comp = Patterns.Compile.make_branches te [ pat, () ] in
......
...@@ -371,7 +371,7 @@ types/intervals.cmi : misc/custom.cmo ...@@ -371,7 +371,7 @@ types/intervals.cmi : misc/custom.cmo
types/chars.cmi : misc/custom.cmo types/chars.cmi : misc/custom.cmo
types/atoms.cmi : misc/ns.cmi misc/encodings.cmi misc/custom.cmo types/atoms.cmi : misc/ns.cmi misc/encodings.cmi misc/custom.cmo
types/normal.cmi : 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/boolVar.cmi : types/var.cmi misc/custom.cmo
types/types.cmi : types/var.cmi misc/ns.cmi types/intervals.cmi \ types/types.cmi : types/var.cmi misc/ns.cmi types/intervals.cmi \
types/ident.cmo misc/custom.cmo types/chars.cmi types/boolVar.cmi \ types/ident.cmo misc/custom.cmo types/chars.cmi types/boolVar.cmi \
......
...@@ -108,20 +108,20 @@ module Array(X : T) = struct ...@@ -108,20 +108,20 @@ module Array(X : T) = struct
end end
module List(X : T) = struct module List(X : T) = struct
module Elem = X module Elem : T with type t = X.t = X
type t = X.t list type t = Elem.t list
let dump = dump_list X.dump let dump = dump_list Elem.dump
let check l = List.iter X.check l let check l = List.iter Elem.check l
let rec equal l1 l2 = let rec equal l1 l2 =
(l1 == l2) || (l1 == l2) ||
match (l1,l2) with 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 | _ -> false
let rec hash accu = function let rec hash accu = function
| [] -> 1 + accu | [] -> 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 let hash l = hash 1 l
...@@ -129,7 +129,7 @@ module List(X : T) = struct ...@@ -129,7 +129,7 @@ module List(X : T) = struct
if l1 == l2 then 0 if l1 == l2 then 0
else match (l1,l2) with else match (l1,l2) with
| x1::l1, x2::l2 -> | 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 else compare l1 l2
| [],_ -> -1 | [],_ -> -1
| _ -> 1 | _ -> 1
......
...@@ -27,13 +27,13 @@ and t = ...@@ -27,13 +27,13 @@ and t =
let rec domain = function let rec domain = function
| Identity | Mono -> Var.Set.empty | Identity | Mono -> Var.Set.empty
| List(l) -> Types.Tallying.domain l | 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) | Sel(_,_,sigma) -> (domain sigma)
let rec codomain = function let rec codomain = function
| Identity | Mono -> Var.Set.empty | Identity | Mono -> Var.Set.empty
| List(l) -> Types.Tallying.codomain l | 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) | Sel(_,_,sigma) -> (codomain sigma)
(* Comp for Value.sigma but simplify if possible. *) (* Comp for Value.sigma but simplify if possible. *)
...@@ -54,7 +54,7 @@ let rec comp s1 s2 = match s1, s2 with ...@@ -54,7 +54,7 @@ let rec comp s1 s2 = match s1, s2 with
| res -> comp s3 (comp res s6)) | res -> comp s3 (comp res s6))
(* If a variable in the image of s2 is in the domain of s1 we can't simplify *) (* 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) -> Comp(s1, s2)
| List(_), List(_) | Sel(_), List(_) -> | List(_), List(_) | Sel(_), List(_) ->
......
...@@ -91,7 +91,7 @@ let pp_node ppf node = ...@@ -91,7 +91,7 @@ let pp_node ppf node =
print node.descr print node.descr
(Types.id node.accept) (Types.id node.accept)
Types.Print.pp_type (Types.descr 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 let counter = ref 0
...@@ -507,9 +507,9 @@ module Normal = struct ...@@ -507,9 +507,9 @@ module Normal = struct
type t = NodeSet.t * Types.t * IdSet.t (* pl,t; t <= \accept{pl} *) 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))) 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) = let print ppf (pl,t,xs) =
Format.fprintf ppf "@[(pl=%a;t=%a;xs=%a)@]" Format.fprintf ppf "@[(pl=%a;t=%a;xs=%a)@]"
NodeSet.dump pl Types.Print.pp_type t NodeSet.dump pl Types.Print.pp_type t
...@@ -523,11 +523,11 @@ module Normal = struct ...@@ -523,11 +523,11 @@ module Normal = struct
let equal x y = compare x y == 0 let equal x y = compare x y == 0
let first_label (pl,t,xs) = let first_label ((pl,t,xs) : t) =
List.fold_left List.fold_left
(fun l p -> Label.min l (first_label (descr p))) (fun l p -> Label.min l (first_label (descr p)))
(Types.Record.first_label t) (Types.Record.first_label t)
pl (pl :> Node.t list)
end end
...@@ -706,9 +706,9 @@ module Normal = struct ...@@ -706,9 +706,9 @@ module Normal = struct
let factorize t0 (pl,t,xs) = let factorize t0 (pl,t,xs) =
let t0 = if Types.subtype t t0 then t else Types.cap t t0 in 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 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 let xs = IdSet.diff xs vs_nil in
(vs_var,vs_nil,(pl,t,xs)) (vs_var,vs_nil,(pl,t,xs))
...@@ -748,7 +748,7 @@ module Normal = struct ...@@ -748,7 +748,7 @@ module Normal = struct
| (t,res,pl)::tl -> aux_check tl s accu (Types.diff t s) res pl | (t,res,pl)::tl -> aux_check tl s accu (Types.diff t s) res pl
in in
aux_check [] Types.empty ResultMap.empty (Types.cap t any_basic) 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) = let prod_tests (pl,t,xs) =
...@@ -943,7 +943,7 @@ module Compile = struct ...@@ -943,7 +943,7 @@ module Compile = struct
Format.fprintf ppf " pat %a@." Normal.Nnf.print p; Format.fprintf ppf " pat %a@." Normal.Nnf.print p;
) disp.pl ) 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 aux l req = Label.min l (Normal.Nnf.first_label req) in
let lab = let lab =
Array.fold_left aux (Types.Record.first_label t) reqs in Array.fold_left aux (Types.Record.first_label t) reqs in
...@@ -953,7 +953,7 @@ module Compile = struct ...@@ -953,7 +953,7 @@ module Compile = struct
let compute_actions = ref (fun _ -> assert false) 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 try DispMap.find (t,pl) !dispatchers
with Not_found -> with Not_found ->
let lab = first_lab t pl in let lab = first_lab t pl in
...@@ -1105,7 +1105,7 @@ module Compile = struct ...@@ -1105,7 +1105,7 @@ module Compile = struct
(* Collect all subrequests *) (* Collect all subrequests *)
let aux reqs (req,_) = let aux reqs (req,_) =
let (_,_,((_,tr,xs) as r')) as 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; factorized := NfMap.add req req' !factorized;
if IdSet.is_empty xs && Types.subtype t tr then reqs if IdSet.is_empty xs && Types.subtype t tr then reqs
...@@ -1216,8 +1216,8 @@ module Compile = struct ...@@ -1216,8 +1216,8 @@ module Compile = struct
if IdSet.mem var x || IdSet.mem nil x if IdSet.mem var x || IdSet.mem nil x
then has_facto := true then has_facto := true
else (assert (IdMap.assoc x res = !i); incr i) else (assert (IdMap.assoc x res = !i); incr i)
) xs; ) (IdSet.get xs);
Match (List.length xs, (var,nil,xs,e)) Match (IdSet.length xs, (var,nil,xs,e))
| [] -> r | [] -> r
| _ -> assert false | _ -> assert false
in 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 module Make(X : Custom.T) = struct
include Custom.List(X) include Custom.List(X)
let rec check = function let rec check = function
| x::(y::_ as tl) -> X.check x; assert (X.compare x y < 0); check tl | x::(y::_ as tl) -> Elem.check x; assert (Elem.compare x y < 0); check tl
| [x] -> X.check x; | [x] -> Elem.check x;
| _ -> () | _ -> ()
type elem = X.t
let rec equal l1 l2 = let rec equal l1 l2 =
(l1 == l2) || (l1 == l2) ||
match (l1,l2) with 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 | _ -> false
let rec hash accu = function let rec hash accu = function
| [] -> 1 + accu | [] -> 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 let hash l = hash 1 l
...@@ -23,7 +100,7 @@ module Make(X : Custom.T) = struct ...@@ -23,7 +100,7 @@ module Make(X : Custom.T) = struct
if l1 == l2 then 0 if l1 == l2 then 0
else match (l1,l2) with else match (l1,l2) with
| x1::l1, x2::l2 -> | 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 else compare l1 l2
| [],_ -> -1 | [],_ -> -1
| _ -> 1 | _ -> 1
...@@ -35,7 +112,7 @@ module Make(X : Custom.T) = struct ...@@ -35,7 +112,7 @@ module Make(X : Custom.T) = struct
let exists = List.exists let exists = List.exists
let fold = List.fold_left let fold = List.fold_left
external get: t -> elem list = "%identity" external get: t -> Elem.t list = "%identity"
let singleton x = [ x ] let singleton x = [ x ]
let pick = function x::_ -> Some x | _ -> None let pick = function x::_ -> Some x | _ -> None
...@@ -49,7 +126,7 @@ module Make(X : Custom.T) = struct ...@@ -49,7 +126,7 @@ module Make(X : Custom.T) = struct
if l1 == l2 then l1 == [] else if l1 == l2 then l1 == [] else
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (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 if c < 0 then disjoint q1 l2
else if c > 0 then disjoint l1 q2 else if c > 0 then disjoint l1 q2
else false else false
...@@ -59,7 +136,7 @@ module Make(X : Custom.T) = struct ...@@ -59,7 +136,7 @@ module Make(X : Custom.T) = struct
if l1 == l2 then l1 else if l1 == l2 then l1 else
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (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) if c = 0 then t1::(cup q1 q2)
else if c < 0 then t1::(cup q1 l2) else if c < 0 then t1::(cup q1 l2)
else t2::(cup l1 q2) else t2::(cup l1 q2)
...@@ -71,7 +148,7 @@ module Make(X : Custom.T) = struct ...@@ -71,7 +148,7 @@ module Make(X : Custom.T) = struct
let rec split l1 l2 = let rec split l1 l2 =
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (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) 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 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) else let (l1,i,l2) = split l1 q2 in (l1,i,t2::l2)
...@@ -82,7 +159,7 @@ module Make(X : Custom.T) = struct ...@@ -82,7 +159,7 @@ module Make(X : Custom.T) = struct
if l1 == l2 then [] else if l1 == l2 then [] else
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (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 if c = 0 then diff q1 q2
else if c < 0 then t1::(diff q1 l2) else if c < 0 then t1::(diff q1 l2)
else diff l1 q2 else diff l1 q2
...@@ -94,7 +171,7 @@ module Make(X : Custom.T) = struct ...@@ -94,7 +171,7 @@ module Make(X : Custom.T) = struct
if l1 == l2 then l1 else if l1 == l2 then l1 else
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (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) if c = 0 then t1::(cap q1 q2)
else if c < 0 then cap q1 l2 else if c < 0 then cap q1 l2
else cap l1 q2 else cap l1 q2
...@@ -105,12 +182,12 @@ module Make(X : Custom.T) = struct ...@@ -105,12 +182,12 @@ module Make(X : Custom.T) = struct
(l1 == l2) || (l1 == l2) ||
match (l1,l2) with match (l1,l2) with
| (t1::q1, t2::q2) -> | (t1::q1, t2::q2) ->
let c = X.compare t1 t2 in let c = Elem.compare t1 t2 in
if c = 0 then ( if c = 0 then (
(* inlined: subset q1 q2 *) (* inlined: subset q1 q2 *)
(q1 == q2) || match (q1,q2) with (q1 == q2) || match (q1,q2) with
| (t1::qq1, t2::qq2) -> | (t1::qq1, t2::qq2) ->
let c = X.compare t1 t2 in let c = Elem.compare t1 t2 in