diff options
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/inductive.ml | 9 | ||||
| -rw-r--r-- | kernel/inductive.mli | 11 |
2 files changed, 18 insertions, 2 deletions
diff --git a/kernel/inductive.ml b/kernel/inductive.ml index 07195c493f..aeeefbfa42 100644 --- a/kernel/inductive.ml +++ b/kernel/inductive.ml @@ -178,13 +178,20 @@ let instantiate_universes env ctx ar argsorts = (* This is a Type with constraints *) else Type level -let type_of_inductive_knowing_parameters env mip paramtyps = +exception SingletonInductiveBecomesProp of identifier + +let type_of_inductive_knowing_parameters ?(polyprop=true) env mip paramtyps = match mip.mind_arity with | Monomorphic s -> s.mind_user_arity | Polymorphic ar -> let ctx = List.rev mip.mind_arity_ctxt in let ctx,s = instantiate_universes env ctx ar paramtyps in + (* The Ocaml extraction cannot handle (yet?) "Prop-polymorphism", i.e. + the situation where a non-Prop singleton inductive becomes Prop + when applied to Prop params *) + if not polyprop && not (is_type0m_univ ar.poly_level) && s = prop_sort + then raise (SingletonInductiveBecomesProp mip.mind_typename); mkArity (List.rev ctx,s) (* Type of a (non applied) inductive type *) diff --git a/kernel/inductive.mli b/kernel/inductive.mli index c14f693439..a124647c6d 100644 --- a/kernel/inductive.mli +++ b/kernel/inductive.mli @@ -82,7 +82,16 @@ val check_cofix : env -> cofixpoint -> unit (** {6 Support for sort-polymorphic inductive types } *) -val type_of_inductive_knowing_parameters : +(** The "polyprop" optional argument below allows to control + the "Prop-polymorphism". By default, it is allowed. + But when "polyprop=false", the following exception is raised + when a polymorphic singleton inductive type becomes Prop due to + parameter instantiation. This is used by the Ocaml extraction, + which cannot handle (yet?) Prop-polymorphism. *) + +exception SingletonInductiveBecomesProp of identifier + +val type_of_inductive_knowing_parameters : ?polyprop:bool -> env -> one_inductive_body -> types array -> types val max_inductive_sort : sorts array -> universe |