Commit 34a448ff authored by Julien Lopez's avatar Julien Lopez
Browse files

Add tests and fixes for TLV

parent 4c91ada9
......@@ -29,6 +29,11 @@ let tlv_tests = [ "is_var", [
"`$A & `$B", Types.is_var, false;
"`$A | `$B", Types.is_var, false;
"`$A \\ `$B", Types.is_var, false;
"(`$A | Int) | (Any \\ `$A)", Types.is_var, false; (* Any *)
"{..}", Types.is_var, false;
"{..} | `$A", Types.is_var, false;
"`$A \\ {..}", Types.is_var, false;
"{a=`$A}", Types.is_var, false;
];
"no_var", [
......@@ -50,6 +55,11 @@ let tlv_tests = [ "is_var", [
"`$A & `$B", Types.no_var, false;
"`$A | `$B", Types.no_var, false;
"`$A \\ `$B", Types.no_var, false;
"(`$A | Int) | (Any \\ `$A)", Types.no_var, true; (* Any *)
"{..}", Types.no_var, true;
"{..} | `$A", Types.no_var, false;
"`$A \\ {..}", Types.no_var, false;
"{a=`$A}", Types.no_var, false;
];
"has_tlv", [
......@@ -70,8 +80,13 @@ let tlv_tests = [ "is_var", [
"(Any \\`$A) \\ Empty", Types.has_tlv, true; (* ~`$A *)
"Any \\ (Any \\ `$A)", Types.has_tlv, true; (* `$A *)
"`$A & `$B", Types.has_tlv, true;
(* "`$A | `$B", Types.has_tlv, true;*) (* TODO: Fix this test *)
"`$A | `$B", Types.has_tlv, true;
"`$A \\ `$B", Types.has_tlv, true;
"(`$A | Int) | (Any \\ `$A)", Types.has_tlv, false; (* Any *)
"{..}", Types.has_tlv, false;
"{..} | `$A", Types.has_tlv, true;
"`$A \\ {..}", Types.has_tlv, true;
"{a=`$A}", Types.has_tlv, false;
];
]
......
......@@ -242,6 +242,7 @@ sig
}
include Custom.T with type t = s
val empty: t
val any : t
val is_empty : t -> bool
end =
struct
......@@ -288,6 +289,23 @@ struct
toplvars = TLV.empty
}
(*
* Two representations possible. Either all fields (except vars) are full, OR
* the field vars is full.
*)
let any = {
times = BoolPair.full;
xml = BoolPair.full;
arrow = BoolPair.full;
record= BoolRec.full;
ints = BoolIntervals.full;
atoms = BoolAtoms.full;
chars = BoolChars.full;
abstract = Abstract.any;
absent= false;
toplvars = TLV.any
}
let check a =
BoolChars.check a.chars;
BoolIntervals.check a.ints;
......@@ -410,22 +428,6 @@ let descr n = n.Node.descr
let internalize n = n
let id n = n.Node.id
(* two representation possible. either all fields (except vars) are full, OR
* the field vars is full.
*)
let any = {
times = BoolPair.full;
xml = BoolPair.full;
arrow = BoolPair.full;
record= BoolRec.full;
ints = BoolIntervals.full;
atoms = BoolAtoms.full;
chars = BoolChars.full;
abstract = Abstract.any;
absent= false;
toplvars = TLV.any
}
let non_constructed =
{ any with
times = empty.times; xml = empty.xml; record = empty.record }
......@@ -500,7 +502,7 @@ let update_tlv x y t =
match l with
|[] -> Set.empty
|[h] -> h
|h::l -> List.fold_left Set.inter h l
|h::l -> List.fold_left Set.union h l
in
List.fold_left Set.union
(aux BoolChars.get t.chars)
......@@ -513,7 +515,7 @@ let update_tlv x y t =
]
in
let fv t =
if Descr.is_empty t then Var.Set.empty
if Descr.is_empty t || equal t Descr.any then Var.Set.empty
else Var.Set.union x.toplvars.fv y.toplvars.fv
in
let toplvars = { tlv = tlv t ; fv = fv t ; isvar = t.toplvars.isvar } in
......@@ -564,7 +566,7 @@ let cap x y =
absent= x.absent && y.absent;
toplvars = TLV.empty
} in
let isvar = (is_var x && equal x t) (* || (is_var y && equal y t) *) in
let isvar = (is_var x && equal x t) || (is_var y && equal y t) in
update_tlv x y { t with toplvars = { t.toplvars with TLV.isvar = isvar }}
let diff x y =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment