X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaExcPp.ml;h=28f25fd5c53a0dd5c185fe3dac5696f5dcbd3046;hb=771ee8b9d122fa963881c876e86f90531bb7434f;hp=38951713eab19127332836aa3d6f84aed11b2205;hpb=8d8ac4a42998970114e43c2fb13ff2c98f7c259a;p=helm.git diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index 38951713e..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,31 +58,54 @@ let rec to_string = None, "Type checking error: " ^ Lazy.force msg | CicTypeChecker.AssertFailure msg -> None, "Type checking assertion failed: " ^ Lazy.force msg - | MatitaDisambiguator.DisambiguationError 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 y - 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 _ as loc,_)::_)::_ -> loc - | _ -> None + ((Some floc,_)::_)::_ -> + let (x, y) = HExtlib.loc_of_floc floc in + let x = x + offset in + let y = y + offset in + let flocb,floce = floc in + let floc = + {flocb with Lexing.pos_cnum = x}, {floce with Lexing.pos_cnum = y} + in + Some floc + | _ -> 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