[r2003-05-18 14:10:33 by cvscast] Improve pretty-printer

Original author: cvscast
Date: 2003-05-18 14:10:33+00:00

types/types.ml

@@ -1002,6 +1002,7 @@ struct
     | Xml of [ `Tag of string | `Type of t ] * t * t
     | Record of (bool * t) label_map * bool * bool
     | Arrows of (t * t) list * (t * t) list
+    | Neg of t
 
   module DescrPairMap = 
     Map.Make(
@@ -1040,6 +1041,19 @@ struct
     not (trivial_pair d.times && trivial_pair d.xml && 
 	 trivial_pair d.arrow && trivial_rec d.record) 
 
+  let worth_complement d =
+    let aux f x y = if f x y = 0 then 1 else 0 in
+    let n = 
+      aux Atoms.compare d.atoms any.atoms +
+      aux Chars.compare d.chars any.chars +
+      aux Intervals.compare d.ints any.ints +
+      aux BoolPair.compare d.times any.times +
+      aux BoolPair.compare d.xml any.xml +
+      aux BoolPair.compare d.arrow any.arrow +
+      aux BoolRec.compare d.record any.record in
+    n >= 4
+
+
   let rec prepare d =
     try 
       let slot = DescrHash.find memo d  in
@@ -1055,6 +1069,9 @@ struct
 	DescrHash.add memo d s;
 	s
       with Not_found ->
+	if worth_complement d then 
+	  { empty_t with def = [Neg (prepare (neg d))] }
+	else
 	let slot = { empty_t with def = []  } in
 	if worth_abbrev d then DescrHash.add memo d slot;
 	let (seq,not_seq) =
@@ -1131,6 +1148,7 @@ struct
     then Format.fprintf ppf "@[(%a)@]" aux def
     else aux ppf def
   and do_print ppf = function
+    | Neg t -> Format.fprintf ppf "Any \\ (@[%a@])" (do_print_slot 0) t
     | Name n -> Format.fprintf ppf "%s" n
     | Char c -> Chars.print_v ppf c
     | Regexp r -> Format.fprintf ppf "@[[ %a ]@]" (do_print_regexp 0) r