diff options
| author |  Matthieu Sozeau <matthieu.sozeau@inria.fr> | 2017-02-21 12:56:28 +0100 |
|---|---|---|
| committer |  Matthieu Sozeau <mattam@mattam.org> | 2017-06-05 20:53:14 +0200 |
| commit | 36f3ae391ee188edb9d858d8832d7fd611db0482 (patch) | |
| tree | 781f6cdb17e10f06eea44552b44ce80329f792f5 /engine/uState.ml | |
| parent | e8137ae63b3b19436755f372b595e7343e942894 (diff) | |
Univs: fix bug #5365, generation of u+k <= v constraints
Use an explicit label ~algebraic for make_flexible_variable as well.
Diffstat (limited to 'engine/uState.ml')
| -rw-r--r-- | engine/uState.ml | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/engine/uState.ml b/engine/uState.ml index c35f97b2e..146a386a2 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -381,16 +381,21 @@ let add_global_univ uctx u = uctx_initial_universes = initial; uctx_universes = univs } -let make_flexible_variable ctx b u = - let {uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in +let make_flexible_variable ctx ~algebraic u = + let {uctx_local = cstrs; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in let uvars' = Univ.LMap.add u None uvars in let avars' = - if b then + if algebraic then let uu = Univ.Universe.make u in let substu_not_alg u' v = Option.cata (fun vu -> Univ.Universe.equal uu vu && not (Univ.LSet.mem u' avars)) false v in - if not (Univ.LMap.exists substu_not_alg uvars) + let has_upper_constraint () = + Univ.Constraint.exists + (fun (l,d,r) -> d == Univ.Lt && Univ.Level.equal l u) + (Univ.ContextSet.constraints cstrs) + in + if not (Univ.LMap.exists substu_not_alg uvars || has_upper_constraint ()) then Univ.LSet.add u avars else avars else avars in |