aboutsummaryrefslogtreecommitdiffhomepage
path: root/engine/eConstr.ml
diff options
context:
space:
mode:
authorGravatar Matthieu Sozeau <mattam@mattam.org>2017-11-22 18:39:34 +0100
committerGravatar Matthieu Sozeau <mattam@mattam.org>2017-12-01 10:16:49 +0100
commit4fcf1fa32ff395d6bd5f6ce4803eee18173c4d36 (patch)
tree860ae15d5abc8665389d034fd8a1ca80dcd7a353 /engine/eConstr.ml
parent0d580ce929060df98b7d566a40adc2e46c4a1d6c (diff)
Cleanup API for registering universe binders.
- Regularly declared for for polymorphic constants - Declared globally for monomorphic constants. E.g mono@{i} := Type@{i} is printed as mono@{mono.i} := Type@{mono.i}. There can be a name clash if there's a module and a constant of the same name. It is detected and is an error if the constant is first but is not detected and the name for the constant not registered (??) if the constant comes second. Accept VarRef when registering universe binders Fix two problems found by Gaƫtan where binders were not registered properly Simplify API substantially by not passing around a substructure of an already carrier-around structure in interpretation/declaration code of constants and proofs Fix an issue of the stronger restrict universe context + no evd leak This is uncovered by not having an evd leak in interp_definition, and the stronger restrict_universe_context. This patch could be backported to 8.7, it could also be triggered by the previous restrict_context I think.
Diffstat (limited to 'engine/eConstr.ml')
-rw-r--r--engine/eConstr.ml18
1 files changed, 18 insertions, 0 deletions
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index afdceae06..ea098902a 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -645,6 +645,24 @@ let eq_constr_universes_proj env sigma m n =
let res = eq_constr' (unsafe_to_constr m) (unsafe_to_constr n) in
if res then Some !cstrs else None
+let universes_of_constr sigma c =
+ let open Univ in
+ let rec aux s c =
+ match kind sigma c with
+ | Const (_, u) | Ind (_, u) | Construct (_, u) ->
+ LSet.fold LSet.add (Instance.levels (EInstance.kind sigma u)) s
+ | Sort u ->
+ let sort = ESorts.kind sigma u in
+ if Sorts.is_small sort then s
+ else
+ let u = Sorts.univ_of_sort sort in
+ LSet.fold LSet.add (Universe.levels u) s
+ | Evar (k, args) ->
+ let concl = Evd.evar_concl (Evd.find sigma k) in
+ fold sigma aux (aux s (of_constr concl)) c
+ | _ -> fold sigma aux s c
+ in aux LSet.empty c
+
open Context
open Environ