X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaExcPp.ml;h=af1aeb882964661d01e722ef905fc3d681c2e545;hb=b92a0ec32215eea5e0452154da54d5a29a84a53e;hp=b79fea6631212e79be1374aa8041800af9c91bc2;hpb=8653d506aacaf019deb3438bd4681ad1000061bd;p=helm.git diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index b79fea663..af1aeb882 100644 --- a/helm/matita/matitaExcPp.ml +++ b/helm/matita/matitaExcPp.ml @@ -31,11 +31,11 @@ let rec to_string = let _,msg = to_string exn in let (x, y) = HExtlib.loc_of_floc floc in Some floc, sprintf "Error at %d-%d: %s" x y msg - | MatitaTypes.Option_error ("baseuri", "not found" ) -> + | GrafiteTypes.Option_error ("baseuri", "not found" ) -> None, "Baseuri not set for this script. " ^ "Use 'set \"baseuri\" \"\".' to set it." - | MatitaTypes.Command_error msg -> None, "Error: " ^ msg + | GrafiteTypes.Command_error msg -> None, "Error: " ^ msg | CicNotationParser.Parse_error err -> None, sprintf "Parse error: %s" err | UriManager.IllFormedUri uri -> None, sprintf "invalid uri: %s" uri @@ -44,12 +44,12 @@ let rec to_string = | Unix.Unix_error (code, api, param) -> let err = Unix.error_message code in None, "Unix Error (" ^ api ^ "): " ^ err - | MatitaMoo.Corrupt_moo fname -> + | GrafiteMarshal.Corrupt_moo fname -> None, sprintf ".moo file '%s' is corrupt (shorter than expected)" fname - | MatitaMoo.Checksum_failure fname -> + | GrafiteMarshal.Checksum_failure fname -> None, sprintf "checksum failed for .moo file '%s', please recompile it'" fname - | MatitaMoo.Version_mismatch fname -> + | GrafiteMarshal.Version_mismatch fname -> None, sprintf (".moo file '%s' has been compiled by a different version of matita, " @@ -61,24 +61,30 @@ let rec to_string = None, "Type checking error: " ^ Lazy.force msg | CicTypeChecker.AssertFailure msg -> None, "Type checking assertion failed: " ^ Lazy.force msg + | 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,_)::_)::_ -> @@ -90,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