From dc58c68f7e385bb9ec7360439527e8edb7f9545a Mon Sep 17 00:00:00 2001 From: msozeau Date: Sat, 8 Nov 2008 01:50:36 +0000 Subject: Apply vmconv if there are no _undefined_ evars around. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11560 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/pretyping.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 2921cd536..7fe358e32 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -599,13 +599,14 @@ module Pretyping_F (Coercion : Coercion.S) = struct | CastConv (k,t) -> let tj = pretype_type empty_valcon env evdref lvar t in let cj = pretype empty_tycon env evdref lvar c in + let cty = nf_isevar !evdref cj.uj_type and tval = nf_isevar !evdref tj.utj_val in let cj = match k with - | VMcast when not (occur_existential cj.uj_type || occur_existential tj.utj_val) -> - ignore (Reduction.vm_conv Reduction.CUMUL env cj.uj_type tj.utj_val); cj - | _ -> inh_conv_coerce_to_tycon loc env evdref cj (mk_tycon tj.utj_val) + | VMcast when not (occur_existential cty || occur_existential tval) -> + ignore (Reduction.vm_conv Reduction.CUMUL env cty tval); cj + | _ -> inh_conv_coerce_to_tycon loc env evdref cj (mk_tycon tval) in - let v = mkCast (cj.uj_val, k, tj.utj_val) in - { uj_val = v; uj_type = tj.utj_val } + let v = mkCast (cj.uj_val, k, tval) in + { uj_val = v; uj_type = tval } in inh_conv_coerce_to_tycon loc env evdref cj tycon | RDynamic (loc,d) -> -- cgit v1.2.3