X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaExcPp.ml;h=b79fea6631212e79be1374aa8041800af9c91bc2;hb=8653d506aacaf019deb3438bd4681ad1000061bd;hp=74f2c9f41a03432d8aca76b8a4af059c2da456fb;hpb=6857e22b8a58162893119f7747c5848031fd59ce;p=helm.git diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml index 74f2c9f41..b79fea663 100644 --- a/helm/matita/matitaExcPp.ml +++ b/helm/matita/matitaExcPp.ml @@ -25,17 +25,75 @@ open Printf -let to_string = +let rec to_string = function + | HExtlib.Localized (floc,exn) -> + 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" ) -> + None, "Baseuri not set for this script. " ^ "Use 'set \"baseuri\" \"\".' to set it." - | MatitaTypes.Command_error msg -> "Error: " ^ msg - | CicTextualParser2.Parse_error (floc,err) -> - let (x, y) = CicAst.loc_of_floc floc in - sprintf "Parse error at %d-%d: %s" x y err - | UriManager.IllFormedUri uri -> sprintf "invalid uri: %s" uri + | MatitaTypes.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 | CicEnvironment.Object_not_found uri -> - sprintf "object not found: %s" (UriManager.string_of_uri uri) - | exn -> "Uncaught exception: " ^ Printexc.to_string exn + None, sprintf "object not found: %s" (UriManager.string_of_uri uri) + | 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 -> + None, + sprintf + (".moo file '%s' has been compiled by a different version of matita, " + ^^ "please recompile it") + fname + | ProofEngineTypes.Fail msg -> None, "Tactic error: " ^ Lazy.force msg + | Continuationals.Error s -> None, "Tactical error: " ^ Lazy.force s + | CicTypeChecker.TypeCheckerFailure msg -> + 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 = + 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 loc = + match errorll with + ((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 + loc, + "********** DISAMBIGUATION ERRORS: **********\n" ^ + aux 1 errorll + | exn -> None, "Uncaught exception: " ^ Printexc.to_string exn