diff options
| author | Gaëtan Gilbert | 2020-07-02 15:30:07 +0200 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-07-05 21:03:17 +0200 |
| commit | 1e92ed4d129aea5ea4e9300a24e1135cc186c341 (patch) | |
| tree | c78ff50d0d156a54b950aaf7b1a80b36b2e23b14 /pretyping | |
| parent | cea10e4e16c05b06693184425dd70ce6e5eba8a8 (diff) | |
Fix Canonical with universe polymorphism and primitive projection
Perhaps we should thread an evar map with the Var universes added
through to cs_pattern_of_constr but that would be significantly more invasive.
Fix #12528
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/recordops.ml | 2 | ||||
| -rw-r--r-- | pretyping/retyping.ml | 3 | ||||
| -rw-r--r-- | pretyping/retyping.mli | 4 |
3 files changed, 8 insertions, 1 deletions
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index a8e934d3c6..c26da8ccc7 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -185,7 +185,7 @@ let rec cs_pattern_of_constr env t = | Rel n -> Default_cs, Some n, [] | Prod (_,a,b) when Vars.noccurn 1 b -> Prod_cs, None, [a; Vars.lift (-1) b] | Proj (p, c) -> - let { Environ.uj_type = ty } = Typeops.infer env c in + let ty = Retyping.get_type_of_constr env c in let _, params = Inductive.find_rectype env ty in Const_cs (GlobRef.ConstRef (Projection.constant p)), None, params @ [c] | Sort s -> Sort_cs (Sorts.family s), None, [] diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml index bb518bc2f9..7a1af7f41a 100644 --- a/pretyping/retyping.ml +++ b/pretyping/retyping.ml @@ -257,6 +257,9 @@ let get_type_of ?(polyprop=true) ?(lax=false) env sigma c = (* Makes an unsafe judgment from a constr *) let get_judgment_of env evc c = { uj_val = c; uj_type = get_type_of env evc c } +let get_type_of_constr ?polyprop ?lax env ?(uctx=UState.from_env env) c = + EConstr.Unsafe.to_constr (get_type_of ?polyprop ?lax env (Evd.from_ctx uctx) (EConstr.of_constr c)) + (* Returns sorts of a context *) let sorts_of_context env evc ctxt = let rec aux = function diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli index 16bc251c2a..2e19ffdfcd 100644 --- a/pretyping/retyping.mli +++ b/pretyping/retyping.mli @@ -30,6 +30,10 @@ exception RetypeError of retype_error val get_type_of : ?polyprop:bool -> ?lax:bool -> env -> evar_map -> constr -> types +(** No-evar version of [get_type_of] *) +val get_type_of_constr : ?polyprop:bool -> ?lax:bool + -> env -> ?uctx:UState.t -> Constr.t -> Constr.types + val get_sort_of : ?polyprop:bool -> env -> evar_map -> types -> Sorts.t |