X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaExcPp.ml;h=28f25fd5c53a0dd5c185fe3dac5696f5dcbd3046;hb=676868d140f4314043723cc7f2fda3fbceade7dd;hp=b79fea6631212e79be1374aa8041800af9c91bc2;hpb=8653d506aacaf019deb3438bd4681ad1000061bd;p=helm.git diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index b79fea663..28f25fd5c 100644 --- a/helm/matita/matitaExcPp.ml +++ b/helm/matita/matitaExcPp.ml @@ -23,6 +23,8 @@ * http://helm.cs.unibo.it/ *) +(* $Id$ *) + open Printf let rec to_string = @@ -31,11 +33,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,16 +46,11 @@ 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 -> - None, sprintf ".moo file '%s' is corrupt (shorter than expected)" fname - | MatitaMoo.Checksum_failure fname -> - None, - sprintf "checksum failed for .moo file '%s', please recompile it'" fname - | MatitaMoo.Version_mismatch fname -> + | HMarshal.Corrupt_file fname -> None, sprintf "file '%s' is corrupt" fname + | HMarshal.Format_mismatch fname + | HMarshal.Version_mismatch fname -> None, - sprintf - (".moo file '%s' has been compiled by a different version of matita, " - ^^ "please recompile it") + sprintf "format/version mismatch for file '%s', please recompile it'" fname | ProofEngineTypes.Fail msg -> None, "Tactic error: " ^ Lazy.force msg | Continuationals.Error s -> None, "Tactical error: " ^ Lazy.force s @@ -61,24 +58,30 @@ let rec to_string = None, "Type checking error: " ^ Lazy.force msg | CicTypeChecker.AssertFailure msg -> None, "Type checking assertion failed: " ^ Lazy.force msg - | MatitaDisambiguator.DisambiguationError (offset,errorll) -> - let rec aux n = + | LibrarySync.AlreadyDefined s -> + None, "Already defined: " ^ UriManager.string_of_uri s + | GrafiteDisambiguator.DisambiguationError (offset,errorll) -> + 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 +93,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