aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping/reductionops.ml
diff options
context:
space:
mode:
authorGravatar barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7>2010-07-29 16:10:38 +0000
committerGravatar barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7>2010-07-29 16:10:38 +0000
commit0824e2aaec90deea52d0a638e2a8a2da74f8fbb4 (patch)
treee95b0b1e67545dd2c6284350e0a3c76b9987923c /pretyping/reductionops.ml
parent8aa59665283c64fa6b6454333bede47a3eccbb40 (diff)
kernel conversion and reduction do not raise assert failure on ill-typed terms, but an anomaly instead. It is caught in pretyping
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13353 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping/reductionops.ml')
-rw-r--r--pretyping/reductionops.ml18
1 files changed, 12 insertions, 6 deletions
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 082ea7080..78a5341b1 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -523,9 +523,11 @@ let nf_evar =
(* Note by HH [oct 08] : why would it be the job of clos_norm_flags to add
a [nf_evar] here *)
let clos_norm_flags flgs env sigma t =
- norm_val
- (create_clos_infos ~evars:(safe_evar_value sigma) flgs env)
- (inject t)
+ try
+ norm_val
+ (create_clos_infos ~evars:(safe_evar_value sigma) flgs env)
+ (inject t)
+ with Anomaly _ -> 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
@@ -584,9 +586,11 @@ let nf_betaiota_preserving_vm_cast =
(* lazy weak head reduction functions *)
let whd_flags flgs env sigma t =
- whd_val
- (create_clos_infos ~evars:(safe_evar_value sigma) flgs env)
- (inject t)
+ try
+ whd_val
+ (create_clos_infos ~evars:(safe_evar_value sigma) flgs env)
+ (inject t)
+ with Anomaly _ -> error "Tried to normalized ill-typed term"
(********************************************************************)
(* Conversion *)
@@ -618,6 +622,7 @@ let test_conversion (f:?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"
let is_conv env sigma = test_conversion Reduction.conv env sigma
let is_conv_leq env sigma = test_conversion Reduction.conv_leq env sigma
@@ -626,6 +631,7 @@ let is_fconv = function | CONV -> is_conv | CUMUL -> is_conv_leq
let test_trans_conversion f reds env sigma x y =
try let _ = f reds env (nf_evar sigma x) (nf_evar sigma y) in true
with NotConvertible -> false
+ | Anomaly _ -> 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