Skip to content

Commit 546f5a7

Browse files
committed
Adapt to rocq-prover/rocq#20178 (template has qvars in kernel)
1 parent ca7f250 commit 546f5a7

File tree

3 files changed

+11
-12
lines changed

3 files changed

+11
-12
lines changed

template-coq/src/quoter.ml

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,7 @@ open Pp
66
open Tm_util
77
open Reification
88

9-
let inductive_sort mip =
10-
match mip.mind_arity with
11-
| RegularArity s -> s.mind_sort
12-
| TemplateArity ar -> ar.template_level
9+
let inductive_sort mip = mip.mind_sort
1310

1411
let cast_prop = ref (false)
1512

@@ -456,9 +453,7 @@ struct
456453
(* TODO quote the real squash data instead of approximating with a sort family *)
457454
let kelim = match oib.Declarations.mind_squashed with
458455
| None -> Sorts.InType
459-
| Some _ -> match oib.mind_arity with
460-
| TemplateArity _ -> InType
461-
| RegularArity s -> Sorts.family s.mind_sort
456+
| Some _ -> Sorts.family oib.mind_sort
462457
in
463458
let sf = Q.quote_sort_family kelim in
464459
(Q.quote_ident oib.mind_typename, indices, indsort, indty, sf,

template-coq/src/run_template_monad.ml

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -281,8 +281,15 @@ let unquote_mutual_inductive_entry env evm trm (* of type mutual_inductive_entry
281281
in
282282
let priv = unquote_map_option unquote_bool priv in
283283
let ctx, univs = match univs with
284-
| UState.Monomorphic_entry ctx ->
285-
if template then Univ.ContextSet.empty, Entries.Template_ind_entry { univs = ctx; pseudo_sort_poly = TemplateUnivOnly }
284+
| UState.Monomorphic_entry ctx ->
285+
if template then
286+
let mk_anon_names u =
287+
let qs, us = UVars.Instance.to_array u in
288+
Array.make (Array.length qs) Anonymous, Array.make (Array.length us) Anonymous
289+
in
290+
let uctx = UVars.UContext.of_context_set mk_anon_names Sorts.QVar.Set.empty ctx in
291+
let default_univs = UVars.UContext.instance uctx in
292+
Univ.ContextSet.empty, Entries.Template_ind_entry { uctx; default_univs }
286293
else ctx, Entries.Monomorphic_ind_entry
287294
| UState.Polymorphic_entry uctx -> Univ.ContextSet.empty, Entries.Polymorphic_ind_entry uctx
288295
in

template-coq/src/tm_util.ml

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -272,9 +272,6 @@ module RetypeMindEntry =
272272
| Entries.Template_ind_entry uctx -> evm
273273
| Entries.Polymorphic_ind_entry uctx ->
274274
let qs, (us, csts) = UVars.UContext.to_context_set uctx in
275-
let qs = Sorts.Quality.Set.fold (fun q qs -> match q with
276-
| QConstant _ -> assert false
277-
| QVar q -> Sorts.QVar.Set.add q qs) qs Sorts.QVar.Set.empty in
278275
Evd.merge_sort_context_set (UState.UnivFlexible false) evm ((qs,us),csts)
279276
in
280277
let evm, mind = infer_mentry_univs env evm mind in

0 commit comments

Comments
 (0)