aboutsummaryrefslogtreecommitdiff
path: root/pretyping
diff options
context:
space:
mode:
authorGaëtan Gilbert2018-12-06 15:52:37 +0100
committerGaëtan Gilbert2018-12-06 17:10:02 +0100
commitcff3c5a7148afc722852bd01658fe49ffec1d967 (patch)
tree63a70acbd8a9657040461fd2fc06b51e0ee960df /pretyping
parent3e275d4bd1c3eb002b68c36ab116e5ab687d52f3 (diff)
Revise API for global universes.
Rename Univ.Level.{Qualid -> UGlobal}, remove Univ.Level.Id. Remove the ability to split the argument of `Univ.Level.Level` into a dirpath*int pair (except by going through string hacks like detyping/pretyping(/funind) does). Id.of_string_soft to turn unnamed universes into qualid is pushed up to detyping. (TODO some followup PR clean up more) This makes it pointless to have an opaque type for ints in Univ.Level: it would only be used as argument to Univ.Level.UGlobal.make, ie ~~~ open Univ.Level let x = UGlobal.make dp (Id.make n) (* vs *) let x = UGlobal.make dp n ~~~ Remaining places which create levels from ints are various hacks (eg the dummy in inductive.ml, the Type.n universes in ugraph sort_universes) and univgen. UnivGen does have an opaque type for ints used as univ ids since they get manipulated by the stm. NB: build breaks due to ocamldep issue if UGlobal is named Global instead.
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/detyping.ml19
-rw-r--r--pretyping/pretyping.ml2
2 files changed, 18 insertions, 3 deletions
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 33ced6d6e0..ce7c7c8702 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -589,8 +589,23 @@ let detype_cofix detype avoid env sigma n (names,tys,bodies) =
Array.map (fun (_,_,ty) -> ty) v,
Array.map (fun (_,bd,_) -> bd) v)
+(* TODO use some algebraic type with a case for unnamed univs so we
+ can cleanly detype them. NB: this corresponds to a hack in
+ Pretyping.interp_universe_level_name to convert Foo.xx strings into
+ universes. *)
+let hack_qualid_of_univ_level sigma l =
+ match Termops.reference_of_level sigma l with
+ | Some qid -> qid
+ | None ->
+ let path = String.split_on_char '.' (Univ.Level.to_string l) in
+ let path = List.rev_map Id.of_string_soft path in
+ Libnames.qualid_of_dirpath (DirPath.make path)
+
let detype_universe sigma u =
- let fn (l, n) = Some (Termops.reference_of_level sigma l, n) in
+ let fn (l, n) =
+ let qid = hack_qualid_of_univ_level sigma l in
+ Some (qid, n)
+ in
Univ.Universe.map fn u
let detype_sort sigma = function
@@ -611,7 +626,7 @@ let detype_anonymous = ref (fun ?loc n -> anomaly ~label:"detype" (Pp.str "index
let set_detype_anonymous f = detype_anonymous := f
let detype_level sigma l =
- let l = Termops.reference_of_level sigma l in
+ let l = hack_qualid_of_univ_level sigma l in
GType (UNamed l)
let detype_instance sigma l =
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index d01c44811f..2be0f73ea4 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -140,7 +140,7 @@ let interp_universe_level_name ~anon_rigidity evd qid =
user_err ?loc:qid.CAst.loc ~hdr:"interp_universe_level_name"
(Pp.(str "Undeclared global universe: " ++ Libnames.pr_qualid qid))
in
- let level = Univ.Level.make2 dp (Univ.Level.Id.make num) in
+ let level = Univ.Level.(make (UGlobal.make dp num)) in
let evd =
try Evd.add_global_univ evd level
with UGraph.AlreadyDeclared -> evd