Skip to content

Commit c0e7d0c

Browse files
Merge PR #17792: Stop relying on opaque proof accessors in funind.
Reviewed-by: Matafou Reviewed-by: SkySkimmer Co-authored-by: SkySkimmer <[email protected]>
2 parents 9790a21 + cac8662 commit c0e7d0c

File tree

2 files changed

+19
-14
lines changed

2 files changed

+19
-14
lines changed

plugins/funind/functional_principles_proofs.ml

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -829,8 +829,10 @@ let generate_equation_lemma env evd fnames f fun_num nb_params nb_args rec_args_
829829
, Array.init (nb_params + nb_args) (fun i ->
830830
mkRel (nb_params + nb_args - i)) )
831831
in
832-
let f_body, _, _ =
833-
Option.get (Global.body_of_constant_body Library.indirect_accessor f_def)
832+
let f_body = match f_def.const_body with
833+
| Def d -> d
834+
| OpaqueDef _ | Primitive _ | Undef _ ->
835+
CErrors.user_err (Pp.str "Definition without a body")
834836
in
835837
let f_body = EConstr.of_constr f_body in
836838
let params, f_body_with_params = decompose_lambda_n evd nb_params f_body in
@@ -991,14 +993,15 @@ let prove_princ_for_struct (evd : Evd.evar_map ref) interactive_proof fun_num
991993
; args = List.map fresh_decl princ_info.args }
992994
in
993995
let get_body const =
994-
match Global.body_of_constant Library.indirect_accessor const with
995-
| Some (body, _, _) ->
996-
let env = Global.env () in
996+
let env = Global.env () in
997+
let body = Environ.lookup_constant const env in
998+
match body.Declarations.const_body with
999+
| Def body ->
9971000
let sigma = Evd.from_env env in
9981001
Tacred.cbv_norm_flags
9991002
(CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
10001003
env sigma (EConstr.of_constr body)
1001-
| None -> user_err Pp.(str "Cannot define a principle over an axiom ")
1004+
| Undef _ | Primitive _ | OpaqueDef _ -> user_err Pp.(str "Cannot define a principle over an axiom ")
10021005
in
10031006
let fbody = get_body fnames.(fun_num) in
10041007
let f_ctxt, f_body = decompose_lambda sigma fbody in

plugins/funind/gen_principle.ml

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1218,18 +1218,20 @@ let get_funs_constant mp =
12181218
function
12191219
| const ->
12201220
let find_constant_body const =
1221-
match Global.body_of_constant Library.indirect_accessor const with
1222-
| Some (body, _, _) ->
1221+
let env = Global.env () in
1222+
let body = Environ.lookup_constant const env in
1223+
match body.Declarations.const_body with
1224+
| Def body ->
12231225
let body =
12241226
Tacred.cbv_norm_flags
12251227
(CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
1226-
(Global.env ())
1227-
(Evd.from_env (Global.env ()))
1228+
env
1229+
(Evd.from_env env)
12281230
(EConstr.of_constr body)
12291231
in
12301232
let body = EConstr.Unsafe.to_constr body in
12311233
body
1232-
| None ->
1234+
| Undef _ | OpaqueDef _ | Primitive _ ->
12331235
CErrors.user_err Pp.(str "Cannot define a principle over an axiom ")
12341236
in
12351237
let f = find_constant_body const in
@@ -2057,9 +2059,9 @@ let make_graph (f_ref : GlobRef.t) =
20572059
++ Termops.pr_global_env env (ConstRef c))
20582060
| _ -> CErrors.user_err Pp.(str "Not a function reference")
20592061
in
2060-
match Global.body_of_constant_body Library.indirect_accessor c_body with
2061-
| None -> CErrors.user_err (Pp.str "Cannot build a graph over an axiom!")
2062-
| Some (body, _, _) ->
2062+
match c_body.Declarations.const_body with
2063+
| Undef _ | Primitive _ | OpaqueDef _ -> CErrors.user_err (Pp.str "Cannot build a graph over an axiom!")
2064+
| Def body ->
20632065
let env = Global.env () in
20642066
let extern_body, extern_type =
20652067
with_full_print

0 commit comments

Comments
 (0)