From 585b70958440a8ae155e9ef8281099b66a9ba836 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Wed, 7 Dec 2005 19:00:25 +0000 Subject: [PATCH] More compact disambiguation errors. --- helm/matita/matitaExcPp.ml | 47 ++++++++++++++++++++++++-------------- 1 file changed, 30 insertions(+), 17 deletions(-) diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index c09b22fdd..29f08d514 100644 --- a/helm/matita/matitaExcPp.ml +++ b/helm/matita/matitaExcPp.ml @@ -64,23 +64,27 @@ let rec to_string = | LibrarySync.AlreadyDefined s -> None, "Already defined: " ^ UriManager.string_of_uri s | MatitaDisambiguator.DisambiguationError (offset,errorll) -> - let rec aux n = + let rec aux n ?(dummy=false) (prev_msg,phases) = function - [] -> "" + [] -> [] | phase::tl -> - aux (n+1) tl ^ - "***** Errors obtained during phase " ^ string_of_int n ^": *****\n"^ - String.concat "\n\n" - (List.map (fun (floc,msg) -> - let loc_descr = - match floc with - None -> "" - | Some floc -> - let (x, y) = HExtlib.loc_of_floc floc in - sprintf " at %d-%d" (x+offset) (y+offset) - in - "*Error" ^ loc_descr ^ ": " ^ Lazy.force msg) phase) ^ - "\n\n\n" in + let msg = + String.concat "\n\n\n" + (List.map (fun (floc,msg) -> + let loc_descr = + match floc with + None -> "" + | Some floc -> + let (x, y) = HExtlib.loc_of_floc floc in + sprintf " at %d-%d" (x+offset) (y+offset) + in + "*Error" ^ loc_descr ^ ": " ^ Lazy.force msg) phase) + in + if msg = prev_msg then + aux (n+1) (msg,phases@[n]) tl + else + (if not dummy then [prev_msg,phases] else []) @ + (aux (n+1) (msg,[n]) tl) in let loc = match errorll with ((Some floc,_)::_)::_ -> @@ -92,10 +96,19 @@ let rec to_string = {flocb with Lexing.pos_cnum = x}, {floce with Lexing.pos_cnum = y} in Some floc - | _ -> None + | _ -> None in + let rec explain = + function + [] -> "" + | (msg,phases)::tl -> + explain tl ^ + "***** Errors obtained during phase" ^ + (if phases = [] then " " else "s ") ^ + String.concat "," (List.map string_of_int phases) ^": *****\n"^ + msg ^ "\n\n" in loc, "********** DISAMBIGUATION ERRORS: **********\n" ^ - aux 1 errorll + explain (aux 1 ~dummy:true ("",[]) errorll) | exn -> None, "Uncaught exception: " ^ Printexc.to_string exn -- 2.39.2