Added more flags choice in desambiguating printer. The code is

parametric on the list of possible flags.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16665 85f007b7-540e-0410-9357-904b9bb8a0f7

3 files changed, 32 insertions, 11 deletions

diff --git a/lib/flags.ml b/lib/flags.ml
index af40e946e9..06c52e4b26 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -14,6 +14,17 @@ let with_option o f x =
      let () = o := old in
      raise reraise
 
+let with_options ol f x =
+  let vl = List.map (!) ol in
+  let () = List.iter (fun r -> r := true) ol in
+  try
+    let r = f x in
+    let () = List.iter2 (:=) ol vl in r
+  with reraise ->
+    let reraise = Backtrace.add_backtrace reraise in
+    let () = List.iter2 (:=) ol vl in
+    raise reraise
+
 let without_option o f x =
   let old = !o in o:=false;
   try let r = f x in o := old; r
diff --git a/lib/flags.mli b/lib/flags.mli
index 9dbe2c68c1..14b9f26bcc 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -64,6 +64,9 @@ val if_warn : ('a -> unit) -> 'a -> unit
    use [with_option o (f x y) z]) *)
 val with_option : bool ref -> ('a -> 'b) -> 'a -> 'b
 
+(** As [with_option], but on several flags. *)
+val with_options : bool ref list -> ('a -> 'b) -> 'a -> 'b
+
 (** Temporarily deactivate an option *)
 val without_option : bool ref -> ('a -> 'b) -> 'a -> 'b
 
diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml
index cc6266039a..756df00534 100644
--- a/toplevel/himsg.ml
+++ b/toplevel/himsg.ml
@@ -34,21 +34,28 @@ let pr_ljudge_env e c = let v,t = pr_ljudge_env e c in (quote v,quote t)
 
 (** This function adds some explicit printing flags if the two arguments are
     printed alike. *)
-let pr_explicit env t1 t2 =
+let rec pr_explicit_aux env t1 t2 = function
+| [] ->
+  (** no specified flags: default. *)
+  (quote (Printer.pr_lconstr_env env t1), quote (Printer.pr_lconstr_env env t2))
+| flags :: rem ->
   let open Constrextern in
-  let ct1 = extern_constr false env t1 in
-  let ct2 = extern_constr false env t2 in
+  let ct1 = Flags.with_options flags (fun () -> extern_constr false env t1) () in
+  let ct2 = Flags.with_options flags (fun () -> extern_constr false env t2) () in
   let equal = Constrexpr_ops.constr_expr_eq ct1 ct2 in
   if equal then
-    let f () =
-      let t1 = pr_lconstr_env env t1 in
-      let t2 = pr_lconstr_env env t2 in
-      (t1, t2)
-    in
-    (** We only display implicit arguments. Maybe we could do more? *)
-    with_implicits f ()
+    (** The two terms are the same from the user point of view *)
+    pr_explicit_aux env t1 t2 rem
   else
-    (Ppconstr.pr_lconstr_expr ct1, Ppconstr.pr_lconstr_expr ct2)
+    (quote (Ppconstr.pr_lconstr_expr ct1), quote (Ppconstr.pr_lconstr_expr ct2))
+
+let explicit_flags =
+  let open Constrextern in
+  [ []; (** First, try with the current flags *)
+    [print_implicits]; (** Then with implicit *)
+    [print_implicits; print_coercions; print_no_symbol] (** Then more! *) ]
+
+let pr_explicit env t1 t2 = pr_explicit_aux env t1 t2 explicit_flags
 
 let pr_db env i =
   try