diff options
| author |  Maxime Dénès <mail@maximedenes.fr> | 2018-01-23 10:01:33 +0100 |
|---|---|---|
| committer | Maxime Dénès <mail@maximedenes.fr> | 2018-01-23 10:01:33 +0100 |
| commit | 2e798fb83db743ce44350af6f7f9442811f374ad (patch) | |
| tree | c21f8be141617491622fdb1f9adf62cfc3026ed9 /kernel | |
| parent | 89d14fa4f16e9741108887177d43d34675261d22 (diff) | |
| parent | fe0e62bebcd71aca8b56cc615d81667a31e43388 (diff) | |
Merge PR #6627: Fix #6619: coqchk does not reduce compatibility constants for primitive projections
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/environ.ml | 23 | ||||
| -rw-r--r-- | kernel/environ.mli | 4 |
2 files changed, 2 insertions, 25 deletions
diff --git a/kernel/environ.ml b/kernel/environ.ml index 93dc2f9a7..738ecc6e1 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -254,31 +254,10 @@ let constant_context env kn = | Monomorphic_const _ -> Univ.AUContext.empty | Polymorphic_const ctx -> ctx -type const_evaluation_result = NoBody | Opaque | IsProj +type const_evaluation_result = NoBody | Opaque exception NotEvaluableConst of const_evaluation_result -let constant_value env (kn,u) = - let cb = lookup_constant kn env in - if cb.const_proj = None then - match cb.const_body with - | Def l_body -> - begin - match cb.const_universes with - | Monomorphic_const _ -> - (Mod_subst.force_constr l_body, Univ.Constraint.empty) - | Polymorphic_const _ -> - let csts = constraints_of cb u in - (subst_instance_constr u (Mod_subst.force_constr l_body), csts) - end - | OpaqueDef _ -> raise (NotEvaluableConst Opaque) - | Undef _ -> raise (NotEvaluableConst NoBody) - else raise (NotEvaluableConst IsProj) - -let constant_opt_value env cst = - try Some (constant_value env cst) - with NotEvaluableConst _ -> None - let constant_value_and_type env (kn, u) = let cb = lookup_constant kn env in if Declareops.constant_is_polymorphic cb then diff --git a/kernel/environ.mli b/kernel/environ.mli index 7cc541258..69d811a64 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -146,13 +146,11 @@ val type_in_type_constant : Constant.t -> env -> bool body and [NotEvaluableConst IsProj] if [c] is a projection and [Not_found] if it does not exist in [env] *) -type const_evaluation_result = NoBody | Opaque | IsProj +type const_evaluation_result = NoBody | Opaque exception NotEvaluableConst of const_evaluation_result -val constant_value : env -> Constant.t puniverses -> constr constrained val constant_type : env -> Constant.t puniverses -> types constrained -val constant_opt_value : env -> Constant.t puniverses -> (constr * Univ.Constraint.t) option val constant_value_and_type : env -> Constant.t puniverses -> constr option * types * Univ.Constraint.t (** The universe context associated to the constant, empty if not |