From d73bf48c107e7f3e08f2fc5777bbbd42b4e1bc7c Mon Sep 17 00:00:00 2001 From: ppedrot Date: Mon, 28 Jan 2013 13:54:13 +0000 Subject: Added backtrace information to anomalies git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16161 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/pretyping.ml | 2 +- pretyping/reductionops.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'pretyping') diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 15395ca7f..fe03cae8c 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -194,7 +194,7 @@ let invert_ltac_bound_name env id0 id = let protected_get_type_of env sigma c = try Retyping.get_type_of env sigma c - with Anomaly _ -> + with e when is_anomaly e -> errorlabstrm "" (str "Cannot reinterpret " ++ quote (print_constr c) ++ str " in the current environment.") let pretype_id loc env sigma (lvar,unbndltacvars) id = diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index 48b15b1dd..6ec5ab9b4 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -608,7 +608,7 @@ let clos_norm_flags flgs env sigma t = norm_val (create_clos_infos ~evars:(safe_evar_value sigma) flgs env) (inject t) - with Anomaly _ -> error "Tried to normalized ill-typed term" + with e when is_anomaly e -> error "Tried to normalized ill-typed term" let nf_beta = clos_norm_flags Closure.beta empty_env let nf_betaiota = clos_norm_flags Closure.betaiota empty_env @@ -713,7 +713,7 @@ let test_conversion (f: ?l2r:bool-> ?evars:'a->'b) env sigma x y = try let _ = f ~evars:(safe_evar_value sigma) env x y in true with NotConvertible -> false - | Anomaly _ -> error "Conversion test raised an anomaly" + | e when is_anomaly e -> error "Conversion test raised an anomaly" let is_conv env sigma = test_conversion Reduction.conv env sigma let is_conv_leq env sigma = test_conversion Reduction.conv_leq env sigma @@ -722,7 +722,7 @@ let is_fconv = function | CONV -> is_conv | CUMUL -> is_conv_leq let test_trans_conversion (f: ?l2r:bool-> ?evars:'a->'b) reds env sigma x y = try let _ = f ~evars:(safe_evar_value sigma) reds env x y in true with NotConvertible -> false - | Anomaly _ -> error "Conversion test raised an anomaly" + | e when is_anomaly e -> error "Conversion test raised an anomaly" let is_trans_conv reds env sigma = test_trans_conversion Reduction.trans_conv reds env sigma let is_trans_conv_leq reds env sigma = test_trans_conversion Reduction.trans_conv_leq reds env sigma -- cgit v1.2.3