diff options
| author | Pierre-Marie Pédrot | 2016-11-29 17:49:11 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2017-02-14 17:30:44 +0100 |
| commit | 390fd4ac0a969103caeb5db3e5138e26f9a533de (patch) | |
| tree | f04f87b0fca81518797dabd0f9d2d395ba8ec2b8 /pretyping | |
| parent | d549d9d3d169fbfc5f555e3e4f22f46301161d53 (diff) | |
Chasing a few unsafe constr coercions.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarconv.ml | 8 | ||||
| -rw-r--r-- | pretyping/evarsolve.ml | 8 |
2 files changed, 14 insertions, 2 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index f5cab070ed..1cbea68dda 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -973,7 +973,13 @@ let apply_on_subterm env evdref f c t = (* By using eq_constr, we make an approximation, for instance, we *) (* could also be interested in finding a term u convertible to t *) (* such that c occurs in u *) - if e_eq_constr_univs evdref (EConstr.Unsafe.to_constr c) (EConstr.Unsafe.to_constr t) then f k + let eq_constr c1 c2 = match EConstr.eq_constr_universes !evdref c1 c2 with + | None -> false + | Some cstr -> + try ignore (Evd.add_universe_constraints !evdref cstr); true + with UniversesDiffer -> false + in + if eq_constr c t then f k else match EConstr.kind !evdref t with | Evar (evk,args) -> diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index ff47365286..28e63d04b9 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -1263,7 +1263,13 @@ type conv_fun_bool = let solve_refl ?(can_drop=false) conv_algo env evd pbty evk argsv1 argsv2 = let evdref = ref evd in - if Array.equal (fun c1 c2 -> e_eq_constr_univs evdref (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) ) argsv1 argsv2 then !evdref else + let eq_constr c1 c2 = match EConstr.eq_constr_universes !evdref c1 c2 with + | None -> false + | Some cstr -> + try ignore (Evd.add_universe_constraints !evdref cstr); true + with UniversesDiffer -> false + in + if Array.equal eq_constr argsv1 argsv2 then !evdref else (* Filter and restrict if needed *) let args = Array.map2 (fun a1 a2 -> (a1, a2)) argsv1 argsv2 in let untypedfilter = |