diff options
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/detyping.ml | 8 | ||||
| -rw-r--r-- | pretyping/indrec.ml | 2 | ||||
| -rw-r--r-- | pretyping/patternops.ml | 8 | ||||
| -rw-r--r-- | pretyping/pretype_errors.ml | 2 | ||||
| -rw-r--r-- | pretyping/recordops.ml | 8 |
5 files changed, 17 insertions, 11 deletions
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 779508477..fc398df9a 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -929,9 +929,11 @@ let (f_subst_genarg, subst_genarg_hook) = Hook.make () let rec subst_glob_constr subst = DAst.map (function | GRef (ref,u) as raw -> - let ref',t = subst_global subst ref in - if ref' == ref then raw else - DAst.get (detype Now false Id.Set.empty (Global.env()) Evd.empty (EConstr.of_constr t)) + let ref',t = subst_global subst ref in + if ref' == ref then raw else + let env = Global.env () in + let evd = Evd.from_env env in + DAst.get (detype Now false Id.Set.empty env evd (EConstr.of_constr t)) | GSort _ | GVar _ diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml index 40f4d4ff8..27b029aad 100644 --- a/pretyping/indrec.ml +++ b/pretyping/indrec.ml @@ -42,7 +42,7 @@ type recursion_scheme_error = exception RecursionSchemeError of recursion_scheme_error -let named_hd env t na = named_hd env Evd.empty (EConstr.of_constr t) na +let named_hd env t na = named_hd env (Evd.from_env env) (EConstr.of_constr t) na let name_assumption env = function | LocalAssum (na,t) -> LocalAssum (named_hd env t na, t) | LocalDef (na,c,t) -> LocalDef (named_hd env c na, c, t) diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml index 375ed10d0..9342b4cc7 100644 --- a/pretyping/patternops.ml +++ b/pretyping/patternops.ml @@ -279,9 +279,11 @@ let lift_pattern k = liftn_pattern k 1 let rec subst_pattern subst pat = match pat with | PRef ref -> - let ref',t = subst_global subst ref in - if ref' == ref then pat else - pattern_of_constr (Global.env()) Evd.empty t + let ref',t = subst_global subst ref in + if ref' == ref then pat else + let env = Global.env () in + let evd = Evd.from_env env in + pattern_of_constr env evd t | PVar _ | PEvar _ | PRel _ -> pat diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index 278a4761d..856894d9a 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -165,7 +165,7 @@ let error_not_product ?loc env sigma c = (*s Error in conversion from AST to glob_constr *) let error_var_not_found ?loc s = - raise_pretype_error ?loc (empty_env, Evd.empty, VarNotFound s) + raise_pretype_error ?loc (empty_env, Evd.from_env empty_env, VarNotFound s) (*s Typeclass errors *) diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index 9eb410f06..56a883099 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -199,7 +199,7 @@ let warn_projection_no_head_constant = let env = Termops.push_rels_assum sign env in let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con) in let proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in - let term_pp = Termops.print_constr_env env Evd.empty (EConstr.of_constr t) in + let term_pp = Termops.print_constr_env env (Evd.from_env env) (EConstr.of_constr t) in strbrk "Projection value has no head constant: " ++ term_pp ++ strbrk " in canonical instance " ++ con_pp ++ str " of " ++ proji_sp_pp ++ strbrk ", ignoring it.") @@ -211,7 +211,7 @@ let compute_canonical_projections warn (con,ind) = let u = Univ.make_abstract_instance ctx in let v = (mkConstU (con,u)) in let c = Environ.constant_value_in env (con,u) in - let sign,t = Reductionops.splay_lam env Evd.empty (EConstr.of_constr c) in + let sign,t = Reductionops.splay_lam env (Evd.from_env env) (EConstr.of_constr c) in let sign = List.map (on_snd EConstr.Unsafe.to_constr) sign in let t = EConstr.Unsafe.to_constr t in let lt = List.rev_map snd sign in @@ -317,7 +317,9 @@ let check_and_decompose_canonical_structure ref = let vc = match Environ.constant_opt_value_in env (sp, u) with | Some vc -> vc | None -> error_not_structure ref "Could not find its value in the global environment." in - let body = snd (splay_lam (Global.env()) Evd.empty (EConstr.of_constr vc)) (** FIXME *) in + let env = Global.env () in + let evd = Evd.from_env env in + let body = snd (splay_lam (Global.env()) evd (EConstr.of_constr vc)) in let body = EConstr.Unsafe.to_constr body in let f,args = match kind body with | App (f,args) -> f,args |