diff options
| author |  Matthieu Sozeau <matthieu.sozeau@inria.fr> | 2016-07-04 19:04:06 +0200 |
|---|---|---|
| committer | Matthieu Sozeau <matthieu.sozeau@inria.fr> | 2016-07-04 19:04:06 +0200 |
| commit | 6eeec8be1951f15cfa96340ff99a5f03acf12a53 (patch) | |
| tree | 32b5f6f11365007644fec647c5a2011e98cd4f0b /pretyping | |
| parent | c22f6694bac3479426cf179839430d9d8675e456 (diff) | |
| parent | 71d4c435e42c24c21ae43f0ddcc7a71bee1009f5 (diff) | |
Merge branch 'congruencefix' into v8.5
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarsolve.ml | 7 | ||||
| -rw-r--r-- | pretyping/evarsolve.mli | 8 |
2 files changed, 12 insertions, 3 deletions
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index 29af199a1..0db309f94 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -47,7 +47,8 @@ let refresh_level evd s = | None -> true | Some l -> not (Evd.is_flexible_level evd l) -let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t = +let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false) + pbty env evd t = let evdref = ref evd in let modified = ref false in let rec refresh status dir t = @@ -62,6 +63,10 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t = else set_leq_sort env !evdref s s' in modified := true; evdref := evd; mkSort s' + | Sort (Prop Pos as s) when refreshset && not dir -> + let s' = evd_comb0 (new_sort_variable status) evdref in + let evd = set_leq_sort env !evdref s s' in + modified := true; evdref := evd; mkSort s' | Prod (na,u,v) -> mkProd (na,u,refresh status dir v) | _ -> t diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index 918ba12f0..f94c83b6d 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -34,8 +34,12 @@ type conv_fun_bool = val evar_define : conv_fun -> ?choose:bool -> env -> evar_map -> bool option -> existential -> constr -> evar_map -val refresh_universes : ?status:Evd.rigid -> - ?onlyalg:bool (* Only algebraic universes *) -> +val refresh_universes : + ?status:Evd.rigid -> + ?onlyalg:bool (* Only algebraic universes *) -> + ?refreshset:bool -> + (* Also refresh Prop and Set universes, so that the returned type can be any supertype + of the original type *) bool option (* direction: true for levels lower than the existing levels *) -> env -> evar_map -> types -> evar_map * types |