From 1b2a6326876c67bf25657ecd7c0765cacd1cde75 Mon Sep 17 00:00:00 2001 From: ppedrot Date: Thu, 30 May 2013 17:55:59 +0000 Subject: Removing a useless location in ltac trace mechanism. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16547 85f007b7-540e-0410-9357-904b9bb8a0f7 --- proofs/proof_type.ml | 2 +- proofs/proof_type.mli | 2 +- tactics/tacinterp.ml | 13 ++++--------- toplevel/cerrors.ml | 3 ++- 4 files changed, 8 insertions(+), 12 deletions(-) diff --git a/proofs/proof_type.ml b/proofs/proof_type.ml index f7f10272c..609c7782d 100644 --- a/proofs/proof_type.ml +++ b/proofs/proof_type.ml @@ -58,4 +58,4 @@ type ltac_call_kind = type ltac_trace = (int * Loc.t * ltac_call_kind) list -let (ltac_trace_info : (ltac_trace * Loc.t) Exninfo.t) = Exninfo.make () +let (ltac_trace_info : ltac_trace Exninfo.t) = Exninfo.make () diff --git a/proofs/proof_type.mli b/proofs/proof_type.mli index 74a12d42b..33e1f29c5 100644 --- a/proofs/proof_type.mli +++ b/proofs/proof_type.mli @@ -85,4 +85,4 @@ type ltac_call_kind = type ltac_trace = (int * Loc.t * ltac_call_kind) list -val ltac_trace_info : (ltac_trace * Loc.t) Exninfo.t +val ltac_trace_info : ltac_trace Exninfo.t diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml index 6c66f4ced..761dfe6a9 100644 --- a/tactics/tacinterp.ml +++ b/tactics/tacinterp.ml @@ -71,20 +71,15 @@ let dloc = Loc.ghost let catch_error call_trace tac g = try tac g with e when Errors.noncritical e -> let e = Errors.push e in - let inner_trace,loc,e = match Exninfo.get e ltac_trace_info with - | Some (inner_trace,loc) -> inner_trace,loc,e - | None -> - let loc = match Loc.get_loc e with - | None -> Loc.ghost - | Some loc -> loc - in - [], loc, e + let inner_trace, e = match Exninfo.get e ltac_trace_info with + | Some inner_trace -> inner_trace, e + | None -> [], e in if List.is_empty call_trace && List.is_empty inner_trace then raise e else begin assert (Errors.noncritical e); (* preserved invariant *) let new_trace = inner_trace @ call_trace in - let located_exc = Exninfo.add e ltac_trace_info (new_trace, loc) in + let located_exc = Exninfo.add e ltac_trace_info new_trace in raise located_exc end diff --git a/toplevel/cerrors.ml b/toplevel/cerrors.ml index d87525bf5..b9468a298 100644 --- a/toplevel/cerrors.ml +++ b/toplevel/cerrors.ml @@ -120,9 +120,10 @@ let process_vernac_interp_error exn = match exn with let process_vernac_interp_error exc = let e = process_vernac_interp_error exc in let ltac_trace = Exninfo.get exc Proof_type.ltac_trace_info in + let loc = Option.default Loc.ghost (Loc.get_loc e) in match ltac_trace with | None -> e - | Some (trace, loc) -> + | Some trace -> match Himsg.extract_ltac_trace trace loc with | None, loc -> Loc.add_loc e loc | Some msg, loc -> Loc.add_loc (EvaluatedError (msg, Some e)) loc -- cgit v1.2.3