diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2018-01-20 23:08:35 +0100 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2018-01-20 23:41:45 +0100 |
commit | 9266190e7965729ddcbf645b386e83e20ba5ab62 (patch) | |
tree | bc8717a1d02c81601396b3aa6387a7756412a929 | |
parent | f77b88a498f7e64bc35ade6fa74a00c2550bdf7f (diff) |
Fix #6618: coqchk fails with "ill-typed term".
Primitive projections were not correctly unfolded, leading to failure of
conversion checks in some cases. The kernel was strangely not affected by
this bug, and it was probably a remnant of some vestigial code.
-rw-r--r-- | checker/environ.ml | 24 | ||||
-rw-r--r-- | checker/environ.mli | 2 |
2 files changed, 12 insertions, 14 deletions
diff --git a/checker/environ.ml b/checker/environ.ml index 3830cd0dc..bbd043c8e 100644 --- a/checker/environ.ml +++ b/checker/environ.ml @@ -126,7 +126,7 @@ let add_constant kn cs env = env_constants = new_constants } in { env with env_globals = new_globals } -type const_evaluation_result = NoBody | Opaque | IsProj +type const_evaluation_result = NoBody | Opaque (* Constant types *) @@ -148,18 +148,16 @@ 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 -> - let b = force_constr l_body in - begin - match cb.const_universes with - | Monomorphic_const _ -> b - | Polymorphic_const _ -> subst_instance_constr u (force_constr l_body) - end - | OpaqueDef _ -> raise (NotEvaluableConst Opaque) - | Undef _ -> raise (NotEvaluableConst NoBody) - else raise (NotEvaluableConst IsProj) + match cb.const_body with + | Def l_body -> + let b = force_constr l_body in + begin + match cb.const_universes with + | Monomorphic_const _ -> b + | Polymorphic_const _ -> subst_instance_constr u (force_constr l_body) + end + | OpaqueDef _ -> raise (NotEvaluableConst Opaque) + | Undef _ -> raise (NotEvaluableConst NoBody) (* A global const is evaluable if it is defined and not opaque *) let evaluable_constant cst env = diff --git a/checker/environ.mli b/checker/environ.mli index ba62ed519..36e0ea027 100644 --- a/checker/environ.mli +++ b/checker/environ.mli @@ -52,7 +52,7 @@ val check_constraints : Univ.constraints -> env -> bool val lookup_constant : Constant.t -> env -> Cic.constant_body val add_constant : Constant.t -> Cic.constant_body -> env -> env val constant_type : env -> Constant.t puniverses -> constr Univ.constrained -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 val evaluable_constant : Constant.t -> env -> bool |