X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaExcPp.ml;h=af1aeb882964661d01e722ef905fc3d681c2e545;hb=6a149d262dfcb03a7d57f8ecabf23b0b59e99f85;hp=c09b22fdd1c053127981cad7226a9968375e34af;hpb=41be5e85a1103a5b14495bb487995a6a88e79c48;p=helm.git diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index c09b22fdd..af1aeb882 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 - [] -> "" + [] -> [prev_msg,phases] | 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