diff options
| author | Matthieu Sozeau | 2014-05-08 13:44:33 +0200 |
|---|---|---|
| committer | Matthieu Sozeau | 2014-05-08 19:23:51 +0200 |
| commit | 18569c5714ae16f867cabebf98327026409e6eaf (patch) | |
| tree | 92923150c138e4268cc2ecac55b42f5b0a9e8d3a /kernel/constr.ml | |
| parent | f912004bbe2c8f77de09cc290c3c687dc4ebf7f8 (diff) | |
Fast-path equality of sorts in compare_constr*
Diffstat (limited to 'kernel/constr.ml')
| -rw-r--r-- | kernel/constr.ml | 29 |
1 files changed, 19 insertions, 10 deletions
diff --git a/kernel/constr.ml b/kernel/constr.ml index f72eb2acbe..c6eacc289c 100644 --- a/kernel/constr.ml +++ b/kernel/constr.ml @@ -556,7 +556,7 @@ let eq_constr_univs univs m n = if m == n then true else let eq_universes _ = Univ.Instance.check_eq univs in - let eq_sorts s1 s2 = Univ.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in + let eq_sorts s1 s2 = s1 == s2 || Univ.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in let rec eq_constr' m n = m == n || compare_head_gen eq_universes eq_sorts eq_constr' m n in compare_head_gen eq_universes eq_sorts eq_constr' m n @@ -565,8 +565,10 @@ let leq_constr_univs univs m n = if m == n then true else let eq_universes _ = Univ.Instance.check_eq univs in - let eq_sorts s1 s2 = Univ.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in - let leq_sorts s1 s2 = Univ.check_leq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in + let eq_sorts s1 s2 = s1 == s2 || + Univ.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in + let leq_sorts s1 s2 = s1 == s2 || + Univ.check_leq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in let rec eq_constr' m n = m == n || compare_head_gen eq_universes eq_sorts eq_constr' m n in @@ -582,9 +584,11 @@ let eq_constr_universes m n = let eq_universes strict l l' = cstrs := Univ.enforce_eq_instances_univs strict l l' !cstrs; true in let eq_sorts s1 s2 = - cstrs := Univ.UniverseConstraints.add - (Sorts.univ_of_sort s1, Univ.UEq, Sorts.univ_of_sort s2) !cstrs; - true + if Sorts.equal s1 s2 then true + else + (cstrs := Univ.UniverseConstraints.add + (Sorts.univ_of_sort s1, Univ.UEq, Sorts.univ_of_sort s2) !cstrs; + true) in let rec eq_constr' m n = m == n || compare_head_gen eq_universes eq_sorts eq_constr' m n @@ -599,12 +603,17 @@ let leq_constr_universes m n = let eq_universes strict l l' = cstrs := Univ.enforce_eq_instances_univs strict l l' !cstrs; true in let eq_sorts s1 s2 = - cstrs := Univ.UniverseConstraints.add - (Sorts.univ_of_sort s1,Univ.UEq,Sorts.univ_of_sort s2) !cstrs; true + if Sorts.equal s1 s2 then true + else (cstrs := Univ.UniverseConstraints.add + (Sorts.univ_of_sort s1,Univ.UEq,Sorts.univ_of_sort s2) !cstrs; + true) in let leq_sorts s1 s2 = - cstrs := Univ.UniverseConstraints.add - (Sorts.univ_of_sort s1,Univ.ULe,Sorts.univ_of_sort s2) !cstrs; true + if Sorts.equal s1 s2 then true + else + (cstrs := Univ.UniverseConstraints.add + (Sorts.univ_of_sort s1,Univ.ULe,Sorts.univ_of_sort s2) !cstrs; + true) in let rec eq_constr' m n = m == n || compare_head_gen eq_universes eq_sorts eq_constr' m n |