diff options
| -rw-r--r-- | pretyping/reductionops.ml | 13 | ||||
| -rw-r--r-- | pretyping/reductionops.mli | 2 |
2 files changed, 15 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)) diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli index 29a28f0f74..f8baac5ea4 100644 --- a/pretyping/reductionops.mli +++ b/pretyping/reductionops.mli @@ -120,6 +120,8 @@ val hnf_lam_app : env -> evar_map -> constr -> constr -> constr val hnf_lam_appvect : env -> evar_map -> constr -> constr array -> constr val hnf_lam_applist : env -> evar_map -> constr -> constr list -> constr +val subst1_nf_evar : evar_map -> constr -> constr -> constr + val splay_prod : env -> evar_map -> constr -> (name * constr) list * constr val splay_lambda : env -> evar_map -> constr -> (name * constr) list * constr val splay_arity : env -> evar_map -> constr -> (name * constr) list * sorts |