aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping/evd.ml
diff options
context:
space:
mode:
authorGravatar Matthieu Sozeau <mattam@mattam.org>2014-04-07 19:21:05 +0200
committerGravatar Matthieu Sozeau <mattam@mattam.org>2014-05-06 09:58:59 +0200
commit4cb7fe525a472928aee02d772458d28a2b71072a (patch)
tree5934260488727e9c06871ce775376535c252f721 /pretyping/evd.ml
parent2d6de8b102ea3cd05c5d193190faf787ccb84baa (diff)
- Fix arity handling in retyping (de Bruijn bug!)
- Enforce that no u <= Prop/Set can be added for u introduced by the user in Evd.process_constraints. (Needs to be enforced in the kernel as well, but that's the main entry point). - Fix a test-suite script and remove a regression comment, it's just as before now.
Diffstat (limited to 'pretyping/evd.ml')
-rw-r--r--pretyping/evd.ml12
1 files changed, 11 insertions, 1 deletions
diff --git a/pretyping/evd.ml b/pretyping/evd.ml
index 166bab4b8..fd6af80b8 100644
--- a/pretyping/evd.ml
+++ b/pretyping/evd.ml
@@ -372,7 +372,12 @@ let process_universe_constraints univs vars alg local cstrs =
else
match Univ.Universe.level r with
| None -> error ("Algebraic universe on the right")
- | Some _ -> Univ.enforce_leq l r local
+ | Some rl when Univ.Level.is_small rl ->
+ (match Univ.Universe.level l with
+ | Some ll when Univ.LMap.mem ll !vars ->
+ Univ.enforce_eq l r local
+ | _ -> raise (Univ.UniverseInconsistency (Univ.Le, l, r, [])))
+ | _ -> Univ.enforce_leq l r local
else if d == Univ.ULub then
match varinfo l, varinfo r with
| (Inr (l, true, _), Inr (r, _, _))
@@ -1107,6 +1112,11 @@ let set_leq_sort evd s1 s2 =
| Prop c, Prop c' ->
if c == Null && c' == Pos then evd
else (raise (Univ.UniverseInconsistency (Univ.Le, u1, u2, [])))
+ | Type u, Prop _ ->
+ (match is_sort_variable evd s1 with
+ | Some (_, false) ->
+ add_universe_constraints evd (Univ.UniverseConstraints.singleton (u1, Univ.UEq, u2))
+ | _ -> raise (Univ.UniverseInconsistency (Univ.Le, u1, u2, [])))
| _, _ ->
add_universe_constraints evd (Univ.UniverseConstraints.singleton (u1,Univ.ULe,u2))