aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping/recordops.ml
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping/recordops.ml')
-rw-r--r--pretyping/recordops.ml16
1 files changed, 9 insertions, 7 deletions
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index d070edead..56a883099 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -69,8 +69,8 @@ let subst_structure (subst,((kn,i),id,kl,projs as obj)) =
let projs' =
(* invariant: struc.s_PROJ is an evaluable reference. Thus we can take *)
(* the first component of subst_con. *)
- List.smartmap
- (Option.smartmap (fun kn -> fst (subst_con_kn subst kn)))
+ List.Smart.map
+ (Option.Smart.map (fun kn -> fst (subst_con_kn subst kn)))
projs
in
let id' = fst (subst_constructor subst id) in
@@ -144,13 +144,13 @@ type obj_typ = {
o_TCOMPS : constr list } (* ordered *)
type cs_pattern =
- Const_cs of global_reference
+ Const_cs of GlobRef.t
| Prod_cs
| Sort_cs of Sorts.family
| Default_cs
let eq_cs_pattern p1 p2 = match p1, p2 with
-| Const_cs gr1, Const_cs gr2 -> eq_gr gr1 gr2
+| Const_cs gr1, Const_cs gr2 -> GlobRef.equal gr1 gr2
| Prod_cs, Prod_cs -> true
| Sort_cs s1, Sort_cs s2 -> Sorts.family_equal s1 s2
| Default_cs, Default_cs -> true
@@ -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