Commit 062d5039 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Rework the types modules to seal the internal representation.

parent 9386685d
...@@ -147,26 +147,37 @@ type ('atoms, 'ints, 'chars, 'times, 'xml, 'arrow, 'record, 'abstract) descr_ = ...@@ -147,26 +147,37 @@ type ('atoms, 'ints, 'chars, 'times, 'xml, 'arrow, 'record, 'abstract) descr_ =
absent : bool; absent : bool;
} }
module type VarType =
sig
include Bool.V
type descr
val inj : t -> descr
val proj : descr -> t
end
let empty_descr_ = { atoms = Bool.empty;
module BoolAtoms = Bool.MakeVar(Atoms) ints = Bool.empty;
module BoolIntervals = Bool.MakeVar(Intervals) chars = Bool.empty;
module BoolChars = Bool.MakeVar(Chars) times = Bool.empty;
module BoolAbstracts = Bool.MakeVar(Abstracts) xml = Bool.empty;
arrow = Bool.empty;
record = Bool.empty;
abstract = Bool.empty;
absent = false }
module rec Descr : module rec Descr :
sig sig
include Custom.T with include Custom.T with
type t = (BoolAtoms.t, BoolIntervals.t, BoolChars.t, BoolPair.t, type t = (BoolAtoms.t, BoolIntervals.t, BoolChars.t, BoolTimes.t,
BoolPair.t, BoolPair.t, BoolRec.t, BoolAbstracts.t) descr_ BoolXml.t, BoolArrow.t, BoolRec.t, BoolAbstracts.t) descr_
val empty: t val empty: t
val any : t val any : t
val is_empty : t -> bool val is_empty : t -> bool
end = end =
struct struct
type t = (BoolAtoms.t, BoolIntervals.t, BoolChars.t, BoolPair.t, type t = (BoolAtoms.t, BoolIntervals.t, BoolChars.t, BoolTimes.t,
BoolPair.t, BoolPair.t, BoolRec.t, BoolAbstracts.t) descr_ BoolXml.t, BoolArrow.t, BoolRec.t, BoolAbstracts.t) descr_
let dump ppf d = let dump ppf d =
Format.fprintf ppf "@[<v 1>types:@\n\ Format.fprintf ppf "@[<v 1>types:@\n\
...@@ -174,41 +185,31 @@ struct ...@@ -174,41 +185,31 @@ struct
@<1> ints: %a@\n\ @<1> ints: %a@\n\
@<1> chars: %a@\n\ @<1> chars: %a@\n\
@<1> times: %a@\n\ @<1> times: %a@\n\
@<1> xml: %a@\n\
@<1> arrow: %a@\n\ @<1> arrow: %a@\n\
@<1> record: %a@\n\ @<1> record: %a@\n\
@<1> xml: %a@\n\
@<1> abstract: %a@\n\ @<1> abstract: %a@\n\
@<1> absent: %b@]@\n" @<1> absent: %b@]@\n"
BoolAtoms.dump d.atoms BoolAtoms.dump d.atoms
BoolIntervals.dump d.ints BoolIntervals.dump d.ints
BoolChars.dump d.chars BoolChars.dump d.chars
BoolPair.dump d.times BoolTimes.dump d.times
BoolPair.dump d.arrow BoolXml.dump d.xml
BoolArrow.dump d.arrow
BoolRec.dump d.record BoolRec.dump d.record
BoolPair.dump d.xml
BoolAbstracts.dump d.abstract BoolAbstracts.dump d.abstract
d.absent d.absent
let empty = { let empty = empty_descr_
times = BoolPair.empty;
xml = BoolPair.empty;
arrow = BoolPair.empty;
record= BoolRec.empty;
ints = BoolIntervals.empty;
atoms = BoolAtoms.empty;
chars = BoolChars.empty;
abstract = BoolAbstracts.empty;
absent = false;
}
let any = { let any = {
times = BoolPair.full;
xml = BoolPair.full;
arrow = BoolPair.full;
record = BoolRec.full;
ints = BoolIntervals.full; ints = BoolIntervals.full;
atoms = BoolAtoms.full; atoms = BoolAtoms.full;
chars = BoolChars.full; chars = BoolChars.full;
times = BoolTimes.full;
xml = BoolXml.full;
arrow = BoolArrow.full;
record = BoolRec.full;
abstract = BoolAbstracts.full; abstract = BoolAbstracts.full;
absent = false; absent = false;
} }
...@@ -217,9 +218,9 @@ struct ...@@ -217,9 +218,9 @@ struct
BoolChars.check a.chars; BoolChars.check a.chars;
BoolIntervals.check a.ints; BoolIntervals.check a.ints;
BoolAtoms.check a.atoms; BoolAtoms.check a.atoms;
BoolPair.check a.times; BoolTimes.check a.times;
BoolPair.check a.xml; BoolXml.check a.xml;
BoolPair.check a.arrow; BoolArrow.check a.arrow;
BoolRec.check a.record; BoolRec.check a.record;
BoolAbstracts.check a.abstract; BoolAbstracts.check a.abstract;
() ()
...@@ -229,9 +230,9 @@ struct ...@@ -229,9 +230,9 @@ struct
(BoolAtoms.equal a.atoms b.atoms) && (BoolAtoms.equal a.atoms b.atoms) &&
(BoolChars.equal a.chars b.chars) && (BoolChars.equal a.chars b.chars) &&
(BoolIntervals.equal a.ints b.ints) && (BoolIntervals.equal a.ints b.ints) &&
(BoolPair.equal a.times b.times) && (BoolTimes.equal a.times b.times) &&
(BoolPair.equal a.xml b.xml) && (BoolXml.equal a.xml b.xml) &&
(BoolPair.equal a.arrow b.arrow) && (BoolArrow.equal a.arrow b.arrow) &&
(BoolRec.equal a.record b.record) && (BoolRec.equal a.record b.record) &&
(BoolAbstracts.equal a.abstract b.abstract) && (BoolAbstracts.equal a.abstract b.abstract) &&
(a.absent == b.absent) (a.absent == b.absent)
...@@ -241,9 +242,9 @@ struct ...@@ -241,9 +242,9 @@ struct
(BoolAtoms.is_empty a.atoms) && (BoolAtoms.is_empty a.atoms) &&
(BoolChars.is_empty a.chars) && (BoolChars.is_empty a.chars) &&
(BoolIntervals.is_empty a.ints) && (BoolIntervals.is_empty a.ints) &&
(BoolPair.is_empty a.times) && (BoolTimes.is_empty a.times) &&
(BoolPair.is_empty a.xml) && (BoolXml.is_empty a.xml) &&
(BoolPair.is_empty a.arrow) && (BoolArrow.is_empty a.arrow) &&
(BoolRec.is_empty a.record) && (BoolRec.is_empty a.record) &&
(BoolAbstracts.is_empty a.abstract) (BoolAbstracts.is_empty a.abstract)
...@@ -252,9 +253,9 @@ struct ...@@ -252,9 +253,9 @@ struct
else let c = BoolAtoms.compare a.atoms b.atoms in if c <> 0 then c else let c = BoolAtoms.compare a.atoms b.atoms in if c <> 0 then c
else let c = BoolChars.compare a.chars b.chars in if c <> 0 then c else let c = BoolChars.compare a.chars b.chars in if c <> 0 then c
else let c = BoolIntervals.compare a.ints b.ints in if c <> 0 then c else let c = BoolIntervals.compare a.ints b.ints in if c <> 0 then c
else let c = BoolPair.compare a.times b.times in if c <> 0 then c else let c = BoolTimes.compare a.times b.times in if c <> 0 then c
else let c = BoolPair.compare a.xml b.xml in if c <> 0 then c else let c = BoolXml.compare a.xml b.xml in if c <> 0 then c
else let c = BoolPair.compare a.arrow b.arrow in if c <> 0 then c else let c = BoolArrow.compare a.arrow b.arrow in if c <> 0 then c
else let c = BoolRec.compare a.record b.record in if c <> 0 then c else let c = BoolRec.compare a.record b.record in if c <> 0 then c
else let c = BoolAbstracts.compare a.abstract b.abstract in if c <> 0 then c else let c = BoolAbstracts.compare a.abstract b.abstract in if c <> 0 then c
else if a.absent && not b.absent then -1 else if a.absent && not b.absent then -1
...@@ -265,9 +266,9 @@ struct ...@@ -265,9 +266,9 @@ struct
let accu = BoolChars.hash a.chars in let accu = BoolChars.hash a.chars in
let accu = 17 * accu + BoolIntervals.hash a.ints in let accu = 17 * accu + BoolIntervals.hash a.ints in
let accu = 17 * accu + BoolAtoms.hash a.atoms in let accu = 17 * accu + BoolAtoms.hash a.atoms in
let accu = 17 * accu + BoolPair.hash a.times in let accu = 17 * accu + BoolTimes.hash a.times in
let accu = 17 * accu + BoolPair.hash a.xml in let accu = 17 * accu + BoolXml.hash a.xml in
let accu = 17 * accu + BoolPair.hash a.arrow in let accu = 17 * accu + BoolArrow.hash a.arrow in
let accu = 17 * accu + BoolRec.hash a.record in let accu = 17 * accu + BoolRec.hash a.record in
let accu = 17 * accu + BoolAbstracts.hash a.abstract in let accu = 17 * accu + BoolAbstracts.hash a.abstract in
let accu = if a.absent then accu+5 else accu in let accu = if a.absent then accu+5 else accu in
...@@ -299,10 +300,75 @@ struct ...@@ -299,10 +300,75 @@ struct
end end
and BoolAtoms : VarType with type Atom.t = Atoms.t
and type descr = Descr.t
=
struct
include Bool.MakeVar(Atoms)
type descr = Descr.t
let inj t = { empty_descr_ with atoms = t }
let proj t = t.atoms
end
and BoolIntervals : VarType with type Atom.t = Intervals.t
and type descr = Descr.t
=
struct
include Bool.MakeVar(Intervals)
type descr = Descr.t
let inj t = { empty_descr_ with ints = t }
let proj t = t.ints
end
and BoolChars : VarType with type Atom.t = Chars.t
and type descr = Descr.t
=
struct
include Bool.MakeVar(Chars)
type descr = Descr.t
let inj t = { empty_descr_ with chars = t }
let proj t = t.chars
end
and BoolAbstracts : VarType with type Atom.t = Abstracts.t
and type descr = Descr.t
=
struct
include Bool.MakeVar(Abstracts)
type descr = Descr.t
let inj t = { empty_descr_ with abstract = t }
let proj t = t.abstract
end
and Pair : Bool.S with type elem = (Node.t * Node.t) = and Pair : Bool.S with type elem = (Node.t * Node.t) =
Bool.Make(Custom.Pair(Node)(Node)) Bool.Make(Custom.Pair(Node)(Node))
and BoolPair : Bool.V with module Atom = Pair = Bool.MakeVar(Pair)
and BoolTimes : VarType 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
end
and BoolXml : VarType 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
end
and BoolArrow : VarType 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
end
(* bool = true means that the record is open that is, that (* bool = true means that the record is open that is, that
* the labels that are not in the domain of the map are * the labels that are not in the domain of the map are
...@@ -311,7 +377,14 @@ and BoolPair : Bool.V with module Atom = Pair = Bool.MakeVar(Pair) ...@@ -311,7 +377,14 @@ and BoolPair : Bool.V with module Atom = Pair = Bool.MakeVar(Pair)
and Rec : Bool.S with type elem = bool * Node.t Ident.label_map = and Rec : Bool.S with type elem = bool * Node.t Ident.label_map =
Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(Node))) Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(Node)))
and BoolRec : Bool.V with module Atom = Rec = Bool.MakeVar(Rec) and BoolRec : VarType with module Atom = Rec
and type descr = Descr.t
=
struct include Bool.MakeVar(Rec)
type descr = Descr.t
let inj (t : t) : descr = { empty_descr_ with record = t }
let proj (t : descr) : t = t.record
end
module DescrHash = Hashtbl.Make(Descr) module DescrHash = Hashtbl.Make(Descr)
module DescrMap = Map.Make(Descr) module DescrMap = Map.Make(Descr)
...@@ -348,9 +421,9 @@ let non_constructed_or_absent = ...@@ -348,9 +421,9 @@ let non_constructed_or_absent =
{ non_constructed with absent = true } { non_constructed with absent = true }
(* Descr.t type constructors *) (* Descr.t type constructors *)
let times x y = { empty with times = BoolPair.atom (`Atm (Pair.atom (x,y))) } let times x y = { empty with times = BoolTimes.atom (`Atm (Pair.atom (x,y))) }
let xml x y = { empty with xml = BoolPair.atom (`Atm (Pair.atom (x,y))) } let xml x y = { empty with xml = BoolXml.atom (`Atm (Pair.atom (x,y))) }
let arrow x y = { empty with arrow = BoolPair.atom (`Atm (Pair.atom (x,y))) } let arrow x y = { empty with arrow = BoolArrow.atom (`Atm (Pair.atom (x,y))) }
let record label t = let record label t =
{ empty with record = BoolRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t))) } { empty with record = BoolRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t))) }
...@@ -363,13 +436,13 @@ let atom a = { empty with atoms = BoolAtoms.atom (`Atm a) } ...@@ -363,13 +436,13 @@ let atom a = { empty with atoms = BoolAtoms.atom (`Atm a) }
(* Atm = Any ^ a *) (* Atm = Any ^ a *)
let var a = let var a =
{ {
times = BoolPair.var a;
xml = BoolPair.var a;
arrow = BoolPair.var a;
record= BoolRec.var a;
ints = BoolIntervals.var a; ints = BoolIntervals.var a;
atoms = BoolAtoms.var a; atoms = BoolAtoms.var a;
chars = BoolChars.var a; chars = BoolChars.var a;
times = BoolTimes.var a;
xml = BoolXml.var a;
arrow = BoolArrow.var a;
record= BoolRec.var a;
abstract = BoolAbstracts.var a; abstract = BoolAbstracts.var a;
absent = false; absent = false;
} }
...@@ -381,13 +454,13 @@ let abstract a = { empty with abstract = BoolAbstracts.atom (`Atm a) } ...@@ -381,13 +454,13 @@ let abstract a = { empty with abstract = BoolAbstracts.atom (`Atm a) }
let cup x y = let cup x y =
if x == y then x else if x == y then x else
{ {
times = BoolPair.cup x.times y.times;
xml = BoolPair.cup x.xml y.xml;
arrow = BoolPair.cup x.arrow y.arrow;
record= BoolRec.cup x.record y.record;
ints = BoolIntervals.cup x.ints y.ints; ints = BoolIntervals.cup x.ints y.ints;
atoms = BoolAtoms.cup x.atoms y.atoms; atoms = BoolAtoms.cup x.atoms y.atoms;
chars = BoolChars.cup x.chars y.chars; chars = BoolChars.cup x.chars y.chars;
times = BoolTimes.cup x.times y.times;
xml = BoolXml.cup x.xml y.xml;
arrow = BoolArrow.cup x.arrow y.arrow;
record= BoolRec.cup x.record y.record;
abstract = BoolAbstracts.cup x.abstract y.abstract; abstract = BoolAbstracts.cup x.abstract y.abstract;
absent = x.absent || y.absent; absent = x.absent || y.absent;
} }
...@@ -395,13 +468,13 @@ let cup x y = ...@@ -395,13 +468,13 @@ let cup x y =
let cap x y = let cap x y =
if x == y then x else if x == y then x else
{ {
ints = BoolIntervals.cap x.ints y.ints;
times = BoolPair.cap x.times y.times;
xml = BoolPair.cap x.xml y.xml;
record = BoolRec.cap x.record y.record;
arrow = BoolPair.cap x.arrow y.arrow;
atoms = BoolAtoms.cap x.atoms y.atoms; atoms = BoolAtoms.cap x.atoms y.atoms;
ints = BoolIntervals.cap x.ints y.ints;
chars = BoolChars.cap x.chars y.chars; chars = BoolChars.cap x.chars y.chars;
times = BoolTimes.cap x.times y.times;
xml = BoolXml.cap x.xml y.xml;
arrow = BoolArrow.cap x.arrow y.arrow;
record = BoolRec.cap x.record y.record;
abstract = BoolAbstracts.cap x.abstract y.abstract; abstract = BoolAbstracts.cap x.abstract y.abstract;
absent= x.absent && y.absent; absent= x.absent && y.absent;
} }
...@@ -409,13 +482,13 @@ let cap x y = ...@@ -409,13 +482,13 @@ let cap x y =
let diff x y = let diff x y =
if x == y then empty else if x == y then empty else
{ {
times = BoolPair.diff x.times y.times;
xml = BoolPair.diff x.xml y.xml;
arrow = BoolPair.diff x.arrow y.arrow;
record= BoolRec.diff x.record y.record;
ints = BoolIntervals.diff x.ints y.ints;
atoms = BoolAtoms.diff x.atoms y.atoms; atoms = BoolAtoms.diff x.atoms y.atoms;
ints = BoolIntervals.diff x.ints y.ints;
chars = BoolChars.diff x.chars y.chars; chars = BoolChars.diff x.chars y.chars;
times = BoolTimes.diff x.times y.times;
xml = BoolXml.diff x.xml y.xml;
arrow = BoolArrow.diff x.arrow y.arrow;
record= BoolRec.diff x.record y.record;
abstract = BoolAbstracts.diff x.abstract y.abstract; abstract = BoolAbstracts.diff x.abstract y.abstract;
absent= x.absent && not y.absent; absent= x.absent && not y.absent;
} }
...@@ -425,9 +498,9 @@ let trivially_disjoint a b = ...@@ -425,9 +498,9 @@ let trivially_disjoint a b =
(BoolChars.trivially_disjoint a.chars b.chars) && (BoolChars.trivially_disjoint a.chars b.chars) &&
(BoolIntervals.trivially_disjoint a.ints b.ints) && (BoolIntervals.trivially_disjoint a.ints b.ints) &&
(BoolAtoms.trivially_disjoint a.atoms b.atoms) && (BoolAtoms.trivially_disjoint a.atoms b.atoms) &&
(BoolPair.trivially_disjoint a.times b.times) && (BoolTimes.trivially_disjoint a.times b.times) &&
(BoolPair.trivially_disjoint a.xml b.xml) && (BoolXml.trivially_disjoint a.xml b.xml) &&
(BoolPair.trivially_disjoint a.arrow b.arrow) && (BoolArrow.trivially_disjoint a.arrow b.arrow) &&
(BoolRec.trivially_disjoint a.record b.record) && (BoolRec.trivially_disjoint a.record b.record) &&
(BoolAbstracts.trivially_disjoint a.abstract b.abstract) && (BoolAbstracts.trivially_disjoint a.abstract b.abstract) &&
(not (a.absent && b.absent)) (not (a.absent && b.absent))
...@@ -697,11 +770,11 @@ module Witness = struct ...@@ -697,11 +770,11 @@ module Witness = struct
| WPair (w1,w2,_) -> | WPair (w1,w2,_) ->
bool_pair bool_pair
(fun (n1,n2) -> node_has n1 w1 && node_has n2 w2) (fun (n1,n2) -> node_has n1 w1 && node_has n2 w2)
(BoolPair.leafconj t.times) (BoolTimes.leafconj t.times)
| WXml (w1,w2,_) -> | WXml (w1,w2,_) ->
bool_pair bool_pair
(fun (n1,n2) -> node_has n1 w1 && node_has n2 w2) (fun (n1,n2) -> node_has n1 w1 && node_has n2 w2)
(BoolPair.leafconj t.xml) (BoolXml.leafconj t.xml)
| WFun (f,_) -> | WFun (f,_) ->
bool_pair bool_pair
(fun (n1,n2) -> (fun (n1,n2) ->
...@@ -711,7 +784,7 @@ module Witness = struct ...@@ -711,7 +784,7 @@ module Witness = struct
(match y with None -> false (match y with None -> false
| Some y -> node_has n2 y)) | Some y -> node_has n2 y))
f) f)
(BoolPair.leafconj t.arrow) (BoolArrow.leafconj t.arrow)
| WRecord (f,o,_) -> | WRecord (f,o,_) ->
bool_rec bool_rec
(fun (o',f') -> (fun (o',f') ->
...@@ -800,9 +873,9 @@ let rec slot d = ...@@ -800,9 +873,9 @@ let rec slot d =
let s = { status = Maybe; active = false; notify = Nothing } in let s = { status = Maybe; active = false; notify = Nothing } in
DescrHash.add memo d s; DescrHash.add memo d s;
(try (try
iter_s s check_times (Pair.get (BoolPair.leafconj d.times)); iter_s s check_times (Pair.get (BoolTimes.leafconj d.times));
iter_s s check_xml (Pair.get (BoolPair.leafconj d.xml)); iter_s s check_xml (Pair.get (BoolXml.leafconj d.xml));
iter_s s check_arrow (Pair.get (BoolPair.leafconj d.arrow)); iter_s s check_arrow (Pair.get (BoolArrow.leafconj d.arrow));
iter_s s check_record (get_record (BoolRec.leafconj d.record)); iter_s s check_record (get_record (BoolRec.leafconj d.record));
if s.active then marks := s :: !marks else s.status <- Empty; if s.active then marks := s :: !marks else s.status <- Empty;
with NotEmpty -> ()); with NotEmpty -> ());
...@@ -939,14 +1012,14 @@ let times x y = ...@@ -939,14 +1012,14 @@ let times x y =
if subtype any x.Node.descr if subtype any x.Node.descr
&& subtype any y.Node.descr && subtype any y.Node.descr
then then
{ empty with times = BoolPair.full } { empty with times = BoolTimes.full }
else times x y else times x y
let xml x y = let xml x y =
if subtype any x.Node.descr if subtype any x.Node.descr
&& subtype any y.Node.descr && subtype any y.Node.descr
then then
{ empty with xml = BoolPair.full } { empty with xml = BoolXml.full }
else xml x y else xml x y
module Cache = struct module Cache = struct
...@@ -1077,8 +1150,8 @@ struct ...@@ -1077,8 +1150,8 @@ struct
let get ?(kind=`Normal) d = let get ?(kind=`Normal) d =
match kind with match kind with
| `Normal -> partition any (BoolPair.leafconj d.times) | `Normal -> partition any (BoolTimes.leafconj d.times)
| `XML -> partition any_pair (BoolPair.leafconj d.xml) | `XML -> partition any_pair (BoolXml.leafconj d.xml)
let pi1 = List.fold_left (fun acc (t1,_) -> cup acc t1) empty let pi1 = List.fold_left (fun acc (t1,_) -> cup acc t1) empty
let pi2 = List.fold_left (fun acc (_,t2) -> cup acc t2) empty let pi2 = List.fold_left (fun acc (_,t2) -> cup acc t2) empty
...@@ -1122,8 +1195,8 @@ struct ...@@ -1122,8 +1195,8 @@ struct
let normal ?(kind=`Normal) d = let normal ?(kind=`Normal) d =
match kind with match kind with
| `Normal -> normal_times (BoolPair.leafconj d.times) | `Normal -> normal_times (BoolTimes.leafconj d.times)
| `XML -> normal_xml (BoolPair.leafconj d.xml) | `XML -> normal_xml (BoolXml.leafconj d.xml)
(* (*
...@@ -1388,7 +1461,7 @@ struct ...@@ -1388,7 +1461,7 @@ struct
not (List.exists (check_simple left) right) not (List.exists (check_simple left) right)
let sample t = let sample t =
let (left,right) = List.find check_line_non_empty (Pair.get (BoolPair.leafconj t.arrow)) in let (left,right) = List.find check_line_non_empty (Pair.get (BoolArrow.leafconj t.arrow)) in
List.fold_left (fun accu (t,s) -> cap accu (arrow t s)) List.fold_left (fun accu (t,s) -> cap accu (arrow t s))
{ empty with arrow = any.arrow } left { empty with arrow = any.arrow } left
...@@ -1418,7 +1491,7 @@ struct ...@@ -1418,7 +1491,7 @@ struct
in in
(* considering only arrows here and not poly variables is correct as (* considering only arrows here and not poly variables is correct as
* the iface is just an intersection of arrows *) * the iface is just an intersection of arrows *)
aux (Pair.get (BoolPair.leafconj s.arrow)) aux (Pair.get (BoolArrow.leafconj s.arrow))
type t = descr * (descr * descr) list list type t = descr * (descr * descr) list list
...@@ -1433,7 +1506,7 @@ struct ...@@ -1433,7 +1506,7 @@ struct
else accu else accu
) )
(any, []) (any, [])
(Pair.get (BoolPair.leafconj t.arrow)) (Pair.get (BoolArrow.leafconj t.arrow))