aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-05-20 13:32:56 +0200
committerGaëtan Gilbert2020-05-20 13:32:56 +0200
commita87e04684335d276cb52c6f8c7385f9549194aef (patch)
treeab14c92d9b458b7b9aae8f831ca0c91db42d62dd
parent7163b75641bb8bf0a88856f43e536a9fba0d6ae7 (diff)
parent0643873397552cc2fe4d1486c14f206968dea672 (diff)
Merge PR #12356: [declare] Remove unused parameters in prepare_obligation
Reviewed-by: SkySkimmer
-rw-r--r--vernac/comDefinition.ml2
-rw-r--r--vernac/declare.ml25
-rw-r--r--vernac/declare.mli6
3 files changed, 12 insertions, 21 deletions
diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml
index eac8f92e2e..d56917271c 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -126,7 +126,7 @@ let do_definition_program ?hook ~name ~scope ~poly ~kind udecl bl red_option c c
let (body, types), evd, udecl, impargs =
interp_definition ~program_mode udecl bl ~poly red_option c ctypopt
in
- let term, ty, uctx, obls = Declare.prepare_obligation ~name ~poly ~body ~types ~udecl evd in
+ let term, ty, uctx, obls = Declare.prepare_obligation ~name ~body ~types evd in
let _ : Declare.Obls.progress =
Obligations.add_definition
~name ~term ty ~uctx ~udecl ~impargs ~scope ~poly ~kind ?hook obls
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 76f79eb0d6..333b186b22 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1007,25 +1007,20 @@ let declare_definition ~name ~scope ~kind ~opaque ~impargs ~udecl ?hook
let entry, uctx = prepare_definition ?fix_exn ~opaque ~poly ~udecl ~types ~body ?inline sigma in
declare_entry ~name ~scope ~kind ~impargs ?obls ?hook ~uctx entry
-let prepare_obligation ?opaque ?inline ~name ~poly ~udecl ~types ~body sigma =
+let prepare_obligation ~name ~types ~body sigma =
+ let env = Global.env () in
+ let types = match types with
+ | Some t -> t
+ | None -> Retyping.get_type_of env sigma body
+ in
let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false
- sigma (fun nf -> nf body, Option.map nf types)
+ sigma (fun nf -> nf body, nf types)
in
- let univs = Evd.check_univ_decl ~poly sigma udecl in
- let ce = definition_entry ?opaque ?inline ?types ~univs body in
- let env = Global.env () in
- let (c,ctx), sideff = Future.force ce.proof_entry_body in
- assert(Safe_typing.is_empty_private_constants sideff.Evd.seff_private);
- assert(Univ.ContextSet.is_empty ctx);
RetrieveObl.check_evars env sigma;
- let c = EConstr.of_constr c in
- let typ = match ce.proof_entry_type with
- | Some t -> EConstr.of_constr t
- | None -> Retyping.get_type_of env sigma c
- in
- let obls, _, c, cty = RetrieveObl.retrieve_obligations env name sigma 0 c typ in
+ let body, types = EConstr.(of_constr body, of_constr types) in
+ let obls, _, body, cty = RetrieveObl.retrieve_obligations env name sigma 0 body types in
let uctx = Evd.evar_universe_context sigma in
- c, cty, uctx, obls
+ body, cty, uctx, obls
let prepare_parameter ~poly ~udecl ~types sigma =
let env = Global.env () in
diff --git a/vernac/declare.mli b/vernac/declare.mli
index 82b0cff8d9..62bc6a34bf 100644
--- a/vernac/declare.mli
+++ b/vernac/declare.mli
@@ -367,11 +367,7 @@ val declare_mutually_recursive
(** Prepare API, to be removed once we provide the corresponding 1-step API *)
val prepare_obligation
- : ?opaque:bool
- -> ?inline:bool
- -> name:Id.t
- -> poly:bool
- -> udecl:UState.universe_decl
+ : name:Id.t
-> types:EConstr.t option
-> body:EConstr.t
-> Evd.evar_map