diff options
| author | Gaëtan Gilbert | 2020-07-07 11:49:35 +0200 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-07-09 14:18:17 +0200 |
| commit | dc16333815d8c542d84abd8bcdd52b7e372b760b (patch) | |
| tree | 32617df0ded9a5fb87fc2d95ff8031858a1d922a /pretyping | |
| parent | 577ec77f17a872d6bc36073ceeb3cf582fcf01c4 (diff) | |
Recordops: unify struc_typ summary record and libobject entry struc_tuple
This requires updating the parameter count at section end, I felt it
was easier to do with rebuild_function but it could be done in
discharge if needed.
Incidentally fixes #12649.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/recordops.ml | 29 | ||||
| -rw-r--r-- | pretyping/recordops.mli | 11 |
2 files changed, 17 insertions, 23 deletions
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index c26da8ccc7..e6e5ad8dd4 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -54,34 +54,29 @@ let structure_table = let projection_table = Summary.ref (Cmap.empty : struc_typ Cmap.t) ~name:"record-projs" -(* TODO: could be unify struc_typ and struc_tuple ? *) - -type struc_tuple = - constructor * proj_kind list * Constant.t option list - -let register_structure env (id,kl,projs) = - let open Declarations in - let ind = fst id in - let mib, mip = Inductive.lookup_mind_specif env ind in - let n = mib.mind_nparams in - let struc = - { s_CONST = id; s_EXPECTEDPARAM = n; s_PROJ = projs; s_PROJKIND = kl } in +let register_structure ({ s_CONST = (ind,_); s_PROJ = projs; } as struc) = structure_table := Indmap.add ind struc !structure_table; projection_table := List.fold_right (Option.fold_right (fun proj -> Cmap.add proj struc)) projs !projection_table -let subst_structure subst (id, kl, projs as obj) = +let subst_structure subst struc = let projs' = (* invariant: struc.s_PROJ is an evaluable reference. Thus we can take *) (* the first component of subst_con. *) List.Smart.map (Option.Smart.map (subst_constant subst)) - projs + struc.s_PROJ in - let id' = Globnames.subst_constructor subst id in - if projs' == projs && id' == id then obj else - (id',kl,projs') + let id' = Globnames.subst_constructor subst struc.s_CONST in + if projs' == struc.s_PROJ && id' == struc.s_CONST + then struc + else { struc with s_CONST = id'; s_PROJ = projs' } + +let rebuild_structure env struc = + let mib = Environ.lookup_mind (fst (fst struc.s_CONST)) env in + let npars = mib.Declarations.mind_nparams in + { struc with s_EXPECTEDPARAM = npars } let lookup_structure indsp = Indmap.find indsp !structure_table diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli index 955a4e7aae..3be60d5e62 100644 --- a/pretyping/recordops.mli +++ b/pretyping/recordops.mli @@ -27,13 +27,12 @@ type struc_typ = { s_CONST : constructor; s_EXPECTEDPARAM : int; s_PROJKIND : proj_kind list; - s_PROJ : Constant.t option list } - -type struc_tuple = - constructor * proj_kind list * Constant.t option list + s_PROJ : Constant.t option list; +} -val register_structure : Environ.env -> struc_tuple -> unit -val subst_structure : Mod_subst.substitution -> struc_tuple -> struc_tuple +val register_structure : struc_typ -> unit +val subst_structure : Mod_subst.substitution -> struc_typ -> struc_typ +val rebuild_structure : Environ.env -> struc_typ -> struc_typ (** [lookup_structure isp] returns the struc_typ associated to the inductive path [isp] if it corresponds to a structure, otherwise |
