aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel/reduction.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 /kernel/reduction.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 'kernel/reduction.ml')
-rw-r--r--kernel/reduction.ml9
1 files changed, 6 insertions, 3 deletions
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index b92f97aa6..904a2a009 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -260,7 +260,8 @@ and eqappr cv_pb infos (lft1,st1) (lft2,st2) cuniv =
| (FAtom a1, FAtom a2) ->
(match kind_of_term a1, kind_of_term a2 with
| (Sort s1, Sort s2) ->
- assert (is_empty_stack v1 && is_empty_stack v2);
+ if not (is_empty_stack v1 && is_empty_stack v2) then
+ anomaly "conversion was given ill-typed terms (Sort)";
sort_cmp cv_pb s1 s2 cuniv
| (Meta n, Meta m) ->
if n=m
@@ -320,14 +321,16 @@ and eqappr cv_pb infos (lft1,st1) (lft2,st2) cuniv =
(* other constructors *)
| (FLambda _, FLambda _) ->
- assert (is_empty_stack v1 && is_empty_stack v2);
+ if not (is_empty_stack v1 && is_empty_stack v2) then
+ anomaly "conversion was given ill-typed terms (FLambda)";
let (_,ty1,bd1) = destFLambda mk_clos hd1 in
let (_,ty2,bd2) = destFLambda mk_clos hd2 in
let u1 = ccnv CONV infos el1 el2 ty1 ty2 cuniv in
ccnv CONV infos (el_lift el1) (el_lift el2) bd1 bd2 u1
| (FProd (_,c1,c2), FProd (_,c'1,c'2)) ->
- assert (is_empty_stack v1 && is_empty_stack v2);
+ if not (is_empty_stack v1 && is_empty_stack v2) then
+ anomaly "conversion was given ill-typed terms (FProd)";
(* Luo's system *)
let u1 = ccnv CONV infos el1 el2 c1 c'1 cuniv in
ccnv cv_pb infos (el_lift el1) (el_lift el2) c2 c'2 u1