diff options
| author | Pierre-Marie Pédrot | 2016-10-31 18:31:35 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2016-10-31 18:57:44 +0100 |
| commit | c48838c05eea1793c2d0a11292f8fc4eb784cd02 (patch) | |
| tree | 18ef4ff5dace16fa286ecf6c8479ff55aabfc453 /pretyping/evarconv.ml | |
| parent | d562d0e0ef9aab9d3f7333aec39172ed37d4d5ae (diff) | |
Stronger static invariant in equality upto universes.
We return an option type, as constraints were always dropped if the boolean
was false. They did not make much sense anyway.
Diffstat (limited to 'pretyping/evarconv.ml')
| -rw-r--r-- | pretyping/evarconv.ml | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 3ef0bb1b35..d06009dce5 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -401,14 +401,16 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty else evar_eqappr_x ts env' evd CONV out2 out1 in let rigids env evd sk term sk' term' = - let b,univs = Universes.eq_constr_universes term term' in - if b then + let univs = Universes.eq_constr_universes term term' in + match univs with + | Some univs -> ise_and evd [(fun i -> let cstrs = Universes.to_constraints (Evd.universes i) univs in try Success (Evd.add_constraints i cstrs) with Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p)); (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk sk')] - else UnifFailure (evd,NotSameHead) + | None -> + UnifFailure (evd,NotSameHead) in let flex_maybeflex on_left ev ((termF,skF as apprF),cstsF) ((termM, skM as apprM),cstsM) vM = let switch f a b = if on_left then f a b else f b a in @@ -650,14 +652,16 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty allow this identification (first-order unification of universes). Otherwise fallback to unfolding. *) - let b,univs = Universes.eq_constr_universes term1 term2 in - if b then + let univs = Universes.eq_constr_universes term1 term2 in + match univs with + | Some univs -> ise_and i [(fun i -> try Success (Evd.add_universe_constraints i univs) with UniversesDiffer -> UnifFailure (i,NotSameHead) | Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p)); (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk1 sk2)] - else UnifFailure (i,NotSameHead) + | None -> + UnifFailure (i,NotSameHead) and f2 i = (try if not (snd ts) then raise Not_found |