Add tests and fixes for TLV

tests/libtest/typesTest.ml

@@ -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;
   ];
 
 ]

types/types.ml

@@ -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 =