diff options
| author | Enrico Tassi | 2018-12-11 16:06:28 +0100 |
|---|---|---|
| committer | Enrico Tassi | 2018-12-11 16:06:28 +0100 |
| commit | df657bd52d20b1c41e2ef4d44bde207323de6935 (patch) | |
| tree | 85fde4a47f00585dfae4bd09c27f3cf8cbef5526 /interp | |
| parent | 97f5f37f782ffb9914fa8f67e745ba1effad20be (diff) | |
| parent | cff3c5a7148afc722852bd01658fe49ffec1d967 (diff) | |
Merge PR #9155: Fix race condition triggered by fresh universe generation
Diffstat (limited to 'interp')
| -rw-r--r-- | interp/declare.ml | 10 |
1 files changed, 3 insertions, 7 deletions
diff --git a/interp/declare.ml b/interp/declare.ml index 1e972d3e35..a809a856b9 100644 --- a/interp/declare.ml +++ b/interp/declare.ml @@ -469,7 +469,7 @@ type universe_source = | QualifiedUniv of Id.t (* global universe introduced by some global value *) | UnqualifiedUniv (* other global universe *) -type universe_name_decl = universe_source * (Id.t * Nametab.universe_id) list +type universe_name_decl = universe_source * (Id.t * Univ.Level.UGlobal.t) list let check_exists sp = if Nametab.exists_universe sp then @@ -540,12 +540,8 @@ let do_universe poly l = user_err ~hdr:"Constraint" (str"Cannot declare polymorphic universes outside sections") in - let l = - List.map (fun {CAst.v=id} -> - let lev = UnivGen.new_univ_id () in - (id, lev)) l - in - let ctx = List.fold_left (fun ctx (_,(dp,i)) -> Univ.LSet.add (Univ.Level.make dp i) ctx) + let l = List.map (fun {CAst.v=id} -> (id, UnivGen.new_univ_global ())) l in + let ctx = List.fold_left (fun ctx (_,qid) -> Univ.LSet.add (Univ.Level.make qid) ctx) Univ.LSet.empty l, Univ.Constraint.empty in let () = declare_universe_context poly ctx in |