aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins/extraction
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2018-06-04 15:26:20 +0200
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2018-06-17 11:44:04 +0200
commite43710b391c278ac7fcb808ec28d720b4317660c (patch)
tree00c9b48f65ed5567e1fcac31a344944d6ea148b9 /plugins/extraction
parenta4839aa1ff076a8938ca182615a93d6afe748860 (diff)
Remove the proj_body field from the kernel.
This was completely wrong, such a term could not even be type-checked by the kernel as it was internally using a match construct over a negative record. They were luckily only used in upper layers, namley printing and extraction. Recomputing the projection body might be costly in detyping, but this only happens when the compatibility flag is turned on, which is not the default. Such flag is probably bound to disappear anyways. Extraction should be fixed though so as to define directly primitive projections, similarly to what has been done in native compute.
Diffstat (limited to 'plugins/extraction')
-rw-r--r--plugins/extraction/extraction.ml12
1 files changed, 10 insertions, 2 deletions
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index b1ee21536..3a61c7747 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -1069,7 +1069,11 @@ let extract_constant env kn cb =
| false -> mk_typ (get_body c)
| true ->
let pb = lookup_projection (Projection.make kn false) env in
- mk_typ (EConstr.of_constr pb.proj_body))
+ (** FIXME: handle mutual records *)
+ let ind = (pb.Declarations.proj_ind, 0) in
+ let bodies = Inductiveops.legacy_match_projection env ind in
+ let body = bodies.(pb.Declarations.proj_arg) in
+ mk_typ (EConstr.of_constr body))
| OpaqueDef c ->
add_opaque r;
if access_opaque () then mk_typ (get_opaque env c)
@@ -1082,7 +1086,11 @@ let extract_constant env kn cb =
| false -> mk_def (get_body c)
| true ->
let pb = lookup_projection (Projection.make kn false) env in
- mk_def (EConstr.of_constr pb.proj_body))
+ (** FIXME: handle mutual records *)
+ let ind = (pb.Declarations.proj_ind, 0) in
+ let bodies = Inductiveops.legacy_match_projection env ind in
+ let body = bodies.(pb.Declarations.proj_arg) in
+ mk_def (EConstr.of_constr body))
| OpaqueDef c ->
add_opaque r;
if access_opaque () then mk_def (get_opaque env c)