Commit ca2fcfac authored by Pietro Abate's avatar Pietro Abate
Browse files

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

Original author: cvscast
Date: 2003-05-18 14:10:33+00:00
parent 15fa6d5a
...@@ -1002,6 +1002,7 @@ struct ...@@ -1002,6 +1002,7 @@ struct
| Xml of [ `Tag of string | `Type of t ] * t * t | Xml of [ `Tag of string | `Type of t ] * t * t
| Record of (bool * t) label_map * bool * bool | Record of (bool * t) label_map * bool * bool
| Arrows of (t * t) list * (t * t) list | Arrows of (t * t) list * (t * t) list
| Neg of t
module DescrPairMap = module DescrPairMap =
Map.Make( Map.Make(
...@@ -1040,6 +1041,19 @@ struct ...@@ -1040,6 +1041,19 @@ struct
not (trivial_pair d.times && trivial_pair d.xml && not (trivial_pair d.times && trivial_pair d.xml &&
trivial_pair d.arrow && trivial_rec d.record) 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 = let rec prepare d =
try try
let slot = DescrHash.find memo d in let slot = DescrHash.find memo d in
...@@ -1055,6 +1069,9 @@ struct ...@@ -1055,6 +1069,9 @@ struct
DescrHash.add memo d s; DescrHash.add memo d s;
s s
with Not_found -> with Not_found ->
if worth_complement d then
{ empty_t with def = [Neg (prepare (neg d))] }
else
let slot = { empty_t with def = [] } in let slot = { empty_t with def = [] } in
if worth_abbrev d then DescrHash.add memo d slot; if worth_abbrev d then DescrHash.add memo d slot;
let (seq,not_seq) = let (seq,not_seq) =
...@@ -1131,6 +1148,7 @@ struct ...@@ -1131,6 +1148,7 @@ struct
then Format.fprintf ppf "@[(%a)@]" aux def then Format.fprintf ppf "@[(%a)@]" aux def
else aux ppf def else aux ppf def
and do_print ppf = function and do_print ppf = function
| Neg t -> Format.fprintf ppf "Any \\ (@[%a@])" (do_print_slot 0) t
| Name n -> Format.fprintf ppf "%s" n | Name n -> Format.fprintf ppf "%s" n
| Char c -> Chars.print_v ppf c | Char c -> Chars.print_v ppf c
| Regexp r -> Format.fprintf ppf "@[[ %a ]@]" (do_print_regexp 0) r | Regexp r -> Format.fprintf ppf "@[[ %a ]@]" (do_print_regexp 0) r
......
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