Commit 5641fa93 authored by Kim Nguyễn's avatar Kim Nguyễn

Further simplify the type algebra code, using the newly introduced combinators...

Further simplify the type algebra code, using the newly introduced combinators (map/fold/iter) over types.
parent 1db0d21a
open Ident
open Encodings
let (@@) f a = f a
let count = ref 0
let () =
......@@ -147,12 +145,13 @@ type ('atoms, 'ints, 'chars, 'times, 'xml, 'arrow, 'record, 'abstract) descr_ =
absent : bool;
}
module type VarType =
module type VarTypeSig =
sig
include Bool.V
type descr
val inj : t -> descr
val proj : descr -> t
val update : descr -> t -> descr
end
let empty_descr_ = { atoms = Bool.empty;
......@@ -298,7 +297,7 @@ struct
let mk id d = { id = id; cu = Compunit.current (); descr = d }
end
and VarAtoms : VarType with type Atom.t = Atoms.t
and VarAtoms : VarTypeSig with type Atom.t = Atoms.t
and type descr = Descr.t
=
struct
......@@ -306,9 +305,10 @@ and VarAtoms : VarType with type Atom.t = Atoms.t
type descr = Descr.t
let inj t = { empty_descr_ with atoms = t }
let proj t = t.atoms
let update t d = { t with atoms = d }
end
and VarIntervals : VarType with type Atom.t = Intervals.t
and VarIntervals : VarTypeSig with type Atom.t = Intervals.t
and type descr = Descr.t
=
struct
......@@ -316,9 +316,10 @@ and VarIntervals : VarType with type Atom.t = Intervals.t
type descr = Descr.t
let inj t = { empty_descr_ with ints = t }
let proj t = t.ints
let update t d = { t with ints = d }
end
and VarChars : VarType with type Atom.t = Chars.t
and VarChars : VarTypeSig with type Atom.t = Chars.t
and type descr = Descr.t
=
struct
......@@ -326,9 +327,10 @@ and VarChars : VarType with type Atom.t = Chars.t
type descr = Descr.t
let inj t = { empty_descr_ with chars = t }
let proj t = t.chars
let update t d = { t with chars = d }
end
and VarAbstracts : VarType with type Atom.t = Abstracts.t
and VarAbstracts : VarTypeSig with type Atom.t = Abstracts.t
and type descr = Descr.t
=
struct
......@@ -336,36 +338,40 @@ and VarAbstracts : VarType with type Atom.t = Abstracts.t
type descr = Descr.t
let inj t = { empty_descr_ with abstract = t }
let proj t = t.abstract
let update t d = { t with abstract = d }
end
and Pair : Bool.S with type elem = (Node.t * Node.t) =
Bool.Make(Custom.Pair(Node)(Node))
and VarTimes : VarType with module Atom = Pair
and VarTimes : VarTypeSig with module Atom = Pair
and type descr = Descr.t
=
struct include Bool.MakeVar(Pair)
type descr = Descr.t
let inj (t : t) : descr = { empty_descr_ with times = t }
let proj (t : descr) : t = t.times
let update (t : descr) (d : t) : descr = { t with times = d }
end
and VarXml : VarType with module Atom = Pair
and VarXml : VarTypeSig with module Atom = Pair
and type descr = Descr.t
=
struct include Bool.MakeVar(Pair)
type descr = Descr.t
let inj (t : t) : descr = { empty_descr_ with xml = t }
let proj (t : descr) : t = t.xml
let update (t : descr) (d : t) : descr = { t with xml = d }
end
and VarArrow : VarType with module Atom = Pair
and VarArrow : VarTypeSig with module Atom = Pair
and type descr = Descr.t
=
struct include Bool.MakeVar(Pair)
type descr = Descr.t
let inj (t : t) : descr = { empty_descr_ with arrow = t }
let proj (t : descr) : t = t.arrow
let update (t : descr) (d : t) : descr = { t with arrow = d }
end
(* bool = true means that the record is open that is, that
......@@ -375,15 +381,20 @@ end
and Rec : Bool.S with type elem = bool * Node.t Ident.label_map =
Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(Node)))
and VarRec : VarType with module Atom = Rec
and VarRec : VarTypeSig with module Atom = Rec
and type descr = Descr.t
=
struct include Bool.MakeVar(Rec)
type descr = Descr.t
let full_atom = Rec.atom (true, LabelMap.empty)
let inj (t : t) : descr = { empty_descr_ with record = t }
let proj (t : descr) : t = t.record
let update (t : descr) (d : t) : descr = { t with record = d }
end
module type VarType = VarTypeSig with type descr = Descr.t
module DescrHash = Hashtbl.Make(Descr)
module DescrMap = Map.Make(Descr)
module DescrSet = Set.Make(Descr)
......@@ -419,17 +430,17 @@ let non_constructed_or_absent =
{ non_constructed with absent = true }
(* Descr.t type constructors *)
let times x y = { empty with times = VarTimes.atom (`Atm (Pair.atom (x,y))) }
let xml x y = { empty with xml = VarXml.atom (`Atm (Pair.atom (x,y))) }
let arrow x y = { empty with arrow = VarArrow.atom (`Atm (Pair.atom (x,y))) }
let times x y = VarTimes.inj (VarTimes.atom (`Atm (Pair.atom (x,y))))
let xml x y = VarXml.inj (VarXml.atom (`Atm (Pair.atom (x,y))))
let arrow x y = VarArrow.inj (VarArrow.atom (`Atm (Pair.atom (x,y))))
let record label t =
{ empty with record = VarRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t))) }
VarRec.inj (VarRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t))))
let record_fields x =
{ empty with record = VarRec.atom (`Atm (Rec.atom x)) }
VarRec.inj (VarRec.atom (`Atm (Rec.atom x)))
let atom a = { empty with atoms = VarAtoms.atom (`Atm a) }
let atom a = VarAtoms.inj (VarAtoms.atom (`Atm a))
(* Atm = Any ^ a *)
let var a =
......@@ -445,14 +456,14 @@ let var a =
absent = false;
}
let char c = { empty with chars = VarChars.atom (`Atm c) }
let interval i = { empty with ints = VarIntervals.atom (`Atm i) }
let abstract a = { empty with abstract = VarAbstracts.atom (`Atm a) }
let char c = VarChars.inj (VarChars.atom (`Atm c))
let interval i = VarIntervals.inj (VarIntervals.atom (`Atm i))
let abstract a = VarAbstracts.inj (VarAbstracts.atom (`Atm a))
let cup x y =
if x == y then x else
{
ints = VarIntervals.cup x.ints y.ints;
ints = VarIntervals.cup x.ints y.ints;
atoms = VarAtoms.cup x.atoms y.atoms;
chars = VarChars.cup x.chars y.chars;
times = VarTimes.cup x.times y.times;
......@@ -996,30 +1007,6 @@ let subtype d1 d2 = is_empty (diff d1 d2)
let equiv d1 d2 = (subtype d1 d2) && (subtype d2 d1)
(* perform some semantic simplifications around type constructors *)
let atom a =
let atm =
if Atoms.(is_empty (diff full a)) then
VarAtoms.full
else VarAtoms.atom (`Atm a)
in
{ empty with atoms = atm }
let times x y =
if subtype any x.Node.descr
&& subtype any y.Node.descr
then
{ empty with times = VarTimes.full }
else times x y
let xml x y =
if subtype any x.Node.descr
&& subtype any y.Node.descr
then
{ empty with xml = VarXml.full }
else xml x y
module Cache = struct
type 'a cache =
......@@ -1577,123 +1564,71 @@ end
module Iter =
struct
let any_node2 = any_node, any_node
let compute ?(normalize=false) ~empty ~full ~cup ~cap ~diff ~var ~atom ~int ~char ~times ~xml ~arrow ~record ~abs ~opt t
let all_fields : (module VarType) array = [|
(module VarAtoms); (module VarIntervals);
(module VarChars); (module VarTimes);
(module VarXml); (module VarArrow);
(module VarRec); (module VarAbstracts)
|]
let fold ?(abs=(fun _ x -> x))
(f : (module VarType) -> Descr.t -> 'a -> 'a) (t : Descr.t)
(acc : 'a) : 'a
=
let var_or f =
function `Atm a -> f a
| `Var v -> var v
in
let any_atom = atom Atoms.full in
let any_int = int Intervals.full in
let any_char = char Chars.full in
let any_abs = abs Abstracts.full in
let any_times = times any_node2 in
let any_xml = xml any_node2 in
let any_record = record (true,LabelMap.empty) in
let any_arrow = diff full
(List.fold_left cup any_atom
[ any_int; any_char; any_abs; any_times; any_xml; any_record ])
in
let record_bdd p =
Rec.compute ~empty ~full:any_record ~cup ~cap ~diff ~atom:record p
in
let prod_bdd kind p =
let any,mk =
match kind with
`Times -> any_times, times
| `Xml -> any_xml, xml
| `Arrow -> any_arrow, arrow
in
if normalize && Pervasives.(kind <> `Arrow) then
let rects =
match kind with
`Times -> Product.normal ~kind:`Normal { Descr.empty with times = VarTimes.atom (`Atm p) }
| `Xml -> Product.normal ~kind:`XML { Descr.empty with xml = VarXml.atom (`Atm p) }
| _ -> assert false
in
List.fold_left (fun acc (d1, d2) -> cup acc (mk (cons d1, cons d2))) empty rects
else
Pair.compute ~empty ~full:any ~cup ~cap ~diff ~atom:mk p
in
List.fold_left (fun acc e -> cup acc e)
(opt t.absent)
[ (VarAtoms.compute
~empty ~full:any_atom ~cup ~cap ~diff ~atom:(var_or atom) t.atoms);
(VarIntervals.compute
~empty ~full:any_int ~cup ~cap ~diff ~atom:(var_or int) t.ints);
(VarChars.compute
~empty ~full:any_char ~cup ~cap ~diff ~atom:(var_or char) t.chars);
(VarAbstracts.compute
~empty ~full:any_abs ~cup ~cap ~diff ~atom:(var_or abs) t.abstract);
(VarTimes.compute
~empty ~full:any_times ~cup ~cap ~diff ~atom:(var_or (prod_bdd `Times)) t.times);
(VarXml.compute
~empty ~full:any_xml ~cup ~cap ~diff ~atom:(var_or (prod_bdd `Xml)) t.xml);
(VarArrow.compute
~empty ~full:any_arrow ~cup ~cap ~diff ~atom:(var_or (prod_bdd `Arrow)) t.arrow);
(VarRec.compute
~empty ~full:any_record ~cup ~cap ~diff ~atom:(var_or record_bdd) t.record);]
let acc = abs t.absent acc in
Array.fold_left (fun acc m -> f m t acc) acc all_fields
let map ?(abs=(fun x -> x))
(f : (module VarType) -> Descr.t -> Descr.t)
(t : Descr.t) : Descr.t =
fold ~abs:(fun a t -> { t with absent = abs a })
(fun (module V : VarType) t acc ->
V.update acc (V.proj (f (module V) t)))
t empty
let iter ?(abs=(fun _ -> ()))
(f : (module VarType) -> Descr.t -> unit) t
=
fold ~abs:(fun a () -> abs a) (fun m t () -> f m t) t ()
let clean_field (module V : VarType) t =
let t_bdd = V.proj t in
if is_empty (V.inj t_bdd) then V.update t V.empty else
if is_empty V.(inj (diff full t_bdd)) then V.update t V.full
else t
let clean_type t = map clean_field t
let simplify =
let memo = DescrHash.create 17 in
let aux (type atom)
inj
(module BV : Bool.V with type Atom.t = atom ) b
=
let clean b =
if is_empty (inj b) then BV.empty else b
in
let aux (module V : VarType) t =
let clean b = V.proj (clean_field (module V) (V.inj b)) in
let rec loop b =
match BV.extract b with
`Split(`Var v, p, i , n) ->
let p = loop p in
let i = loop i in
let n = loop n in
let tp = inj p and tn = inj n in
match V.extract b with
`Split(`Var v, p, i , n) ->
let p = loop p and i = loop i and n = loop n in
let tp = V.inj p and tn = V.inj n in
if disjoint tp tn then b
else
let v' = clean (BV.var v) in
let p' = clean BV.(cap v' (diff p n)) in
let n' = clean BV.(diff (diff n p) v') in
let i' = clean (BV.cap n p) in
let i'' = clean (BV.cup i i') in
BV.(cup i'' (cup p' n'))
| _ -> b
let v' = V.var v in
let p' = clean V.(cap v' (diff p n)) in
let n' = clean V.(diff (diff n p) v') in
let i' = clean (V.cap n p) in
let i'' = clean (V.cup i i') in
clean V.(cup i'' (cup p' n'))
| _ -> b
in
loop b
V.inj (loop (V.proj t))
in
fun t ->
try DescrHash.find memo t with
Not_found ->
let res =
{ t with
atoms = aux (fun i -> { empty with atoms = i })
(module VarAtoms) t.atoms;
chars = aux (fun i -> { empty with chars = i })
(module VarChars) t.chars;
ints = aux (fun i -> { empty with ints = i })
(module VarIntervals) t.ints;
abstract = aux (fun i -> { empty with abstract = i })
(module VarAbstracts) t.abstract;
times = aux (fun i -> { empty with times = i })
(module VarTimes) t.times;
xml = aux (fun i -> { empty with xml = i })
(module VarXml) t.xml;
arrow = aux (fun i -> { empty with arrow = i })
(module VarArrow) t.arrow;
record = aux (fun i -> { empty with record = i })
(module VarRec) t.record;
}
in
DescrHash.add memo t res;
DescrHash.add memo res res;
res
try DescrHash.find memo t with
Not_found ->
let res = clean_type (map aux t) in
DescrHash.add memo t res;
DescrHash.add memo res res;
res
let compute_bdd ~typ ~cup ~cap ~neg ~var ~atoms ~ints ~chars ~times ~xml ~arrow ~record ~abstract ~absent t =
let compute ~cup ~cap ~neg ~var ~atoms ~ints ~chars ~times ~xml ~arrow ~record ~abstract ~absent t =
let t = simplify t in
let any_node2 = any_node, any_node in
let any_atoms = atoms Atoms.full in
......@@ -1703,37 +1638,39 @@ module Iter =
let any_times = times any_node2 in
let any_xml = xml any_node2 in
let any_record = record (true,LabelMap.empty) in
let any_arrow = typ Arrow.any
(*neg (cup ([ any_atoms;
any_ints; any_chars; any_abstract;
any_times; any_xml; any_record ])) *)
in
let any_arrow = arrow (empty_node,any_node) in
let var_or do_atom =
function `Var v -> var v
| `Atm atm -> do_atom atm
in
let simple_bdd (type bdd) (type atom)
any
do_atom
(module B : Bool.S with type t = bdd and type elem = atom) acc bv =
any
do_atom
(module B : Bool.S with type t = bdd and type elem = atom)
acc
bv
=
List.fold_left (fun acc (ipos, ineg) ->
match List.map do_atom ipos, List.map do_atom ineg
with
| [] , [] -> any :: acc
| [ e ] , [] -> e :: acc
| [], l -> cap (any :: List.map neg l) :: acc
| l1, l2 -> cap (l1 @ List.map neg l2) :: acc
) acc (B.get bv)
match List.map do_atom ipos, List.map do_atom ineg
with
| [] , [] -> any :: acc
| [ e ] , [] -> e :: acc
| [], l -> cap (any :: List.map neg l) :: acc
| l1, l2 -> cap (l1 @ List.map neg l2) :: acc
) acc (B.get bv)
in
let cplx_bdd (type atom) (type atom2)
any
do_atom
(module BV : VarType with type Atom.t = atom and type Atom.elem = atom2)
acc
bdd
=
simple_bdd (cap[]) (var_or (fun t -> cup (simple_bdd (any) do_atom (module BV.Atom) [] t)))
(module BV) acc bdd
any
do_atom
(module V : VarType with type Atom.t = atom
and type Atom.elem = atom2)
acc
bdd
=
simple_bdd (cap[])
(var_or (fun t -> cup (simple_bdd (any) do_atom
(module V.Atom) [] t)))
(module V) acc bdd
in
let acc = absent t.absent in
let acc = simple_bdd any_ints (var_or ints) (module VarIntervals) acc t.ints in
......@@ -1747,8 +1684,6 @@ module Iter =
match acc with
[ e ] -> e
| _ -> cup acc
end
module Variable =
......@@ -1756,74 +1691,8 @@ module Variable =
type t = Var.t
let var_cache = DescrHash.create 17
let collect_vars t =
let memo = DescrHash.create 17 in
let union s1 s2 =
match s1, s2 with
Some s1, Some s2 -> Some (Var.Set.cup s1 s2)
| None, Some s | Some s, None -> Some s
| _ -> None
in
let inter s1 s2 =
match s1, s2 with
Some s1, Some s2 -> Some (Var.Set.cup s1 s2)
| _ -> None
in
let union3 (x1,y1,z1) (x2,y2,z2) =
union x1 x2, union y1 y2, union z1 z2
in
let inter3 (x1,y1,z1) (x2,y2,z2) =
inter x1 x2, inter y1 y2, inter z1 z2
in
let empty = Some Var.Set.empty in
let empty3 = empty,empty,empty in
let no3 = None, None, None in
let cst_empty3 _ = empty3 in
let rec loop t =
try
DescrHash.find memo t
with
Not_found ->
DescrHash.add memo t empty3;
let res =
Iter.compute ~normalize:true
~empty:no3
~full:empty3
~cup:union3
~cap:inter3
~diff:(fun (x1,y1,z1) (x2, y2, z2) ->
inter x1 x2, inter y1 z2, inter z1 y2)
~var:(fun v -> let e = Some (Var.Set.singleton v) in
e,e,empty)
~int:cst_empty3
~char:cst_empty3
~atom:cst_empty3
~abs:cst_empty3
~xml:prod
~times:prod
~arrow:arrow
~record:record
~opt:cst_empty3 t
in
DescrHash.replace memo t res;
res
and prod (t1, t2) =
let _,y1,z1 = loop (descr t1)
and _,y2,z2 = loop (descr t2) in
empty, union y1 y2, union z1 z2
and arrow (t1, t2) =
let _,y1,z1 = loop (descr t1)
and _,y2,z2 = loop (descr t2) in
empty, union z1 y2, union y1 z2
and record (b, lm) =
let _, y, z = List.fold_left (fun acc (_,t) ->
union3 acc (loop (descr t))) empty3 (LabelMap.get lm)
in
empty, y, z
in
loop t
let collect_vars2 t =
let collect_vars t =
let memo = DescrHash.create 17 in
let empty3 = Var.Set.(empty,empty,empty) in
let merge l =
......@@ -1839,8 +1708,7 @@ module Variable =
Not_found ->
DescrHash.add memo t empty3;
let res =
Iter.compute_bdd
~typ:cst_empty3
Iter.compute
~cup:merge
~cap:merge
~neg:(fun (a, b, c) -> (a , c , b))
......@@ -1882,8 +1750,7 @@ module Variable =
with
Not_found ->
DescrHash.add memo t ();
Iter.compute_bdd
~typ:ignore
Iter.compute
~cup:ignore
~cap:ignore
~neg:ignore
......@@ -1908,15 +1775,11 @@ module Variable =
loop t; true
with Not_found -> false
let collect_vars t =
let _extract = function Some e -> e | None -> Var.Set.empty in
try
DescrHash.find var_cache t
with Not_found ->
let tlv, pos, neg = collect_vars2 t in
(* let tlv, pos, neg = extract tlv, extract pos, extract neg in *)
let tlv, pos, neg = collect_vars t in
let res = tlv, pos, neg, Var.Set.cup pos neg in
DescrHash.add var_cache t res;
res
......@@ -1934,7 +1797,6 @@ module Variable =
Not_found -> let b = no_var t in
DescrHash.add h t b; b
(* let is_ground t = Var.Set.is_empty (all_vars t) *)
let no_var = is_ground
let is_closed delta t =
......@@ -1988,7 +1850,6 @@ let extract_variable = Variable.extract_variable
let is_closed = Variable.is_closed
module Print = struct
let rec pp_const ppf = function
| Integer i -> Intervals.V.print ppf i
......@@ -2117,8 +1978,7 @@ module Print = struct
b == VarRec.empty ||
(is_empty { empty with record = VarRec.diff VarRec.full b})
let trivial (type atom) (module T : VarType with type Atom.t = atom
and type descr = Descr.t) t =
let trivial (type atom) (module T : VarType with type Atom.t = atom) t =
let t1 = T.inj (T.proj t) in
is_empty t1 ||
is_empty (diff (T.inj T.full) t1)
......@@ -2130,25 +1990,14 @@ module Print = struct
&& trivial (module VarArrow) d
&& trivial (module VarRec) d
)
(* let worth_abbrev d =
not (trivial_pair d.times && trivial_pair d.xml &&
trivial_pair d.arrow && trivial_rec d.record)
*)
let worth_complement d =
let dd = diff any d in
let aux x = if is_empty x then 1 else 0 in
let n =
aux { empty with atoms = dd.atoms } +
aux { empty with chars = dd.chars } +
aux { empty with ints = dd.ints } +
aux { empty with times = dd.times } +
aux { empty with xml = dd.xml } +
aux { empty with arrow = dd.arrow } +
aux { empty with record = dd.record } +
aux { empty with abstract = dd.abstract }
let c =
Iter.fold (fun (module V : VarType) t acc ->
if is_empty (V.inj (V.proj t)) then acc+1
else acc) (diff any d) 0
in
n >= 5
c >= 5
let proper_seq t =
let memo = DescrHash.create 17 in
......@@ -2223,55 +2072,43 @@ module Print = struct
| `Var x -> (Var.Set.add x acc_v, acc_a)
) (Var.Set.empty, init) l
in
let fill_line (type atom) (module BV : Bool.V with type Atom.t = atom)
table get set t =
let fill_line table (module V : VarType) t =
List.iter (fun (p, n) ->
let v1, a1 = split_var_atom (fun a b -> BV.(cap (atom a) b)) BV.full p in
let v2, a2 = split_var_atom (fun a b -> BV.(cup (atom a) b)) BV.empty n in
let a = BV.diff a1 a2 in
let key = v1, v2 in
let old_t = try VarTable.find table key with Not_found -> {empty with absent = t.absent } in
let new_a = BV.cup a (get old_t) in
VarTable.replace table key (set old_t new_a)) (BV.get (get t))
let v1, a1 =
split_var_atom (fun a b -> V.(cap (atom a) b)) V.full p in
let v2, a2 =
split_var_atom (fun a b -> V.(cup (atom a) b)) V.empty n in
let a = V.diff a1 a2 in
let key = v1, v2 in
let old_t =
try VarTable.find table key with
Not_found -> { empty with absent = t.absent }
in
let new_a = V.cup a (V.proj old_t) in
VarTable.replace table key (V.update old_t new_a))
(V.get (V.proj t))
in
let h = VarTable.create 17 in
let d = Iter.simplify d in
fill_line (module VarIntervals) h (fun t -> t.ints) (fun t u -> {t with ints = u }) d;
fill_line (module VarChars) h (fun t -> t.chars) (fun t u -> {t with chars = u }) d;
fill_line (module VarAtoms) h (fun t -> t.atoms) (fun t u -> {t with atoms = u }) d;
fill_line (module VarTimes) h (fun t -> t.times) (fun t u -> {t with times = u }) d;
fill_line (module VarXml) h (fun t -> t.xml) (fun t u -> {t with xml = u }) d;
fill_line (module VarArrow) h (fun t -> t.arrow) (fun t u -> {t with arrow = u }) d;
fill_line (module VarRec) h (fun t -> t.record) (fun t u -> {t with record = u }) d;
fill_line (module VarAbstracts) h (fun t -> t.abstract) (fun t u -> {t with abstract = u }) d;
Iter.iter (fill_line h) d;
let h =
try
let no_var = VarTable.find h Key.empty in
let update_field
(type atom) (module BV : Bool.V with type Atom.t = atom)
get set d1 d2 =
let bdd = get d1 in
if BV.(is_empty (diff full bdd)) then set d2 bdd else d2
in
let h' = VarTable.create 17 in
let update_field (module V : VarType) t =
let v_no_var = V.proj no_var in
if is_empty V.(inj (diff full v_no_var)) then V.update t v_no_var
else t
in
let h' = VarTable.create 17 in
VarTable.iter (fun ((v1, v2) as k) t ->
let t =
if Var.Set.(is_empty v1 && is_empty v2) then t
else
let t = update_field (module VarIntervals) (fun t -> t.ints) (fun t u -> {t with ints = u }) no_var t in
let t = update_field (module VarChars) (fun t -> t.chars) (fun t u -> {t with chars = u }) no_var t in
let t = update_field (module VarAtoms) (fun t -> t.atoms) (fun t u -> {t with atoms = u }) no_var t in
let t = update_field (module VarTimes) (fun t -> t.times) (fun t u -> {t with times = u }) no_var t in
let t = update_field (module VarXml) (fun t -> t.xml) (fun t u -> {t with xml = u }) no_var t in
let t = update_field (module VarArrow) (fun t -> t.arrow) (fun t u -> {t with arrow = u }) no_var t in
let t = update_field (module VarRec) (fun t -> t.record) (fun t u -> {t with record = u }) no_var t in
let t = update_field (module VarAbstracts) (fun t -> t.abstract) (fun t u -> {t with abstract = u }) no_var t in t
in
VarTable.replace h' k t
) h; h'
let t =
if Var.Set.(is_empty v1 && is_empty v2) then t else
Iter.map update_field t
in
VarTable.replace h' k t
) h; h'