A défaut de substitution paresseuse ou explicite, ajout d'une substitution optimisée pour le prétypage que normalise les evars (cf bug #932)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@6819 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 13 insertions, 0 deletions

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index a7573f5343..f77dfe3c29 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -433,6 +433,19 @@ let rec whd_evar sigma c =
 let nf_evar sigma =
   local_strong (whd_evar sigma)
 
+let subst1_nf_evar sigma v =
+  let rec substrec depth c = match kind_of_term c with
+    | Rel k     ->
+        if k <= depth then c
+        else if k = depth+1 then lift depth v
+        else mkRel (k-1)
+    | Evar (ev,args as evar) ->
+	(try substrec depth (Evd.existential_value sigma evar)
+	 with Not_found -> mkEvar (ev, Array.map (substrec depth) args))
+    | _ -> map_constr_with_binders succ substrec depth c
+  in 
+  substrec 0
+
 (* lazy reduction functions. The infos must be created for each term *)
 let clos_norm_flags flgs env sigma t =
   norm_val (create_clos_infos flgs env) (inject (nf_evar sigma t))