diff options
| author |  msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2008-11-08 01:50:36 +0000 |
|---|---|---|
| committer | msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2008-11-08 01:50:36 +0000 |
| commit | dc58c68f7e385bb9ec7360439527e8edb7f9545a (patch) | |
| tree | dcdfc58796b6c64649b76601386dd18062c03e86 | |
| parent | 12a13c739a71cb4e796cc9e6e1596bb75be4ff1c (diff) | |
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
| -rw-r--r-- | pretyping/pretyping.ml | 11 |
1 files 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) -> |