diff options
| author | Maxime Dénès | 2018-01-17 15:17:10 +0100 |
|---|---|---|
| committer | Maxime Dénès | 2018-01-17 15:17:10 +0100 |
| commit | 79b6f227664df61948c535039522fdd2aeb2e9a9 (patch) | |
| tree | e3f15349037f648da5f1eed59536c3c1f1ba09be | |
| parent | d4f965678dcffb836fb9cf8790e3e969d3bfc364 (diff) | |
| parent | 8acf32377b67c08568215a89c31cdc382883dbf6 (diff) | |
Merge PR #6298: Fix #6297: handle constraints like (u+1 <= Set/Prop)
| -rw-r--r-- | engine/uState.ml | 20 | ||||
| -rw-r--r-- | test-suite/bugs/closed/6297.v | 8 |
2 files changed, 20 insertions, 8 deletions
diff --git a/engine/uState.ml b/engine/uState.ml index 6f2b3c4b26..4b650c9c94 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -201,14 +201,18 @@ let process_universe_constraints ctx cstrs = | None -> user_err Pp.(str "Algebraic universe on the right") | Some r' -> if Univ.Level.is_small r' then - let levels = Univ.Universe.levels l in - let fold l' local = - let l = Univ.Universe.make l' in - if Univ.Level.is_small l' || is_local l' then - equalize_variables false l l' r r' local - else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None)) - in - Univ.LSet.fold fold levels local + if not (Univ.Universe.is_levels l) + then + raise (Univ.UniverseInconsistency (Univ.Le, l, r, None)) + else + let levels = Univ.Universe.levels l in + let fold l' local = + let l = Univ.Universe.make l' in + if Univ.Level.is_small l' || is_local l' then + equalize_variables false l l' r r' local + else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None)) + in + Univ.LSet.fold fold levels local else Univ.enforce_leq l r local end diff --git a/test-suite/bugs/closed/6297.v b/test-suite/bugs/closed/6297.v new file mode 100644 index 0000000000..a28607058f --- /dev/null +++ b/test-suite/bugs/closed/6297.v @@ -0,0 +1,8 @@ +Set Printing Universes. + +(* Error: Anomaly "Uncaught exception "Anomaly: Incorrect universe Set + declared for inductive type, inferred level is max(Prop, Set+1)."." + Please report at http://coq.inria.fr/bugs/. *) +Fail Record LTS: Set := + lts { St: Set; + init: St }. |