From cc69a4697633e14fc00c9bd0858b38120645464b Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 23 Sep 2015 16:00:49 +0200 Subject: Univs: module constraints move to universe contexts as they might declare new universes (e.g. with). --- kernel/environ.ml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'kernel/environ.ml') diff --git a/kernel/environ.ml b/kernel/environ.ml index c433c0789..429aba4f7 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -197,8 +197,10 @@ let push_constraints_to_env (_,univs) env = add_constraints univs env let add_universes strict ctx g = - let g = Array.fold_left (fun g v -> Univ.add_universe v strict g) - g (Univ.Instance.to_array (Univ.UContext.instance ctx)) + let g = Array.fold_left + (* Be lenient, module typing reintroduces universes and constraints due to includes *) + (fun g v -> try Univ.add_universe v strict g with Univ.AlreadyDeclared -> g) + g (Univ.Instance.to_array (Univ.UContext.instance ctx)) in Univ.merge_constraints (Univ.UContext.constraints ctx) g @@ -206,8 +208,9 @@ let push_context ?(strict=false) ctx env = map_universes (add_universes strict ctx) env let add_universes_set strict ctx g = - let g = Univ.LSet.fold (fun v g -> Univ.add_universe v strict g) - (Univ.ContextSet.levels ctx) g + let g = Univ.LSet.fold + (fun v g -> try Univ.add_universe v strict g with Univ.AlreadyDeclared -> g) + (Univ.ContextSet.levels ctx) g in Univ.merge_constraints (Univ.ContextSet.constraints ctx) g let push_context_set ?(strict=false) ctx env = -- cgit v1.2.3