aboutsummaryrefslogtreecommitdiff
path: root/checker
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2019-06-04 13:44:05 +0200
committerPierre-Marie Pédrot2019-06-17 15:20:02 +0200
commit5316d205993bb3fe3f69e8984fe53d4d50aa8d2a (patch)
tree8016562d06949b981a3e58e71103b02aea7f1c44 /checker
parent7e47fea5ce050c8129ba2d6f94e93fbc29763a3b (diff)
Allow to delay polymorphic opaque constants.
We had to move the private opaque constraints out of the constant declaration into the opaque table. The API is not very pretty yet due to a pervasive confusion between monomorphic global constraints and polymorphic local ones, but once we get rid of futures in the kernel this should be magically solved.
Diffstat (limited to 'checker')
-rw-r--r--checker/check.ml7
-rw-r--r--checker/mod_checking.ml23
-rw-r--r--checker/values.ml6
3 files changed, 19 insertions, 17 deletions
diff --git a/checker/check.ml b/checker/check.ml
index 903258daef..89cb834a4a 100644
--- a/checker/check.ml
+++ b/checker/check.ml
@@ -51,7 +51,7 @@ let pr_path sp =
type compilation_unit_name = DirPath.t
type seg_univ = Univ.ContextSet.t * bool
-type seg_proofs = (Opaqueproof.cooking_info list * int * Constr.constr option) array
+type seg_proofs = Opaqueproof.opaque_proofterm array
type library_t = {
library_name : compilation_unit_name;
@@ -98,10 +98,7 @@ let access_opaque_table dp i =
with Not_found -> assert false
in
assert (i < Array.length t);
- let (info, n, c) = t.(i) in
- match c with
- | None -> None
- | Some c -> Some (Cooking.cook_constr info n c)
+ t.(i)
let access_discharge = Cooking.cook_constr
diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 0684623a81..7e49e741ad 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -31,16 +31,19 @@ let check_constant_declaration env kn cb =
in
let ty = cb.const_type in
let _ = infer_type env' ty in
- let env' = match cb.const_private_poly_univs, (cb.const_body, poly) with
- | None, _ -> env'
- | Some local, (OpaqueDef _, true) -> push_subgraph local env'
- | Some _, _ -> assert false
- in
- let otab = Environ.opaque_tables env in
- let body = match cb.const_body with
- | Undef _ | Primitive _ -> None
- | Def c -> Some (Mod_subst.force_constr c)
- | OpaqueDef o -> Some (Opaqueproof.force_proof !indirect_accessor otab o)
+ let otab = Environ.opaque_tables env' in
+ let body, env' = match cb.const_body with
+ | Undef _ | Primitive _ -> None, env'
+ | Def c -> Some (Mod_subst.force_constr c), env'
+ | OpaqueDef o ->
+ let c, u = Opaqueproof.force_proof !indirect_accessor otab o in
+ let env' = match u, cb.const_universes with
+ | Opaqueproof.PrivateMonomorphic (), Monomorphic _ -> env'
+ | Opaqueproof.PrivatePolymorphic local, Polymorphic _ ->
+ push_subgraph local env'
+ | _ -> assert false
+ in
+ Some c, env'
in
let () =
match body with
diff --git a/checker/values.ml b/checker/values.ml
index 4a4c8d803c..7b869cd130 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -230,7 +230,6 @@ let v_cb = v_tuple "constant_body"
v_relevance;
Any;
v_univs;
- Opt v_context_set;
v_bool;
v_typing_flags|]
@@ -399,6 +398,9 @@ let v_abstract =
let v_cooking_info =
Tuple ("cooking_info", [|v_work_list; v_abstract|])
-let v_opaques = Array (Tuple ("opaque", [| List v_cooking_info; Int; Opt v_constr |]))
+let v_delayed_universes =
+ Sum ("delayed_universes", 0, [| [| v_unit |]; [| v_context_set |] |])
+
+let v_opaques = Array (Tuple ("opaque", [| List v_cooking_info; Int; Opt (v_pair v_constr v_delayed_universes) |]))
let v_univopaques =
Opt (Tuple ("univopaques",[|v_context_set;v_bool|]))