diff options
| author | Pierre-Marie Pédrot | 2020-02-24 11:11:06 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2020-02-24 11:36:07 +0100 |
| commit | 02b837e9b135fc828c8c8efc8eb1bc5b882f1aaf (patch) | |
| tree | 3673515d16cf409da01439aef81357a66c82c771 /kernel | |
| parent | 6354eb0cec6a59bfe23aa3b332b3b8c13259f555 (diff) | |
Do not perform a universe diff when typing opaque constants.
Apart from being an ugly hack in the kernel, the universe-adding function
is already robust to redundant universes anyways.
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/term_typing.ml | 8 |
1 files changed, 3 insertions, 5 deletions
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml index faa601e277..2ecd4880f7 100644 --- a/kernel/term_typing.ml +++ b/kernel/term_typing.ml @@ -61,7 +61,7 @@ let feedback_completion_typecheck = Feedback.feedback ~id:state_id Feedback.Complete) type typing_context = -| MonoTyCtx of Environ.env * unsafe_type_judgment * Univ.ContextSet.t * Id.Set.t * Stateid.t option +| MonoTyCtx of Environ.env * unsafe_type_judgment * Id.Set.t * Stateid.t option | PolyTyCtx of Environ.env * unsafe_type_judgment * Univ.universe_level_subst * Univ.AUContext.t * Id.Set.t * Stateid.t option let infer_declaration env (dcl : constant_entry) = @@ -155,7 +155,7 @@ let infer_opaque env = function let env = push_context_set ~strict:true univs env in let { opaque_entry_feedback = feedback_id; _ } = c in let tyj = Typeops.infer_type env typ in - let context = MonoTyCtx (env, tyj, univs, c.opaque_entry_secctx, feedback_id) in + let context = MonoTyCtx (env, tyj, c.opaque_entry_secctx, feedback_id) in let def = OpaqueDef () in { Cooking.cook_body = def; @@ -257,10 +257,8 @@ let build_constant_declaration env result = const_typing_flags = Environ.typing_flags env } let check_delayed (type a) (handle : a effect_handler) tyenv (body : a proof_output) = match tyenv with -| MonoTyCtx (env, tyj, univs, declared, feedback_id) -> +| MonoTyCtx (env, tyj, declared, feedback_id) -> let ((body, uctx), side_eff) = body in - (* don't redeclare universes which are declared for the type *) - let uctx = Univ.ContextSet.diff uctx univs in let (body, uctx', valid_signatures) = handle env body side_eff in let uctx = Univ.ContextSet.union uctx uctx' in let env = push_context_set uctx env in |