[r2006-01-27 16:52:28 by afrisch] Empty log message

Original author: afrisch
Date: 2006-01-27 16:52:29+00:00

types/chars.ml

@@ -124,6 +124,12 @@ let print =
 	 Format.fprintf ppf "%a--%a" V.print a V.print b
     )
 
+let dump ppf t =
+  match print t with
+    | [] -> Format.fprintf ppf "()"
+    | hd::tl -> hd ppf; List.iter (fun x -> Format.fprintf ppf "|"; x ppf) tl
+  
+
 type 'a map = (int * 'a) list
 (* Optimize lookup:
    - decision tree

types/chars.mli

@@ -11,6 +11,8 @@ end
 
 include Custom.T
 val print : t -> (Format.formatter -> unit) list
+val dump: Format.formatter -> t -> unit
+
 
 val empty : t
 val any   : t

types/types.ml

@@ -674,7 +674,17 @@ and check_times (left,right) s =
     | [] -> set s
   in
   let (accu1,accu2) = cap_product any any left in
-  guard (slot accu1) (guard (slot accu2) (aux accu1 accu2 right)) s
+  let rec check_trivial l s = match l with
+    | [] -> aux accu1 accu2 right s
+    | (n1,n2)::l ->
+	let t1 = diff accu1 (descr n1) in
+	if Descr.equal t1 empty then
+	  let t2 = diff accu2 (descr n2) in
+	  guard (slot t2) (check_trivial l) s
+	else
+	  check_trivial l s
+  in
+  guard (slot accu1) (guard (slot accu2) (check_trivial right)) s
 
 and check_xml (left,right) s =
   let rec aux accu1 accu2 right s = match right with
@@ -693,7 +703,7 @@ and check_xml (left,right) s =
     | [] -> set s
   in
   let (accu1,accu2) = cap_product any any_pair left in
-  guard (slot accu1) (guard (slot accu2) (aux accu1 accu2 right)) s
+  guard (slot accu1) (guard (slot accu2) (aux accu1 accu2 right)) s 
 
 and check_arrow (left,right) s =
   let single_right (s1,s2) s =